PL/M-80 COMPILER 5/20/79 PAGE 1 ISI+s#r:çIþÂkAäA!éI6:çI=!éI¾Ú¤A*éI&ë*åINÍ"A*éI&ë*åI^*ÝI"ÝI!éI4ÂpA:çIþüÒÀA:éIþüÒÀAÍ"A!éI4ìA*ÝI}OÍ"A*ÝI|OÍ"AÉ!ëIp+q!"ÝRC DEBUG DATE(5/20/79) 1 XMT800: 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$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 5/20/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 5/20/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 5/20/79 PAGE 4 $EJECT $INCLUDE (:F1:DEFIO.800) 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 '0E1H'; 53 1 = DECL SIO$DATA LIT '0E0H'; 54 1 = DECL SIO$RXRDY LIT '02H'; 55 1 = DECL SIO$TXRDY LIT '01H'; 56 1 = DECL SIO$RSET LIT '040H'; 57 1 = DECL SIO$MODE LIT '04EH'; 58 1 = DECL SIO$CMND LIT '037H'; 59 1 = DECL CRTC LIT '10H';/*CRT OUTPUT DATA COMMAND*/ 60 1 = DECL CRTS LIT '11H';/*CRT DEVICE STATUS COMMAND*/ 61 1 = DECL KEYC LIT '12H';/*KEYBOARD INPUT DATA COMMAND*/ 62 1 = DECL KSTS LIT '13H';/*KEYBOARD DEVICE STATUS COMMAND*/ 63 1 = DECL OBF LIT '01H'; 64 1 = DECL IBF LIT '02H'; 65 1 = DECL FO LIT '04H'; 66 1 = DECL CPUC LIT '0FFH'; 67 1 = DECL DISABL LIT '0DH'; 68 1 = DECL ENABL LIT '05H'; 69 1 = DECL IOCC LIT '0C1H'; 70 1 = DECL IOCS LIT '0C1H'; 71 1 = DECL IOCO LIT '0C0H'; 72 1 = DECL IOCI LIT '0C0H'; PL/M-80 COMPILER 5/20/79 PAGE 5 $EJECT 73 1 DECL AFT ADDRESS; 74 1 DECL CHAR BYTE; 75 1 DECL STAT ADDRESS; 76 1 CO: PROCEDURE (ODB) EXTERNAL; 77 2 DECL ODB BYTE; 78 2 END CO; 79 1 CI: PROCEDURE BYTE EXTERNAL; 80 2 END CI; 81 1 CSTS: PROCEDURE BYTE EXTERNAL; 82 2 END CSTS; 83 1 MEMCK: PROCEDURE ADDRESS EXTERNAL; 84 2 END MEMCK; 85 1 SIO$INIT: PROCEDURE EXTERNAL; 86 2 END SIO$INIT; 87 1 SCHAR: PROCEDURE (CHAR) PUBLIC; 88 2 DECL CHAR BYTE; 89 2 DO WHILE (INPUT (SIO$STAT) AND SIO$TXRDY) = 0; 90 3 END; 91 2 OUTPUT (SIO$DATA) = CHAR; 92 2 RETURN; 93 2 END; 94 1 ISCAN: PROCEDURE BYTE PUBLIC; 95 2 ISC1: DO WHILE CSTS = 0; 96 3 IF (INPUT (SIO$STAT) AND SIO$RXRDY) = SIO$RXRDY THEN 97 3 DO; 98 4 CHAR = (INPUT (SIO$DATA) AND 07FH); 99 4 IF CHAR <> NULL THEN CALL CO (CHAR); 101 4 END; 102 3 END; 103 2 RETURN (CI AND 07FH); 104 2 END; PL/M-80 COMPILER 5/20/79 PAGE 6 105 1 SIO$SCAN: PROCEDURE BYTE PUBLIC; 106 2 DECL CHAR BYTE; 107 2 SIO$SCAN1: DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 108 3 IF CSTS <> 0 THEN 109 3 DO; 110 4 CALL SCHAR (CI AND 07FH); 111 4 END; 112 3 END; 113 2 CHAR = (INPUT (SIO$DATA) AND 07FH); 114 2 IF CHAR < SPACE THEN 115 2 DO; 116 3 IF (CHAR < BS) OR (CHAR > CR) THEN 117 3 GOTO SIO$SCAN1; 118 3 END; 119 2 RETURN (CHAR); 120 2 END SIO$SCAN; 121 1 TIM$OUT: PROCEDURE; 122 2 DECL REC$TIME BYTE; 123 2 REC$TIME = 0; 124 2 DO WHILE REC$TIME < 30; 125 3 IF (INPUT (SIO$STAT) AND SIO$RXRDY) > 0 THEN 126 3 DO; 127 4 CALL CO (INPUT (SIO$DATA) AND 07FH); 128 4 REC$TIME = 0; 129 4 END; 130 3 CALL TIME (10); 131 3 REC$TIME = REC$TIME + 1; 132 3 END; 133 2 END TIM$OUT; 134 1 SEND$CHAR: PROCEDURE (BYT$OUT) PUBLIC; 135 2 DECL BYT$OUT BYTE; 136 2 DECL CHAR BYTE; /* IF RECEIVING SYSTEM CANNOT TAKE CHARACTERS AT FULL SPEED */ 137 2 IF (INPUT (SIO$STAT) AND SIO$RXRDY) > 0 THEN 138 2 CALL TIM$OUT; /*CHAR RECEIVED WITHOUT SENDING ANYTHING*/ 139 2 DO WHILE (INPUT (SIO$STAT) AND SIO$TXRDY) = 0; 140 3 END; 141 2 IF BYT$OUT > SPACE THEN GOTO SEND; 143 2 IF BYT$OUT < BS THEN RETURN; 145 2 IF BYT$OUT = TAB THEN 146 2 DO; 147 3 CR$FLG = FALSE; 148 3 OUTPUT (SIO$DATA) = BYT$OUT; 149 3 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 150 4 END; 151 3 CALL TIM$OUT; 152 3 RETURN; PL/M-80 COMPILER 5/20/79 PAGE 7 153 3 END; 154 2 IF BYT$OUT = CR THEN 155 2 DO; 156 3 CR$FLG = TRUE; 157 3 GOTO SEND1; 158 3 END; 159 2 IF BYT$OUT = LF THEN 160 2 DO; 161 3 IF CR$FLG = TRUE THEN 162 3 DO; 163 4 CR$FLG = FALSE; 164 4 RETURN; 165 4 END; 166 3 END; 167 2 IF BYT$OUT = VT THEN 168 2 DO; 169 3 CR$FLG = FALSE; 170 3 OUTPUT (SIO$DATA) = BYT$OUT; 171 3 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 172 4 END; 173 3 CALL TIM$OUT; 174 3 RETURN; 175 3 END; 176 2 IF BYT$OUT = FF THEN 177 2 DO; 178 3 CR$FLG = FALSE; 179 3 OUTPUT (SIO$DATA) = BYT$OUT; 180 3 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 181 4 END; 182 3 CALL TIM$OUT; 183 3 RETURN; 184 3 END; 185 2 SEND: CR$FLG = FALSE; 186 2 SEND1: OUTPUT (SIO$DATA) = BYT$OUT; 187 2 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 188 3 END; 189 2 CHAR = (INPUT (SIO$DATA) AND 07FH); 190 2 CALL CO (CHAR); 191 2 IF CHAR = CR THEN 192 2 DO WHILE CHAR <> LF; 193 3 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 194 4 END; 195 3 CHAR = (INPUT (SIO$DATA) AND 07FH); 196 3 CALL CO (CHAR); 197 3 END; 198 2 IF CHAR = LF THEN CALL TIME (10); 200 2 IF CHAR = CNTRL$S THEN 201 2 DO; 202 3 CALL CO (UP$ARW); 203 3 CALL CO ('S'); 204 3 DO WHILE CHAR <> CNTRL$Q; 205 4 DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0; 206 5 END; 207 4 CHAR = (INPUT (SIO$DATA) AND 07FH); 208 4 END; PL/M-80 COMPILER 5/20/79 PAGE 8 209 3 CALL CO (UP$ARW); 210 3 CALL CO ('Q'); 211 3 END; 212 2 RETURN; 213 2 END SEND$CHAR; 214 1 B$SEND$CHAR: PROCEDURE (CHAR); 215 2 DECL IDATA BYTE; 216 2 DECL CHAR BYTE; 217 2 IF CR$FLG = TRUE THEN 218 2 DO; 219 3 CR$FLG = FALSE; 220 3 IF CHAR = LF THEN 221 3 RETURN; 222 3 END; 223 2 IF CHAR < SPACE THEN 224 2 DO; 225 3 IF ((CHAR = BS) OR (CHAR = TAB) OR (CHAR = VT) OR (CHAR = FF) OR (CHAR = LF)) THEN CHAR = (CHAR OR 080H); 227 3 END; 228 2 CALL SCHAR(CHAR); 229 2 IDATA = 0; 230 2 IF CHAR = CR THEN 231 2 DO; 232 3 CR$FLG = TRUE; 233 3 DO WHILE IDATA <> CNTRL$Q; 234 4 DO WHILE (INPUT(SIO$STAT) AND SIO$RXRDY) = 0; 235 5 END; 236 4 IDATA = (INPUT (SIO$DATA) AND 07FH); 237 4 END; 238 3 END; 239 2 RETURN; 240 2 END B$SEND$CHAR; 241 1 SIO$CHECK: PROCEDURE BYTE; 242 2 DECL FLAG BYTE; 243 2 IF (INPUT (SIO$STAT) AND SIO$RXRDY) <> 0 THEN 244 2 FLAG = TRUE; 245 2 ELSE FLAG = FALSE; 246 2 RETURN (FLAG); 247 2 END SIO$CHECK; 248 1 DECL ACTUAL ADDRESS; 249 1 DECL I ADDRESS; 250 1 DECL FLAG BYTE; 251 1 DECL COUNT BYTE; 252 1 DECL CR$FLG BYTE PUBLIC; 253 1 TEST: PROCEDURE BYTE; 254 2 IF MEMORY(I - 1) <> LF THEN GOTO TST1; 256 2 IF MEMORY(I - 2) <> CR THEN GOTO TST2; PL/M-80 COMPILER 5/20/79 PAGE 9 258 2 RETURN (TRUE); 259 2 TST1: IF MEMORY(I-1) <> CR THEN RETURN (FALSE); 261 2 IF MEMORY(I-2) <> LF THEN RETURN (FALSE); 263 2 RETURN (TRUE); 264 2 TST2: IF MEMORY(I-2) <> NULL THEN RETURN (FALSE); 266 2 RETURN (TRUE); 267 2 END TEST; 268 1 XMTCM: PROCEDURE PUBLIC; /* WAIT FOR END OF COMMAND LINE */ 269 2 DECL CHAR BYTE; 270 2 CHAR = 0; /* WAIT FOR CR TO TERMINATE COMMAND THEN CR TO BE ECHOED */ 271 2 DO WHILE CHAR <> CR; 272 3 CHAR = ISCAN; 273 3 CALL SCHAR (CHAR); 274 3 END; 275 2 CHAR = 0; 276 2 DO WHILE CHAR <> CR; 277 3 CHAR = SIO$SCAN; 278 3 CALL CO (CHAR); 279 3 END; /* WAIT ONE MORE CHARACTER FOR LINE FEED */ /* NOT NEEDED IN ALL SYSTEMS */ /* CHAR = SIO$SCAN; CALL CO (CHAR); */ /* BEGIN TRANSMISSION */ 280 2 DO CASE TRANSFER$MODE; 281 3 RETURN; 282 3 GOTO SEND$LOOP; 283 3 GOTO RECEIVE$LOOP; 284 3 GOTO BLOCK$SEND$LOOP; 285 3 END; 286 2 RECEIVE$LOOP: I = 0; 287 2 FLAG = FALSE; 288 2 COUNT = 0; 289 2 MEMORY(I) = SIO$SCAN; 290 2 IF MEMORY(I) <> LF THEN GOTO REC$NXT1; 292 2 REC$NXT: MEMORY(I) = SIO$SCAN; 293 2 REC$NXT1: IF MEMORY(I) = PROMPT THEN FLAG = TEST; 295 2 IF FLAG = TRUE THEN GOTO REC$END; 297 2 NEXT: IF MEMORY(I) < SPACE THEN 298 2 DO; PL/M-80 COMPILER 5/20/79 PAGE 10 299 3 IF (MEMORY(I) < BS) OR (MEMORY(I) > CR) THEN GOTO REC$NXT; 301 3 END; 302 2 I = I+1; 303 2 IF I >= MAX$MEM THEN 304 2 DO; 305 3 CALL SCHAR (CNTRL$S); 306 3 DO WHILE COUNT < 100; 307 4 IF SIO$CHECK = TRUE THEN 308 4 DO; 309 5 MEMORY(I) = INPUT (SIO$DATA); 310 5 IF MEMORY(I) < SPACE THEN 311 5 DO; 312 6 IF MEMORY(I) <> CR THEN GOTO RESTIME; 314 6 I = I+1; 315 6 MEMORY(I) = LF; 316 6 END; 317 5 IF MEMORY(I) = PROMPT THEN FLAG = TEST; 319 5 IF FLAG = TRUE THEN GOTO REC$END; 321 5 I = I+1; 322 5 RESTIME: COUNT = 0; 323 5 IF I >= MEM$LIMIT THEN COUNT = 100; 325 5 END; 326 4 CALL TIME (2); 327 4 COUNT = COUNT+1; 328 4 END; 329 3 CALL WRITE (AFT,.MEMORY,I,.STAT); 330 3 I = 0; 331 3 CALL SCHAR (CNTRL$Q); 332 3 GOTO RECEIVE$LOOP; 333 3 END; 334 2 GOTO REC$NXT; /* TRANSMISSION DONE WRITE INFO AND RESET BUFFER */ 335 2 REC$END: CALL WRITE (AFT,.MEMORY,I,.STAT); 336 2 IF STAT > 0 THEN CALL ERROR (STAT); 338 2 CALL CO (CR); 339 2 CALL CO (LF); 340 2 CALL CO (PROMPT); 341 2 I = 0; 342 2 RETURN; 343 2 BLOCK$SEND$LOOP: DO WHILE CHAR <> LF; 344 3 CHAR = SIO$SCAN; 345 3 CALL CO(CHAR); 346 3 END; 347 2 CR$FLG = FALSE; 348 2 CALL B$SEND$CHAR(CR); 349 2 B$SEND$LOOP1: CALL READ (AFT,.MEMORY,MAX$MEM,.ACTUAL,.STAT); 350 2 IF STAT > 0 THEN 351 2 DO; 352 3 CALL ERROR(STAT); 353 3 RETURN; 354 3 END; 355 2 IF ACTUAL < 1 THEN PL/M-80 COMPILER 5/20/79 PAGE 11 356 2 DO; 357 3 CALL SCHAR(END$O$FILE); 358 3 RETURN; 359 3 END; 360 2 I = 0; 361 2 DO WHILE I < ACTUAL; 362 3 CALL B$SEND$CHAR (MEMORY(I)); 363 3 IF MEMORY(I) = CR THEN 364 3 DO; 365 4 IF CSTS <> 0 THEN 366 4 DO; 367 5 IF (CI AND 07FH) = ESC THEN 368 5 RETURN; 369 5 END; 370 4 END; 371 3 I = I + 1; 372 3 END; 373 2 GOTO B$SEND$LOOP1; 374 2 SEND$LOOP: DO WHILE CHAR <> LF; 375 3 CHAR = SIO$SCAN; 376 3 CALL CO (CHAR); 377 3 END; 378 2 CR$FLG = FALSE; 379 2 SEND$LOOP1: CALL READ (AFT,.MEMORY,MAX$MEM,.ACTUAL,.STAT); 380 2 IF STAT > 0 THEN 381 2 DO; 382 3 CALL ERROR (STAT); 383 3 RETURN; 384 3 END; 385 2 IF ACTUAL < 1 THEN 386 2 DO; 387 3 CALL SCHAR (END$O$FILE); 388 3 RETURN; 389 3 END; 390 2 I = 0; 391 2 DO WHILE I < ACTUAL; 392 3 CALL SEND$CHAR (MEMORY (I)); 393 3 IF MEMORY(I) = CR THEN 394 3 DO; 395 4 IF CSTS <> 0 THEN 396 4 DO; 397 5 IF (CI AND 07FH) = ESC THEN RETURN; 399 5 END; 400 4 END; 401 3 I = I+1; 402 3 END; 403 2 GOTO SEND$LOOP1; 404 2 END; 405 1 COM$DEC: PROCEDURE (CHAR,ADR$COM$ARRAY,COUNT) BYTE PUBLIC; 406 2 DECL (CHAR,I,TEST,COUNT) BYTE; 407 2 DECL ADR$COM$ARRAY ADDRESS; PL/M-80 COMPILER 5/20/79 PAGE 12 408 2 DECL (COM$ARRAY BASED ADR$COM$ARRAY) (128) BYTE; 409 2 I=0; 410 2 TEST=FALSE; 411 2 DO WHILE TEST=FALSE; 412 3 IF CHAR = COM$ARRAY(I) THEN 413 3 TEST = TRUE; 414 3 ELSE DO; 415 4 I = I+1; 416 4 IF I > COUNT THEN 417 4 TEST = TRUE; 418 4 END; 419 3 END; 420 2 RETURN (I); 421 2 END; 422 1 DECL KEY$BUFFER(122) BYTE PUBLIC; 423 1 DECL AFT$IN ADDRESS PUBLIC; 424 1 DECL CONSL$INP(*) BYTE PUBLIC INITIAL(':CI:'); 425 1 DECL ACTL ADDRESS PUBLIC; 426 1 DECL STATUS ADDRESS PUBLIC; 427 1 DECL INDEX BYTE; 428 1 DECL FILE$COMMANDS(*) BYTE INITIAL ('RWTCPEX'); 429 1 READ$SETUP: PROCEDURE PUBLIC; 430 2 IF TRANSFER$MODE > 0 THEN 431 2 DO; 432 3 CALL CLOSE (AFT,.STAT); 433 3 IF STAT > 0 THEN CALL ERROR (STAT); 435 3 END; 436 2 CALL OPEN (.AFT,.KEY$BUFFER(2),READ$AC,0,.STAT); 437 2 IF STAT > 0 THEN CALL ERROR (STAT); 439 2 IF STAT > 0 THEN TRANSFER$MODE = 0; 441 2 ELSE TRANSFER$MODE = 1; 442 2 CALL CO(PROMPT); 443 2 RETURN; 444 2 END READ$SETUP; 445 1 BLOCK$READ$SETUP: PROCEDURE PUBLIC; 446 2 IF TRANSFER$MODE > 0 THEN 447 2 DO; 448 3 CALL CLOSE (AFT,.STAT); 449 3 IF STAT > 0 THEN CALL ERROR (STAT); 451 3 END; 452 2 CALL OPEN (.AFT,.KEYBUFFER(2),READ$AC,0,.STAT); 453 2 IF STAT > 0 THEN CALL ERROR (STAT); 455 2 IF STAT > 0 THEN TRANSFER$MODE = 0; 457 2 ELSE TRANSFER$MODE = 3; 458 2 CALL CO(PROMPT); 459 2 RETURN; 460 2 END BLOCK$READ$SETUP; PL/M-80 COMPILER 5/20/79 PAGE 13 461 1 WRITE$SETUP: PROCEDURE PUBLIC; 462 2 IF TRANSFER$MODE > 0 THEN 463 2 DO; 464 3 CALL CLOSE (AFT,.STAT); 465 3 IF STAT > 0 THEN CALL ERROR (STAT); 467 3 END; 468 2 CALL OPEN (.AFT,.KEY$BUFFER(2),WRITE$AC,0,.STAT); 469 2 IF STAT > 0 THEN CALL ERROR (STAT); 471 2 IF STAT > 0 THEN TRANSFER$MODE = 0; 473 2 ELSE TRANSFER$MODE = 2; 474 2 CALL CO (PROMPT); 475 2 RETURN; 476 2 END WRITE$SETUP; 477 1 CLOSE$SETUP: PROCEDURE PUBLIC; 478 2 CALL CLOSE (AFT,.STAT); 479 2 IF STAT > 0 THEN CALL ERROR (STAT); 481 2 TRANSFER$MODE = 0; 482 2 CALL CO (PROMPT); 483 2 RETURN; 484 2 END CLOSE$SETUP; 485 1 SET$NEW$PROMPT: PROCEDURE PUBLIC; /* ALLOW ALL PRINTING ASCII CHARACTERS TO BE PROMPT */ 486 2 IF SPACE < KEY$BUFFER(2) THEN PROMPT = KEY$BUFFER(2); 488 2 ELSE PROMPT = DASH; 489 2 CALL CO (PROMPT); 490 2 RETURN; 491 2 END SET$NEW$PROMPT; 492 1 SET$NEW$EOF: PROCEDURE PUBLIC; 493 2 IF KEY$BUFFER(2) < EXCLM$PT THEN END$O$FILE = KEY$BUFFER(2); 495 2 ELSE END$O$FILE = CNTRL$Z; 496 2 CALL CO(PROMPT); 497 2 END SET$NEW$EOF; 498 1 FLCMD: PROCEDURE PUBLIC; 499 2 COM$BEGIN: CALL READ (AFTIN,.KEY$BUFFER,122,.ACTL,.STATUS); 500 2 IF STATUS > 0 THEN GOTO REPORT$ERROR; 502 2 INDEX = COMDEC (KEY$BUFFER(0),.FILE$COMMANDS,LENGTH(FILE$COMMANDS)); 503 2 IF INDEX > LENGTH(FILE$COMMANDS) THEN 504 2 DO; 505 3 STATUS=203; /* SET UP STATUS SO ERROR ROUTINE WILL PRINT 'INVALID COMMAND SYNTAX' */ 506 3 CALL ERROR (STATUS); 507 3 RETURN; 508 3 END; PL/M-80 COMPILER 5/20/79 PAGE 14 509 2 DO CASE INDEX; 510 3 CALL READ$SETUP; 511 3 CALL WRITE$SETUP; 512 3 CALL BLOCK$READ$SETUP; 513 3 CALL CLOSE$SETUP; 514 3 CALL SET$NEW$PROMPT; 515 3 CALL SET$NEW$EOF; 516 3 CALL EXIT; 517 3 END; 518 2 RETURN; 519 2 REPORT$ERROR: CALL ERROR (STATUS); 520 2 GOTO COM$BEGIN; 521 2 END; 522 1 DECL PROMPT BYTE PUBLIC INITIAL (GR$THAN); 523 1 DECL END$O$FILE BYTE PUBLIC INITIAL (CNTRL$Z); 524 1 DECL TRANSFER$MODE BYTE PUBLIC INITIAL (0H); 525 1 DECL MAX$MEM ADDRESS PUBLIC; 526 1 DECL MEM$LIMIT ADDRESS PUBLIC; 527 1 DECL SGN$ON(*) BYTE DATA ('800XMT V1.5',CR,LF); 528 1 MEM$LIMIT = (MEMCK-.MEMORY); 529 1 MAX$MEM = (MEM$LIMIT-200); 530 1 CALL SIO$INIT; 531 1 CALL OPEN (.AFT$IN,.CONSL$INP,READ$AC,LN$EDT$CO,.STATUS); 532 1 IF STATUS > 0 THEN CALL ERROR (STATUS); 534 1 CALL READ (AFT$IN,.KEY$BUFFER,122,.ACTL,.STATUS); 535 1 IF STATUS > 0 THEN CALL ERROR (STATUS); 537 1 DO I = 0 TO (LENGTH (SGN$ON) - 1); 538 2 CALL CO (SGN$ON(I)); 539 2 END; 540 1 CALL SCHAR (CR); 541 1 STRT$XMT: CHAR=ISCAN; 542 1 IF CHAR=PRCNT THEN 543 1 DO; 544 2 CALL CO (CHAR); 545 2 CALL XMTCM; 546 2 GOTO STRT$XMT; 547 2 END; 548 1 IF CHAR=AMPRSAND THEN 549 1 DO; 550 2 CALL CO (CHAR); 551 2 CALL FLCMD; 552 2 GOTO STRT$XMT; 553 2 END; 554 1 CALL SCHAR (CHAR); 555 1 DO WHILE CHAR <> CR; 556 2 CHAR = ISCAN; 557 2 CALL SCHAR (CHAR) ; PL/M-80 COMPILER 5/20/79 PAGE 15 558 2 END; 559 1 GOTO STRT$XMT; 560 1 END; EOF; MODULE INFORMATION: CODE AREA SIZE = 09EAH 2538D VARIABLE AREA SIZE = 00AEH 174D MAXIMUM STACK SIZE = 000CH 12D 720 LINES READ 0 PROGRAM ERROR(S) END OF PL/M-80 COMPILATION