Listing: 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 11 (*%F _fdata *) 12 (*# call(seg_name => null) *) 13 (*# data(seg_name => null) *) 14 (*%E *) 15 (*# module(implementation=>off) *) 16 (*# call(o_a_copy => off) *) 17 (*# check(stack=>off, 18 index=>off, 19 range=>off, 20 overflow=>off, 21 nil_ptr=>off) *) 22 23 IMPLEMENTATION MODULE IO; 24 25 (*%F _OS2 *) 26 IMPORT Lib, Str, SYSTEM, CoreIO, CoreSig; 27 (*%E *) 28 (*%T _OS2 *) 29 IMPORT Str,Dos,Vio,Kbd,Lib,CoreIO,CoreSig; 30 (*%E *) 31 (*%T _mthread *) 32 IMPORT Process, CoreProc; 33 (*%E *) 34 CONST 35 TrueStr = 'TRUE'; ***** ^ not supported yet 36 ConStr = 'CON'; ***** ^ not supported yet 37 38 VAR 39 VIOoutput : BOOLEAN; 40 LWW : BOOLEAN; 41 Buffer : ARRAY[0..MaxRdLength-1] OF CHAR; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 42 s,e : CARDINAL; 43 (*%T _mthread *) 44 OKTable: ARRAY [1..Process.MaxProcess] OF BOOLEAN; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 45 (*%E *) 46 47 TYPE 48 Str80 = ARRAY[0..79] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 49 PathStr = Str80; 50 51 (*%F _OS2 *) 52 PROCEDURE KeyPressed (): BOOLEAN; 53 VAR R : SYSTEM.Registers; 54 BEGIN 55 WITH R DO 56 AH := 0BH; 57 Lib.Dos(R); 58 RETURN AL=0FFH; 59 END; 60 END KeyPressed; 61 62 PROCEDURE TerminalRdStr(VAR string: ARRAY OF CHAR); 63 VAR 64 R : SYSTEM.Registers; 65 H : CARDINAL; 66 I : CARDINAL; 67 InputBuffer : RECORD 68 LenBuf : CHAR; 69 Len : CHAR; 70 Buf : ARRAY[0..81] OF CHAR; 71 END; 72 BEGIN 73 IF Prompt AND NOT LWW THEN WrStr('?'); END; 74 LWW := FALSE; 75 H := HIGH(string); 76 IF H > 80 THEN 77 InputBuffer.LenBuf := CHR(82); 78 ELSE 79 InputBuffer.LenBuf := CHR(H+2); 80 END; 81 InputBuffer.Len := CHR(0); 82 WITH R DO 83 DS := Seg(InputBuffer); 84 DX := Ofs(InputBuffer); 85 AH := 0AH; 86 Lib.Dos(R); 87 END; 88 I := ORD(InputBuffer.Len); 89 IF I <= H THEN 90 string[I] := CHR(0); 91 END; 92 WHILE (I>0) DO 93 DEC(I); 94 string[I] := InputBuffer.Buf[I]; 95 END; 96 WrLn; 97 END TerminalRdStr; 98 (*%E *) 99 100 PROCEDURE GetName(name: ARRAY OF CHAR; VAR fn: PathStr); ***** ^ not supported yet 101 (* Makes Null terminated filename, also sets IOR to 0 *) 102 BEGIN 103 Str.Copy(fn,name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 104 fn[HIGH(fn)] := CHR(0); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 105 END GetName; ***** ^ not supported yet 106 107 108 (*%T _OS2 *) 109 110 VAR tchar : CHAR; 111 112 PROCEDURE KeyPressed():BOOLEAN; 113 VAR r : CARDINAL; k : Kbd.KEYINFO; ***** ^ not supported yet 114 BEGIN 115 k.char := 0C; ***** ^ not supported yet ***** ^ not supported yet 116 k.scan := 0; ***** ^ not supported yet ***** ^ not supported yet 117 k.nlsShift := 0; ***** ^ not supported yet ***** ^ not supported yet 118 r := Kbd.Peek(k,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 119 RETURN (tchar#0C) OR (k.scan#0) OR (k.char#0C); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 120 END KeyPressed; ***** ^ not supported yet 121 122 PROCEDURE FileRdStr(VAR string: ARRAY OF CHAR); ***** ^ not supported yet 123 VAR 124 NumRead: CARDINAL; 125 BEGIN 126 IF Dos.Read(0, FarADR(string), HIGH(string), NumRead) # 0 THEN END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 127 string[NumRead] := CHR(0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 128 END FileRdStr; ***** ^ not supported yet 129 130 PROCEDURE TerminalRdStr(VAR string: ARRAY OF CHAR); ***** ^ not supported yet 131 VAR l : Kbd.STRINGINBUF; ***** ^ not supported yet 132 r : CARDINAL; 133 BEGIN 134 IF Prompt AND NOT LWW THEN WrStr('?'); END; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 135 LWW := FALSE; 136 IF NOT InputRedirected THEN ***** ^ undeclared identifier 137 l.b := HIGH(string); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 138 r := Kbd.StringIn( string,l,0,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 139 IF l.chIn < l.b THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 140 string[l.chIn]:= 0C; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 141 END; 142 WrLn; ***** ^ undeclared identifier 143 ELSE 144 FileRdStr(string); ***** ^ not supported yet ***** ^ not supported yet 145 END; 146 END TerminalRdStr; ***** ^ not supported yet 147 (*%E *) 148 149 150 (*%T _mthread *) 151 PROCEDURE SetThreadOK( b : BOOLEAN); 152 153 BEGIN 154 OKTable[CoreProc._getTID()] := b; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 155 END SetThreadOK; ***** ^ not supported yet 156 (*%E *) 157 158 159 160 PROCEDURE WrStr(s: ARRAY OF CHAR); ***** ^ not supported yet 161 BEGIN 162 WrStrRedirect(s); ***** ^ undeclared identifier ***** ^ not supported yet 163 END WrStr; ***** ^ not supported yet 164 165 PROCEDURE RdStr ( VAR s : ARRAY OF CHAR ); ***** ^ not supported yet 166 BEGIN 167 RdStrRedirect(s); ***** ^ undeclared identifier ***** ^ not supported yet 168 END RdStr; ***** ^ not supported yet 169 170 171 PROCEDURE RdBuff; 172 VAR 173 p,h : CARDINAL; 174 BEGIN 175 RdStrRedirect(Buffer); ***** ^ undeclared identifier ***** ^ not supported yet 176 p := Str.Length(Buffer); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 177 h := SIZE(Buffer)-1; ***** ^ undeclared identifier ***** ^ not supported yet 178 IF p>h-1 THEN p := h-1; END; 179 Buffer[p] := CHR(13); INC(p); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 180 Buffer[p] := CHR(10); INC(p); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 181 IF p<=h THEN Buffer[p] := CHR(0) END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 182 e := p; s := 0; 183 END RdBuff; ***** ^ not supported yet 184 185 (*%F _OS2 *) 186 PROCEDURE TerminalWrStr(string: ARRAY OF CHAR); 187 VAR R : SYSTEM.Registers; 188 BEGIN 189 LWW := TRUE; 190 WITH R DO 191 BX := 1; 192 AH := 40H; 193 DS := Seg( string ); 194 DX := Ofs( string ); 195 CX := Str.Length(string); 196 Lib.Dos( R ); 197 END; 198 END TerminalWrStr; 199 200 PROCEDURE RdKey() : CHAR; 201 VAR R : SYSTEM.Registers; 202 BEGIN 203 WITH R DO 204 AH := 8; 205 Lib.Dos(R); 206 IF AL=0E0H THEN AL := 0 END; 207 RETURN CHR(AL); 208 END; 209 END RdKey; 210 (*%E *) 211 212 (*%T _OS2 *) 213 PROCEDURE TerminalWrStr(string: ARRAY OF CHAR); ***** ^ not supported yet 214 VAR r : CARDINAL; 215 n : CARDINAL ; 216 BEGIN 217 LWW := TRUE; 218 IF (VIOoutput) AND (NOT OutputRedirected) THEN ***** ^ undeclared identifier 219 r := Vio.WrtTTY(string,Str.Length(string),0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 220 ELSE 221 r := Dos.Write(1,FarADR(string),Str.Length(string),n); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 222 END ; 223 END TerminalWrStr; ***** ^ not supported yet 224 225 226 PROCEDURE RdKey() : CHAR; 227 VAR k : Kbd.KEYINFO; r : CARDINAL; c:CHAR; ***** ^ not supported yet 228 BEGIN 229 IF (tchar#0C) THEN 230 c := tchar; 231 tchar:=0C; 232 RETURN c; 233 ELSE 234 r := Kbd.CharIn( k,0,0 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 235 IF (k.char=0C) OR (k.char=CHR(0E0H)) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 236 tchar := CHAR(k.scan); ***** ^ not supported yet ***** ^ not supported yet 237 k.char := 0C; ***** ^ not supported yet ***** ^ not supported yet 238 END; 239 RETURN (k.char); ***** ^ not supported yet ***** ^ not supported yet 240 END; 241 END RdKey; ***** ^ not supported yet 242 (*%E *) 243 244 (*# save, 245 call(o_a_copy => on) *) 246 247 PROCEDURE WrStrAdj( S : ARRAY OF CHAR; Length : INTEGER ); ***** ^ not supported yet 248 VAR 249 L : CARDINAL; 250 a : INTEGER; 251 BEGIN 252 OK := TRUE; ***** ^ undeclared identifier 253 (*%T _mthread *) 254 SetThreadOK(TRUE); ***** ^ not supported yet ***** ^ not supported yet 255 (*%E *) 256 IF RdLnOnWr THEN RdLn; END; ***** ^ undeclared identifier ***** ^ undeclared identifier 257 L := Str.Length( S ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 258 a := ABS( Length ) - INTEGER( L ); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 259 IF (a < 0) AND ChopOff THEN ***** ^ undeclared identifier 260 L := CARDINAL(ABS(Length)); ***** ^ undeclared identifier ***** ^ not supported yet 261 IF L<=HIGH(S) THEN S[L] := CHR(0); END; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 262 WHILE (L>0) DO DEC(L); S[L] := '?'; END; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 263 OK := FALSE; ***** ^ undeclared identifier 264 (*%T _mthread *) 265 SetThreadOK(FALSE); ***** ^ not supported yet ***** ^ not supported yet 266 (*%E *) 267 a := 0; 268 END; 269 IF (Length > 0) AND (a > 0) THEN WrCharRep( PrefixChar,a ); END; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 270 WrStr( S ); ***** ^ not supported yet ***** ^ not supported yet 271 IF (Length < 0) AND (a > 0) THEN WrCharRep( SuffixChar,a ); END; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 272 END WrStrAdj; ***** ^ not supported yet 273 274 (*# restore *) 275 276 PROCEDURE WrChar( V: CHAR ); 277 BEGIN 278 IF RdLnOnWr THEN RdLn; END; ***** ^ undeclared identifier ***** ^ undeclared identifier 279 WrStr( V ); ***** ^ not supported yet ***** ^ not supported yet 280 END WrChar; ***** ^ not supported yet 281 282 PROCEDURE WrCharRep(V: CHAR; count: CARDINAL); 283 VAR 284 s : Str80; ***** ^ not supported yet 285 i,j : CARDINAL; 286 BEGIN 287 IF RdLnOnWr THEN RdLn; END; ***** ^ undeclared identifier ***** ^ undeclared identifier 288 WHILE count>0 DO 289 i := SIZE(s)-2; ***** ^ undeclared identifier ***** ^ not supported yet 290 IF i>count THEN i := count END; 291 DEC(count,i); ***** ^ undeclared identifier ***** ^ not supported yet 292 j := 0; 293 WHILE (j= -80H) AND (i < 80H)); ***** ^ not supported yet ***** ^ not supported yet 529 (*%E *) 530 OK := b AND (i >= -80H) AND (i < 80H); ***** ^ undeclared identifier 531 RETURN SHORTINT( i ); ***** ^ not supported yet 532 END RdShtInt; ***** ^ not supported yet 533 534 PROCEDURE RdInt() : INTEGER; 535 VAR 536 S : Str80; ***** ^ not supported yet 537 i : LONGINT; 538 b : BOOLEAN; 539 BEGIN 540 RdItem(S); ***** ^ undeclared identifier ***** ^ not supported yet 541 i := Str.StrToInt( S,10,b ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 542 (*%T _mthread *) 543 SetThreadOK(b AND (i >= -8000H) AND (i < 8000H)); ***** ^ not supported yet ***** ^ not supported yet 544 (*%E *) 545 OK := b AND (i >= -8000H) AND (i < 8000H); ***** ^ undeclared identifier 546 RETURN INTEGER(i); ***** ^ not supported yet 547 END RdInt; ***** ^ not supported yet 548 549 PROCEDURE RdLngInt() : LONGINT; 550 VAR 551 S : Str80; ***** ^ not supported yet 552 i : LONGINT; 553 b : BOOLEAN; 554 BEGIN 555 RdItem(S); ***** ^ undeclared identifier ***** ^ not supported yet 556 i := Str.StrToInt( S,10,b ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 557 (*%T _mthread *) 558 SetThreadOK(b); ***** ^ not supported yet ***** ^ not supported yet 559 (*%E *) 560 OK := b; ***** ^ undeclared identifier 561 RETURN i; 562 END RdLngInt; ***** ^ not supported yet 563 564 PROCEDURE RdShtCard() : SHORTCARD; 565 VAR 566 S : Str80; ***** ^ not supported yet 567 i : LONGCARD; ***** ^ undeclared identifier 568 b : BOOLEAN; 569 BEGIN 570 RdItem(S); ***** ^ undeclared identifier ***** ^ not supported yet 571 i := Str.StrToCard( S,10,b ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 572 (*%T _mthread *) 573 SetThreadOK(b AND (i < 100H)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 574 (*%E *) 575 OK := b AND (i < 100H); ***** ^ undeclared identifier ***** ^ not supported yet 576 RETURN SHORTCARD( i ); ***** ^ not supported yet 577 END RdShtCard; ***** ^ not supported yet 578 579 PROCEDURE RdShtHex() : SHORTCARD; 580 VAR 581 S : Str80; ***** ^ not supported yet 582 i : LONGCARD; ***** ^ undeclared identifier 583 b : BOOLEAN; 584 BEGIN 585 RdItem(S); ***** ^ undeclared identifier ***** ^ not supported yet 586 i := Str.StrToCard( S,16,b ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 587 (*%T _mthread *) 588 SetThreadOK(b AND (i < 100H)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 589 (*%E *) 590 OK := b AND (i < 100H); ***** ^ undeclared identifier ***** ^ not supported yet 591 RETURN SHORTCARD( i ); ***** ^ not supported yet 592 END RdShtHex; ***** ^ not supported yet 593 594 PROCEDURE RdCard() : CARDINAL; 595 VAR 596 S : Str80; ***** ^ not supported yet 597 i : LONGCARD; ***** ^ undeclared identifier 598 b : BOOLEAN; 599 BEGIN 600 RdItem(S); ***** ^ undeclared identifier ***** ^ not supported yet 601 i := Str.StrToCard( S,10,b ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 602 (*%T _mthread *) 603 SetThreadOK(b AND (i < 10000H)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 604 (*%E *) 605 OK := b AND (i < 10000H); ***** ^ undeclared identifier ***** ^ not supported yet 606 RETURN CARDINAL( i ); ***** ^ not supported yet 607 END RdCard; ***** ^ not supported yet 608 609 PROCEDURE RdHex() : CARDINAL; 610 VAR 611 S : Str80; ***** ^ not supported yet 612 i : LONGCARD; ***** ^ undeclared identifier 613 b : BOOLEAN; 614 BEGIN 615 RdItem(S); ***** ^ undeclared identifier ***** ^ not supported yet 616 i := Str.StrToCard( S,16,b ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 617 (*%T _mthread *) 618 SetThreadOK(b AND (i < 10000H)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 619 (*%E *) 620 OK := b AND (i < 10000H); ***** ^ undeclared identifier ***** ^ not supported yet 621 RETURN CARDINAL( i ); ***** ^ not supported yet 622 END RdHex; ***** ^ not supported yet 623 624 PROCEDURE RdLngCard() : LONGCARD; ***** ^ undeclared identifier 625 VAR 626 S : Str80; ***** ^ not supported yet 627 i : LONGCARD; ***** ^ undeclared identifier 628 b : BOOLEAN; 629 BEGIN 630 RdItem(S); ***** ^ undeclared identifier ***** ^ not supported yet 631 i := Str.StrToCard( S,10,b ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 632 (*%T _mthread *) 633 SetThreadOK(b); ***** ^ not supported yet ***** ^ not supported yet 634 (*%E *) 635 OK := b; ***** ^ undeclared identifier 636 RETURN i; ***** ^ not supported yet 637 END RdLngCard; ***** ^ not supported yet 638 639 PROCEDURE RdLngHex() : LONGCARD; ***** ^ undeclared identifier 640 VAR 641 S : Str80; ***** ^ not supported yet 642 i : LONGCARD; ***** ^ undeclared identifier 643 b : BOOLEAN; 644 BEGIN 645 RdItem(S); ***** ^ undeclared identifier ***** ^ not supported yet 646 i := Str.StrToCard( S,16,b ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 647 (*%T _mthread *) 648 SetThreadOK(b); ***** ^ not supported yet ***** ^ not supported yet 649 (*%E *) 650 OK := b; ***** ^ undeclared identifier 651 RETURN i; ***** ^ not supported yet 652 END RdLngHex ; ***** ^ not supported yet 653 654 PROCEDURE RdReal() : REAL; 655 VAR 656 S : Str80; ***** ^ not supported yet 657 r : LONGREAL; 658 b : BOOLEAN; 659 BEGIN 660 RdItem(S ); ***** ^ undeclared identifier ***** ^ not supported yet 661 r := Str.StrToReal( S,b); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 662 (*%T _mthread *) 663 SetThreadOK(b AND (ABS(r) <= 3.4E38 )); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 664 (*%E *) 665 OK := b AND (ABS(r) <= 3.4E38 ); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 666 RETURN REAL ( r ); ***** ^ not supported yet 667 END RdReal; ***** ^ not supported yet 668 669 PROCEDURE RdLngReal() : LONGREAL; 670 VAR 671 S : Str80; ***** ^ not supported yet 672 r : LONGREAL; 673 b : BOOLEAN; 674 BEGIN 675 RdItem(S); ***** ^ undeclared identifier ***** ^ not supported yet 676 r := Str.StrToReal( S,b); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 677 (*%T _mthread *) 678 SetThreadOK(b); ***** ^ not supported yet ***** ^ not supported yet 679 (*%E *) 680 OK := b; ***** ^ undeclared identifier 681 RETURN r; 682 END RdLngReal; ***** ^ not supported yet 683 684 685 PROCEDURE RdLn; 686 BEGIN 687 s:=e; 688 END RdLn; ***** ^ not supported yet 689 690 PROCEDURE EndOfRd(Skip: BOOLEAN) : BOOLEAN; 691 BEGIN 692 IF Skip THEN 693 WHILE (s < e) AND (Buffer[s] IN Separators) DO INC(s) END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 694 END; 695 RETURN s = e; 696 END EndOfRd; ***** ^ not supported yet 697 698 PROCEDURE RdItem(VAR V: ARRAY OF CHAR); ***** ^ not supported yet 699 VAR L,i : CARDINAL; 700 BEGIN 701 OK := TRUE; ***** ^ undeclared identifier 702 (*%T _mthread *) 703 SetThreadOK(TRUE); ***** ^ not supported yet ***** ^ not supported yet 704 (*%E *) 705 L := HIGH(V); ***** ^ undeclared identifier ***** ^ not supported yet 706 REPEAT 707 IF s=e THEN RdBuff(); END; ***** ^ not supported yet ***** ^ not supported yet 708 WHILE (s= e THEN RdBuff; END; ***** ^ not supported yet 725 INC (s); ***** ^ undeclared identifier ***** ^ not supported yet 726 RETURN Buffer[s-1]; ***** ^ not supported yet ***** ^ not supported yet 727 END RdChar; ***** ^ not supported yet 728 729 (*%F _OS2 *) 730 PROCEDURE RedirectInput(FileName: ARRAY OF CHAR); 731 VAR c : CARDINAL; 732 r : SYSTEM.Registers; 733 fn: PathStr; 734 BEGIN 735 GetName(FileName,fn); 736 WITH r DO 737 BX := 0; 738 AH := 3EH; (* close file *) 739 Lib.Dos(r); 740 DS := Seg(fn); 741 DX := Ofs(fn); 742 CX := 0; 743 AX := 3D00H; (* open for read *) 744 Lib.Dos(r); 745 END; 746 InputRedirected := (Str.Compare(fn,ConStr) # 0); 747 END RedirectInput; 748 749 PROCEDURE RedirectOutput(FileName: ARRAY OF CHAR); 750 VAR c : CARDINAL; 751 r : SYSTEM.Registers; 752 fn: PathStr; 753 BEGIN 754 GetName(FileName,fn); 755 WITH r DO 756 BX := 1; 757 AH := 3EH; (* close file *) 758 Lib.Dos(r); 759 DS := Seg(fn); 760 DX := Ofs(fn); 761 CX := 0; 762 AX := 3C00H; (* Create *) 763 Lib.Dos(r); 764 END ; 765 OutputRedirected := (Str.Compare(fn,ConStr) # 0); 766 END RedirectOutput; 767 (*%E *) 768 769 (*%T _OS2 *) 770 PROCEDURE RedirectInput(FileName: ARRAY OF CHAR); ***** ^ not supported yet 771 VAR 772 InputHandle, NewHandle: CARDINAL; 773 ErrMsg: ARRAY [0..99] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 774 fn: PathStr; ***** ^ not supported yet 775 BEGIN 776 GetName(FileName,fn); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 777 InputHandle := 0; 778 NewHandle := CoreIO._os2_open(fn, CARDINAL(CoreIO.O_RDONLY), 1, 1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 779 IF NewHandle = MAX(CARDINAL) THEN ***** ^ undeclared identifier ***** ^ not supported yet 780 Str.Concat(ErrMsg,'RedirectInput: ',fn); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 781 Lib.RunTimeError(CoreSig._FatalErrorPos(), 0BEH, ErrMsg); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 782 END; 783 Dos.DupHandle(NewHandle, InputHandle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 784 Dos.Close(NewHandle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 785 InputRedirected := (Str.Compare(fn,ConStr) # 0); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 786 END RedirectInput; ***** ^ not supported yet 787 788 PROCEDURE RedirectOutput(FileName: ARRAY OF CHAR); ***** ^ not supported yet 789 VAR 790 OutputHandle, NewHandle: CARDINAL; 791 ErrMsg: ARRAY [0..99] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 792 fn: PathStr; ***** ^ not supported yet 793 BEGIN 794 GetName(FileName,fn); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 795 OutputHandle := 1; 796 NewHandle := CoreIO._os2_open(FileName, CARDINAL(CoreIO.O_RDWR), 0, 12H); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 797 IF NewHandle = MAX(CARDINAL) THEN ***** ^ undeclared identifier ***** ^ not supported yet 798 Str.Concat(ErrMsg,'RedirectOutput: ',fn); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 799 Lib.RunTimeError(CoreSig._FatalErrorPos(), 0BFH, ErrMsg); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 800 END; 801 Dos.DupHandle(NewHandle, OutputHandle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 802 Dos.Close(NewHandle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 803 OutputRedirected := (Str.Compare(fn,ConStr) # 0); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 804 END RedirectOutput; ***** ^ not supported yet 805 (*%E *) 806 807 PROCEDURE ThreadOK(): BOOLEAN; 808 809 BEGIN 810 (*%T _mthread *) 811 RETURN OKTable[CoreProc._getTID()]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 812 (*%E *) 813 (*%F _mthread *) 814 RETURN OK; 815 (*%E *) 816 END ThreadOK; ***** ^ not supported yet 817 818 (*%T _mthread *) 819 VAR 820 n : [1..Process.MaxProcess]; ***** ^ not supported yet ***** ^ not supported yet 821 (*%E *) 822 BEGIN 823 (*%T _mthread *) 824 n := 1; ***** ^ not supported yet 825 WHILE n <= Process.MaxProcess DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 826 OKTable[n] := TRUE; ***** ^ not supported yet ***** ^ not supported yet 827 INC(n); ***** ^ undeclared identifier ***** ^ not supported yet 828 END; 829 (*%E *) 830 (*%F _OS2 *) 831 Prompt := TRUE; 832 RdLnOnWr := FALSE; 833 WrStrRedirect := TerminalWrStr; 834 RdStrRedirect := TerminalRdStr; 835 s := e; 836 OK := TRUE; 837 ChopOff := FALSE; 838 Separators := CHARSET{CHR(9),CHR(10),CHR(13),CHR(26),' '}; 839 Eng := FALSE; 840 LWW := FALSE; 841 InputRedirected := FALSE; 842 OutputRedirected := FALSE; 843 PrefixChar := ' '; 844 SuffixChar := ' '; 845 (*%E *) 846 847 (*%T _OS2 *) 848 Prompt := FALSE; ***** ^ undeclared identifier 849 RdLnOnWr := FALSE; ***** ^ undeclared identifier 850 VIOoutput := FALSE; 851 InputRedirected := FALSE; ***** ^ undeclared identifier 852 OutputRedirected := FALSE; ***** ^ undeclared identifier 853 WrStrRedirect := TerminalWrStr; ***** ^ undeclared identifier ***** ^ not supported yet 854 RdStrRedirect := TerminalRdStr; ***** ^ undeclared identifier ***** ^ not supported yet 855 s := e; 856 OK := TRUE; ***** ^ undeclared identifier 857 ChopOff := FALSE; ***** ^ undeclared identifier 858 Separators := CHARSET{CHR(9),CHR(10),CHR(13),CHR(26),' '}; ***** ^ undeclared identifier ***** ^ undeclared identifier 859 Eng := FALSE; 860 LWW := FALSE; 861 tchar := 0C; 862 InputRedirected := FALSE; 863 OutputRedirected := FALSE; 864 PrefixChar := ' '; 865 SuffixChar := ' '; 866 (*%E *) 867 END IO. 714 errors