[Back to FILES SWAG index] [Back to Main SWAG index] [Original]

    (************************************************************************)
    (*                                                                      *)
    (*  Program ex. to      : "Tips & Tricks in Turbo Pascal", SysTime 1993 *)
    (*                                                                      *)
    (*  By                  : Martin Israelsen                              *)
    (*                                                                      *)
    (*  Title               : BUFFER.PAS                                    *)
    (*                                                                      *)
    (*  Chapter             : 5                                             *)
    (*                                                                      *)
    (*  Description         : Quicker than Turbo fileread                   *)
    (*                                                                      *)
    (************************************************************************)
    (*$I-*)  (* Iocheck off         *)
    (*$F+*)  (* Force FAR call      *)
    (*$V-*)  (* Relaxed VAR check   *)
    (*$R-*)  (* Range check off     *)
    (*$S-*)  (* Stack check off     *)
    (*$Q-*)  (* Overflow off        *)
    (*$D-*)  (* Debug off           *)
    (*$L-*)  (* Linenumber off      *)

    Unit
      Buffer;

    Interface

    Type

      PByte     = ^Byte;
      PWord     = ^Word;
      PLong     = ^Longint;

      PByteArr  = ^TByteArr;
      TByteArr  = Array[1..64000] Of Byte;
      PfStr     = String[100];

      PBuffer       = ^TBuffer;
      TBuffer       = Record
                         BufFil   : File;
                         BufPtr   : PByteArr;

                         BufSize,
                         BufIndex,
                         BufUsed  : Word;

                         BufFPos,
                         BufFSize : Longint;
                      End;

    Function  BufferInit(Var Br: PBuffer; MemSize: Word;
                          FilName: PfStr): Boolean;
    Procedure BufferClose(Var Br: PBuffer);

    Function  BufferGetByte(Br: PBuffer): Byte;
    Function  BufferGetByteAsm(Br: PBuffer): Byte;

    Function  BufferGetWord(Br: PBuffer): Word;
    Procedure BufferGetBlock(Br: PBuffer; Var ToAdr; BlockSize: Word);
    Function  BufferGetStringAsm(Br: PBuffer): String;

    Function  BufferEof(Br: PBuffer): Boolean;

    Implementation

    (*$I-,F+*)

    Function BufferInit(Var Br: PBuffer; MemSize: Word;
                        FilName: PfStr): Boolean;
    Begin
       BufferInit:=False;

       (* Check if there's enough memory               *)

       If MemSize<500 Then Exit;
       If MaxAvail<Sizeof(TBuffer)+MemSize+32 Then Exit;

       New(Br);

       With BR^ Do
       Begin
          BufSize:=MemSize; BufIndex:=1; BufFPos:=0;

          (* Open the filen. Exit if there's an error *)

          Assign(BufFil,Filname); Reset(BufFil,1);

          If IoResult<>0 Then
          Begin
             Dispose(Br);
             Exit;
          End;

          (* Ok, the file is there, and there's enough *)
          (* memory. So allocate the memory and read   *)
          (* as much as possible                       *)

          GetMem(BufPtr,BufSize);
          BlockRead(BufFil,BufPtr^,BufSize,BufUsed);

          BufFSize:=FileSize(BufFil); Inc(BufFPos,BufUsed);
       End;

       BufferInit:=True;
    End;

    Procedure BufferClose(Var Br: PBuffer);
    Begin
       With Br^ Do
       Begin
          Close(BufFil);
          Freemem(BufPtr,BufSize);
       End;

       Dispose(Br);
    End;

    Procedure BufferCheck(Br: PBuffer; ReqBytes: Word);
    Var
       W,Rest: Word;
    Begin
       With Br^ Do
       Begin
          If (BufIndex+ReqBytes>BufUsed) And (BufUsed=BufSize) Then
          Begin
             Rest:=Succ(BufSize-BufIndex);

             Move(BufPtr^[BufIndex],BufPtr^[1],Rest);
             BufIndex:=1;

             BlockRead(BufFil,BufPtr^[Succ(Rest)],BufSize-Rest,W);
             BufUsed:=Rest+W; Inc(BufFPos,W);
          End;
       End;
    End;

    Function BufferGetByte(Br: PBuffer): Byte;
    Begin
       With Br^ Do
       Begin
          BufferCheck(Br,1);

          BufferGetByte:=BufPtr^[BufIndex];
          Inc(BufIndex);
       End;
    End;

    Function BufferGetByteAsm(Br: PBuffer): Byte; Assembler;
    Asm
       Les   Di,Br                              (* ES:DI ->  BRecPtr         *)

       Mov   Ax,Es:[Di.TBuffer.BufIndex]        (* Check wheather the buffer should be updated *)
       Cmp   Ax,Es:[Di.TBuffer.BufUsed]
       Jle   @@NoBufCheck                       (* If not jump on            *)

       Push  Word Ptr Br[2]                     (* Push BR to BufferCheck   *)
       Push  Word Ptr Br
       Mov   Ax,0001                            (* Check for one byte           *)
       Push  Ax                                 (* Push it                      *)
       Push  CS                                 (* Push CS, and make a          *)
       Call  Near Ptr BufferCheck               (* NEAR call - it's quicker     *)

       Les   Di,Br                              (* ES:DI-> BRecPtr              *)

     @@NoBufCheck:

       Mov   Bx,Es:[Di.TBuffer.BufIndex]        (* BufferIndex in BX            *)
       Inc   Es:[Di.TBuffer.BufIndex]           (* Inc BufferIndex directly     *)
       Les   Di,Es:[Di.TBuffer.BufPtr]          (* ES:DI -> BufPtr              *)

       Xor   Ax,Ax                              (* Now get the byte             *)
       Mov   Al,Byte Ptr Es:[Di+Bx-1]
    End;

    Function BufferGetWord(Br: PBuffer): Word;
    Begin
       With Br^ Do
       Begin
          BufferCheck(Br,2);

          BufferGetWord:=PWord(@BufPtr^[BufIndex])^;
          Inc(BufIndex,2);
       End;
    End;

    Procedure BufferGetBlock(Br: PBuffer; Var ToAdr; BlockSize: Word);
    Begin
       With Br^ Do
       Begin
          BufferCheck(Br,BlockSize);

          Move(BufPtr^[BufIndex],ToAdr,BlockSize);
          Inc(BufIndex,BlockSize);
       End;
    End;

    Function BufferGetStringAsm(Br: PBuffer): String; Assembler;
    Asm
       Push   Ds

       Les    Di,Br                        (* es:di -> Br *)
       Mov    Bx,Es:[Di.TBuffer.BufUsed]   (* check for buffercheck *)
       Sub    Bx,Es:[Di.TBuffer.BufIndex]
       Cmp    Bx,257
       Jae    @NoBufCheck                  (* Jump on if not        *)

       Push   Word Ptr Br[2]
       Push   Word Ptr Br

       Mov    Ax,257
       Push   Ax

       Push   Cs
       Call   Near Ptr BufferCheck

       Les    Di,Br

     @NoBufCheck:

       Mov    Bx,Es:[Di.TBuffer.BufIndex]  (* Get index in buffer     *)
       Dec    Bx                           (* Adjust for 0            *)

       Les    Di,Es:[Di.TBuffer.BufPtr]    (* Point to the buffer     *)
       Add    Di,Bx                        (* Add Index               *)
       Push   Di                           (* Save currect position   *)

       Mov    Al,$0a                       (* Search for CR = 0ah     *)
       Mov    Cx,$ff                       (* max. 255 chars          *)

       Cld                                 (* Remember                *)
       RepNz  Scasb                        (* and do the search       *)
       Jz     @Fundet                      (* Jump if we found one    *)

       Mov    Cx,0                         (* Otherwise set length to 0  *)
     @Fundet:
       Sub    Cx,$ff                       (* Which will be recalculated *)
       Neg    Cx                           (* to nomal length            *)
       Dec    Cx                           (* Dec, to avoid CR           *)

       Push   Es                           (* DS:SI->Buffer              *)
       Pop    Ds
       Pop    Si

       Les    Di,@Result                   (* ES:DI->result string        *)
       Mov    Ax,Cx

       Stosb                               (* Set length                  *)

       Shr    Cx,1                         (* Copy the string             *)
       Rep    MovSw
       Adc    Cx,Cx
       Rep    MovSb

       Pop    Ds                           (* Restore DS                  *)

       Les    Di,Br                        (* ES:DI->Br                   *)
       Inc    Ax                           (* Inc Ax, point to LF         *)

       Add    Es:[Di.TBuffer.BufIndex],Ax  (* and set BufferIndex         *)
    End;

    Function BufferEof(Br: PBuffer): Boolean;
    Begin
       With Br^ Do
       BufferEof:=(BufIndex>BufUsed) And (BufFPos=BufFSize);
    End;

    End.

[Back to FILES SWAG index] [Back to Main SWAG index] [Original]