Topspeed_JPI/TS/SRC/PACK.MOD

(*%T _fcall *) (*# call(near_call=>on,seg_name=>Btree) *) (*%E *)
IMPLEMENTATION MODULE Pack;
(*
        Copyright (C) 1990 Jensen & Partners International
*)



  IMPORT Btree, apack2;
(*%T _mthread *)
  IMPORT Process;
(*%E *)



  MODULE inline;

    EXPORT MemMove, MemFastMove, AddAddr, IncAddr, DecAddr;

    TYPE
      A2 = ARRAY[0..1] OF SHORTCARD;
      A3 = ARRAY[0..2] OF SHORTCARD;
      A6 = ARRAY[0..5] OF SHORTCARD;
      A8 = ARRAY[0..7] OF SHORTCARD;
      A19 = ARRAY[0..18] OF SHORTCARD;
      A21 = ARRAY[0..20] OF SHORTCARD;

(*%T _fptr *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(si,ax,di,es,cx),reg_saved=>(ax,bx,dx,ds,es,st1,st2,st3,st4,st5,st6)) *)
    PROCEDURE MemMove(s,r: ADDRESS; c: CARDINAL)=A21(0E3H,013H,(*   jcxz  $1     *)
                                                     09CH,     (*   pushf        *)
                                                     01EH,     (*   push  ds     *)
                                                     08EH,0D8H,(*   mov   ds,ax  *)
                                                     03BH,0FEH,(*   cmp   di,si  *)
                                                     072H,007H,(*   jb    $0     *)
                                                     003H,0F1H,(*   add   si,cx  *)
                                                     003H,0F9H,(*   add   di,cx  *)
                                                     04EH,     (*   dec   si     *)
                                                     04FH,     (*   dec   di     *)
                                                     0FDH,     (*   std          *)
                                                               (* $0:            *)
                                                     0F3H,0A4H,(*   rep   ;movsb *)
                                                     01FH,     (*   pop   ds     *)
                                                     09DH);    (*   popf         *)
                                                               (* $1:            *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(si,ax,di,es,cx),reg_saved=>(ax,bx,dx,ds,es,st1,st2,st3,st4,st5,st6)) *)
    PROCEDURE MemFastMove(s,r: ADDRESS; c: CARDINAL)=A8(0E3H,006H,(*   jcxz  $0     *)
                                                        01EH,     (*   push  ds     *)
                                                        08EH,0D8H,(*   mov   ds,ax  *)
                                                        0F3H,0A4H,(*   rep   ;movsb *)
                                                        01FH);    (*   pop   ds     *)
                                                                  (* $0:            *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(ax,dx,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
    PROCEDURE AddAddr(A: ADDRESS; I: CARDINAL): ADDRESS=A2(003H,0C1H);(*add ax,cx*)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
    PROCEDURE IncAddr(VAR a: ADDRESS; i: CARDINAL)=A3(026H,001H,007H); (* add es:[bx],cx *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
    PROCEDURE DecAddr(VAR a: ADDRESS; i: CARDINAL)=A3(026H,029H,007H); (* sub es:[bx],cx *)
(*# restore *)

(*%E *)

(*%F _fptr *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(si,di,cx),reg_saved=>(ax,bx,dx,ds,st1,st2,st3,st4,st5,st6)) *)
    PROCEDURE MemMove(s,r: ADDRESS; c: CARDINAL)=A19(0E3H,011H,(*  jcxz $1   *)
                                                     09CH,     (*  pushf     *)
                                                     01EH,     (*  push ds   *)
                                                     007H,     (*  pop es    *)
                                                     03BH,0FEH,(*  cmp di,si *)
                                                     072H,007H,(*  jb $0     *)
                                                     003H,0F1H,(*  add si,cx *)
                                                     003H,0F9H,(*  add di,cx *)
                                                     04EH,     (*  dec si    *)
                                                     04FH,     (*  dec di    *)
                                                     0FDH,     (*  std       *)
                                                               (* $0:        *)
                                                     0F3H,0A4H,(*  rep; movsb*)
                                                     09DH);    (*  popf      *)
                                                               (* $1:        *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(si,di,cx),reg_saved=>(ax,bx,dx,ds,st1,st2,st3,st4,st5,st6)) *)
    PROCEDURE MemFastMove(s,r: ADDRESS; c: CARDINAL)=A6(0E3H,004H,  (*  jcxz $0   *)
                                                        01EH,       (*  push ds   *)
                                                        007H,       (*  pop es    *)
                                                        0F3H,0A4H); (*  rep; movsb*)
                                                                    (* $0:        *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
    PROCEDURE AddAddr(A: ADDRESS; I: CARDINAL): ADDRESS=A2(003H,0C1H);(*add ax,cx*)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
    PROCEDURE IncAddr(VAR a: ADDRESS; i: CARDINAL)=A2(001H,007H); (* add [bx],cx *)
(*# restore *)

(*# save *)
(*# call(inline=>on) *)
(*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
    PROCEDURE DecAddr(VAR a: ADDRESS; i: CARDINAL)=A2(029H,007H); (* sub [bx],cx *)
(*# restore *)

(*%E *)

    END inline;



  TYPE
    PackBlk = RECORD
                _up,_p : CARDINAL;
              END;
    PackBlkPtr = POINTER TO PackBlk;



  PROCEDURE Packer(n: CARDINAL; in: ADDRESS; out: ADDRESS): CARDINAL;
    VAR
      ofs : CARDINAL;
    BEGIN
      ofs := Ofs(out^);
      WHILE n#0 DO
        IF n>apack2.buf_size THEN
          PackBlkPtr(out)^._up := apack2.buf_size;
        ELSE
          PackBlkPtr(out)^._up := n;
        END;
        (*%T _mthread *) Process.Lock(); (*%E *)
        PackBlkPtr(out)^._p := apack2.Pack(PackBlkPtr(out)^._up,in);
        (*%T _mthread *) Process.Unlock(); (*%E *)
        IF PackBlkPtr(out)^._up<=PackBlkPtr(out)^._p THEN
          PackBlkPtr(out)^._p := PackBlkPtr(out)^._up;
          MemFastMove(in,AddAddr(out,SIZE(PackBlk)),PackBlkPtr(out)^._p);
        ELSE
          MemFastMove(ADR(apack2.p),AddAddr(out,SIZE(PackBlk)),PackBlkPtr(out)^._p);
        END;
        DEC(n,PackBlkPtr(out)^._up);
        IncAddr(in,PackBlkPtr(out)^._up);
        IncAddr(out,SIZE(PackBlk)+PackBlkPtr(out)^._p);
      END;
      PackBlkPtr(out)^._up := 0;
      PackBlkPtr(out)^._p := 0;
      RETURN Ofs(out^)-ofs+SIZE(PackBlk);
    END Packer;



  PROCEDURE Unpacker(n: CARDINAL; in: ADDRESS; out: ADDRESS);
    BEGIN
      WHILE PackBlkPtr(in)^._p#0 DO
        IF PackBlkPtr(in)^._up=PackBlkPtr(in)^._p THEN
          MemFastMove(AddAddr(in,SIZE(PackBlk)),out,PackBlkPtr(in)^._up);
        ELSE
          MemFastMove(AddAddr(in,SIZE(PackBlk)),ADR(apack2.p),PackBlkPtr(in)^._p);
        (*%T _mthread *) Process.Lock(); (*%E *)
          apack2.Unpack(PackBlkPtr(in)^._up,out);
        (*%T _mthread *) Process.Unlock(); (*%E *)
        END;
        IncAddr(out,PackBlkPtr(in)^._up);
        IncAddr(in,SIZE(PackBlk)+PackBlkPtr(in)^._p);
      END;
    END Unpacker;



  PROCEDURE UnpackedSize(n: CARDINAL; in: ADDRESS): CARDINAL;
    VAR
      tmp : CARDINAL;
    BEGIN
      tmp := 0;
      WHILE PackBlkPtr(in)^._p#0 DO
        INC(tmp,PackBlkPtr(in)^._up);
        IncAddr(in,SIZE(PackBlk)+PackBlkPtr(in)^._p);
      END;
      RETURN tmp;
    END UnpackedSize;



  PROCEDURE Packing(): BOOLEAN;
    BEGIN
      RETURN TRUE;
    END Packing;



  PROCEDURE AdjustBlock(rs: CARDINAL): CARDINAL;
    BEGIN
      INC(rs,(rs+apack2.buf_size-1) DIV apack2.buf_size * SIZE(CARDINAL)*2);
      RETURN rs;
    END AdjustBlock;


  BEGIN
    Btree.Packer := Packer;
    Btree.Unpacker := Unpacker;
    Btree.UnpackedSize := UnpackedSize;
    Btree.Packing := Packing;
    Btree.AdjustBlock := AdjustBlock;
  END Pack.