Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * FILESYST.MOD - File utilities * 5 * * 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 (*# call(o_a_copy=>off) *) 12 13 (*%F _fdata *) 14 (*# call(seg_name => null) *) 15 (*%E *) 16 17 (*# data(seg_name => null) *) 18 (*# check(stack=>off, 19 index=>off, 20 range=>off, 21 overflow=>off, 22 nil_ptr=>off) *) 23 24 IMPLEMENTATION MODULE FileSystem; 25 26 IMPORT Str, Storage, CoreIO; 27 28 VAR 29 LastTempExt: ARRAY [0..8] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 30 31 32 PROCEDURE GetTempFileName(VAR Name: FileNameType): BOOLEAN; ***** ^ undeclared identifier 33 34 VAR 35 n, p: INTEGER; 36 BEGIN 37 n:=Str.Length(Name)-8; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 38 IF n < 0 THEN 39 RETURN FALSE; 40 END; 41 p:=0; 42 WHILE p < 8 DO (* append previous extension *) 43 Name[n]:=LastTempExt[p]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 44 INC(p); ***** ^ undeclared identifier ***** ^ not supported yet 45 INC(n); ***** ^ undeclared identifier ***** ^ not supported yet 46 END; 47 DEC(n, 5); ***** ^ undeclared identifier ***** ^ not supported yet 48 p:=3; (* if yes increment counters *) 49 REPEAT 50 LOOP 51 IF Name[n] < '9' THEN ***** ^ not supported yet ***** ^ not supported yet 52 INC(Name[n]); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 53 INC(LastTempExt[p]); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 54 EXIT; 55 END; 56 IF p >= 0 THEN 57 Name[n]:='0'; ***** ^ not supported yet ***** ^ not supported yet 58 DEC(n); ***** ^ undeclared identifier ***** ^ not supported yet 59 LastTempExt[p]:='0'; ***** ^ not supported yet ***** ^ not supported yet 60 DEC(p); ***** ^ undeclared identifier ***** ^ not supported yet 61 ELSE 62 RETURN FALSE; 63 END; 64 END; 65 UNTIL NOT FIO.Exists(Name); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 66 RETURN TRUE; 67 END GetTempFileName; ***** ^ not supported yet 68 69 PROCEDURE SetErrorType(VAR f: File); ***** ^ undeclared identifier 70 71 BEGIN 72 CASE FIO.IOresult() OF ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 73 | 0 : 74 f.res:=done; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 75 | 1 : 76 f.res:=callerror; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 77 | 2 : 78 f.res:=unknownfile; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 79 | 3 : 80 f.res:=unknownpath; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 81 | 4 : 82 f.res:=toomanyfiles; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 83 | 5 : 84 f.res:=softprotected; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 85 | 15 : 86 f.res:=unknownmedium; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 87 | 19 : 88 f.res:=hardprotected; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 89 ELSE 90 f.res:=notdone; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 91 END; 92 END SetErrorType; ***** ^ not supported yet 93 94 95 PROCEDURE Create(VAR f: File; Device: ARRAY OF CHAR); ***** ^ undeclared identifier ***** ^ not supported yet 96 97 BEGIN 98 f.flags:=FlagSet{}; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 99 f.eof:=FALSE; 100 f.fileno:=MAX(CARDINAL); 101 Str.Copy(f.name, Device); 102 Str.Append(f.name, '\'); 103 Str.Append(f.name, 'FSYSXXXX.XXX'); 104 IF GetTempFileName(f.name) = FALSE THEN 105 f.res:=toomanyfiles; 106 RETURN; 107 END; 108 f.fileno:=FIO.Create(f.name); 109 IF f.fileno = MAX(CARDINAL) THEN 110 SetErrorType(f); 111 RETURN; 112 END; 113 Storage.ALLOCATE(f.buffer, BufferSize); 114 FIO.AssignBuffer(f.fileno, f.buffer^); 115 INCL(f.flags, tf); 116 f.res:=done; 117 RETURN; 118 END Create; 119 120 PROCEDURE Close(VAR f: File); 121 122 BEGIN 123 FIO.Close(f.fileno); 124 Storage.DEALLOCATE(f.buffer, BufferSize); 125 IF tf IN f.flags THEN 126 FIO.Erase(f.name); 127 END; 128 f.flags:=FlagSet{}; 129 f.fileno:=MAX(CARDINAL); 130 f.res:=done; 131 END Close; 132 133 PROCEDURE Lookup(VAR f: File; Filename: ARRAY OF CHAR; New: BOOLEAN); 134 135 VAR 136 OK: BOOLEAN; 137 BEGIN 138 f.flags:=FlagSet{}; 139 f.eof:=FALSE; 140 f.fileno:=MAX(CARDINAL); 141 OK:=TRUE; 142 Str.Copy(f.name, Filename); 143 IF FIO.Exists(f.name) THEN 144 f.fileno:=FIO.Open(f.name); 145 IF f.fileno = MAX(CARDINAL) THEN 146 OK:=FALSE; 147 END; 148 ELSIF New THEN 149 f.fileno:=FIO.Create(f.name); 150 IF f.fileno = MAX(CARDINAL) THEN 151 OK:=FALSE; 152 END; 153 ELSE 154 OK:=FALSE; 155 END; 156 IF NOT OK THEN 157 f.res:=notdone; 158 RETURN; 159 END; 160 Storage.ALLOCATE(f.buffer, BufferSize); 161 FIO.AssignBuffer(f.fileno, f.buffer^); 162 f.res:=done; 163 RETURN; 164 END Lookup; 165 166 PROCEDURE Rename(VAR f: File; Filename: ARRAY OF CHAR); 167 168 VAR 169 NewName: FileNameType; 170 BEGIN 171 EXCL(f.flags, tf); 172 Close(f); 173 IF Filename[0] = CHAR(0) THEN 174 Str.Copy(NewName, '\'); 175 Str.Append(NewName, 'FSYSXXXX.XXX'); 176 IF GetTempFileName(NewName) = FALSE THEN 177 f.res:=toomanyfiles; 178 RETURN; 179 END; 180 FIO.Rename(f.name, NewName); 181 Lookup(f, NewName, FALSE); 182 IF f.res # done THEN RETURN END; 183 INCL(f.flags, tf); 184 ELSE 185 FIO.Rename(f.name, Filename); 186 Lookup(f, Filename, FALSE); 187 IF f.res # done THEN RETURN END; 188 END; 189 f.res:=done; 190 END Rename; 191 192 PROCEDURE SetRead(VAR f: File); 193 194 VAR 195 CurrentPos: LONGCARD; 196 BEGIN 197 CurrentPos:=FIO.GetPos(f.fileno); 198 FIO.Seek(f.fileno, CurrentPos); 199 f.flags:= f.flags - FlagSet{wr, mo}; 200 INCL(f.flags, rd); 201 f.res:=done; 202 END SetRead; 203 204 PROCEDURE SetWrite(VAR f: File); 205 206 VAR 207 CurrentPos: LONGCARD; 208 BEGIN 209 CurrentPos:=FIO.GetPos(f.fileno); 210 FIO.Seek(f.fileno, CurrentPos); 211 f.flags:=f.flags - FlagSet{rd ,mo}; 212 f.flags:=f.flags + FlagSet{pi, wr}; 213 f.res:=done; 214 END SetWrite; 215 216 PROCEDURE SetModify(VAR f: File); 217 218 VAR 219 CurrentPos: LONGCARD; 220 BEGIN 221 CurrentPos:=FIO.GetPos(f.fileno); 222 FIO.Seek(f.fileno, CurrentPos); 223 f.flags:=f.flags - FlagSet{rd, wr}; 224 INCL(f.flags, mo); 225 f.res:=done; 226 END SetModify; 227 228 PROCEDURE SetOpen(VAR f: File); 229 230 VAR 231 CurrentPos: LONGCARD; 232 BEGIN 233 CurrentPos:=FIO.GetPos(f.fileno); 234 FIO.Seek(f.fileno, CurrentPos); 235 f.flags:=f.flags - FlagSet{rd, mo, wr}; 236 f.res:=done; 237 END SetOpen; 238 239 PROCEDURE FillBuffer(f: File); 240 241 VAR 242 F: FIO.FileInf; 243 NumRead: INTEGER; 244 BEGIN 245 F:=FIO.GetStreamPointer(f.fileno); 246 WITH F^ DO 247 IF (Flag = {}) OR ((Flag * (CoreIO._F_ERR + CoreIO._F_OUT)) # {}) THEN 248 f.res:=callerror; 249 RETURN 250 END; 251 IF (Flag >= CoreIO._F_EOF) THEN 252 f.eof:=TRUE; 253 f.res:=notdone; 254 RETURN; 255 END; 256 IF (Flag >= CoreIO._F_RST) THEN 257 Flag := Flag - CoreIO._F_RST; 258 END; 259 NumRead := CoreIO.read(Handle, Base, Size); 260 Ptr := Base; 261 IF (NumRead = -1) AND (NumRead # Size) THEN 262 Flag := Flag + CoreIO._F_ERR; 263 Cnt := 0; 264 f.res:=notdone; 265 RETURN; 266 END; 267 Cnt := NumRead; (* reset pointers *) 268 Flag := Flag + CoreIO._F_IN; (* set input flag *) 269 IF NumRead = 0 THEN 270 Flag := Flag + CoreIO._F_EOF; (* end of file *) 271 f.eof:=TRUE; 272 f.res:=notdone; 273 RETURN; 274 END; 275 f.res:=done; 276 RETURN; 277 END; 278 END FillBuffer; 279 280 PROCEDURE Doio(VAR f: File); 281 282 VAR 283 CurPos: LONGCARD; 284 BEGIN 285 IF (rd IN f.flags) THEN 286 CurPos:=FIO.GetPos(f.fileno); 287 FIO.Seek(f.fileno, CurPos); 288 FillBuffer(f); 289 ELSIF (wr IN f.flags) THEN 290 FIO.Flush(f.fileno); 291 ELSIF (mo IN f.flags) THEN 292 FIO.Flush(f.fileno); 293 FillBuffer(f); 294 ELSE 295 f.res:=done; 296 END; 297 298 299 END Doio; 300 301 302 PROCEDURE SetPos(VAR f: File; HighPos, LowPos: CARDINAL); 303 304 VAR 305 Pos: LONGCARD; 306 BEGIN 307 Pos:=LONGCARD(LowPos)+LONGCARD(HighPos)<<16; 308 FIO.Seek(f.fileno, Pos); 309 INCL(f.flags, pi); 310 f.res:=done; 311 END SetPos; 312 313 314 PROCEDURE GetPos(VAR f: File; VAR HighPos, LowPos: CARDINAL); 315 316 VAR 317 Pos: LONGCARD; 318 BEGIN 319 Pos:=FIO.GetPos(f.fileno); 320 IF Pos = MAX(LONGCARD) THEN 321 SetErrorType(f); 322 RETURN; 323 END; 324 LowPos:=CARDINAL(Pos); 325 HighPos:=CARDINAL(Pos>>16); 326 f.res:=done; 327 END GetPos; 328 329 330 PROCEDURE Length(VAR f: File; VAR HighPos, LowPos: CARDINAL); 331 332 VAR 333 Len: LONGCARD; 334 BEGIN 335 Len:=FIO.Size(f.fileno); 336 IF Len = MAX(LONGCARD) THEN 337 SetErrorType(f); 338 RETURN; 339 END; 340 LowPos:=CARDINAL(Len); 341 HighPos:=CARDINAL(Len>>16); 342 f.res:=done; 343 RETURN; 344 END Length; 345 346 347 PROCEDURE Reset(VAR f: File); 348 349 BEGIN 350 SetPos(f, 0, 0); 351 f.flags:=f.flags - FlagSet{rd, mo, wr}; 352 f.eof:=FALSE; 353 f.res:=done; 354 END Reset; 355 356 357 PROCEDURE Again(VAR f: File); 358 359 BEGIN 360 IF f.flags * FlagSet{mo, rd} # FlagSet{} THEN 361 INCL(f.flags, ag); 362 f.res:=done; 363 ELSE 364 f.res:=callerror; 365 END; 366 RETURN; 367 END Again; 368 369 370 PROCEDURE ReadWord(VAR f: File; VAR w: WORD); 371 372 BEGIN 373 IF wr IN f.flags THEN 374 f.res:=callerror; 375 RETURN; 376 ELSIF f.flags * FlagSet{mo, rd} = FlagSet{} THEN 377 INCL(f.flags, rd); 378 END; 379 FIO.EOF:=FALSE; 380 IF ag IN f.flags THEN 381 EXCL(f.flags, ag); 382 w:=f.again; 383 f.res:=done; 384 RETURN; 385 END; 386 IF FIO.RdBin(f.fileno, w, SIZE(WORD)) # SIZE(WORD) THEN 387 SetErrorType(f); 388 f.eof:=FIO.EOF; 389 ELSE 390 f.again:=w; 391 f.res:=done; 392 END; 393 RETURN; 394 END ReadWord; 395 396 397 PROCEDURE WriteWord(VAR f: File; w: WORD); 398 399 BEGIN 400 IF rd IN f.flags THEN 401 f.res:=callerror; 402 RETURN; 403 ELSIF f.flags * FlagSet{mo, wr} = FlagSet{} THEN 404 INCL(f.flags, wr); 405 END; 406 FIO.WrBin(f.fileno, w, SIZE(WORD)); 407 f.res:=done; 408 RETURN; 409 END WriteWord; 410 411 PROCEDURE ReadChar(VAR f: File; VAR ch: CHAR); 412 413 BEGIN 414 IF wr IN f.flags THEN 415 f.res:=callerror; 416 RETURN; 417 ELSIF f.flags * FlagSet{mo, rd} = FlagSet{} THEN 418 INCL(f.flags, rd); 419 END; 420 FIO.EOF:=FALSE; 421 IF ag IN f.flags THEN 422 EXCL(f.flags, ag); 423 ch:=CHAR(f.again); 424 f.res:=done; 425 RETURN; 426 END; 427 ch:=FIO.RdChar(f.fileno); 428 IF ch = CHAR(0DH) THEN 429 ch:=FIO.RdChar(f.fileno); 430 END; 431 IF ch = CHR(26) THEN 432 SetErrorType(f); 433 f.eof:=FIO.EOF; 434 f.res:=notdone; 435 ELSE 436 f.again:=WORD(ch); 437 f.res:=done; 438 END; 439 END ReadChar; 440 441 PROCEDURE WriteChar(VAR f: File; ch: CHAR); 442 443 VAR 444 HighEnd, LowEnd: CARDINAL; 445 BEGIN 446 IF rd IN f.flags THEN 447 f.res:=callerror; 448 RETURN; 449 ELSIF f.flags * FlagSet{mo, wr} = FlagSet{} THEN 450 f.flags:= f.flags + FlagSet{pi, wr}; 451 END; 452 IF pi IN f.flags THEN 453 Length(f, HighEnd, LowEnd); 454 SetPos(f, HighEnd, LowEnd); 455 EXCL(f.flags, pi); 456 END; 457 IF ch = EOL THEN 458 FIO.WrLn(f.fileno); 459 ELSE 460 FIO.WrChar(f.fileno, ch); 461 END; 462 f.res:=done; 463 RETURN; 464 END WriteChar; 465 466 467 BEGIN 468 FIO.IOcheck:=FALSE; 469 LastTempExt:= "0000.$$$"; 470 END FileSystem. 471 73 errors