Topspeed_JPI/TS-V3/SRC/PACK.LST

Listing:

    1  (*%T _fcall *) (*# call(near_call=>on,seg_name=>Btree) *) (*%E *)
    2  IMPLEMENTATION MODULE Pack;
    3  (*
    4          Copyright (C) 1990 Jensen & Partners International
    5  *)
    6  
    7  
    8  
    9    IMPORT Btree, apack2;
   10  (*%T _mthread *)
   11    IMPORT Process;
   12  (*%E *)
   13  
   14  
   15  
   16    MODULE inline;
   17  
   18      EXPORT MemMove, MemFastMove, AddAddr, IncAddr, DecAddr;
   19  
   20      TYPE
   21        A2 = ARRAY[0..1] OF SHORTCARD;
*****                      ^ not supported yet
*****                            ^ not supported yet
   22        A3 = ARRAY[0..2] OF SHORTCARD;
*****                      ^ not supported yet
*****                            ^ not supported yet
   23        A6 = ARRAY[0..5] OF SHORTCARD;
*****                      ^ not supported yet
*****                            ^ not supported yet
   24        A8 = ARRAY[0..7] OF SHORTCARD;
*****                      ^ not supported yet
*****                            ^ not supported yet
   25        A19 = ARRAY[0..18] OF SHORTCARD;
*****                       ^ not supported yet
*****                              ^ not supported yet
   26        A21 = ARRAY[0..20] OF SHORTCARD;
*****                       ^ not supported yet
*****                              ^ not supported yet
   27  
   28  (*%T _fptr *)
   29  
   30  (*# save *)
   31  (*# call(inline=>on) *)
   32  (*# call(reg_param=>(si,ax,di,es,cx),reg_saved=>(ax,bx,dx,ds,es,st1,st2,st3,st4,st5,st6)) *)
   33      PROCEDURE MemMove(s,r: ADDRESS; c: CARDINAL)=A21(0E3H,013H,(*   jcxz  $1     *)
*****                             ^ undeclared identifier
*****                                                   ^ not supported yet
   34                                                       09CH,     (*   pushf        *)
   35                                                       01EH,     (*   push  ds     *)
   36                                                       08EH,0D8H,(*   mov   ds,ax  *)
   37                                                       03BH,0FEH,(*   cmp   di,si  *)
   38                                                       072H,007H,(*   jb    $0     *)
   39                                                       003H,0F1H,(*   add   si,cx  *)
   40                                                       003H,0F9H,(*   add   di,cx  *)
   41                                                       04EH,     (*   dec   si     *)
   42                                                       04FH,     (*   dec   di     *)
   43                                                       0FDH,     (*   std          *)
   44                                                                 (* $0:            *)
   45                                                       0F3H,0A4H,(*   rep   ;movsb *)
   46                                                       01FH,     (*   pop   ds     *)
   47                                                       09DH);    (*   popf         *)
   48                                                                 (* $1:            *)
   49  (*# restore *)
   50  
   51  (*# save *)
   52  (*# call(inline=>on) *)
   53  (*# call(reg_param=>(si,ax,di,es,cx),reg_saved=>(ax,bx,dx,ds,es,st1,st2,st3,st4,st5,st6)) *)
   54      PROCEDURE MemFastMove(s,r: ADDRESS; c: CARDINAL)=A8(0E3H,006H,(*   jcxz  $0     *)
*****                                 ^ undeclared identifier
*****                                                       ^ not supported yet
   55                                                          01EH,     (*   push  ds     *)
   56                                                          08EH,0D8H,(*   mov   ds,ax  *)
   57                                                          0F3H,0A4H,(*   rep   ;movsb *)
   58                                                          01FH);    (*   pop   ds     *)
   59                                                                    (* $0:            *)
   60  (*# restore *)
   61  
   62  (*# save *)
   63  (*# call(inline=>on) *)
   64  (*# call(reg_param=>(ax,dx,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
   65      PROCEDURE AddAddr(A: ADDRESS; I: CARDINAL): ADDRESS=A2(003H,0C1H);(*add ax,cx*)
*****                           ^ undeclared identifier
*****                                                  ^ undeclared identifier
*****                                                          ^ not supported yet
   66  (*# restore *)
   67  
   68  (*# save *)
   69  (*# call(inline=>on) *)
   70  (*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
   71      PROCEDURE IncAddr(VAR a: ADDRESS; i: CARDINAL)=A3(026H,001H,007H); (* add es:[bx],cx *)
*****                               ^ undeclared identifier
*****                                                     ^ not supported yet
   72  (*# restore *)
   73  
   74  (*# save *)
   75  (*# call(inline=>on) *)
   76  (*# call(reg_param=>(bx,es,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
   77      PROCEDURE DecAddr(VAR a: ADDRESS; i: CARDINAL)=A3(026H,029H,007H); (* sub es:[bx],cx *)
*****                               ^ undeclared identifier
*****                                                     ^ not supported yet
   78  (*# restore *)
   79  
   80  (*%E *)
   81  
   82  (*%F _fptr *)
   83  
   84  (*# save *)
   85  (*# call(inline=>on) *)
   86  (*# call(reg_param=>(si,di,cx),reg_saved=>(ax,bx,dx,ds,st1,st2,st3,st4,st5,st6)) *)
   87      PROCEDURE MemMove(s,r: ADDRESS; c: CARDINAL)=A19(0E3H,011H,(*  jcxz $1   *)
   88                                                       09CH,     (*  pushf     *)
   89                                                       01EH,     (*  push ds   *)
   90                                                       007H,     (*  pop es    *)
   91                                                       03BH,0FEH,(*  cmp di,si *)
   92                                                       072H,007H,(*  jb $0     *)
   93                                                       003H,0F1H,(*  add si,cx *)
   94                                                       003H,0F9H,(*  add di,cx *)
   95                                                       04EH,     (*  dec si    *)
   96                                                       04FH,     (*  dec di    *)
   97                                                       0FDH,     (*  std       *)
   98                                                                 (* $0:        *)
   99                                                       0F3H,0A4H,(*  rep; movsb*)
  100                                                       09DH);    (*  popf      *)
  101                                                                 (* $1:        *)
  102  (*# restore *)
  103  
  104  (*# save *)
  105  (*# call(inline=>on) *)
  106  (*# call(reg_param=>(si,di,cx),reg_saved=>(ax,bx,dx,ds,st1,st2,st3,st4,st5,st6)) *)
  107      PROCEDURE MemFastMove(s,r: ADDRESS; c: CARDINAL)=A6(0E3H,004H,  (*  jcxz $0   *)
  108                                                          01EH,       (*  push ds   *)
  109                                                          007H,       (*  pop es    *)
  110                                                          0F3H,0A4H); (*  rep; movsb*)
  111                                                                      (* $0:        *)
  112  (*# restore *)
  113  
  114  (*# save *)
  115  (*# call(inline=>on) *)
  116  (*# call(reg_param=>(ax,cx),reg_saved=>(bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  117      PROCEDURE AddAddr(A: ADDRESS; I: CARDINAL): ADDRESS=A2(003H,0C1H);(*add ax,cx*)
  118  (*# restore *)
  119  
  120  (*# save *)
  121  (*# call(inline=>on) *)
  122  (*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  123      PROCEDURE IncAddr(VAR a: ADDRESS; i: CARDINAL)=A2(001H,007H); (* add [bx],cx *)
  124  (*# restore *)
  125  
  126  (*# save *)
  127  (*# call(inline=>on) *)
  128  (*# call(reg_param=>(bx,ax),reg_saved=>(ax,bx,cx,dx,si,di,ds,es,st1,st2,st3,st4,st5,st6)) *)
  129      PROCEDURE DecAddr(VAR a: ADDRESS; i: CARDINAL)=A2(029H,007H); (* sub [bx],cx *)
  130  (*# restore *)
  131  
  132  (*%E *)
  133  
  134      END inline;
*****          ^ not supported yet
  135  
  136  
  137  
  138    TYPE
  139      PackBlk = RECORD
  140                  _up,_p : CARDINAL;
  141                END;
*****                ^ not supported yet
  142      PackBlkPtr = POINTER TO PackBlk;
*****                              ^ not supported yet
  143  
  144  
  145  
  146    PROCEDURE Packer(n: CARDINAL; in: ADDRESS; out: ADDRESS): CARDINAL;
*****                                      ^ undeclared identifier
*****                                                    ^ undeclared identifier
  147      VAR
  148        ofs : CARDINAL;
  149      BEGIN
  150        ofs := Ofs(out^);
*****               ^ undeclared identifier
*****                   ^ not supported yet
  151        WHILE n#0 DO
  152          IF n>apack2.buf_size THEN
*****               ^ not supported yet
*****                      ^ not supported yet
  153            PackBlkPtr(out)^._up := apack2.buf_size;
*****                       ^ not supported yet
*****                             ^ not supported yet
*****                                    ^ not supported yet
*****                                           ^ not supported yet
  154          ELSE
  155            PackBlkPtr(out)^._up := n;
*****                       ^ not supported yet
*****                             ^ not supported yet
  156          END;
  157          (*%T _mthread *) Process.Lock(); (*%E *)
*****                           ^ not supported yet
*****                                   ^ not supported yet
*****                                        ^ not supported yet
  158          PackBlkPtr(out)^._p := apack2.Pack(PackBlkPtr(out)^._up,in);
*****                     ^ not supported yet
*****                           ^ not supported yet
*****                                 ^ not supported yet
*****                                        ^ not supported yet
*****                                                        ^ not supported yet
*****                                                              ^ not supported yet
*****                                                                  ^ not supported yet
  159          (*%T _mthread *) Process.Unlock(); (*%E *)
*****                           ^ not supported yet
*****                                   ^ not supported yet
*****                                          ^ not supported yet
  160          IF PackBlkPtr(out)^._up<=PackBlkPtr(out)^._p THEN
*****                        ^ not supported yet
*****                              ^ not supported yet
*****                                              ^ not supported yet
*****                                                    ^ not supported yet
  161            PackBlkPtr(out)^._p := PackBlkPtr(out)^._up;
*****                       ^ not supported yet
*****                             ^ not supported yet
*****                                              ^ not supported yet
*****                                                    ^ not supported yet
  162            MemFastMove(in,AddAddr(out,SIZE(PackBlk)),PackBlkPtr(out)^._p);
*****            ^ undeclared identifier
*****                        ^ not supported yet
*****                           ^ undeclared identifier
*****                                   ^ not supported yet
*****                                       ^ undeclared identifier
*****                                                   ^ not supported yet
*****                                                                 ^ not supported yet
*****                                                                       ^ not supported yet
  163          ELSE
  164            MemFastMove(ADR(apack2.p),AddAddr(out,SIZE(PackBlk)),PackBlkPtr(out)^._p);
*****            ^ undeclared identifier
*****                        ^ undeclared identifier
*****                            ^ not supported yet
*****                                   ^ not supported yet
*****                                      ^ undeclared identifier
*****                                              ^ not supported yet
*****                                                  ^ undeclared identifier
*****                                                              ^ not supported yet
*****                                                                            ^ not supported yet
*****                                                                                  ^ not supported yet
  165          END;
  166          DEC(n,PackBlkPtr(out)^._up);
*****          ^ undeclared identifier
*****                           ^ not supported yet
*****                                 ^ not supported yet
  167          IncAddr(in,PackBlkPtr(out)^._up);
*****          ^ undeclared identifier
*****                  ^ not supported yet
*****                                ^ not supported yet
*****                                      ^ not supported yet
  168          IncAddr(out,SIZE(PackBlk)+PackBlkPtr(out)^._p);
*****          ^ undeclared identifier
*****                  ^ not supported yet
*****                      ^ undeclared identifier
*****                                  ^ not supported yet
*****                                               ^ not supported yet
*****                                                     ^ not supported yet
  169        END;
  170        PackBlkPtr(out)^._up := 0;
*****                   ^ not supported yet
*****                         ^ not supported yet
  171        PackBlkPtr(out)^._p := 0;
*****                   ^ not supported yet
*****                         ^ not supported yet
  172        RETURN Ofs(out^)-ofs+SIZE(PackBlk);
*****               ^ undeclared identifier
*****                   ^ not supported yet
*****                             ^ undeclared identifier
*****                                         ^ not supported yet
  173      END Packer;
*****          ^ not supported yet
  174  
  175  
  176  
  177    PROCEDURE Unpacker(n: CARDINAL; in: ADDRESS; out: ADDRESS);
*****                                        ^ undeclared identifier
*****                                                      ^ undeclared identifier
  178      BEGIN
  179        WHILE PackBlkPtr(in)^._p#0 DO
*****                         ^ not supported yet
*****                              ^ not supported yet
  180          IF PackBlkPtr(in)^._up=PackBlkPtr(in)^._p THEN
*****                        ^ not supported yet
*****                             ^ not supported yet
*****                                            ^ not supported yet
*****                                                 ^ not supported yet
  181            MemFastMove(AddAddr(in,SIZE(PackBlk)),out,PackBlkPtr(in)^._up);
*****            ^ undeclared identifier
*****                        ^ undeclared identifier
*****                                ^ not supported yet
*****                                   ^ undeclared identifier
*****                                               ^ not supported yet
*****                                                  ^ not supported yet
*****                                                                 ^ not supported yet
*****                                                                      ^ not supported yet
  182          ELSE
  183            MemFastMove(AddAddr(in,SIZE(PackBlk)),ADR(apack2.p),PackBlkPtr(in)^._p);
*****            ^ undeclared identifier
*****                        ^ undeclared identifier
*****                                ^ not supported yet
*****                                   ^ undeclared identifier
*****                                               ^ not supported yet
*****                                                  ^ undeclared identifier
*****                                                      ^ not supported yet
*****                                                             ^ not supported yet
*****                                                                           ^ not supported yet
*****                                                                                ^ not supported yet
  184          (*%T _mthread *) Process.Lock(); (*%E *)
*****                           ^ not supported yet
*****                                   ^ not supported yet
*****                                        ^ not supported yet
  185            apack2.Unpack(PackBlkPtr(in)^._up,out);
*****            ^ not supported yet
*****                   ^ not supported yet
*****                                     ^ not supported yet
*****                                          ^ not supported yet
*****                                              ^ not supported yet
  186          (*%T _mthread *) Process.Unlock(); (*%E *)
*****                           ^ not supported yet
*****                                   ^ not supported yet
*****                                          ^ not supported yet
  187          END;
  188          IncAddr(out,PackBlkPtr(in)^._up);
*****          ^ undeclared identifier
*****                  ^ not supported yet
*****                                 ^ not supported yet
*****                                      ^ not supported yet
  189          IncAddr(in,SIZE(PackBlk)+PackBlkPtr(in)^._p);
*****          ^ undeclared identifier
*****                  ^ not supported yet
*****                     ^ undeclared identifier
*****                                 ^ not supported yet
*****                                              ^ not supported yet
*****                                                   ^ not supported yet
  190        END;
  191      END Unpacker;
*****          ^ not supported yet
  192  
  193  
  194  
  195    PROCEDURE UnpackedSize(n: CARDINAL; in: ADDRESS): CARDINAL;
*****                                            ^ undeclared identifier
  196      VAR
  197        tmp : CARDINAL;
  198      BEGIN
  199        tmp := 0;
  200        WHILE PackBlkPtr(in)^._p#0 DO
*****                         ^ not supported yet
*****                              ^ not supported yet
  201          INC(tmp,PackBlkPtr(in)^._up);
*****          ^ undeclared identifier
*****                             ^ not supported yet
*****                                  ^ not supported yet
  202          IncAddr(in,SIZE(PackBlk)+PackBlkPtr(in)^._p);
*****          ^ undeclared identifier
*****                  ^ not supported yet
*****                     ^ undeclared identifier
*****                                 ^ not supported yet
*****                                              ^ not supported yet
*****                                                   ^ not supported yet
  203        END;
  204        RETURN tmp;
  205      END UnpackedSize;
*****          ^ not supported yet
  206  
  207  
  208  
  209    PROCEDURE Packing(): BOOLEAN;
  210      BEGIN
  211        RETURN TRUE;
  212      END Packing;
*****          ^ not supported yet
  213  
  214  
  215  
  216    PROCEDURE AdjustBlock(rs: CARDINAL): CARDINAL;
  217      BEGIN
  218        INC(rs,(rs+apack2.buf_size-1) DIV apack2.buf_size * SIZE(CARDINAL)*2);
*****        ^ undeclared identifier
*****                   ^ not supported yet
*****                          ^ not supported yet
*****                                          ^ not supported yet
*****                                                 ^ not supported yet
*****                                                            ^ undeclared identifier
*****                                                                         ^ not supported yet
*****                                                                            ^ not supported yet
  219        RETURN rs;
  220      END AdjustBlock;
*****          ^ not supported yet
  221  
  222  
  223    BEGIN
  224      Btree.Packer := Packer;
*****      ^ not supported yet
*****            ^ not supported yet
*****                      ^ not supported yet
  225      Btree.Unpacker := Unpacker;
*****      ^ not supported yet
*****            ^ not supported yet
*****                        ^ not supported yet
  226      Btree.UnpackedSize := UnpackedSize;
*****      ^ not supported yet
*****            ^ not supported yet
*****                            ^ not supported yet
  227      Btree.Packing := Packing;
*****      ^ not supported yet
*****            ^ not supported yet
*****                       ^ not supported yet
  228      Btree.AdjustBlock := AdjustBlock;
*****      ^ not supported yet
*****            ^ not supported yet
*****                           ^ not supported yet
  229    END Pack.
*****        ^ not supported yet

  186 errors