IO.MOD 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868
  1. (* Release 3.10 *)
  2. (*-------------------------------------------------------------------------*
  3. * *
  4. * IO.MOD - Terminal input/output *
  5. * *
  6. * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. *
  7. * All Rights Reserved *
  8. * *
  9. *--------------------------------------------------------------------------*)
  10. (*%F _fdata *)
  11. (*# call(seg_name => null) *)
  12. (*# data(seg_name => null) *)
  13. (*%E *)
  14. (*# module(implementation=>off) *)
  15. (*# call(o_a_copy => off) *)
  16. (*# check(stack=>off,
  17. index=>off,
  18. range=>off,
  19. overflow=>off,
  20. nil_ptr=>off) *)
  21. IMPLEMENTATION MODULE IO;
  22. (*%F _OS2 *)
  23. IMPORT Lib, Str, SYSTEM, CoreIO, CoreSig;
  24. (*%E *)
  25. (*%T _OS2 *)
  26. IMPORT Str,Dos,Vio,Kbd,Lib,CoreIO,CoreSig;
  27. (*%E *)
  28. (*%T _mthread *)
  29. IMPORT Process, CoreProc;
  30. (*%E *)
  31. CONST
  32. TrueStr = 'TRUE';
  33. ConStr = 'CON';
  34. VAR
  35. VIOoutput : BOOLEAN;
  36. LWW : BOOLEAN;
  37. Buffer : ARRAY[0..MaxRdLength-1] OF CHAR;
  38. s,e : CARDINAL;
  39. (*%T _mthread *)
  40. OKTable: ARRAY [1..Process.MaxProcess] OF BOOLEAN;
  41. (*%E *)
  42. TYPE
  43. Str80 = ARRAY[0..79] OF CHAR;
  44. PathStr = Str80;
  45. (*%F _OS2 *)
  46. PROCEDURE KeyPressed (): BOOLEAN;
  47. VAR R : SYSTEM.Registers;
  48. BEGIN
  49. WITH R DO
  50. AH := 0BH;
  51. Lib.Dos(R);
  52. RETURN AL=0FFH;
  53. END;
  54. END KeyPressed;
  55. PROCEDURE TerminalRdStr(VAR string: ARRAY OF CHAR);
  56. VAR
  57. R : SYSTEM.Registers;
  58. H : CARDINAL;
  59. I : CARDINAL;
  60. InputBuffer : RECORD
  61. LenBuf : CHAR;
  62. Len : CHAR;
  63. Buf : ARRAY[0..81] OF CHAR;
  64. END;
  65. BEGIN
  66. IF Prompt AND NOT LWW THEN WrStr('?'); END;
  67. LWW := FALSE;
  68. H := HIGH(string);
  69. IF H > 80 THEN
  70. InputBuffer.LenBuf := CHR(82);
  71. ELSE
  72. InputBuffer.LenBuf := CHR(H+2);
  73. END;
  74. InputBuffer.Len := CHR(0);
  75. WITH R DO
  76. DS := Seg(InputBuffer);
  77. DX := Ofs(InputBuffer);
  78. AH := 0AH;
  79. Lib.Dos(R);
  80. END;
  81. I := ORD(InputBuffer.Len);
  82. IF I <= H THEN
  83. string[I] := CHR(0);
  84. END;
  85. WHILE (I>0) DO
  86. DEC(I);
  87. string[I] := InputBuffer.Buf[I];
  88. END;
  89. WrLn;
  90. END TerminalRdStr;
  91. (*%E *)
  92. PROCEDURE GetName(name: ARRAY OF CHAR; VAR fn: PathStr);
  93. (* Makes Null terminated filename, also sets IOR to 0 *)
  94. BEGIN
  95. Str.Copy(fn,name);
  96. fn[HIGH(fn)] := CHR(0);
  97. END GetName;
  98. (*%T _OS2 *)
  99. VAR tchar : CHAR;
  100. PROCEDURE KeyPressed():BOOLEAN;
  101. VAR r : CARDINAL; k : Kbd.KEYINFO;
  102. BEGIN
  103. k.char := 0C;
  104. k.scan := 0;
  105. k.nlsShift := 0;
  106. r := Kbd.Peek(k,0);
  107. RETURN (tchar#0C) OR (k.scan#0) OR (k.char#0C);
  108. END KeyPressed;
  109. PROCEDURE FileRdStr(VAR string: ARRAY OF CHAR);
  110. VAR
  111. NumRead: CARDINAL;
  112. BEGIN
  113. IF Dos.Read(0, FarADR(string), HIGH(string), NumRead) # 0 THEN END;
  114. string[NumRead] := CHR(0);
  115. END FileRdStr;
  116. PROCEDURE TerminalRdStr(VAR string: ARRAY OF CHAR);
  117. VAR l : Kbd.STRINGINBUF;
  118. r : CARDINAL;
  119. BEGIN
  120. IF Prompt AND NOT LWW THEN WrStr('?'); END;
  121. LWW := FALSE;
  122. IF NOT InputRedirected THEN
  123. l.b := HIGH(string);
  124. r := Kbd.StringIn( string,l,0,0);
  125. IF l.chIn < l.b THEN
  126. string[l.chIn]:= 0C;
  127. END;
  128. WrLn;
  129. ELSE
  130. FileRdStr(string);
  131. END;
  132. END TerminalRdStr;
  133. (*%E *)
  134. (*%T _mthread *)
  135. PROCEDURE SetThreadOK( b : BOOLEAN);
  136. BEGIN
  137. OKTable[CoreProc._getTID()] := b;
  138. END SetThreadOK;
  139. (*%E *)
  140. PROCEDURE WrStr(s: ARRAY OF CHAR);
  141. BEGIN
  142. WrStrRedirect(s);
  143. END WrStr;
  144. PROCEDURE RdStr ( VAR s : ARRAY OF CHAR );
  145. BEGIN
  146. RdStrRedirect(s);
  147. END RdStr;
  148. PROCEDURE RdBuff;
  149. VAR
  150. p,h : CARDINAL;
  151. BEGIN
  152. RdStrRedirect(Buffer);
  153. p := Str.Length(Buffer);
  154. h := SIZE(Buffer)-1;
  155. IF p>h-1 THEN p := h-1; END;
  156. Buffer[p] := CHR(13); INC(p);
  157. Buffer[p] := CHR(10); INC(p);
  158. IF p<=h THEN Buffer[p] := CHR(0) END;
  159. e := p; s := 0;
  160. END RdBuff;
  161. (*%F _OS2 *)
  162. PROCEDURE TerminalWrStr(string: ARRAY OF CHAR);
  163. VAR R : SYSTEM.Registers;
  164. BEGIN
  165. LWW := TRUE;
  166. WITH R DO
  167. BX := 1;
  168. AH := 40H;
  169. DS := Seg( string );
  170. DX := Ofs( string );
  171. CX := Str.Length(string);
  172. Lib.Dos( R );
  173. END;
  174. END TerminalWrStr;
  175. PROCEDURE RdKey() : CHAR;
  176. VAR R : SYSTEM.Registers;
  177. BEGIN
  178. WITH R DO
  179. AH := 8;
  180. Lib.Dos(R);
  181. IF AL=0E0H THEN AL := 0 END;
  182. RETURN CHR(AL);
  183. END;
  184. END RdKey;
  185. (*%E *)
  186. (*%T _OS2 *)
  187. PROCEDURE TerminalWrStr(string: ARRAY OF CHAR);
  188. VAR r : CARDINAL;
  189. n : CARDINAL ;
  190. BEGIN
  191. LWW := TRUE;
  192. IF (VIOoutput) AND (NOT OutputRedirected) THEN
  193. r := Vio.WrtTTY(string,Str.Length(string),0);
  194. ELSE
  195. r := Dos.Write(1,FarADR(string),Str.Length(string),n);
  196. END ;
  197. END TerminalWrStr;
  198. PROCEDURE RdKey() : CHAR;
  199. VAR k : Kbd.KEYINFO; r : CARDINAL; c:CHAR;
  200. BEGIN
  201. IF (tchar#0C) THEN
  202. c := tchar;
  203. tchar:=0C;
  204. RETURN c;
  205. ELSE
  206. r := Kbd.CharIn( k,0,0 );
  207. IF (k.char=0C) OR (k.char=CHR(0E0H)) THEN
  208. tchar := CHAR(k.scan);
  209. k.char := 0C;
  210. END;
  211. RETURN (k.char);
  212. END;
  213. END RdKey;
  214. (*%E *)
  215. (*# save,
  216. call(o_a_copy => on) *)
  217. PROCEDURE WrStrAdj( S : ARRAY OF CHAR; Length : INTEGER );
  218. VAR
  219. L : CARDINAL;
  220. a : INTEGER;
  221. BEGIN
  222. OK := TRUE;
  223. (*%T _mthread *)
  224. SetThreadOK(TRUE);
  225. (*%E *)
  226. IF RdLnOnWr THEN RdLn; END;
  227. L := Str.Length( S );
  228. a := ABS( Length ) - INTEGER( L );
  229. IF (a < 0) AND ChopOff THEN
  230. L := CARDINAL(ABS(Length));
  231. IF L<=HIGH(S) THEN S[L] := CHR(0); END;
  232. WHILE (L>0) DO DEC(L); S[L] := '?'; END;
  233. OK := FALSE;
  234. (*%T _mthread *)
  235. SetThreadOK(FALSE);
  236. (*%E *)
  237. a := 0;
  238. END;
  239. IF (Length > 0) AND (a > 0) THEN WrCharRep( PrefixChar,a ); END;
  240. WrStr( S );
  241. IF (Length < 0) AND (a > 0) THEN WrCharRep( SuffixChar,a ); END;
  242. END WrStrAdj;
  243. (*# restore *)
  244. PROCEDURE WrChar( V: CHAR );
  245. BEGIN
  246. IF RdLnOnWr THEN RdLn; END;
  247. WrStr( V );
  248. END WrChar;
  249. PROCEDURE WrCharRep(V: CHAR; count: CARDINAL);
  250. VAR
  251. s : Str80;
  252. i,j : CARDINAL;
  253. BEGIN
  254. IF RdLnOnWr THEN RdLn; END;
  255. WHILE count>0 DO
  256. i := SIZE(s)-2;
  257. IF i>count THEN i := count END;
  258. DEC(count,i);
  259. j := 0;
  260. WHILE (j<i) DO s[j] := V; INC(j) END;
  261. s[j] := CHR(0);
  262. WrStr(s);
  263. END;
  264. END WrCharRep;
  265. PROCEDURE WrBool(V: BOOLEAN; Length: INTEGER);
  266. BEGIN
  267. IF V THEN
  268. WrStrAdj(TrueStr,Length);
  269. ELSE
  270. WrStrAdj('FALSE',Length);
  271. END;
  272. END WrBool;
  273. PROCEDURE WrShtInt(V: SHORTINT; Length: INTEGER);
  274. VAR
  275. S : Str80;
  276. b : BOOLEAN;
  277. BEGIN
  278. Str.IntToStr( LONGINT(V),S,10,b);
  279. (*%T _mthread *)
  280. SetThreadOK(b);
  281. (*%E *)
  282. IF b THEN
  283. WrStrAdj(S,Length );
  284. END;
  285. OK := b;
  286. END WrShtInt;
  287. PROCEDURE WrInt(V: INTEGER; Length: INTEGER);
  288. VAR
  289. S : Str80;
  290. b : BOOLEAN;
  291. BEGIN
  292. Str.IntToStr( LONGINT(V),S,10,b);
  293. (*%T _mthread *)
  294. SetThreadOK(b);
  295. (*%E *)
  296. IF b THEN
  297. WrStrAdj(S,Length );
  298. END;
  299. OK := b;
  300. END WrInt;
  301. PROCEDURE WrLngInt(V: LONGINT; Length: INTEGER);
  302. VAR
  303. S : Str80;
  304. b : BOOLEAN;
  305. BEGIN
  306. Str.IntToStr( V,S,10,b);
  307. (*%T _mthread *)
  308. SetThreadOK(b);
  309. (*%E *)
  310. IF b THEN
  311. WrStrAdj(S,Length );
  312. END;
  313. OK := b;
  314. END WrLngInt;
  315. PROCEDURE WrShtCard(V: SHORTCARD; Length: INTEGER);
  316. VAR S : Str80;
  317. b : BOOLEAN;
  318. BEGIN
  319. Str.CardToStr(LONGCARD(V),S,10,b);
  320. (*%T _mthread *)
  321. SetThreadOK(b);
  322. (*%E *)
  323. IF b THEN
  324. WrStrAdj(S,Length );
  325. END;
  326. OK := b;
  327. END WrShtCard;
  328. PROCEDURE WrCard(V: CARDINAL; Length: INTEGER);
  329. VAR
  330. S : Str80;
  331. b : BOOLEAN;
  332. BEGIN
  333. Str.CardToStr(LONGCARD(V),S,10,b);
  334. (*%T _mthread *)
  335. SetThreadOK(b);
  336. (*%E *)
  337. IF b THEN
  338. WrStrAdj(S,Length );
  339. END;
  340. OK := b;
  341. END WrCard;
  342. PROCEDURE WrLngCard(V: LONGCARD; Length: INTEGER);
  343. VAR
  344. S : Str80;
  345. b : BOOLEAN;
  346. BEGIN
  347. Str.CardToStr(V,S,10,b);
  348. (*%T _mthread *)
  349. SetThreadOK(b);
  350. (*%E *)
  351. IF b THEN
  352. WrStrAdj(S,Length );
  353. END;
  354. OK := b;
  355. END WrLngCard;
  356. PROCEDURE WrShtHex(V: SHORTCARD; Length: INTEGER);
  357. VAR
  358. S : Str80;
  359. b : BOOLEAN;
  360. BEGIN
  361. Str.CardToStr(LONGCARD(V),S,16,b);
  362. (*%T _mthread *)
  363. SetThreadOK(b);
  364. (*%E *)
  365. IF b THEN
  366. WrStrAdj(S,Length );
  367. END;
  368. OK := b;
  369. END WrShtHex;
  370. PROCEDURE WrHex(V: CARDINAL; Length: INTEGER);
  371. VAR
  372. S : Str80;
  373. b : BOOLEAN;
  374. BEGIN
  375. Str.CardToStr(LONGCARD(V),S,16,b);
  376. (*%T _mthread *)
  377. SetThreadOK(b);
  378. (*%E *)
  379. IF b THEN
  380. WrStrAdj(S,Length );
  381. END;
  382. OK := b;
  383. END WrHex;
  384. PROCEDURE WrLngHex(V: LONGCARD; Length: INTEGER);
  385. VAR S : Str80;
  386. b : BOOLEAN;
  387. BEGIN
  388. Str.CardToStr(V,S,16,b);
  389. (*%T _mthread *)
  390. SetThreadOK(b);
  391. (*%E *)
  392. IF b THEN
  393. WrStrAdj(S,Length );
  394. END;
  395. OK := b;
  396. END WrLngHex;
  397. PROCEDURE WrReal(V: REAL; Precision: CARDINAL; Length: INTEGER);
  398. VAR
  399. S : Str80;
  400. b : BOOLEAN;
  401. BEGIN
  402. Str.RealToStr( LONGREAL ( V ),Precision,Eng,S,b);
  403. (*%T _mthread *)
  404. SetThreadOK(b);
  405. (*%E *)
  406. IF b THEN
  407. WrStrAdj(S,Length );
  408. END;
  409. OK := b;
  410. END WrReal;
  411. PROCEDURE WrFixReal(V: REAL; Precision: CARDINAL; Length: INTEGER);
  412. VAR
  413. S : Str80;
  414. b : BOOLEAN;
  415. BEGIN
  416. Str.FixRealToStr( LONGREAL ( V ),Precision,S,b );
  417. (*%T _mthread *)
  418. SetThreadOK(b);
  419. (*%E *)
  420. IF b THEN
  421. WrStrAdj(S,Length );
  422. END;
  423. OK := b;
  424. END WrFixReal;
  425. PROCEDURE WrLngReal(V : LONGREAL; Precision: CARDINAL; Length: INTEGER);
  426. VAR
  427. S : Str80;
  428. b : BOOLEAN;
  429. BEGIN
  430. Str.RealToStr( V,Precision,Eng,S,b);
  431. (*%T _mthread *)
  432. SetThreadOK(b);
  433. (*%E *)
  434. IF b THEN
  435. WrStrAdj(S,Length );
  436. END;
  437. OK := b;
  438. END WrLngReal;
  439. PROCEDURE WrFixLngReal(V: LONGREAL; Precision: CARDINAL; Length: INTEGER);
  440. VAR
  441. S : Str80;
  442. b : BOOLEAN;
  443. BEGIN
  444. Str.FixRealToStr(V,Precision,S,b );
  445. (*%T _mthread *)
  446. SetThreadOK(b);
  447. (*%E *)
  448. IF b THEN
  449. WrStrAdj(S,Length );
  450. END;
  451. OK := b;
  452. END WrFixLngReal;
  453. PROCEDURE WrLn;
  454. TYPE
  455. a3 = ARRAY [0..1] OF CHAR;
  456. CONST
  457. crlf = a3(CHR(13),CHR(10));
  458. BEGIN
  459. IF RdLnOnWr THEN RdLn; END;
  460. WrStr( crlf );
  461. LWW := FALSE;
  462. END WrLn;
  463. PROCEDURE RdBool() : BOOLEAN;
  464. VAR s : Str80;
  465. BEGIN
  466. RdItem( s );
  467. RETURN Str.Compare( s,TrueStr )=0;
  468. END RdBool;
  469. PROCEDURE RdShtInt() : SHORTINT;
  470. VAR
  471. S : Str80;
  472. i : LONGINT;
  473. b : BOOLEAN;
  474. BEGIN
  475. RdItem(S );
  476. i := Str.StrToInt( S,10,b );
  477. (*%T _mthread *)
  478. SetThreadOK(b AND (i >= -80H) AND (i < 80H));
  479. (*%E *)
  480. OK := b AND (i >= -80H) AND (i < 80H);
  481. RETURN SHORTINT( i );
  482. END RdShtInt;
  483. PROCEDURE RdInt() : INTEGER;
  484. VAR
  485. S : Str80;
  486. i : LONGINT;
  487. b : BOOLEAN;
  488. BEGIN
  489. RdItem(S);
  490. i := Str.StrToInt( S,10,b );
  491. (*%T _mthread *)
  492. SetThreadOK(b AND (i >= -8000H) AND (i < 8000H));
  493. (*%E *)
  494. OK := b AND (i >= -8000H) AND (i < 8000H);
  495. RETURN INTEGER(i);
  496. END RdInt;
  497. PROCEDURE RdLngInt() : LONGINT;
  498. VAR
  499. S : Str80;
  500. i : LONGINT;
  501. b : BOOLEAN;
  502. BEGIN
  503. RdItem(S);
  504. i := Str.StrToInt( S,10,b );
  505. (*%T _mthread *)
  506. SetThreadOK(b);
  507. (*%E *)
  508. OK := b;
  509. RETURN i;
  510. END RdLngInt;
  511. PROCEDURE RdShtCard() : SHORTCARD;
  512. VAR
  513. S : Str80;
  514. i : LONGCARD;
  515. b : BOOLEAN;
  516. BEGIN
  517. RdItem(S);
  518. i := Str.StrToCard( S,10,b );
  519. (*%T _mthread *)
  520. SetThreadOK(b AND (i < 100H));
  521. (*%E *)
  522. OK := b AND (i < 100H);
  523. RETURN SHORTCARD( i );
  524. END RdShtCard;
  525. PROCEDURE RdShtHex() : SHORTCARD;
  526. VAR
  527. S : Str80;
  528. i : LONGCARD;
  529. b : BOOLEAN;
  530. BEGIN
  531. RdItem(S);
  532. i := Str.StrToCard( S,16,b );
  533. (*%T _mthread *)
  534. SetThreadOK(b AND (i < 100H));
  535. (*%E *)
  536. OK := b AND (i < 100H);
  537. RETURN SHORTCARD( i );
  538. END RdShtHex;
  539. PROCEDURE RdCard() : CARDINAL;
  540. VAR
  541. S : Str80;
  542. i : LONGCARD;
  543. b : BOOLEAN;
  544. BEGIN
  545. RdItem(S);
  546. i := Str.StrToCard( S,10,b );
  547. (*%T _mthread *)
  548. SetThreadOK(b AND (i < 10000H));
  549. (*%E *)
  550. OK := b AND (i < 10000H);
  551. RETURN CARDINAL( i );
  552. END RdCard;
  553. PROCEDURE RdHex() : CARDINAL;
  554. VAR
  555. S : Str80;
  556. i : LONGCARD;
  557. b : BOOLEAN;
  558. BEGIN
  559. RdItem(S);
  560. i := Str.StrToCard( S,16,b );
  561. (*%T _mthread *)
  562. SetThreadOK(b AND (i < 10000H));
  563. (*%E *)
  564. OK := b AND (i < 10000H);
  565. RETURN CARDINAL( i );
  566. END RdHex;
  567. PROCEDURE RdLngCard() : LONGCARD;
  568. VAR
  569. S : Str80;
  570. i : LONGCARD;
  571. b : BOOLEAN;
  572. BEGIN
  573. RdItem(S);
  574. i := Str.StrToCard( S,10,b );
  575. (*%T _mthread *)
  576. SetThreadOK(b);
  577. (*%E *)
  578. OK := b;
  579. RETURN i;
  580. END RdLngCard;
  581. PROCEDURE RdLngHex() : LONGCARD;
  582. VAR
  583. S : Str80;
  584. i : LONGCARD;
  585. b : BOOLEAN;
  586. BEGIN
  587. RdItem(S);
  588. i := Str.StrToCard( S,16,b );
  589. (*%T _mthread *)
  590. SetThreadOK(b);
  591. (*%E *)
  592. OK := b;
  593. RETURN i;
  594. END RdLngHex ;
  595. PROCEDURE RdReal() : REAL;
  596. VAR
  597. S : Str80;
  598. r : LONGREAL;
  599. b : BOOLEAN;
  600. BEGIN
  601. RdItem(S );
  602. r := Str.StrToReal( S,b);
  603. (*%T _mthread *)
  604. SetThreadOK(b AND (ABS(r) <= 3.4E38 ));
  605. (*%E *)
  606. OK := b AND (ABS(r) <= 3.4E38 );
  607. RETURN REAL ( r );
  608. END RdReal;
  609. PROCEDURE RdLngReal() : LONGREAL;
  610. VAR
  611. S : Str80;
  612. r : LONGREAL;
  613. b : BOOLEAN;
  614. BEGIN
  615. RdItem(S);
  616. r := Str.StrToReal( S,b);
  617. (*%T _mthread *)
  618. SetThreadOK(b);
  619. (*%E *)
  620. OK := b;
  621. RETURN r;
  622. END RdLngReal;
  623. PROCEDURE RdLn;
  624. BEGIN
  625. s:=e;
  626. END RdLn;
  627. PROCEDURE EndOfRd(Skip: BOOLEAN) : BOOLEAN;
  628. BEGIN
  629. IF Skip THEN
  630. WHILE (s < e) AND (Buffer[s] IN Separators) DO INC(s) END;
  631. END;
  632. RETURN s = e;
  633. END EndOfRd;
  634. PROCEDURE RdItem(VAR V: ARRAY OF CHAR);
  635. VAR L,i : CARDINAL;
  636. BEGIN
  637. OK := TRUE;
  638. (*%T _mthread *)
  639. SetThreadOK(TRUE);
  640. (*%E *)
  641. L := HIGH(V);
  642. REPEAT
  643. IF s=e THEN RdBuff(); END;
  644. WHILE (s<e) AND ( Buffer[s] IN Separators ) DO INC(s); END;
  645. i := 0;
  646. WHILE (s<e) AND (i<=L) AND NOT ( Buffer[s] IN Separators ) DO
  647. V[i] := Buffer[s];
  648. INC(s);
  649. INC(i);
  650. END;
  651. IF i <= L THEN V[i] := CHR(0); END;
  652. UNTIL V[0] # CHR(0);
  653. END RdItem;
  654. PROCEDURE RdChar() : CHAR;
  655. VAR
  656. c : CHAR;
  657. t : BOOLEAN;
  658. BEGIN
  659. IF s >= e THEN RdBuff; END;
  660. INC (s);
  661. RETURN Buffer[s-1];
  662. END RdChar;
  663. (*%F _OS2 *)
  664. PROCEDURE RedirectInput(FileName: ARRAY OF CHAR);
  665. VAR c : CARDINAL;
  666. r : SYSTEM.Registers;
  667. fn: PathStr;
  668. BEGIN
  669. GetName(FileName,fn);
  670. WITH r DO
  671. BX := 0;
  672. AH := 3EH; (* close file *)
  673. Lib.Dos(r);
  674. DS := Seg(fn);
  675. DX := Ofs(fn);
  676. CX := 0;
  677. AX := 3D00H; (* open for read *)
  678. Lib.Dos(r);
  679. END;
  680. InputRedirected := (Str.Compare(fn,ConStr) # 0);
  681. END RedirectInput;
  682. PROCEDURE RedirectOutput(FileName: ARRAY OF CHAR);
  683. VAR c : CARDINAL;
  684. r : SYSTEM.Registers;
  685. fn: PathStr;
  686. BEGIN
  687. GetName(FileName,fn);
  688. WITH r DO
  689. BX := 1;
  690. AH := 3EH; (* close file *)
  691. Lib.Dos(r);
  692. DS := Seg(fn);
  693. DX := Ofs(fn);
  694. CX := 0;
  695. AX := 3C00H; (* Create *)
  696. Lib.Dos(r);
  697. END ;
  698. OutputRedirected := (Str.Compare(fn,ConStr) # 0);
  699. END RedirectOutput;
  700. (*%E *)
  701. (*%T _OS2 *)
  702. PROCEDURE RedirectInput(FileName: ARRAY OF CHAR);
  703. VAR
  704. InputHandle, NewHandle: CARDINAL;
  705. ErrMsg: ARRAY [0..99] OF CHAR;
  706. fn: PathStr;
  707. BEGIN
  708. GetName(FileName,fn);
  709. InputHandle := 0;
  710. NewHandle := CoreIO._os2_open(fn, CARDINAL(CoreIO.O_RDONLY), 1, 1);
  711. IF NewHandle = MAX(CARDINAL) THEN
  712. Str.Concat(ErrMsg,'RedirectInput: ',fn);
  713. Lib.RunTimeError(CoreSig._FatalErrorPos(), 0BEH, ErrMsg);
  714. END;
  715. Dos.DupHandle(NewHandle, InputHandle);
  716. Dos.Close(NewHandle);
  717. InputRedirected := (Str.Compare(fn,ConStr) # 0);
  718. END RedirectInput;
  719. PROCEDURE RedirectOutput(FileName: ARRAY OF CHAR);
  720. VAR
  721. OutputHandle, NewHandle: CARDINAL;
  722. ErrMsg: ARRAY [0..99] OF CHAR;
  723. fn: PathStr;
  724. BEGIN
  725. GetName(FileName,fn);
  726. OutputHandle := 1;
  727. NewHandle := CoreIO._os2_open(FileName, CARDINAL(CoreIO.O_RDWR), 0, 12H);
  728. IF NewHandle = MAX(CARDINAL) THEN
  729. Str.Concat(ErrMsg,'RedirectOutput: ',fn);
  730. Lib.RunTimeError(CoreSig._FatalErrorPos(), 0BFH, ErrMsg);
  731. END;
  732. Dos.DupHandle(NewHandle, OutputHandle);
  733. Dos.Close(NewHandle);
  734. OutputRedirected := (Str.Compare(fn,ConStr) # 0);
  735. END RedirectOutput;
  736. (*%E *)
  737. PROCEDURE ThreadOK(): BOOLEAN;
  738. BEGIN
  739. (*%T _mthread *)
  740. RETURN OKTable[CoreProc._getTID()];
  741. (*%E *)
  742. (*%F _mthread *)
  743. RETURN OK;
  744. (*%E *)
  745. END ThreadOK;
  746. (*%T _mthread *)
  747. VAR
  748. n : [1..Process.MaxProcess];
  749. (*%E *)
  750. BEGIN
  751. (*%T _mthread *)
  752. n := 1;
  753. WHILE n <= Process.MaxProcess DO
  754. OKTable[n] := TRUE;
  755. INC(n);
  756. END;
  757. (*%E *)
  758. (*%F _OS2 *)
  759. Prompt := TRUE;
  760. RdLnOnWr := FALSE;
  761. WrStrRedirect := TerminalWrStr;
  762. RdStrRedirect := TerminalRdStr;
  763. s := e;
  764. OK := TRUE;
  765. ChopOff := FALSE;
  766. Separators := CHARSET{CHR(9),CHR(10),CHR(13),CHR(26),' '};
  767. Eng := FALSE;
  768. LWW := FALSE;
  769. InputRedirected := FALSE;
  770. OutputRedirected := FALSE;
  771. PrefixChar := ' ';
  772. SuffixChar := ' ';
  773. (*%E *)
  774. (*%T _OS2 *)
  775. Prompt := FALSE;
  776. RdLnOnWr := FALSE;
  777. VIOoutput := FALSE;
  778. InputRedirected := FALSE;
  779. OutputRedirected := FALSE;
  780. WrStrRedirect := TerminalWrStr;
  781. RdStrRedirect := TerminalRdStr;
  782. s := e;
  783. OK := TRUE;
  784. ChopOff := FALSE;
  785. Separators := CHARSET{CHR(9),CHR(10),CHR(13),CHR(26),' '};
  786. Eng := FALSE;
  787. LWW := FALSE;
  788. tchar := 0C;
  789. InputRedirected := FALSE;
  790. OutputRedirected := FALSE;
  791. PrefixChar := ' ';
  792. SuffixChar := ' ';
  793. (*%E *)
  794. END IO.
  795.