home *** CD-ROM | disk | FTP | other *** search
/ The Devil's Doorknob BBS Capture (1996-2003) / devilsdoorknobbbscapture1996-2003.iso / Dloads / OTHERUTI / TPASCAL3.ZIP / TVISION.ZIP / BUFFERS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-11  |  3KB  |  170 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 6.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1990 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Buffers;
  12.  
  13. {$F+,O+,S-,X+,D-}
  14.  
  15. interface
  16.  
  17. procedure InitBuffers;
  18. procedure DoneBuffers;
  19. procedure NewBuffer(var P: Pointer);
  20. procedure DisposeBuffer(P: Pointer);
  21. function GetBufferSize(P: Pointer): Word;
  22. function SetBufferSize(P: Pointer; Size: Word): Boolean;
  23.  
  24. const
  25.   BufHeapSize: Word = 0;
  26.   BufHeapPtr: Word = 0;
  27.   BufHeapEnd: Word = 0;
  28.  
  29. implementation
  30.  
  31. uses Objects;
  32.  
  33. type
  34.   PBuffer = ^TBuffer;
  35.   TBuffer = record
  36.     Master: ^Word;
  37.     Size: Word;
  38.   end;
  39.  
  40. procedure MoveSeg(Source, Dest, Size: Word); assembler;
  41. asm
  42.     PUSH    DS
  43.     MOV    AX,Source
  44.     MOV    DX,Dest
  45.     MOV    BX,Size
  46.     CMP    AX,DX
  47.     JB    @@3
  48.     CLD
  49. @@1:    MOV    CX,0FFFH
  50.     CMP    CX,BX
  51.     JB    @@2
  52.     MOV    CX,BX
  53. @@2:    MOV    DS,AX
  54.     MOV    ES,DX
  55.     ADD    AX,CX
  56.     ADD    DX,CX
  57.     SUB    BX,CX
  58.     SHL    CX,1
  59.     SHL    CX,1
  60.     SHL    CX,1
  61.     XOR    SI,SI
  62.     XOR    DI,DI
  63.     REP    MOVSW
  64.     OR    BX,BX
  65.     JNE    @@1
  66.     JMP    @@6
  67. @@3:    ADD    AX,BX
  68.     ADD    DX,BX
  69.     STD
  70. @@4:    MOV    CX,0FFFH
  71.     CMP    CX,BX
  72.     JB    @@5
  73.     MOV    CX,BX
  74. @@5:    SUB    AX,CX
  75.     SUB    DX,CX
  76.     SUB    BX,CX
  77.     MOV    DS,AX
  78.     MOV    ES,DX
  79.     SHL    CX,1
  80.     SHL    CX,1
  81.     SHL    CX,1
  82.     MOV    SI,CX
  83.     DEC    SI
  84.     SHL    SI,1
  85.     MOV    DI,SI
  86.     REP    MOVSW
  87.     OR    BX,BX
  88.     JNE    @@4
  89. @@6:    POP    DS
  90. end;
  91.  
  92. function GetBufSize(P: PBuffer): Word;
  93. begin
  94.   GetBufSize := (P^.Size + 15) shr 4 + 1;
  95. end;
  96.  
  97. procedure SetBufSize(P: PBuffer; NewSize: Word);
  98. var
  99.   CurSize: Word;
  100. begin
  101.   CurSize := GetBufSize(P);
  102.   MoveSeg(PtrRec(P).Seg + CurSize, PtrRec(P).Seg + NewSize,
  103.     BufHeapPtr - PtrRec(P).Seg - CurSize);
  104.   Inc(BufHeapPtr, NewSize - CurSize);
  105.   Inc(PtrRec(P).Seg, NewSize);
  106.   while PtrRec(P).Seg < BufHeapPtr do
  107.   begin
  108.     Inc(P^.Master^, NewSize - CurSize);
  109.     Inc(PtrRec(P).Seg, (P^.Size + 15) shr 4 + 1);
  110.   end;
  111. end;
  112.  
  113. procedure InitBuffers;
  114. var
  115.   HeapSize: Word;
  116. begin
  117.   HeapSize := PtrRec(HeapEnd).Seg - PtrRec(HeapOrg).Seg;
  118.   BufHeapPtr := PtrRec(HeapEnd).Seg - BufHeapSize;
  119.   BufHeapEnd := PtrRec(HeapEnd).Seg;
  120.   PtrRec(HeapEnd).Seg := BufHeapPtr;
  121. end;
  122.  
  123. procedure DoneBuffers;
  124. begin
  125.   PtrRec(HeapEnd).Seg := BufHeapEnd;
  126. end;
  127.    
  128. procedure NewBuffer(var P: Pointer);
  129. begin
  130.   if BufHeapPtr = BufHeapEnd then P := nil else
  131.   begin
  132.     with PBuffer(Ptr(BufHeapPtr, 0))^ do
  133.     begin
  134.       Master := @PtrRec(P).Seg;
  135.       Size := 0;
  136.     end;
  137.     Inc(BufHeapPtr);
  138.     P := Ptr(BufHeapPtr, 0);
  139.   end;
  140. end;
  141.  
  142. procedure DisposeBuffer(P: Pointer);
  143. begin
  144.   Dec(PtrRec(P).Seg);
  145.   SetBufSize(P, 0);
  146. end;
  147.  
  148. function GetBufferSize(P: Pointer): Word;
  149. begin
  150.   Dec(PtrRec(P).Seg);
  151.   GetBufferSize := PBuffer(P)^.Size;
  152. end;
  153.  
  154. function SetBufferSize(P: Pointer; Size: Word): Boolean;
  155. var
  156.   NewSize: Word;
  157. begin
  158.   Dec(PtrRec(P).Seg);
  159.   NewSize := (Size + 15) shr 4 + 1;
  160.   SetBufferSize := False;
  161.   if BufHeapPtr + NewSize - GetBufSize(P) <= BufHeapEnd then
  162.   begin
  163.     SetBufSize(P, NewSize);
  164.     PBuffer(P)^.Size := Size;
  165.     SetBufferSize := True;
  166.   end;
  167. end;
  168.  
  169. end.
  170.