Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * FIOR.MOD - Redirection file support * 5 * * 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 (*# call(o_a_copy=>off) *) 12 (*%F _fdata *) 13 (*# call(seg_name => null) *) 14 (*# data(seg_name => null) *) 15 (*%E *) 16 (*# module(implementation=>off) *) 17 (*# check(stack=>off, 18 index=>off, 19 range=>off, 20 overflow=>off, 21 nil_ptr=>off) *) 22 23 IMPLEMENTATION MODULE FIOR ; 24 25 (*# call(o_a_copy=>off) *) 26 FROM Storage IMPORT ALLOCATE,DEALLOCATE,Available ; 27 28 (*%F _OS2 *) 29 IMPORT Str, Lib, SYSTEM, CoreMain; 30 (*%E *) 31 (*%T _OS2 *) 32 IMPORT Str, Lib, SYSTEM, Dos, CoreMain; 33 (*%E *) 34 (*%T _mthread *) 35 IMPORT Process, CoreProc; 36 (*%E *) 37 38 TYPE 39 40 String = ARRAY[0..255] OF CHAR ; ***** ^ not supported yet ***** ^ not supported yet 41 StrPtr = POINTER TO String ; ***** ^ not supported yet 42 STP = POINTER TO PathStr ; ***** ^ undeclared identifier 43 44 OpenMode = ( OMopen, OMcreate, OMopenrw ) ; 45 46 47 CONST 48 StrTabSize = 8192 ; 49 StrTabMax = StrTabSize-1 ; ***** ^ not supported yet 50 51 VAR 52 StrTab : ARRAY [0..StrTabMax] OF CHAR ; ***** ^ not supported yet ***** ^ not supported yet 53 FilesBase : CARDINAL ; 54 NoOfStrings : CARDINAL ; 55 LastDelPtr : CARDINAL ; 56 StrTabPtr : CARDINAL ; 57 58 CONST 59 MaxNoOfConversions = 50 ; 60 61 62 VAR 63 NoOfConversions : CARDINAL ; 64 Conversion : ARRAY[1..MaxNoOfConversions] OF CARDINAL ; ***** ^ not supported yet ***** ^ not supported yet 65 (*%F _mthread *) 66 IOR : CARDINAL ; 67 (*%E *) 68 (*%T _mthread *) 69 IOR: ARRAY [1..Process.MaxProcess] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 70 (*%E *) 71 72 PROCEDURE SetIOR(Num: CARDINAL); 73 74 BEGIN 75 (*%T _mthread *) 76 IOR[CoreProc._getTID()] := Num; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 77 (*%E *) 78 (*%F _mthread *) 79 IOR := Num; 80 (*%E *) 81 END SetIOR; ***** ^ not supported yet 82 83 PROCEDURE AddText ( s : ARRAY OF CHAR ) : CARDINAL ; ***** ^ not supported yet 84 VAR 85 len : CARDINAL ; 86 p : CARDINAL ; 87 BEGIN 88 len := Str.Length(s) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 89 IF (len+StrTabPtr+1 >= SIZE(StrTab)) THEN RETURN 0 END ; ***** ^ undeclared identifier ***** ^ not supported yet 90 p := StrTabPtr ; 91 Lib.Move(ADR(s),ADR(StrTab[StrTabPtr]),len) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 92 INC(StrTabPtr,len) ; ***** ^ undeclared identifier ***** ^ not supported yet 93 StrTab[StrTabPtr] := 0C ; ***** ^ not supported yet ***** ^ not supported yet 94 INC(StrTabPtr) ; ***** ^ undeclared identifier ***** ^ not supported yet 95 RETURN p ; 96 END AddText ; ***** ^ not supported yet 97 98 99 CONST 100 FileBuffSize = 4096 ; 101 FileBuffMax = FileBuffSize-1 ; ***** ^ not supported yet 102 103 TYPE 104 FileBuffPtr = POINTER TO CHAR ; ***** ^ not supported yet 105 VAR 106 FileBuff : FileBuffPtr ; ***** ^ not supported yet 107 FileBuffBase : FileBuffPtr ; ***** ^ not supported yet 108 109 110 PROCEDURE OpenTextFile ( name : ARRAY OF CHAR ) : BOOLEAN ; ***** ^ not supported yet 111 VAR 112 s : ARRAY[0..79] OF CHAR ; ***** ^ not supported yet ***** ^ not supported yet 113 fb : FileBuffPtr ; ***** ^ not supported yet 114 BEGIN 115 TextFile := Open(name) ; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 116 IF TextFile = Null THEN RETURN FALSE END ; ***** ^ undeclared identifier ***** ^ undeclared identifier 117 ALLOCATE(fb, FileBuffSize+1) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 118 FileBuffBase := fb ; ***** ^ not supported yet ***** ^ not supported yet 119 FileBuff := fb ; ***** ^ not supported yet ***** ^ not supported yet 120 INC(CARDINAL(FileBuff), FileBuffSize); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 121 RETURN TRUE ; 122 END OpenTextFile ; ***** ^ not supported yet 123 124 125 126 127 PROCEDURE ReadTextLn ( VAR l : ARRAY OF CHAR ) ; ***** ^ not supported yet 128 VAR c : CHAR ; 129 i : CARDINAL ; 130 131 PROCEDURE ReadTextChar () : CHAR ; 132 VAR 133 count : CARDINAL ; 134 fbp : FileBuffPtr ; ***** ^ not supported yet 135 BEGIN 136 INC(CARDINAL(FileBuff), 1); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 137 IF CARDINAL(FileBuff) - CARDINAL(FileBuffBase) >=FileBuffSize THEN ***** ^ not supported yet ***** ^ not supported yet 138 FileBuff := FileBuffBase; ***** ^ not supported yet ***** ^ not supported yet 139 count := FIO.RdBin(TextFile,FileBuff^,FileBuffSize) ; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 140 IF count<>FileBuffSize THEN 141 fbp := Lib.AddAddr(FileBuffBase, count) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 142 fbp^ := CHR(26) ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 143 END ; 144 END ; 145 RETURN FileBuff^ ; ***** ^ not supported yet 146 END ReadTextChar ; ***** ^ not supported yet 147 148 149 BEGIN 150 i := 0 ; 151 FileBuff := FileBuff ; ***** ^ not supported yet ***** ^ not supported yet 152 REPEAT (* clear LFs *) 153 IF CARDINAL(FileBuff) - CARDINAL(FileBuffBase) >=FileBuffMax THEN c := ReadTextChar() ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 154 ELSE 155 INC(CARDINAL(FileBuff), 1); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 156 c := FileBuff^ ; ***** ^ not supported yet 157 END ; 158 UNTIL c<>CHR(10) ; ***** ^ undeclared identifier ***** ^ not supported yet 159 IF c=CHR(26) THEN l[0] := c ; INC(i) ; (* check for EOF *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 160 ELSE 161 LOOP 162 IF (c>=' ')AND(i=FileBuffMax THEN c := ReadTextChar() ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 166 ELSE 167 INC(CARDINAL(FileBuff), 1); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 168 c := FileBuff^ ; ***** ^ not supported yet 169 END ; 170 END ; 171 END ; 172 l[i] := 0C ; ***** ^ not supported yet ***** ^ not supported yet 173 END ReadTextLn ; ***** ^ not supported yet 174 175 PROCEDURE CloseTextFile ; 176 VAR 177 fb : POINTER TO ARRAY[0..FileBuffMax] OF CHAR ; ***** ^ not supported yet ***** ^ not supported yet 178 BEGIN 179 IF TextFile<>Null THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 180 FIO.Close(TextFile) ; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 181 END ; 182 SetIOR(FIO.IOresult()); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 183 DEALLOCATE(FileBuffBase, FileBuffSize+1) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 184 END CloseTextFile ; ***** ^ not supported yet 185 186 (*%F _OS2 *) 187 PROCEDURE DosCall ( VAR R : SYSTEM.Registers ) : BOOLEAN ; 188 BEGIN 189 (*%T _mthread *) 190 (*%F _OS2 *) 191 Process.Lock(); 192 (*%E *) 193 (*%E *) 194 Lib.Dos(R) ; 195 (*%T _mthread *) 196 (*%F _OS2 *) 197 Process.Unlock(); 198 (*%E *) 199 (*%E *) 200 WITH R DO 201 IF (BITSET{SYSTEM.CarryFlag}*Flags)#BITSET{} THEN 202 SetIOR(AX); 203 RETURN TRUE ; 204 ELSE 205 SetIOR(0) ; 206 RETURN FALSE ; 207 END ; 208 END ; 209 END DosCall ; 210 211 PROCEDURE GetDosVersion (): CARDINAL; 212 VAR r : SYSTEM.Registers; t : SHORTCARD; 213 BEGIN 214 WITH r DO 215 AH := 30H; 216 Lib.Dos(r); 217 t := AH; 218 AH :=AL; 219 AL :=t; 220 RETURN AX 221 END; 222 END GetDosVersion; 223 224 PROCEDURE ExpandPath ( path : ARRAY OF CHAR ; 225 VAR fullpath : ARRAY OF CHAR ) ; 226 227 VAR 228 i,p,l : CARDINAL ; 229 c : CHAR ; 230 hp : CARDINAL ; 231 lim : CARDINAL ; 232 R : SYSTEM.Registers ; 233 ps : ARRAY[0..13] OF CHAR ; 234 po : PathStr ; 235 236 BEGIN 237 WITH R DO 238 i := 0 ; 239 hp := HIGH(path) ; 240 IF (hp=0)OR(path[1]<>':')OR(path[0]=0C) THEN 241 AH := 19H ; 242 Lib.Dos(R) ; 243 po[0] := CHR(SHORTCARD('A')+AL) ; 244 p := 0 ; 245 ELSE 246 po[0] := CAP(path[0]) ; 247 p := 2 ; 248 END ; 249 po[1] := ':' ; 250 po[2] := '\' ; 251 IF path[p]<>'\' THEN 252 DL := SHORTCARD(po[0])-SHORTCARD('A')+1 ; 253 DS := Seg(po) ; 254 SI := Ofs(po[3]) ; 255 AH := 47H ; 256 IF DosCall(R) THEN 257 fullpath[0] := 0C ; 258 RETURN ; 259 END ; 260 i := Str.Length(po) ; 261 IF (i>3) THEN po[i] := '\' ; INC(i) ; END ; 262 ELSE 263 i := 3 ; INC(p) ; 264 END ; 265 po[i] :=CHR (0) ; 266 LOOP 267 i := 0 ; 268 lim := 8 ; 269 LOOP 270 IF (p>hp) THEN ps[i] := '\' ; INC(i); EXIT; END ; 271 c := path[p] ; INC(p) ; 272 IF (c=0C)OR(c='\') THEN ps[i] := '\' ; INC(i); EXIT; END; 273 IF (c='.') THEN ps[i] := c ; INC(i); lim := 3; 274 ELSIF (lim>0) THEN ps[i] := c ; INC(i); DEC(lim) ; 275 END ; 276 END ; 277 ps[i] := 0C ; 278 IF (i>1) THEN 279 IF ps[0] = '.' THEN (* .. = parent *) 280 IF (i=3)AND(ps[1]='.') THEN 281 l := Str.Length(po)-1 ; 282 IF l>2 THEN 283 WHILE (po[l-1]<>'\') DO DEC(l) END ; 284 END ; 285 po[l] := 0C ; 286 ELSIF i<>2 THEN 287 Str.Append(po,ps) ; 288 END ; 289 ELSE 290 Str.Append(po,ps) ; 291 END ; 292 END ; 293 IF c=0C THEN EXIT END ; 294 END ; 295 l := Str.Length(po)-1 ; 296 IF (l>2) AND (po[l] = '\') THEN po[l] := 0C END ; 297 Str.Copy(fullpath,po) ; 298 Str.Caps(fullpath) ; 299 END ; 300 END ExpandPath ; 301 (*%E *) 302 303 (*%T _OS2 *) 304 PROCEDURE GetDosVersion(): CARDINAL; 305 306 VAR 307 Version: CARDINAL; 308 309 BEGIN 310 Dos.GetVersion(Version); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 311 RETURN Version; 312 END GetDosVersion; ***** ^ not supported yet 313 314 (* Utility routines *) 315 316 PROCEDURE ExpandPath ( path : ARRAY OF CHAR ; ***** ^ not supported yet 317 VAR fullpath : ARRAY OF CHAR ) ; ***** ^ not supported yet 318 319 VAR 320 i,p,l : CARDINAL ; 321 c : CHAR ; 322 hp : CARDINAL ; 323 lim : CARDINAL ; 324 ps : ARRAY[0..13] OF CHAR ; ***** ^ not supported yet ***** ^ not supported yet 325 po : PathStr ; ***** ^ undeclared identifier 326 Drive, Length : CARDINAL; 327 Map: LONGCARD; ***** ^ undeclared identifier 328 329 BEGIN 330 i := 0 ; 331 hp := HIGH(path) ; ***** ^ undeclared identifier ***** ^ not supported yet 332 IF (hp=0)OR(path[1]<>':')OR(path[0]=0C) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 333 SYSTEM.Eval(Dos.QCurDisk(Drive, Map)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 334 po[0] := CHR(CARDINAL('A')+Drive-1) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 335 p := 0 ; 336 ELSE 337 po[0] := CAP(path[0]) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 338 p := 2 ; 339 END ; 340 po[1] := ':' ; ***** ^ not supported yet ***** ^ not supported yet 341 po[2] := '\' ; ***** ^ not supported yet ***** ^ not supported yet 342 IF path[p]<>'\' THEN ***** ^ not supported yet ***** ^ not supported yet 343 Drive := CARDINAL(po[0])-CARDINAL('A')+1 ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 344 Length := 77; 345 SYSTEM.Eval(Dos.QCurDir(Drive, FarADR(po[3]), Length)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 346 i := Str.Length(po) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 347 IF (i>3) THEN po[i] := '\' ; INC(i) ; END ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 348 ELSE 349 i := 3 ; INC(p) ; ***** ^ undeclared identifier ***** ^ not supported yet 350 END ; 351 po[i] :=CHR (0) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 352 LOOP 353 i := 0 ; 354 lim := 8 ; 355 LOOP 356 IF (p>hp) THEN ps[i] := '\' ; INC(i); EXIT; END ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 357 c := path[p] ; INC(p) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 358 IF (c=0C)OR(c='\') THEN ps[i] := '\' ; INC(i); EXIT; END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 359 IF (c='.') THEN ps[i] := c ; INC(i); lim := 3; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 360 ELSIF (lim>0) THEN ps[i] := c ; INC(i); DEC(lim) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 361 END ; 362 END ; 363 ps[i] := 0C ; ***** ^ not supported yet ***** ^ not supported yet 364 IF (i>1) THEN 365 IF ps[0] = '.' THEN (* .. = parent *) ***** ^ not supported yet ***** ^ not supported yet 366 IF (i=3)AND(ps[1]='.') THEN ***** ^ not supported yet ***** ^ not supported yet 367 l := Str.Length(po)-1 ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 368 IF l>2 THEN 369 WHILE (po[l-1]<>'\') DO DEC(l) END ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 370 END ; 371 po[l] := 0C ; ***** ^ not supported yet ***** ^ not supported yet 372 ELSIF i<>2 THEN 373 Str.Append(po,ps) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 374 END ; 375 ELSE 376 Str.Append(po,ps) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 377 END ; 378 END ; 379 IF c=0C THEN EXIT END ; 380 END ; 381 l := Str.Length(po)-1 ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 382 IF (l>2) AND (po[l] = '\') THEN po[l] := 0C END ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 383 Str.Copy(fullpath,po) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 384 Str.Caps(fullpath) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 385 END ExpandPath ; ***** ^ not supported yet 386 (*%E *) 387 388 PROCEDURE AbsolutePath ( name : ARRAY OF CHAR ) : BOOLEAN ; ***** ^ not supported yet 389 BEGIN 390 RETURN (name[0]='\')OR(name[1]=':') ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 391 END AbsolutePath ; ***** ^ not supported yet 392 393 PROCEDURE SplitPath ( path : ARRAY OF CHAR ; ***** ^ not supported yet 394 VAR head,tail : ARRAY OF CHAR ) ; ***** ^ not supported yet 395 VAR 396 L : CARDINAL ; 397 c : CHAR ; 398 i : CARDINAL ; 399 BEGIN 400 i := Str.Length(path) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 401 LOOP 402 IF (i=0) THEN EXIT END ; 403 DEC(i) ; c := path[i] ; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 404 IF (c='\') THEN EXIT END ; 405 IF (c=':') THEN INC(i) ; EXIT END ; ***** ^ undeclared identifier ***** ^ not supported yet 406 END ; 407 Str.Slice(head,path,0,i) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 408 IF c='\' THEN INC(i) END ; ***** ^ undeclared identifier ***** ^ not supported yet 409 Str.Slice(tail,path,i,HIGH(tail)+1) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 410 Str.Caps(head) ; Str.Caps(tail) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 411 END SplitPath ; ***** ^ not supported yet 412 413 PROCEDURE MakePath ( VAR path : ARRAY OF CHAR ; ***** ^ not supported yet 414 head,tail : ARRAY OF CHAR ) ; ***** ^ not supported yet 415 VAR 416 l : CARDINAL ; 417 BEGIN 418 ExpandPath(head,path); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 419 l := Str.Length(path) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 420 IF (path[l-1]<>'\') THEN ***** ^ not supported yet ***** ^ not supported yet 421 IF (tail[0]<>'\')AND(lMAX(CARDINAL) THEN s[p] := 0C END ; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 465 END RemoveExtension ; ***** ^ not supported yet 466 467 468 PROCEDURE ChangeExtension ( VAR s : ARRAY OF CHAR ; ext : ARRAY OF CHAR ) ; ***** ^ not supported yet ***** ^ not supported yet 469 BEGIN 470 RemoveExtension(s) ; ***** ^ not supported yet ***** ^ not supported yet 471 AddExtension(s,ext) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 472 END ChangeExtension ; ***** ^ not supported yet 473 474 PROCEDURE IsExtension ( s : ARRAY OF CHAR ; ext : ARRAY OF CHAR ) : BOOLEAN ; ***** ^ not supported yet ***** ^ not supported yet 475 VAR 476 es: PathStr; ***** ^ undeclared identifier 477 BEGIN 478 Str.Concat(es, '*.', ext); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 479 RETURN Str.Match(s, es); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 480 END IsExtension ; ***** ^ not supported yet 481 482 483 PROCEDURE FindAndOpenPath ( name : ARRAY OF CHAR ; ***** ^ not supported yet 484 om : OpenMode ; 485 VAR fullname : PathStr ; ***** ^ undeclared identifier 486 VAR h : File ) : BOOLEAN ; ***** ^ undeclared identifier 487 VAR 488 l : CARDINAL ; 489 i,p : CARDINAL ; 490 sp : StrPtr ; ***** ^ not supported yet 491 path : PathStr ; ***** ^ undeclared identifier 492 493 amatch : BOOLEAN ; 494 savep : CARDINAL ; 495 496 PROCEDURE TestFileExists ( name : ARRAY OF CHAR ) : BOOLEAN ; ***** ^ not supported yet 497 VAR 498 path : PathStr ; ***** ^ undeclared identifier 499 found : BOOLEAN ; 500 BEGIN 501 ExpandPath(name,path) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 502 IF om=OMcreate THEN found := TRUE ***** ^ not supported yet ***** ^ not supported yet 503 ELSE 504 IF om=OMopen THEN ***** ^ not supported yet ***** ^ not supported yet 505 h := FIO.OpenRead(path) ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 506 ELSE 507 h := FIO.Open(path) ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 508 END; 509 SetIOR(FIO.IOresult()); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 510 found := (IOresult()=0) ; ***** ^ undeclared identifier ***** ^ not supported yet 511 IF (IOresult()<>0) THEN h := Null END ; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 512 END ; 513 IF found THEN Str.Copy(fullname,path) END ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 514 RETURN found ; 515 END TestFileExists ; ***** ^ not supported yet 516 517 518 BEGIN 519 SetIOR(0); ***** ^ not supported yet ***** ^ not supported yet 520 amatch := FALSE ; 521 h := Null ; ***** ^ not supported yet ***** ^ undeclared identifier 522 IF AbsolutePath(name) THEN i := NoOfConversions ***** ^ not supported yet ***** ^ not supported yet 523 ELSE i := 0 ; 524 END ; 525 LOOP 526 INC(i) ; ***** ^ undeclared identifier ***** ^ not supported yet 527 IF i>NoOfConversions THEN 528 IF NOT amatch THEN 529 IF TestFileExists ( name ) THEN ***** ^ not supported yet ***** ^ not supported yet 530 RETURN TRUE 531 END ; 532 END ; 533 RETURN FALSE ; 534 END ; 535 p := Conversion[i] ; ***** ^ not supported yet ***** ^ not supported yet 536 sp := ADR(StrTab[p]) ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 537 IF Str.Match(name,sp^) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 538 amatch := TRUE ; 539 LOOP 540 INC(p,Str.Length(sp^)+1) ; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 541 sp := ADR(StrTab[p]) ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 542 IF sp^[0]=0C THEN EXIT END ; ***** ^ not supported yet ***** ^ not supported yet 543 MakePath(path,sp^,name) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 544 IF TestFileExists ( path ) THEN ***** ^ not supported yet ***** ^ not supported yet 545 RETURN TRUE ; 546 END ; 547 END ; 548 END ; 549 END ; 550 END FindAndOpenPath ; ***** ^ not supported yet 551 552 PROCEDURE FindPath ( name : ARRAY OF CHAR ; ***** ^ not supported yet 553 VAR fullname : PathStr ) : BOOLEAN ; ***** ^ undeclared identifier 554 VAR 555 h : File ; ***** ^ undeclared identifier 556 b : BOOLEAN ; 557 BEGIN 558 b := FindAndOpenPath(name,OMopen,fullname,h) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 559 IF h<>Null THEN FIO.Close(h) END ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 560 RETURN b ; 561 END FindPath ; ***** ^ not supported yet 562 563 PROCEDURE FindNewPath ( name : ARRAY OF CHAR ; ***** ^ not supported yet 564 VAR fullname : PathStr ) : BOOLEAN ; ***** ^ undeclared identifier 565 VAR 566 h : File ; ***** ^ undeclared identifier 567 b : BOOLEAN ; 568 BEGIN 569 b := FindAndOpenPath(name,OMcreate,fullname,h) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 570 IF h<>Null THEN FIO.Close(h) END ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 571 RETURN b ; 572 END FindNewPath ; ***** ^ not supported yet 573 574 575 576 PROCEDURE OpenOrCreateFile ( name : ARRAY OF CHAR ; ***** ^ not supported yet 577 om : OpenMode ) : CARDINAL ; 578 VAR 579 h : File ; ***** ^ undeclared identifier 580 BEGIN 581 h := Null ; ***** ^ not supported yet ***** ^ undeclared identifier 582 SetIOR(0); ***** ^ not supported yet ***** ^ not supported yet 583 IF FindAndOpenPath(name,om,LastPath,h) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 584 IF (h=Null)OR(IOresult()<>0) THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 585 IF h<>Null THEN FIO.Close(h) END ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 586 ExpandPath(LastPath,LastPath) ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 587 IF om=OMcreate THEN h := FIO.Create(LastPath) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 588 ELSIF om=OMopen THEN h := FIO.OpenRead(LastPath) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 589 ELSE h := FIO.Open(LastPath) ; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 590 END; 591 SetIOR(FIO.IOresult()); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 592 END ; 593 ELSE 594 IF IOresult()=0 THEN SetIOR(2) END ; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 595 END ; 596 IF IOresult()<>0 THEN ***** ^ undeclared identifier ***** ^ not supported yet 597 h := Null ; ***** ^ not supported yet ***** ^ undeclared identifier 598 END ; 599 RETURN h ; ***** ^ not supported yet 600 END OpenOrCreateFile ; ***** ^ not supported yet 601 602 603 PROCEDURE Create ( name : ARRAY OF CHAR ) : File ; ***** ^ not supported yet ***** ^ undeclared identifier 604 BEGIN 605 RETURN OpenOrCreateFile(name,OMcreate) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 606 END Create ; ***** ^ not supported yet 607 608 609 PROCEDURE Open ( name : ARRAY OF CHAR ) : File ; ***** ^ not supported yet ***** ^ undeclared identifier 610 BEGIN 611 RETURN OpenOrCreateFile(name,OMopen) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 612 END Open ; ***** ^ not supported yet 613 614 PROCEDURE OpenRW ( name : ARRAY OF CHAR ) : File ; ***** ^ not supported yet ***** ^ undeclared identifier 615 BEGIN 616 RETURN OpenOrCreateFile(name,OMopenrw) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 617 END OpenRW ; ***** ^ not supported yet 618 619 620 621 (* Redirected calls *) 622 623 624 PROCEDURE Erase ( name : ARRAY OF CHAR ) ; ***** ^ not supported yet 625 VAR 626 path : PathStr ; ***** ^ undeclared identifier 627 BEGIN 628 IF FindPath(name,path) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 629 FIO.Erase(path) ; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 630 END ; 631 END Erase ; ***** ^ not supported yet 632 633 PROCEDURE DelLeading ( VAR R : ARRAY OF CHAR ) ; ***** ^ not supported yet 634 BEGIN 635 WHILE (R[0]>0C)AND(R[0]<=' ') DO Str.Delete(R,0,1) END ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 636 END DelLeading ; ***** ^ not supported yet 637 638 639 640 641 PROCEDURE ReadRedirectionFile ( name : ARRAY OF CHAR ) ; ***** ^ not supported yet 642 TYPE 643 Str3 = ARRAY[0..2] OF CHAR ; ***** ^ not supported yet ***** ^ not supported yet 644 VAR 645 line : ARRAY[0..255] OF CHAR ; ***** ^ not supported yet ***** ^ not supported yet 646 item : ARRAY[0..64] OF CHAR ; ***** ^ not supported yet ***** ^ not supported yet 647 outp : BOOLEAN ; 648 pat : CARDINAL ; 649 n,i : CARDINAL ; 650 path : PathStr ; ***** ^ undeclared identifier 651 BEGIN 652 NoOfConversions := 0 ; 653 IF FindExePath(name,TRUE,path) THEN END ; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 654 IF NOT OpenTextFile(path) THEN ***** ^ not supported yet ***** ^ not supported yet 655 RETURN 656 END ; 657 outp := TRUE ; 658 LOOP 659 ReadTextLn(line) ; ***** ^ not supported yet ***** ^ not supported yet 660 IF line[0]=CHR(26) THEN EXIT END ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 661 Str.Caps(line) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 662 DelLeading(line) ; ***** ^ not supported yet ***** ^ not supported yet 663 Str.ItemS(item,line,' ,=;',0) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 664 IF item[0]<>0C THEN ***** ^ not supported yet ***** ^ not supported yet 665 INC(NoOfConversions) ; ***** ^ undeclared identifier ***** ^ not supported yet 666 Conversion[NoOfConversions] := AddText(item) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 667 i := 0 ; 668 REPEAT 669 INC(i) ; ***** ^ undeclared identifier ***** ^ not supported yet 670 Str.ItemS(item,line,' =,;',i) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 671 n := AddText(item) ; ***** ^ not supported yet ***** ^ not supported yet 672 UNTIL item[0]=0C ; ***** ^ not supported yet ***** ^ not supported yet 673 END ; 674 IF NoOfConversions=MaxNoOfConversions THEN EXIT END ; 675 END ; 676 CloseTextFile ; ***** ^ not supported yet 677 StrTabPtr := 1 ; 678 END ReadRedirectionFile ; ***** ^ not supported yet 679 680 681 PROCEDURE FindExePath ( path : ARRAY OF CHAR ; ***** ^ not supported yet 682 ovl : BOOLEAN ; 683 VAR outpath : PathStr ) : BOOLEAN ; ***** ^ undeclared identifier 684 VAR 685 fp : PathStr ; ***** ^ undeclared identifier 686 str : StrPtr ; ***** ^ not supported yet 687 l : CARDINAL ; 688 envpath : String ; ***** ^ not supported yet 689 n : CARDINAL ; 690 BEGIN 691 Str.Copy(outpath,path) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 692 IF FindPath(path,outpath) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 693 RETURN TRUE ; 694 END ; 695 IF AbsolutePath(path) THEN RETURN FALSE END ; ***** ^ not supported yet ***** ^ not supported yet 696 IF ovl AND (GetDosVersion() >= 300H) THEN ***** ^ not supported yet ***** ^ not supported yet 697 str := StrPtr(CoreMain._argv[0]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 698 Str.Copy(fp,str^) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 699 l := Str.Length( fp ) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 700 LOOP 701 IF l=0 THEN fp[0] := 0C; EXIT; END; ***** ^ not supported yet ***** ^ not supported yet 702 DEC(l); ***** ^ undeclared identifier ***** ^ not supported yet 703 IF fp[l]='\' THEN EXIT END; ***** ^ not supported yet ***** ^ not supported yet 704 END; 705 fp[l+1] := 0C; ***** ^ not supported yet ***** ^ not supported yet 706 MakePath(fp,fp,path) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 707 IF FindPath(fp,outpath) THEN RETURN TRUE END ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 708 END; 709 Lib.EnvironmentFind('PATH',envpath) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 710 n := 0 ; 711 LOOP 712 Str.ItemS(fp,envpath,' =;,',n) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 713 IF fp[0]=0C THEN RETURN FALSE END ; ***** ^ not supported yet ***** ^ not supported yet 714 MakePath(fp,fp,path) ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 715 IF FindPath(fp,outpath) THEN RETURN TRUE END ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 716 INC(n) ; ***** ^ undeclared identifier ***** ^ not supported yet 717 END ; 718 END FindExePath ; ***** ^ not supported yet 719 720 PROCEDURE IOresult () : CARDINAL ; 721 BEGIN 722 (*%F _mthread *) 723 RETURN IOR ; 724 (*%E *) 725 (*%T _mthread *) 726 RETURN IOR[CoreProc._getTID()] ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 727 (*%E *) 728 END IOresult ; ***** ^ not supported yet 729 730 731 PROCEDURE Init ; 732 733 VAR 734 RedFile: ARRAY [0..80] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 735 BEGIN 736 NoOfConversions := 0 ; 737 StrTab[0] := 0C ; ***** ^ not supported yet ***** ^ not supported yet 738 StrTabPtr := 1 ; 739 LastDelPtr := 0 ; 740 NoOfStrings := 0 ; 741 FIO.IOcheck := FALSE ; ***** ^ undeclared identifier ***** ^ not supported yet 742 Lib.EnvironmentFind('TSRED', RedFile); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 743 IF RedFile[0] = 0C THEN ***** ^ not supported yet ***** ^ not supported yet 744 RedFile := 'TS.RED'; ***** ^ not supported yet ***** ^ not supported yet 745 END; 746 ReadRedirectionFile(RedFile); ***** ^ not supported yet ***** ^ not supported yet 747 END Init ; ***** ^ not supported yet 748 749 (*%T _mthread *) 750 VAR 751 n : [1..Process.MaxProcess]; ***** ^ not supported yet ***** ^ not supported yet 752 (*%E *) 753 BEGIN 754 (*%T _mthread *) 755 n := 1; ***** ^ not supported yet 756 WHILE n <= Process.MaxProcess DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 757 IOR[n] := 0; ***** ^ not supported yet ***** ^ not supported yet 758 INC(n); ***** ^ undeclared identifier ***** ^ not supported yet 759 END; 760 (*%E *) 761 (*%F _mthread *) 762 IOR := 0; 763 (*%E *) 764 Init ; ***** ^ not supported yet 765 END FIOR. ***** ^ not supported yet 731 errors