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