PL/M-80 COMPILER 6/11/79 PAGE 1 ISIS-II PL/M-80 V3.1 COMPILATION OF MODULE SXMT OBJECT MODULE PLACED IN :F1:SXMT.OBJ COMPILER INVOKED BY: PLM80 :F1:SXMT.SRC DEBUG DATE(6/11/79) 1 SXMT: DO; $INCLUDE (:F1:COMMON.LIT) 2 1 = DECLARE LIT LITERALLY 'LITERALLY'; 3 1 = DECLARE DECL LIT 'DECLARE'; 4 1 = DECL TRUE LIT '0FFH', = FALSE LIT '00H', = BOOLEAN LIT 'BYTE', = FOREVER LIT 'WHILE 1'; = = = /* SPECIAL ASCII CHARACTERS */ = 5 1 = DECL = NULL LIT '00H', = CNTRL$C LIT '03H', = CNTRL$E LIT '05H', = BELL LIT '07H', = BS LIT '08H', = TAB LIT '09H', = LF LIT '0AH', = VT LIT '0BH', = FF LIT '0CH', = CR LIT '0DH', = CNTRL$P LIT '010H', = CNTRL$Q LIT '011H', = CNTRL$R LIT '012H', = CNTRL$S LIT '013H', = CNTRL$W LIT '017H', = CNTRL$X LIT '018H', = CNTRL$Z LIT '01AH', = ESC LIT '01BH', = SPACE LIT '020H', = EXCLM$PT LIT '021H', = QUOTE LIT '022H', = HASH LIT '023H', = PRCNT LIT '025H', = AMPRSAND LIT '026H', = DASH LIT '02DH', = LS$THAN LIT '03CH', = GR$THAN LIT '03EH', = QMARK LIT '03FH', = LFT$BRK LIT '05BH', = RT$BRK LIT '05DH', = UP$ARW LIT '05EH', = LCA LIT '061H', = LCZ LIT '07AH', = ALT$MOD LIT '07DH', = RUBOUT LIT '07FH'; = PL/M-80 COMPILER 6/11/79 PAGE 2 $EJECT $INCLUDE (:F1:ISS.COM) 6 1 = OPEN: PROCEDURE (AFTPTR,FILE,ACCESS,MODE,STATUS) EXTERNAL; 7 2 = DECL (AFTPTR,FILE,ACCESS,MODE,STATUS) ADDRESS; 8 2 = END OPEN; = 9 1 = CLOSE: PROCEDURE (AFT,STATUS) EXTERNAL; 10 2 = DECL (AFT,STATUS) ADDRESS; 11 2 = END CLOSE; = 12 1 = DELETE: PROCEDURE (FILE,STATUS) EXTERNAL; 13 2 = DECL (FILE,STATUS) ADDRESS; 14 2 = END DELETE; = 15 1 = READ: PROCEDURE (AFT,BUFFER,COUNT,ACTUAL,STATUS) EXTERNAL; 16 2 = DECL (AFT,BUFFER,COUNT,ACTUAL,STATUS) ADDRESS; 17 2 = END READ; = 18 1 = WRITE: PROCEDURE (AFT,BUFFER,COUNT,STATUS) EXTERNAL; 19 2 = DECL (AFT,BUFFER,COUNT,STATUS) ADDRESS; 20 2 = END WRITE; = 21 1 = SEEK: PROCEDURE (AFT,BASE,BLOCKNUM,BYTENUM,STATUS) EXTERNAL; 22 2 = DECL (AFT,BASE,BLOCKNUM,BYTENUM,STATUS) ADDRESS; 23 2 = END SEEK; = 24 1 = LOAD: PROCEDURE (FILE,BIAS,RETSW,ENTRY,STATUS) EXTERNAL; 25 2 = DECL (FILE,BIAS,RETSW,ENTRY,STATUS) ADDRESS; 26 2 = END LOAD; = 27 1 = RENAME: PROCEDURE (OLDFILE,NEWFILE,STATUS) EXTERNAL; 28 2 = DECL (OLDFILE,NEWFILE,STATUS) ADDRESS; 29 2 = END RENAME; = 30 1 = CONSOL: PROCEDURE (INFILE,OUTFILE,STATUS) EXTERNAL; 31 2 = DECL (INFILE,OUTFILE,STATUS) ADDRESS; 32 2 = END CONSOL; = 33 1 = EXIT: PROCEDURE EXTERNAL; 34 2 = END EXIT; = 35 1 = ATTRIB: PROCEDURE (FILE,SWID,VALUE,STATUS) EXTERNAL; 36 2 = DECL (FILE,SWID,VALUE,STATUS) ADDRESS; 37 2 = END ATTRIB; = 38 1 = RESCAN: PROCEDURE (AFT,STATUS) EXTERNAL; 39 2 = DECL (AFT,STATUS) ADDRESS; 40 2 = END RESCAN; = 41 1 = ERROR: PROCEDURE (ERRNUM) EXTERNAL; 42 2 = DECL (ERRNUM) ADDRESS; 43 2 = END ERROR; = 44 1 = WHOCON: PROCEDURE (AFT,BUFFER) EXTERNAL; 45 2 = DECL (AFT,BUFFER) ADDRESS; 46 2 = END WHOCON; PL/M-80 COMPILER 6/11/79 PAGE 3 = = 47 1 = DECL READ$AC LIT '01H', = WRITE$AC LIT '02H', = UPDATE$AC LIT '03H'; = 48 1 = DECL CI$AFT LIT '01H', = CO$AFT LIT '0H', = LN$EDT$CO LIT '0F0H'; = PL/M-80 COMPILER 6/11/79 PAGE 4 $EJECT $INCLUDE (:F1:DEFIO) 49 1 = DECL KBD$STAT LIT '0C1H'; 50 1 = DECL KBD$DATA LIT '0C0H'; 51 1 = DECL KBD$RDY LIT '01H'; 52 1 = DECL SIO$STAT LIT '0F7H'; 53 1 = DECL SIO$DATA LIT '0F6H'; 54 1 = DECL SIO$RXRDY LIT '02H'; 55 1 = DECL SIO$TXRDY LIT '01H'; 56 1 = DECL CRTC LIT '10H';/*CRT OUTPUT DATA COMMAND*/ 57 1 = DECL CRTS LIT '11H';/*CRT DEVICE STATUS COMMAND*/ 58 1 = DECL KEYC LIT '12H';/*KEYBOARD INPUT DATA COMMAND*/ 59 1 = DECL KSTS LIT '13H';/*KEYBOARD DEVICE STATUS COMMAND*/ 60 1 = DECL OBF LIT '01H'; 61 1 = DECL IBF LIT '02H'; 62 1 = DECL FO LIT '04H'; 63 1 = DECL CPUC LIT '0FFH'; 64 1 = DECL DISABL LIT '0DH'; 65 1 = DECL ENABL LIT '05H'; 66 1 = DECL IOCC LIT '0C1H'; 67 1 = DECL IOCS LIT '0C1H'; 68 1 = DECL IOCO LIT '0C0H'; 69 1 = DECL IOCI LIT '0C0H'; PL/M-80 COMPILER 6/11/79 PAGE 5 $EJECT 70 1 DECL AFT ADDRESS; 71 1 DECL CHAR BYTE; 72 1 DECL STAT ADDRESS; 73 1 CO: PROCEDURE (ODB) EXTERNAL; 74 2 DECL ODB BYTE; 75 2 END CO; 76 1 IOCCOM: PROCEDURE (COMMAND) BYTE PUBLIC; 77 2 DECL COMMAND BYTE; 78 2 DECL STIN BYTE; 79 2 OUTPUT (CPUC) = DISABL; 80 2 DO WHILE ((INPUT (IOCS) ) AND (OBF OR IBF OR FO)) <> 0; 81 3 END; 82 2 OUTPUT (IOCS) = COMMAND; 83 2 DO WHILE (INPUT (IOCS) AND (OBF OR IBF OR FO)) <> OBF; 84 3 END; 85 2 STIN = INPUT (IOCI); 86 2 OUTPUT (CPUC) = ENABL; 87 2 RETURN (STIN); 88 2 END IOCCOM; 89 1 MEMCK: PROCEDURE ADDRESS EXTERNAL; 90 2 END MEMCK; 91 1 SCHAR: PROCEDURE (CHAR) PUBLIC; 92 2 DECL CHAR BYTE; 93 2 DO WHILE (INPUT (SIO$STAT) AND SIO$TXRDY) = 0; 94 3 END; 95 2 OUTPUT (SIO$DATA) = CHAR; 96 2 RETURN; 97 2 END; 98 1 DECL CHR BYTE; 99 1 DECL LF$FLG BYTE INITIAL(FALSE); 100 1 DECL MAXCNT LIT 'LENGTH(TCHAR)'; 101 1 DECL TCNTIN BYTE INITIAL (0); 102 1 DECL TCNTOUT BYTE INITIAL (0); 103 1 DECL TCHAR(256) BYTE; 104 1 ISCAN: PROCEDURE BYTE PUBLIC; 105 2 DO FOREVER; 106 3 IF (INPUT(SIO$STAT) AND SIO$RXRDY) > 0 THEN 107 3 DO; 108 4 CHR = (INPUT(SIO$DATA) AND 07FH); 109 4 IF ((CHR > 0) AND ((LF$FLG = FALSE) OR PL/M-80 COMPILER 6/11/79 PAGE 6 ((LF$FLG = TRUE) AND (CHR <> LF)))) THEN 110 4 DO; 111 5 TCNTIN = TCNTIN + 1; 112 5 TCHAR(TCNTIN) = CHR; 113 5 IF CHR = CR THEN 114 5 DO; 115 6 LF$FLG = TRUE; 116 6 TCNTIN = TCNTIN + 1; 117 6 TCHAR(TCNTIN) = LF; 118 6 END; ELSE 119 5 LF$FLG = FALSE; 120 5 END; 121 4 IF ((LF$FLG = TRUE) AND (CHR = LF)) THEN LF$FLG = FALSE; 123 4 END; 124 3 IF (TCNTIN - TCNTOUT) <> 0 THEN 125 3 DO; 126 4 IF (INPUT(IOCS) AND (OBF OR IBF OR FO)) = 0 THEN 127 4 DO; 128 5 TCNTOUT = TCNTOUT + 1; 129 5 CALL CO(TCHAR(TCNTOUT)); 130 5 END; 131 4 END; 132 3 IF (INPUT(IOCS) AND (FO OR IBF OR OBF)) = 0 THEN 133 3 DO; 134 4 IF (IOCCOM(KSTS) AND KBD$RDY) THEN 135 4 DO; 136 5 RETURN(IOCCOM(KEYC) AND 07FH); 137 5 END; 138 4 END; 139 3 END; 140 2 END ISCAN; 141 1 SIO$SCAN: PROCEDURE BYTE PUBLIC; 142 2 DECL CHAR BYTE; 143 2 SIO$SCAN1: DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 144 3 IF ((IOCCOM (KSTS)) AND KBD$RDY) <> 0 THEN 145 3 DO; 146 4 CALL SCHAR ((IOCCOM (KEYC)) AND 07FH); 147 4 END; 148 3 END; 149 2 CHAR = (INPUT (SIO$DATA) AND 07FH); 150 2 IF CHAR < SPACE THEN 151 2 DO; 152 3 IF (CHAR < BS) OR (CHAR > CR) THEN 153 3 GOTO SIO$SCAN1; 154 3 END; 155 2 RETURN (CHAR); 156 2 END SIO$SCAN; 157 1 TIM$OUT: PROCEDURE; 158 2 DECL REC$TIME BYTE; PL/M-80 COMPILER 6/11/79 PAGE 7 159 2 REC$TIME = 0; 160 2 DO WHILE REC$TIME < 30; 161 3 IF (INPUT (SIO$STAT) AND SIO$RXRDY) > 0 THEN 162 3 DO; 163 4 CALL CO (INPUT (SIO$DATA) AND 07FH); 164 4 REC$TIME = 0; 165 4 END; 166 3 CALL TIME (10); 167 3 REC$TIME = REC$TIME + 1; 168 3 END; 169 2 END TIM$OUT; 170 1 SEND$CHAR: PROCEDURE (BYT$OUT) PUBLIC; 171 2 DECL BYT$OUT BYTE; 172 2 DECL CHAR BYTE; /* IF RECEIVING SYSTEM CANNOT TAKE CHARACTERS AT FULL SPEED */ 173 2 IF (INPUT (SIO$STAT) AND SIO$RXRDY) > 0 THEN 174 2 CALL TIM$OUT; /*CHAR RECEIVED WITHOUT SENDING ANYTHING*/ 175 2 DO WHILE (INPUT (SIO$STAT) AND SIO$TXRDY) = 0; 176 3 END; 177 2 IF BYT$OUT > SPACE THEN GOTO SEND; 179 2 IF BYT$OUT < BS THEN RETURN; 181 2 IF BYT$OUT = TAB THEN 182 2 DO; 183 3 CR$FLG = FALSE; 184 3 OUTPUT (SIO$DATA) = BYT$OUT; 185 3 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 186 4 END; 187 3 CALL TIM$OUT; 188 3 RETURN; 189 3 END; 190 2 IF BYT$OUT = CR THEN 191 2 DO; 192 3 CR$FLG = TRUE; 193 3 GOTO SEND1; 194 3 END; 195 2 IF BYT$OUT = LF THEN 196 2 DO; 197 3 IF CR$FLG = TRUE THEN 198 3 DO; 199 4 CR$FLG = FALSE; 200 4 RETURN; 201 4 END; 202 3 END; 203 2 IF BYT$OUT = VT THEN 204 2 DO; 205 3 CR$FLG = FALSE; 206 3 OUTPUT (SIO$DATA) = BYT$OUT; 207 3 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 208 4 END; 209 3 CALL TIM$OUT; 210 3 RETURN; PL/M-80 COMPILER 6/11/79 PAGE 8 211 3 END; 212 2 IF BYT$OUT = FF THEN 213 2 DO; 214 3 CR$FLG = FALSE; 215 3 OUTPUT (SIO$DATA) = BYT$OUT; 216 3 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 217 4 END; 218 3 CALL TIM$OUT; 219 3 RETURN; 220 3 END; 221 2 SEND: CR$FLG = FALSE; 222 2 SEND1: OUTPUT (SIO$DATA) = BYT$OUT; 223 2 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 224 3 END; 225 2 CHAR = (INPUT (SIO$DATA) AND 07FH); 226 2 CALL CO (CHAR); 227 2 IF CHAR = CR THEN 228 2 DO WHILE CHAR <> LF; 229 3 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 230 4 END; 231 3 CHAR = (INPUT (SIO$DATA) AND 07FH); 232 3 CALL CO (CHAR); 233 3 END; 234 2 IF CHAR = LF THEN CALL TIME (10); 236 2 IF CHAR = CNTRL$S THEN 237 2 DO; 238 3 CALL CO (UP$ARW); 239 3 CALL CO ('S'); 240 3 DO WHILE CHAR <> CNTRL$Q; 241 4 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 242 5 END; 243 4 CHAR = (INPUT (SIO$DATA) AND 07FH); 244 4 END; 245 3 CALL CO (UP$ARW); 246 3 CALL CO ('Q'); 247 3 END; 248 2 RETURN; 249 2 END SEND$CHAR; 250 1 B$SEND$CHAR: PROCEDURE (CHAR); 251 2 DECL IDATA BYTE; 252 2 DECL CHAR BYTE; 253 2 IF CR$FLG = TRUE THEN 254 2 DO; 255 3 CR$FLG = FALSE; 256 3 IF CHAR = LF THEN 257 3 RETURN; 258 3 END; 259 2 IF CHAR < SPACE THEN 260 2 DO; 261 3 IF ((CHAR = BS) OR (CHAR = TAB) OR (CHAR = VT) OR (CHAR = FF) OR (CHAR = LF)) THEN CHAR = (CHAR OR 080H); 263 3 END; PL/M-80 COMPILER 6/11/79 PAGE 9 264 2 CALL SCHAR(CHAR); 265 2 IDATA = 0; 266 2 IF CHAR = CR THEN 267 2 DO; 268 3 CR$FLG = TRUE; 269 3 DO WHILE IDATA <> CNTRL$Q; 270 4 DO WHILE (INPUT(SIO$STAT) AND SIO$RXRDY) = 0; 271 5 END; 272 4 IDATA = (INPUT (SIO$DATA) AND 07FH); 273 4 END; 274 3 END; 275 2 RETURN; 276 2 END B$SEND$CHAR; 277 1 SIO$CHECK: PROCEDURE BYTE; 278 2 DECL FLAG BYTE; 279 2 IF (INPUT (SIO$STAT) AND SIO$RXRDY) <> 0 THEN 280 2 FLAG = TRUE; 281 2 ELSE FLAG = FALSE; 282 2 RETURN (FLAG); 283 2 END SIO$CHECK; 284 1 DECL ACTUAL ADDRESS; 285 1 DECL I ADDRESS; 286 1 DECL FLAG BYTE; 287 1 DECL COUNT BYTE; 288 1 DECL CR$FLG BYTE PUBLIC; 289 1 TEST: PROCEDURE BYTE; 290 2 IF MEMORY(I - 1) <> LF THEN GOTO TST1; 292 2 IF MEMORY(I - 2) <> CR THEN GOTO TST2; 294 2 RETURN (TRUE); 295 2 TST1: IF MEMORY(I-1) <> CR THEN RETURN (FALSE); 297 2 IF MEMORY(I-2) <> LF THEN RETURN (FALSE); 299 2 RETURN (TRUE); 300 2 TST2: IF MEMORY(I-2) <> NULL THEN RETURN (FALSE); 302 2 RETURN (TRUE); 303 2 END TEST; 304 1 XMTCM: PROCEDURE PUBLIC; /* WAIT FOR END OF COMMAND LINE */ 305 2 DECL CHAR BYTE; 306 2 CHAR = 0; /* WAIT FOR CR TO TERMINATE COMMAND THEN CR TO BE ECHOED */ 307 2 DO WHILE CHAR <> CR; 308 3 CHAR = ISCAN; 309 3 CALL SCHAR (CHAR); PL/M-80 COMPILER 6/11/79 PAGE 10 310 3 END; 311 2 CHAR = 0; 312 2 DO WHILE CHAR <> CR; 313 3 CHAR = SIO$SCAN; 314 3 CALL CO (CHAR); 315 3 END; /* WAIT ONE MORE CHARACTER FOR LINE FEED */ /* NOT NEEDED IN ALL SYSTEMS */ /* CHAR = SIO$SCAN; CALL CO (CHAR); */ /* BEGIN TRANSMISSION */ 316 2 DO CASE TRANSFER$MODE; 317 3 RETURN; 318 3 GOTO SEND$LOOP; 319 3 GOTO RECEIVE$LOOP; 320 3 GOTO BLOCK$SEND$LOOP; 321 3 END; 322 2 RECEIVE$LOOP: I = 0; 323 2 FLAG = FALSE; 324 2 COUNT = 0; 325 2 MEMORY(I) = SIO$SCAN; 326 2 IF MEMORY(I) <> LF THEN GOTO REC$NXT1; 328 2 REC$NXT: MEMORY(I) = SIO$SCAN; 329 2 REC$NXT1: IF MEMORY(I) = PROMPT THEN FLAG = TEST; 331 2 IF FLAG = TRUE THEN GOTO REC$END; 333 2 NEXT: IF MEMORY(I) < SPACE THEN 334 2 DO; 335 3 IF (MEMORY(I) < BS) OR (MEMORY(I) > CR) THEN GOTO REC$NXT; 337 3 END; 338 2 I = I+1; 339 2 IF I >= MAX$MEM THEN 340 2 DO; 341 3 CALL SCHAR (CNTRL$S); 342 3 DO WHILE COUNT < 100; 343 4 IF SIO$CHECK = TRUE THEN 344 4 DO; 345 5 MEMORY(I) = INPUT (SIO$DATA); 346 5 IF MEMORY(I) < SPACE THEN 347 5 DO; 348 6 IF MEMORY(I) <> CR THEN GOTO RESTIME; 350 6 I = I+1; 351 6 MEMORY(I) = LF; 352 6 END; 353 5 IF MEMORY(I) = PROMPT THEN FLAG = TEST; 355 5 IF FLAG = TRUE THEN GOTO REC$END; 357 5 I = I+1; 358 5 RESTIME: COUNT = 0; 359 5 IF I >= MEM$LIMIT THEN COUNT = 100; 361 5 END; PL/M-80 COMPILER 6/11/79 PAGE 11 362 4 CALL TIME (2); 363 4 COUNT = COUNT+1; 364 4 END; 365 3 CALL WRITE (AFT,.MEMORY,I,.STAT); 366 3 I = 0; 367 3 CALL SCHAR (CNTRL$Q); 368 3 GOTO RECEIVE$LOOP; 369 3 END; 370 2 GOTO REC$NXT; /* TRANSMISSION DONE WRITE INFO AND RESET BUFFER */ 371 2 REC$END: CALL WRITE (AFT,.MEMORY,I,.STAT); 372 2 IF STAT > 0 THEN CALL ERROR (STAT); 374 2 CALL CO (CR); 375 2 CALL CO (LF); 376 2 CALL CO (PROMPT); 377 2 I = 0; 378 2 RETURN; 379 2 BLOCK$SEND$LOOP: DO WHILE CHAR <> LF; 380 3 CHAR = SIO$SCAN; 381 3 CALL CO(CHAR); 382 3 END; 383 2 CR$FLG = FALSE; 384 2 CALL B$SEND$CHAR(CR); 385 2 B$SEND$LOOP1: CALL READ (AFT,.MEMORY,MAX$MEM,.ACTUAL,.STAT); 386 2 IF STAT > 0 THEN 387 2 DO; 388 3 CALL ERROR(STAT); 389 3 RETURN; 390 3 END; 391 2 IF ACTUAL < 1 THEN 392 2 DO; 393 3 CALL SCHAR(END$O$FILE); 394 3 RETURN; 395 3 END; 396 2 I = 0; 397 2 DO WHILE I < ACTUAL; 398 3 CALL B$SEND$CHAR (MEMORY(I)); 399 3 IF MEMORY(I) = CR THEN 400 3 DO; 401 4 IF ((IOCCOM(KSTS)) AND KBD$RDY) <> 0 THEN 402 4 DO; 403 5 IF ((IOCCOM(KEYC)) AND 07FH) = ESC THEN 404 5 RETURN; 405 5 END; 406 4 END; 407 3 I = I + 1; 408 3 END; 409 2 GOTO B$SEND$LOOP1; 410 2 SEND$LOOP: DO WHILE CHAR <> LF; 411 3 CHAR = SIO$SCAN; PL/M-80 COMPILER 6/11/79 PAGE 12 412 3 CALL CO (CHAR); 413 3 END; 414 2 CR$FLG = FALSE; 415 2 SEND$LOOP1: CALL READ (AFT,.MEMORY,MAX$MEM,.ACTUAL,.STAT); 416 2 IF STAT > 0 THEN 417 2 DO; 418 3 CALL ERROR (STAT); 419 3 RETURN; 420 3 END; 421 2 IF ACTUAL < 1 THEN 422 2 DO; 423 3 CALL SCHAR (END$O$FILE); 424 3 RETURN; 425 3 END; 426 2 I = 0; 427 2 DO WHILE I < ACTUAL; 428 3 CALL SEND$CHAR (MEMORY (I)); 429 3 IF MEMORY(I) = CR THEN 430 3 DO; 431 4 IF ((IOCCOM (KSTS)) AND KBD$RDY) <> 0 THEN 432 4 DO; 433 5 IF ((IOCCOM (KEYC)) AND 07FH) = ESC THEN RETURN; 435 5 END; 436 4 END; 437 3 I = I+1; 438 3 END; 439 2 GOTO SEND$LOOP1; 440 2 END; 441 1 COM$DEC: PROCEDURE (CHAR,ADR$COM$ARRAY,COUNT) BYTE PUBLIC; 442 2 DECL (CHAR,I,TEST,COUNT) BYTE; 443 2 DECL ADR$COM$ARRAY ADDRESS; 444 2 DECL (COM$ARRAY BASED ADR$COM$ARRAY) (128) BYTE; 445 2 I=0; 446 2 TEST=FALSE; 447 2 DO WHILE TEST=FALSE; 448 3 IF CHAR = COM$ARRAY(I) THEN 449 3 TEST = TRUE; 450 3 ELSE DO; 451 4 I = I+1; 452 4 IF I > COUNT THEN 453 4 TEST = TRUE; 454 4 END; 455 3 END; 456 2 RETURN (I); 457 2 END; 458 1 DECL KEY$BUFFER(122) BYTE PUBLIC; 459 1 DECL AFT$IN ADDRESS PUBLIC; PL/M-80 COMPILER 6/11/79 PAGE 13 460 1 DECL CONSL$INP(*) BYTE PUBLIC INITIAL(':CI:'); 461 1 DECL ACTL ADDRESS PUBLIC; 462 1 DECL STATUS ADDRESS PUBLIC; 463 1 DECL INDEX BYTE; 464 1 DECL FILE$COMMANDS(*) BYTE INITIAL ('RWTCPEX'); 465 1 READ$SETUP: PROCEDURE PUBLIC; 466 2 IF TRANSFER$MODE > 0 THEN 467 2 DO; 468 3 CALL CLOSE (AFT,.STAT); 469 3 IF STAT > 0 THEN CALL ERROR (STAT); 471 3 END; 472 2 CALL OPEN (.AFT,.KEY$BUFFER(2),READ$AC,0,.STAT); 473 2 IF STAT > 0 THEN CALL ERROR (STAT); 475 2 IF STAT > 0 THEN TRANSFER$MODE = 0; 477 2 ELSE TRANSFER$MODE = 1; 478 2 CALL CO(PROMPT); 479 2 RETURN; 480 2 END READ$SETUP; 481 1 BLOCK$READ$SETUP: PROCEDURE PUBLIC; 482 2 IF TRANSFER$MODE > 0 THEN 483 2 DO; 484 3 CALL CLOSE (AFT,.STAT); 485 3 IF STAT > 0 THEN CALL ERROR (STAT); 487 3 END; 488 2 CALL OPEN (.AFT,.KEYBUFFER(2),READ$AC,0,.STAT); 489 2 IF STAT > 0 THEN CALL ERROR (STAT); 491 2 IF STAT > 0 THEN TRANSFER$MODE = 0; 493 2 ELSE TRANSFER$MODE = 3; 494 2 CALL CO(PROMPT); 495 2 RETURN; 496 2 END BLOCK$READ$SETUP; 497 1 WRITE$SETUP: PROCEDURE PUBLIC; 498 2 IF TRANSFER$MODE > 0 THEN 499 2 DO; 500 3 CALL CLOSE (AFT,.STAT); 501 3 IF STAT > 0 THEN CALL ERROR (STAT); 503 3 END; 504 2 CALL OPEN (.AFT,.KEY$BUFFER(2),WRITE$AC,0,.STAT); 505 2 IF STAT > 0 THEN CALL ERROR (STAT); 507 2 IF STAT > 0 THEN TRANSFER$MODE = 0; 509 2 ELSE TRANSFER$MODE = 2; 510 2 CALL CO (PROMPT); 511 2 RETURN; 512 2 END WRITE$SETUP; 513 1 CLOSE$SETUP: PROCEDURE PUBLIC; 514 2 CALL CLOSE (AFT,.STAT); 515 2 IF STAT > 0 THEN CALL ERROR (STAT); 517 2 TRANSFER$MODE = 0; 518 2 CALL CO (PROMPT); PL/M-80 COMPILER 6/11/79 PAGE 14 519 2 RETURN; 520 2 END CLOSE$SETUP; 521 1 SET$NEW$PROMPT: PROCEDURE PUBLIC; /* ALLOW ALL PRINTING ASCII CHARACTERS TO BE PROMPT */ 522 2 IF SPACE < KEY$BUFFER(2) THEN PROMPT = KEY$BUFFER(2); 524 2 ELSE PROMPT = DASH; 525 2 CALL CO (PROMPT); 526 2 RETURN; 527 2 END SET$NEW$PROMPT; 528 1 SET$NEW$EOF: PROCEDURE PUBLIC; 529 2 IF KEY$BUFFER(2) < EXCLM$PT THEN END$O$FILE = KEY$BUFFER(2); 531 2 ELSE END$O$FILE = CNTRL$Z; 532 2 CALL CO(PROMPT); 533 2 END SET$NEW$EOF; 534 1 FLCMD: PROCEDURE PUBLIC; 535 2 COM$BEGIN: CALL READ (AFTIN,.KEY$BUFFER,122,.ACTL,.STATUS); 536 2 IF STATUS > 0 THEN GOTO REPORT$ERROR; 538 2 INDEX = COMDEC (KEY$BUFFER(0),.FILE$COMMANDS,LENGTH(FILE$COMMANDS)); 539 2 IF INDEX > LENGTH(FILE$COMMANDS) THEN 540 2 DO; 541 3 STATUS=203; /* SET UP STATUS SO ERROR ROUTINE WILL PRINT 'INVALID COMMAND SYNTAX' */ 542 3 CALL ERROR (STATUS); 543 3 RETURN; 544 3 END; 545 2 DO CASE INDEX; 546 3 CALL READ$SETUP; 547 3 CALL WRITE$SETUP; 548 3 CALL BLOCK$READ$SETUP; 549 3 CALL CLOSE$SETUP; 550 3 CALL SET$NEW$PROMPT; 551 3 CALL SET$NEW$EOF; 552 3 CALL EXIT; 553 3 END; 554 2 RETURN; 555 2 REPORT$ERROR: CALL ERROR (STATUS); 556 2 GOTO COM$BEGIN; 557 2 END; 558 1 DECL PROMPT BYTE PUBLIC INITIAL (GR$THAN); 559 1 DECL END$O$FILE BYTE PUBLIC INITIAL (CNTRL$Z); 560 1 DECL TRANSFER$MODE BYTE PUBLIC INITIAL (0H); PL/M-80 COMPILER 6/11/79 PAGE 15 561 1 DECL MAX$MEM ADDRESS PUBLIC; 562 1 DECL MEM$LIMIT ADDRESS PUBLIC; 563 1 DECL SGN$ON(*) BYTE DATA ('SXMT V1.7',CR,LF); 564 1 MEM$LIMIT = (MEMCK-.MEMORY); 565 1 MAX$MEM = (MEM$LIMIT-200); 566 1 CALL OPEN (.AFT$IN,.CONSL$INP,READ$AC,LN$EDT$CO,.STATUS); 567 1 IF STATUS > 0 THEN CALL ERROR (STATUS); 569 1 CALL READ (AFT$IN,.KEY$BUFFER,122,.ACTL,.STATUS); 570 1 IF STATUS > 0 THEN CALL ERROR (STATUS); 572 1 CALL WRITE(CO$AFT,.SGN$ON,LENGTH(SGN$ON),.STATUS); 573 1 CALL SCHAR (CR); 574 1 STRT$XMT: CHAR=ISCAN; 575 1 IF CHAR=PRCNT THEN 576 1 DO; 577 2 CALL CO (CHAR); 578 2 CALL XMTCM; 579 2 GOTO STRT$XMT; 580 2 END; 581 1 IF CHAR=AMPRSAND THEN 582 1 DO; 583 2 CALL CO (CHAR); 584 2 CALL FLCMD; 585 2 GOTO STRT$XMT; 586 2 END; 587 1 CALL SCHAR (CHAR); 588 1 DO WHILE CHAR <> CR; 589 2 CHAR = ISCAN; 590 2 CALL SCHAR (CHAR) ; 591 2 END; 592 1 GOTO STRT$XMT; 593 1 END; EOF; MODULE INFORMATION: CODE AREA SIZE = 0AB3H 2739D VARIABLE AREA SIZE = 01B4H 436D MAXIMUM STACK SIZE = 000CH 12D 750 LINES READ 0 PROGRAM ERROR(S) END OF PL/M-80 COMPILATION