1 /MARK SENSE BATCH AND PIP 2 / 3 / 4 / 5 / 6 / 7 / 8 / 9 // 10 / 11 / 12 / 13 / 14 /COPYRIGHT (C) 1974, 1975, 1977 15 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 16 / 17 / 18 / 19 /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A 20 /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- 21 /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER 22 /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE 23 /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO 24 /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE 25 /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. 26 / 27 / 28 /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT 29 /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL 30 /EQUIPMRNT COROPATION. 31 / 32 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 33 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. 34 / 35 / 36 / 37 / 38 / 39 / 40 /MARK SENSE BATCH AND PIP JANUARY 9, 1974 41 / 42 / 43 / 44 / AUTHOR: 45 / MARK B. ROSENTHAL 46 / DIGITAL EQUIPMENT CORPORATION 47 / 48 / VERSION 3A M.H. 28-APR-77 49 / 50 / 51 / 52 / 53 / 54 / 55 / 56 / 57 / 58 / 59 / 60 / 61 / 62 / 63 64 65 66 67 L7775=CLA CLL CMA RTL 68 L7776=CLA CLL CMA RAL 69 L7777=CLA CLL CMA 70 L0002=CLA CLL CML RTL 71 L0001=CLA CLL IAC 72 CONTCH=3 /CONTINUATION CHARACTER 73 RUBOUT=7 /RUBOUT BITS 74 JOBBIT=0200 /BIT POSITION OF $JOB IN COLUMN 1 75 EOFCHR=6004 /END OF FILE CARD CHARACTER IS _ 76 TABCHR=6010 /TAB CHARACTER 77 FFCHR=3010 /FORM FEED CHARACTER 78 NOCHR=6400 /# CHARACTER 79 RCSE=6672 /CARD READER SELECT AND SKIP IF READY 80 RCSD=6671 /CARD READER SKIP IF CARD DONE 81 RCRD=6674 /CARD READER CLEAR CARD DONE FLAG 82 RCSF=6631 /CARD READER SKIP IF DATA READY 83 RCRB=6634 /CARD READER READ BINARY 84 KCF=6030 /CLEAR KEYBOARD FLAG 85 SYSNO=CLA CLL IAC /OS8 DEVICE NUMBER FOR SYS: 86 DSKNO=CLA CLL CML RTL /OS8 DEVICE NUMBER FOR DSK: 87 FETCH=1 88 LOOKUP=2 89 ENTER=3 90 CLOSE=4 91 DECODE=5 92 CHAIN=6 93 USRIN=10 94 USROUT=11 95 F0=0 96 F1=10 97 JSBITS=7746 /JOB STATUS WORD 98 99 100 101 *10 102 000010 0000 XR1, 0 103 000011 0000 XR2, 0 104 000012 0000 XRCDR, 0 105 000013 0000 XROPT, 0 106 107 108 *20 109 000020 1000 ERROR=JMS I .; XERR 110 000021 1652 CONVRT=JMS I .; XCONVR 111 000022 2053 OUT=JMS I .;OUTAD, XOUT 112 000023 0663 SAVFLD=JMS I .;XSAVDF 113 000024 0200 USR=JMS I .; 200 114 000025 0000 KEYWD, 0;0;0;0 000026 0000 000027 0000 000030 0000 115 000031 0000 TEMP1, 0 116 000032 0000 TEMP2, 0 117 000033 0000 TEMP3, 0 118 000034 0000 TEMP4, 0 119 000035 0000 TEMP5, 0 120 000036 0000 OPTCNT, 0 /OUTPUT BUFFER COUNT 121 000037 0000 OPTSW, 0 /OUTPUT BUFFER THREE WAY SWITCH 122 000040 0000 KEYADR, 0 123 000041 0000 KEYVAL, 0 124 000042 0000 ERRFLG, 0 125 000043 0000 ERRCNT, 0 126 000044 0000 CONFLG, 0 127 000045 0000 LNCNT, 0 128 000046 0000 USRFLG, 0 129 000047 0000 OFILE, ZBLOCK 5 /OUTPUT FILE DEVICE, LENGTH, AND NAME 000050 0000 000051 0000 000052 0000 000053 0000 130 000054 7777 CDRFLG, -1 /CDRIN TO PASSES LAST CARD IF 0 131 000055 0000 BCLSW, 0 132 000056 7777 CDREOF, -1 133 000057 0000 DEVENT, 0 /ENTRY ADDRESS OF OUTPUT DEVICE HANDLER 134 000060 0000 IOERR, 0 /ERROR NUMBER 135 000061 2060 VERNO9, ISZ IOERR 136 000062 2060 IOER8, ISZ IOERR 137 000063 2060 CDRER7, ISZ IOERR 138 000064 2060 OPTER6, ISZ IOERR 139 000065 2060 OPTER5, ISZ IOERR 140 000066 2060 OPTER4, ISZ IOERR 141 000067 2060 OPTER3, ISZ IOERR 142 000070 2060 OPTER2, ISZ IOERR 143 000071 5472 OPTER1, JMP I .+1 144 000072 2310 IOERR1 145 146 147 *200 148 000200 2046 START, ISZ USRFLG;SKP /IS THE USR IN CORE? 000201 7410 149 000202 5206 JMP CD /YES 150 000203 6212 CIF 10;JMS I (7700;USRIN /LOCK USR IN CORE 000204 4777 000205 0010 151 000206 7340 CD, L7777 /SET FLAG FOR USR IN CORE 152 000207 3046 DCA USRFLG 153 000210 6212 CIF 10;USR;DECODE;0 /DELETE TENTATIVE FILES 000211 4424 000212 0005 000213 0000 154 000214 1376 TAD (7577 /COPY OUTPUT FILE #1 (NAME AND DEVICE) 155 000215 3010 DCA XR1 156 000216 6211 CDF F1 157 000217 1775 TAD I (7644 /TEST /V SWITCH 158 000220 0374 AND (4 159 000221 7640 SZA CLA 160 000222 5061 JMP VERNO9 /YES - PRINT VERSION NUMBER 161 000223 1410 TAD I XR1 162 000224 7450 SNA /IF NOT SPECIFIED, 163 000225 7326 DSKNO /USE DEVICE DSK: 164 000226 3047 DCA OFILE 165 000227 1410 TAD I XR1 166 000230 7450 SNA /WAS A NAME GIVEN? 167 000231 5071 JMP OPTER1 /NO 168 000232 3050 INIT1, DCA OFILE+1 169 000233 1410 TAD I XR1 170 000234 3051 DCA OFILE+2 171 000235 1410 TAD I XR1 172 000236 3052 DCA OFILE+3 173 000237 1410 TAD I XR1 174 000240 3053 DCA OFILE+4 175 000241 1373 TAD (OFILE+1 176 000242 3266 DCA BLOKNO /SET FILE NAME ADDRESS 177 000243 1772 TAD I (7605 /GET SECOND OUTPUT DEVICE SPECIFICATION 178 000244 3771 DCA I (7600 /MOVE TO FIRST FOR SPOOLING IN BATCH 179 000245 6201 CDF 180 000246 1266 TAD BLOKNO /GET ADDRESS OF FILE NAME 181 000247 3770 DCA I (CLOSNM /AND SAVE FOR CALL TO CLOSE 182 000250 1367 TAD (OPTDEV&7600+1 /SET DEVICE HANDLER SPACE 183 000251 3256 DCA DEVHDL 184 000252 1047 TAD OFILE 185 000253 6212 CIF 10;USR;FETCH /FETCH DEVICE HANDLER 000254 4424 000255 0001 186 000256 2401 DEVHDL, OPTDEV&7600+1 /2 PAGES 187 000257 5070 JMP OPTER2 /ERROR - CANNOT FETCH HANDLER 188 000260 1256 TAD DEVHDL /MOVE ENTRY ADDRESS 189 000261 3057 DCA DEVENT /TO PAGE ZERO 190 000262 1047 TAD OFILE /ENTER THE FILE NAME AS TENTATIVE 191 000263 6212 CIF 10;USR;ENTER 000264 4424 000265 0003 192 000266 0050 BLOKNO, OFILE+1 /FILE NAME, STARTING BLOCK RETURNED HERE 193 000267 0000 FILLEN, 0 /RETURNS FILE LENGTH HERE 194 000270 5067 JMP OPTER3 /CANNOT ENTER FILE 195 000271 6212 CIF 10;USR;USROUT /DISMISS THE USR 000272 4424 000273 0011 196 000274 3046 DCA USRFLG /CLEAR USR IN CORE FLAG 197 000275 6211 CDF 10 198 000276 1266 TAD BLOKNO /SAVE STARTING BLOCK NO. FOR BATCH 199 000277 3766 DCA I (7620 200 000300 1047 TAD OFILE /SAVE DEVICE NO. FOR BATCH 201 000301 0365 AND (17 202 000302 3764 DCA I (7617 203 000303 1763 TAD I (7643 /GET OPTIONS 204 000304 6201 CDF F0 205 000305 0362 AND (2100 / /B OR /F 206 000306 7450 SNA 207 000307 3761 DCA I (EOFJMP /IF NEITHER, THEN WE CHAIN TO BATCH 208 000310 7106 CLL RTL /GET /B OUT OF AC 209 000311 7640 SZA CLA /IF AC=0 START WITH BASIC KEYWORDS 210 000312 1360 TAD (FORKEY-BASKEY 211 000313 1357 TAD (BASKEY-15 212 000314 3040 DCA KEYADR 213 000315 5756 JMP I (INIT5 214 215 216 000356 0400 PAGE 000357 4373 000360 0042 000361 2224 000362 2100 000363 7643 000364 7617 000365 0017 000366 7620 000367 2401 000370 2125 000371 7600 000372 7605 000373 0050 000374 0004 000375 7644 000376 7577 000377 7700 217 000400 1377 INIT5, TAD (BPRI2 /TAILOR IT FOR BATCH PROCESSING 218 000401 3776 DCA I (BPRKEY /"PRINT #4," 219 000402 1375 TAD (BINP2 220 000403 3774 DCA I (BINKEY /"INPUT #3," 221 000404 1373 TAD (BSTO2 222 000405 3772 DCA I (BSTKEY /"CLOSE# 4\STOP" 223 000406 1371 TAD (BEND2 224 000407 3770 DCA I (BENKEY /"CLOSE #4\END" 225 000410 6211 CDF F1 226 000411 3767 DCA I (CBAS5 /NO JUMP 227 000412 3766 DCA I (DATL48 /NO JUMP 228 000413 1365 TAD (CL2M1A /".R LOADER_*GENIOX" 229 000414 3764 DCA I (CL2SX 230 000415 1763 TAD I (7643 /TEST /I OPTION (INTERACTIVE) 231 000416 0362 AND (10 232 000417 7650 SNA CLA 233 000420 5240 JMP INIT6 234 000421 1313 TAD BASJMP /SET UP FOR FILES 0 & 1 235 000422 3767 DCA I (CBAS5 /SET UP THE JMP 236 000423 1314 TAD BASJM1 /SET UP JUMP 237 000424 3766 DCA I (DATL48 238 000425 1361 TAD (CL2M1 /".R LOADER_*" 239 000426 3764 DCA I (CL2SX 240 000427 6201 CDF F0 241 000430 1360 TAD (BPRI 242 000431 3776 DCA I (BPRKEY 243 000432 1357 TAD (BINP 244 000433 3774 DCA I (BINKEY 245 000434 1356 TAD (BSTO 246 000435 3772 DCA I (BSTKEY 247 000436 1355 TAD (BEND 248 000437 3770 DCA I (BENKEY 249 000440 6211 INIT6, CDF 10 250 000441 1754 TAD I (7644 /TEST /T OPTION 251 000442 0353 AND (20 252 000443 7650 SNA CLA 253 000444 1352 TAD (BATLPT-BATTTY 254 000445 1351 TAD (BATTTY 255 000446 6213 CIF CDF F1 256 000447 4750 JMS I (MOVODV 257 000450 1747 TAD I (7645 /TEST /2 OPTION 258 000451 0346 AND (200 259 000452 7650 SNA CLA 260 000453 5262 JMP INIT3 261 000454 1345 TAD (CF2 /FORTRAN 2 262 000455 3744 DCA I (FORADR 263 000456 1343 TAD (CL2 264 000457 3742 DCA I (LOAADR 265 000460 1341 TAD (DATX2 266 000461 5267 JMP INIT4 267 000462 1340 INIT3, TAD (CF4 /FORTRAN 4 268 000463 3744 DCA I (FORADR 269 000464 1337 TAD (CL4 270 000465 3742 DCA I (LOAADR 271 000466 1336 TAD (DATX4 /INITIALIZE $DATA 272 000467 3735 INIT4, DCA I (DATFTN 273 000470 1735 TAD I (DATFTN 274 000471 3734 DCA I (DATADR 275 000472 1333 TAD (SAVARA 276 000473 3732 DCA I (SAVPNT 277 000474 3731 DCA I (NAMCNT 278 000475 6201 CDF F0 279 000476 3055 DCA BCLSW /NO BCL CARDS YET 280 000477 7340 L7777 281 000500 3056 DCA CDREOF /RESET EOF SWITCH 282 000501 1730 TAD I (BLOKNO /SET STARTING BLOCK NUMBER 283 000502 3727 DCA I (OPTBLK 284 000503 1326 TAD (OPTBUF-1 285 000504 3013 DCA XROPT 286 000505 1325 TAD (-200 287 000506 3036 DCA OPTCNT 288 000507 7346 L7775 289 000510 3037 DCA OPTSW 290 000511 3043 DCA ERRCNT /CLEAR COUNT OF CARDS IN ERROR 291 000512 5724 JMP I (READY 292 293 000513 5311 BASJMP, JMP CBAS7&177+INIT5 294 000514 5230 BASJM1, JMP DATL49&177+INIT5 295 296 297 000524 0600 PAGE 000525 7600 000526 2777 000527 2032 000530 0266 000531 1672 000532 1724 000533 4200 000534 5316 000535 0024 000536 3007 000537 2540 000540 2200 000541 2312 000542 5317 000543 3533 000544 5315 000545 3200 000546 0200 000547 7645 000550 0302 000551 5057 000552 0006 000553 0020 000554 7644 000555 4025 000556 4165 000557 4046 000560 4066 000561 5640 000562 0010 000563 7643 000564 3404 000565 5646 000566 3020 000567 2100 000570 4441 000571 4027 000572 4423 000573 4170 000574 4425 000575 4051 000576 4432 000577 4071 298 000600 4777 READY, JMS I (CDRIN /READ A CARD 299 000601 5776 JMP I (EOF /END OF FILE SENSED 300 000602 1412 TAD I XRCDR /GET COLUMN 1 301 000603 3025 DCA KEYWD /SAVE AS KEYWORD BITS 302 000604 1012 TAD XRCDR 303 000605 3011 DCA XR2 304 305 306 /TRANSLATE LINE NUMBER 307 000606 1375 TAD (-5 308 000607 3031 DCA TEMP1 309 000610 3045 DCA LNCNT /CLEAR COUNT 310 000611 3030 DCA KEYWD+3 /CLEAR COLUMN 2-6 KEYWORD BITS 311 000612 1412 LNLP, TAD I XRCDR /GET LINE NO. COLUMN 312 000613 3032 DCA TEMP2 /SAVE CHAR 313 000614 1374 TAD (6000 314 000615 0032 AND TEMP2 /GET KEYWORD BITS 315 000616 7104 CLL RAL 316 000617 7006 RTL 317 000620 1030 TAD KEYWD+3 318 000621 7106 CLL RTL 319 000622 3030 DCA KEYWD+3 320 000623 1373 TAD (1777 321 000624 0032 AND TEMP2 /GET CHAR 322 000625 7450 SNA 323 000626 5242 JMP LNLPEN /IGNORE BLANKS 324 000627 4421 CONVRT /TRANSLATE 325 000630 5242 JMP LNLPEN /IGNORE RUBOUTS 326 000631 1372 TAD (-"9 327 000632 7540 SMA SZA 328 000633 5245 JMP LNERR /NOT A NUMBER 329 000634 1371 TAD ("9-"0 330 000635 7510 SPA 331 000636 5245 JMP LNERR /NOT A NUMBER 332 000637 1370 TAD ("0 333 000640 3411 LNLP1, DCA I XR2 /INSERT CHARACTER IN OUTPUT BUFFER 334 000641 2045 ISZ LNCNT /COUNT THIS CHARACTER 335 000642 2031 LNLPEN, ISZ TEMP1 /GOT ALL LINE NUMBER COLUMNS? 336 000643 5212 JMP LNLP /NO - LOOP. 337 000644 5767 JMP I (KEYTRA /GO TRANSLATE KEYWORD 338 339 340 000645 4420 LNERR, ERROR 341 000646 5240 JMP LNLP1 342 343 344 000647 0000 MAKNA2, 0 /FIELD 1 OUTPUT ROUTINE FOR MAKNAM 345 000650 6213 CIF CDF F1 346 000651 4766 JMS I (MAKNA3 347 000652 5647 JMP I MAKNA2 348 349 000653 0000 OOUT2, 0 350 000654 4422 OUT 351 000655 6213 CIF CDF F1 352 000656 5653 JMP I OOUT2 353 354 000657 0000 GETCD1, 0 355 000660 1412 TAD I XRCDR 356 000661 6213 CIF CDF F1 357 000662 5657 JMP I GETCD1 358 359 /FOR RETURN TO CALLING FIELD 360 /PRESERVES AC AND LINK WHILE PUTTING 361 /CIF CDF TO DATA FIELD AT ADDRESS 362 /SPECIFIED AS FIRST WORD AFTER CALL 363 000663 0000 XSAVDF, 0 364 000664 3300 DCA XSAVD1 365 000665 6214 RDF 366 000666 1365 TAD (CIF CDF 367 000667 3301 DCA XSAVD2 368 000670 6201 CDF 369 000671 1663 TAD I XSAVDF 370 000672 2263 ISZ XSAVDF 371 000673 3302 DCA XSAVD3 372 000674 1301 TAD XSAVD2 373 000675 3702 DCA I XSAVD3 374 000676 1300 TAD XSAVD1 375 000677 5663 JMP I XSAVDF 376 000700 0000 XSAVD1, 0 377 000701 0000 XSAVD2, 0 378 000702 0000 XSAVD3, 0 379 380 000765 6203 PAGE 000766 1665 000767 1200 000770 0260 000771 0011 000772 7507 000773 1777 000774 6000 000775 7773 000776 2067 000777 1005 381 001000 0000 XERR, 0 382 001001 7600 K7600, 7600 383 001002 1377 TAD ("? /OUTPUT A "?" 384 001003 2042 ISZ ERRFLG /FLAG ERROR ON THIS CARD 385 001004 5600 JMP I XERR 386 387 TIME=12 388 389 001005 0000 CDRIN, 0 /READ A CARD INTO THE BUFFER 390 001006 4423 SAVFLD;CDRCIF /SAVE DATA FIELD FOR RETURN 001007 1067 391 001010 3042 DCA ERRFLG /CLEAR ERROR FLAG FOR THIS CARD 392 001011 2056 ISZ CDREOF /HAVE WE SEEN EOF? 393 001012 5267 JMP CDRCIF /YES - STILL EOF 394 001013 2054 ISZ CDRFLG /SHOULD WE PASS LAST CARD? 395 001014 5263 JMP REINIT /YES 396 001015 4276 CDRIN6, JMS CDRIN5 /RESET TIME OUT COUNTERS 397 001016 1376 TAD (-50 /YES - READ IT INTO THE CDR BUFFER 398 001017 3031 DCA TEMP1 /40 COLUMNS (DECIMAL) 399 001020 1375 TAD (CDRBUF-1 400 001021 3012 DCA XRCDR 401 001022 6672 CDRIN3, RCSE /CARD READY? 402 001023 5274 JMP CDRIN4 /TEST TIME OUT 403 001024 4276 JMS CDRIN5 /RESET TIME OUT COUNT 404 001025 4303 CDRIN1, JMS KBRD /TEST KEYBOARD (AFTER TIME OUT LOOP) 405 001026 6671 RCSD /CARD DONE? 406 001027 7410 SKP 407 001030 5244 JMP CDRIN7 /YES - TOO FEW COLUMNS 408 001031 6631 RCSF /CHARACTER READY? 409 001032 5225 JMP CDRIN1 /NO - TRY CARD DONE 410 001033 4276 JMS CDRIN5 /RESET TIME OUT COUNT 411 001034 6634 RCRB /YES - READ BINARY 412 001035 3412 CDRIN2, DCA I XRCDR /AND STORE IT 413 001036 2031 ISZ TEMP1 /DON'T READ MORE THAN BUFFER CAN HOLD 414 001037 5225 JMP CDRIN1 /TRY CARD DONE AGAIN 415 001040 6671 RCSD /WAIT FOR END OF CARD - OR ELSE! 416 001041 5240 JMP .-1 417 001042 6674 RCRD /IF THIS ISN'T CLEARED, 418 /FORTRAN IV BECOMES VERY UNHAPPY! 419 001043 5250 JMP CDRIN8 420 001044 6674 CDRIN7, RCRD /FORTRAN IV AGAIN 421 001045 2031 ISZ TEMP1 /ALLOW ONE COLUMN TOO FEW (EDU30 - 39 COL) 422 001046 5063 JMP CDRER7 /ERROR! 423 001047 3412 DCA I XRCDR 424 001050 1375 CDRIN8, TAD (CDRBUF-1 /INIT BUFFER POINTERS AGAIN 425 001051 3012 DCA XRCDR 426 001052 1376 TAD (-50 427 001053 3031 DCA TEMP1 428 001054 1374 TAD (-EOFCHR /TEST FOR FIRST COLUMN=EOFCHR AND REST =0 429 001055 1412 EOFLP, TAD I XRCDR /GET NEXT COLUMN 430 001056 7640 SZA CLA 431 001057 5263 JMP REINIT /NON-ZERO - NOT EOF 432 001060 2031 ISZ TEMP1 433 001061 5255 JMP EOFLP /LOOP 434 001062 5267 JMP CDRCIF /END OF FILE CARD 435 001063 1375 REINIT, TAD (CDRBUF-1 436 001064 3012 DCA XRCDR 437 001065 2205 ISZ CDRIN /SKIP RETURN IF NOT EOF 438 001066 7340 L7777 /RESET EOF SWITCH 439 001067 0000 CDRCIF, 0 440 001070 3056 DCA CDREOF 441 001071 7340 L7777 /SET TO READ A NEW CARD NEXT TIME 442 001072 3054 DCA CDRFLG 443 001073 5605 JMP I CDRIN 444 445 001074 4303 CDRIN4, JMS KBRD /TEST TIME OUT 446 001075 5222 JMP CDRIN3 /TRY SELECTING CARD AGAIN 447 448 001076 0000 CDRIN5, 0 /RESET TIME OUT 449 001077 3353 DCA TIMOUT 450 001100 1373 TAD (-TIME 451 001101 3354 DCA TIMOU2 452 001102 5676 JMP I CDRIN5 453 454 001103 0000 KBRD, 0 455 001104 6031 KSF /KEYBOARD? 456 001105 5313 JMP KBRDTM /NO - TIME 457 001106 6034 KRS /IS IT ^C? 458 001107 0372 AND (177 459 001110 1371 TAD (-3 460 001111 7650 SNA CLA 461 001112 5601 JMP I K7600 /YES - RETURN TO OS-8 462 001113 2353 KBRDTM, ISZ TIMOUT /TIMED OUT YET? 463 001114 5703 JMP I KBRD /NO 464 001115 2354 ISZ TIMOU2 465 001116 5703 JMP I KBRD /LIKEWISE 466 001117 6030 KCF /IGNORE ANYTHING TYPED BEFORE THIS 467 001120 1370 TAD (207 /NOTHING - WAKE HIM UP 468 001121 4767 JMS I (TOUT 469 001122 1366 TAD (MSGJAM /IT COULD BE JAMMED 470 001123 3031 DCA TEMP1 471 001124 4765 JMS I (TTYOUT 472 001125 6031 KBRD1, KSF /WAIT FOR A CHARACTER OR READER 473 001126 5341 JMP KBRD3 474 001127 6034 KBRD2, KRS /GET THE CHAR 475 001130 0372 AND (177 /WITHOUT PARITY 476 001131 1371 TAD (-3 /IS IT ^C? 477 001132 7450 SNA 478 001133 5601 JMP I K7600 /YES - TO MONITOR 479 001134 6030 KCF /IF ^C - LEAVE FLAG SO OS-8 WILL SEE IT. ELSE CLEAR IT 480 001135 1364 TAD (3-32 /IS IT ^Z? 481 001136 7650 SNA CLA 482 001137 5267 JMP CDRCIF /YES - EOF 483 001140 5215 JMP CDRIN6 /GO BACK AND TIME OUT AGAIN 484 001141 6672 KBRD3, RCSE /SELECT A CARD? 485 001142 5325 JMP KBRD1 /NO - TRY KEYBOARD 486 001143 1376 TAD (-50 /RESET COUNT 487 001144 3031 DCA TEMP1 488 001145 1375 TAD (CDRBUF-1 /AND POINTER 489 001146 3012 DCA XRCDR 490 001147 5224 JMP CDRIN3+2 /YES - RE-ENTER ROUTINE WITH SUCCESSFUL SELECT 491 492 001150 6031 CDRJA1, KSF 493 001151 5350 JMP .-1 494 001152 5327 JMP KBRD2 495 496 001153 0000 TIMOUT, 0 497 001154 0000 TIMOU2, 0 498 499 001164 7751 PAGE 001165 1435 001166 3473 001167 2277 001170 0207 001171 7775 001172 0177 001173 7766 001174 1774 001175 3377 001176 7730 001177 0277 500 001200 1412 KEYTRA, TAD I XRCDR /GET KEYWORD COLUMN 501 001201 3026 DCA KEYWD+1 502 001202 1412 TAD I XRCDR /DITTO 503 001203 3027 DCA KEYWD+2 504 /CONVERT KEYWORD BITS TO NUMBER 505 001204 1377 TAD (KEYWD-1 /POINT INDEX REGISTER TO KEYWORD BUFFER 506 001205 3010 DCA XR1 507 001206 1376 TAD (-4 /SET COUNT OF WORDS 508 001207 3031 DCA TEMP1 509 001210 3041 DCA KEYVAL /ZERO KEYWORD VALUE 510 001211 1375 WRDLP, TAD (-14 /SET BIT COUNT 511 001212 3032 DCA TEMP2 512 001213 1410 TAD I XR1 /GET WORD 513 001214 2041 BITLP, ISZ KEYVAL /BUMP BIT VALUE 514 001215 7104 CLL RAL /SHIFT INTO LINK 515 001216 7430 SZL /IS THIS ONE ON? 516 001217 5232 JMP KEYFND /YES - KEYWORD FOUND 517 001220 2032 ISZ TEMP2 /COUNT BITS 518 001221 5214 JMP BITLP 519 001222 2031 ISZ TEMP1 /COUNT WORDS 520 001223 5211 JMP WRDLP 521 001224 4774 JMS I (LNOUT /SEND THE LINE NO. 522 001225 5773 JMP I (TEXTRA /ALL BITS OFF - NO KEYWORD 523 524 525 001226 4420 KEYBAD, ERROR 526 001227 4422 OUT 527 001230 5311 JMP KEYBLK 528 529 530 001231 1410 TAD I XR1 /GET NEXT WORD 531 001232 7640 KEYFND, SZA CLA /TEST THIS WORD 532 001233 5226 JMP KEYBAD /ERROR - MORE THAN ONE KEYWORD MARKED 533 001234 2031 ISZ TEMP1 /COUNT WORDS 534 001235 5231 JMP KEYFND-1 /AND LOOP 535 536 /OUTPUT THE KEYWORD 537 001236 1041 TAD KEYVAL /IS IT A BATCH CONTROL LANGUAGE COMMAND? 538 001237 1375 TAD (-14 539 001240 7740 SMA SZA CLA 540 001241 5246 JMP KEYOUT 541 001242 7340 L7777 /FOUND A BCL CARD 542 001243 3055 DCA BCLSW /GENERATE "$END" BEFORE CLOSING FILE 543 001244 6213 CIF CDF F1 544 001245 5772 JMP I (BCLTRA /YES - HANDLE THAT SPECIALLY 545 546 547 001246 4774 KEYOUT, JMS I (LNOUT /SEND LINE NUMBER 548 001247 1040 TAD KEYADR 549 001250 1041 TAD KEYVAL 550 001251 3031 DCA TEMP1 551 001252 1431 TAD I TEMP1 /GET ADDRESS OF KEYWORD 552 001253 7450 SNA 553 001254 5226 JMP KEYBAD /IF ZERO - UNUSED KEYWORD 554 001255 3031 DCA TEMP1 /ELSE SAVE IT 555 001256 1031 TAD TEMP1 /IS THIS "INPUT" OR "PRINT 556 001257 1371 TAD (-BPRI2 /BEING FUDGED UNDER BASIC? 557 001260 7450 SNA 558 001261 5265 JMP NOSGN /PRINT - CHECK FOR NUMBER SIGN 559 001262 1370 TAD (BPRI2-BINP2 560 001263 7640 SZA CLA 561 001264 5310 JMP KEYOU5 /NONE - ALL'S WELL 562 001265 1367 NOSGN, TAD (-40 /SET COUNT 563 001266 3033 DCA TEMP3 564 001267 1412 NOSGN1, TAD I XRCDR /IS NEXT CHAR BLANK? 565 001270 7440 SZA 566 001271 5275 JMP NOSGN2 /NO - IS IT # 567 001272 2033 ISZ TEMP3 568 001273 5267 JMP NOSGN1 569 001274 5306 JMP NOSGN3 /REST IS BLANK 570 001275 1372 NOSGN2, TAD (-NOCHR /IS IT "#"? 571 001276 7640 SZA CLA 572 001277 5306 JMP NOSGN3 /NO 573 001300 1031 TAD TEMP1 /YES - USE "INPUT" OR "PRINT" 574 001301 1371 TAD (-BPRI2 575 001302 7640 SZA CLA 576 001303 1366 TAD (BINP-BPRI 577 001304 1365 TAD (BPRI 578 001305 3031 DCA TEMP1 579 001306 1364 NOSGN3, TAD (CDRBUF+7 580 001307 3012 DCA XRCDR 581 001310 4772 KEYOU5, JMS I (UNPACK /AND OUTPUT KEYWORD 582 001311 1363 KEYBLK, TAD (" /INSERT BLANK AFTER KEYWORD 583 001312 4422 OUT 584 001313 5773 JMP I (TEXTRA 585 586 587 001363 0240 PAGE 001364 3407 001365 4066 001366 7760 001367 7740 001370 0020 001371 3707 001372 1400 001373 1600 001374 1444 001375 7764 001376 7774 001377 0024 588 001400 0000 UNPACK, 0 /OUTPUT PACKED 6-BIT ASCII TEXT 589 001401 1431 TAD I TEMP1 /IS FIRST CHAR = 00? 590 001402 0377 AND (7700 591 001403 7640 SZA CLA 592 001404 5210 JMP KEYOU1 /NO - NORMAL 6-BIT TRANSLATE 593 001405 1376 TAD (211 /YES - THIS IS TAB RATHER THAN END 594 001406 4422 OUT /OUTPUT IT 595 001407 5215 JMP KEYOU3 /AND GET SECOND CHARACTER 596 001410 1431 KEYOU1, TAD I TEMP1 /GET FIRST CHARACTER 597 001411 7112 CLL RTR 598 001412 7012 RTR 599 001413 7012 RTR 600 001414 4221 JMS KEYOU2 /AND OUTPUT IT 601 001415 1431 KEYOU3, TAD I TEMP1 /GET SECOND CHARACTER 602 001416 4221 JMS KEYOU2 /AND OUTPUT IT 603 001417 2031 ISZ TEMP1 /POINT TO NEXT TWO CHARACTERS 604 001420 5210 JMP KEYOU1 /ETC. 605 606 001421 0000 KEYOU2, 0 607 001422 0375 AND (77 /MASK FOR THE LOW ORDER BITS 608 001423 7450 SNA 609 001424 5600 JMP I UNPACK /CHARACTER IS 00 - END OF KEYWORD 610 001425 1374 TAD (-37 /? 611 001426 7450 SNA 612 001427 1373 TAD (215-337 /THIS WILL BE 215 WHEN WE'RE DONE 613 001430 7510 SPA 614 001431 1372 TAD (100 615 001432 1371 TAD (237 616 001433 4422 OUT /OUTPUT THE CHARACTER 617 001434 5621 JMP I KEYOU2 618 619 001435 0000 TTYOUT, 0 /USE UNPACK ROUTINE TO PRINT MESSAGE ON TTY 620 001436 1370 TAD (TOUT /SWITCH OUTPUT ROUTINES 621 001437 3022 DCA OUTAD 622 001440 4200 JMS UNPACK 623 001441 1367 TAD (XOUT /RESET OUTPUT ROUTINES 624 001442 3022 DCA OUTAD 625 001443 5635 JMP I TTYOUT /RETURN 626 627 628 001444 0000 LNOUT, 0 /OUTPUT THE LINE NUMBER 629 001445 4423 SAVFLD;LNCIF 001446 1467 630 001447 1045 TAD LNCNT /GET NUMBER OF CHARS 631 001450 7040 CMA 632 001451 3031 DCA TEMP1 633 001452 1366 TAD (CDRBUF /START WITH COLUMN 2 634 001453 3011 DCA XR2 635 001454 2031 LNOUT1, ISZ TEMP1;SKP /MORE DIGITS? 001455 7410 636 001456 5262 JMP LNOUT2 /NO 637 001457 1411 TAD I XR2;OUT 001460 4422 638 001461 5254 JMP LNOUT1 639 001462 1045 LNOUT2, TAD LNCNT /ANY DIGITS? 640 001463 7650 SNA CLA 641 001464 5267 JMP LNCIF 642 001465 1365 TAD (" ;OUT /YES - SUFFIX A BLANK 001466 4422 643 001467 0000 LNCIF, 0 644 001470 5644 JMP I LNOUT 645 646 647 001565 0240 PAGE 001566 3400 001567 2053 001570 2277 001571 0237 001572 0100 001573 7656 001574 7741 001575 0077 001576 0211 001577 7700 648 /TRANSLATE TEXT 649 001600 3044 TEXTRA, DCA CONFLG /CLEAR CONTINUATION FLAG 650 001601 3031 DCA TEMP1 /CLEAR COUNT OF BLANK CHARACTERS 651 001602 1377 TAD (-40 /32 COLUMNS OF TEXT (DECIMAL) 652 001603 3033 DCA TEMP3 653 001604 1412 TEXLP1, TAD I XRCDR 654 001605 7450 SNA /BLANK? 655 001606 5232 JMP TEXBLK /YES - COUNT A BLANK 656 001607 1376 TAD (-CONTCH /CONTINUATION CHARACTER? 657 001610 7450 SNA 658 001611 5226 JMP TEXCON /YES - ENOUGH OF THIS CARD 659 001612 1375 TAD (CONTCH 660 001613 4421 CONVRT /TRANSLATE THE CHARACTER 661 001614 5221 JMP TEXLP2 /RUBOUT? - GET THE NEXT CHARACTER 662 001615 3032 DCA TEMP2 /SAVE THE CHARACTER 663 001616 4234 JMS TEXBOU /OUTPUT THE COUNTED BLANKS 664 001617 1032 TAD TEMP2 665 001620 4422 OUT /OUTPUT THE CHARACTER 666 001621 2033 TEXLP2, ISZ TEMP3 /COUNT COLUMNS 667 001622 5204 JMP TEXLP1 668 001623 1374 TAD (215 /OUTPUT A 669 001624 4422 OUT 670 001625 5246 JMP TEXFIN 671 672 673 001626 4234 TEXCON, JMS TEXBOU 674 001627 7240 CLA CMA 675 001630 3044 DCA CONFLG /SET THE CONTINUATION FLAG 676 001631 5246 JMP TEXFIN 677 678 679 001632 2031 TEXBLK, ISZ TEMP1 /COUNT THE BLANKS 680 001633 5221 JMP TEXLP2 /GET THE NEXT CHARACTER 681 682 683 001634 0000 TEXBOU, 0 /OUTPUT BLANKS 684 001635 1031 TAD TEMP1 685 001636 7040 CMA 686 001637 3031 DCA TEMP1 687 001640 2031 TEXBO1, ISZ TEMP1 /MORE BLANKS 688 001641 7410 SKP 689 001642 5634 JMP I TEXBOU /NO - RETURN 690 001643 1373 TAD (" /YES - OUTPUT A BLANK 691 001644 4422 OUT 692 001645 5240 JMP TEXBO1 693 694 695 001646 1042 TEXFIN, TAD ERRFLG /DID THIS CARD HAVE AN ERROR? 696 001647 7640 SZA CLA 697 001650 2043 ISZ ERRCNT /YES - COUNT IT 698 001651 5772 JMP I (READY /PROCESS NEXT CARD 699 700 701 /CARD CODE TO ASCII CONVERSION ROUTINE 702 001652 0000 XCONVR, 0 /INPUT 12 BIT CARD CODE - OUTPUT 8 BIT ASCII 703 001653 4423 SAVFLD;XCOCIF /SAVE DATA FIELD FOR RETURN 001654 1744 704 001655 3346 DCA CONVR1 /SAVE 12 BIT CARD CODE 705 001656 1371 TAD (RUBOUT 706 001657 0346 AND CONVR1 707 001660 1370 TAD (-RUBOUT 708 001661 7650 SNA CLA /WAS CHARACTER RUBBED OUT? 709 001662 5344 JMP XCOCIF /YES - RETURN 0 IN AC 710 001663 2252 ISZ XCONVR /NOT RUBBED OUT - SKIP RETURN 711 001664 1346 TAD CONVR1 712 001665 7006 RTL 713 001666 7006 RTL 714 001667 0371 AND (7 /GET ZONE BITS 715 001670 7104 CLL RAL 716 001671 3347 DCA CONVR2 /2*ZONE BITS 717 001672 1347 TAD CONVR2 718 001673 7006 RTL 719 001674 1347 TAD CONVR2 /10*ZONE BITS 720 001675 3347 DCA CONVR2 721 001676 1346 TAD CONVR1 722 001677 7006 RTL 723 001700 7004 RAL 724 001701 0367 AND (7770 /1-9 "PUNCHES" 725 001702 7450 SNA 726 001703 5312 JMP CONVR3 /IF ALL OFF DON'T INCREMENT COUNT 727 001704 7104 CLL RAL /SHIFT NEXT BIT INTO LINK 728 001705 2347 ISZ CONVR2 /COUNT THE BIT 729 001706 7420 SNL 730 001707 5304 JMP .-3 /LOOP IF OFF 731 001710 7640 SZA CLA 732 001711 5343 JMP CONILL /IF REST OF AC IS NOT ZERO - ILLEGAL CHARACTER 733 001712 1347 CONVR3, TAD CONVR2 /GET DISPLACEMENT OF CHAR IN TABLE 734 001713 7110 CLL RAR /GET WORD DISPLACEMENT IN AC 735 001714 1366 TAD (TRTAB /ADDRESS OF WORD 736 001715 3347 DCA CONVR2 737 001716 1747 TAD I CONVR2 /GET WORD 738 001717 7430 SZL 739 001720 5324 JMP .+4 /IF DISPLACEMENT WAS ODD, USE LOW ORDER HALF OF WORD 740 001721 7012 RTR 741 001722 7012 RTR 742 001723 7012 RTR 743 001724 0365 AND (77 /MASK FOR LOW PART OF WORD 744 001725 7450 SNA 745 001726 5331 JMP CONVR4 /ZERO IN TABLE IS ILLEGAL CODE (MAYBE) 746 001727 1373 TAD (240 747 001730 5344 JMP XCOCIF /RETURN WITH 8 BIT ASCII IN AC 748 001731 1346 CONVR4, TAD CONVR1 /GET 12-BIT CARD CODE 749 001732 1364 TAD (-TABCHR /IS IT A TAB CHAR? 750 001733 7450 SNA 751 001734 5341 JMP CONVR5 /YUP! 752 001735 1363 TAD (TABCHR-FFCHR /HOW ABOUT A FORM FEED? 753 001736 7640 SZA CLA 754 001737 5343 JMP CONILL /NOPE - IT'S REALLY BAD 755 001740 1375 TAD (214-211 /IT'S FORM FEED 756 001741 1362 CONVR5, TAD (211 /IT'S TAB 757 001742 5344 JMP XCOCIF 758 001743 4420 CONILL, ERROR /SET ERROR FLAG; RETURN "?" IN AC 759 001744 0000 XCOCIF, 0 760 001745 5652 JMP I XCONVR 761 762 001746 0000 CONVR1, 0 763 001747 0000 CONVR2, 0 764 765 766 001762 0211 PAGE 001763 3000 001764 1770 001765 0077 001766 3724 001767 7770 001770 7771 001771 0007 001772 0600 001773 0240 001774 0215 001775 0003 001776 7775 001777 7740 767 /OUTPUT A CHARACTER. RETURNS .+1 IF CHARACTER IS 768 /JUST STORED IN BUFFER. RETURNS .+2 IF NO MORE SPACE IN 769 /EMPTY. RETURNS .+3 IF BLOCK WAS WRITTEN AND THERE ARE 770 /MORE BLOCKS IN THE EMPTY. 771 002000 0000 XOUTP, 0 /OUTPUT ROUTINE 772 002001 2037 ISZ OPTSW /THREE WAY SWITCH 773 002002 5247 JMP XOUT1 774 002003 3251 DCA XOUT2 /SAVE CHAR IN TEMP 775 002004 7340 L7777 776 002005 1013 TAD XROPT /BACK UP 2 WORDS 777 002006 3252 DCA XOUT3 778 002007 1251 TAD XOUT2 /GET FIRST HALF OF CHARACTER 779 002010 7006 RTL 780 002011 7006 RTL 781 002012 0304 AND K7400 782 002013 1652 TAD I XOUT3 /ADD IN FIRST CHARACTER 783 002014 3652 DCA I XOUT3 784 002015 2252 ISZ XOUT3 785 002016 1251 TAD XOUT2 /GET SECOND HALF OF CHARACTER 786 002017 7012 RTR 787 002020 7012 RTR 788 002021 7010 RAR 789 002022 0304 AND K7400 790 002023 1652 TAD I XOUT3 /ADD IN SECOND CHARACTER 791 002024 3652 DCA I XOUT3 792 002025 2036 ISZ OPTCNT /IS BUFFER FULL? 793 002026 5244 JMP XOUT6 /NO - RETURN NORMALLY 794 002027 4457 JMS I DEVENT /CALL DEVICE HANDLER 795 002030 4200 4200 /TWO PAGES OF OUTPUT FROM FIELD 0 796 002031 3000 OPTBUF /BUFFER ADDRESS 797 002032 0000 OPTBLK, 0 /BLOCK NUMBER 798 002033 5066 JMP OPTER4 /ERROR DOING OUTPUT 799 002034 2232 ISZ OPTBLK /INCREMENT BLOCK NUMBER 800 002035 1377 TAD (OPTBUF-1 /RESET BUFFER POINTER 801 002036 3013 DCA XROPT 802 002037 1376 TAD (-200 /AND BUFFER LENGTH /2 803 002040 3036 DCA OPTCNT 804 002041 2200 ISZ XOUTP /SKIP RETURN IF BLOCK WRITTEN 805 002042 2775 ISZ I (FILLEN /MORE BLOCKS IN EMPTY? 806 002043 2200 ISZ XOUTP /YES - SKIP AGAIN 807 002044 7346 XOUT6, L7775 /RESET 3-WAY SWITCH 808 002045 3037 DCA OPTSW 809 002046 5600 JMP I XOUTP /RETURN 810 811 002047 3413 XOUT1, DCA I XROPT /SAVE CHARACTER IN BUFFER 812 002050 5600 JMP I XOUTP 813 814 002051 0000 XOUT2, 0 815 002052 0000 XOUT3, 0 816 817 818 002053 0000 XOUT, 0 819 002054 3326 DCA CLOSLN /SAVE CHAR IN A CONVENIENT TEMP 820 002055 1326 TAD CLOSLN 821 002056 4200 JMS XOUTP /OUTPUT THE CHARACTER 822 002057 7410 SKP 823 002060 5065 JMP OPTER5 /FILLED UP AVAILABLE SPACE BEFORE ^Z 824 002061 1326 TAD CLOSLN /WAS IT ? 825 002062 1374 TAD (-215 826 002063 7640 SZA CLA 827 002064 5653 JMP I XOUT /RETURN 828 002065 1373 TAD (212 829 002066 5254 JMP XOUT+1 830 831 832 002067 3041 EOF, DCA KEYVAL /FINISH UP ANY BCL CARD IN PROGRESS 833 002070 3044 DCA CONFLG /ZERO THESE TO GET US AROUND 834 002071 3045 DCA LNCNT /THE TESTS IN BCLHUH 835 002072 6213 CIF CDF F1 836 002073 5772 JMP I (BCLTRA 837 002074 2055 EOF2, ISZ BCLSW /WERE THERE ANY BCL CARDS? 838 002075 5301 JMP EOF1 /NO 839 002076 1371 TAD (MEND /YES - SEND "$END" 840 002077 3031 DCA TEMP1 841 002100 4772 JMS I (UNPACK 842 002101 1370 EOF1, TAD (32 /^Z 843 002102 4200 JMS XOUTP /OUTPUT CHAR 844 002103 5302 JMP .-1 /BLOCK NOT YET FULL 845 002104 7400 K7400, 7400 /BLOCK WRITTEN 846 002105 1767 TAD I (BLOKNO /BLOCK WRITTEN 847 002106 7041 CIA 848 002107 1232 TAD OPTBLK /GET LENGTH OF FILE WRITTEN 849 002110 3326 DCA CLOSLN /SET LENGTH FOR CLOSE 850 002111 2046 ISZ USRFLG;SKP /IS USR IN CORE? 002112 7410 851 002113 5317 JMP EOF3 /YES 852 002114 6212 CIF 10;JMS I (7700;USRIN /BRING IN THE USR 002115 4766 002116 0010 853 002117 7340 EOF3, L7777 /SET USR IN CORE FLAG 854 002120 3046 DCA USRFLG 855 002121 1047 TAD OFILE /GET DEVICE NUMBER 856 002122 6212 CIF 10;USR;CLOSE 002123 4424 002124 0004 857 002125 0000 CLOSNM, 0 /POINTER TO NAME 858 002126 0000 CLOSLN, 0 /LENGTH OF FILE 859 002127 5064 JMP OPTER6 860 002130 1326 TAD CLOSLN 861 002131 7041 CIA 862 002132 7006 RTL 863 002133 7006 RTL 864 002134 0365 AND (7760 /GET MINUS LENGTH IN BITS 0-7 865 002135 6211 CDF 10 866 002136 1764 TAD I (7617 867 002137 3764 DCA I (7617 /SET LENGTH AND DEVICE NO. FOR BATCH 868 002140 6201 CDF 869 002141 5763 JMP I (ERRDEC /CONVERT NUMBER OF ERRORS TO DECIMAL 870 871 872 002163 2200 PAGE 002164 7617 002165 7760 002166 7700 002167 0266 002170 0032 002171 3454 002172 1400 002173 0212 002174 7563 002175 0267 002176 7600 002177 2777 873 /CONVERT NUMBER OF CARDS IN ERROR TO DECIMAL AND TYPE MESSAGE 874 002200 1377 ERRDEC, TAD (DECN-1 /START POWERS OF 10 AT 1000 875 002201 3010 DCA XR1 876 002202 1376 TAD (-4 877 002203 3031 DCA TEMP1 /FOUR POWERS OF 10 878 002204 3035 DCA TEMP5 /CLEAR LEADING ZEROES FLAG 879 002205 1043 TAD ERRCNT /SET VALUE 880 002206 3034 DCA TEMP4 881 002207 1375 TAD (TOUT /FUDGE OUTPUT CALL 882 002210 3022 DCA OUTAD 883 002211 4244 JMS CONDEC /CONVERT TO DECIMAL 884 002212 1374 TAD (XOUT /RESTORE OUTPUT CALL 885 002213 3022 DCA OUTAD 886 002214 1373 TAD (NOMES /SET UP TO PRINT "NO" 887 002215 3031 DCA TEMP1 888 002216 1035 TAD TEMP5 /DID WE PRINT A NUMBER? 889 002217 7650 SNA CLA 890 002220 4772 JMS I (TTYOUT /NO - PRINT "NO" 891 002221 1371 TAD (CDMES /PRINT "CARDS IN ERROR" 892 002222 3031 DCA TEMP1 893 002223 4772 JMS I (TTYOUT 894 002224 5770 EOFJMP, JMP I (CD /DONE WITH THIS ONE - CALL COMMAND DECODER 895 002225 7301 SYSNO /LOAD SYS: NUMBER FOR LOOKUP 896 002226 6212 CIF 10;USR;LOOKUP 002227 4424 002230 0002 897 002231 3450 BATBLK, BATNAM 898 002232 0000 0 899 002233 5062 JMP IOER8 900 002234 1231 TAD BATBLK 901 002235 3243 DCA CHNBLK 902 002236 7301 L0001 903 002237 3767 DCA I (JSBITS /KEEP USR ACROSS CHAIN 904 002240 6212 CIF 10;USR;CHAIN /NOW CHAIN TO BATCH 002241 4424 002242 0006 905 002243 0000 CHNBLK, 0 906 907 908 002244 0000 CONDEC, 0 /CONVERT A NUMBER TO DECIMAL 909 002245 4423 SAVFLD;CONCIF /SAVE DATA FIELD FOR RETURN 002246 2275 910 002247 1410 DIGLP, TAD I XR1 /GET THIS POWER OF 10 911 002250 3032 DCA TEMP2 /AND SAVE IT 912 002251 3033 DCA TEMP3 /CLEAR THIS DIGIT 913 002252 1034 DIGLP1, TAD TEMP4 /GET NUMBER TO BE CONVERTED 914 002253 1032 TAD TEMP2 /DIVIDE BY SUBTRACTING 915 002254 7510 SPA 916 002255 5261 JMP DIGLP2 /WENT NEGATIVE - DONE 917 002256 2033 ISZ TEMP3 /BUMP COUNT 918 002257 3034 DCA TEMP4 /SAVE REDUCED VALUE 919 002260 5252 JMP DIGLP1 920 002261 7200 DIGLP2, CLA 921 002262 1033 TAD TEMP3 /GET VALUE OF THIS DIGIT 922 002263 7440 SZA 923 002264 5270 JMP DIGOUT /NOT A ZERO - PRINT IT 924 002265 1035 TAD TEMP5 /IF ZERO - IS IT LEADING? 925 002266 7650 SNA CLA 926 002267 5273 JMP DIGLPE /YES - DON'T PRINT IT 927 002270 2035 DIGOUT, ISZ TEMP5 /IF PRINTING, THEN ZEROES ARE NOT LEADING 928 002271 1366 TAD (260 /CONVERT TO ASCII 929 002272 4422 OUT 930 002273 2031 DIGLPE, ISZ TEMP1 /LAST DIGIT? 931 002274 5247 JMP DIGLP /NO - LOOP 932 002275 0000 CONCIF, 0 933 002276 5644 JMP I CONDEC /RETURN 934 935 936 002277 0000 TOUT, 0 /SEND A CHARACTER TO THE TTY 937 002300 6046 TLS 938 002301 6041 TSF 939 002302 5301 JMP .-1 940 002303 1365 TAD (-215 /WAS THE CHARACTER ? 941 002304 7640 SZA CLA 942 002305 5677 JMP I TOUT /NO - RETURN 943 002306 1364 TAD (212 /YES - TYPE A LINE FEED 944 002307 5300 JMP TOUT+1 945 946 947 002310 6201 IOERR1, CDF F0 948 002311 7200 CLA /TYPE ERROR MESSAGE 949 002312 1060 TAD IOERR /GET NUMBER 950 002313 7104 CLL RAL 951 002314 1363 TAD (IOETAB-1 952 002315 3010 DCA XR1 953 002316 1410 TAD I XR1 /GET ADDRESS OF MESSAGE 954 002317 3031 DCA TEMP1 955 002320 3060 DCA IOERR /CLEAR ERROR NUMBER 956 002321 4772 JMS I (TTYOUT /PRINT IT 957 002322 1410 TAD I XR1 /GO TO RESTART ADDRESS 958 002323 3031 DCA TEMP1 959 002324 5431 JMP I TEMP1 960 961 962 002363 3675 PAGE 002364 0212 002365 7563 002366 0260 002367 7746 002370 0206 002371 3462 002372 1435 002373 3460 002374 2053 002375 2277 002376 7774 002377 3717 963 002400 0000 OPTDEV, ZBLOCK 400 /TWO PAGES FOR DEVICE HANDLER 002401 0000 002402 0000 002403 0000 002404 0000 002405 0000 002406 0000 002407 0000 002410 0000 002411 0000 002412 0000 002413 0000 002414 0000 002415 0000 002416 0000 002417 0000 002420 0000 002421 0000 002422 0000 002423 0000 002424 0000 002425 0000 002426 0000 002427 0000 002430 0000 002431 0000 002432 0000 002433 0000 002434 0000 002435 0000 002436 0000 002437 0000 002440 0000 002441 0000 002442 0000 002443 0000 002444 0000 002445 0000 002446 0000 002447 0000 002450 0000 002451 0000 002452 0000 002453 0000 002454 0000 002455 0000 002456 0000 002457 0000 002460 0000 002461 0000 002462 0000 002463 0000 002464 0000 002465 0000 002466 0000 002467 0000 002470 0000 002471 0000 002472 0000 002473 0000 002474 0000 002475 0000 002476 0000 002477 0000 002500 0000 002501 0000 002502 0000 002503 0000 002504 0000 002505 0000 002506 0000 002507 0000 002510 0000 002511 0000 002512 0000 002513 0000 002514 0000 002515 0000 002516 0000 002517 0000 002520 0000 002521 0000 002522 0000 002523 0000 002524 0000 002525 0000 002526 0000 002527 0000 002530 0000 002531 0000 002532 0000 002533 0000 002534 0000 002535 0000 002536 0000 002537 0000 002540 0000 002541 0000 002542 0000 002543 0000 002544 0000 002545 0000 002546 0000 002547 0000 002550 0000 002551 0000 002552 0000 002553 0000 002554 0000 002555 0000 002556 0000 002557 0000 002560 0000 002561 0000 002562 0000 002563 0000 002564 0000 002565 0000 002566 0000 002567 0000 002570 0000 002571 0000 002572 0000 002573 0000 002574 0000 002575 0000 002576 0000 002577 0000 002600 0000 002601 0000 002602 0000 002603 0000 002604 0000 002605 0000 002606 0000 002607 0000 002610 0000 002611 0000 002612 0000 002613 0000 002614 0000 002615 0000 002616 0000 002617 0000 002620 0000 002621 0000 002622 0000 002623 0000 002624 0000 002625 0000 002626 0000 002627 0000 002630 0000 002631 0000 002632 0000 002633 0000 002634 0000 002635 0000 002636 0000 002637 0000 002640 0000 002641 0000 002642 0000 002643 0000 002644 0000 002645 0000 002646 0000 002647 0000 002650 0000 002651 0000 002652 0000 002653 0000 002654 0000 002655 0000 002656 0000 002657 0000 002660 0000 002661 0000 002662 0000 002663 0000 002664 0000 002665 0000 002666 0000 002667 0000 002670 0000 002671 0000 002672 0000 002673 0000 002674 0000 002675 0000 002676 0000 002677 0000 002700 0000 002701 0000 002702 0000 002703 0000 002704 0000 002705 0000 002706 0000 002707 0000 002710 0000 002711 0000 002712 0000 002713 0000 002714 0000 002715 0000 002716 0000 002717 0000 002720 0000 002721 0000 002722 0000 002723 0000 002724 0000 002725 0000 002726 0000 002727 0000 002730 0000 002731 0000 002732 0000 002733 0000 002734 0000 002735 0000 002736 0000 002737 0000 002740 0000 002741 0000 002742 0000 002743 0000 002744 0000 002745 0000 002746 0000 002747 0000 002750 0000 002751 0000 002752 0000 002753 0000 002754 0000 002755 0000 002756 0000 002757 0000 002760 0000 002761 0000 002762 0000 002763 0000 002764 0000 002765 0000 002766 0000 002767 0000 002770 0000 002771 0000 002772 0000 002773 0000 002774 0000 002775 0000 002776 0000 002777 0000 964 003000 0000 OPTBUF, ZBLOCK 400 /TWO PAGES FOR OUTPUT BUFFER 003001 0000 003002 0000 003003 0000 003004 0000 003005 0000 003006 0000 003007 0000 003010 0000 003011 0000 003012 0000 003013 0000 003014 0000 003015 0000 003016 0000 003017 0000 003020 0000 003021 0000 003022 0000 003023 0000 003024 0000 003025 0000 003026 0000 003027 0000 003030 0000 003031 0000 003032 0000 003033 0000 003034 0000 003035 0000 003036 0000 003037 0000 003040 0000 003041 0000 003042 0000 003043 0000 003044 0000 003045 0000 003046 0000 003047 0000 003050 0000 003051 0000 003052 0000 003053 0000 003054 0000 003055 0000 003056 0000 003057 0000 003060 0000 003061 0000 003062 0000 003063 0000 003064 0000 003065 0000 003066 0000 003067 0000 003070 0000 003071 0000 003072 0000 003073 0000 003074 0000 003075 0000 003076 0000 003077 0000 003100 0000 003101 0000 003102 0000 003103 0000 003104 0000 003105 0000 003106 0000 003107 0000 003110 0000 003111 0000 003112 0000 003113 0000 003114 0000 003115 0000 003116 0000 003117 0000 003120 0000 003121 0000 003122 0000 003123 0000 003124 0000 003125 0000 003126 0000 003127 0000 003130 0000 003131 0000 003132 0000 003133 0000 003134 0000 003135 0000 003136 0000 003137 0000 003140 0000 003141 0000 003142 0000 003143 0000 003144 0000 003145 0000 003146 0000 003147 0000 003150 0000 003151 0000 003152 0000 003153 0000 003154 0000 003155 0000 003156 0000 003157 0000 003160 0000 003161 0000 003162 0000 003163 0000 003164 0000 003165 0000 003166 0000 003167 0000 003170 0000 003171 0000 003172 0000 003173 0000 003174 0000 003175 0000 003176 0000 003177 0000 003200 0000 003201 0000 003202 0000 003203 0000 003204 0000 003205 0000 003206 0000 003207 0000 003210 0000 003211 0000 003212 0000 003213 0000 003214 0000 003215 0000 003216 0000 003217 0000 003220 0000 003221 0000 003222 0000 003223 0000 003224 0000 003225 0000 003226 0000 003227 0000 003230 0000 003231 0000 003232 0000 003233 0000 003234 0000 003235 0000 003236 0000 003237 0000 003240 0000 003241 0000 003242 0000 003243 0000 003244 0000 003245 0000 003246 0000 003247 0000 003250 0000 003251 0000 003252 0000 003253 0000 003254 0000 003255 0000 003256 0000 003257 0000 003260 0000 003261 0000 003262 0000 003263 0000 003264 0000 003265 0000 003266 0000 003267 0000 003270 0000 003271 0000 003272 0000 003273 0000 003274 0000 003275 0000 003276 0000 003277 0000 003300 0000 003301 0000 003302 0000 003303 0000 003304 0000 003305 0000 003306 0000 003307 0000 003310 0000 003311 0000 003312 0000 003313 0000 003314 0000 003315 0000 003316 0000 003317 0000 003320 0000 003321 0000 003322 0000 003323 0000 003324 0000 003325 0000 003326 0000 003327 0000 003330 0000 003331 0000 003332 0000 003333 0000 003334 0000 003335 0000 003336 0000 003337 0000 003340 0000 003341 0000 003342 0000 003343 0000 003344 0000 003345 0000 003346 0000 003347 0000 003350 0000 003351 0000 003352 0000 003353 0000 003354 0000 003355 0000 003356 0000 003357 0000 003360 0000 003361 0000 003362 0000 003363 0000 003364 0000 003365 0000 003366 0000 003367 0000 003370 0000 003371 0000 003372 0000 003373 0000 003374 0000 003375 0000 003376 0000 003377 0000 965 003400 0000 CDRBUF, DECIMAL;ZBLOCK 40;OCTAL 003401 0000 003402 0000 003403 0000 003404 0000 003405 0000 003406 0000 003407 0000 003410 0000 003411 0000 003412 0000 003413 0000 003414 0000 003415 0000 003416 0000 003417 0000 003420 0000 003421 0000 003422 0000 003423 0000 003424 0000 003425 0000 003426 0000 003427 0000 003430 0000 003431 0000 003432 0000 003433 0000 003434 0000 003435 0000 003436 0000 003437 0000 003440 0000 003441 0000 003442 0000 003443 0000 003444 0000 003445 0000 003446 0000 003447 0000 966 003450 0201 BATNAM, TEXT "BATCH@SV";*.-1 003451 2403 003452 1000 003453 2326 003454 0000 967 003454 3744 MEND, TEXT "_$END_" 003455 0516 003456 0437 003457 0000 968 003460 1617 NOMES, TEXT "NO" 003461 0000 969 003462 4003 CDMES, TEXT " CARDS IN ERROR_" 003463 0122 003464 0423 003465 4011 003466 1640 003467 0522 003470 2217 003471 2237 003472 0000 970 003473 1417 MSGJAM, TEXT "LOAD MORE CARDS OR TYPE ^Z_" 003474 0104 003475 4015 003476 1722 003477 0540 003500 0301 003501 2204 003502 2340 003503 1722 003504 4024 003505 3120 003506 0540 003507 3632 003510 3700 971 003511 1617 IOEM1, TEXT "NO OUTPUT FILE SPECIFIED_" 003512 4017 003513 2524 003514 2025 003515 2440 003516 0611 003517 1405 003520 4023 003521 2005 003522 0311 003523 0611 003524 0504 003525 3700 972 003526 0301 IOEM2, TEXT "CAN'T FETCH DEVICE HANDLER_" 003527 1647 003530 2440 003531 0605 003532 2403 003533 1040 003534 0405 003535 2611 003536 0305 003537 4010 003540 0116 003541 0414 003542 0522 003543 3700 973 003544 0301 IOEM3, TEXT "CAN'T ENTER FILE_" 003545 1647 003546 2440 003547 0516 003550 2405 003551 2240 003552 0611 003553 1405 003554 3700 974 003555 1725 IOEM4, TEXT "OUTPUT ERROR_" 003556 2420 003557 2524 003560 4005 003561 2222 003562 1722 003563 3700 975 003564 0611 IOEM5, TEXT "FILE TOO BIG_" 003565 1405 003566 4024 003567 1717 003570 4002 003571 1107 003572 3700 976 003573 0301 IOEM6, TEXT "CAN'T CLOSE FILE_" 003574 1647 003575 2440 003576 0314 003577 1723 003600 0540 003601 0611 003602 1405 003603 3700 977 003604 0301 IOEM7, TEXT "CARD IN READER BACKWARDS. TYPE SPACE TO CONTINUE._" 003605 2204 003606 4011 003607 1640 003610 2205 003611 0104 003612 0522 003613 4002 003614 0103 003615 1327 003616 0122 003617 0423 003620 5640 003621 4024 003622 3120 003623 0540 003624 2320 003625 0103 003626 0540 003627 2417 003630 4003 003631 1716 003632 2411 003633 1625 003634 0556 003635 3700 978 003636 4202 IOEM8, TEXT /"BATCH.SV" NOT ON SYS: - CAN'T CHAIN_/ 003637 0124 003640 0310 003641 5623 003642 2642 003643 4016 003644 1724 003645 4017 003646 1640 003647 2331 003650 2372 003651 4055 003652 4003 003653 0116 003654 4724 003655 4003 003656 1001 003657 1116 003660 3700 979 003661 1523 VERM9, TEXT "MSBAT - VERSION 3A_@@@@@@" 003662 0201 003663 2440 003664 5540 003665 2605 003666 2223 003667 1117 003670 1640 003671 6301 003672 3700 003673 0000 003674 0000 003675 0000 980 981 003676 3511 IOETAB, IOEM1;START 003677 0200 982 003700 3526 IOEM2;START 003701 0200 983 003702 3544 IOEM3;START 003703 0200 984 003704 3555 IOEM4;START 003705 0200 985 003706 3564 IOEM5;START 003707 0200 986 003710 3573 IOEM6;START 003711 0200 987 003712 3604 IOEM7;CDRJA1 003713 1150 988 003714 3636 IOEM8;7600 003715 7600 989 003716 3661 VERM9;START 003717 0200 990 991 DECIMAL 992 003720 6030 DECN, -1000 993 003721 7634 -100 994 003722 7766 -10 995 003723 7777 -1 996 OCTAL 997 998 /CHARACTER CODE TRANSLATION TABLE 999 TRTAB, 1000 /0 IN ROWS 12-0 1001 003724 0021 0021 /?1 1002 003725 2223 2223 /23 1003 003726 2425 2425 /45 1004 003727 2627 2627 /67 1005 003730 3031 3031 /89 1006 /1 1007 003731 2043 2043 /0C 1008 003732 4651 4651 /FI 1009 003733 5457 5457 /LO 1010 003734 6265 6265 /RU 1011 003735 7004 7004 /X$ 1012 /2 1013 003736 1442 1442 /,B 1014 003737 4550 4550 /EH 1015 003740 5356 5356 /KN 1016 003741 6164 6164 /QT 1017 003742 6772 6772 /WZ 1018 /3 1019 003743 3632 3632 />: 1020 003744 0106 0106 /!& 1021 003745 7540 7540 /]@ 1022 003746 0000 0000 /
? 1023 003747 0000 0000 /?? 1024 /4 1025 003750 1641 1641 /.A 1026 003751 4447 4447 /DG 1027 003752 5255 5255 /JM 1028 003753 6063 6063 /PS 1029 003754 6671 6671 /VY 1030 /5 1031 003755 3400 3400 / _ 1041 003766 0000 0000 /?? 1042 /7 1043 003767 7435 7435 /\= 1044 003770 1315 1315 /+- 1045 003771 1217 1217 /*/ 1046 003772 7610 7610 /^( 1047 003773 1102 1102 /)" 1048 1049 1050 /BASIC KEYWORDS 1051 003774 0401 BDAT, TEXT "DATA" 003775 2401 003776 0000 1052 003777 0301 BCAL, TEXT "CALL" 004000 1414 004001 0000 1053 004002 0314 BCLO, TEXT "CLOSE" 004003 1723 004004 0500 1054 004005 0405 BDEF, TEXT "DEFINE" 004006 0611 004007 1605 004010 0000 1055 004011 0310 BCHN, TEXT "CHAIN" 004012 0111 004013 1600 1056 004014 0411 BDIM, TEXT "DIMENSION" 004015 1505 004016 1623 004017 1117 004020 1600 1057 004021 0310 BCHG, TEXT "CHANGE" 004022 0116 004023 0705 004024 0000 1058 004025 0516 BEND, TEXT "END" 004026 0400 1059 004027 0314 BEND2, TEXT "CLOSE #4\END" 004030 1723 004031 0540 004032 4364 004033 3405 004034 1604 004035 0000 1060 004036 0611 BFIL, TEXT "FILE" 004037 1405 004040 0000 1061 004041 0717 BGOS, TEXT "GOSUB" 004042 2325 004043 0200 1062 004044 1106 BIF, TEXT "IF" 004045 0000 1063 004046 1116 BINP, TEXT "INPUT" 004047 2025 004050 2400 1064 004051 1116 BINP2, TEXT "INPUT #3:" 004052 2025 004053 2440 004054 4363 004055 7200 1065 004056 1411 BLIS, TEXT "LIST" 004057 2324 004060 0000 1066 004061 1605 BNEX, TEXT "NEXT" 004062 3024 004063 0000 1067 004064 1714 BOLD, TEXT "OLD" 004065 0400 1068 004066 2022 BPRI, TEXT "PRINT" 004067 1116 004070 2400 1069 004071 2022 BPRI2, TEXT "PRINT #4:" 004072 1116 004073 2440 004074 4364 004075 7200 1070 004076 2205 BREA, TEXT "READ" 004077 0104 004100 0000 1071 004101 2205 BRES, TEXT "RESTORE" 004102 2324 004103 1722 004104 0500 1072 004105 2225 BRUN, TEXT "RUN" 004106 1600 1073 004107 0617 BFOR, TEXT "FOR" 004110 2200 1074 004111 0717 BGOT, TEXT "GOTO" 004112 2417 004113 0000 1075 004114 1106 BIFE, TEXT "IF END" 004115 4005 004116 1604 004117 0000 1076 004120 1405 BLET, TEXT "LET" 004121 2400 1077 004122 1411 BLIN, TEXT "LINPUT" 004123 1620 004124 2524 004125 0000 1078 004126 1605 BNEW, TEXT "NEW" 004127 2700 1079 004130 1716 BON, TEXT "ON" 004131 0000 1080 004132 2201 BRND, TEXT "RANDOM" 004133 1604 004134 1715 004135 0000 1081 004136 1726 BOV, TEXT "OVERLAY" 004137 0522 004140 1401 004141 3100 1082 004142 2205 BREP, TEXT "REPLACE" 004143 2014 004144 0103 004145 0500 1083 004146 2516 BUNS, TEXT "UNSAVE" 004147 2301 004150 2605 004151 0000 1084 004152 2205 BREM, TEXT "REMARK" 004153 1501 004154 2213 004155 0000 1085 004156 2205 BRET, TEXT "RETURN" 004157 2425 004160 2216 004161 0000 1086 004162 2301 BSAV, TEXT "SAVE" 004163 2605 004164 0000 1087 004165 2324 BSTO, TEXT "STOP" 004166 1720 004167 0000 1088 004170 0314 BSTO2, TEXT "CLOSE #4\STOP" 004171 1723 004172 0540 004173 4364 004174 3423 004175 2417 004176 2000 1089 1090 /FORTRAN KEYWORDS 1091 004177 0003 FCMN, TEXT "@COMMON" 004200 1715 004201 1517 004202 1600 1092 004203 0001 FASN, TEXT "@ASSIGN" 004204 2323 004205 1107 004206 1600 1093 004207 0003 FCPX, TEXT "@COMPLEX" 004210 1715 004211 2014 004212 0530 004213 0000 1094 004214 0002 FBKS, TEXT "@BACKSPACE" 004215 0103 004216 1323 004217 2001 004220 0305 004221 0000 1095 004222 0003 FCNT, TEXT "@CONTINUE" 004223 1716 004224 2411 004225 1625 004226 0500 1096 004227 0002 FBKD, TEXT "@BLOCK DATA" 004230 1417 004231 0313 004232 4004 004233 0124 004234 0100 1097 004235 0004 FDTA, TEXT "@DATA" 004236 0124 004237 0100 1098 004240 0003 FCAL, TEXT "@CALL" 004241 0114 004242 1400 1099 004243 0004 FDEF, TEXT "@DEFINE FILE" 004244 0506 004245 1116 004246 0540 004247 0611 004250 1405 004251 0000 1100 004252 0004 FDO, TEXT "@DO" 004253 1700 1101 004254 0005 FEND, TEXT "@END" 004255 1604 004256 0000 1102 004257 0005 FEQU, TEXT "@EQUIVALENCE" 004260 2125 004261 1126 004262 0114 004263 0516 004264 0305 004265 0000 1103 004266 0006 FFOR, TEXT "@FORMAT" 004267 1722 004270 1501 004271 2400 1104 004272 0007 FGOT, TEXT "@GO TO" 004273 1740 004274 2417 004275 0000 1105 004276 0011 FINT, TEXT "@INTEGER" 004277 1624 004300 0507 004301 0522 004302 0000 1106 004303 0020 FPAU, TEXT "@PAUSE" 004304 0125 004305 2305 004306 0000 1107 004307 0022 FREAL, TEXT "@REAL" 004310 0501 004311 1400 1108 004312 0022 FREW, TEXT "@REWIND" 004313 0527 004314 1116 004315 0400 1109 004316 0023 FSBR, TEXT "@SUBROUTINE" 004317 2502 004320 2217 004321 2524 004322 1116 004323 0500 1110 004324 0300 FCMT, TEXT "C" /COMMENT 1111 004325 0004 FDIM, TEXT "@DIMENSION" 004326 1115 004327 0516 004330 2311 004331 1716 004332 0000 1112 004333 0004 FDBP, TEXT "@DOUBLE PRECISION" 004334 1725 004335 0214 004336 0540 004337 2022 004340 0503 004341 1123 004342 1117 004343 1600 1113 004344 0005 FEF, TEXT "@END FILE" 004345 1604 004346 4006 004347 1114 004350 0500 1114 004351 0005 FEXT, TEXT "@EXTERNAL" 004352 3024 004353 0522 004354 1601 004355 1400 1115 004356 0006 FFUN, TEXT "@FUNCTION" 004357 2516 004360 0324 004361 1117 004362 1600 1116 004363 0011 FIF, TEXT "@IF" 004364 0600 1117 004365 0014 FLOG, TEXT "@LOGICAL" 004366 1707 004367 1103 004370 0114 004371 0000 1118 004372 0022 FREAD, TEXT "@READ" 004373 0501 004374 0400 1119 004375 0022 FRET, TEXT "@RETURN" 004376 0524 004377 2522 004400 1600 1120 004401 0023 FSTO, TEXT "@STOP" 004402 2417 004403 2000 1121 004404 0027 FWRI, TEXT "@WRITE" 004405 2211 004406 2405 004407 0000 1122 BASKEY, 1123 /COLUMN 7 ROW 1124 004410 4005 BDEF /12 1125 004411 4114 BIFE /11 1126 004412 4120 BLET /0 1127 004413 4056 BLIS /1 1128 004414 4126 BNEW /2 1129 004415 4130 BON /3 1130 004416 4136 BOV /4 1131 004417 4132 BRND /5 1132 004420 4152 BREM /6 1133 004421 4101 BRES /7 1134 004422 4105 BRUN /8 1135 004423 4165 BSTKEY, BSTO /9 1136 /COLUMN 8 ROW 1137 004424 4014 BDIM /12 1138 004425 4046 BINKEY, BINP /11 1139 004426 4122 BLIN /0 1140 004427 4061 BNEX /1 1141 004430 4064 BOLD /2 1142 004431 4036 BFIL /3 1143 004432 4066 BPRKEY, BPRI /4 1144 004433 4076 BREA /5 1145 004434 4142 BREP /6 1146 004435 4156 BRET /7 1147 004436 4162 BSAV /8 1148 004437 4146 BUNS /9 1149 /COLUMNS 2-6 COLUMN ROW 1150 004440 3777 BCAL /2 12 1151 004441 4025 BENKEY, BEND /2 11 1152 004442 4002 BCLO /3 12 1153 004443 4107 BFOR /3 11 1154 004444 4011 BCHN /4 12 1155 004445 4041 BGOS /4 11 1156 004446 4021 BCHG /5 12 1157 004447 4111 BGOT /5 11 1158 004450 3774 BDAT /6 12 1159 004451 4044 BIF /6 11 1160 1161 1162 FORKEY, 1163 /COLUMN 7 /ROW 1164 004452 4240 FCAL /12 1165 004453 4243 FDEF /11 1166 004454 4252 FDO /0 1167 004455 4254 FEND /1 1168 004456 4257 FEQU /2 1169 004457 4266 FFOR /3 1170 004460 4272 FGOT /4 1171 004461 4276 FINT /5 1172 004462 4303 FPAU /6 1173 004463 4307 FREAL /7 1174 004464 4312 FREW /8 1175 004465 4316 FSBR /9 1176 /COLUMN 8 ROW 1177 004466 4324 FCMT /12 1178 004467 4325 FDIM /11 1179 004470 4333 FDBP /0 1180 004471 4344 FEF /1 1181 004472 4351 FEXT /2 1182 004473 4356 FFUN /3 1183 004474 4363 FIF /4 1184 004475 4365 FLOG /5 1185 004476 4372 FREAD /6 1186 004477 4375 FRET /7 1187 004500 4401 FSTO /8 1188 004501 4404 FWRI /9 1189 /COLUMN 2-6 COLUMN ROW 1190 004502 0000 0 /2 12 1191 004503 0000 0 /2 11 1192 004504 0000 0 /3 12 1193 004505 4177 FCMN /3 11 1194 004506 4203 FASN /4 12 1195 004507 4207 FCPX /4 11 1196 004510 4214 FBKS /5 12 1197 004511 4222 FCNT /5 11 1198 004512 4227 FBKD /6 12 1199 004513 4235 FDTA /6 11 1200 1201 1202 FIELD 1 1203 1204 1205 1206 1207 1208 *17 1209 1210 1211 010017 0000 OXR1, 0 1212 010020 0000 OTEMP1, 0 1213 010021 0000 CHAR, 0 1214 010022 0000 PUTPNT, 0 1215 010023 0000 GETPNT, 0 1216 010024 0000 DATFTN, 0 /ADDRESS OF FORTRAN $RUN 1217 010025 0234 GETCHR=JMS I .;XGETCH 1218 010026 0200 PUTCHR=JMS I .;XPUTCH 1219 010027 1223 BCLIN=JMS I .;XBCLIN 1220 010030 0400 OPTION=JMS I .;XOPTIO 1221 010031 1200 MOV6=JMS I .;XMOV6 1222 010032 1000 COLNAM=JMS I .;XCOLNA 1223 010033 1453 OUTNAM=JMS I .;XOUTNA 1224 010034 0664 ISIT=JMS I .;XISIT 1225 010035 1600 SEND=JMS I .;XSEND 1226 010036 0311 TSTCR=JMS I .;XTSTCR 1227 010037 1401 CDRTRA=JMS I .;BCLTRA+1 1228 010040 1673 ISNUM=JMS I .;XISNUM 1229 010041 0276 OUT1=JMS I .;OOUT1 1230 *200 1231 1232 1233 /PUT A CHARACTER INTO A 6-BIT BUFFER 1234 PUTCH1=XGETCH 1235 PUTCH4=CON628 1236 010200 0000 XPUTCH, 0 1237 010201 1377 TAD (-215 /IF , IT BECOMES 37 1238 010202 7440 SZA 1239 010203 1376 TAD (215-337 1240 010204 1375 TAD (337 1241 010205 0374 AND (77 /AND OFF 6 BITS 1242 010206 3234 DCA PUTCH1 /SAVE IT IN A TEMP 1243 010207 1022 TAD PUTPNT /GET POINTER TO CHARACTER IN 6-BIT BUFFER 1244 010210 2022 ISZ PUTPNT /AND BUMP POINTER 1245 010211 7110 CLL RAR /GET WORD DISPLACEMENT 1246 010212 1600 TAD I XPUTCH /ADD IN BASE ADDRESS 1247 010213 2200 ISZ XPUTCH /BUMP RETURN ADDRESS 1248 010214 3242 DCA PUTCH4 /SAVE ADDRESS OF WORD CONTAINING CHAR 1249 010215 7430 SZL /LINK HAS FIRST OR LAST HALF INDICATOR 1250 010216 5227 JMP PUTCH2 1251 010217 1234 TAD PUTCH1 /FIRST HALF - ROTATE CHAR INTO HIGH BITS 1252 010220 7106 CLL RTL;RTL;RTL 010221 7006 010222 7006 1253 010223 3234 DCA PUTCH1 1254 010224 1642 TAD I PUTCH4 /GET ANY CHARACTER ALREADY THERE 1255 010225 0374 AND (77 1256 010226 5231 JMP PUTCH3 1257 010227 1642 PUTCH2, TAD I PUTCH4 1258 010230 0373 AND (7700 /GET CHARACTER ALREADY THERE 1259 010231 1234 PUTCH3, TAD PUTCH1 /ADD IN NEW CHARACTER 1260 010232 3642 DCA I PUTCH4 /STORE THEM BOTH 1261 010233 5600 JMP I XPUTCH /AND RETURN 1262 1263 1264 /GET A CHARACTER FROM A 6-BIT BUFFER 1265 010234 0000 XGETCH, 0 1266 010235 1234 TAD XGETCH /MOVE RETURN ADDRESS TO CON628 1267 010236 3242 DCA CON628 1268 010237 1023 TAD GETPNT /GET POINTER TO CHARACTER 1269 010240 2023 ISZ GETPNT /BUMP IT FOR NEXT TIME 1270 010241 5243 JMP CON628+1 /ENTER CONVERSION ROUTINE 1271 1272 1273 /CONVERT 6-BIT ASCII TO 8-BIT 1274 /AC HAS POINTER TO CHARACTER 1275 /ARGUMENT IS BASE ADDRESS OF BUFFER 1276 CO628X=XGETCH 1277 010242 0000 CON628, 0 1278 010243 7110 CLL RAR /GET WORD DISPLACEMENT IN AC 1279 010244 1642 TAD I CON628 /ADD BASE ADDRESS OF BUFFER 1280 010245 2242 ISZ CON628 /BUMP RETURN ADDRESS 1281 010246 3234 DCA CO628X /SAVE ADDRESS 1282 010247 1634 TAD I CO628X /GET WORD CONTAINING CHARACTER 1283 010250 7430 SZL /LINK HAS INDICATOR FOR FIRST OR LAST CHAR 1284 010251 5255 JMP .+4 1285 010252 7012 RTR;RTR;RTR /FIRST CHAR - PUT IN LOW BITS 010253 7012 010254 7012 1286 010255 0374 AND (77 1287 010256 4262 JMS XSEND3 /GET PROPER 8-BIT REPRESENTATION 1288 010257 3021 DCA CHAR /SAVE IT 1289 010260 1021 TAD CHAR /RETURN WITH IT IN AC 1290 010261 5642 JMP I CON628 /RETURN 1291 1292 1293 010262 0000 XSEND3, 0 1294 010263 1372 TAD (-37 1295 010264 7450 SNA 1296 010265 1376 TAD (215-337 1297 010266 7510 SPA 1298 010267 1371 TAD (100 1299 010270 1370 TAD (237 1300 010271 5662 JMP I XSEND3 1301 1302 1303 010272 0000 GETCDR, 0 1304 010273 6203 CIF CDF F0 1305 010274 4767 JMS I (GETCD1 /GET A CHAR FROM THE CDR BUFFER 1306 010275 5672 JMP I GETCDR 1307 1308 1309 010276 0000 OOUT1, 0 1310 010277 6203 CIF CDF F0 1311 010300 4766 JMS I (OOUT2 1312 010301 5676 JMP I OOUT1 1313 1314 1315 010302 0000 MOVODV, 0 1316 010303 3305 DCA .+2 1317 010304 4431 MOV6;0;BATOUT 010305 0000 010306 5043 1318 010307 6202 CIF F0 /RETURN DF=1 1319 010310 5702 JMP I MOVODV 1320 1321 1322 010311 0000 XTSTCR, 0 1323 010312 4425 GETCHR;BCLBUF 010313 3600 1324 010314 1377 TAD (-215 1325 010315 7650 SNA CLA 1326 010316 2311 ISZ XTSTCR 1327 010317 7340 L7777 1328 010320 1023 TAD GETPNT 1329 010321 3023 DCA GETPNT 1330 010322 5711 JMP I XTSTCR 1331 1332 1333 010366 0653 PAGE 010367 0657 010370 0237 010371 0100 010372 7741 010373 7700 010374 0077 010375 0337 010376 7656 010377 7563 1334 /SUBROUTINE OPTION WILL SCAN THE BATCH CONTROL LANGUAGE 1335 /BUFFER FOR OPTIONS SPECIFIED IN IT'S CALL. AN OPTION IS 1336 /RECOGNIZED AS ANY ITEM WHICH FOLLOWS A "/". IT'S NAME 1337 /IS COMPOSED OF ANY CHARACTERS OTHER THAN "/" , "," , 1338 /"=",OR . THE NAME IS TERMINATED BY ANY ONE OF THE 1339 /PREVIOUS DELIMITERS. IF IT IS TERMINATED BY A "=" AND 1340 /THE SUBROUTINE CALL INDICATES THAT IT EXPECTS A FILE NAME, 1341 /THEN THE FILE NAME FOLLOWS THE "=" AND IS TERMINATED BY A 1342 /"/" , "," , OR . THE SUBROUTINE CALL IS FOLLOWED BY A 1343 /POINTER TO A LIST OF ADDRESSES. THIS LIST IS TERMINATED BY 1344 /A ZERO ENTRY. EACH ENTRY POINTS TO AN OPTION CONTROL 1345 /BLOCK IN THE FOLLOWING FORM: 1346 / OPTION CONTROL WORD 1347 / (FILE NAME SPACE IF NEEDED - 6 WORDS) 1348 / TEXT "OPTION NAME" 1349 / 1350 /THE FORMAT OF THE OPTION CONTROL WORD IS AS FOLLOWS: 1351 / BIT 0: ON RETURN THIS BIT WILL BE SET IF 1352 / THE OPTION WAS FOUND, AND CLEARED 1353 / IF NOT 1354 / BIT1: ON RETURN THIS BIT IS SET IF A NAME 1355 / WAS GIVEN WITH THE OPTION 1356 / BIT 2: SET IF OPTION HAS ALLOCATED 6 WORDS 1357 / FOR A POSSIBLE FILE NAME. CLEARED 1358 / IF NOT 1359 / BITS 6-8: NUMBER OF CHARACTERS -1 OF SHORT 1360 / FORM OF OPTION 1361 / BITS 9-11: DIFFERENCE BETWEEN SIZES OF 1362 / SHORT AND LONG FORMS 1363 / THE SUM OF BITS 6-8 AND BITS 9-11 1364 / SHOULD TOTAL THE LENGTH OF THE 1365 / LONG FORM-1 1366 / 1367 /THE FILE NAME SPACE MAY BE INITIALIZED TO SOME DEFAULT 1368 /DEVICE, NAME, AND EXTENSION. 1369 / 1370 010400 0000 XOPTIO, 0 1371 1372 /TURN OFF ALL OPTIONS 1373 010401 1600 TAD I XOPTIO /GET ADDRESS OF LIST OF OPTION ADDRESSES 1374 010402 3316 DCA OPTLIS /SAVE IT 1375 010403 1716 OPTIO1, TAD I OPTLIS /GET OPTION ADDRESS 1376 010404 2316 ISZ OPTLIS /POINT TO NEXT ONE 1377 010405 7450 SNA 1378 010406 5214 JMP OPTIO2 /DONE TURNING OFF ALL OPTIONS 1379 010407 3317 DCA OPTCTL 1380 010410 1717 TAD I OPTCTL /GET OPTION CONTROL WORD 1381 010411 0377 AND (1777 /CLEAR FIRST BIT 1382 010412 3717 DCA I OPTCTL 1383 010413 5203 JMP OPTIO1 /LOOP 1384 1385 /SEARCH BCL BUFFER FOR "/" 1386 010414 3023 OPTIO2, DCA GETPNT /START AT BEGINNING OF BATCH CONTROL LINE 1387 010415 4425 OPTIO3, GETCHR;BCLBUF /GET A CHARACTER FROM THE BUFFER 010416 3600 1388 010417 4434 ISIT /IS IT "/" OR ? 1389 010420 5270 OPTIS3;OPTIS4-1 010421 5263 1390 010422 5215 JMP OPTIO3 /NO - KEEP LOOKING 1391 010423 1023 OPTI3A, TAD GETPNT /YES - SAVE IT'S POSITION 1392 010424 3320 DCA OPTBEG 1393 010425 1600 TAD I XOPTIO /GET ADDRESS OF LIST AGAIN 1394 010426 3316 DCA OPTLIS /AND SAVE IT 1395 1396 /FOUND A "/" - TRY ALL OPTIONS 1397 010427 1320 OPTIO4, TAD OPTBEG /START COMPARISON OF OPTION WITH CHARACTER AFTER "/" 1398 010430 3023 DCA GETPNT 1399 010431 1716 TAD I OPTLIS /GET ADDRESS OF OPTION CONTROL WORD 1400 010432 2316 ISZ OPTLIS /AND BUMP POINTER FOR NEXT TIME 1401 010433 7450 SNA /IS THE LIST ENDED? 1402 010434 5776 JMP I (OPTIER /YES - OPTION WAS INVALID 1403 010435 3317 DCA OPTCTL /NO - SAVE ADDRESS OF CONTROL WORD 1404 010436 1717 TAD I OPTCTL /GET CONTROL WORD 1405 010437 7006 RTL 1406 010440 7710 SPA CLA /DOES IT HAVE SPACE FOR A FILE NAME 1407 010441 1375 TAD (6 /YES - ADD SIZE OF THE SPACE 1408 010442 1317 TAD OPTCTL /ADD ADDRESS OF OPTION 1409 010443 7001 IAC /BUMP ONE FOR CONTROL WORD 1410 010444 3304 DCA OPTTEX /SAVE ADDRESS OF OPTION TEXT 1411 010445 1717 TAD I OPTCTL /GET LENGTH FOR UNIQUE OPTION FROM CONTROL WORD 1412 010446 7010 RAR;RTR 010447 7012 1413 010450 0374 AND (7 1414 010451 7040 CMA /NEGATE IT (INCREMENTED BY ONE) 1415 010452 3321 DCA OPTCT1 /SAVE IN COUNTER 1416 010453 3322 DCA OPTCT2 /ZERO CHARACTER POSITION 1417 /COMPARE OPTION WITH CONTENTS OF BCL BUFFER 1418 010454 4300 OPTIO5, JMS OPTI6A 1419 010455 7640 SZA CLA /ARE THEY THE SAME? 1420 010456 5227 JMP OPTIO4 /NO - TRY NEXT OPTION 1421 010457 2321 ISZ OPTCT1 /HAVE WE SUCCEEDED FAR ENOUGH FOR IT TO BE UNIQUE? 1422 010460 5254 JMP OPTIO5 /NO - KEEP COMPARING 1423 1424 010461 1023 TAD GETPNT /SAVE CURRENT BUFFER POSITION 1425 010462 3324 DCA OPTTM2 1426 010463 1717 TAD I OPTCTL /GET REMAINING LENGTH FROM CONTROL WORD 1427 010464 0374 AND (7 1428 010465 7040 CMA 1429 010466 3321 DCA OPTCT1 1430 010467 2321 OPTIO6, ISZ OPTCT1 /DONE WITH REMAINING CHARACTERS? 1431 010470 7410 SKP 1432 010471 5325 JMP OPTIO7 /YES - SUCCESS 1433 010472 4300 JMS OPTI6A 1434 010473 7650 SNA CLA /ARE THEY THE SAME? 1435 010474 5267 JMP OPTIO6 /YES - KEEP GOING 1436 010475 1324 TAD OPTTM2 /NO - MOVE POINTER BACK TO SHORT FORM 1437 010476 3023 DCA GETPNT 1438 010477 5325 JMP OPTIO7 1439 1440 010500 0000 OPTI6A, 0 1441 010501 1322 TAD OPTCT2 1442 010502 2322 ISZ OPTCT2 1443 010503 4773 JMS I (CON628 1444 010504 0000 OPTTEX, 0 1445 010505 7041 CIA 1446 010506 3323 DCA OPTTM1 1447 010507 4425 GETCHR;BCLBUF 010510 3600 1448 010511 1323 TAD OPTTM1 1449 010512 5700 JMP I OPTI6A 1450 1451 1452 010513 2200 OPTRET, ISZ XOPTIO /INCREMENT RETURN ADDRESS 1453 010514 3023 DCA GETPNT /SET POINTER TO BEGINNING OF BUFFER 1454 010515 5600 JMP I XOPTIO 1455 1456 1457 010516 0000 OPTLIS, 0 1458 010517 0000 OPTCTL, 0 1459 010520 0000 OPTBEG, 0 1460 010521 0000 OPTCT1, 0 1461 010522 0000 OPTCT2, 0 1462 010523 0000 OPTTM1, 0 1463 010524 0000 OPTTM2, 0 1464 1465 1466 /TEST DELIMITER AFTER OPTION 1467 010525 4425 OPTIO7, GETCHR;BCLBUF /GET NEXT BUFFER CHARACTER 010526 3600 1468 010527 4434 ISIT /IS IT "=", "," ,"/", OR ? 1469 010530 5266 OPTIS1;OPTIS2-1 010531 5257 1470 010532 5776 JMP I (OPTIER /NONE OF THESE 1471 010533 1717 OPTIO8, TAD I OPTCTL /YES - GET CONTROL WORD 1472 010534 7006 RTL 1473 010535 7700 SMA CLA /DOES IT TAKE A FILE NAME? 1474 010536 5776 JMP I (OPTIER /NO - ERROR 1475 010537 1317 TAD OPTCTL /GET ADDRESS OF FILE NAME SPACE 1476 010540 7001 IAC 1477 010541 3343 DCA .+2 1478 010542 4432 COLNAM /AND COLLECT A NAME INTO IT 1479 010543 0000 OPTTM3, 0 1480 010544 5776 JMP I (OPTIER /ERROR RETURN 1481 010545 1717 TAD I OPTCTL /TURN ON NAME BIT 1482 010546 0377 AND (1777 1483 010547 1372 TAD (2000 1484 010550 3717 DCA I OPTCTL 1485 010551 1717 OPTIO9, TAD I OPTCTL /GET CONTROL WORD 1486 010552 0371 AND (3777 1487 010553 1370 TAD (4000 /TURN ON OPTION FOUND BIT 1488 010554 3717 DCA I OPTCTL 1489 010555 5767 JMP I (OPTI10 1490 1491 1492 010567 0603 PAGE 010570 4000 010571 3777 010572 2000 010573 0242 010574 0007 010575 0006 010576 0600 010577 1777 1493 /ON ERROR, REPORT IT 1494 010600 1777 OPTIER, TAD I (OPTBEG /OPTION BEGINS AT THIS POSITION 1495 010601 4244 JMS OUTERR /OUTPUT THE ERROR 1496 010602 5340 OPTERM 1497 1498 /SQUISH THE CURRENT OPTION OUT OF BCL BUFFER 1499 010603 7340 OPTI10, L7777 /BACK UP OVER "/" 1500 010604 1777 TAD I (OPTBEG /POINT TO BEGINNING OF OPTION 1501 010605 4211 JMS BCLSQU /SQUISH OUT THIS OPTION 1502 010606 7340 L7777 1503 010607 1777 TAD I (OPTBEG 1504 010610 5776 JMP I (OPTIO2 /GO LOOK FOR MORE OPTIONS 1505 1506 1507 /SQUISH OUT A PORTION OF THE BCL BUFFER 1508 / TAD X /POSITION OF FIRST CHAR OF SQUISH 1509 / JMS BCLSQU 1510 /GETPNT POINTS TO FIRST CHAR SURE TO BE KEPT AFTER 1511 /SQUISH CHARS. ONE CHAR PRECEDING IT IS TESTED, 1512 /AND IS KEPT IF IT IS A "/" OR 1513 010611 0000 BCLSQU, 0 1514 010612 3022 DCA PUTPNT /AC POINTS TO BEGINNING OF AREA TO BE SQUISHED 1515 010613 1022 TAD PUTPNT /SAVE THE POINTER 1516 010614 3244 DCA OUTERR 1517 010615 7340 L7777 1518 010616 1023 TAD GETPNT 1519 010617 3023 DCA GETPNT /TEST LAST CHAR OF STUFF TO BE SQUISHED 1520 010620 4425 GETCHR;BCLBUF 010621 3600 1521 010622 4434 ISIT /IS IT "/", OR ? 1522 010623 5270 BCLIS1;BCLIS2-1 010624 5305 1523 010625 4425 BCLSQ1, GETCHR;BCLBUF /GET A CHAR 010626 3600 1524 010627 1375 TAD (-215 /IS IT ? 1525 010630 7650 SNA CLA 1526 010631 5236 JMP BCLSQ3 /YES - DONE 1527 010632 1021 BCLSQ2, TAD CHAR /RESTORE CHAR 1528 010633 4426 PUTCHR;BCLBUF /PUT THE CHAR IN THE BUFFER 010634 3600 1529 010635 5225 JMP BCLSQ1 /GET ANOTHER CHAR 1530 010636 1374 BCLSQ3, TAD (215 /PUT A 1531 010637 4426 PUTCHR;BCLBUF 010640 3600 1532 010641 1244 TAD OUTERR /RESTORE POINTER 1533 010642 3023 DCA GETPNT 1534 010643 5611 JMP I BCLSQU /RETURN 1535 1536 1537 /SEND AN ERROR MESSAGE INCLUDING PART OF THE BCL BUFFER 1538 /TO THE OUTPUT BUFFER 1539 / TAD X /POSITION OF FIRST CHAR IN BUFFER TO BE SENT 1540 / JMS OUTERR 1541 / A /ADDRESS OF ERROR MESSAGE TO PRECEDE IT 1542 / /SIX-BIT ASCII 1543 010644 0000 OUTERR, 0 1544 010645 3023 DCA GETPNT /SET BEGINNING OF BCL LINE TO OUTPUT 1545 010646 1644 TAD I OUTERR /GET ERROR MESSAGE ADDRESS 1546 010647 2244 ISZ OUTERR 1547 010650 4435 SEND /PRINT IT 1548 010651 4425 OUTER1, GETCHR;BCLBUF /GET A CHARACTER 010652 3600 1549 010653 4434 ISIT /IS IT "," ,"/", OR ? 1550 010654 5267 OUTIS1;OUTIS2-1 010655 5307 1551 010656 1021 TAD CHAR /NO - SEND CHAR 1552 010657 4441 OUT1 1553 010660 5251 JMP OUTER1 1554 010661 1374 OUTER2, TAD (215 1555 010662 4441 OUT1 1556 010663 5644 JMP I OUTERR /RETURN 1557 1558 1559 /TEST A CHAR AND JUMP IF IN LIST 1560 / JMS XISIT 1561 / A1 /ADDRESS OF LIST OF NEGATIVE OF CHARS 1562 / /TERMINATED BY A POSITIVE OR ZERO 1563 / A2-1 /ADDRESS -1 OF LIST OF 1564 / /TRANSFER ADDRESSES 1565 010664 0000 XISIT, 0 1566 010665 3310 DCA ISIT1 /SAVE CHAR 1567 010666 1664 TAD I XISIT /GET LIST OF CHARS 1568 010667 2264 ISZ XISIT 1569 010670 3311 DCA ISIT2 1570 010671 1664 TAD I XISIT /GET LIST OF ADDRS - 1 1571 010672 2264 ISZ XISIT 1572 010673 3312 DCA ISIT3 1573 010674 1711 ISIT4, TAD I ISIT2 /GET THE NEXT CHAR 1574 010675 2311 ISZ ISIT2 1575 010676 2312 ISZ ISIT3 1576 010677 7500 SMA 1577 010700 5306 JMP ISIT5 /END OF LIST SIGNALLED BY ENTRY>=0 1578 010701 1310 TAD ISIT1 /IS IT THE CHAR? 1579 010702 7640 SZA CLA 1580 010703 5274 JMP ISIT4 /NO - TRY THE NEXT 1581 010704 1712 TAD I ISIT3 /GET SEND ADDRESS 1582 010705 3264 DCA XISIT 1583 010706 7200 ISIT5, CLA 1584 010707 5664 JMP I XISIT 1585 1586 010710 0000 ISIT1, 0 1587 010711 0000 ISIT2, 0 1588 010712 0000 ISIT3, 0 1589 1590 1591 010774 0215 PAGE 010775 7563 010776 0414 010777 0520 1592 /COLLECT A NAME FROM THE BUFFER 1593 / JMS XCOLNA 1594 / X /ADDRESS OF SPACE TO RECEIVE NAME 1595 / JMP ERR /INVALID NAME 1596 011000 0000 XCOLNA, 0 1597 011001 1600 TAD I XCOLNA 1598 011002 3205 DCA .+3 1599 011003 4431 MOV6;ZER6;0 011004 5051 011005 0000 1600 011006 1600 TAD I XCOLNA /ARGUMENT IS ADDRESS TO PUT NAME 1601 011007 2200 ISZ XCOLNA 1602 011010 3342 DCA COLPU1+2 /SAVE IT FOR USE AS PUTCHR ARG 1603 011011 7344 L7776 /SET NAME - EXTENSION SWITCH FOR NAME 1604 011012 3344 DCA COLSW 1605 011013 1377 TAD (COLIS1 /SET TO COLLECT ANYTHING 1606 011014 3226 DCA COLIS3 /I.E. DEVICE, FILE, OR EXTENSION 1607 011015 1376 TAD (COLIS2-1 1608 011016 3227 DCA COLIS3+1 1609 011017 1023 TAD GETPNT /SAVE POINTER TO BEGINNING OF NAME 1610 011020 3345 DCA COLNP1 1611 011021 1023 COLGE1, TAD GETPNT /SAVE POINTER TO BEGINNING OF SECTION 1612 011022 3346 DCA COLNP2 /OF NAME 1613 011023 4425 COLGE2, GETCHR;BCLBUF /GET A CHAR 011024 3600 1614 011025 4434 ISIT /IS IT ":",".","/", "," , OR ? 1615 011026 0000 COLIS3, 0;0 011027 0000 1616 011030 5223 JMP COLGE2 1617 1618 011031 4272 COLDEV, JMS COLMOV;0;-4-1 /MOVE 4 CHARS TO POSITION 0 011032 0000 011033 7773 1619 011034 2226 ISZ COLIS3 /REMOVE ":" FROM LIST 1620 011035 2227 ISZ COLIS3+1 1621 011036 5221 JMP COLGE1 /COLLECT NEXT PART OF NAME 1622 1623 011037 4272 COLFIL, JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4 011040 0004 011041 7771 1624 011042 2344 ISZ COLSW /NEXT TIME COLLECT EXTENSION 1625 011043 1375 TAD (COLIS1+2 /REMOVE "." FROM LIST 1626 011044 3226 DCA COLIS3 1627 011045 1374 TAD (COLIS2+1 1628 011046 3227 DCA COLIS3+1 1629 011047 5221 JMP COLGE1 /COLLECT NEXT PART OF NAME 1630 1631 011050 2344 COLEXT, ISZ COLSW /ARE WE COLLECTING NAME OR EXTENSION? 1632 011051 5256 JMP COLEX1 /NAME 1633 011052 4272 JMS COLMOV;12;-2-1 /MOVE 2 CHARS TO POSITION 12 011053 0012 011054 7775 1634 011055 5261 JMP COLEX2 1635 011056 4272 COLEX1, JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4 011057 0004 011060 7771 1636 011061 2200 COLEX2, ISZ XCOLNA /NO ERRORS 1637 011062 5267 JMP COLEX3 1638 1639 011063 7200 COLERR, CLA 1640 011064 1345 TAD COLNP1 /POINT TO BEGINNING OF NAME 1641 011065 4773 JMS I (OUTERR /SEND IT AS ERROR MESSAGE 1642 011066 5352 COLERM 1643 011067 1345 COLEX3, TAD COLNP1 /POINT TO BEGINNING OF NAME 1644 011070 4772 JMS I (BCLSQU /SQUISH IT OUT 1645 011071 5600 JMP I XCOLNA /RETURN 1646 1647 011072 0000 COLMOV, 0 1648 011073 1672 TAD I COLMOV /FIRST ARG IS POSITION 1649 011074 2272 ISZ COLMOV 1650 011075 3022 DCA PUTPNT 1651 011076 1672 TAD I COLMOV /SECOND ARG IS COUNT 1652 011077 2272 ISZ COLMOV 1653 011100 3351 DCA COLCT1 1654 011101 1021 TAD CHAR /GET DELIMITER 1655 011102 7041 CIA 1656 011103 3347 DCA COLCH1 /SAVE FOR TEST 1657 011104 1021 TAD CHAR 1658 011105 1371 TAD (-"Z 1659 011106 3350 DCA COLCH2 /ANOTHER TEST 1660 011107 1346 TAD COLNP2 /POINT TO BEGINNING OF THIS PART 1661 011110 3023 DCA GETPNT 1662 011111 4425 COLMV1, GETCHR;BCLBUF /GET NEXT CHAR 011112 3600 1663 011113 1347 TAD COLCH1 /SUBTRACT THE DELIMITER 1664 011114 7450 SNA 1665 011115 5672 JMP I COLMOV /DELIMITER - WE'RE DONE 1666 011116 1350 TAD COLCH2 /CHAR-"Z" 1667 011117 7540 SMA SZA 1668 011120 5263 JMP COLERR /NOT ALPHA-NUMERIC 1669 011121 1370 TAD ("Z-"A 1670 011122 7500 SMA 1671 011123 5332 JMP COLPUT /ALPHABETIC 1672 011124 1367 TAD ("A-"9 1673 011125 7540 SMA SZA 1674 011126 5263 JMP COLERR /NOT NUMERIC 1675 011127 1366 TAD ("9-"0 1676 011130 7510 SPA 1677 011131 5263 JMP COLERR /NOT NUMERIC 1678 011132 7200 COLPUT, CLA 1679 011133 2351 ISZ COLCT1 /HAVE WE USED UP OUR COUNT? 1680 011134 5340 JMP COLPU1 /NO - PUT THE CHAR 1681 011135 7340 L7777 /YES - SET COUNTER TO SKIP 1682 011136 3351 DCA COLCT1 1683 011137 5311 JMP COLMV1 /GET NEXT CHAR 1684 011140 1021 COLPU1, TAD CHAR 1685 011141 4426 PUTCHR;0 /PUT THE CHAR IN THE USER SPACE 011142 0000 1686 011143 5311 JMP COLMV1 /GET THE NEXT CHAR 1687 1688 1689 011144 0000 COLSW, 0 /FILE NAME OR EXTENSION SWITCH 1690 011145 0000 COLNP1, 0 /POINTER TO BEGINNING OF NAME 1691 011146 0000 COLNP2, 0 /POINTER TO BEGINNING OF NAME PART 1692 011147 0000 COLCH1, 0 /TEMP LOC FOR COLMOV 1693 011150 0000 COLCH2, 0 /DITTO 1694 011151 0000 COLCT1, 0 /DITTO 1695 1696 011166 0011 PAGE 011167 0010 011170 0031 011171 7446 011172 0611 011173 0644 011174 5274 011175 5302 011176 5272 011177 5300 1697 011200 0000 XMOV6, 0 1698 011201 1600 TAD I XMOV6 /GET "FROM" ADDRESS 1699 011202 2200 ISZ XMOV6 1700 011203 3220 DCA MOV61 1701 011204 1600 TAD I XMOV6 /GET "TO" ADDRESS 1702 011205 2200 ISZ XMOV6 1703 011206 3221 DCA MOV62 1704 011207 1377 TAD (-6 1705 011210 3222 DCA MOV63 1706 011211 1620 MOV64, TAD I MOV61 1707 011212 3621 DCA I MOV62 1708 011213 2220 ISZ MOV61 1709 011214 2221 ISZ MOV62 1710 011215 2222 ISZ MOV63 1711 011216 5211 JMP MOV64 1712 011217 5600 JMP I XMOV6 /RETURN 1713 011220 0000 MOV61, 0 1714 011221 0000 MOV62, 0 1715 011222 0000 MOV63, 0 1716 1717 1718 011223 0000 XBCLIN, 0 1719 011224 3022 DCA PUTPNT /START AT BEGINNING OF BCL BUFFER 1720 011225 4776 JMS I (SENDKY /SEND THE KEYWORD 1721 011226 3220 DCA MOV61 /CLEAR THE BLANK COUNTER 1722 011227 4257 BCLIN5, JMS BCLIN3 /GET NEXT CARD AND PUT IT INTO BCL BUFFER 1723 011230 5246 JMP BCLIN7+2 /CARD NOT CONTINUED - DONE 1724 011231 6202 CIF F0 1725 011232 4775 JMS I (CDRIN /READ ANOTHER CARD 1726 011233 5246 JMP BCLIN7+2 /EOF 1727 011234 1374 TAD (-10 1728 011235 3256 DCA BCLIN4 1729 011236 4773 BCLIN6, JMS I (GETCDR /GET FIRST 8 CHARS 1730 011237 7640 SZA CLA /TEST FOR ZERO 1731 011240 5244 JMP BCLIN7 /NON-ZERO - ERROR 1732 011241 2256 ISZ BCLIN4 1733 011242 5236 JMP BCLIN6 1734 011243 5227 JMP BCLIN5 /OK - PUT IT IN BUFFER 1735 1736 011244 6201 BCLIN7, CDF F0 1737 011245 3772 DCA I (CDRFLG /SET CDRIN TO RETURN THIS CARD AGAIN 1738 011246 6211 CDF F1 1739 011247 1371 TAD (215 /PUT A 1740 011250 4426 PUTCHR;BCLBUF 011251 3600 1741 011252 1371 TAD (215;OUT1 011253 4441 1742 011254 3023 DCA GETPNT /SET POINTER TO BEGINNING 1743 011255 5623 JMP I XBCLIN /RETURN 1744 1745 011256 0000 BCLIN4, 0 1746 011257 0000 BCLIN3, 0 1747 011260 1370 TAD (-40 1748 011261 3256 DCA BCLIN4 1749 011262 4773 BCLIN9, JMS I (GETCDR /GET NEXT CDR CHAR 1750 011263 7450 SNA 1751 011264 5341 JMP BCLI13 /BLANK 1752 011265 1367 TAD (-CONTCH 1753 011266 7450 SNA 1754 011267 5312 JMP BCLI10 /CONTINUATION 1755 011270 1366 TAD (CONTCH 1756 011271 6202 CIF F0 1757 011272 4765 JMS I (XCONVR 1758 011273 5307 JMP BCLIN8 /RUBOUT 1759 011274 3200 DCA XMOV6 /SAVE THE CHAR 1760 011275 4343 JMS BCLI14 /SEND THE BLANKS 1761 011276 1200 TAD XMOV6 1762 011277 4441 OUT1 /SEND IT 1763 011300 1200 TAD XMOV6 1764 011301 4426 PUTCHR;BCLBUF /PUT IT 011302 3600 1765 011303 1022 TAD PUTPNT 1766 011304 1364 TAD (-BCLSIZ^2+2 /BCL BUFFER FULL? 1767 011305 7700 SMA CLA 1768 011306 5321 JMP BCLI11 /FULL - ERROR 1769 011307 2256 BCLIN8, ISZ BCLIN4 /COUNT COLUMNS 1770 011310 5262 JMP BCLIN9 /LOOP 1771 011311 5657 JMP I BCLIN3 1772 011312 2257 BCLI10, ISZ BCLIN3 /SKIP RETURN FOR CONTINUATION 1773 011313 3220 DCA MOV61 /CLEAR THE BLANK COUNTER 1774 011314 4435 SEND;BCL10E /"_$" 011315 5407 1775 011316 1363 TAD (211;OUT1 / 011317 4441 1776 011320 5657 JMP I BCLIN3 /RETURN 1777 1778 011321 4435 BCLI11, SEND;BCL11E /SEND ERROR 011322 5372 1779 011323 6202 BCLI12, CIF F0 1780 011324 4775 JMS I (CDRIN /GET THE NEXT CARD 1781 011325 5246 JMP BCLIN7+2 1782 011326 4773 JMS I (GETCDR /GET THE NEXT COLUMN 1783 011327 3256 DCA BCLIN4 /SAVE THIS COLUMN 1784 011330 1362 TAD (JOBBIT /IS THIS A $JOB CARD? 1785 011331 0256 AND BCLIN4 1786 011332 7650 SNA CLA 1787 011333 5323 JMP BCLI12 /NO - FLUSH TO $JOB 1788 011334 1361 TAD (-JOBBIT-1 1789 011335 0256 AND BCLIN4 1790 011336 7640 SZA CLA 1791 011337 5323 JMP BCLI12 1792 011340 5244 JMP BCLIN7 /YES - DONE 1793 1794 011341 2220 BCLI13, ISZ MOV61 /ANOTHER BLANK 1795 011342 5307 JMP BCLIN8 1796 1797 011343 0000 BCLI14, 0 1798 011344 1220 TAD MOV61 1799 011345 7040 CMA 1800 011346 3220 DCA MOV61 1801 011347 2220 BCLI15, ISZ MOV61;SKP 011350 7410 1802 011351 5743 JMP I BCLI14 1803 011352 1360 TAD (" ;OUT1 011353 4441 1804 011354 5347 JMP BCLI15 1805 1806 1807 1808 1809 011360 0240 PAGE 011361 7577 011362 0200 011363 0211 011364 7002 011365 1652 011366 0003 011367 7775 011370 7740 011371 0215 011372 0054 011373 0272 011374 7770 011375 1005 011376 3333 011377 7772 1810 011400 5601 BCLTRA, JMP I .+1 /GO FINISH UP LAST BCL COMMAND 1811 011401 1413 BCLHUH /HUH? - I.E. WHICH COMMAND WAS IT? 1812 011402 6203 CIF CDF F0 1813 011403 5777 JMP I (TEXFIN /TO COPY A DECK UNTIL THE NEXT BCL 1814 /COMMAND - JMS BCLTRA+1 1815 1816 011404 0000 BCLHU1, 0 /JMS HERE WITH ARG = TRANSFER ADDRESS 1817 011405 1604 TAD I BCLHU1 /GET TRANSFER ADDRESS 1818 011406 3204 DCA BCLHU1 1819 011407 1376 TAD (BCLHUH /ON NEXT BCL CARD - NOTHING TO FINISH 1820 011410 3201 DCA BCLTRA+1 1821 011411 6203 CIF CDF F0 /FIELD 0! 1822 011412 5604 JMP I BCLHU1 /GO GO GO 1823 1824 1825 011413 6201 BCLHUH, CDF F0 1826 011414 1775 TAD I (KEYVAL /GET KEYWORD VALUE 1827 011415 6211 CDF F1 1828 011416 1374 TAD (BCLGO /USE IT TO GET TRANSFER ADDRESS 1829 011417 3020 DCA OTEMP1 1830 011420 1420 TAD I OTEMP1 1831 011421 3020 DCA OTEMP1 1832 011422 6201 CDF F0 1833 011423 1773 TAD I (CONFLG /WAS LAST CARD CONTINUED? 1834 011424 6211 CDF F1 1835 011425 7640 SZA CLA 1836 011426 4240 JMS BCLHU2 /YES - ERROR 1837 011427 6201 CDF F0 1838 011430 1772 TAD I (LNCNT /DID THIS CARD HAVE A LINE NUMBER? 1839 011431 6211 CDF F1 1840 011432 7650 SNA CLA 1841 011433 5420 JMP I OTEMP1 /YES - GO TO IT! 1842 011434 6203 CIF CDF F0 1843 011435 4771 JMS I (LNOUT /OUTPUT THE LINE NUMBER 1844 011436 4240 JMS BCLHU2 /WHAT'S IT DOING WITH A NUMBER ANYWAY? 1845 011437 5420 JMP I OTEMP1 /NOW WE GO. 1846 1847 011440 0000 BCLHU2, 0 1848 011441 6201 CDF F0 1849 011442 2770 ISZ I (ERRFLG 1850 011443 6211 CDF F1 1851 011444 4435 SEND;BCLHM1 /"?_" 011445 5405 1852 011446 5640 JMP I BCLHU2 1853 1854 1855 011447 4204 BCLEOF, JMS BCLHU1;EOF2 011450 2074 1856 1857 1858 011451 4204 CERR, JMS BCLHU1;KEYBAD 011452 1226 1859 1860 1861 011453 0000 XOUTNA, 0 1862 011454 1653 TAD I XOUTNA /GET ADDRESS OF NAME 1863 011455 2253 ISZ XOUTNA 1864 011456 3314 DCA OUTNA2 1865 011457 1023 TAD GETPNT /SAVE BUFFER INPUT POINTER 1866 011460 3343 DCA OUTNA6 1867 011461 3323 DCA OUTNA3 /SET FLAG FOR NO NAME 1868 011462 4324 JMS OUTNA4;0;-4 /SEND 4 CHARS FROM POSITION 0 011463 0000 011464 7774 1869 011465 1323 TAD OUTNA3 1870 011466 7650 SNA CLA 1871 011467 5272 JMP .+3 /NO DEVICE - NO ":" 1872 011470 1367 TAD (": 1873 011471 4441 OUT1 1874 011472 4324 JMS OUTNA4;4;-6 /SEND 6 CHARS FROM POSITION 4 011473 0004 011474 7772 1875 011475 1366 TAD (12 /SET UP TO GET EXTENSION 1876 011476 3023 DCA GETPNT 1877 011477 4312 JMS OUTNA1 /GET FIRST CHAR 1878 011500 5307 JMP OUTNA5 /NO EXTENSION 1879 011501 7200 CLA 1880 011502 1365 TAD (". 1881 011503 4441 OUT1 1882 011504 4324 JMS OUTNA4;12;-2 /SEND 2 CHARS FROM POSITION 12 011505 0012 011506 7776 1883 011507 1343 OUTNA5, TAD OUTNA6 /RESTORE BUFFER INPUT POINTER 1884 011510 3023 DCA GETPNT 1885 011511 5653 JMP I XOUTNA 1886 1887 011512 0000 OUTNA1, 0 1888 011513 4425 GETCHR 1889 011514 0000 OUTNA2, 0 1890 011515 1364 TAD (-300 /IS IT NULL? 1891 011516 7450 SNA 1892 011517 5712 JMP I OUTNA1 /YES - DONE 1893 011520 2312 ISZ OUTNA1 /SKIP RETURN 1894 011521 1363 TAD (300 1895 011522 5712 JMP I OUTNA1 1896 011523 0000 OUTNA3, 0 /NAME PRESENT SWITCH 1897 1898 011524 0000 OUTNA4, 0 1899 011525 1724 TAD I OUTNA4 /GET CHAR POSITION 1900 011526 2324 ISZ OUTNA4 1901 011527 3023 DCA GETPNT 1902 011530 1724 TAD I OUTNA4 /GET NO OF CHARS 1903 011531 2324 ISZ OUTNA4 1904 011532 3342 DCA OUTN41 1905 011533 4312 OUTN42, JMS OUTNA1 /GET A CHAR 1906 011534 5724 JMP I OUTNA4 /NULL - DONE 1907 011535 4441 OUT1 1908 011536 2323 ISZ OUTNA3 /SET NAME PRESENT 1909 011537 2342 ISZ OUTN41 1910 011540 5333 JMP OUTN42 1911 011541 5724 JMP I OUTNA4 /DONE - RETURN 1912 011542 0000 OUTN41, 0 1913 011543 0000 OUTNA6, 0 1914 1915 1916 011563 0300 PAGE 011564 7500 011565 0256 011566 0012 011567 0272 011570 0042 011571 1444 011572 0045 011573 0044 011574 5313 011575 0041 011576 1413 011577 1646 1917 011600 0000 XSEND, 0 1918 011601 7440 SZA /IF AC =0, ADDRESS IS ARG OF CALL 1919 011602 5205 JMP XSEND4 1920 011603 1600 TAD I XSEND /GET MESSAGE ADDRESS 1921 011604 2200 ISZ XSEND 1922 011605 3020 XSEND4, DCA OTEMP1 1923 011606 1420 XSEND1, TAD I OTEMP1 1924 011607 7112 CLL RTR;RTR;RTR 011610 7012 011611 7012 1925 011612 4217 JMS XSEND2 1926 011613 1420 TAD I OTEMP1 1927 011614 4217 JMS XSEND2 1928 011615 2020 ISZ OTEMP1 1929 011616 5206 JMP XSEND1 1930 1931 011617 0000 XSEND2, 0 1932 011620 0377 AND (77 1933 011621 7450 SNA 1934 011622 5600 JMP I XSEND /NULL ENDS MESSAGE 1935 011623 4776 JMS I (XSEND3 /GET 8-BIT REPRESENTATION 1936 011624 4441 OUT1 1937 011625 5617 JMP I XSEND2 1938 1939 1940 011626 0000 MAKNAM, 0 1941 011627 1375 TAD (DECN /START CONVERSION AT 100 1942 011630 6201 CDF F0 1943 011631 3774 DCA I (XR1 1944 011632 7346 L7775 /CONVERT 3 DIGITS 1945 011633 3773 DCA I (TEMP1 1946 011634 2272 ISZ NAMCNT /BUMP NAME COUNTER 1947 011635 1272 TAD NAMCNT 1948 011636 3772 DCA I (TEMP4 1949 011637 7301 L0001 1950 011640 3771 DCA I (TEMP5 /SAVE LEADING ZEROES 1951 011641 1370 TAD (MAKNA2 1952 011642 3767 DCA I (OUTAD 1953 011643 6211 CDF F1 1954 011644 1626 TAD I MAKNAM /MOVE DEFAULT NAME TO OUTPUT AREA 1955 011645 3250 DCA .+3 1956 011646 4431 MOV6;FILNAM;0 011647 5115 011650 0000 1957 011651 1626 TAD I MAKNAM 1958 011652 2226 ISZ MAKNAM 1959 011653 3267 DCA MAKNA3+2 1960 011654 1366 TAD (7 /PUT NUMBER AT POSITION 7-9 1961 011655 3022 DCA PUTPNT 1962 011656 6202 CIF F0 1963 011657 4765 JMS I (CONDEC /OUTPUT NUMBER 1964 011660 1364 TAD (XOUT /RESTORE OUTPUT ROUTINE 1965 011661 6201 CDF F0 1966 011662 3767 DCA I (OUTAD 1967 011663 6211 CDF F1 1968 011664 5626 JMP I MAKNAM /RETURN 1969 1970 011665 0000 MAKNA3, 0 1971 011666 4426 PUTCHR;0 011667 0000 1972 011670 6203 CIF CDF F0 1973 011671 5665 JMP I MAKNA3 1974 011672 0000 NAMCNT, 0 1975 1976 1977 011673 0000 XISNUM, 0 1978 011674 1363 TAD (-"9 1979 011675 7540 SMA SZA 1980 011676 5302 JMP XISNU1 1981 011677 1362 TAD ("9-"0 1982 011700 7500 SMA 1983 011701 2273 ISZ XISNUM 1984 011702 7200 XISNU1, CLA 1985 011703 5673 JMP I XISNUM 1986 1987 1988 011704 0000 SAVNAM, 0 1989 011705 1324 TAD SAVPNT 1990 011706 3322 DCA SAV1+2 /PUT NAME IN LIST 1991 011707 1324 TAD SAVPNT 1992 011710 1361 TAD (-SAVTOP /ARE WE AT TOP OF LIST? 1993 011711 7450 SNA 1994 011712 5704 JMP I SAVNAM /YES - DON'T SAVE NAME 1995 011713 1360 TAD (SAVTOP+6 1996 011714 3324 DCA SAVPNT /ADVANCE POINTER FOR NEXT TIME 1997 011715 1704 TAD I SAVNAM /GET NAME TO SAVE 1998 011716 3321 DCA SAV1+1 1999 011717 2304 ISZ SAVNAM 2000 011720 4431 SAV1, MOV6;0;0 011721 0000 011722 0000 2001 011723 5704 JMP I SAVNAM 2002 2003 011724 4200 SAVPNT, SAVARA /POINT TO SAVE AREA 2004 2005 2006 011725 0000 UNSNAM, 0 2007 011726 1725 TAD I UNSNAM 2008 011727 2325 ISZ UNSNAM 2009 011730 3343 DCA UNSNA1+2 /POINT TO SPACE TO RECEIVE NAME 2010 011731 1324 TAD SAVPNT 2011 011732 1357 TAD (-6-SAVARA 2012 011733 7510 SPA 2013 011734 5345 JMP UNSNA2 /EMPTY - RETURN 2014 011735 1356 TAD (SAVARA 2015 011736 3324 DCA SAVPNT /BACK UP 2016 011737 1324 TAD SAVPNT 2017 011740 3342 DCA UNSNA1+1 /SET ADDRESS FROM WHICH NAME WILL COME 2018 011741 4431 UNSNA1, MOV6;0;0 011742 0000 011743 0000 2019 011744 2325 ISZ UNSNAM /SKIP RETURN UNLESS EMPTY 2020 011745 7200 UNSNA2, CLA 2021 011746 5725 JMP I UNSNAM 2022 2023 2024 011756 4200 PAGE 011757 3572 011760 4662 011761 3124 011762 0011 011763 7507 011764 2053 011765 2244 011766 0007 011767 0022 011770 0647 011771 0035 011772 0034 011773 0031 011774 0010 011775 3720 011776 0262 011777 0077 2025 / 2026 / 2027 / $DECK 2028 / 2029 / 2030 012000 4427 CDECK, BCLIN /GET THE LINE 2031 012001 4430 OPTION;CDEOPT /ANALYZE THE OPTIONS 012002 4654 2032 012003 4436 TSTCR /END OF LINE? 2033 012004 5211 JMP CDECK1 /NO - GET A NAME 2034 012005 4431 CDECK3, MOV6;CDEDEF;NAME1 /YES - MOVE DEFAULT NAME 012006 5073 012007 5027 2035 012010 5214 JMP CDECK2 2036 012011 4432 CDECK1, COLNAM;NAME1 /COLLECT A NAME 012012 5027 2037 012013 5205 JMP CDECK3 /FAIL - BAD NAME 2038 012014 4435 CDECK2, SEND;CDEM1 /".R PIP_*" 012015 5411 2039 012016 4433 OUTNAM;NAME1 /SEND THE NAME 012017 5027 2040 012020 4435 SEND;CDEM2 /"? 012614 5270 012615 5243 2309 012616 5211 JMP DAT41 /NO 2310 012617 7340 DAT42, L7777 2311 012620 1023 TAD GETPNT /SAVE POINTER TO "/" 2312 012621 3331 DCA DEVAST 2313 012622 4425 GETCHR;BCLBUF 012623 3600 2314 012624 4440 ISNUM 2315 012625 5213 JMP DAT411 /IT'S NOT A NUMBER 2316 012626 1021 TAD CHAR 2317 012627 1375 TAD (-"0 2318 012630 7041 CIA 2319 012631 3327 DCA DEVASC 2320 012632 1327 TAD DEVASC 2321 012633 7041 CIA 2322 012634 7104 CLL RAL;RTL 012635 7006 2323 012636 1327 TAD DEVASC /NUMBER*7 2324 012637 1374 TAD (DEVASN 2325 012640 3327 DCA DEVASC 2326 012641 4425 DAT47, GETCHR;BCLBUF /GET ANOTHER CHAR 012642 3600 2327 012643 4434 ISIT;DATIS2;DATIS3-1 /IS IT "N","C", OR "="? 012644 5246 012645 5251 2328 012646 5213 JMP DAT411 /NO 2329 012647 1727 DAT44, TAD I DEVASC /"N" SETS BIT 1 2330 012650 0373 AND (5777 2331 012651 1372 TAD (2000 2332 012652 3727 DCA I DEVASC 2333 012653 5241 JMP DAT47 2334 012654 1727 DAT45, TAD I DEVASC /"C" SETS BIT 2 2335 012655 0371 AND (6777 2336 012656 1370 TAD (1000 2337 012657 3727 DCA I DEVASC 2338 012660 5241 JMP DAT47 2339 012661 1023 DAT46, TAD GETPNT /SAVE POINTER TO POSSIBLE NAME 2340 012662 3326 DCA DEVASP 2341 012663 4425 GETCHR;BCLBUF /GET THE NEXT CHAR 012664 3600 2342 012665 4440 ISNUM 2343 012666 5276 JMP DAT48 /NOT A NUMBER 2344 012667 1021 TAD CHAR /SAVE THE NUMBER 2345 012670 3330 DCA DEVASS 2346 012671 4425 GETCHR;BCLBUF 012672 3600 2347 012673 4434 ISIT;DATIS4;DATIS5-1 /IS IT "," "/" OR ? 012674 5267 012675 5254 2348 012676 1326 DAT48, TAD DEVASP /RESET NAME POINTER 2349 012677 3023 DCA GETPNT 2350 012700 1727 TAD I DEVASC /ZERO OUT NUMBER 2351 012701 0367 AND (7400 2352 012702 3727 DCA I DEVASC 2353 012703 1327 TAD DEVASC;IAC /GET POINTER TO DEVICE BLOCK 012704 7001 2354 012705 3307 DCA .+2 2355 012706 4432 COLNAM;0 /COLLECT NAME 012707 0000 2356 012710 5315 JMP DAT49 /BAD NAME 2357 012711 1727 DAT412, TAD I DEVASC /NAME OR NUM OK - SET BIT 0 2358 012712 0366 AND (3777 2359 012713 1365 TAD (4000 2360 012714 3727 DCA I DEVASC 2361 012715 1331 DAT49, TAD DEVAST /SQUISH 2362 012716 4764 JMS I (BCLSQU 2363 012717 5211 JMP DAT41 2364 012720 1727 DAT410, TAD I DEVASC /ADD NUMBER TO CONTROL WORD 2365 012721 0367 AND (7400 2366 012722 1330 TAD DEVASS 2367 012723 3727 DCA I DEVASC 2368 012724 5311 JMP DAT412 2369 012725 5600 DAT43, JMP I DAT4 2370 2371 2372 012726 0000 DEVASP, 0 2373 012727 0000 DEVASC, 0 2374 012730 0000 DEVASS, 0 2375 012731 0000 DEVAST, 0 2376 2377 2378 /SEND A NAME AND SEND /T OPTION IF DEVICE IS TTY: 2379 012732 0000 PIPOUT, 0 2380 012733 1732 TAD I PIPOUT /GET ADDRESS OF NAME 2381 012734 2332 ISZ PIPOUT 2382 012735 3337 DCA PIPPNT 2383 012736 4433 OUTNAM /SEND IT 2384 012737 0000 PIPPNT, 0 2385 012740 1737 TAD I PIPPNT /GET CHAR OF DEVICE 2386 012741 1363 TAD (-2424 /IS IT "TT"? 2387 012742 7640 SZA CLA 2388 012743 5732 JMP I PIPOUT /NO 2389 012744 2337 ISZ PIPPNT 2390 012745 1737 TAD I PIPPNT 2391 012746 1362 TAD (-3100 /IS IT "Y@"? 2392 012747 7640 SZA CLA 2393 012750 5732 JMP I PIPOUT /NO 2394 012751 4435 SEND;PIPM1 /"/T" 012752 5474 2395 012753 5732 JMP I PIPOUT 2396 2397 2398 012762 4700 PAGE 012763 5354 012764 0611 012765 4000 012766 3777 012767 7400 012770 1000 012771 6777 012772 2000 012773 5777 012774 5131 012775 7520 012776 5130 012777 7672 2399 /$RUN (FORTRAN IV) 2400 013000 4777 DATF4, JMS I (DAT4 /PROCESS DEVICE NUMBER STUFF 2401 013001 4776 JMS I (CL4S /DO LOAD STUFF 2402 013002 5211 JMP DATL46 2403 013003 4777 DATL4, JMS I (DAT4 2404 013004 4430 OPTION;ZER6 /NO OPTIONS 013005 5051 2405 013006 5211 JMP DATL46 2406 013007 4777 DATX4, JMS I (DAT4 /DO DEVICE NUMBER STUFF 2407 013010 4321 JMS DATNAM /COLLECT A NAME 2408 013011 4435 DATL46, SEND;DTF4M1 /".R PIP_*DATA.DA 2701 015246 7462 DATIS2, -"N;-"C;-"=;0 015247 7475 015250 7503 015251 0000 2702 015252 2647 DATIS3, DAT44;DAT45;DAT46 015253 2654 015254 2661 2703 015255 2720 DATIS5, DAT410;DAT410;DAT410 015256 2720 015257 2720 2704 015260 0533 OPTIS2, OPTIO8 /"=" 2705 015261 0551 OPTIO9 /"," 2706 015262 0551 OPTIO9 /"/" 2707 015263 0551 OPTIO9 / 2708 2709 015264 0423 OPTIS4, OPTI3A 2710 015265 0513 OPTRET 2711 2712 015266 7503 OPTIS1, -"= 2713 DATIS4, 2714 015267 7524 OUTIS1, -", 2715 OPTIS3, 2716 015270 7521 BCLIS1, -"/;-215 015271 7563 2717 /LIST MUST BE TERMINATED BY A POSITIVE WORD 2718 015272 0000 0 2719 2720 015273 1031 COLIS2, COLDEV /":" 2721 015274 1037 COLFIL /"." 2722 015275 1050 COLEXT /"/" 2723 015276 1050 COLEXT /"," 2724 015277 1050 COLEXT / 2725 2726 2727 015300 7506 COLIS1, -":;-".;-"/;-",;-215 015301 7522 015302 7521 015303 7524 015304 7563 2728 /TERMINATE LIST WITH POSITIVE WORD 2729 015305 0000 0 2730 2731 015306 0632 BCLIS2, BCLSQ2 /"/" 2732 015307 0636 BCLSQ3 / 2733 2734 015310 0661 OUTIS2, OUTER2 /"," 2735 015311 0661 OUTER2 /"/" 2736 015312 0661 OUTER2 / 2737 2738 /LIST OF BCL ROUTINE ADDRESSES 2739 015313 1447 BCLGO, BCLEOF /FOR FINISHING UP BEFORE CLOSING FILE 2740 015314 2052 CBAS /$BAS 2741 015315 2200 FORADR, CF4 /$FOR 2742 015316 3007 DATADR, DATX4 /$DATA 2743 015317 2540 LOAADR, CL4 /$LOAD 2744 015320 3321 CJOB /$JOB 2745 015321 3316 CMSG /$MSG 2746 015322 2000 CDECK /$DECK 2747 015323 3316 CEOD /$EOD 2748 015324 1451 CERR 2749 015325 1451 CERR 2750 015326 1451 CERR 2751 015327 1451 CERR 2752 /LIST OF BCL KEYWORDS 2753 015330 5700 BCLKEY, MBAS 2754 015331 5704 MFOR 2755 015332 5743 MDATA 2756 015333 5740 MLOAD 2757 015334 5727 MJOB 2758 015335 5732 MMSG 2759 015336 5735 MDECK 2760 015337 5724 MEOD 2761 /ERROR MESSAGES 2762 015340 7711 OPTERM, TEXT "?INVALID OPTION: /" 015341 1626 015342 0114 015343 1104 015344 4017 015345 2024 015346 1117 015347 1672 015350 4057 015351 0000 2763 015352 7711 COLERM, TEXT "?INVALID FILE SPECIFICATION - " 015353 1626 015354 0114 015355 1104 015356 4006 015357 1114 015360 0540 015361 2320 015362 0503 015363 1106 015364 1103 015365 0124 015366 1117 015367 1640 015370 5540 015371 0000 2764 015372 7737 BCL11E, TEXT "?_BCL LINE TOO LONG_" 015373 0203 015374 1440 015375 1411 015376 1605 015377 4024 015400 1717 015401 4014 015402 1716 015403 0737 015404 0000 2765 /MESSAGES 2766 015405 7737 BCLHM1, TEXT "?_" 015406 0000 2767 015407 3744 BCL10E, TEXT "_$" 015410 0000 2768 CF4M1, 2769 CF2M1, 2770 015411 5622 CDEM1, TEXT ".R PIP_*" 015412 4020 015413 1120 015414 3752 015415 0000 2771 015416 7402 CDEM2, TEXT "