FIOR.MOD 18 KB

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