Listing: 1 (*# call(o_a_size=>off) *) 2 (*# call(o_a_copy=>off) *) 3 (*# call(near_call=>on) *) 4 IMPLEMENTATION MODULE FIOx; 5 (* 6 Copyright (C) 1988,1989,1990 Jensen & Partners International 7 *) 8 9 10 IMPORT FIO; 11 (*%T _OS2 *) IMPORT Dos; (*%E*) 12 (*%F _OS2 *) IMPORT Lib, SYSTEM, Str (*%T _mthread *),Process (*%E *); (*%E*) 13 14 VAR 15 _multi_mode : MultiMode; ***** ^ undeclared identifier 16 LocalError : CARDINAL; 17 18 (*************************) 19 (****** DOS Section ******) 20 (*************************) 21 (*%F _OS2 *) 22 23 VAR 24 DosVerMaj, 25 DosVerMin : SHORTCARD; 26 27 28 PROCEDURE FileLocks(f: File; VAR unlock,lock: LockRec): CARDINAL; 29 VAR 30 regs : SYSTEM.Registers; 31 tmp : POINTER TO LockRec; 32 mode : SHORTCARD; 33 BEGIN 34 mode := 1; 35 tmp := SYSTEM.ADR(unlock); 36 LOOP 37 IF tmp#NIL THEN 38 WITH regs DO 39 AH := 5CH; 40 AL := mode; 41 BX := f; 42 CX := CARDINAL(tmp^.pos DIV 65536); 43 DX := CARDINAL(tmp^.pos MOD 65536); 44 SI := CARDINAL(tmp^.len DIV 65536); 45 DI := CARDINAL(tmp^.len MOD 65536); 46 END; 47 (*%T _mthread *) Process.Lock(); (*%E *) 48 Lib.Dos(regs); 49 (*%T _mthread *) Process.Unlock(); (*%E *) 50 IF SYSTEM.CarryFlag IN regs.Flags THEN 51 RETURN regs.AX; 52 END; 53 END; 54 IF mode=0 THEN 55 EXIT; 56 END; 57 tmp := SYSTEM.ADR(lock); 58 DEC(mode); 59 END; 60 RETURN NO_ERROR; 61 END FileLocks; 62 63 64 PROCEDURE Multi(): MultiMode; 65 BEGIN 66 RETURN _multi_mode; 67 END Multi; 68 69 70 PROCEDURE MultiFile(f: File): BOOLEAN; 71 VAR 72 regs : SYSTEM.Registers; 73 BEGIN 74 IF _multi_mode=_multi_file THEN 75 WITH regs DO 76 AH := 44H; 77 AL := 0AH; 78 BX := f; 79 Lib.Dos(regs); 80 RETURN NOT (SYSTEM.CarryFlag IN Flags) AND (15 IN BITSET(DX)); 81 END; 82 ELSE 83 RETURN _multi_mode=_multi_yes; 84 END; 85 END MultiFile; 86 87 88 89 90 (*# save *) 91 (*%T _fcall *) (*# call(near_call=>off) *) (*%E *) 92 PROCEDURE DelayDefault(); 93 BEGIN 94 (*%T _mthread *) Process.Delay(DelayDefaultValue DIV 50); (*%E *) 95 (*%F _mthread *) Lib.Delay(DelayDefaultValue); (*%E *) 96 END DelayDefault; 97 (*# restore *) 98 99 100 PROCEDURE Init; 101 VAR 102 regs : SYSTEM.Registers; 103 str : ARRAY[0..5] OF CHAR; 104 BEGIN 105 _multi_mode := _multi_file; 106 WITH regs DO 107 AH := 30H; 108 Lib.Dos(regs); 109 DosVerMaj := AL; 110 DosVerMin := AH; 111 Lib.EnvironmentFind('multi',str); 112 Str.Caps(str); 113 IF Str.Compare(str,'YES')=0 THEN 114 _multi_mode := _multi_yes; 115 ELSIF Str.Compare(str,'NO')=0 THEN 116 _multi_mode := _multi_no; 117 ELSIF DosVerMaj >= 3 THEN 118 AH := 10H; 119 AL := 0; 120 Lib.Intr(regs,2FH); 121 IF AL=0FFH THEN 122 _multi_mode := _multi_yes; 123 END; 124 END; 125 END; 126 END Init; 127 128 129 (*%E *) 130 (**************************) 131 (****** OS/2 Section ******) 132 (**************************) 133 (*%T _OS2 *) 134 135 136 137 PROCEDURE Multi(): MultiMode; ***** ^ undeclared identifier 138 BEGIN 139 RETURN _multi_yes; ***** ^ undeclared identifier 140 END Multi; ***** ^ not supported yet 141 142 143 PROCEDURE MultiFile(f: File): BOOLEAN; ***** ^ undeclared identifier 144 BEGIN 145 RETURN TRUE; 146 END MultiFile; ***** ^ not supported yet 147 148 149 150 151 (*%F _fptr *) 152 (*# save *) 153 (*# call(inline=>on) *) 154 (*# call(reg_param=>(cx)) *) 155 (*# call(reg_return=>(cx,dx)) *) 156 (*# call(reg_saved=>(ax,bx,cx,si,di,ds,es,st1,st2)) *) 157 (*# data(near_ptr=>off) *) 158 TYPE 159 A6 = ARRAY[0..5] OF SHORTCARD; 160 LR_PTR = POINTER TO Dos.LOCKRANGE; 161 PROCEDURE LR_ptr(a: NearADDRESS): LR_PTR=A6(033H,0D2H, (* xor dx,dx *) 162 0E3H,002H, (* jcxz $0 *) 163 08CH,0DAH);(* mov dx,ds *) 164 (* $0: *) 165 (*# restore *) 166 (*%E *) 167 168 169 PROCEDURE FileLocks(f: File; VAR unlock,lock: LockRec): CARDINAL; ***** ^ undeclared identifier ***** ^ undeclared identifier 170 BEGIN 171 (*%T _fptr *) 172 RETURN Dos.FileLocks(f,Dos.LOCKRANGE(unlock),Dos.LOCKRANGE(lock)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 173 (*%E *) 174 (*%F _fptr *) 175 RETURN Dos.FileLocks(f,LR_ptr(ADR(unlock))^,LR_ptr(ADR(lock))^); 176 (*%E *) 177 END FileLocks; ***** ^ not supported yet 178 179 180 (*# save *) 181 (*%T _fcall *) (*# call(near_call=>off) *) (*%E *) 182 PROCEDURE DelayDefault(); 183 BEGIN 184 Dos.Sleep(DelayDefaultValue); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 185 END DelayDefault; ***** ^ not supported yet 186 (*# restore *) 187 188 189 PROCEDURE Init(); 190 BEGIN 191 END Init; ***** ^ not supported yet 192 193 194 (*%E *) 195 (****************************) 196 (****** Common Section ******) 197 (****************************) 198 199 PROCEDURE Open(Name: ARRAY OF CHAR; Share,ReadOnly,Create: BOOLEAN): File; ***** ^ not supported yet ***** ^ undeclared identifier 200 TYPE 201 Mn = ARRAY BOOLEAN OF BITSET; ***** ^ not supported yet ***** ^ undeclared identifier 202 Mj = ARRAY BOOLEAN OF Mn; ***** ^ not supported yet ***** ^ not supported yet 203 ST = ARRAY[0..64] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 204 CONST 205 m_Std = {}; ***** ^ not supported yet 206 m_ReadWrite = {1}; ***** ^ not supported yet 207 m_ReadOnly = {}; ***** ^ not supported yet 208 m_DenyAll = {4}; ***** ^ not supported yet 209 m_DenyWrite = {5}; ***** ^ not supported yet 210 m_DenyNone = {6}; ***** ^ not supported yet 211 M = Mj(Mn((m_Std+m_ReadWrite+m_DenyAll), 212 (m_Std+m_ReadWrite+m_DenyNone)), ***** ^ not supported yet 213 Mn((m_Std+m_ReadOnly +m_DenyAll), 214 (m_Std+m_ReadOnly +m_DenyWrite))); ***** ^ not supported yet 215 m_Test = (m_Std+m_ReadOnly+m_DenyNone); 216 VAR 217 multi : BOOLEAN; 218 h : File; ***** ^ undeclared identifier 219 savesharemode : BITSET; ***** ^ undeclared identifier 220 BEGIN 221 IF Create AND (ReadOnly OR Share) THEN 222 RETURN MAX(CARDINAL); ***** ^ undeclared identifier ***** ^ not supported yet 223 END; 224 (*%T _mthread *) (*%F _OS2*) Process.Lock(); (*%E*) (*%E *) 225 IF Create THEN 226 h := FIO.Create(ST(Name)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 227 ELSE 228 savesharemode := FIO.ShareMode; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 229 IF Share AND (_multi_mode=_multi_file) THEN ***** ^ not supported yet ***** ^ undeclared identifier 230 FIO.ShareMode := m_Test; ***** ^ not supported yet ***** ^ not supported yet 231 h := FIO.OpenRead(ST(Name)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 232 multi := MultiFile(h); ***** ^ not supported yet ***** ^ not supported yet 233 FIO.Close(h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 234 ELSE 235 multi := _multi_mode=_multi_yes; ***** ^ not supported yet ***** ^ undeclared identifier 236 END; 237 FIO.ShareMode := M[ReadOnly,Share AND multi]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 238 h := FIO.OpenRead(ST(Name)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 239 FIO.ShareMode := savesharemode; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 240 END; 241 (*%T _mthread *) (*%F _OS2*) Process.Unlock(); (*%E *) (*%E*) 242 RETURN h; ***** ^ not supported yet 243 END Open; ***** ^ not supported yet 244 245 246 PROCEDURE Truncate(f: File; l: LONGCARD); ***** ^ undeclared identifier ***** ^ undeclared identifier 247 VAR 248 s : LONGCARD; ***** ^ undeclared identifier 249 BEGIN 250 s := Size(f); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 251 IF FIO.IOresult()=0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 252 IF s0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 257 LocalError := FIO.IOresult(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 258 IF (Size(f)#s) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 259 Truncate(f,s); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 260 END; 261 END; 262 END; 263 ELSIF s>l THEN ***** ^ not supported yet ***** ^ not supported yet 264 Seek(f,l); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 265 FIO.Truncate(f); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 266 END; 267 END; 268 END Truncate; ***** ^ not supported yet 269 270 271 272 CONST 273 Locking = _mthread AND NOT _OS2; ***** ^ undeclared identifier ***** ^ undeclared identifier 274 275 276 (*# save *) 277 (*# call(result_optional=>on) *) 278 PROCEDURE Common(f: File; x: LockRec; l: BOOLEAN): BOOLEAN; ***** ^ undeclared identifier ***** ^ undeclared identifier 279 VAR 280 cnt, 281 res : CARDINAL; 282 BEGIN 283 cnt := RetryCount(); ***** ^ undeclared identifier ***** ^ not supported yet 284 LOOP 285 IF l THEN 286 res := FileLocks(f,NULL^,x); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 287 ELSE 288 res := FileLocks(f,x,NULL^); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 289 END; 290 IF (res=NO_ERROR) OR (cnt=0) OR NOT l THEN ***** ^ undeclared identifier 291 EXIT; 292 END; 293 DEC(cnt); ***** ^ undeclared identifier ***** ^ not supported yet 294 Delay(); ***** ^ undeclared identifier ***** ^ not supported yet 295 END; 296 RETURN res=NO_ERROR; ***** ^ undeclared identifier 297 END Common; ***** ^ not supported yet 298 (*# restore *) 299 300 301 PROCEDURE Lock(f: File; x: LockRec): BOOLEAN; ***** ^ undeclared identifier ***** ^ undeclared identifier 302 BEGIN 303 RETURN Common(f,x,TRUE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 304 END Lock; ***** ^ not supported yet 305 306 307 PROCEDURE UnLock(f: File; x: LockRec); ***** ^ undeclared identifier ***** ^ undeclared identifier 308 BEGIN 309 Common(f,x,FALSE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 310 END UnLock; ***** ^ not supported yet 311 312 313 (*# save *) 314 (*# call(o_a_size=>on) *) 315 (*# call(o_a_copy=>off) *) 316 (*# call(result_optional=>on) *) 317 PROCEDURE RangeCommon(f: File; x: ARRAY OF LockRec; lock: BOOLEAN): BOOLEAN; ***** ^ undeclared identifier ***** ^ undeclared identifier 318 VAR 319 i, 320 j : CARDINAL; 321 res : BOOLEAN; 322 BEGIN 323 res := TRUE; 324 i := 0; 325 LOOP 326 IF NOT res OR (i>HIGH(x)) OR (x[i].pos=MAX(LONGCARD)) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 327 EXIT; 328 END; 329 res := Common(f,x[i],lock); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 330 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 331 END; 332 IF NOT res AND (i>1) THEN 333 DEC(i); ***** ^ undeclared identifier ***** ^ not supported yet 334 LOOP 335 DEC(i); ***** ^ undeclared identifier ***** ^ not supported yet 336 Common(f,x[i],NOT lock); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 337 IF i = 0 THEN 338 EXIT; 339 END; 340 END; 341 END; 342 RETURN res; 343 END RangeCommon; ***** ^ not supported yet 344 (*# restore *) 345 346 347 (*# save *) 348 (*# call(o_a_size=>on) *) 349 (*# call(o_a_copy=>off) *) 350 PROCEDURE LockRange(f: File; x: ARRAY OF LockRec): BOOLEAN; ***** ^ undeclared identifier ***** ^ undeclared identifier 351 BEGIN 352 RETURN RangeCommon(f,x,TRUE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 353 END LockRange; ***** ^ not supported yet 354 (*# restore *) 355 356 357 (*# save *) 358 (*# call(o_a_size=>on) *) 359 (*# call(o_a_copy=>off) *) 360 PROCEDURE UnLockRange(f: File; x: ARRAY OF LockRec); ***** ^ undeclared identifier ***** ^ undeclared identifier 361 BEGIN 362 RangeCommon(f,x,FALSE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 363 END UnLockRange; ***** ^ not supported yet 364 (*# restore *) 365 366 PROCEDURE Error(): CARDINAL; 367 VAR res : CARDINAL; 368 BEGIN 369 IF LocalError<>0 THEN 370 LocalError := 0; 371 ELSE 372 res := FIO.IOresult(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 373 END; 374 RETURN res; 375 END Error; ***** ^ not supported yet 376 377 378 (*# save *) 379 (*%T _fcall *) (*# call(near_call=>off) *) (*%E *) 380 PROCEDURE RetryCountDefault() : CARDINAL; 381 BEGIN 382 RETURN RetryCountDefaultValue; ***** ^ undeclared identifier 383 END RetryCountDefault; ***** ^ not supported yet 384 (*# restore *) 385 386 PROCEDURE Read(f: File; VAR b: ARRAY OF BYTE; c: CARDINAL); ***** ^ undeclared identifier ***** ^ undeclared identifier 387 VAR p : ADDRESS; ***** ^ undeclared identifier 388 BEGIN 389 p := ADR(b); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 390 IF FIO.RdBin(f,p^,c)<>c THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 391 LocalError := PAST_EOF; ***** ^ undeclared identifier 392 END; 393 END Read; ***** ^ not supported yet 394 395 PROCEDURE Write(f: File; b: ARRAY OF BYTE; c: CARDINAL); ***** ^ undeclared identifier ***** ^ undeclared identifier 396 VAR p : ADDRESS; ***** ^ undeclared identifier 397 BEGIN 398 p := ADR(b); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 399 FIO.WrBin(f,p^,c); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 400 IF FIO.IOresult()=FIO.DiskFull THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 401 LocalError := PAST_EOF; ***** ^ undeclared identifier 402 END; 403 END Write; ***** ^ not supported yet 404 405 406 BEGIN 407 _multi_mode := _multi_yes; ***** ^ not supported yet ***** ^ undeclared identifier 408 LocalError := 0; 409 RetryCount := RetryCountDefault; ***** ^ undeclared identifier ***** ^ not supported yet 410 Delay := DelayDefault; ***** ^ undeclared identifier ***** ^ not supported yet 411 Init(); ***** ^ not supported yet ***** ^ not supported yet 412 END FIOx. ***** ^ not supported yet 240 errors