170 lines
3.3 KiB
Plaintext
170 lines
3.3 KiB
Plaintext
|
|
{*******************************************************}
|
|
{ }
|
|
{ Turbo Pascal Version 6.0 }
|
|
{ Turbo Vision Unit }
|
|
{ }
|
|
{ Copyright (c) 1990 Borland International }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
unit Buffers;
|
|
|
|
{$F+,O+,S-,X+,D-}
|
|
|
|
interface
|
|
|
|
procedure InitBuffers;
|
|
procedure DoneBuffers;
|
|
procedure NewBuffer(var P: Pointer);
|
|
procedure DisposeBuffer(P: Pointer);
|
|
function GetBufferSize(P: Pointer): Word;
|
|
function SetBufferSize(P: Pointer; Size: Word): Boolean;
|
|
|
|
const
|
|
BufHeapSize: Word = 0;
|
|
BufHeapPtr: Word = 0;
|
|
BufHeapEnd: Word = 0;
|
|
|
|
implementation
|
|
|
|
uses Objects;
|
|
|
|
type
|
|
PBuffer = ^TBuffer;
|
|
TBuffer = record
|
|
Master: ^Word;
|
|
Size: Word;
|
|
end;
|
|
|
|
procedure MoveSeg(Source, Dest, Size: Word); assembler;
|
|
asm
|
|
PUSH DS
|
|
MOV AX,Source
|
|
MOV DX,Dest
|
|
MOV BX,Size
|
|
CMP AX,DX
|
|
JB @@3
|
|
CLD
|
|
@@1: MOV CX,0FFFH
|
|
CMP CX,BX
|
|
JB @@2
|
|
MOV CX,BX
|
|
@@2: MOV DS,AX
|
|
MOV ES,DX
|
|
ADD AX,CX
|
|
ADD DX,CX
|
|
SUB BX,CX
|
|
SHL CX,1
|
|
SHL CX,1
|
|
SHL CX,1
|
|
XOR SI,SI
|
|
XOR DI,DI
|
|
REP MOVSW
|
|
OR BX,BX
|
|
JNE @@1
|
|
JMP @@6
|
|
@@3: ADD AX,BX
|
|
ADD DX,BX
|
|
STD
|
|
@@4: MOV CX,0FFFH
|
|
CMP CX,BX
|
|
JB @@5
|
|
MOV CX,BX
|
|
@@5: SUB AX,CX
|
|
SUB DX,CX
|
|
SUB BX,CX
|
|
MOV DS,AX
|
|
MOV ES,DX
|
|
SHL CX,1
|
|
SHL CX,1
|
|
SHL CX,1
|
|
MOV SI,CX
|
|
DEC SI
|
|
SHL SI,1
|
|
MOV DI,SI
|
|
REP MOVSW
|
|
OR BX,BX
|
|
JNE @@4
|
|
@@6: POP DS
|
|
end;
|
|
|
|
function GetBufSize(P: PBuffer): Word;
|
|
begin
|
|
GetBufSize := (P^.Size + 15) shr 4 + 1;
|
|
end;
|
|
|
|
procedure SetBufSize(P: PBuffer; NewSize: Word);
|
|
var
|
|
CurSize: Word;
|
|
begin
|
|
CurSize := GetBufSize(P);
|
|
MoveSeg(PtrRec(P).Seg + CurSize, PtrRec(P).Seg + NewSize,
|
|
BufHeapPtr - PtrRec(P).Seg - CurSize);
|
|
Inc(BufHeapPtr, NewSize - CurSize);
|
|
Inc(PtrRec(P).Seg, NewSize);
|
|
while PtrRec(P).Seg < BufHeapPtr do
|
|
begin
|
|
Inc(P^.Master^, NewSize - CurSize);
|
|
Inc(PtrRec(P).Seg, (P^.Size + 15) shr 4 + 1);
|
|
end;
|
|
end;
|
|
|
|
procedure InitBuffers;
|
|
var
|
|
HeapSize: Word;
|
|
begin
|
|
HeapSize := PtrRec(HeapEnd).Seg - PtrRec(HeapOrg).Seg;
|
|
BufHeapPtr := PtrRec(HeapEnd).Seg - BufHeapSize;
|
|
BufHeapEnd := PtrRec(HeapEnd).Seg;
|
|
PtrRec(HeapEnd).Seg := BufHeapPtr;
|
|
end;
|
|
|
|
procedure DoneBuffers;
|
|
begin
|
|
PtrRec(HeapEnd).Seg := BufHeapEnd;
|
|
end;
|
|
|
|
procedure NewBuffer(var P: Pointer);
|
|
begin
|
|
if BufHeapPtr = BufHeapEnd then P := nil else
|
|
begin
|
|
with PBuffer(Ptr(BufHeapPtr, 0))^ do
|
|
begin
|
|
Master := @PtrRec(P).Seg;
|
|
Size := 0;
|
|
end;
|
|
Inc(BufHeapPtr);
|
|
P := Ptr(BufHeapPtr, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure DisposeBuffer(P: Pointer);
|
|
begin
|
|
Dec(PtrRec(P).Seg);
|
|
SetBufSize(P, 0);
|
|
end;
|
|
|
|
function GetBufferSize(P: Pointer): Word;
|
|
begin
|
|
Dec(PtrRec(P).Seg);
|
|
GetBufferSize := PBuffer(P)^.Size;
|
|
end;
|
|
|
|
function SetBufferSize(P: Pointer; Size: Word): Boolean;
|
|
var
|
|
NewSize: Word;
|
|
begin
|
|
Dec(PtrRec(P).Seg);
|
|
NewSize := (Size + 15) shr 4 + 1;
|
|
SetBufferSize := False;
|
|
if BufHeapPtr + NewSize - GetBufSize(P) <= BufHeapEnd then
|
|
begin
|
|
SetBufSize(P, NewSize);
|
|
PBuffer(P)^.Size := Size;
|
|
SetBufferSize := True;
|
|
end;
|
|
end;
|
|
|
|
end.
|