1 /SNOBOL 8.2 COMPILER. 31 AUGUST 76 PAL SOURCE 2 / 3 / 4 / 5 / THIS IS THE SOURCE FILE FOR THE SNOBOL-8.2 LANGUAGE COMPILER. THIS 6 /PROGRAM IS DESIGNED TO RUN ON ANY STANDARD PDP-8 OS/8 SYSTEM WITH AT LEAST 7 /8K. THE MACHINE READABLE USER DOCUMENTATION IS CONTAINED IN THE FILE 8 /SNOUSER.DC ON THE NETWORK. ANY BUGS DISCOVERED SHOULD BE REFERRED TO THE 9 /APPROPRIATE PERSON(S), WHO IS CURRENTLY FRED DALRYMPLE. 10 / 11 /FRED DALRYMPLE 12 13 14 15 *0 16 DECIMAL 17 000000 0136 94 /VERSION NUMBER 18 OCTAL 19 / PAGE USAGE (FIELD 0) ***OUT OF DATE 20 / 21 /200 SNOBOL-FRONT2 (26) 146 (4) * 22 /400 FRONT4-MAIN0A (22) 145 (11) 23 /600 MAIN01-MAIN18 (27) 150 (1) 24 /1000 MAIN19-MAIN55 (24) 135 (17) 25 /1200 MAIN56-MAIN63 (17) 150 (11) 26 /1400 MAIN70-MAIN78 (16) 147 (13) 27 /1600 MAIN79-END4 (27) 150 (1) 28 /2000 END7-PUTOUT (23) 152 (3) 29 /2200 SCANNR-SCAN08 (10) 160 (10) 30 /2400 SCAN09-SCAN16 (7) 133 (36) 31 /2600 SCAN20-SCAN2S (21) 135 (20) 32 /3000 SCAN24-SCAN2C (12) 162 (4) 33 /3200 SCAN2M-SCAN30 (25) 125 (26) 34 /3400 CLOSE-CLOS10 (22) 125 (31) * 35 /3600 CLOS11-CLOS23 (15) 135 (26) 36 /4000 CLOS24-ERR17 (35) 121 (22) 37 /4200 ERR18-ENDRD (17) 146 (13) 38 /4400 RETRN-WRSPO (3) 174 (1) 39 /4600 WROCTO-SERCH (5) 155 (16) 40 /5000 MACH-RDPOL (4) 104 (70) 41 /5200 WRPOL-WPSTR (3) 170 (5) 42 /5400 RDCHR (12) 165 (1) 43 /5600 WRCHR-PRN (13) 150 (15) 44 45 INHAN=6000 /INPUT HANDLER 46 /6200 47 OUTHAN=6400 /OUTPUT HANDLER 48 /6600 49 /7000 LITERALS AND STORAGE 50 / PAGE USAGE (FIELD 1) 51 / 52 / 53 /200 INPUT BUFFER 54 /400 55 / 56 /600 OUTPUT BUFFER 57 /1000 58 /1200 59 /1400 60 / 61 /1600 TEXT 62 63 64 65 IBUF=200 /ADDRESS OF THE INPUT BUFFER 66 NTOPIB=-600 /NEGATIVE TOP OF THE INPUT BUFFER 67 OBUF=600 / OUTPUT BUFFER 68 NTOPOB=-1600 /NEG. TOP OF OUTPUT BUFFER 69 / DEFINITIONS 70 71 /STORAGE DELIMITERS 72 73 STRDEL=0000 /BEGINNING OR END OF STRING 74 FREE= 7777 /FREE WORD IN STORAGE 75 LINK= 7776 /LINK CODE 76 POLEND=7775 /END OF POOL 77 78 79 /USR LOCATIONS 80 81 OFLTAB=7600 /CD OUTPUT FILE TABLE (FIELD 1) 82 IFLTAB=7617 /CD INPT FILE TABLE (FIELD 1) 83 84 85 /PARSING DELIMITERS 86 87 UPARR= 23 88 COMMA= 22 89 COLON= 21 90 SPACE= 20 91 SEMI= 17 92 OR= 16 93 EQUAL= 15 94 LESS= 14 95 BACK= 12 96 END= 11 97 EOL= 10 98 LPAREN= 6 99 RPAREN= 4 100 STAR= 3 101 SLASH= 2 102 ADD= 1 103 SUB= 0 104 105 106 /POINT COMMAND ARGUMENT DESCRIPTORS 107 108 VARORLIT= 1 109 NOARG= 2 110 LABEL= 4 111 JMPTR= 10 112 VAR= 20 113 ANY= 37-LABEL-JMPTR 114 115 CPAL= 100 116 CSNO= 200 117 CEXIT= 400 118 CEND= 1000 119 CCONTR=1700 /ALL COMPILER CONTROL TYPES 120 / PAGE ZERO STORAGE 121 122 *10 123 000010 0000 INDEX0, 0 /AUTO-INDEX REGISTERS 124 000011 0000 INDEX1, 0 125 000012 0000 INDEX2, 0 126 000013 0000 INDEX3, 0 127 000014 0000 LINEP, 0 /LINE IMAGE PTR 128 000015 0000 AGVPTR, 0 /ARITH GEN VAR POOL PTR 129 000016 0000 INDEX6, 0 130 000017 0000 INDEX7, 0 131 132 000020 0000 ACCNUM, 0 /NUMBER ACCUMULATION (SCAN) 133 000021 0000 LPOOL, 0 /WHICH LITERAL POOL TO REFERENCE 134 000022 0000 DEL, 0 /ATOM DELIMITER (SCAN) 135 000023 0000 LAST, 0 /LAST DELIMITER IN ARITHMETIC STATEMENT 136 000024 0000 T1, 0 /TEMPORARIES 137 000025 0000 T2, 0 / 138 000026 0000 T3, 0 / 139 000027 0000 T4, 0 140 000030 0000 TX, 0 /VERY TEMPORARIES 141 000031 0000 TXX, 0 142 000032 0000 TOP, 0 /LAST USED ADDRESS IN STORAGE PLUS 1 143 000033 0000 ARGCNT, 0 /ARGUMENT COUNT FOR POINT COMMAND 144 000034 0000 CLEN, 0 /LENGTH OF THIS SNOBOL INST IN PAL CODE 145 000035 0000 PAGLEN, 0 /CURRENT LENGTH OF OBJECT PAGE 146 000036 0000 TMODE, 0 /MODE FOR THIS INSTRUCTION 147 000037 0000 NXTSTR, 0 /BEGINNING OF NEW LITERAL 148 000040 0000 T1MAT, 0 /WRITE CURSOR FOR WRPOOL 149 000041 0000 SCURS, 0; 0 /HOLD CURSOR THROUGH EXTCUR-EXFCUR 000042 0000 150 000043 0000 OCURSR, 0; 0 /OUTPUT STREAM CURSOR 000044 0000 151 000045 0000 IMCNT, 0 /COUNT FOR LINE IMAGE 152 000046 0000 VALID, 0 /VALID TYPE TO BE FOUND BY SCAN 153 000047 0000 HPOOL, 0 /POOL HEAD (FOR WRPOOL) 154 000050 0000 AGVCNT, 0 /COUNT FOR ARITH GEN VAR POOL PTR 155 000051 0000 INFLPT, 0; 0 /PTR TO INPUT FILE LIST AND COUNT 000052 0000 156 000053 0000 IHAN, 0 /LOCATION OF INPUT HANDLER 157 000054 0000 OHAN, 0 /LOCATION OF OUTPUT HANDLER 158 000055 0000 FOUTBK, 0 /FIRST BLOCK NUMBER IN OUTPUT FILE 159 000056 0000 OFLAG, 0 /FLAG OUTPUT FILE BEING USED 160 000057 0000 LITFND, 0 /FLAG LITERAL FOUND (SCAN) 161 000060 0000 EQLSEN, 0 /FLAG EQUAL SIGN SEEN 162 000061 0000 LABELF, 0 /FLAG LABEL BEING PARSED (SCAN) 163 000062 0000 TRASEN, 0 /FLAG TRANSFER SEEN 164 000063 0000 OUTF, 0 /FLAG OLINE PUT (PUTOUT) 165 000064 0000 ACMIND, 0 /FLAG ACCUM IS INDIRECT (SCAN) 166 000065 0000 PTATOM, 0 /FLAG .A ATOM SEEN (SCAN) 167 000066 0000 MODECH, 0 /FLAG MODE CHANGED 168 000067 0000 STRF, 0 /FLAG NOT INPUT FILE (FOR GETCHR) 169 170 171 F0CLR=. /IMPURE AREA - VARIABLES BETWEEN HERE AND F0CLRL 172 /ARE CLEARED AUTOMATICALLY AT INITIALIZATION 173 174 000070 0000 CHOLD, 0 /HOLD CHARACTER FOR GETCHR LOOK AHEAD 175 000071 0000 CURSOR, 0; 0 /POINTER TO INPUT STREAM 000072 0000 176 000073 0000 OCNT, 0 /TELETYPE COLUMN POSITION 177 000074 0000 TOCNT, 0 /HIGHEST OCNT VALUE 178 000075 0000 GENLIT, 0 /GENERATED LITERALS COUNT 179 000076 0000 PAGLIT, 0 /GEN LITS FOR PAGING PAL FILE 180 181 000077 0000 OVERF, 0 /FLAG OVERWRITING POOL (DELETE SUBSTRING) 182 000100 0000 LINDF, 0 /FLAG INDIRECT LABEL USAGE 183 000101 0000 VINDF, 0 /FLAG INDIRECT VARIABLE USAGE 184 185 000102 0000 COLINE, 0 /CURRENT POSITION POINTER FOR OLINE 186 000103 0000 CPOLIN, 0 /CURRENT POSITION POINTER FOR POLINE 187 188 F0CLRL=.-F0CLR /THIS IS THE END OF THE AUTOMATIC CLEAR AREA 189 190 000104 0000 ONAME, ZBLOCK 4 /OUTPUT FILE NAME 000105 0000 000106 0000 000107 0000 191 / CONSTANTS 192 193 ZERO= CLA CLL 194 ONE= CLA CLL IAC 195 TWO= CLA CLL IAC RAL 196 THREE= CLA CLL CML IAC RAL 197 FOUR= CLA CLL IAC RTL 198 SIX= CLA CLL CML IAC RTL 199 200 000110 0005 C5, 5 201 000111 0007 C7, 7 202 000112 0010 C10, 10 203 000113 0012 C12, 12 204 000114 0240 C240, 240 205 000115 0260 C260, 260 206 000116 0377 C377, 377 207 000117 7400 C7400, 7400 208 000120 4000 SARG, 4000 /SUBSTITUTE ARG BIT 209 210 NONE= CLA CLL CMA 211 NTWO= CLA CLL CMA RAL 212 NTHREE= CLA CLL CMA RTL 213 214 000121 7777 NC1, -1 215 000122 7776 NC2, -2 216 000123 7775 NC3, -3 217 000124 7774 NC4, -4 218 000125 7773 NC5, -5 219 000126 7772 NC6, -6 220 000127 7771 NC7, -7 221 000130 7770 NC10, -10 222 000131 7766 NC12, -12 223 000132 7566 NC212, -212 224 000133 7520 NC260, -260 225 / ROUTINES AND COMMON POINTERS 226 227 228 000134 2161 ACUM, ACCUM /POINT TO FIRST WORD OF ACCUM 229 000135 2160 ACUMM, ACCUM-1 / 230 000136 4451 CONVD, CVD /CONVERT THE AC TO DECIMAL 231 000137 4323 CTYPE, CTTYPE /TYPE CHARACTERS (CHAR/WORD); PTR IN AC 232 000140 4705 DELPOL, DPOOL /DELETE A POOL'S STORAGE (PTR IN AC) 233 000141 4431 ENDRD, ENDRED /READ FROM INPUT UNTIL EOL 234 000142 5400 GETCHR, RDCHR /RETURN NEXT CHAR FROM INPUT IN AC 235 000143 5413 GETCHS, RDCHRS /READ CHARACTER AND DON'T MODIFY 236 000144 4740 INTST, INTRPT /TEST FOR INTERRUPT 237 000145 0200 LUSR, 200 /ADDRESS OF USR (FIELD 1) WHEN LOCKED 238 000146 5066 MAKASC, CALASC /GENERATE CALL TO ASC WITH GEN'ED LIT 239 000147 5674 PRINT, PRN /TYPE A CHARACTER 240 000150 4414 PUTACR, PACCUR /PUT ACCUM ONTO OLINE WITH RETURN 241 000151 5600 PUTCHR, WRCHR /WRITE CHAR TO OUTPUT (CHAR IN AC) 242 000152 4332 PUTNAM, PTNAME /PUT NAME TO OUTPUT FROM POOL (PTR IN T1) 243 000153 5106 PUTOC, PUTOCT /PUT OCTAL NUMBER IN AC TO OUTPUT 244 000154 2200 PUTOUT, PTOUT /WRITE LINE AND GENERATED CODE TO OUTPUT 245 000155 5130 RDPOOL, RDPOL /READ CHAR FROM A POOL (PTR IN T1) 246 000156 4445 RETORN, RETRN /PUT CARRAIGE RETURN ON OLINE 247 000157 5000 RETTRN, TYRET /TYPE A CARRAIGE RETURN 248 000160 2402 SCAN, SCANNR /PARSE NEXT ATOM (ACCUM, DEL) 249 000161 5004 SEARCH, SERCH /SEARCH POOL (PTR IN T1) FOR (ACCUM) 250 000162 4400 SAVACM, SVACUM /STORE ACCUM IN SACCUM 251 000163 4754 SHACUM, SHFTAC /SHIFT ACCUM ONE CHAR LEFT 252 000164 4477 TYPE, TTYPE /TYPE PACKED STRING 253 000165 7700 USR, 7700 /USR LOCATION WHEN NOT LOCKED 254 000166 4657 WROCO, WROCTO /WRITE OCTAL NUMBER IN AC TO OLINE 255 000167 4547 WROLIN, WRITO /WRITE CHAR TO OLINE 256 000170 4626 WRPOLN, WRITPO /WRITE CHAR ON POLINE 257 000171 5147 WRPOOL, WRPOL /WRITE CHAR TO A POOL (PTR IN T1MAT) 258 000172 4600 WRPPSO, WRPPO /WRITE PACKED STRING TO POLINE 259 000173 4507 WRPSO, WRIPO /WRITE PACKED STRING TO OLINE 260 000174 5350 WRPS, WPSTR /WRITE PACKED STRING TO OUTPUT 261 000175 4641 WRSTPO, WRSPO /WRITE STRING TO POLINE (PTR IN AC) 262 000176 4540 WRSTR, WRSTRG /WRITE STRING (PTR IN AC) TO OUTPUT 263 000177 4610 WRSTRO, WRSTO /WRITE STRING (PTR IN AC) TO OLINE 264 / THIS IS THE FRONT END OF THE COMPILER. INPUT AND OUTPUT FILES 265 /ARE SETUP VIA THE COMMAND DECODER. 266 267 268 *200 269 270 000200 7300 SNOBOL, ZERO 271 000201 6201 CDF 0 272 000202 6212 CIF 10 273 000203 4565 JMS I USR /CALL THE USR 274 000204 0010 10 /LOCK IT IN CORE 275 276 000205 6212 CIF 10 277 000206 4545 JMS I LUSR /CALL AGAIN 278 000207 0005 5 /FOR THE CD 279 000210 2316 2316 /"SN" - DEFAULT EXTENSION 280 000211 0000 0 /PRESERVE TENTATIVE FILES 281 282 000212 1377 TAD (IFLTAB 283 000213 3051 DCA INFLPT /POINTER TO INPUT FILE LIST 284 000214 1130 TAD NC10 285 000215 3052 DCA INFLPT+1 /AND COUNT 286 000216 1376 TAD (OUTHAN /WHERE TO PUT HANDLER 287 000217 7001 IAC /2 PAGE HANDLER IS OK 288 000220 3245 DCA OFHANL 289 290 000221 6211 CDF 10 291 000222 1775 TAD I (OFLTAB+1 /TRANSFER OUTPUT FILENAME TO PAGE ZERO 292 293 000223 3104 DCA ONAME 294 000224 1774 TAD I (OFLTAB+2 295 000225 3105 DCA ONAME+1 296 000226 1773 TAD I (OFLTAB+3 297 000227 3106 DCA ONAME+2 298 000230 1772 TAD I (OFLTAB+4 299 000231 3107 DCA ONAME+3 300 301 000232 1371 TAD (ONAME 302 000233 3253 DCA OFLNM /SAVE ADDRESS OF FILE NAME 303 000234 1770 TAD I (OFLTAB /GET OUTPUT FILE DEVICE # 304 000235 3056 DCA OFLAG 305 000236 1056 TAD OFLAG /FLAG WHETHER ITS SPECIFIED OR NOT 306 000237 7450 SNA /SPECIFIED? 307 000240 5300 JMP FRONT1 /NO 308 / GET THE OUTPUT HANDLER 309 310 000241 6201 CDF 0 /SET THE BASE FIELD 311 000242 6212 CIF 10 312 000243 4545 JMS I LUSR /CALL 313 000244 0001 1 /TO FETCH THE HANDLER 314 000245 0000 OFHANL, 0 /LOCATION OF HANDLER 315 000246 7402 HLT /NO 316 317 000247 1056 TAD OFLAG /GET DEVICE NUMBER 318 000250 6212 CIF 10 319 000251 4545 JMS I LUSR /CALL 320 000252 0003 3 /TO ENTER 321 000253 0104 OFLNM, ONAME /FILENAME 322 000254 0000 OFLEN, 0 323 000255 5767 JMP ERR24 /CANT ENTER 324 325 000256 6211 CDF 10 326 000257 1245 TAD OFHANL /GET LOCATION OF HANDLER 327 000260 3054 DCA OHAN /SAVE 328 000261 1253 TAD OFLNM /GET STARTING BLOCK 329 000262 3055 DCA FOUTBK 330 000263 1055 TAD FOUTBK 331 000264 3766 DCA I (OUTBLK 332 000265 1254 TAD OFLEN / 333 000266 7130 CLL CML RAR /CoNVERT TO TWO BLOCK SIZE 334 000267 3765 DCA I (OBCNT /SAVE NEGATIVE LENGTH 335 000270 1364 TAD (OBUF 336 000271 3043 DCA OCURSR /SETUP THE OUTPUT CURSOR 337 000272 7301 ONE 338 000273 3044 DCA OCURSR+1 339 000274 1363 TAD (TOPF1 340 000275 3762 DCA I (BASE /SETUP POINTERS TO THE BOTTOM OF FREE SPACE 341 000276 1363 TAD (TOPF1 342 000277 3032 DCA TOP 343 344 000300 6201 FRONT1, CDF 0 345 000301 6212 CIF 10 346 000302 4545 JMS I LUSR /CALL ONCE MORE 347 000303 0011 11 /TO BE DISMISSED 348 349 000304 1056 TAD OFLAG 350 000305 7650 SNA CLA /DOING OUTPUT? 351 000306 5761 JMP FRONT4 352 000307 6211 CDF 10 353 000310 1360 TAD (INITAL /INITIALIZATION MESSAGES 354 000311 4574 JMS I WRPS /WRITE IT 355 000312 1757 TAD I (7666 /GET SYSTEM DATE WORD 356 000313 7450 SNA /SPECIFIED? 357 000314 5345 JMP FRONT2 /NO 358 000315 3030 DCA TX 359 000316 1030 TAD TX 360 000317 0111 AND C7 /SAVE YEAR 361 000320 1115 TAD C260 362 000321 3756 DCA I (YEAR 363 000322 1030 TAD TX 364 000323 7012 RTR; RAR /SHIFT FOR DAY 000324 7010 365 000325 3030 DCA TX 366 000326 1355 TAD (DAY-1 367 000327 3011 DCA INDEX1 /WHERE TO PUT DAY 368 000330 1030 TAD TX 369 000331 0354 AND (37 /SAVE DAYS 370 000332 4536 JMS I CONVD /CONVERT TO DECIMAL 371 000333 1353 TAD (MONTH-1 372 000334 3011 DCA INDEX1 373 000335 1030 TAD TX 374 000336 7012 RTR; RTR; RAR 000337 7012 000340 7010 375 000341 0352 AND (17 /SAVE MONTH 376 000342 4536 JMS I CONVD /PUT IT 377 000343 1353 TAD (MONTH-1 /MESSAGE 378 000344 4576 JMS I WRSTR /PUT IT 379 380 000345 1351 FRONT2, TAD (INITA2 /INITIAL CODE 381 000346 4574 JMS I WRPS / 382 383 000347 5761 JMP I (.&7600+200 /*** PAGE BOUND 384 000351 2335 PAGE 000352 0017 000353 2235 000354 0037 000355 2240 000356 2245 000357 7666 000360 2323 000361 0400 000362 2171 000363 3527 000364 0600 000365 2175 000366 2174 000367 4247 000370 7600 000371 0104 000372 7604 000373 7603 000374 7602 000375 7601 000376 6400 000377 7617 385 / INITIALIZE COUNTERS, POOLS, ETC. 386 387 388 000400 6201 FRONT4, CDF 0 389 000401 1377 TAD (F0CLR-1 /CLEAR FIELD 0 IMPURE AREA 390 000402 3011 DCA INDEX1 391 000403 1376 TAD (-F0CLRL 392 000404 3030 DCA TX 393 394 000405 3411 DCA I INDEX1 395 000406 2030 ISZ TX 396 000407 5205 JMP .-2 397 398 000410 6211 CDF 10 399 000411 1375 TAD (F1CLR-1 /CLEAR FIELD 1 IMPURE AREA 400 000412 3011 DCA INDEX1 401 000413 1374 TAD (-F1CLRL 402 000414 3030 DCA TX 403 404 000415 3411 DCA I INDEX1 405 000416 2030 ISZ TX 406 000417 5215 JMP .-2 407 408 000420 1373 TAD (1-LINEL 409 000421 3045 DCA IMCNT /MAX LINE LENGTH 410 000422 1372 TAD (LINEIM-1 411 000423 3014 DCA LINEP /PTR TO LINE BUFFER 412 413 000424 1371 TAD (-NTOPIB 414 000425 3071 DCA CURSOR 415 000426 7301 ONE /INITIALIZE THE INPUT CURSOR 416 000427 3072 DCA CURSOR+1 417 418 000430 1110 TAD C5 419 000431 3035 DCA PAGLEN /LENGTH OF OBJECT PAGE 420 / THIS IS THE MAIN LOOP FOR ASSIGNING ANOTHER INPUT FILE FOR 421 /COMPILATION. IF THERE ARE NO MORE, CLOSE IS CALLED. 422 423 424 425 000432 2052 NEXTIN, ISZ INFLPT+1 /ANY MORE? 426 000433 7410 SKP /YES 427 000434 5770 JMP CLOSE /NO - DONE 428 000435 1451 TAD I INFLPT /GET NEXT DEVICE NUMBER 429 000436 7450 SNA /ANY? 430 000437 5770 JMP CLOSE /NO - DONE 431 000440 7012 RTR; RTR /GET MINUS LENGTH 000441 7012 432 000442 0116 AND C377 433 000443 1367 TAD (7400-1 /EXTEND SIGN 434 000444 3766 DCA I (IBCNT /AND SAVE 435 000445 1365 TAD (INHAN /AREA FOR INPUT HANDLER 436 000446 7001 IAC /2-PAGER IS OK 437 000447 3255 DCA IFHANL 438 000450 1451 TAD I INFLPT /GET DEVICE # AGAIN 439 440 000451 6201 CDF 0 441 000452 6212 CIF 10 442 000453 4565 JMS I USR /CALL THE USR 443 000454 0001 1 /TO GET THE HANDLER 444 000455 0000 IFHANL, 0 445 000456 7402 HLT /SHOULDN'T 446 447 000457 1255 TAD IFHANL /LOCATION OF HANDLER 448 000460 3053 DCA IHAN /SAVE IT 449 450 451 /FROM HERE ON, THE DATA FIELD IS ONE EXCEPT FOR USR AND HANDLER CALLS 452 453 454 000461 6211 CDF 10 455 000462 2051 ISZ INFLPT /POINT TO NEXT WD 456 000463 1451 TAD I INFLPT /GET STARTING BLOCK # 457 000464 3764 DCA I (INBLK /SAVE IT 458 000465 2051 ISZ INFLPT /AND BUMP 459 / THIS IS THE MAIN COMPILER LOOP. PARSING EACH NEW INPUT LINE 460 /IS BEGUN HERE. 461 462 463 000466 7340 MAIN, NONE 464 000467 3062 DCA TRASEN /TRANSFER NOT SEEN YET 465 000470 3066 DCA MODECH /MODE NOT CHANGED 466 000471 3034 DCA CLEN /ZERO LENGTH 467 000472 3033 DCA ARGCNT /ZERO ARGUMENT LIST 468 000473 1763 TAD I (MODE 469 000474 3036 DCA TMODE /SETUP CURRENT MODE 470 000475 4544 JMS I INTST /TEST FOR INTERRUPT 471 /SCAN FOR A LABEL OR STATEMENT 472 473 000476 1362 MAIN00, TAD (ANY 474 000477 3046 DCA VALID /VALID TYPE TO BE FOUND BY SCAN 475 476 000500 4560 JMS I SCAN /GET THE FIRST ATOM 477 000501 1020 TAD ACCNUM 478 000502 7640 SZA CLA /A NUMBER? 479 000503 5761 JMP ERR5 /YES 480 000504 1534 TAD I ACUM 481 000505 7640 SZA CLA /NO - A WORD? 482 000506 5771 JMP MAIN01 /YES 483 000507 7344 NTWO /(-SLASH) 484 000510 1022 TAD DEL /NO - GET THE DELIMITER 485 000511 7450 SNA /COMMENT? 486 000512 5760 JMP END6 /YES 487 000513 1126 TAD NC6 /(-EOL) 488 000514 7450 SNA /END OF LINE? 489 000515 5266 JMP MAIN /YES - GO AGAIN 490 000516 1121 TAD NC1 491 000517 7450 SNA /END OF FILE? 492 000520 5232 JMP NEXTIN /YES - GET ANOTHER FILE 493 000521 1130 TAD NC10 /(END-COLON) 494 000522 7450 SNA /COLON? 495 000523 5757 JMP END2 /YES 496 000524 1122 TAD NC2 /(COLON-UPARR) 497 000525 7640 SZA CLA /UPARROW? 498 000526 5756 JMP ERR10 /NO - SOURCE ERROR 499 000527 1066 TAD MODECH /GET THE MODE CHANGED FLAG 500 000530 7640 SZA CLA /HAS IT? 501 000531 5336 JMP MAIN0A /YES 502 000532 2066 ISZ MODECH /NO - SO NOW IT DOES 503 000533 1036 TAD TMODE 504 000534 7040 CMA /AND COMPLEMENT THE MODE FLAG 505 000535 3036 DCA TMODE 506 000536 1036 MAIN0A, TAD TMODE / 507 000537 7650 SNA CLA /SNOBOL MODE NOW? 508 000540 5276 JMP MAIN00 /YES - GO AGAIN 509 000541 2034 ISZ CLEN /NO - BUMP THE INST LENGTH 510 000542 1014 TAD LINEP 511 000543 3030 DCA TX /GET POINTER TO UPARROW IN SOURCE 512 000544 1114 TAD C240 513 000545 3430 DCA I TX /REPLACE BY A SPACE 514 000546 5276 JMP MAIN00 /GO AGAIN 515 516 000556 4215 PAGE 000557 1641 000560 2015 000561 4205 000562 0023 000563 2235 000564 2172 000565 6000 000566 2173 000567 7377 000570 3502 000571 0600 000572 2037 000573 7661 000574 7741 000575 2176 000576 7764 000577 0067 517 /HERE IF A NAME WAS FOUND FIRST ON THE LINE 518 519 000600 1022 MAIN01, TAD DEL /GET THE DELIMITER 520 000601 1377 TAD (-COMMA /WAS IT A COMMA? 521 000602 7640 SZA CLA 522 000603 5215 JMP MAIN02 /NO 523 000604 1057 TAD LITFND 524 000605 7650 SNA CLA /WAS IT A LITERAL? 525 000606 5776 JMP ERR5 /YES - ERROR 526 000607 3775 DCA I (ACCUM+6 /STRDEL 527 000610 1135 TAD ACUMM 528 000611 4575 JMS I WRSTPO /WRITE ON PRE-OLINE 529 000612 1374 TAD (254 / 530 000613 4570 JMS I WRPOLN /AND A COMMA 531 000614 5773 JMP MAIN00 /AND GET ANOTHER ATOM 532 533 000615 1036 MAIN02, TAD TMODE 534 000616 7640 SZA CLA /PAL MODE? 535 000617 5772 JMP PALEND /YES - HANDLE PAL END OF LINE 536 537 538 / HERE WHEN WE HAVE A NAME NOT DELIMITED BY A COMMA IN SNOBOL MODE. 539 /PRESUMABLY, IF IT BEGINS WITH A PERIOD, IT IS A STANDARD SNOBOL COMMAND 540 /LINE, OTHERWISE IT IS PATTERN MATCHING OR ASSIGNMENT. 541 542 000620 1534 MAIN05, TAD I ACUM /GET FIRST CHAR OF NAME 543 000621 1371 TAD (-256 544 000622 7640 SZA CLA /PERIOD? 545 000623 5770 JMP MAIN50 /NO MUST BE ASSIGNMENT OR PATTERN MATCHING 546 000624 4563 JMS I SHACUM /SHIFT ACCUM ONE LEFT 547 000625 1367 TAD (CMDTAB /PTR TO COMMANDS TABLE 548 000626 3024 DCA T1 / 549 000627 7340 NONE /ONE INFORMATION WORD AFTER STRDEL 550 000630 3025 DCA T2 /IN THE COMMAND POOL 551 000631 1135 TAD ACUMM /POSITION OF ARGUMENT 552 553 000632 4561 JMS I SEARCH /MATCH FOUND? 554 000633 5766 JMP ERR15 /NO 555 000634 4555 JMS I RDPOOL /YES - GET VALID ARG TYPES 556 000635 7402 HLT 557 000636 3046 DCA VALID /SAVE 558 000637 1046 TAD VALID 559 000640 0365 AND (CCONTR /TEST FOR COMPILER CONTROL STA 560 000641 7640 SZA CLA /IS IT? 561 000642 5271 JMP MAIN15 /YES 562 000643 2034 ISZ CLEN /NO - BUMP OBJ LENGTH 563 000644 1364 TAD (LITJMS /"JMS I X" 564 000645 4573 JMS I WRPSO 565 000646 4550 JMS I PUTACR /PUT ACCUM TO OLINE 566 / THIS CODE HANDLES ARGUMENTS TO THE POINT COMMANDS, THIS IS DIRECTED 567 /BY THE 'VALID' CODES FOR EACH COMMAND. 568 569 000647 1046 TAD VALID 570 000650 7012 RTR /(NOARG=2) 571 000651 7630 SZL CLA /NO ARGUMENT FOR THIS COMMAND? 572 000652 5763 JMP END1 /NO - DO END OF LINE PARSE 573 000653 1022 TAD DEL /GET THE DELIMITER 574 000654 1362 TAD (-SPACE 575 000655 7640 SZA CLA /MUST BE SPACE 576 000656 5761 JMP ERR20 577 000657 4560 JMS I SCAN /GET NEXT ATOM 578 000660 1020 TAD ACCNUM 579 000661 7640 SZA CLA /NUMBER GIVEN? 580 000662 5776 JMP ERR5 /YES - BAD ARGUMENT TYPE 581 000663 1534 TAD I ACUM 582 000664 7650 SNA CLA /ANY WORD? 583 000665 5761 JMP ERR20 /NO - TOO FEW ARGUMENTS 584 000666 4550 JMS I PUTACR /YES - WRITE ACCUM AND RETURN 585 000667 2034 MAIN14, ISZ CLEN /ANOTHER WORD 586 000670 5763 JMP END1 /FINISH THE END OF LINE 587 588 589 590 /HANDLE COMPILER CONTROL STATEMENTS 591 592 000671 1046 MAIN15, TAD VALID /GET WHICH INST 593 000672 0360 AND (CPAL 594 000673 7640 SZA CLA /.PAL STATEMENT? 595 000674 5305 JMP MAIN16 /YES 596 000675 1046 TAD VALID 597 000676 0357 AND (CSNO /NO CHECK .SNOBOL COMMAND 598 000677 7640 SZA CLA 599 000700 5756 JMP MAIN20 /YES 600 000701 1355 TAD (EXITCL /EXIT CALL 601 000702 4573 JMS I WRPSO /WRITE IT 602 000703 2034 ISZ CLEN 603 000704 5267 JMP MAIN14 /FINISH PARSE 604 /.PAL COMMAND 605 606 000705 3020 MAIN16, DCA ACCNUM /ARG 607 000706 1022 TAD DEL 608 000707 7450 SNA /DELIMITER A MINUS? 609 000710 5315 JMP MAIN17 /NO 610 000711 1362 TAD (-SPACE 611 000712 7640 SZA CLA /DELIMITER A SPACE? 612 000713 5754 JMP ERR14 /NO - BAD ARGUMENT 613 000714 7340 NONE 614 615 000715 3027 MAIN17, DCA T4 /MINUS SEEN FLAG 616 000716 4542 MAIN18, JMS I GETCHR /GET NEXT CHAR 617 000717 5753 JMP ERR6 / 618 000720 1133 TAD NC260 619 000721 7510 SPA /OCTAL '0' OR ABOVE? 620 000722 5752 JMP MAI19A /NO 621 000723 1130 TAD NC10 622 000724 7500 SMA /RANGE 0 - 7? 623 000725 5751 JMP MAIN19 /NO 624 000726 1112 TAD C10 625 000727 3030 DCA TX 626 000730 1020 TAD ACCNUM /GET SUM 627 000731 7104 CLL RAL 628 000732 7104 CLL RAL 629 000733 7104 CLL RAL /SHIFT OVER 630 000734 1030 TAD TX /ADD IN CHAR 631 000735 3020 DCA ACCNUM /UPDATE 632 000736 5316 JMP MAIN18 /AND AGAIN 633 634 000751 1000 PAGE 000752 1001 000753 4207 000754 4224 000755 2417 000756 1016 000757 0200 000760 0100 000761 4240 000762 7760 000763 1621 000764 2371 000765 1700 000766 4226 000767 1600 000770 1020 000771 7522 000772 2017 000773 0476 000774 0254 000775 2167 000776 4205 000777 7756 635 /HERE WHEN LENGTH OF PAL CODE HAS BEEN ACCUMULATED 636 637 001000 1112 MAIN19, TAD C10 638 001001 1115 MAI19A, TAD C260 /RECONSTITUTE THE CHARACTER 639 001002 3070 DCA CHOLD /AND SAVE FOR EOL PARSE 640 001003 1020 TAD ACCNUM /GET VALUE 641 001004 1377 TAD (-200 642 001005 7700 SMA CLA /TOO BIG? 643 001006 5776 JMP ERR16 /YES 644 001007 1020 TAD ACCNUM /NO, GET IT AGAIN 645 001010 2027 ISZ T4 /MINUS? 646 001011 7041 CMA IAC /YES, DO IT 647 001012 3034 DCA CLEN /LENGTH OF THIS BLOCK 648 001013 7340 NONE 649 001014 3775 DCA I (MODE /CHANGE MODE 650 001015 5774 JMP ENDLIN /DO END OF LINE PARSE 651 652 653 /.SNOBOL COMMAND 654 655 001016 3775 MAIN20, DCA I (MODE /SNOBOL MODE 656 001017 5773 JMP END1 /PARSE EOL 657 /ASSIGNMENT OR PATTERN MATCHING 658 659 660 001020 7301 MAIN50, ONE /(VARORLIT) ARGUMENT TYPES ALLOWED 661 001021 3046 DCA VALID 662 001022 3060 DCA EQLSEN /EQUAL NOT SEEN YET 663 001023 1022 TAD DEL /GET DELIMITER 664 001024 1372 TAD (-EQUAL 665 001025 7650 SNA CLA /ASSIGNMENT? 666 001026 5771 JMP MAIN70 /YES 667 001027 3033 DCA ARGCNT /CLEAR ARGUMENT COUNT 668 001030 1370 TAD (PATCAL /PATTERN MATCH INITIALIZATION 669 001031 4573 JMS I WRPSO /WRITE IT 670 001032 1120 TAD SARG 671 001033 4567 JMS I WROLIN /PUT ARGCNT SUBSTITUTE 672 001034 1022 TAD DEL 673 001035 1131 TAD NC12 /(-BACK) 674 001036 7640 SZA CLA /BACKARROW? (ANCHOR MODE) 675 001037 5243 JMP MAIN51 /NO 676 001040 1367 TAD (NCMDF /FLAG ANCHOR MODE 677 001041 4573 JMS I WRPSO / 678 001042 5244 JMP MAIN52 679 680 001043 4556 MAIN51, JMS I RETORN /PUT CARRAIGE RETURN 681 001044 4550 MAIN52, JMS I PUTACR /PUT ACCUM (BASE VARIABLE) 682 001045 7325 THREE 683 001046 1034 TAD CLEN 684 001047 3034 DCA CLEN /UPDATE LENGTH 685 001050 7346 NTHREE /(-STAR) 686 001051 1022 TAD DEL /TEST LEGAL DELIMITERS 687 001052 7450 SNA 688 001053 5766 JMP MAIN59 /DO FILLER 689 001054 1127 TAD NC7 /(STAR-BACK) 690 001055 7450 SNA /BACKARROW? 691 001056 5265 JMP MAIN53 /YES 692 001057 1365 TAD (BACK-EQUAL 693 001060 7450 SNA /AN EQUAL SIGN? 694 001061 5764 JMP MAIN5A /YES 695 001062 1365 TAD (EQUAL-SPACE 696 001063 7640 SZA CLA /SPACE? 697 001064 5763 JMP ERR14 /NO - SYNTAX ERROR 698 /MAIN PATTERN MATCHING PARSING LOOP 699 700 001065 7301 MAIN53, ONE /(VAROLIT) 701 001066 3046 DCA VALID 702 001067 4560 JMS I SCAN /GET NEXT ATOM 703 001070 1020 TAD ACCNUM 704 001071 7640 SZA CLA /ACCUMULATED NUMBER? 705 001072 5762 JMP ERR5 /YES - ERROR 706 001073 1534 MAIN5B, TAD I ACUM / 707 001074 7640 SZA CLA /ACCUMULATED ATOM? 708 001075 5761 JMP MAIN56 /YES 709 001076 5303 JMP MAIN55 /NO TEST DELIMITERS 710 711 001077 1022 MAIN54, TAD DEL 712 001100 1360 TAD (-OR /"!" 713 001101 7650 SNA CLA /? 714 001102 5757 JMP MAIN57 /YES 715 716 001103 7344 MAIN55, NTWO /(-SLASH) 717 001104 1022 TAD DEL 718 001105 7450 SNA /COMMENT? 719 001106 5756 JMP END6 720 001107 1121 TAD NC1 /(SLASH-STAR) 721 001110 7450 SNA /IS IT A FILLER? 722 001111 5766 JMP MAIN59 /YES 723 001112 1125 TAD NC5 /(-STAR-EOL) 724 001113 7450 SNA /END OF LINE? 725 001114 5554 JMP I PUTOUT /YES - FINISH UP 726 001115 1121 TAD NC1 /(EOL-END) 727 001116 7450 SNA /END OF FILE? 728 001117 5554 JMP I PUTOUT 729 001120 1365 TAD (END-LESS 730 001121 7450 SNA /FENCE (<) ? 731 001122 5755 JMP MAIN58 /YES 732 001123 1121 TAD NC1 /(LESS-EQUAL) 733 001124 7450 SNA /EQUAL SIGN? 734 001125 5764 JMP MAIN5A /YES 735 001126 1365 TAD (-3 /(EQUAL-SPACE) 736 001127 7450 SNA /SPACE? 737 001130 5265 JMP MAIN53 /YES, GO AGAIN 738 001131 1121 TAD NC1 /(SPACE-COLON) 739 001132 7650 SNA CLA /COLON? 740 001133 5754 JMP END2 /YES 741 001134 5763 JMP ERR14 /NO - BAD DELIMITER 742 743 001154 1641 PAGE 001155 1223 001156 2015 001157 1204 001160 7762 001161 1200 001162 4205 001163 4224 001164 1231 001165 7775 001166 1243 001167 2407 001170 2565 001171 1403 001172 7763 001173 1621 001174 1616 001175 2235 001176 4230 001177 7600 744 /HANDLE ACCUMULATED NAME 745 746 001200 2034 MAIN56, ISZ CLEN /INST LENGTH 747 001201 2033 ISZ ARGCNT /ARGUMENT COUNT 748 001202 4550 JMS I PUTACR /PUT ACCUM 749 001203 5777 JMP MAIN54 /AND CONTINUE 750 751 752 /HANDLE OR 753 754 001204 2060 MAIN57, ISZ EQLSEN /EQUAL SIGN SEEN? 755 001205 7410 SKP /NO 756 001206 5776 JMP ERR17 /YES - ERROR 757 001207 1534 TAD I ACUM 758 001210 7650 SNA CLA /WAS THIS PRECEDED BY AN ARG? 759 001211 5775 JMP ERR18 /NO 760 001212 2034 ISZ CLEN 761 001213 2033 ISZ ARGCNT 762 001214 1374 TAD (ORCODE 763 001215 4573 JMS I WRPSO /WRITE AN OR CODE 764 001216 4560 JMS I SCAN /GET NEXT 765 001217 1534 TAD I ACUM 766 001220 7650 SNA CLA /AN ARG HERE TOO? 767 001221 5775 JMP ERR18 /NO - ERROR 768 001222 5200 JMP MAIN56 /YES DO IT 769 770 /HANDLE THE FENCE 771 772 001223 2060 MAIN58, ISZ EQLSEN /EQUAL SIGN SEEN? 773 001224 7410 SKP 774 001225 5776 JMP ERR17 /YES 775 001226 1373 TAD (FCODE /FENCE CODE 776 001227 4573 JMS I WRPSO /PUT IT 777 001230 5240 JMP MAIN5R /DONE 778 779 780 /HANDLE AN EQUAL SIGN 781 782 001231 2060 MAIN5A, ISZ EQLSEN /EQUAL ALREADY SEEN? 783 001232 7410 SKP 784 001233 5776 JMP ERR17 /YES 785 001234 1372 TAD (EQUALC /EQUAL CODE 786 001235 4573 JMS I WRPSO /PUT 787 001236 7340 NONE 788 001237 3060 DCA EQLSEN /SET FLAG 789 001240 2033 MAIN5R, ISZ ARGCNT 790 001241 2034 ISZ CLEN 791 001242 5771 JMP MAIN53 /GO 792 /HANDLE A FILLER 793 794 001243 2060 MAIN59, ISZ EQLSEN /EQUAL SEEN? 795 001244 7410 SKP 796 001245 5776 JMP ERR17 797 001246 2033 ISZ ARGCNT 798 001247 2033 ISZ ARGCNT /UPDATE THE ARGUMENT COUNT 799 001250 2034 ISZ CLEN 800 001251 2034 ISZ CLEN /AND THE INST LENGTH 801 001252 1370 TAD (VAR 802 001253 3046 DCA VALID /VALID TYPE TO BE FOUND BY SCAN 803 804 001254 4560 JMS I SCAN /GET THE FILLER VAR NAME 805 001255 1367 TAD (FILLER 806 001256 4573 JMS I WRPSO /GET THE BEGINNING FILLER CODE 807 001257 4562 JMS I SAVACM /SAVE ACCUM 808 809 001260 1022 TAD DEL 810 001261 1366 TAD (-STAR 811 001262 7450 SNA /ARBITRARY LENGTH FILLER? 812 001263 5321 JMP MAIN62 /YES 813 001264 7001 IAC 814 001265 7640 SZA CLA /SLASH? 815 001266 5765 JMP ERR14 /NO - ERROR 816 001267 7301 ONE /(VARORLIT) 817 001270 3046 DCA VALID /ARG TYPE 818 001271 4560 JMS I SCAN /GET LENGTH 819 001272 1022 TAD DEL 820 001273 1366 TAD (-STAR 821 001274 7640 SZA CLA /MUST BE MATCHING STAR 822 001275 5765 JMP ERR14 /NO 823 001276 1020 TAD ACCNUM 824 001277 7450 SNA /SPECIFIC NUMBER? 825 001300 5335 JMP MAIN63 /NO 826 001301 7106 CLL RTL; RAL /SHIFT ONE OCTAL DIGIT UP 001302 7004 827 001303 3024 DCA T1 828 001304 7346 NTHREE /COUNT 829 001305 3025 DCA T2 830 /DECODE FILLER LENGTH 831 832 001306 1024 MAIN61, TAD T1 833 001307 7006 RTL; RAL /SHIFT LEFT ONE DIGIT 001310 7004 834 001311 3024 DCA T1 /UPDATE T1 835 001312 1024 TAD T1 836 001313 7004 RAL /SHIFT LEFTMOST DIGIT AROUND 837 001314 0111 AND C7 838 001315 1115 TAD C260 /TURN DIGIT INTO CHAR 839 001316 4567 JMS I WROLIN /WRITE IT 840 001317 2025 ISZ T2 841 001320 5306 JMP MAIN61 /NOT YET 842 843 001321 1364 MAIN62, TAD (FILEND 844 001322 4573 JMS I WRPSO /WRITE FILLER END 845 846 001323 1064 MAIN64, TAD ACMIND 847 001324 7640 SZA CLA /INDIRECT? 848 001325 4556 JMS I RETORN /YES - PUT RETURN FIRST 849 001326 1763 TAD I (SACCUM /TEST FOR NULL NAME 850 001327 7650 SNA CLA 851 001330 5762 JMP MAIN65 852 001331 1361 TAD (SACCUM-1 /PUT THE VARAIBLE NAME 853 001332 4577 JMS I WRSTRO 854 001333 4556 MAIN66, JMS I RETORN /PUT A RETURN 855 001334 5240 JMP MAIN5R /UPDATE ARGCNT, CLEN AND GO AGAIN 856 /MAKE XASC CALL FOR VARIABLE FILLER LENGTH 857 858 001335 4546 MAIN63, JMS I MAKASC /MAKE ASC CALL 859 001336 1360 TAD (SHFT3 860 001337 4572 JMS I WRPPSO /WRITE A SHIFT 861 001340 1357 TAD (DCAGVC-1 862 001341 4575 JMS I WRSTPO /WRITE THE STORE 863 001342 4556 JMS I RETORN /PUT RETURN 864 001343 1756 TAD I (DCAGV /GET FINISHING LITERAL 865 001344 4567 JMS I WROLIN /PUT IT 866 001345 1355 TAD (STOR 867 001346 4573 JMS I WRPSO /PUT STORAGE FOR IT 868 001347 7307 FOUR 869 001350 1034 TAD CLEN 870 001351 3034 DCA CLEN /UPDATE THE LENGTH OF THE INST 871 001352 5323 JMP MAIN64 /GO 872 873 001355 2515 PAGE 001356 2260 001357 2251 001360 2455 001361 2216 001362 1400 001363 2217 001364 2415 001365 4224 001366 7775 001367 2561 001370 0020 001371 1065 001372 2437 001373 2501 001374 2431 001375 4234 001376 4232 001377 1077 874 875 001400 1115 MAIN65, TAD C260 /NULL NAME - PUT A ZERO 876 001401 4567 JMS I WROLIN 877 001402 5777 JMP MAIN66 878 /HANDLE SIMPLE ASSIGNMENT STATEMENTS - EITHER PATTERN MATCHING 879 /OR ARITHMETIC 880 881 882 001403 4562 MAIN70, JMS I SAVACM /SAVE ACCUM 883 001404 7301 ONE 884 001405 3023 DCA LAST /LAST DELIMITER SEEN (1 = ADD) 885 886 001406 4560 JMS I SCAN /GET NEXT ATOM 887 001407 1376 TAD (ARGENV-1 /ARITH GEN VAR TABLE 888 001410 3015 DCA AGVPTR /PTR 889 001411 1130 TAD NC10 890 001412 3050 DCA AGVCNT /COUNT 891 001413 1022 TAD DEL /GET THE DELIMITER 892 001414 7450 SNA /SUBTRACTION? 893 001415 5245 JMP MAIN74 /YES 894 001416 1121 TAD NC1 895 001417 7650 SNA CLA /ADDITION? 896 001420 5245 JMP MAIN74 /YES 897 001421 1020 TAD ACCNUM 898 001422 7640 SZA CLA /NO, ANY ACCUMULATED NUMBER? 899 001423 5775 JMP ERR5 /YES - ERROR 900 001424 1374 TAD (PATCAL 901 001425 4573 JMS I WRPSO /WRITE PATTERN HEADER 902 001426 1120 TAD SARG 903 001427 4567 JMS I WROLIN /ARGCNT SUBSTITUTE 904 001430 4556 JMS I RETORN /RETURN 905 001431 1373 TAD (SACCUM-1 906 001432 4577 JMS I WRSTRO /PUT BASE VARIABLE 907 001433 4556 JMS I RETORN 908 001434 1372 TAD (EQUALC 909 001435 4573 JMS I WRPSO /WRITE EQUAL CODE 910 001436 7301 ONE 911 001437 3033 DCA ARGCNT /SET THE ARG LENGTH COUNT 912 001440 7307 FOUR 913 001441 1034 TAD CLEN 914 001442 3034 DCA CLEN 915 001443 5771 JMP MAIN5B /HANDLE NAME 916 /HANDLE ARITHMETIC ASSIGNMENT STATEMENTS 917 918 919 001444 4560 MAIN73, JMS I SCAN /GET NEXT ATOM 920 001445 1020 MAIN74, TAD ACCNUM 921 001446 7640 SZA CLA /CONSTANT? 922 001447 5310 JMP MAIN77 /YES 923 001450 1534 TAD I ACUM 924 001451 7650 SNA CLA /VAR GIVEN? 925 001452 5277 JMP MAIN75 /NO 926 001453 4546 JMS I MAKASC /WRITE A CALL TO ASC 927 001454 1023 TAD LAST 928 001455 7640 SZA CLA /NEGATIVE OF THIS NAME? 929 001456 5262 JMP MAIN7A 930 001457 1370 TAD (COMPC 931 001460 4572 JMS I WRPPSO /YES - WRITE COMPLEMENT 932 001461 2034 ISZ CLEN 933 001462 1367 MAIN7A, TAD (DCAGVC-1 934 001463 4575 JMS I WRSTPO /WRITE A STORE 935 001464 2034 ISZ CLEN 936 001465 1766 TAD I (DCAGV /GET LIT 937 001466 2050 ISZ AGVCNT /LIT OVERFLOW? 938 001467 7410 SKP 939 001470 5765 JMP ERR25 /YES 940 001471 3415 DCA I AGVPTR /NO - PUT INTO LIST 941 001472 1766 TAD I (DCAGV /GET GEN'ED LIT 942 001473 3764 DCA I (TADGV 943 001474 1363 TAD (TADCON-1 /DO A TAD OF IT 944 001475 4577 JMS I WRSTRO / 945 001476 2034 ISZ CLEN 946 /HANDLE NEXT DELIMITER 947 948 001477 1022 MAIN75, TAD DEL 949 001500 7450 SNA /MINUS? 950 001501 5306 JMP MAIN76 /YES 951 001502 1121 TAD NC1 952 001503 7640 SZA CLA /NO, ADDITION? 953 001504 5330 JMP MAIN79 /NO, FINISH UP 954 001505 7301 ONE /YES 955 956 001506 3023 MAIN76, DCA LAST /UPDATE LAST DELIMITER 957 001507 5244 JMP MAIN73 /AND GO AGAIN 958 959 960 /HANDLE CONSTANT 961 962 001510 3764 MAIN77, DCA I (TADGV /NO GENERATED LITERAL 963 001511 1363 TAD (TADCON-1 / 964 001512 4577 JMS I WRSTRO /WRITE TAD 965 001513 1362 TAD ("( 966 001514 4567 JMS I WROLIN /PUT CONSTANT 967 001515 2034 ISZ CLEN 968 001516 2034 ISZ CLEN /INST LENGTH 969 001517 1023 TAD LAST /GET LAST DELIM 970 001520 7640 SZA CLA /SUBTRACTION? 971 001521 5324 JMP MAIN78 /NO 972 001522 1361 TAD ("- /YES 973 001523 4567 JMS I WROLIN /PUT A MINUS 974 975 001524 1020 MAIN78, TAD ACCNUM /GET THE CONST 976 001525 4566 JMS I WROCO /WRITE IT 977 001526 4556 JMS I RETORN 978 001527 5277 JMP MAIN75 /GO 979 /FINISH UP AFTER ARITHMETIC ASSIGNMENT 980 981 001530 1360 MAIN79, TAD (LITJMS /INT CALL 982 001531 4573 JMS I WRPSO /WRITE IT 983 001532 1357 TAD (XINT 984 001533 4573 JMS I WRPSO 985 001534 1373 TAD (SACCUM-1 986 001535 4577 JMS I WRSTRO /WRITE THE BASE VAR 987 001536 4556 JMS I RETORN 988 001537 2034 ISZ CLEN 989 001540 2034 ISZ CLEN 990 001541 1112 TAD C10 991 001542 1050 TAD AGVCNT /ANY GENED LITS FOR THIS STA? 992 001543 7450 SNA 993 001544 5756 JMP END1 /NO - PROCEED 994 001545 7041 CMA IAC /YES 995 001546 3050 DCA AGVCNT /SAVE NEG COUNT 996 001547 1376 TAD (ARGENV-1 /PTR TO TABLE 997 001550 3015 DCA AGVPTR / 998 001551 1355 TAD (JMPCAL 999 001552 4573 JMS I WRPSO /JUMP AROUND LITS 1000 1001 001553 5754 JMP I (.&7600+200 /***PAGE BOUNDS 1002 001554 1600 PAGE 001555 2507 001556 1621 001557 2403 001560 2371 001561 0255 001562 0250 001563 2263 001564 2270 001565 4253 001566 2260 001567 2251 001570 2445 001571 1073 001572 2437 001573 2216 001574 2565 001575 4205 001576 2206 001577 1333 1003 1004 001600 1050 TAD AGVCNT 1005 001601 7041 CMA IAC; IAC / 001602 7001 1006 001603 4566 JMS I WROCO /DISTANCE 1007 001604 4556 JMS I RETORN 1008 001605 2034 ISZ CLEN 1009 1010 001606 1415 MAIN80, TAD I AGVPTR /GET NEXT 1011 001607 4567 JMS I WROLIN /WRITE VAR 1012 001610 1377 TAD (STOR 1013 001611 4573 JMS I WRPSO /WRITE STORAGE 1014 001612 2034 ISZ CLEN 1015 001613 2050 ISZ AGVCNT /DONE? 1016 001614 5206 JMP MAIN80 /NO 1017 001615 5221 JMP END1 /YES 1018 /THIS ROUTINE HANDLES THE END OF LINE PARSING. FROM THE INPUT 1019 /CURSOR ON TO THE END OF THE LINE SHOULD BE ONLY (AT THE 1020 /MOST) A TRANSFER SPECIFICATION, OR A COMMENT FIELD. 1021 1022 1023 001616 7305 ENDLIN, TWO /(NOARG) 1024 001617 3046 DCA VALID /AN ARGUMENT IS ILLEGAL 1025 001620 4560 JMS I SCAN /GET THE NEXT ATOM 1026 1027 001621 7344 END1, NTWO /(-SLASH) 1028 001622 1022 TAD DEL /GET THE DELIMITER 1029 001623 7450 SNA /COMMENT? 1030 001624 5776 JMP END6 /YES 1031 001625 1126 TAD NC6 /(SLASH-EOL) 1032 001626 7450 SNA /END OF LINE? 1033 001627 5554 JMP I PUTOUT /YES - PUT OUTPUT LINE 1034 001630 1121 TAD NC1 1035 001631 7450 SNA /END OF FILE? 1036 001632 5554 JMP I PUTOUT /YES 1037 001633 1127 TAD NC7 /(END-SPACE) 1038 001634 7450 SNA /SPACE? 1039 001635 5216 JMP ENDLIN /YES - TRY AGAIN 1040 001636 1121 TAD NC1 /(-COLON) 1041 001637 7640 SZA CLA /COLON (TRANSFER)? 1042 001640 5775 JMP ERR14 /NO 1043 1044 001641 2062 END2, ISZ TRASEN /TRANSFER ALREADY SEEN? 1045 001642 5774 JMP ERR19 /YES - ERROR 1046 001643 4542 JMS I GETCHR /GET THE NEXT CHAR 1047 001644 5773 JMP ERR6 1048 001645 3023 DCA LAST /SAVE IT 1049 001646 1023 TAD LAST 1050 001647 1372 TAD (-"( /OPEN PARENTHESIS? 1051 001650 7450 SNA /I.E. UNCONDITIONAL TRANSFER? 1052 001651 5277 JMP END4 /YES 1053 001652 1371 TAD (-36 /(-"F) 1054 001653 7450 SNA /FAIL CONDITION? 1055 001654 5261 JMP END3 1056 001655 1370 TAD (-15 /NO - -"S 1057 001656 7640 SZA CLA /MUST BE SUCCESS CONDITION 1058 001657 5767 JMP ERR10 1059 001660 1366 TAD ("N-"Z 1060 001661 1365 END3, TAD ("Z 1061 001662 3764 DCA I (TESTQ /PUT CONDITION IN TEST 1062 001663 7305 TWO /(NOARG) 1063 001664 3046 DCA VALID /VALID TYPE 1064 1065 001665 4560 JMS I SCAN /GET THE NEXT 1066 001666 1022 TAD DEL 1067 001667 1126 TAD NC6 /(-LPAREN) 1068 001670 7640 SZA CLA /NOW MUST BE OPEN PAREN 1069 001671 5775 JMP ERR14 1070 001672 1363 TAD (TESTSF-1 1071 001673 4577 JMS I WRSTRO /WRITE TEST 1072 001674 2034 ISZ CLEN 1073 001675 2034 ISZ CLEN 1074 001676 5300 JMP END4+1 1075 1076 1077 /PARSE LABEL PART OF TRANSFER FIELD 1078 1079 001677 3023 END4, DCA LAST /UNCONDITIONAL 1080 001700 1362 TAD (JMPTR+LABEL / 1081 001701 3046 DCA VALID /FIND LABEL 1082 1083 001702 4560 JMS I SCAN /GET NAME 1084 001703 1534 TAD I ACUM 1085 001704 7650 SNA CLA /ANY? 1086 001705 5761 JMP ERR20 /NO 1087 001706 1022 TAD DEL 1088 001707 1124 TAD NC4 /(-RPAREN) 1089 001710 7640 SZA CLA /MUST BE CLOSE 1090 001711 5775 JMP ERR14 1091 001712 1360 TAD (JMPLAB 1092 001713 4573 JMS I WRPSO /WRITE JMP 1093 001714 4550 JMS I PUTACR /PUT ACCUM 1094 001715 1064 TAD ACMIND 1095 001716 7650 SNA CLA /IS ACCUM INDIRECT? 1096 001717 5326 JMP END7 /NO 1097 001720 1023 TAD LAST /GET TRANSFER CONDITION 1098 001721 7640 SZA CLA /MUST BE UNCONDITIONAL 1099 001722 5757 JMP ERR11 1100 001723 1377 TAD (STOR /STORAGE DEFINITION 1101 001724 4573 JMS I WRPSO /WRITE IT 1102 001725 5326 JMP END7 1103 001726 2034 END7, ISZ CLEN 1104 001727 2034 ISZ CLEN /BUMP INST LENGTH CNT 1105 001730 4542 JMS I GETCHR /GET NEXT 1106 001731 5554 JMP I PUTOUT 1107 001732 3024 DCA T1 1108 001733 1024 TAD T1 1109 001734 1356 TAD (-"F /FAIL NOW? 1110 001735 7450 SNA 1111 001736 5755 JMP END5 /YES 1112 001737 1370 TAD (-15 1113 001740 7650 SNA CLA /SUCCESS? 1114 001741 5755 JMP END5 1115 001742 1024 TAD T1 /NO - 1116 001743 3070 DCA CHOLD /SAVE THE CHARACTER 1117 001744 5216 JMP ENDLIN /AND PROCESS IT 1118 1119 001755 2000 PAGE 001756 7472 001757 4220 001760 2525 001761 4240 001762 0014 001763 2273 001764 2312 001765 0332 001766 7764 001767 4215 001770 7763 001771 7742 001772 7530 001773 4207 001774 4236 001775 4224 001776 2015 001777 2515 1120 1121 002000 1023 END5, TAD LAST 1122 002001 7450 SNA /UNCONDITIONAL BEFORE? 1123 002002 5777 JMP ERR19 /YES 1124 002003 7041 CMA IAC 1125 002004 1024 TAD T1 /SAME CONDITION? 1126 002005 7650 SNA CLA 1127 002006 5776 JMP ERR22 /YES 1128 002007 4542 JMS I GETCHR /GET THE PAREN 1129 002010 5775 JMP ERR6 /NO 1130 002011 1374 TAD (-"( 1131 002012 7640 SZA CLA /MUST BE 1132 002013 5773 JMP ERR14 /NOT 1133 002014 5772 JMP END4 /DO THAT LABEL 1134 1135 /COMMENT - SCAN UNTIL THE END OF THE LINE IS READ 1136 1137 002015 4541 END6, JMS I ENDRD /READ THROUGH END OF LINE 1138 002016 5554 JMP I PUTOUT 1139 /tHIS ROUTINE HANDLES THE END OF LINE ACTION FOR PAL MODE STATEMENTS 1140 1141 1142 002017 1066 PALEND, TAD MODECH 1143 002020 7650 SNA CLA /DID THE MODE CHANGE? 1144 002021 5235 JMP PALEN2 /NO 1145 002022 1371 TAD ("/ 1146 002023 4570 JMS I WRPOLN /YES - NOTE A COMMENT 1147 002024 1034 TAD CLEN 1148 002025 7041 CMA IAC 1149 002026 3024 DCA T1 /SAVE THE CoUNT OF WORDS 1150 1151 002027 1370 PALEN1, TAD ("^ /WRITE ENOUGH UPARROWS 1152 002030 4570 JMS I WRPOLN 1153 002031 2024 ISZ T1 1154 002032 5227 JMP PALEN1 1155 1156 002033 1367 TAD (RETURN-1 1157 002034 4575 JMS I WRSTPO /PUT A RETURN AFTER THEM 1158 1159 /NOW wRITE THE PAL LINE 1160 1161 002035 1135 PALEN2, TAD ACUMM 1162 002036 4577 JMS I WRSTRO /PUT ACCUM TO OLINE 1163 002037 1366 TAD (1-LINEIM 1164 002040 1014 TAD LINEP 1165 002041 7650 SNA CLA /IS THE LINE ALREADY FINISHED? 1166 002042 5257 JMP PALEN4 /YES 1167 002043 1114 TAD C240 /PUT AN EXTRA SPACE 1168 002044 4567 JMS I WROLIN 1169 002045 1765 TAD I (CDEL /GET DELIMITER 1170 002046 4567 JMS I WROLIN /PUT IT AFTER ACCUM 1171 1172 002047 4542 PALEN3, JMS I GETCHR /GeT tHE NEXT CHARACTER 1173 002050 5554 JMP I PUTOUT 1174 002051 1132 TAD NC212 1175 002052 7450 SNA /END OF LINE? 1176 002053 5257 JMP PALEN4 1177 002054 1364 TAD (212 /NO - RESTORE THE CHARACTER 1178 002055 4567 JMS I WROLIN /AND WRITE IT 1179 002056 5247 JMP PALEN3 1180 1181 002057 1367 PALEN4, TAD (RETURN-1 1182 002060 4577 JMS I WRSTRO /PUT FINAL RETURN 1183 002061 5554 JMP I PUTOUT 1184 1185 002164 0212 PAGE 002165 2176 002166 5741 002167 2246 002170 0336 002171 0257 002172 1677 002173 4224 002174 7530 002175 4207 002176 4242 002177 4236 1186 /HERE TO WRITE OUT POLINE AND OLINE AND SETUP FOR THE NEXT STATEMENT. 1187 1188 002200 7300 PTOUT, ZERO 1189 002201 1377 TAD (-176 1190 002202 1035 TAD PAGLEN /WILL THIS INST FIT ON THIS PAGE? 1191 002203 1034 TAD CLEN /GET SUM OF SIZES 1192 002204 7710 SPA CLA /? 1193 002205 5216 JMP PUT0 /YES - GO AHEAD 1194 002206 1376 TAD (PAGJMP /JMP CODE 1195 002207 4574 JMS I WRPS /WRITE DIRECTLY ONTO OUTPUT 1196 002210 2076 ISZ PAGLIT 1197 002211 1076 TAD PAGLIT /GET A NEW PAGE LITERAL 1198 002212 4553 JMS I PUTOC /PUT THE NUMBER 1199 002213 1375 TAD (PAGFIN /FINISH INFO 1200 002214 4574 JMS I WRPS /PUT IT 1201 002215 3035 DCA PAGLEN /ZERO NEW PAGE LENGTH 1202 1203 002216 1034 PUT0, TAD CLEN 1204 002217 1035 TAD PAGLEN /GET NEW PAGE SIZE 1205 002220 3035 DCA PAGLEN /AND SAVE 1206 002221 1036 TAD TMODE 1207 002222 7640 SZA CLA /PAL MODE? 1208 002223 5231 JMP PUT7 /YES - DON'T PUT SOURCE 1209 002224 1374 TAD ("/ 1210 002225 4551 JMS I PUTCHR /COMMENT OUT THE LINE 1211 002226 4773 JMS I (PLINE /PUT SOURCE LINE ONTO OUTPUT 1212 002227 1372 TAD (RETURN-1 1213 002230 4576 JMS I WRSTR /PUT EOL 1214 002231 7340 PUT7, NONE 1215 002232 3063 DCA OUTF /OLINE NOT PUT YET 1216 002233 7346 NTHREE 1217 002234 3502 DCA I COLINE /CLOSE OLINE 1218 002235 7346 NTHREE 1219 002236 3503 DCA I CPOLINE /AND POLINE 1220 002237 1771 TAD I (POLINE /PRE-OUT FIRST 1221 002240 7450 SNA 1222 002241 5271 JMP PUT4 /EMPTY - SKIP IT 1223 /DO TRANSFER FROM THE OUTPUT POOLS TO OUTPUT 1224 1225 002242 3024 PUT1, DCA T1 1226 002243 4555 PUT2, JMS I RDPOOL /READ FROM POOL 1227 002244 5271 JMP PUT4 /DONE 1228 002245 3025 DCA T2 1229 002246 1025 TAD T2 1230 002247 0120 AND SARG /SUBSTITUTE? 1231 002250 7640 SZA CLA 1232 002251 5255 JMP PUT3 /YES 1233 002252 1025 TAD T2 1234 002253 4551 JMS I PUTCHR /NO - WRITE IT 1235 002254 5243 JMP PUT2 /AND AGAIN 1236 1237 002255 1025 PUT3, TAD T2 /GET ARG 1238 002256 1120 TAD SARG / 1239 002257 7650 SNA CLA /ARGCNT SUBSTITUTE? 1240 002260 5307 JMP PUT6 /YES 1241 002261 1370 TAD ("X /NO - SUBSTITUTE "XL" 1242 002262 4551 JMS I PUTCHR 1243 002263 1367 TAD ("L 1244 002264 4551 JMS I PUTCHR /PUT THEM 1245 002265 1025 TAD T2 1246 002266 1120 TAD SARG /SUBTRACT SARG 1247 002267 4553 JMS I PUTOC /PUT IT 1248 002270 5243 JMP PUT2 /AND AGAIN 1249 1250 002271 2063 PUT4, ISZ OUTF /OLINE DONE YET? 1251 002272 5276 JMP PUT5 /YES 1252 002273 1766 TAD I (OLINE /NO - USE IT 1253 002274 7440 SZA 1254 002275 5242 JMP PUT1 /GO 1255 1256 002276 1771 PUT5, TAD I (POLINE 1257 002277 4540 JMS I DELPOL /DELETE POLINE 1258 002300 3771 DCA I (POLINE /DELETE PTR 1259 002301 3103 DCA CPOLINE 1260 002302 1766 TAD I (OLINE 1261 002303 4540 JMS I DELPOL /AND OLINE 1262 002304 3766 DCA I (OLINE /AND THE PTR 1263 002305 3102 DCA COLINE 1264 002306 5765 JMP MAIN /AND NEXT LINE 1265 1266 002307 1033 PUT6, TAD ARGCNT /SUBSTITUTE ARGCNT - GET IT 1267 002310 4553 JMS I PUTOC /WRITE IT 1268 002311 5243 JMP PUT2 /AND AGAIN 1269 1270 002365 0466 PAGE 002366 2227 002367 0314 002370 0330 002371 2230 002372 2246 002373 4421 002374 0257 002375 2555 002376 2531 002377 7602 1271 / THIS ROUTINE HAS THE RESPONSIBILITY OF PERFORMING PRIMARY PARSING 1272 /OF THE INPUT FILE. ON A CALL TO SCAN, THE INPUT LINE IS READ UNTIL 1273 /A DELIMITER IS FOUND. ANY IDENTIFIER IS STORED IN ACCUM, ANY NUMBER 1274 /ACCUMULATION IS PERFORMED AND STORED INTO ACCNUM. IF THE DELIMITER 1275 /IS A SPACE, SCAN WILL SEARCH FOR THE NEXT DELIMITER AFTER THAT, IF 1276 /NONE, THEN SPACE IS RETURNED AS THE DELIMITER. ARGUMENT ACCUMULA- 1277 /TION IS GUIDED BY THE CODE CONTAINED IN LOCATION VALID. 1278 1279 1280 1281 002400 7300 ZERO /CLEAR AC VIA SCANNR-2 1282 002401 5602 JMP I SCANNR /RETURN VIA SCANNR-1 1283 002402 0000 SCANNR, 0 1284 002403 3064 DCA ACMIND /CLEAR ACCUM IS INDIRECT FLAG 1285 002404 3061 DCA LABELF /CLEAR LABEL FLAG 1286 002405 3065 DCA PTATOM /CLEAR "THIS IS" .A ATOM FLAG 1287 002406 3020 DCA ACCNUM /CLEAR ACCUMULATED NUMBER 1288 002407 3022 DCA DEL /CLEAR DEL 1289 002410 3057 DCA LITFND /LITERAL FOUND FLAG 1290 002411 1130 TAD NC10 1291 002412 3026 DCA T3 /COUNT FOR ACCUM 1292 002413 1135 TAD ACUMM 1293 002414 3011 DCA INDEX1 /SETUP PTR 1294 002415 1135 TAD ACUMM 1295 002416 3017 DCA INDEX7 1296 002417 1130 TAD NC10 1297 002420 3030 DCA TX 1298 002421 3417 DCA I INDEX7 /CLEAR ACCUM 1299 002422 2030 ISZ TX 1300 002423 5221 JMP .-2 /ALL OF IT 1301 1302 002424 1377 SCAN00, TAD (DELST-1 1303 002425 3016 DCA INDEX6 /PTR TO DELIMITERS 1304 002426 4542 JMS I GETCHR /GET NEXT CHAR 1305 002427 5362 JMP SCAN08 1306 002430 3027 DCA T4 1307 002431 1027 TAD T4 1308 002432 1376 TAD (-"" 1309 002433 7450 SNA /DOUBLE QUOTE? 1310 002434 5775 JMP SCAN09 /YES 1311 002435 1125 TAD NC5 /' 1312 002436 7650 SNA CLA /SINGLE? 1313 002437 5775 JMP SCAN09 /YES 1314 1315 002440 1027 SCAN01, TAD T4 /GET CHAR AGAIN 1316 002441 1416 TAD I INDEX6 /GET NEGATIVE DELIMITER 1317 002442 7650 SNA CLA /MATCH? 1318 002443 5327 JMP SCAN06 /YES 1319 002444 1416 TAD I INDEX6 /GET THE DELIMETER CODE 1320 002445 7640 SZA CLA /NULL? 1321 002446 5240 JMP SCAN01 /NO - TRY NEXT 1322 002447 1022 TAD DEL /GET DELIMITER 1323 002450 7650 SNA CLA /ALREADY FOUND? 1324 002451 5255 JMP SCAN02 /NO 1325 002452 1027 TAD T4 /YES, HOLD THIS CHARACTER 1326 002453 3070 DCA CHOLD 1327 002454 5352 JMP SCAN07 /AND DONE 1328 1329 002455 1057 SCAN02, TAD LITFND /LITERAL FOUND ALREADY? 1330 002456 7640 SZA CLA 1331 002457 5322 JMP SCAN05 /YES 1332 002460 1534 TAD I ACUM 1333 002461 7640 SZA CLA /NAME ACCUMULATED? 1334 002462 5313 JMP SCAN04 /YES 1335 002463 1027 TAD T4 /NO, GET CHAR 1336 002464 1133 TAD NC260 1337 002465 7510 SPA /BELOW "0"? 1338 002466 5307 JMP SCAN03 /YES, NOT NUMBER 1339 002467 1131 TAD NC12 / 1340 002470 7500 SMA /DIGIT? 1341 002471 5307 JMP SCAN03 /NO 1342 002472 1113 TAD C12 /YES - GET BACK NUMBER 1343 002473 3030 DCA TX /SAVE IT 1344 002474 1036 TAD TMODE 1345 002475 7640 SZA CLA /sNOBOL MODE? 1346 002476 5313 JMP SCAN04 /NO - DON'T CONVERT THE NUMBER 1347 002477 1131 TAD NC12 /DECIMAL -10 1348 002500 3024 DCA T1 /COUNT 1349 002501 1020 TAD ACCNUM /GET SUM 1350 002502 2024 ISZ T1 /MULTIPLY BY 10 1351 002503 5301 JMP .-2 1352 002504 1030 TAD TX /AND ADD IN NEW DIGIT 1353 002505 3020 DCA ACCNUM /UPDATE SUM 1354 002506 5224 JMP SCAN00 /GO AGAIN 1355 1356 002507 7300 SCAN03, ZERO 1357 002510 1020 TAD ACCNUM /CHAR IS NOT A NUMBER 1358 002511 7640 SZA CLA /ANY ACCUMULATED NUMBER? 1359 002512 5774 JMP ERR4 /YES - ERROR 1360 1361 002513 2026 SCAN04, ISZ T3 /INC ACCUM CNT 1362 002514 1026 TAD T3 /GET THE CNT 1363 002515 7700 SMA CLA /ACCUM FULL? 1364 002516 5224 JMP SCAN00 /YES - THROW AWAY CHAR 1365 002517 1027 TAD T4 1366 002520 3411 DCA I INDEX1 /NO, SAVE CHAR 1367 002521 5224 JMP SCAN00 /AND DO THE NEXT ONE 1368 002522 1373 SCAN05, TAD (SPACE 1369 002523 3022 DCA DEL /FORCE SPACE 1370 002524 1027 TAD T4 1371 002525 3070 DCA CHOLD /HOLD THIS CHARACTER 1372 002526 5352 JMP SCAN07 /AND ALMOST DONE 1373 1374 002527 1416 SCAN06, TAD I INDEX6 /DELIMITER FOUND - GET CODE 1375 002530 3022 DCA DEL /SAVE 1376 002531 1027 TAD T4 1377 002532 3772 DCA I (CDEL /SAVE THAT DELIMITER 1378 002533 1020 TAD ACCNUM 1379 002534 1057 TAD LITFND 1380 002535 1534 TAD I ACUM 1381 002536 7640 SZA CLA /ANY ARGUMENTS FOUND? 1382 002537 5346 JMP SCAN0A /YES 1383 002540 1022 TAD DEL 1384 002541 1371 TAD (-SPACE 1385 002542 7640 SZA CLA /SPACE AS A DELIMITER? 1386 002543 5346 JMP SCAN0A 1387 002544 3022 DCA DEL /YES - CLEAR DEL 1388 002545 5224 JMP SCAN00 /AND IGNORE THE SPACE 1389 002546 1022 SCAN0A, TAD DEL 1390 002547 1371 TAD (-SPACE /IS IT A SPACE? 1391 002550 7650 SNA CLA 1392 002551 5224 JMP SCAN00 /YES, TRY TO FIND A BETTER ONE 1393 1394 002552 1020 SCAN07, TAD ACCNUM 1395 002553 7640 SZA CLA /ACCUMULATED NUMBER? 1396 002554 5201 JMP SCANNR-1 /YES 1397 002555 1534 TAD I ACUM 1398 002556 2057 ISZ LITFND /LITERAL FOUND? 1399 002557 7650 SNA CLA /OR NO ACCUMULATED NAME? 1400 002560 5200 JMP SCANNR-2 /YES - DONE 1401 002561 5770 JMP SCAN22 1402 1403 002562 1367 SCAN08, TAD (END /END OF FILE 1404 002563 3022 DCA DEL 1405 002564 5201 JMP SCANNR-1 /DONE 1406 1407 002567 0011 PAGE 002570 3000 002571 7760 002572 2176 002573 0020 002574 4203 002575 2600 002576 7536 002577 1773 1408 /HERE TO HANDLE A LITERAL. THE LITERAL WILL BE STORED JUST ABOVE 1409 /THE TOP OF USED STORAGE IN FIELD 1. IF IT IS ALREADY IN A POOL, 1410 /THEN THE NAME IS RETURNED, OTHERWISE, IT IS ADDED TO THE APPROP- 1411 /RIATE POOL AND THE NEW NAME IS RETURNED. 1412 1413 1414 002600 1057 SCAN09, TAD LITFND 1415 002601 1534 TAD I ACUM 1416 002602 7640 SZA CLA /ANY ATOM? 1417 002603 5777 JMP SCAN05 /YES - USE IT 1418 002604 1046 TAD VALID /NO, GET VALID ARG TYPES 1419 002605 0376 AND (VARORLIT 1420 002606 7650 SNA CLA /APPROPRIATE? 1421 002607 5775 JMP ERR5 /NO 1422 002610 1027 TAD T4 /GET TYPE OF QUOTE 1423 002611 7041 CMA IAC 1424 002612 3026 DCA T3 /SAVE NEGATIVE 1425 002613 4542 JMS I GETCHR /GET BUT DON'T MODIFY THE NEXT CHAR 1426 002614 5774 JMP ERR6 1427 002615 3024 DCA T1 1428 002616 1024 TAD T1 1429 002617 1026 TAD T3 /GET THE INITIAL QUOTE CHARACTER 1430 002620 7640 SZA CLA /NULL STRING? 1431 002621 1024 SCAN10, TAD T1 /NO - USE THE CHARACTER 1432 002622 0111 AND C7 /HASH FOR LITERAL POOLS 1433 002623 3021 DCA LPOOL /SAVE IT 1434 002624 7340 NONE 1435 002625 3057 DCA LITFND /LITERAL FOUND FLAG 1436 002626 7325 THREE 1437 002627 1032 TAD TOP 1438 002630 3037 DCA NXTSTR /GET A FREE ADDRESS 1439 002631 7340 NONE 1440 002632 3432 DCA I TOP 1441 002633 1032 TAD TOP 1442 002634 3012 DCA INDEX2 1443 002635 7340 NONE 1444 002636 3412 DCA I INDEX2 /FREE UP TWO LOCATIONS AT TOP 1445 002637 3412 DCA I INDEX2 /SAVE STRDEL 1446 002640 1037 TAD NXTSTR 1447 002641 3016 DCA INDEX6 /SAVE PUT PTR 1448 002642 1024 TAD T1 /GET CHARACTER AGAIN 1449 002643 2065 ISZ PTATOM /IS THIS A .A LITERAL? 1450 002644 5252 JMP SCAN12 /NO 1451 002645 5260 JMP SCAN13 /YES 1452 002646 4542 SCAN11, JMS I GETCHR /GET AND DON'T MODIFY CHAR 1453 002647 5774 JMP ERR6 1454 002650 3024 DCA T1 /SAVE IT 1455 002651 1024 TAD T1 1456 1457 002652 1026 SCAN12, TAD T3 /GET FINAL QUOTE CHAR 1458 002653 7650 SNA CLA /IS THIS IT? 1459 002654 5261 JMP SCAN14 /YES 1460 002655 1024 TAD T1 1461 002656 3416 DCA I INDEX6 /NO, PUT CHAR 1462 002657 5246 JMP SCAN11 /AND ON 1463 1464 002660 3416 SCAN13, DCA I INDEX6 /.A ATOM - PUT THE LITERAL 1465 002661 3416 SCAN14, DCA I INDEX6 /STRDEL 1466 002662 1373 TAD (LITS /LITERAL POINTERS 1467 002663 1021 TAD LPOOL /WHICH ONE 1468 002664 3027 DCA T4 1469 002665 1427 TAD I T4 /GET THE PTR 1470 002666 7450 SNA /EMPTY? 1471 002667 5306 JMP SCAN15 /YES 1472 002670 7001 IAC /SKIP THE NAME WORD 1473 002671 3024 DCA T1 /SAVE POINTER FOR SEARCH 1474 002672 7340 NONE /ONE INFO WORD AFTER STRDEL IN LITERAL 1475 002673 3025 DCA T2 /POOLS (EXCEPT THE LAST STRING BECAUSE THE 1476 /WORD ACTUALLY PRECEEDS THE STRINGS) 1477 002674 1037 TAD NXTSTR /SEARCH LITERAL POOL FOR NEW LITERAL 1478 1479 002675 4561 JMS I SEARCH /HAS THE STRING ALREADY BEEN ENTERED? 1480 002676 5333 JMP SCAN20 1481 1482 002677 7340 NONE 1483 002700 1040 TAD T1MAT /YES - POINT TO LITERAL NAME 1484 002701 3025 DCA T2 1485 002702 1425 TAD I T2 /GET THE LITERAL NAME 1486 002703 1120 TAD SARG /FLAG SUBSTITUTE 1487 002704 3534 DCA I ACUM 1488 002705 5342 JMP SCAN21 1489 /HERE TO ADD THE NEW STRING TO THE APPROPRIATE POOL 1490 1491 002706 7340 SCAN15, NONE 1492 002707 1037 TAD NXTSTR 1493 002710 3030 DCA TX 1494 002711 7340 NONE 1495 002712 3430 DCA I TX /FREE UP EXTRA STRDEL 1496 002713 2037 ISZ NXTSTR /DON'T INCLUDE INITIAL STRDEL 1497 1498 002714 7340 SCAN16, NONE 1499 002715 1037 TAD NXTSTR /POINT TO THE NEW STRING 1500 002716 3427 DCA I T4 /SAVE IN POOL 1501 1502 002717 2075 ISZ GENLIT /GENERATE A NEW LITERAL 1503 002720 1075 TAD GENLIT /GET IT 1504 002721 1120 TAD SARG /ADD IN SUBSTITUTE BIT 1505 002722 3534 DCA I ACUM /SAVE LITERAL 1506 002723 1075 TAD GENLIT 1507 002724 3412 DCA I INDEX2 /PUT BEFORE STRING IN POOL 1508 002725 7346 NTHREE 1509 002726 3416 DCA I INDEX6 /PUT POLEND 1510 1511 002727 7301 ONE 1512 002730 1016 TAD INDEX6 1513 002731 3032 DCA TOP /UPDATE THE TOP POINTER 1514 002732 5342 JMP SCAN21 /DONE 1515 002733 7340 SCAN20, NONE /LITERAL NOT IN POOL 1516 002734 1024 TAD T1 1517 002735 3027 DCA T4 /POS OF LIT POOL STRDEL BEFORE POLEND 1518 002736 7344 NTWO /LINK CODE 1519 002737 3427 DCA I T4 /PUT IT 1520 002740 2027 ISZ T4 /POINT TO LINK ADDRESS 1521 002741 5314 JMP SCAN16 /ADD NEW STRING TO POOL 1522 1523 /DONE STRING ACCUMULATION 1524 1525 002742 1065 SCAN21, TAD PTATOM 1526 002743 7650 SNA CLA /WAS THIS A .ANNN LITERAL? 1527 002744 5772 JMP SCANNR-1 /YES - THEN DONE 1528 002745 1371 TAD (SPACE /NO - FORCE A SPACE 1529 002746 3022 DCA DEL /AS A DELIMITER 1530 002747 5770 JMP SCAN00 /BUT LOOK FOR A BETTER ONE 1531 1532 1533 /@ SEEN - HANDLE INDIRECT FOR ACCUM 1534 1535 002750 2064 SCAN2G, ISZ ACMIND /SET FLAG FOR INDIRECT 1536 002751 4563 JMS I SHACUM /SHIFT ACCUM 1537 002752 1534 TAD I ACUM 1538 002753 1367 TAD (-330 1539 002754 5766 JMP SCAN2I 1540 1541 002766 3021 PAGE 002767 7450 002770 2424 002771 0020 002772 2401 002773 2177 002774 4207 002775 4205 002776 0001 002777 2522 1542 /ADD ACCUMULATED NAME TO VARPOL OR LABPOL 1543 1544 003000 7344 SCAN22, NTWO /(NOARG) 1545 003001 1046 TAD VALID /GET VALID TYPE 1546 003002 7650 SNA CLA /NO ARGUMENT ALLOWED? 1547 003003 5777 JMP ERR5 /YES - ERROR 1548 003004 1534 TAD I ACUM /NO - GET THE FIRST CHARACTER 1549 003005 1376 TAD (-256 1550 003006 7450 SNA /PERIOD? 1551 003007 5775 JMP SCAN27 /YES 1552 003010 3030 DCA TX 1553 003011 1036 TAD TMODE /GET THE COMPILER MODE 1554 003012 7640 SZA CLA /SNOBOL MODE? 1555 003013 5313 JMP SCAN2S /NO - ONLY LOOK AT LABELS 1556 003014 1030 SCAN2T, TAD TX / 1557 003015 1374 TAD (-22 1558 003016 7450 SNA /"@" INDIRECT? 1559 003017 5773 JMP SCAN2G /YES 1560 003020 1372 TAD (-30 1561 003021 7450 SCAN2I, SNA /NO, "X"? 1562 003022 5771 JMP ERR7 /YES - RESTRICTED 1563 003023 1370 TAD (27 1564 003024 7510 SPA /A LETTER? 1565 003025 5767 JMP ERR10 /NO 1566 003026 1366 TAD (-32 1567 003027 7700 SMA CLA /? 1568 003030 5767 JMP ERR10 /NO 1569 003031 3765 DCA I (ACCUM+6 /TRUNCATE TO SIX CHARACTERS 1570 003032 1364 TAD (SPFNPL /SPECIAL FUNCTION POOL 1571 003033 3024 DCA T1 1572 003034 3025 DCA T2 /NO INFO WORDS 1573 003035 1135 TAD ACUMM 1574 1575 003036 4561 JMS I SEARCH /IS THIS IDENTIFIER A FUNCTION? 1576 003037 5241 JMP .+2 1577 003040 5302 JMP SCAN2P /YES - JUST RETURN IT 1578 003041 7301 ONE 1579 003042 1032 TAD TOP 1580 003043 3013 DCA INDEX3 /PTR TO FREE SPACE 1581 003044 1013 TAD INDEX3 1582 003045 3037 DCA NXTSTR /SAVE IT 1583 003046 7340 NONE 1584 003047 3432 DCA I TOP 1585 003050 7340 NONE 1586 003051 3437 DCA I NXTSTR /FREE UP SPACES AT TOP 1587 003052 3413 DCA I INDEX3 /STRDEL TO COVER ANY PREVIOUS NAME 1588 003053 1135 TAD ACUMM 1589 003054 3011 DCA INDEX1 /SETUP READ PTR 1590 003055 1411 SCAN23, TAD I INDEX1 /GET NEXT 1591 003056 7450 SNA /DONE? 1592 003057 5320 JMP SCAN24 /YES 1593 003060 3030 DCA TX 1594 003061 1030 TAD TX 1595 003062 1133 TAD NC260 /CHECK FOR ALPHA OR NUMERIC 1596 003063 7510 SPA / 1597 003064 5767 JMP ERR10 1598 003065 1131 TAD NC12 1599 003066 7510 SPA /NUMBER? 1600 003067 5276 JMP SCAN2H /YES 1601 003070 1127 TAD NC7 1602 003071 7510 SPA /ALPHABETIC? 1603 003072 5767 JMP ERR10 /NO 1604 003073 1366 TAD (-32 1605 003074 7700 SMA CLA /? 1606 003075 5767 JMP ERR10 1607 003076 7300 SCAN2H, ZERO 1608 003077 1030 TAD TX /CHAR IS OK, GET IT BACK 1609 003100 3413 DCA I INDEX3 /PUT IT 1610 003101 5255 JMP SCAN23 /CONTINUE 1611 1612 003102 1022 SCAN2P, TAD DEL 1613 003103 1374 TAD (-COMMA 1614 003104 7640 SZA CLA /IS THIS A LABEL? 1615 003105 5763 JMP SCANNR-1 /NO - DONE 1616 003106 1046 TAD VALID 1617 003107 1362 TAD (-ANY 1618 003110 7640 SZA CLA /IS IT REALLY A LABEL? 1619 003111 5763 JMP SCANNR-1 1620 003112 5771 JMP ERR7 /YES - CANNOT BE A SPECIAL FUNCTION NAME 1621 1622 003113 1022 SCAN2S, TAD DEL 1623 003114 1374 TAD (-COMMA /IS THIS A LABEL? 1624 003115 7640 SZA CLA 1625 003116 5763 JMP SCANNR-1 /NO - DONE 1626 003117 5214 JMP SCAN2T /YES - PROCESS IT 1627 /HERE WHEN ACCUM IS CHECKED AND STORED - PUT POOL DELIMITERS 1628 /AND TEST IF THIS NAME IS ALREADY IN A POOL. 1629 1630 003120 3413 SCAN24, DCA I INDEX3 /STRDEL 1631 003121 1022 TAD DEL /GET THE DELIMITER 1632 003122 1374 TAD (-COMMA /LABEL? 1633 003123 7650 SNA CLA /? 1634 003124 5336 JMP SCAN2D /YES 1635 003125 1064 TAD ACMIND 1636 003126 7640 SZA CLA /INDIRECT? 1637 003127 5334 JMP SCAN2J /YES - VAR 1638 003130 1046 TAD VALID 1639 003131 0361 AND (LABEL /IS THIS A LABEL REF? 1640 003132 7640 SZA CLA 1641 003133 5346 JMP SCAN2N /YES 1642 1643 003134 1360 SCAN2J, TAD (VARPOL /USE VARIABLE POOL 1644 003135 5757 JMP SCAN2K 1645 1646 003136 1046 SCAN2D, TAD VALID 1647 003137 1362 TAD (-ANY 1648 003140 7640 SZA CLA /IS THIS REALLY A LABEL? 1649 003141 5756 JMP ERR14 /NO - BAD DELIMETER 1650 003142 2061 ISZ LABELF /FLAG LABEL BEING pROCESSED 1651 003143 1064 TAD ACMIND /INDIRECT? 1652 003144 7640 SZA CLA /MUST NOT BE 1653 003145 5755 JMP ERR11 1654 003146 1064 SCAN2N, TAD ACMIND 1655 003147 7640 SZA CLA 1656 003150 5334 JMP SCAN2J /INDIRECT LABEL REF THROUGH A VARIABLE 1657 003151 1354 TAD (LABPOL /USE THE LABEL POOL 1658 1659 003152 5757 JMP I (.&7600+200 /***PAGE BOUNDS 1660 003154 2231 PAGE 003155 4220 003156 4224 003157 3200 003160 2232 003161 0004 003162 7755 003163 2401 003164 1720 003165 2167 003166 7746 003167 4215 003170 0027 003171 4211 003172 7750 003173 2750 003174 7756 003175 3432 003176 7522 003177 4205 1661 1662 003200 3027 SCAN2K, DCA T4 /SAVE POOL HEADER ADDRESS 1663 003201 1427 TAD I T4 /GET THE POOL LOCATION 1664 003202 7450 SNA /POOL EMPTY? 1665 003203 5231 JMP SCAN2Q 1666 003204 3024 DCA T1 /NO - SAVE PTR 1667 003205 3025 DCA T2 /NO INFO WORDS 1668 003206 1135 TAD ACUMM 1669 1670 003207 4561 JMS I SEARCH /SEARCH FOR OCCURANCE 1671 003210 5215 JMP SCAN2A /NOT FOUND 1672 003211 1061 TAD LABELF 1673 003212 7640 SZA CLA /LABEL BEING PROCESSED? 1674 003213 5777 JMP ERR12 /YES - MULT. DEF. LABEL 1675 003214 5332 JMP SCAN2M /OTHERWISE TEST FOR INDIRECT 1676 /HERE IF THE NAME IS NOT FOUND IN THE POOL 1677 1678 003215 1046 SCAN2A, TAD VALID 1679 003216 0376 AND (LABEL /LOOKING FOR A LABEL REF? 1680 003217 7640 SZA CLA / 1681 003220 5317 JMP SCAN2C /YES 1682 1683 /HERE IF APPENDING TO POOL 1684 1685 003221 7340 SCAN2F, NONE 1686 003222 1024 TAD T1 1687 003223 3027 DCA T4 /BACKUP T1 TO POINT TO OLD STRDEL 1688 003224 7344 NTWO 1689 003225 3427 DCA I T4 /MAKE IT A LINK 1690 003226 2027 ISZ T4 /POINT TO ADDRESS WD 1691 003227 7301 ONE 1692 003230 5243 JMP SCAN2E 1693 1694 003231 1046 SCAN2Q, TAD VALID /HERE ON EMPTY MAIN POOL 1695 003232 0376 AND (LABEL 1696 003233 7640 SZA CLA /LOOKING FOR A LABEL REF? 1697 003234 5317 JMP SCAN2C /YES - TEST UNDEFINED LABELS POOL 1698 1699 003235 7301 SCAN2B, ONE 1700 003236 1037 TAD NXTSTR 1701 003237 3030 DCA TX 1702 003240 7340 NONE 1703 003241 3430 DCA I TX /FREE UP STRDEL BEFORE NAME 1704 003242 7305 TWO 1705 003243 1037 SCAN2E, TAD NXTSTR /POS OF NEW NAME 1706 003244 3427 DCA I T4 /UPDATE PTR 1707 003245 7346 NTHREE 1708 003246 3413 DCA I INDEX3 /PUT POLEND 1709 003247 7301 ONE 1710 003250 1013 TAD INDEX3 /GET NEW TOP 1711 003251 3032 DCA TOP 1712 003252 1046 TAD VALID 1713 003253 0376 AND (LABEL 1714 003254 7640 SZA CLA /LABEL REF? 1715 003255 5332 JMP SCAN2M /YES - CHECK INDIRECT 1716 003256 1061 TAD LABELF 1717 003257 7650 SNA CLA /LABEL DEFINITION? 1718 003260 5332 JMP SCAN2M 1719 1720 /LABEL DEFINED - CHECK UNDEFINED LABEL POOL TO SOLVE ANY UNDEFINED 1721 /REFERENCES 1722 1723 003261 1775 TAD I (ULBPOL /GET POOL PTR 1724 003262 7450 SNA /EMPTY? 1725 003263 5332 JMP SCAN2M /YES - CHECK INDIRECT 1726 003264 3024 DCA T1 1727 003265 3025 DCA T2 /NO INFO WORDS 1728 003266 1135 TAD ACUMM 1729 003267 4561 JMS I SEARCH /LOOK FOR ATOM 1730 003270 5332 JMP SCAN2M /NOT FOUND - DO INDIRECT 1731 /HERE TO DELETE THE ENTRY IN A POOL POINTED TO BY T1 AND T1MAT 1732 1733 003271 4555 JMS I RDPOOL /TRY TO GET THE NEXT CHARACTER 1734 003272 5274 JMP .+2 1735 003273 5305 JMP SCAN25 /GOT IT 1736 003274 1775 TAD I (ULBPOL /NO CHARACTER - ARE WE DELETING THE ONLY ENTRY? 1737 003275 7041 CMA IAC 1738 003276 1040 TAD T1MAT 1739 003277 7640 SZA CLA 1740 003300 5312 JMP SCAN2R /NO - WRITE THE END CODE 1741 003301 1775 TAD I (ULBPOL 1742 003302 4540 JMS I DELPOL /YES - DELETE IT 1743 003303 3775 DCA I (ULBPOL /ZERO THE POINTER 1744 003304 5332 JMP SCAN2M /DONE 1745 1746 003305 2077 SCAN25, ISZ OVERF /OVERWRITING POOL 1747 003306 4571 JMS I WRPOOL /WRITE THE CHARACTER 1748 003307 4555 JMS I RDPOOL /READ NEXT FROM POOL 1749 003310 5312 JMP .+2 /END OF POOL 1750 003311 5306 JMP SCAN25+1 /AND AGAIN 1751 003312 2077 SCAN2R, ISZ OVERF 1752 003313 7340 NONE 1753 003314 4571 JMS I WRPOOL /WRITE END CODE 1754 003315 3077 DCA OVERF /DONE OVERWRITING 1755 003316 5332 JMP SCAN2M /CHECK FOR INDIRECT 1756 1757 1758 /HERE TO SEARCH THE UNDEFINED LABELS POOL (WITH LABEL REF) 1759 1760 003317 1375 SCAN2C, TAD (ULBPOL 1761 003320 3027 DCA T4 /PTR TO HEAD OF POOL 1762 003321 1775 TAD I (ULBPOL /GET PTR 1763 003322 7450 SNA /EMPTY? 1764 003323 5235 JMP SCAN2B /YES - APPEND 1765 003324 3024 DCA T1 1766 003325 3025 DCA T2 /NO INFO WORDS 1767 003326 1135 TAD ACUMM 1768 1769 003327 4561 JMS I SEARCH /SEARCH POOL 1770 003330 5221 JMP SCAN2F /FAIL - APPEND TO POOL 1771 003331 5332 JMP SCAN2M /CHECK FOR INDIRECT 1772 /CHECK FOR ACCUM BEING INDIRECT, HANDLE AND RETURN 1773 1774 003332 1064 SCAN2M, TAD ACMIND 1775 003333 7650 SNA CLA /INDIRECT? 1776 003334 5774 JMP SCANNR-1 /NO - DONE 1777 003335 1373 TAD (INDCAL /XIND CALL 1778 003336 4572 JMS I WRPPSO /WRITE IT ON PRE-OUT 1779 003337 1135 TAD ACUMM 1780 003340 4575 JMS I WRSTPO /WRITE ACCUM 1781 003341 2075 ISZ GENLIT 1782 003342 1075 TAD GENLIT /GENERATE A NEW LITERAL 1783 003343 1120 TAD SARG /SUBSTITUTE ARG 1784 003344 3772 DCA I (DCAGV 1785 003345 1371 TAD (DCAGVC-1 /DCA SAVE OF NAME 1786 003346 4575 JMS I WRSTPO 1787 003347 7325 THREE 1788 003350 1034 TAD CLEN 1789 003351 3034 DCA CLEN /UPDATE INST LENGTH 1790 003352 1046 TAD VALID 1791 003353 0376 AND (LABEL /LABEL REF? 1792 003354 7650 SNA CLA /? 1793 003355 5360 JMP .+3 /NO 1794 003356 2100 ISZ LINDF /YES - INDICATE USAGE 1795 003357 5361 JMP .+2 1796 003360 2101 ISZ VINDF /NO - SET VAR IND FLAG 1797 1798 003361 5770 JMP I (.&7600+200 /***PAGE BOUNDS 1799 003370 3400 PAGE 003371 2251 003372 2260 003373 2577 003374 2401 003375 2233 003376 0004 003377 4222 1800 1801 003400 1046 TAD VALID 1802 003401 0377 AND (JMPTR 1803 003402 7640 SZA CLA /TO BE USED AS A JUMP ADDRESS? 1804 003403 5214 JMP SCAN2L /YES 1805 003404 1776 TAD I (DCAGV /GET LIT # 1806 003405 3534 DCA I ACUM /SUBSTITUTE ARG 1807 003406 1375 TAD (", 1808 003407 3774 DCA I (ACCUM+1 1809 003410 1115 TAD C260 1810 003411 3773 DCA I (ACCUM+2 /PUT 'NAME,0' 1811 003412 3772 DCA I (ACCUM+3 /NULL 1812 003413 5771 JMP SCANNR-1 /DONE 1813 003414 1370 SCAN2L, TAD ("I 1814 003415 3534 DCA I ACUM /INDIRECT JUMP 1815 003416 1114 TAD C240 1816 003417 3774 DCA I (ACCUM+1 1817 003420 1776 TAD I (DCAGV 1818 003421 3773 DCA I (ACCUM+2 /TO INDIRECT NAME 1819 003422 1367 TAD (215 1820 003423 3772 DCA I (ACCUM+3 1821 003424 1366 TAD (212 1822 003425 3765 DCA I (ACCUM+4 1823 003426 1776 TAD I (DCAGV /GENERATED NAME AGAIN 1824 003427 3764 DCA I (ACCUM+5 /PUT IT 1825 003430 3763 DCA I (ACCUM+6 /NULL 1826 003431 5771 JMP SCANNR-1 /DONE 1827 1828 /DOT SEEN AS FIRST CHARACTER, CHECK FOR .ANNN 1829 1830 003432 1774 SCAN27, TAD I (ACCUM+1 1831 003433 1362 TAD (-301 /"A"? 1832 003434 7640 SZA CLA 1833 003435 5274 JMP SCAN30 /NO 1834 003436 1036 TAD TMODE /GET COMPILER MODE 1835 003437 7640 SZA CLA /SNOBOL MODE? 1836 003440 5771 JMP SCANNR-1 /NO - DONE 1837 003441 1374 TAD (ACCUM+1 /PTR TO REST OF ATOM 1838 003442 3011 DCA INDEX1 1839 003443 3024 DCA T1 /NUMBER ACCUMULATION 1840 1841 003444 1411 SCAN28, TAD I INDEX1 /GET NEXT CHARACTER 1842 003445 7450 SNA /MORE? 1843 003446 5265 JMP SCAN29 /NO - DONE 1844 003447 1133 TAD NC260 1845 003450 7510 SPA /BELOW A NUMBER? 1846 003451 5274 JMP SCAN30 /YES - PASS IT BY 1847 003452 1130 TAD NC10 1848 003453 7500 SMA 1849 003454 5274 JMP SCAN30 /NOT A NUMBER 1850 003455 1112 TAD C10 /CONVERT TO OCTAL 1851 003456 3030 DCA TX 1852 003457 1024 TAD T1 1853 003460 7106 CLL RTL; RAL /SHIFT TOTAL 003461 7004 1854 003462 1030 TAD TX /ADD IN NEXT DIGIT TO TOTAL 1855 003463 3024 DCA T1 1856 003464 5244 JMP SCAN28 /AND DO NEXT 1857 003465 1024 SCAN29, TAD T1 /GET ACCUMULATED CHAR 1858 003466 7650 SNA CLA /OK IF NOT .EQ. 0 1859 003467 5761 JMP ERR9 1860 003470 7340 NONE 1861 003471 3065 DCA PTATOM /SET .A LITERAL FLAG 1862 003472 3774 DCA I (ACCUM+1 /CLEAR ACCUM 1863 003473 5760 JMP SCAN10 /AND GO 1864 1865 1866 /PERIOD NAME FOUND - CHECK VALID TYPES 1867 1868 003474 7300 SCAN30, ZERO 1869 003475 1046 TAD VALID /GET VALID CODES 1870 003476 1357 TAD (-ANY /LOOKING FOR A COMMAND? 1871 003477 7640 SZA CLA 1872 003500 5756 JMP ERR7 /NO - ILLEGAL NAME 1873 003501 5771 JMP SCANNR-1 /YES - DONE 1874 /WRITE END CODE AND CLOSE OUTPUT FILE 1875 1876 003502 1056 CLOSE, TAD OFLAG /DOING OUTPUT? 1877 003503 7650 SNA CLA 1878 003504 5755 JMP CLOS20 /NO SKIP 1879 003505 1354 TAD (ENDC1 /FIRST END CODE 1880 003506 4574 JMS I WRPS /WRITE IT 1881 003507 1753 TAD I (VARPOL 1882 003510 7450 SNA /ANY VARIABLES? 1883 003511 5320 JMP CLOS2 1884 003512 3024 DCA T1 /POINTER 1885 1886 003513 4552 CLOS1, JMS I PUTNAM /PUT NEXT 1887 003514 5320 JMP CLOS2 /END OF POOL 1888 003515 1352 TAD (STOR 1889 003516 4574 JMS I WRPS /WRITE A WD OF STORAGE 1890 003517 5313 JMP CLOS1 /AND NEXT 1891 1892 003520 1351 CLOS2, TAD (ENDC2 /) 1893 003521 4574 JMS I WRPS /WRITE MORE CODE 1894 003522 1350 TAD (LITS-1 1895 003523 3011 DCA INDEX1 1896 003524 1130 TAD NC10 /NUMBER OF LITERALS 1897 003525 3026 DCA T3 1898 1899 003526 1411 CLOS3, TAD I INDEX1 /GET NEXT PTR 1900 003527 7450 SNA /EMPTY? 1901 003530 5747 JMP CLOS6 /YES 1902 003531 3024 DCA T1 1903 1904 003532 5746 JMP I (.&7600+200 /***PAGE BOUNDS 1905 003546 3600 PAGE 003547 3624 003550 2176 003551 2623 003552 2515 003553 2232 003554 2611 003555 4031 003556 4211 003557 7755 003560 2621 003561 4213 003562 7477 003563 2167 003564 2166 003565 2165 003566 0212 003567 0215 003570 0311 003571 2401 003572 2164 003573 2163 003574 2162 003575 0254 003576 2260 003577 0010 1906 1907 003600 4555 CLOS4, JMS I RDPOOL /GET THE NEXT LITERAL NAME 1908 003601 5224 JMP CLOS6 1909 003602 3025 DCA T2 1910 003603 1377 TAD ("X 1911 003604 4551 JMS I PUTCHR /PUT AN "X" 1912 003605 1376 TAD ("L 1913 003606 4551 JMS I PUTCHR 1914 003607 1025 TAD T2 /GET THE NAME 1915 003610 4553 JMS I PUTOC /PUT NAME 1916 003611 1375 TAD (ENDC3 1917 003612 4574 JMS I WRPS /POINTER FOR LIT 1918 003613 1025 TAD T2 1919 003614 4553 JMS I PUTOC /NAME AGAIN 1920 003615 1374 TAD (RETURN-1 1921 003616 4576 JMS I WRSTR /AND RETURN 1922 003617 4555 CLOS5, JMS I RDPOOL /GET NEXT (OF STR) 1923 003620 5224 JMP CLOS6 /DONE 1924 003621 7650 SNA CLA /STRDEL? 1925 003622 5200 JMP CLOS4 /YES - DO NEXT 1926 003623 5217 JMP CLOS5 /NO, KEEP LOOKING 1927 1928 003624 2026 CLOS6, ISZ T3 /MORE? 1929 003625 5773 JMP CLOS3 /YES - GO 1930 1931 003626 1372 TAD (ENDC6 /MORE INFO 1932 003627 4574 JMS I WRPS 1933 003630 1100 TAD LINDF /LABEL INDIRECT SEEN FLAG 1934 003631 1101 TAD VINDF /VAR " " " 1935 003632 7650 SNA CLA /ANY SEEN? 1936 003633 5252 JMP CLOS8 /NO 1937 003634 1371 TAD (ENDC5 1938 003635 4574 JMS I WRPS /DEFINE XIND 1939 003636 1100 TAD LINDF /LABEL USAGE? 1940 003637 7650 SNA CLA 1941 003640 5245 JMP CLOS7 /NO 1942 003641 1770 TAD I (LABPOL /GET POOL HEADER 1943 003642 7450 SNA /EMPTY? 1944 003643 5767 JMP ERR23 1945 003644 4766 JMS CLOS30 /NO - PUT IT 1946 1947 003645 1101 CLOS7, TAD VINDF /VARIABLE USAGE? 1948 003646 7650 SNA CLA 1949 003647 5252 JMP CLOS8 /NO - DONE INDIRECTS 1950 003650 1765 TAD I (VARPOL 1951 003651 4766 JMS CLOS30 /PUT VARS 1952 003652 1115 CLOS8, TAD C260 /END OF TABLE 1953 003653 4551 JMS I PUTCHR 1954 003654 1364 TAD (LITS-1 1955 003655 3011 DCA INDEX1 1956 003656 1130 TAD NC10 1957 003657 3026 DCA T3 /COUNT 1958 1959 003660 1411 CLOS9, TAD I INDEX1 /NEXT LIT PTR 1960 003661 7450 SNA /EMPTY? 1961 003662 5763 JMP CLOS16 /YES 1962 003663 3024 DCA T1 /SAVE PTR 1963 1964 003664 4555 CLOS10, JMS I RDPOOL 1965 003665 5763 JMP CLOS16 /POOL DONE 1966 003666 3025 DCA T2 1967 003667 1362 TAD (ENDC7 1968 003670 4574 JMS I WRPS /WRITE BEG 1969 003671 1025 TAD T2 1970 003672 4553 JMS I PUTOC 1971 003673 1361 TAD (", 1972 003674 4551 JMS I PUTCHR /PUT COMMA 1973 /DECODE LITERALS INTO 3 CHAR/2 WORD FORMAT 1974 1975 003675 3534 CLOS11, DCA I ACUM 1976 003676 3760 DCA I (ACCUM+1 1977 003677 1135 TAD ACUMM 1978 003700 3012 DCA INDEX2 /PTR TO PUT CODES 1979 003701 7346 NTHREE 1980 003702 3025 DCA T2 /COUNT 1981 1982 003703 4555 CLOS12, JMS I RDPOOL /GET THE NEXT CHAR 1983 003704 7402 HLT 1984 003705 7450 SNA /STRDEL? 1985 003706 5336 JMP CLOS14 /YES 1986 003707 2025 ISZ T2 /3RD CHAR? 1987 003710 5334 JMP CLOS13 /NO 1988 003711 3027 DCA T4 1989 003712 1027 TAD T4 1990 003713 7006 RTL; RTL /SHIFT FOR TOP CHAR 003714 7006 1991 003715 0117 AND C7400 /SAVE TOP BITS 1992 003716 1534 TAD I ACUM /ADD IN BOTTOM 1993 003717 4553 JMS I PUTOC /PUT IT 1994 003720 1374 TAD (RETURN-1 1995 003721 4576 JMS I WRSTR /PUT RETURN 1996 003722 1027 TAD T4 1997 003723 7012 RTR; RTR; RAR /SHIFT FOR BOTTOM 003724 7012 003725 7010 1998 003726 0117 AND C7400 1999 003727 1760 TAD I (ACCUM+1 /BOTTOM WD 2000 003730 4553 JMS I PUTOC /PUT IT 2001 003731 1374 TAD (RETURN-1 2002 003732 4576 JMS I WRSTR /AND RETURN 2003 003733 5275 JMP CLOS11 /AGAIN 2004 2005 003734 3412 CLOS13, DCA I INDEX2 /SAVE 1ST OR 2ND CHAR 2006 003735 5303 JMP CLOS12 2007 2008 003736 1534 CLOS14, TAD I ACUM 2009 003737 4553 JMS I PUTOC /PUT PARTAIL WORDS OF LITERAL OUT 2010 003740 1374 TAD (RETURN-1 2011 003741 4576 JMS I WRSTR 2012 003742 1760 TAD I (ACCUM+1 2013 003743 4553 JMS I PUTOC 2014 003744 1374 TAD (RETURN-1 2015 003745 4576 JMS I WRSTR 2016 003746 7340 NONE 2017 003747 4553 JMS I PUTOC /PUT END OF STRING 2018 003750 1374 TAD (RETURN-1 2019 003751 4576 JMS I WRSTR 2020 003752 5264 JMP CLOS10 /DO THE NEXT STRING 2021 2022 003760 2162 PAGE 003761 0254 003762 2671 003763 4000 003764 2176 003765 2232 003766 4107 003767 4244 003770 2231 003771 2641 003772 2645 003773 3526 003774 2246 003775 2635 003776 0314 003777 0330 2023 /HERE WHEN LITERAL POOL DONE 2024 2025 004000 2026 CLOS16, ISZ T3 /MORE? 2026 004001 5777 JMP CLOS9 /YES - GO 2027 2028 004002 1376 TAD (ENDC10 /LAST BIT 2029 004003 4574 JMS I WRPS 2030 2031 004004 1775 TAD I (OUTBLK /GET CURRECT BLOCK NUMBER 2032 004005 7041 CMA IAC 2033 004006 3024 DCA T1 /SAVE NEG 2034 2035 004007 4551 CLOS17, JMS I PUTCHR /PUT ZEROS 2036 004010 1775 TAD I (OUTBLK 2037 004011 1024 TAD T1 2038 004012 7650 SNA CLA /UNTIL A BLOCK IS WRITTEN 2039 004013 5207 JMP CLOS17 /AGAIN 2040 004014 1055 TAD FOUTBK /GET THE FIRST OUTPUT BLOCK NUMBER 2041 004015 7041 CMA IAC 2042 004016 1775 TAD I (OUTBLK 2043 004017 3226 DCA CLOS19 /# OF BLOCKS WRITTEN 2044 004020 1774 TAD I (OFLTAB /GET OUTPUT DEVICE # AGAIN 2045 2046 004021 6201 CDF 0 2047 004022 6212 CIF 10 2048 004023 4565 JMS I USR /CALL USR 2049 004024 0004 4 /TO CLOSE OUTPUT 2050 004025 0104 ONAME /OUTPUT FILE NAME 2051 004026 0000 CLOS19, 0 /# OF BLOCKS 2052 004027 5773 JMP ERR3 /ERROR 2053 2054 004030 6211 CDF 10 2055 004031 4557 CLOS20, JMS I RETTRN /TYPE A RETURN 2056 004032 1772 TAD I (ULBPOL /UNDEFINDED LABEL POOL 2057 004033 7450 SNA /EMPTY? 2058 004034 5260 JMP CLOS24+1 /YES - DONE HERE 2059 004035 3024 DCA T1 /SAVE PTR TO LABELS 2060 004036 1371 TAD (ENDC20 /UNDEFINED LABELS MESSAGE 2061 004037 4564 JMS I TYPE 2062 2063 004040 4555 CLOS21, JMS I RDPOOL /NEXT 2064 004041 5257 JMP CLOS24 2065 004042 7450 SNA /STRDEL? 2066 004043 5246 JMP CLOS23 /YES 2067 004044 4547 CLOS22, JMS I PRINT /NO - PRINT IT 2068 004045 5240 JMP CLOS21 /AND GO AGAIN 2069 2070 004046 4555 CLOS23, JMS I RDPOOL /GET NEXT 2071 004047 5257 JMP CLOS24 /DONE 2072 004050 3025 DCA T2 2073 004051 1370 TAD (", 2074 004052 4547 JMS I PRINT 2075 004053 1114 TAD C240 2076 004054 4547 JMS I PRINT 2077 004055 1025 TAD T2 /GET BACK CHAR 2078 004056 5244 JMP CLOS22 /CONTINUE 2079 /HERE TO DO TOTAL ERRORS MESSAGE 2080 2081 004057 4557 CLOS24, JMS I RETTRN 2082 004060 4557 JMS I RETTRN 2083 004061 1767 TAD I (ERRC 2084 004062 7450 SNA /ERRORS? 2085 004063 5302 JMP CLOS29 /NO 2086 004064 1366 TAD (-144 2087 004065 7700 SMA CLA /OVER 100 ERRORS? 2088 004066 5277 JMP CLOS28 /YES 2089 004067 1365 TAD (SACCUM-1 2090 004070 3011 DCA INDEX1 /WHERE TO PUT NUMBER 2091 004071 3764 DCA I (SACCUM+2 2092 004072 1767 TAD I (ERRC / 2093 004073 4536 JMS I CONVD /CONVERT IT TO DECIMAL 2094 004074 1365 TAD (SACCUM-1 2095 004075 4537 JMS I CTYPE /TYPE THE NUMBER 2096 004076 5304 JMP CLOS32 2097 2098 004077 1363 CLOS28, TAD (ENDC21 /OVER 100 ERRORS, GIVE 'MANY' 2099 004100 4564 JMS I TYPE 2100 004101 5304 JMP CLOS32 2101 2102 004102 1362 CLOS29, TAD (ENDC22 /'NO' 2103 004103 4564 JMS I TYPE 2104 2105 004104 1361 CLOS32, TAD (ENDC23 /'ERRORS DETECTED' 2106 004105 4564 JMS I TYPE 2107 004106 5345 JMP GOMON /GO TO OS/8 2108 2109 2110 /PUT INDIRECT INFO FOR CLOSE 2111 2112 004107 0000 CLOS30, 0 2113 2114 004110 3024 CLOS31, DCA T1 /PTR TO POOL 2115 004111 1024 TAD T1 2116 004112 3025 DCA T2 /SAVE PTR 2117 004113 1360 TAD (ENDC24 2118 004114 4574 JMS I WRPS /WRITE 2119 004115 4552 JMS I PUTNAM /PUT NAME 2120 004116 5707 JMP I CLOS30 2121 004117 1025 TAD T2 2122 004120 3024 DCA T1 /BACKUP 2123 004121 1357 TAD (ENDC5 2124 004122 4574 JMS I WRPS 2125 004123 4552 JMS I PUTNAM /PUT NAME AGAIN 2126 004124 5707 JMP I CLOS30 2127 004125 1356 TAD (RETURN-1 2128 004126 4576 JMS I WRSTR 2129 004127 4555 JMS I RDPOOL /ANOTHER? 2130 004130 5707 JMP I CLOS30 /NO - DONE 2131 004131 7340 NONE 2132 004132 1024 TAD T1 2133 004133 5310 JMP CLOS31 /AGAIN 2134 / THIS PAGE CONTAINS ERROR MESSAGES FOR COMPILER AND SOURCE ERRORS. 2135 2136 004134 7300 ERR1, ZERO 2137 004135 1355 TAD (1-LINEL 2138 004136 3045 DCA IMCNT /BUFFER COUNT 2139 004137 1354 TAD (LINEIM-1 2140 004140 3014 DCA LINEP /PTR TO BUFFER 2141 004141 1353 TAD (ERLTL /LINE TOO LONG 2142 004142 5752 JMP ERRH 2143 004143 1351 ERR2, TAD (EROFF /OUTPUT FILE IS FULL 2144 004144 4564 JMS I TYPE 2145 004145 6201 GOMON, CDF 0 2146 004146 5774 JMP I (7600 /GO TO OS/8 2147 2148 004151 3001 PAGE 004152 4255 004153 2767 004154 2037 004155 7661 004156 2246 004157 2641 004160 2757 004161 2741 004162 2737 004163 2733 004164 2221 004165 2216 004166 7634 004167 2234 004170 0254 004171 2713 004172 2233 004173 4200 004174 7600 004175 2174 004176 2675 004177 3660 2149 004200 6211 ERR3, CDF 10 2150 004201 1377 TAD (EROER /OUTPUT ERROR 2151 004202 5255 JMP ERRH 2152 004203 1376 ERR4, TAD (ERIVN /INVALID NUMBER 2153 004204 5255 JMP ERRH 2154 004205 1375 ERR5, TAD (ERIARG /ILLEGAL ARGUMENT TYPE 2155 004206 5255 JMP ERRH 2156 004207 1374 ERR6, TAD (ERPEOF /PREMATURE EOF 2157 004210 5255 JMP ERRH 2158 004211 1373 ERR7, TAD (ERNIR /RESTRICTED NAME 2159 004212 5255 JMP ERRH 2160 004213 1372 ERR9, TAD (ERLIV /LITERAL HAS ILLEGAL VALUE 2161 004214 5255 JMP ERRH 2162 004215 7300 ERR10, ZERO 2163 004216 1371 TAD (ERIC /ILLEGAL CHARACTER 2164 004217 5255 JMP ERRH 2165 004220 1370 ERR11, TAD (ERLNI /LABEL MAY NOT BE INDIRECT 2166 004221 5255 JMP ERRH 2167 004222 1367 ERR12, TAD (ERMDL /MULT. DEF. LABEL 2168 004223 5255 JMP ERRH 2169 004224 1366 ERR14, TAD (ERID /ILLEGAL DELIMITER 2170 004225 5255 JMP ERRH 2171 004226 1365 ERR15, TAD (ERUC /UNRECOGNIZED COMMAND 2172 004227 5255 JMP ERRH 2173 004230 1364 ERR16, TAD (ERARTB /ARG IS TOO LARGE (OR SMALL) 2174 004231 5255 JMP ERRH 2175 004232 1363 ERR17, TAD (ERNAE /ARG MAY NOT APPEAR AFTER EQUAL 2176 004233 5255 JMP ERRH 2177 004234 1362 ERR18, TAD (ERMHA /OR MUST BE PRECEDED AND FOLLOWED 2178 004235 5255 JMP ERRH / BY AN ARGUMENT 2179 004236 1361 ERR19, TAD (EROOT /ONLY ONE TRANSFER IS LEGAL 2180 004237 5255 JMP ERRH 2181 004240 1360 ERR20, TAD (ERTFA /TOO FEW ARGS 2182 004241 5255 JMP ERRH 2183 004242 1357 ERR22, TAD (ERSTC /SAME TRANSFER CONDITION 2184 004243 5255 JMP ERRH 2185 004244 1356 ERR23, TAD (ERNLD /NO LABELS DEFINED FOR TRANSFER TABLE 2186 004245 4564 JMS I TYPE 2187 004246 5755 JMP MAIN 2188 004247 6211 ERR24, CDF 10 2189 004250 1354 TAD (ERCNT /CANT ENTER OUTPUT FILE 2190 004251 4564 JMS I TYPE 2191 004252 5753 JMP SNOBOL /GO AGAIN 2192 004253 7300 ERR25, ZERO 2193 004254 1352 TAD (ERAGVO /ARITH GEN VAR OVERFLOW 2194 / THIS ROUTINE HANDLES TYPING THE SOURCE LINE IN ERROR AND THEN THE 2195 /ERROR MESSAGE. WHEN DONE, CONTROL IS RETURNED TO THE MAIN PARSING 2196 /LOOP. 2197 2198 2199 004255 2751 ERRH, ISZ I (ERRC 2200 004256 3025 DCA T2 /SAVE PTR TO MESSAGE 2201 004257 4557 JMS I RETTRN /TYPE A RETURN 2202 004260 1014 TAD LINEP 2203 004261 3017 DCA INDEX7 2204 004262 1014 TAD LINEP 2205 004263 1350 TAD (1-LINEIM 2206 004264 7640 SZA CLA /LINE FULL? 2207 004265 3417 DCA I INDEX7 /NULL FOR LINE IMAGE 2208 004266 1347 TAD (LINEIM-1 2209 004267 4537 JMS I CTYPE /FIRST PART OF THE LINE 2210 004270 1074 TAD TOCNT /CURRENT CHAR POS 2211 004271 1121 TAD NC1 /MARK THE PREVIOUS 2212 004272 7041 CMA IAC 2213 004273 3024 DCA T1 /SAVE NEG COUNT 2214 004274 1014 TAD LINEP /GET LINE BUFFER PTR 2215 004275 3026 DCA T3 2216 004276 1026 TAD T3 2217 004277 1350 TAD (1-LINEIM 2218 004300 7650 SNA CLA /FULL LINE ALREADY? 2219 004301 5305 JMP ERRH1-1 2220 004302 4541 JMS I ENDRD /FINISH READING THE LINE 2221 004303 1026 TAD T3 2222 004304 4537 JMS I CTYPE /AND TYPE IT 2223 004305 4557 JMS I RETTRN /TERMINATE LINE 2224 2225 004306 1073 ERRH1, TAD OCNT 2226 004307 1024 TAD T1 2227 004310 7650 SNA CLA /RIGHT POSITION YET? 2228 004311 5315 JMP ERRH2 /YES 2229 004312 1114 TAD C240 2230 004313 4547 JMS I PRINT /NO - TYPE A SPACE 2231 004314 5306 JMP ERRH1 /AGAIN 2232 2233 004315 1346 ERRH2, TAD (ERPONT 2234 004316 4564 JMS I TYPE /POINT AT THE ERROR 2235 004317 1025 TAD T2 /ERROR MESSAGE PTR 2236 004320 4564 JMS I TYPE /GIVE IT 2237 004321 4557 JMS I RETTRN 2238 004322 5554 JMP I PUTOUT /DO NEXT LINE 2239 /TYPE THE FIXED POOL STARTING AT C(AC)+1 2240 2241 004323 0000 CTTYPE, 0 2242 004324 3017 DCA INDEX7 /PTR TO STRING 2243 2244 004325 1417 CTTYP1, TAD I INDEX7 /GET NEXT 2245 004326 7450 SNA /ANY? 2246 004327 5723 JMP I CTTYPE /NO, DONE 2247 004330 4547 JMS I PRINT /YES - TYPE IT 2248 004331 5325 JMP CTTYP1 /AGAIN 2249 2250 2251 2252 / PUT NAME IN POOL POINTED TO BY T1 TO OUTPUT 2253 2254 004332 0000 PTNAME, 0 2255 2256 004333 4555 PTNAM1, JMS I RDPOOL /READ A CHAR 2257 004334 5732 JMP I PTNAME /NONE - DONE 2258 004335 7450 SNA /STRDEL? 2259 004336 5341 JMP PTNAM2 2260 004337 4551 JMS I PUTCHR /NO - PUT IT 2261 004340 5333 JMP PTNAM1 /AGAIN 2262 2263 004341 2332 PTNAM2, ISZ PTNAME 2264 004342 5732 JMP I PTNAME /DONE 2265 2266 2267 004346 2765 PAGE 004347 2037 004350 5741 004351 2234 004352 3513 004353 0200 004354 3473 004355 0466 004356 3443 004357 3423 004360 3407 004361 3365 004362 3327 004363 3301 004364 3251 004365 3233 004366 3217 004367 3177 004370 3155 004371 3141 004372 3121 004373 3073 004374 3061 004375 3041 004376 3027 004377 3015 2268 2269 /SAVE ACCUM IN SACCUM 2270 2271 004400 0000 SVACUM, 0 2272 004401 1135 TAD ACUMM 2273 004402 3016 DCA INDEX6 2274 004403 1377 TAD (SACCUM-1 2275 004404 3017 DCA INDEX7 2276 004405 1130 TAD NC10 /COUNT 2277 004406 3030 DCA TX 2278 2279 004407 1416 SVAC1, TAD I INDEX6 2280 004410 3417 DCA I INDEX7 /MOVE IT 2281 004411 2030 ISZ TX 2282 004412 5207 JMP SVAC1 2283 004413 5600 JMP I SVACUM /DONE 2284 / PUT ACCUM ONTO OLINE WITH RETURN 2285 2286 004414 0000 PACCUR, 0 2287 004415 1135 TAD ACUMM 2288 004416 4577 JMS I WRSTRO /PUT ACCUM TO OLINE 2289 004417 4556 JMS I RETORN /AND RETURN 2290 004420 5614 JMP I PACCUR /AND DONE 2291 2292 2293 2294 / PUT SOURCE LINE ONTO OUTPUT 2295 2296 004421 0000 PLINE, 0 2297 004422 1376 TAD (LINEIM-1 /PTR TO LINE 2298 004423 4576 JMS I WRSTR /WRITE IT 2299 004424 1376 TAD (LINEIM-1 2300 004425 3014 DCA LINEP 2301 004426 1375 TAD (1-LINEL 2302 004427 3045 DCA IMCNT 2303 004430 5621 JMP I PLINE /DONE 2304 2305 2306 /READ UNTIL END OF LINE OR END OF FILE 2307 2308 004431 0000 ENDRED, 0 2309 004432 1374 TAD (1-LINEIM 2310 004433 1014 TAD LINEP 2311 004434 7650 SNA CLA /ALREADY END OF LINE? 2312 004435 5631 JMP I ENDRED 2313 2314 004436 4542 ENDRD1, JMS I GETCHR /GET NEXT 2315 004437 5631 JMP I ENDRED /DONE - EOF 2316 004440 1132 TAD NC212 2317 004441 7640 SZA CLA /EOL? 2318 004442 5236 JMP ENDRD1 /NO 2319 004443 3070 DCA CHOLD 2320 004444 5631 JMP I ENDRED /YES - DONE 2321 /WRITE CARRAIGE RETURN ON OLINE 2322 2323 004445 0000 RETRN, 0 2324 004446 1373 TAD (RETURN-1 2325 004447 4577 JMS I WRSTRO /WRITE 2326 004450 5645 JMP I RETRN /DONE 2327 2328 2329 /CONVERT THE NUMBER IN THE AC TO A TWO DIGIT DECIMAL NUMBER (OUTPUT 2330 /PTR IN INDEX1) 2331 2332 004451 0000 CVD, 0 2333 004452 3017 DCA INDEX7 /SAVE NUM 2334 004453 3016 DCA INDEX6 /COUNT 2335 004454 1017 TAD INDEX7 /GET IT 2336 2337 004455 1131 CVD1, TAD NC12 /SUBTRACT DEC 10 2338 004456 7510 SPA /DONE? 2339 004457 5262 JMP CVD2 /YES 2340 004460 2016 ISZ INDEX6 /NO - BUMP COUNT 2341 004461 5255 JMP CVD1 / 2342 2343 004462 1113 CVD2, TAD C12 /DIGIT BACK TO NORMAL 2344 004463 3017 DCA INDEX7 2345 004464 1016 TAD INDEX6 2346 004465 7450 SNA /ANY TENS? 2347 004466 5275 JMP CVD4 /NO 2348 004467 1115 TAD C260 /YES - CAUSE ASCII 2349 004470 3411 CVD3, DCA I INDEX1 /PUT 2350 004471 1017 TAD INDEX7 /GET SINGLES PLACE 2351 004472 1115 TAD C260 /ASCIIIZE 2352 004473 3411 DCA I INDEX1 /PUT THAT 2353 004474 5651 JMP I CVD /DONE 2354 2355 004475 1114 CVD4, TAD C240 /TENS A ZERO - USE A SPACE 2356 004476 5270 JMP CVD3 2357 /TYPE A PACKED STRING - PTR IN AC 2358 2359 004477 0000 TTYPE, 0 2360 004500 4317 JMS EXTCUR /SETUP CURSOR FROM THE AC 2361 2362 004501 4543 TTYP1, JMS I GETCHS /GET NEXT 2363 004502 5305 JMP TTYP2 / 2364 004503 4547 JMS I PRINT /TYPE IT 2365 004504 5301 JMP TTYP1 /AGAIN 2366 2367 004505 4332 TTYP2, JMS EXFCUR /RESTORE CURSOR 2368 004506 5677 JMP I TTYPE /DONE 2369 2370 2371 /WRITE PACKED STRING TO OLINE, PTR IN (AC) 2372 2373 004507 0000 WRIPO, 0 2374 004510 4317 JMS EXTCUR /SETUP CURSOR 2375 004511 4543 WRIP1, JMS I GETCHS / 2376 004512 5315 JMP WRIP2 2377 004513 4567 JMS I WROLIN /PUT IT 2378 004514 5311 JMP WRIP1 2379 004515 4332 WRIP2, JMS EXFCUR /RESTORE CURSOR 2380 004516 5707 JMP I WRIPO /DONE 2381 2382 2383 /SETUP AND EXCHANGE CURSOR FROM THE LOCATION CONTAINED IN THE AC 2384 2385 004517 0000 EXTCUR, 0 2386 004520 3030 DCA TX /SAVE LOC 2387 004521 1071 TAD CURSOR 2388 004522 3041 DCA SCURS /SAVE CURSOR 2389 004523 1072 TAD CURSOR+1 2390 004524 3042 DCA SCURS+1 2391 004525 1030 TAD TX /GET BACK ADDR 2392 004526 3071 DCA CURSOR 2393 004527 7301 ONE 2394 004530 3072 DCA CURSOR+1 /CHAR POS 2395 004531 5717 JMP I EXTCUR /DONE 2396 2397 004532 0000 EXFCUR, 0 2398 004533 1041 TAD SCURS 2399 004534 3071 DCA CURSOR /RESTORE CURSOR FROM STORAGE 2400 004535 1042 TAD SCURS+1 2401 004536 3072 DCA CURSOR+1 / 2402 004537 5732 JMP I EXFCUR /AND DONE 2403 /WRITE LINEAR STRING ONTO OUTPUT FROM C(AC)+1 2404 2405 004540 0000 WRSTRG, 0 2406 004541 3017 DCA INDEX7 /PTR TO STRING 2407 2408 004542 1417 WRSTR1, TAD I INDEX7 /GET NEXT 2409 004543 7450 SNA /STRDEL? 2410 004544 5740 JMP I WRSTRG /YES - DONE 2411 004545 4551 JMS I PUTCHR /NO - PUT IT 2412 004546 5342 JMP WRSTR1 /NEXT 2413 2414 2415 2416 / WRITE CHAR TO OLINE FROM AC 2417 2418 004547 0000 WRITO, 0 2419 004550 3030 DCA TX /SAVE CHAR 2420 004551 1372 TAD (OLINE 2421 004552 3047 DCA HPOOL /HEAD OF POOL 2422 004553 1102 TAD COLINE /PTR TO END OF OLINE 2423 004554 3040 DCA T1MAT 2424 004555 1030 TAD TX /GET CHAR 2425 004556 4571 JMS I WRPOOL /WRITE IT 2426 004557 1040 TAD T1MAT 2427 004560 3102 DCA COLINE /UPDATE OLINE 2428 004561 5747 JMP I WRITO /DONE 2429 2430 2431 004572 2227 PAGE 004573 2246 004574 5741 004575 7661 004576 2037 004577 2216 2432 2433 /WRITE A PACKED STRING TO POLINE. PTR IN (AC) 2434 2435 004600 0000 WRPPO, 0 2436 004601 4777 JMS EXTCUR 2437 2438 004602 4543 WRPP1, JMS I GETCHS /GET THE NEXT CHARACTER 2439 004603 5206 JMP WRPP2 2440 004604 4570 JMS I WRPOLN /PUT ON POLINE 2441 004605 5202 JMP WRPP1 2442 2443 004606 4776 WRPP2, JMS EXFCUR 2444 004607 5600 JMP I WRPPO /DONE 2445 /WRITE LINEAR STRING TO OLINE POOL FROM C(AC)+1 2446 2447 004610 0000 WRSTO, 0 2448 004611 3017 DCA INDEX7 /SAVE PTR 2449 004612 1375 TAD (OLINE 2450 004613 3047 DCA HPOOL /HEAD OF POOL 2451 004614 1102 TAD COLINE 2452 004615 3040 DCA T1MAT /SAVE PTR TO OLINE 2453 2454 004616 1417 WRSTO1, TAD I INDEX7 /GET NEXT 2455 004617 7450 SNA /DONE? 2456 004620 5223 JMP WRSTO2 /YES 2457 004621 4571 JMS I WRPOOL /NO - WRITE THE CHAR 2458 004622 5216 JMP WRSTO1 2459 2460 004623 1040 WRSTO2, TAD T1MAT /GET UPDATED PTR 2461 004624 3102 DCA COLINE / 2462 004625 5610 JMP I WRSTO /DONE 2463 2464 2465 2466 / WRITE CHAR ON POLINE POOL FROM AC 2467 2468 004626 0000 WRITPO, 0 2469 004627 3030 DCA TX /SAVE CHAR 2470 004630 1374 TAD (POLINE 2471 004631 3047 DCA HPOOL /HEAD OF POOL 2472 004632 1103 TAD CPOLIN /PTR TO END OF POLINE 2473 004633 3040 DCA T1MAT 2474 004634 1030 TAD TX /GET THE CHARACTER 2475 004635 4571 JMS I WRPOOL 2476 004636 1040 TAD T1MAT 2477 004637 3103 DCA CPOLIN /UPDATE PTR 2478 004640 5626 JMP I WRITPO /DONE 2479 /WRITE LINEAR STRING ONTO POLINE POOL FROM C(AC)+1 2480 2481 004641 0000 WRSPO, 0 2482 004642 3017 DCA INDEX7 /PTR 2483 004643 1374 TAD (POLINE 2484 004644 3047 DCA HPOOL /HEAD OF POOL 2485 004645 1103 TAD CPOLIN 2486 004646 3040 DCA T1MAT /PTR TO POLINE POOL 2487 2488 004647 1417 WRSPO1, TAD I INDEX7 /GET NEXT CHAR 2489 004650 7450 SNA /DONE? 2490 004651 5254 JMP WRSPO2 /YES 2491 004652 4571 JMS I WRPOOL /NO, WRITE CHAR 2492 004653 5247 JMP WRSPO1 /AND NEXT 2493 2494 004654 1040 WRSPO2, TAD T1MAT 2495 004655 3103 DCA CPOLIN /UPDATE PTR 2496 004656 5641 JMP I WRSPO /DONE 2497 2498 2499 / WRITE OCTAL NUMBER IN AC ONTO OLINE 2500 2501 004657 0000 WROCTO, 0 2502 004660 3025 DCA T2 /SAVE NUMBER 2503 004661 1124 TAD NC4 /COUNT 2504 004662 3024 DCA T1 2505 004663 1375 TAD (OLINE 2506 004664 3047 DCA HPOOL /HEAD OF POOL 2507 004665 1102 TAD COLINE /PTR TO OLINE 2508 004666 3040 DCA T1MAT 2509 2510 004667 1025 WROC1, TAD T2 /GET NUM 2511 004670 7006 RTL; RAL /SHIFT 004671 7004 2512 004672 3025 DCA T2 2513 004673 1025 TAD T2 2514 004674 7004 RAL /GET NEXT DIGIT 2515 004675 0111 AND C7 2516 004676 1115 TAD C260 /FORM DIGIT 2517 004677 4571 JMS I WRPOOL /WRITE IT 2518 004700 2024 ISZ T1 /MORE? 2519 004701 5267 JMP WROC1 /YES 2520 004702 1040 TAD T1MAT 2521 004703 3102 DCA COLINE /NO, UPDATE PTR 2522 004704 5657 JMP I WROCTO /DONE 2523 / DELETE THE POOL POINTED TO BY (AC) 2524 2525 004705 0000 DPOOL, 0 2526 004706 7450 SNA /ANYTHING TO DELETE? 2527 004707 5705 JMP I DPOOL /NO - RETURN 2528 2529 004710 3030 DPOOL0, DCA TX /SAVE PTR 2530 2531 004711 7305 DPOOL1, TWO 2532 004712 1430 TAD I TX 2533 004713 7450 SNA /IS THIS A LINK WORD? 2534 004714 5324 JMP DPOOL3 2535 004715 7001 IAC 2536 004716 7650 SNA CLA /NO - A POLEND? 2537 004717 5335 JMP DPOOL4 /YES 2538 004720 7340 NONE 2539 004721 3430 DCA I TX /NO - FREE UP WORD 2540 004722 2030 ISZ TX /POINT TO NEXT 2541 004723 5311 JMP DPOOL1 /GO AGAIN 2542 2543 004724 7340 DPOOL3, NONE 2544 004725 3430 DCA I TX /FREE LINK WD 2545 004726 2030 ISZ TX 2546 004727 1430 TAD I TX /GET LINK ADDR 2547 004730 3031 DCA TXX 2548 004731 7340 NONE 2549 004732 3430 DCA I TX /FREE LINK ADDR WD 2550 004733 1031 TAD TXX /GET NEXT ADDR 2551 004734 5310 JMP DPOOL0 /AND GO 2552 2553 004735 7340 DPOOL4, NONE 2554 004736 3430 DCA I TX /CLEAR POLEND 2555 004737 5705 JMP I DPOOL 2556 / CHECK FROM INTERRUPT FROM KEYBOARD 2557 2558 004740 0000 INTRPT, 0 2559 004741 6031 KSF /ANYTHING TYPED? 2560 004742 5740 JMP I INTRPT /NO 2561 004743 6034 KRS /YES - GET IT 2562 004744 1373 TAD (-203 2563 004745 7640 SZA CLA /CONTROL C? 2564 004746 5740 JMP I INTRPT /NO - IGNORE IT 2565 004747 6032 KCC /REMOVE THE CHARACTER 2566 004750 1372 TAD (CNTLC 2567 004751 4564 JMS I TYPE /TYPE "^C" 2568 004752 6201 CDF 0 2569 004753 5771 JMP I (7600 /AND GO TO MONITOR 2570 2571 2572 2573 / SHIFT ACCUM ONE CHARACTER LEFT 2574 2575 004754 0000 SHFTAC, 0 2576 004755 1134 TAD ACUM 2577 004756 3016 DCA INDEX6 /READ ACCUM PTR 2578 004757 1135 TAD ACUMM 2579 004760 3017 DCA INDEX7 /PUT PTR 2580 004761 1130 TAD NC10 2581 004762 3030 DCA TX /COUNT 2582 2583 004763 1416 SHFT1, TAD I INDEX6 /GET THE NEXT 2584 004764 3417 DCA I INDEX7 2585 004765 2030 ISZ TX /MORE? 2586 004766 5363 JMP SHFT1 /YES 2587 004767 5754 JMP I SHFTAC /NO - DONE 2588 2589 2590 004771 7600 PAGE 004772 2521 004773 7575 004774 2230 004775 2227 004776 4532 004777 4517 2591 2592 / TYPE A RETURN ON THE TELETYPE 2593 2594 005000 0000 TYRET, 0 2595 005001 1377 TAD (RETURN-1 2596 005002 4537 JMS I CTYPE /TYPE A RETURN 2597 005003 5600 JMP I TYRET 2598 / ROUTINE TO SEARCH THE POOL POINTED TO BY T1 FOR THE STRING POINTED 2599 /TO BY (AC)+1. ASSUME (T2) WORDS TO BE IGNORED AFTER EACH STRDEL. SKIP 2600 /ON SUCCESS. 2601 2602 2603 2604 005004 0000 SERCH, 0 2605 005005 3243 DCA SERCHA /SAVE POSITION OF ATOM TO SEARCH FOR 2606 2607 005006 1243 SERCH1, TAD SERCHA /POS OF ATOM 2608 005007 3011 DCA INDEX1 /PTR FOR MATCH 2609 005010 1024 TAD T1 2610 005011 3040 DCA T1MAT /POS OF T1 WHEN MATCH SUCCEEDS 2611 2612 005012 4244 JMS MATCH /IS THIS A MATCH? 2613 005013 5216 JMP SERCH2 /NO 2614 005014 2204 ISZ SERCH /YES - SET FOR SKIP 2615 005015 5604 JMP I SERCH /AND DO IT 2616 2617 005016 7325 SERCH2, THREE 2618 005017 1424 TAD I T1 2619 005020 7650 SNA CLA /POLEND? 2620 005021 5604 JMP I SERCH /YES - FAIL 2621 005022 7340 NONE 2622 005023 1024 TAD T1 /GET CHAR POS 2623 005024 3024 DCA T1 /BACKUP 2624 2625 005025 4555 SERCH3, JMS I RDPOOL /GET THE NEXT CHARACTER 2626 005026 5604 JMP I SERCH /FAIL - END OF POOL 2627 005027 7640 SZA CLA /STRDEL? 2628 005030 5225 JMP SERCH3 2629 005031 7340 NONE 2630 005032 1025 TAD T2 2631 005033 3030 DCA TX /NEG COUNT OF INFO WORDS 2632 2633 005034 2030 SERCH4, ISZ TX 2634 005035 5237 JMP .+2 2635 005036 5206 JMP SERCH1 /DONE SKIPPING THEM 2636 005037 4555 JMS I RDPOOL 2637 005040 5604 JMP I SERCH /FAIL ON POLEND 2638 005041 7300 ZERO 2639 005042 5234 JMP SERCH4 /GO FOR MORE 2640 2641 2642 005043 0000 SERCHA, 0 /ARGUMENT ADDRESS 2643 / THIS ROUTINE DETERMINES WHETHER THE STRING (PTR IN INDEX1) 2644 /MATCHES A SUBSTRING IN THE POOL POINTED TO BY T1. SKIP ON 2645 /SUCCESS. 2646 2647 2648 2649 005044 0000 MATCH, 0 2650 005045 4555 JMS I RDPOOL /GET NEXT CHAR FROM THE POOL 2651 005046 5644 JMP I MATCH /END OF POOL 2652 005047 7450 SNA /STRDEL? 2653 005050 5262 JMP MAT1 /YES 2654 005051 3030 DCA TX /NO, SAVE CHAR 2655 005052 1411 TAD I INDEX1 /GET MATCH CHAR 2656 005053 7450 SNA /STRDEL? 2657 005054 5644 JMP I MATCH /YES - FAIL 2658 005055 7041 CMA IAC 2659 005056 1030 TAD TX / 2660 005057 7640 SZA CLA /MATCH? 2661 005060 5644 JMP I MATCH /NO 2662 005061 5245 JMP MATCH+1 /YES, SO FAR 2663 2664 005062 1411 MAT1, TAD I INDEX1 /GET CHAR 2665 005063 7650 SNA CLA /STRDEL? 2666 005064 2244 ISZ MATCH /YES - SKIP 2667 005065 5644 JMP I MATCH /NO - FAIL 2668 / WRITE AN XASC CALL ON PRE-OLINE 2669 2670 005066 0000 CALASC, 0 2671 005067 2075 ISZ GENLIT /BUMP GEN LIT COUNT 2672 005070 1075 TAD GENLIT 2673 005071 1120 TAD SARG /FORM SUBSTITUTE CODE 2674 005072 3776 DCA I (DCAGV /SAVE IT 2675 005073 1375 TAD (LITJMS /ASC CALL 2676 005074 4572 JMS I WRPPSO /PUT IT 2677 005075 1374 TAD (XASC 2678 005076 4572 JMS I WRPPSO 2679 005077 1135 TAD ACUMM 2680 005100 4575 JMS I WRSTPO /AND ACCUM 2681 005101 1373 TAD (RETURN 2682 005102 4572 JMS I WRPPSO 2683 005103 2034 ISZ CLEN 2684 005104 2034 ISZ CLEN /BUMP INST LENGTH COUNT 2685 005105 5666 JMP I CALASC /DONE 2686 2687 2688 2689 2690 / WRITE OCTAL NUMBER IN AC ONTO OUTPUT 2691 2692 005106 0000 PUTOCT, 0 2693 005107 3327 DCA P2 2694 005110 1124 TAD NC4 2695 005111 3326 DCA P1 /COUNT 2696 2697 005112 1327 PUTO1, TAD P2 /GET NUMBER 2698 005113 7106 CLL RTL; RAL /SHIFT 005114 7004 2699 005115 3327 DCA P2 2700 005116 1327 TAD P2 /SAVE 2701 005117 7004 RAL 2702 005120 0111 AND C7 2703 005121 1115 TAD C260 /FORM A DIGIT 2704 005122 4551 JMS I PUTCHR /WRITE IT 2705 005123 2326 ISZ P1 / 2706 005124 5312 JMP PUTO1 /MORE 2707 005125 5706 JMP I PUTOCT /DONE 2708 2709 2710 005126 0000 P1, 0 /LOCALS FOR PUTOCT 2711 005127 0000 P2, 0 2712 / READ A CHARACTER FROM THE POOL POINTED TO BY T1, SKIP ON 2713 /SUCCESS. 2714 2715 2716 2717 005130 0000 RDPOL, 0 2718 2719 005131 7325 RDP0, THREE 2720 005132 1424 TAD I T1 /GET CHAR 2721 005133 7450 SNA /POLEND? 2722 005134 5730 JMP I RDPOL /YES - FAIL 2723 005135 2024 ISZ T1 /UPDATE THE POINTER 2724 005136 1121 TAD NC1 2725 005137 7450 SNA /LINK (-2) ? 2726 005140 5344 JMP RDP1 /YES 2727 005141 1122 TAD NC2 /NORMALIZE 2728 005142 2330 ISZ RDPOL /NO - SKIP RETURN 2729 005143 5730 JMP I RDPOL /DONE 2730 2731 005144 1424 RDP1, TAD I T1 /GET THE ADDR 2732 005145 3024 DCA T1 /UPDATE PTR 2733 005146 5331 JMP RDP0 /GO AGAIN 2734 / WRITE A CHARACTER INTO THE POOL POINTED TO BY T1MAT. THE CHAR IS 2735 /SUPPLIED IN THE AC. REQUIRES WT1. 2736 2737 2738 005147 0000 WRPOL, 0 2739 005150 3366 DCA WT1 /SAVE THE CHARACTER 2740 005151 1040 TAD T1MAT /GET THE POOL POINTER 2741 005152 7450 SNA /ASSIGNED AN ADDRESS? 2742 005153 4772 JMS WRPAA /NO - GET ONE 2743 005154 4771 JMS WRPCA /AND CHECK IT 2744 005155 3040 DCA T1MAT 2745 005156 7301 ONE 2746 005157 1366 TAD WT1 /GET THE CHAR 2747 005160 7450 SNA 2748 005161 5770 JMP WRP1 /WRITE END CODE IF NULL 2749 005162 1121 TAD NC1 2750 2751 005163 3440 WRP0, DCA I T1MAT /WRITE THE CHARACTER 2752 005164 2040 ISZ T1MAT 2753 005165 5747 JMP I WRPOL /AND DONE 2754 2755 2756 005166 0000 WT1, 0 /TEMPORARY FOR WRPOL 2757 005170 5200 PAGE 005171 5301 005172 5207 005173 2247 005174 2377 005175 2371 005176 2260 005177 2246 2758 2759 005200 1077 WRP1, TAD OVERF 2760 005201 7650 SNA CLA /OVERWRITING POOL? 2761 005202 5205 JMP WRP2 2762 005203 1040 TAD T1MAT 2763 005204 4540 JMS I DELPOL /YES - DELETE THE OLD END OF THE POOL 2764 2765 005205 7346 WRP2, NTHREE 2766 005206 5777 JMP WRP0 /PUT POLEND AND DONE 2767 /FIND A VALID ADDRESS FOR A POOL EXTENSION. USES WT2, WT3 AND WT5. 2768 2769 005207 0000 WRPAA, 0 2770 005210 1776 TAD I (BASE /BASE OF DYNAMIC STORAGE 2771 005211 3344 DCA WT2 2772 2773 005212 1125 WRPA0, TAD NC5 2774 005213 3347 DCA WT5 /NUMBER OF FREE SPACES NECESSARY 2775 005214 7301 WRPA1, ONE 2776 005215 3345 DCA WT3 /SAVE MATCH WORD (FREE) 2777 2778 005216 1344 WRPA2, TAD WT2 /SEARCH FOR A FREE AREA 2779 005217 7041 CMA IAC 2780 005220 1032 TAD TOP 2781 005221 7650 SNA CLA /HAVE WE EXHAUSTED USED SPACE? 2782 005222 5246 JMP WRPA6 2783 005223 1345 TAD WT3 /NO - GET THE SEARCH WORD 2784 005224 1744 TAD I WT2 /GET THE WORD FROM STORAGE 2785 005225 2344 ISZ WT2 /POINT TO NEXT WORD 2786 005226 7450 SNA /MATCH? 2787 005227 5235 JMP WRPA3 2788 005230 7001 IAC /NO - CHECK FOR POLEND (CANNOT BE 2789 005231 7650 SNA CLA / LINK IF WT2 IS FREE) 2790 005232 5212 JMP WRPA0 2791 005233 7305 TWO /NO - SET THE MATCH TO LINK (MATCHES POLEND TOO) 2792 005234 5215 JMP WRPA1+1 /AND GO AGAIN 2793 2794 /FOUND THE MATCHED WORD - IF POLEND, THEN SET TO FREE AND LOOK FOR ENOUGH 2795 /FREE WORDS; IF FREE, INCREMENT WT5 AND CHECK THE NEXT WORD UNLESS WT5 2796 /HAS GONE TO ZERO IN WHICH CASE, WE FOUND A FREE ADDRESS. 2797 2798 005235 7344 WRPA3, NTWO 2799 005236 1345 TAD WT3 /GET THE MATCH WORD 2800 005237 7650 SNA CLA /LINK? 2801 005240 5244 JMP WRPA7 /YES - SKIP POINTER WORD 2802 005241 2347 ISZ WT5 /NO - BUMP FREE COUNT 2803 005242 5216 JMP WRPA2 /AND TRY FOR MORE 2804 005243 5247 JMP WRPA4 2805 2806 005244 2344 WRPA7, ISZ WT2 /POINT PAST THE LINK ADDRESS WORD 2807 005245 5212 JMP WRPA0 /AND LOOK FOR FREE SPACE 2808 005246 4263 WRPA6, JMS WRPA10 /CLEAR AREA AT TOP 2809 2810 005247 1347 WRPA4, TAD WT5 /POINT TO THE FIRST FREE WORD 2811 005250 1110 TAD C5 2812 005251 7041 CMA IAC 2813 005252 1344 TAD WT2 /CURRENT POINTER 2814 005253 3030 DCA TX 2815 005254 1040 TAD T1MAT /GET POINTER TO PREVIOUS WORD 2816 005255 7640 SZA CLA 2817 005256 5261 JMP WRPA5 2818 005257 1030 TAD TX 2819 005260 3447 DCA I HPOOL /UNSPECIFIED - UPDATE POOL HEADER 2820 005261 1030 WRPA5, TAD TX /GET BACK ADDRESS 2821 005262 5607 JMP I WRPAA /DONE 2822 2823 005263 0000 WRPA10, 0 /THIS CODE FREES NEW AREA AT THE TOP OF STORAGE 2824 005264 7340 NONE 2825 005265 1032 TAD TOP 2826 005266 3010 DCA INDEX0 2827 005267 1130 TAD NC10 2828 005270 3030 DCA TX 2829 005271 7340 NONE 2830 005272 3410 DCA I INDEX0 /CLEAR THE NEW FREE SPACE 2831 005273 2030 ISZ TX 2832 005274 5271 JMP .-3 2833 005275 1032 TAD TOP 2834 005276 1112 TAD C10 2835 005277 3032 DCA TOP /AND UPDATE TOP 2836 005300 5663 JMP I WRPA10 2837 / CHECK THIS ADDRESS (IN AC) FOR WRITING A CHARACTER HERE (THERE MUST 2838 /BE AT LEAST TWO FREE WORDS FOLLOWING IT). IF THERE IS NO ROOM, WRITE 2839 /A LINK CODE AND FIND A GOOD ADDRESS. REQUIRES WT4. 2840 2841 2842 2843 005301 0000 WRPCA, 0 2844 005302 3346 DCA WT4 /SAVE 2845 005303 7305 TWO 2846 005304 1346 TAD WT4 2847 005305 7041 CMA IAC 2848 005306 1032 TAD TOP /OVER THE TOP? 2849 005307 7750 SPA SNA CLA 2850 005310 5341 JMP WRPCA3 /YES 2851 005311 1077 TAD OVERF 2852 005312 7640 SZA CLA /OVERWRITING POOL? 2853 005313 5332 JMP WRPCA2 /YES 2854 005314 7305 TWO 2855 005315 1346 TAD WT4 /GET IT AGAIN 2856 005316 3030 DCA TX 2857 005317 7301 ONE 2858 005320 1430 TAD I TX 2859 005321 7650 SNA CLA /USED? 2860 005322 5342 JMP WRPCA3+1 /NO 2861 005323 7344 NTWO /LINK CODE 2862 005324 3746 DCA I WT4 2863 005325 2346 ISZ WT4 2864 005326 4207 JMS WRPAA /GET ANOTHER ADDR 2865 005327 3746 DCA I WT4 /PUT IT 2866 005330 1746 TAD I WT4 /GET IT BACK 2867 005331 5701 JMP I WRPCA /AND DONE 2868 2869 005332 7305 WRPCA2, TWO 2870 005333 1746 TAD I WT4 /GET CURRENT LOCATION 2871 005334 7640 SZA CLA /LINK CODE? 2872 005335 5342 JMP WRPCA3+1 /NO, USE ADDRESS 2873 005336 2346 ISZ WT4 /YES - POINT TO LINK ADDR 2874 005337 1746 TAD I WT4 /GET THE LINK ADDRESS 2875 005340 5302 JMP WRPCA+1 /AND CHECK IT 2876 2877 005341 4263 WRPCA3, JMS WRPA10 /GET FREE SPACE AT THE TOP OF STORAGE 2878 005342 1346 TAD WT4 /GET BACK THE ORIGINAL 2879 005343 5701 JMP I WRPCA /AND DONE 2880 2881 2882 005344 0000 WT2, 0 /TEMPORARIES FOR WRPAA AND WRPCA 2883 005345 0000 WT3, 0 2884 005346 0000 WT4, 0 2885 005347 0000 WT5, 0 2886 /WRITE PACKED STRING TO OUTPUT 2887 2888 2889 2890 2891 005350 0000 WPSTR, 0 2892 005351 4775 JMS EXTCUR /EXCHANGE CURSOR 2893 005352 4543 WPSTR1, JMS I GETCHS /GET NEXT 2894 005353 5356 JMP WPSTR2 2895 005354 4551 JMS I PUTCHR /PUT IT 2896 005355 5352 JMP WPSTR1 2897 2898 005356 4774 WPSTR2, JMS EXFCUR /RESTORE CURSOR 2899 005357 5750 JMP I WPSTR 2900 2901 005374 4532 PAGE 005375 4517 005376 2171 005377 5163 2902 /READ THE NEXT CHARACTER FROM THE INPUT BUFFER. SKIP ON SUCCESS. 2903 /THE POINTER TO THE INPUT BUFFER IS IN CURSOR AND CURSOR + 1. THE 2904 /NEXT CHARACTER'S LOCATION IS IN CURSOR AND THE CHARACTER NUMBER (1, 2905 /2 OR 3) IS IN CURSOR+1. 2906 2907 2908 2909 005400 0000 RDCHR, 0 2910 005401 1070 TAD CHOLD /GET THE TEMPORARY CHARACTER HOLD 2911 005402 7450 SNA 2912 005403 5211 JMP RDCH 2913 005404 3030 DCA TX /SAVE IT 2914 005405 2200 ISZ RDCHR /IF SPECIFIED, SKIP 2915 005406 3070 DCA CHOLD /DELETE IT 2916 005407 1030 TAD TX /BUT USE IT 2917 005410 5600 JMP I RDCHR 2918 2919 005411 7340 RDCH, NONE 2920 005412 5216 JMP RDCHR0 /SKIP RDCHRS ENTRY 2921 2922 005413 0000 RDCHRS, 0 /ENTER HERE TO NOT MODIFY CHARACTER 2923 005414 1213 TAD RDCHRS / 2924 005415 3200 DCA RDCHR /SETUP EXIT ROUTE 2925 2926 005416 3067 RDCHR0, DCA STRF /SET FLAG 2927 005417 1071 TAD CURSOR 2928 005420 1377 TAD (NTOPIB /NEG TOP OF INPUT BUFFER 2929 005421 7650 SNA CLA /BUFFER EXHAUSTED? 2930 005422 5322 JMP RDCH5 2931 005423 7346 NTHREE 2932 005424 1072 TAD CURSOR+1 /GET CHAR POS 2933 005425 7640 SZA CLA /THIRD? 2934 005426 5311 JMP RDCH4 /NO 2935 005427 7344 NTWO 2936 005430 1071 TAD CURSOR /YES - POINT AT FIRST WD 2937 005431 3017 DCA INDEX7 2938 005432 1417 TAD I INDEX7 / 2939 005433 0117 AND C7400 /SAVE TOP 4 BITS 2940 005434 7112 CLL RTR; RTR /SHIFT 005435 7012 2941 005436 3030 DCA TX 2942 005437 1417 TAD I INDEX7 2943 005440 0117 AND C7400 /BOTTOM 4 BITS 2944 005441 7106 CLL RTL; RTL; RAL /SHIFT THOSE INTO POSITION 005442 7006 005443 7004 2945 005444 1030 TAD TX 2946 005445 3030 DCA TX /SAVE CHAR 2947 005446 2071 ISZ CURSOR /BUMP POS PTR 2948 005447 7301 ONE 2949 005450 3072 DCA CURSOR+1 /FIRST CHAR AGAIN 2950 005451 2067 RDCH1, ISZ STRF /DON'T MODIFY FLAG? 2951 005452 5305 JMP RDCH3 /YES - DON'T MODIFY CHAR 2952 005453 1030 TAD TX /GET THE CHAR 2953 005454 7450 SNA /NULL? 2954 005455 5211 JMP RDCH /YES - TRY FOR NEXT CHARACTER 2955 005456 1132 TAD NC212 /CHECK FOR EOL 2956 005457 7510 SPA / 2957 005460 5277 JMP RDCH2 /NO 2958 005461 1123 TAD NC3 2959 005462 7510 SPA /LF, VT, FF? 2960 005463 5211 JMP RDCH /YES - IGNORE THEM 2961 005464 7450 SNA /RETURN? 2962 005465 5346 JMP RDCH7 /YES - EOL 2963 005466 1376 TAD (-13 2964 005467 7450 SNA /CONTROL X? 2965 005470 5362 JMP RDCH9 /YES 2966 005471 1122 TAD NC2 2967 005472 7450 SNA /CONTROL Z? 2968 005473 5362 JMP RDCH9 /YES 2969 005474 1375 TAD (-145 2970 005475 7650 SNA CLA /RUBOUT? 2971 005476 5211 JMP RDCH /YES - IGNORE IT 2972 2973 005477 7300 RDCH2, ZERO 2974 005500 1030 TAD TX /GET CHARACTER 2975 005501 2045 ISZ IMCNT /LINE IMAGE COUNT 2976 005502 7410 SKP 2977 005503 5774 JMP ERR1 /OVERFLOW 2978 005504 3414 DCA I LINEP /PUT CHAR 2979 005505 1030 RDCH3, TAD TX /AND GET IT BACK 2980 005506 7440 SZA /NO SKIP IF NULL 2981 005507 2200 ISZ RDCHR /SKIP RETURN 2982 005510 5600 JMP I RDCHR /AND DONE 2983 2984 005511 1471 RDCH4, TAD I CURSOR /GET 1ST OR 2ND CHAR 2985 005512 0116 AND C377 2986 005513 3030 DCA TX /SAVE IT 2987 005514 2072 ISZ CURSOR+1 /UPDATE PTR 2988 005515 7344 NTWO 2989 005516 1072 TAD CURSOR+1 /GET CHAR POS 2990 005517 7650 SNA CLA /NOW SECOND? 2991 005520 2071 ISZ CURSOR /YES - BUMP WD PTR 2992 005521 5251 JMP RDCH1 /AND FINISH 2993 005522 1773 RDCH5, TAD I (IBCNT 2994 005523 2773 ISZ I (IBCNT /TEST IF ANY MORE PAGES LEFT IN THE FILE 2995 005524 7740 SMA SZA CLA 2996 005525 5362 JMP RDCH9 /NO - FAIL 2997 005526 1145 TAD LUSR /(IBUF) PTR TO BUFFER 2998 005527 3071 DCA CURSOR /UPDATE PTR 2999 005530 1772 TAD I (INBLK / 3000 005531 3337 DCA IBLK /SETUP WHICH BLOCK 3001 005532 2772 ISZ I (INBLK /UPD PTR 3002 3003 005533 6201 CDF 0 3004 005534 4453 JMS I IHAN /CALL THE HANDLER 3005 005535 0210 0210 /READ 1 BLOCK TO FIELD 1 3006 005536 0200 IBUF /LOCATION OF BUFFER 3007 005537 0000 IBLK, 0 /WHICH BLOCK TO READ 3008 005540 5357 JMP RDCH8 /DONE - EOF 3009 005541 6211 CDF 10 3010 005542 1067 RDCH6, TAD STRF 3011 005543 7640 SZA CLA /WHICH ENTRY POINT? 3012 005544 5211 JMP RDCH /RDCHR 3013 005545 5216 JMP RDCHR0 /RDCHRS 3014 3015 005546 7300 RDCH7, ZERO 3016 005547 1371 TAD (212 /EOL - FORCE LF 3017 005550 3030 DCA TX 3018 005551 3414 DCA I LINEP /NULL THE END OF THE LINE 3019 005552 1370 TAD (1-LINEL 3020 005553 3045 DCA IMCNT /FINISH LINE IMAGE 3021 005554 1367 TAD (LINEIM-1 3022 005555 3014 DCA LINEP /UPD PTR 3023 005556 5305 JMP RDCH3 /AND DONE 3024 3025 005557 6211 RDCH8, CDF 10 3026 005560 7700 SMA CLA /FATAL ERROR RETURN? 3027 005561 5342 JMP RDCH6 /NO - ASSUME WE GOT A PARTIAL BLOCK 3028 005562 1366 RDCH9, TAD (-NTOPIB 3029 005563 3071 DCA CURSOR /CLEAR THE BUFFER POINTER 3030 005564 5600 JMP I RDCHR /DONE 3031 3032 005566 0600 PAGE 005567 2037 005570 7661 005571 0212 005572 2172 005573 2173 005574 4134 005575 7633 005576 7765 005577 7200 3033 / WRITE THE CHARACTER IN THE AC TO THE OUTPUT BUFFER. 3034 3035 005600 0000 WRCHR, 0 3036 005601 3030 DCA TX /SAVE CHAR 3037 005602 1056 TAD OFLAG /DOING OUTPUT? 3038 005603 7650 SNA CLA 3039 005604 5600 JMP I WRCHR /NO - FLUSH 3040 005605 1377 TAD (NTOPOB 3041 005606 1043 TAD OCURSR / 3042 005607 7640 SZA CLA /BUFFER FULL? 3043 005610 5233 JMP WRCH1 /NO 3044 005611 1376 TAD (OBUF 3045 005612 3043 DCA OCURSR /YES - FIX PTR 3046 005613 7301 ONE 3047 005614 3044 DCA OCURSR+1 3048 005615 1775 TAD I (OUTBLK /WHICH OUTPUT BLOCK TO WRITE 3049 005616 3225 DCA OBLK 3050 005617 2775 ISZ I (OUTBLK /UPDATE 3051 005620 2775 ISZ I (OUTBLK 3052 3053 005621 6201 CDF 0 3054 005622 4454 JMS I OHAN /CALL THE HANDLER 3055 005623 4410 4410 /WRITE 4 PAGES FROM FIELD 1 3056 005624 0600 OBUF /OUTPUT BUFFER 3057 005625 0000 OBLK, 0 /WHICH BLOCK 3058 005626 5774 JMP ERR3 /OUTPUT ERROR 3059 005627 6211 CDF 10 3060 3061 005630 2773 ISZ I (OBCNT /OUTPUT FILE FULL? 3062 005631 5233 JMP .+2 3063 005632 5772 JMP ERR2 /YES - ERROR 3064 005633 7346 WRCH1, NTHREE 3065 005634 1044 TAD OCURSR+1 3066 005635 7640 SZA CLA /THIRD CHARACTER? 3067 005636 5263 JMP WRCH3 /NO 3068 005637 7340 NONE 3069 005640 1043 TAD OCURSR / 3070 005641 3031 DCA TXX /TOP BITS GO INTO THE PREV WD 3071 005642 1030 TAD TX /GET THE CHAR 3072 005643 7006 RTL; RTL /SHIFT INTO PLACE 005644 7006 3073 005645 0117 AND C7400 /TOP 4 BITS 3074 005646 1431 TAD I TXX /ADD IN OTHER CHAR 3075 005647 3431 DCA I TXX /SAVE 3076 005650 1030 TAD TX /GET THE CHAR AGAIN 3077 005651 7012 RTR; RTR; RAR /SHIFT AGAIN 005652 7012 005653 7010 3078 005654 0117 AND C7400 /SAVE BOTTOM 4 BITS 3079 005655 1443 TAD I OCURSR /ADD IN CHAR 3080 005656 3443 DCA I OCURSR /AND SAVE 3081 005657 7301 ONE /1ST CHAR AGAIN 3082 005660 3044 DCA OCURSR+1 / 3083 005661 2043 ISZ OCURSR /UPD PTR 3084 005662 5600 JMP I WRCHR /DONE 3085 3086 005663 1030 WRCH3, TAD TX /GET CHAR 3087 005664 0116 AND C377 /TRUNCATE 3088 005665 3443 DCA I OCURSR /SAVE IT 3089 005666 2044 ISZ OCURSR+1 /UPD CHAR CNT 3090 005667 7344 NTWO 3091 005670 1044 TAD OCURSR+1 /GET WHICH CHAR 3092 005671 7650 SNA CLA /FIRST? 3093 005672 2043 ISZ OCURSR /YES - UPD PTR 3094 005673 5600 JMP I WRCHR /NO - DONE 3095 /TELETYPE OUTPUT ROUTINE 3096 3097 3098 005674 0000 PRN, 0 3099 005675 3347 DCA TPRN /SAVE CHAR 3100 005676 4544 JMS I INTST /CHECK FOR INTERRUPT 3101 005677 1073 TAD OCNT 3102 005700 7650 SNA CLA /ANY CHARACTERS ON LINE YET? 3103 005701 5323 JMP PRN2 3104 005702 1347 PRN0, TAD TPRN 3105 005703 1371 TAD (-215 / 3106 005704 7450 SNA /RETURN? 3107 005705 3073 DCA OCNT /YES - ZERO COUNT 3108 005706 1370 TAD (4 3109 005707 7650 SNA CLA /TAB? 3110 005710 5314 JMP PRN1 /YES 3111 005711 1347 TAD TPRN 3112 005712 4332 JMS PRX /NO - TYPE THE CHAR 3113 005713 5674 JMP I PRN /DONE 3114 3115 005714 1114 PRN1, TAD C240 /TYPE A SPACE 3116 005715 4332 JMS PRX 3117 005716 1073 TAD OCNT /UNTIL OCNT 3118 005717 0111 AND C7 3119 005720 7640 SZA CLA /GOES TO MOD 8 3120 005721 5314 JMP PRN1 /NO 3121 005722 5674 JMP I PRN /YES - THEN DONE 3122 3123 005723 1347 PRN2, TAD TPRN 3124 005724 1132 TAD NC212 3125 005725 7650 SNA CLA /ONLY A LINE FEED? 3126 005726 5302 JMP PRN0 /YES 3127 005727 1367 TAD ("/ 3128 005730 4551 JMS I PUTCHR /COMMENT OUT LINE IN OUTPUT 3129 005731 5302 JMP PRN0 3130 3131 005732 0000 PRX, 0 3132 005733 6046 TLS /TYPE THE CHARACTER 3133 005734 1366 TAD (-232 /-^Z 3134 005735 7540 SMA SZA /PRINTING CHAR? 3135 005736 2073 ISZ OCNT /YES - BUMP POS 3136 005737 1365 TAD (232 3137 005740 4551 JMS I PUTCHR /WRITE IT IN THE OUTPUT FILE 3138 005741 1073 TAD OCNT 3139 005742 7440 SZA 3140 005743 3074 DCA TOCNT /SAVE TOCNT AS TOP OCNT 3141 005744 6041 TSF 3142 005745 5344 JMP .-1 3143 005746 5732 JMP I PRX /AND DONE 3144 3145 005747 0000 TPRN, 0 /TEMPORARY CHARACTER HOLD 3146 3147 005765 0232 FIELD 1 005766 7546 005767 0257 005770 0004 005771 7563 005772 4143 005773 2175 005774 4200 005775 2174 005776 0600 005777 6200 3148 *1600 3149 / COMMAND POOL 3150 3151 3152 011600 0320 CMDTAB, "P;"A;"L; STRDEL; CPAL 011601 0301 011602 0314 011603 0000 011604 0100 3153 011605 0323 "S;"N;"O;"B;"O;"L; STRDEL; CSNO 011606 0316 011607 0317 011610 0302 011611 0317 011612 0314 011613 0000 011614 0200 3154 011615 0314 "L;"O;"O;"K;"U;"P; STRDEL; VARORLIT 011616 0317 011617 0317 011620 0313 011621 0325 011622 0320 011623 0000 011624 0001 3155 011625 0305 "E;"N;"T;"E;"R; STRDEL; VARORLIT 011626 0316 011627 0324 011630 0305 011631 0322 011632 0000 011633 0001 3156 011634 0311 "I;"C;"L;"O;"S;"E; STRDEL; NOARG 011635 0303 011636 0314 011637 0317 011640 0323 011641 0305 011642 0000 011643 0002 3157 011644 0317 "O;"C;"L;"O;"S;"E; STRDEL; NOARG 011645 0303 011646 0314 011647 0317 011650 0323 011651 0305 011652 0000 011653 0002 3158 011654 0320 "P;"U;"S;"H;"J; STRDEL; LABEL 011655 0325 011656 0323 011657 0310 011660 0312 011661 0000 011662 0004 3159 011663 0320 "P;"O;"P;"J; STRDEL; NOARG 011664 0317 011665 0320 011666 0312 011667 0000 011670 0002 3160 011671 0305 "E;"X;"I;"T; STRDEL; CEXIT 011672 0330 011673 0311 011674 0324 011675 0000 011676 0400 3161 011677 0305 "E;"N;"D; STRDEL; CEND 011700 0316 011701 0304 011702 0000 011703 1000 3162 011704 0320 "P;"U;"S;"H; STRDEL; VAR 011705 0325 011706 0323 011707 0310 011710 0000 011711 0020 3163 011712 0320 "P;"O;"P; STRDEL; VAR 011713 0317 011714 0320 011715 0000 011716 0020 3164 011717 7775 POLEND /END OF COMMAND POOL 3165 / SPECIAL FUNCTION NAMES POOL 3166 3167 3168 011720 0317 SPFNPL, "O;"U;"T;"P;"U;"T;STRDEL 011721 0325 011722 0324 011723 0320 011724 0325 011725 0324 011726 0000 3169 011727 0311 "I;"N;"P;"U;"T;STRDEL 011730 0316 011731 0320 011732 0325 011733 0324 011734 0000 3170 011735 0317 "O;"U;"T;"H;"O;"L;STRDEL 011736 0325 011737 0324 011740 0310 011741 0317 011742 0314 011743 0000 3171 011744 0322 "R;"E;"A;"D;STRDEL 011745 0305 011746 0301 011747 0304 011750 0000 3172 011751 0327 "W;"R;"I;"T;"E;STRDEL 011752 0322 011753 0311 011754 0324 011755 0305 011756 0000 3173 011757 0327 "W;"R;"I;"T;"E;"H;STRDEL 011760 0322 011761 0311 011762 0324 011763 0305 011764 0310 011765 0000 3174 011766 0320 "P;"O;"S;"R;STRDEL 011767 0317 011770 0323 011771 0322 011772 0000 3175 011773 7775 POLEND 3176 / DELIMITER TABLE 3177 3178 3179 011774 7567 DELST, -211; SPACE 011775 0020 3180 011776 7566 -212; EOL 011777 0010 3181 012000 7563 -215; SPACE 012001 0020 3182 012002 7540 -240; SPACE 012003 0020 3183 012004 7537 -241; OR 012005 0016 3184 012006 7530 -250; LPAREN 012007 0006 3185 012010 7527 -251; RPAREN 012011 0004 3186 012012 7526 -252; STAR 012013 0003 3187 012014 7525 -253; ADD 012015 0001 3188 012016 7524 -254; COMMA 012017 0022 3189 012020 7521 -257; SLASH 012021 0002 3190 012022 7506 -272; COLON 012023 0021 3191 012024 7505 -273; SEMI 012025 0017 3192 012026 7503 -275; EQUAL 012027 0015 3193 012030 7504 -274; LESS 012031 0014 3194 012032 7442 -336; UPARR 012033 0023 3195 012034 7441 -337; BACK 012035 0012 3196 012036 7523 -255; SUB /END OF TABLE (NOTE SUB = 0) 012037 0000 3197 / VARIOUS BULK STORAGE 3198 3199 3200 LINEL=120 /LENGTH OF LINE INPUT BUFFER (80 CHARACTERS) 3201 3202 012040 0000 LINEIM, ZBLOCK 116 /LINE INPUT IMAGE 012041 0000 012042 0000 012043 0000 012044 0000 012045 0000 012046 0000 012047 0000 012050 0000 012051 0000 012052 0000 012053 0000 012054 0000 012055 0000 012056 0000 012057 0000 012060 0000 012061 0000 012062 0000 012063 0000 012064 0000 012065 0000 012066 0000 012067 0000 012070 0000 012071 0000 012072 0000 012073 0000 012074 0000 012075 0000 012076 0000 012077 0000 012100 0000 012101 0000 012102 0000 012103 0000 012104 0000 012105 0000 012106 0000 012107 0000 012110 0000 012111 0000 012112 0000 012113 0000 012114 0000 012115 0000 012116 0000 012117 0000 012120 0000 012121 0000 012122 0000 012123 0000 012124 0000 012125 0000 012126 0000 012127 0000 012130 0000 012131 0000 012132 0000 012133 0000 012134 0000 012135 0000 012136 0000 012137 0000 012140 0000 012141 0000 012142 0000 012143 0000 012144 0000 012145 0000 012146 0000 012147 0000 012150 0000 012151 0000 012152 0000 012153 0000 012154 0000 012155 0000 3203 012156 0215 215;212;0 /FOR OVERFLOW CONDITIONS 012157 0212 012160 0000 3204 012161 0000 ACCUM, ZBLOCK 10 /7 CHARACTER IDENTIFIER ACCUMULATION (SCAN) 012162 0000 012163 0000 012164 0000 012165 0000 012166 0000 012167 0000 012170 0000 3205 3206 012171 0000 BASE, 0 /BASE OF POOL STORAGE 3207 012172 0000 INBLK, 0 /WHICH INPUT BLOCK 3208 012173 0000 IBCNT, 0 /NEG LENGTH OF INPUT FILE (BLOCKS) 3209 012174 0000 OUTBLK, 0 /WHICH OUTPUT BLOCK 3210 012175 0000 OBCNT, 0 /NEG LENGTH OF OUTPUT FILE 3211 012176 0000 CDEL, 0 /HOLD DELIMITER CHARACTER 3212 3213 3214 F1CLR=. /IMPURE AREA - ANY LOCATIONS BETWEEN HERE 3215 /AND F1CLRL ARE AUTOMATICALLY CLEARED AT 3216 /INITIALIZATION 3217 3218 012177 0000 LITS, ZBLOCK 10 /LITERAL POOL HEADERS 012200 0000 012201 0000 012202 0000 012203 0000 012204 0000 012205 0000 012206 0000 3219 012207 0000 ARGENV, ZBLOCK 10 /ARITHMETIC GENERATED VARIABLES STORAGE 012210 0000 012211 0000 012212 0000 012213 0000 012214 0000 012215 0000 012216 0000 3220 012217 0000 SACCUM, ZBLOCK 10 /SAVE ACCUM BLOCK 012220 0000 012221 0000 012222 0000 012223 0000 012224 0000 012225 0000 012226 0000 3221 3222 012227 0000 OLINE, 0 /HEADER FOR OLINE POOL 3223 012230 0000 POLINE, 0 /HEADER FOR POLINE POOL 3224 012231 0000 LABPOL, 0 /HEADER FOR LABEL POOL 3225 012232 0000 VARPOL, 0 /HEADER FOR VARIABLE POOL 3226 012233 0000 ULBPOL, 0 /HEADER FOR UNDEFINED LABELS POOL 3227 012234 0000 ERRC, 0 /COMPILATION ERROR COUNT 3228 012235 0000 MODE, 0 /COMPILER MODE (0: SNOBOL, 1: PAL) 3229 3230 F1CLRL=.-F1CLR /HERE ENDS THE AUTOMATIC CLEAR AREA FOR FIELD 1 3231 / MODIFIABLE LITERALS 3232 3233 012236 0000 MONTH, 0;0;"/ 012237 0000 012240 0257 3234 012241 0000 DAY, 0;0;"/;"7 012242 0000 012243 0257 012244 0267 3235 012245 0000 YEAR, 0;0 012246 0000 3236 012247 0215 RETURN, 215;212;0 012250 0212 012251 0000 3237 012252 0215 DCAGVC, 215;212;"D;"C;"A;" 012253 0212 012254 0304 012255 0303 012256 0301 012257 0240 3238 012260 0000 DCAGV, 0;215;212;0 012261 0215 012262 0212 012263 0000 3239 012264 0324 TADCON, "T;"A;"D;" 012265 0301 012266 0304 012267 0240 3240 012270 0000 TADGV, 0;215;212;0 012271 0215 012272 0212 012273 0000 3241 012274 0324 TESTSF, "T;"A;"D;" ;"X;"S;"U;"C;"C;"E;"S;215;212;"S 012275 0301 012276 0304 012277 0240 012300 0330 012301 0323 012302 0325 012303 0303 012304 0303 012305 0305 012306 0323 012307 0215 012310 0212 012311 0323 3242 012312 0000 TESTQ, 0;"A;" ;"C;"L;"A;215;212;0 012313 0301 012314 0240 012315 0303 012316 0314 012317 0301 012320 0215 012321 0212 012322 0000 3243 / TEXT FOR WRITE PACKED STRING ROUTINES 3244 3245 3246 INITAL, /SNOBOL 8.2> 3247 012323 6257 6257;7323;6317;7702;5714;4240;4256;4662;0;0 012324 7323 012325 6317 012326 7702 012327 5714 012330 4240 012331 4256 012332 4662 012333 0000 012334 0000 3248 INITA2, /;;JMS I XINIT;XIND;X0;XVLEN;XTOP; 3249 012335 4215 4215;5212;6712;1715;5240;0311;6330;7311;4311;6724;6212;4730;4316;6704 012336 5212 012337 6712 012340 1715 012341 5240 012342 0311 012343 6330 012344 7311 012345 4311 012346 6724 012347 6212 012350 4730 012351 4316 012352 6704 3250 012353 5612 5612;330;6615;4212;6326;2714;4316;5215;6330;7724;4320;5215;212;0 012354 0330 012355 6615 012356 4212 012357 6326 012360 2714 012361 4316 012362 5215 012363 6330 012364 7724 012365 4320 012366 5215 012367 0212 012370 0000 3251 LITJMS, /JMS I X 3252 012371 6712 6712;1715;5240;311;330;0 012372 1715 012373 5240 012374 0311 012375 0330 012376 0000 3253 XASC, /ASC; 3254 012377 6301 6301;1723;215;212 012400 1723 012401 0215 012402 0212 3255 XINT, /INT; 3256 012403 6711 6711;2316;215;212 012404 2316 012405 0215 012406 0212 3257 NCMDF, /-4000; 3258 012407 5655 5655;264;4260;6660;212;0 012410 0264 012411 4260 012412 6660 012413 0212 012414 0000 3259 FILEND, /0; 3260 012415 0260 260;273 012416 0273 3261 EXITCL, /JMP I (7600; 3262 012417 6712 6712;315;5240;311;5650;3267;4260;6660;212;0 012420 0315 012421 5240 012422 0311 012423 5650 012424 3267 012425 4260 012426 6660 012427 0212 012430 0000 3263 ORCODE, /XORC; 3264 012431 6730 6730;1317;4303;5215;0;0 012432 1317 012433 4303 012434 5215 012435 0000 012436 0000 3265 EQUALC, /XEQC; 3266 012437 6730 6730;705;4303;5215;0;0 012440 0705 012441 4303 012442 5215 012443 0000 012444 0000 3267 COMPC, /CMA IAC; 3268 012445 6303 6303;0715;6240;0711;4303;5215;0;0 012446 0715 012447 6240 012450 0711 012451 4303 012452 5215 012453 0000 012454 0000 3269 SHFT3, /CLL RAL; CLL RAL; CLL RAL; 3270 012455 6303 6303;6314;6240;722;4314;5215;6303;6314;6240;0722;4314;5215 012456 6314 012457 6240 012460 0722 012461 4314 012462 5215 012463 6303 012464 6314 012465 6240 012466 0722 012467 4314 012470 5215 3271 012471 6303 6303;6314;6240;722;4314;5215;0;0 012472 6314 012473 6240 012474 0722 012475 4314 012476 5215 012477 0000 012500 0000 3272 FCODE, /XFENC; 3273 012501 6330 6330;2706;4316;6703;212;0 012502 2706 012503 4316 012504 6703 012505 0212 012506 0000 3274 JMPCAL, /JMP .+ 3275 012507 6712 6712;315;5240;5656;0;0 012510 0315 012511 5240 012512 5656 012513 0000 012514 0000 3276 STOR, /, 0; 3277 012515 5654 5654;211;215;212 012516 0211 012517 0215 012520 0212 3278 CNTLC, /^C; 3279 012521 4336 4336;6703;212;0 012522 6703 012523 0212 012524 0000 3280 JMPLAB, /JMP_ 3281 012525 6712 6712;315;240;0 012526 0315 012527 0240 012530 0000 3282 PAGJMP, /JMP I (.&7600+200;PAGE;XP 3283 012531 6712 6712;315;5240;311;5250;3256;5667;266;5660;1253;4260;6660;6212 012532 0315 012533 5240 012534 0311 012535 5250 012536 3256 012537 5667 012540 0266 012541 5660 012542 1253 012543 4260 012544 6660 012545 6212 3284 012546 0720 720;4307;6705;6612;330;0;0 012547 4307 012550 6705 012551 6612 012552 0330 012553 0000 012554 0000 3285 PAGFIN, /=.; 3286 012555 4275 4275;6656;212;0 012556 6656 012557 0212 012560 0000 3287 FILLER, /XFLC; 3288 012561 6330 6330;6306;303;273 012562 6306 012563 0303 012564 0273 3289 PATCAL, /JMS I XPAT 3290 012565 6712 6712;1715;5240;311;6330;720;4324;5215;0;0 012566 1715 012567 5240 012570 0311 012571 6330 012572 0720 012573 4324 012574 5215 012575 0000 012576 0000 3291 INDCAL, /JMS I XINDRC; 3292 012577 6712 6712;1715;5240;311;6330;7311;6304;1722;215;212 012600 1715 012601 5240 012602 0311 012603 6330 012604 7311 012605 6304 012606 1722 012607 0215 012610 0212 3293 ENDC1, /;PAGE;X0,; 3294 012611 6615 6615;212;6301;2707;4215;5212;5330;6260;215;212 012612 0212 012613 6301 012614 2707 012615 4215 012616 5212 012617 5330 012620 6260 012621 0215 012622 0212 3295 ENDC2, /;XVLEN=.-X0 3296 012623 6612 6612;3330;6314;7305;5275;6656;4330;6660;212;212 012624 3330 012625 6314 012626 7305 012627 5275 012630 6656 012631 4330 012632 6660 012633 0212 012634 0212 3297 ENDC3, /, XX 3298 012635 6654 6654;4211;330;0 012636 4211 012637 0330 012640 0000 3299 ENDC5, /.; 3300 012641 4256 4256;5215;0;0 012642 5215 012643 0000 012644 0000 3301 ENDC6, /;FIELD 1;*XFIELD1;XIND= 3302 012645 4215 4215;5212;6306;2711;5314;0304;4261;5215;6252;3330;6311;6305;4304 012646 5212 012647 6306 012650 2711 012651 5314 012652 0304 012653 4261 012654 5215 012655 6252 012656 3330 012657 6311 012660 6305 012661 4304 3303 012662 6661 6661;6612;4212;6311;2316;275;0 012663 6612 012664 4212 012665 6311 012666 2316 012667 0275 012670 0000 3304 ENDC7, /;XX 3305 012671 6615 6615;4212;330;0 012672 4212 012673 0330 012674 0000 3306 ENDC10, /;XTOP=.;$$$; 3307 012675 4215 4215;5212;6330;7724;5320;7275;4215;5212;5244;2244;4615;5212;0;0 012676 5212 012677 6330 012700 7724 012701 5320 012702 7275 012703 4215 012704 5212 012705 5244 012706 2244 012707 4615 012710 5212 012711 0000 012712 0000 3308 ENDC20, /UNDEFINED ADDRESSES:_ 3309 012713 6325 6325;2316;6305;4706;6316;2305;6240;2301;6304;2722;6323;2723 012714 2316 012715 6305 012716 4706 012717 6316 012720 2305 012721 6240 012722 2301 012723 6304 012724 2722 012725 6323 012726 2723 3310 012727 5323 5323;272;240;240 012730 0272 012731 0240 012732 0240 3311 ENDC21, /MANY 3312 012733 6315 6315;7301;331;0 012734 7301 012735 0331 012736 0000 3313 ENDC22, /NO 3314 012737 0316 316;317 012740 0317 3315 ENDC23, / ERRORS DETECTED; 3316 012741 6640 6640;1305;6722;1317;6323;2240;6305;2724;6303;2724;4304;5215;212;0 012742 1305 012743 6722 012744 1317 012745 6323 012746 2240 012747 6305 012750 2724 012751 6303 012752 2724 012753 4304 012754 5215 012755 0212 012756 0000 3317 ENDC24, /TEXT . 3318 012757 6724 6724;4305;5324;7211;0;0 012760 4305 012761 5324 012762 7211 012763 0000 012764 0000 3319 / ERROR MESSAGES 3320 3321 3322 ERPONT, /^; 3323 012765 0336 336;240 012766 0240 3324 ERLTL, /LINE TOO LONG 3325 012767 6314 6314;7311;6705;2240;5317;317;6314;7317;307;0 012770 7311 012771 6705 012772 2240 012773 5317 012774 0317 012775 6314 012776 7317 012777 0307 013000 0000 3326 EROFF, /OUTPUT FILE FULL 3327 013001 6717 6717;2325;6720;2325;6240;4706;5314;305;6306;6325;314;0 013002 2325 013003 6720 013004 2325 013005 6240 013006 4706 013007 5314 013010 0305 013011 6306 013012 6325 013013 0314 013014 0000 3328 EROER, /OUTPUT ERROR 3329 013015 6717 6717;2325;6720;2325;6640;1305;6722;1317;0;0 013016 2325 013017 6720 013020 2325 013021 6640 013022 1305 013023 6722 013024 1317 013025 0000 013026 0000 3330 ERIVN, /INVALID NUMBER 3331 013027 6711 6711;3316;6301;4714;6304;7240;6325;1315;305;322 013030 3316 013031 6301 013032 4714 013033 6304 013034 7240 013035 6325 013036 1315 013037 0305 013040 0322 3332 ERIARG, /ILLEGAL ARGUMENT TYPE 3333 013041 6311 6311;6314;6305;707;6314;640;6722;2707;6315;7305;6724;2240;6331;2720;0;0 013042 6314 013043 6305 013044 0707 013045 6314 013046 0640 013047 6722 013050 2707 013051 6315 013052 7305 013053 6724 013054 2240 013055 6331 013056 2720 013057 0000 013060 0000 3334 ERPEOF, /PRE-MATURE EOF 3335 013061 6320 6320;2722;6255;715;6724;1325;6305;2640;317;306 013062 2722 013063 6255 013064 0715 013065 6724 013066 1325 013067 6305 013070 2640 013071 0317 013072 0306 3336 ERNIR, /NAMES MAY NOT BEGIN WITH X OR . 3337 013073 6316 6316;6701;5305;0323;6715;4701;6240;7716;6324;1240;6305;4707;6716;3640 013074 6701 013075 5305 013076 0323 013077 6715 013100 4701 013101 6240 013102 7716 013103 6324 013104 1240 013105 6305 013106 4707 013107 6716 013110 3640 3338 013111 6311 6311;4324;5240;330;5317;322;256;0 013112 4324 013113 5240 013114 0330 013115 5317 013116 0322 013117 0256 013120 0000 3339 ERLIV, /ILLEGAL LITERAL VALUE 3340 013121 6311 6311;6314;6305;707;6314;6240;6311;2724;6322;6301;6240;726 013122 6314 013123 6305 013124 0707 013125 6314 013126 6240 013127 6311 013130 2724 013131 6322 013132 6301 013133 6240 013134 0726 3341 013135 6314 6314;2725;0;0 013136 2725 013137 0000 013140 0000 3342 ERIC, /ILLEGAL CHARACTER 3343 013141 6311 6311;6314;6305;707;6314;1640;6710;1301;6701;2303;305;322 013142 6314 013143 6305 013144 0707 013145 6314 013146 1640 013147 6710 013150 1301 013151 6701 013152 2303 013153 0305 013154 0322 3344 ERLNI, /LABEL MAY NOT BE INDIRECT 3345 013155 6314 6314;1301;5305;0314;6715;4701;6240;7716;6324;1240;6305;4640;6316 013156 1301 013157 5305 013160 0314 013161 6715 013162 4701 013163 6240 013164 7716 013165 6324 013166 1240 013167 6305 013170 4640 013171 6316 3346 013172 4704 4704;6322;1705;324;0 013173 6322 013174 1705 013175 0324 013176 0000 3347 ERMDL, /MULTIPLY DEFINED LABEL 3348 013177 6315 6315;6325;6724;311;5314;331;6304;3305;6311;2716;6304;6240 013200 6325 013201 6724 013202 0311 013203 5314 013204 0331 013205 6304 013206 3305 013207 6311 013210 2716 013211 6304 013212 6240 3349 013213 6301 6301;2702;314;0 013214 2702 013215 0314 013216 0000 3350 ERID, /ILLEGAL DELIMITER 3351 013217 6311 6311;6314;6305;707;6314;2240;6305;4714;6715;2311;305;322 013220 6314 013221 6305 013222 0707 013223 6314 013224 2240 013225 6305 013226 4714 013227 6715 013230 2311 013231 0305 013232 0322 3352 ERUC, /UNRECOGNIZED COMMAND 3353 013233 6725 6725;1316;6305;7703;6307;4716;6332;2305;6240;7703;6315;715;316;304 013234 1316 013235 6305 013236 7703 013237 6307 013240 4716 013241 6332 013242 2305 013243 6240 013244 7703 013245 6315 013246 0715 013247 0316 013250 0304 3354 ERARTB, /MAGNITUDE OF ARGUMENT IS TOO LARGE 3355 013251 6315 6315;3701;6716;2311;6325;2704;6240;3317;6640;1301;6307;6725;6705 013252 3701 013253 6716 013254 2311 013255 6325 013256 2704 013257 6240 013260 3317 013261 6640 013262 1301 013263 6307 013264 6725 013265 6705 3356 013266 2316 2316;6640;1711;6240;7724;6317;6240;6301;3722;305;0 013267 6640 013270 1711 013271 6240 013272 7724 013273 6317 013274 6240 013275 6301 013276 3722 013277 0305 013300 0000 3357 ERNAE, /ARGUMENT MAY NOT FOLLOW AN EQUAL 3358 013301 6301 6301;3722;6325;2715;5316;324;6715;4701;6240;7716;6324;3240;6317 013302 3722 013303 6325 013304 2715 013305 5316 013306 0324 013307 6715 013310 4701 013311 6240 013312 7716 013313 6324 013314 3240 013315 6317 3359 013316 6314 6314;5317;327;5301;316;6705;2721;301;314 013317 5317 013320 0327 013321 5301 013322 0316 013323 6705 013324 2721 013325 0301 013326 0314 3360 ERMHA, /OR MUST BE PRECEDED AND FOLLOWED BY A NAME 3361 013327 5317 5317;322;6715;1725;6324;1240;6705;240;6322;1705;6305;2305;5305;304;6301 013330 0322 013331 6715 013332 1725 013333 6324 013334 1240 013335 6705 013336 0240 013337 6322 013340 1705 013341 6305 013342 2305 013343 5305 013344 0304 013345 6301 3362 013346 2316 2316;6240;7706;6314;7714;6327;2305;6640;4702;5240;301;6316;6701;305;0 013347 6240 013350 7706 013351 6314 013352 7714 013353 6327 013354 2305 013355 6640 013356 4702 013357 5240 013360 0301 013361 6316 013362 6701 013363 0305 013364 0000 3363 EROOT, /ONLY ONE TRANSFER IS LEGAL 3364 013365 6317 6317;6316;6331;7640;5316;305;6324;722;6316;3323;5305;322;5311;323 013366 6316 013367 6331 013370 7640 013371 5316 013372 0305 013373 6324 013374 0722 013375 6316 013376 3323 013377 5305 013400 0322 013401 5311 013402 0323 3365 013403 6314 6314;3705;301;314 013404 3705 013405 0301 013406 0314 3366 ERTFA, /TOO FEW ARGUMENTS 3367 013407 6324 6324;7717;6240;2706;6327;640;6722;2707;6315;7305;324;323 013410 7717 013411 6240 013412 2706 013413 6327 013414 0640 013415 6722 013416 2707 013417 6315 013420 7305 013421 0324 013422 0323 3368 ERSTC, /SAME TRANSFER CONDITION 3369 013423 6323 6323;6701;6705;2240;6322;7301;6323;2706;6322;1640;6317;2316;6311;4724 013424 6701 013425 6705 013426 2240 013427 6322 013430 7301 013431 6323 013432 2706 013433 6322 013434 1640 013435 6317 013436 2316 013437 6311 013440 4724 3370 013441 0317 317;316 013442 0316 3371 ERNLD, /NO LABELS DEFINED FOR INDIRECT TABLE 3372 013443 5316 5316;317;6314;1301;6705;1714;6240;2704;6306;7311;5305;304;6706;1317 013444 0317 013445 6314 013446 1301 013447 6705 013450 1714 013451 6240 013452 2704 013453 6306 013454 7311 013455 5305 013456 0304 013457 6706 013460 1317 3373 013461 6240 6240;7311;6705;2303;6240;724;6302;2714;0;0 013462 7311 013463 6705 013464 2303 013465 6240 013466 0724 013467 6302 013470 2714 013471 0000 013472 0000 3374 ERCNT, /CANT ENTER OUTPUT FILE 3375 013473 6303 6303;7301;6324;2640;6316;2724;6322;7640;6725;324;5325;324;6306;6311 013474 7301 013475 6324 013476 2640 013477 6316 013500 2724 013501 6322 013502 7640 013503 6725 013504 0324 013505 5325 013506 0324 013507 6306 013510 6311 3376 013511 0305 305;0 013512 0000 3377 ERAGVO, /GEN VAR OVERFLOW 3378 013513 6307 6307;7305;6240;726;6322;7640;6726;1305;6306;7714;327;0 013514 7305 013515 6240 013516 0726 013517 6322 013520 7640 013521 6726 013522 1305 013523 6306 013524 7714 013525 0327 013526 0000 3379 3380 3381 3382 TOPF1=. /TOP OF FIELD 1 STORAGE 3383 3384 3385 $$$$$$$$$$$$$$$$$$$ ACCNUM 0020 ACCUM 2161 ACMIND 0064 ACUM 0134 ACUMM 0135 ADD 0001 AGVCNT 0050 AGVPTR 0015 ANY 0023 ARGCNT 0033 ARGENV 2207 BACK 0012 BASE 2171 C10 0112 C12 0113 C240 0114 C260 0115 C377 0116 C5 0110 C7 0111 C7400 0117 CALASC 5066 CCONTR 1700 CDEL 2176 CEND 1000 CEXIT 0400 CHOLD 0070 CLEN 0034 CLOS1 3513 CLOS10 3664 CLOS11 3675 CLOS12 3703 CLOS13 3734 CLOS14 3736 CLOS16 4000 CLOS17 4007 CLOS19 4026 CLOS2 3520 CLOS20 4031 CLOS21 4040 CLOS22 4044 CLOS23 4046 CLOS24 4057 CLOS28 4077 CLOS29 4102 CLOS3 3526 CLOS30 4107 CLOS31 4110 CLOS32 4104 CLOS4 3600 CLOS5 3617 CLOS6 3624 CLOS7 3645 CLOS8 3652 CLOS9 3660 CLOSE 3502 CMDTAB 1600 CNTLC 2521 COLINE 0102 COLON 0021 COMMA 0022 COMPC 2445 CONVD 0136 CPAL 0100 CPOLIN 0103 CSNO 0200 CTTYP1 4325 CTTYPE 4323 CTYPE 0137 CURSOR 0071 CVD 4451 CVD1 4455 CVD2 4462 CVD3 4470 CVD4 4475 DAY 2241 DCAGV 2260 DCAGVC 2252 DEL 0022 DELPOL 0140 DELST 1774 DPOOL 4705 DPOOL0 4710 DPOOL1 4711 DPOOL3 4724 DPOOL4 4735 END 0011 END1 1621 END2 1641 END3 1661 END4 1677 END5 2000 END6 2015 END7 1726 ENDC1 2611 ENDC10 2675 ENDC2 2623 ENDC20 2713 ENDC21 2733 ENDC22 2737 ENDC23 2741 ENDC24 2757 ENDC3 2635 ENDC5 2641 ENDC6 2645 ENDC7 2671 ENDLIN 1616 ENDRD 0141 ENDRD1 4436 ENDRED 4431 EOL 0010 EQLSEN 0060 EQUAL 0015 EQUALC 2437 ERAGVO 3513 ERARTB 3251 ERCNT 3473 ERIARG 3041 ERIC 3141 ERID 3217 ERIVN 3027 ERLIV 3121 ERLNI 3155 ERLTL 2767 ERMDL 3177 ERMHA 3327 ERNAE 3301 ERNIR 3073 ERNLD 3443 EROER 3015 EROFF 3001 EROOT 3365 ERPEOF 3061 ERPONT 2765 ERR1 4134 ERR10 4215 ERR11 4220 ERR12 4222 ERR14 4224 ERR15 4226 ERR16 4230 ERR17 4232 ERR18 4234 ERR19 4236 ERR2 4143 ERR20 4240 ERR22 4242 ERR23 4244 ERR24 4247 ERR25 4253 ERR3 4200 ERR4 4203 ERR5 4205 ERR6 4207 ERR7 4211 ERR9 4213 ERRC 2234 ERRH 4255 ERRH1 4306 ERRH2 4315 ERSTC 3423 ERTFA 3407 ERUC 3233 EXFCUR 4532 EXITCL 2417 EXTCUR 4517 F0CLR 0070 F0CLRL 0014 F1CLR 2177 F1CLRL 0037 FCODE 2501 FILEND 2415 FILLER 2561 FOUR 7307 FOUTBK 0055 FREE 7777 unreferenced FRONT1 0300 FRONT2 0345 FRONT4 0400 GENLIT 0075 GETCHR 0142 GETCHS 0143 GOMON 4145 HPOOL 0047 IBCNT 2173 IBLK 5537 IBUF 0200 IFHANL 0455 IFLTAB 7617 IHAN 0053 IMCNT 0045 INBLK 2172 INDCAL 2577 INDEX0 0010 INDEX1 0011 INDEX2 0012 INDEX3 0013 INDEX6 0016 INDEX7 0017 INFLPT 0051 INHAN 6000 INITA2 2335 INITAL 2323 INTRPT 4740 INTST 0144 JMPCAL 2507 JMPLAB 2525 JMPTR 0010 LABEL 0004 LABELF 0061 LABPOL 2231 LAST 0023 LESS 0014 LINDF 0100 LINEIM 2040 LINEL 0120 LINEP 0014 LINK 7776 unreferenced LITFND 0057 LITJMS 2371 LITS 2177 LPAREN 0006 LPOOL 0021 LUSR 0145 MAI19A 1001 MAIN 0466 MAIN00 0476 MAIN01 0600 MAIN02 0615 MAIN05 0620 unreferenced MAIN0A 0536 MAIN14 0667 MAIN15 0671 MAIN16 0705 MAIN17 0715 MAIN18 0716 MAIN19 1000 MAIN20 1016 MAIN50 1020 MAIN51 1043 MAIN52 1044 MAIN53 1065 MAIN54 1077 MAIN55 1103 MAIN56 1200 MAIN57 1204 MAIN58 1223 MAIN59 1243 MAIN5A 1231 MAIN5B 1073 MAIN5R 1240 MAIN61 1306 MAIN62 1321 MAIN63 1335 MAIN64 1323 MAIN65 1400 MAIN66 1333 MAIN70 1403 MAIN73 1444 MAIN74 1445 MAIN75 1477 MAIN76 1506 MAIN77 1510 MAIN78 1524 MAIN79 1530 MAIN7A 1462 MAIN80 1606 MAKASC 0146 MAT1 5062 MATCH 5044 MODE 2235 MODECH 0066 MONTH 2236 NC1 0121 NC10 0130 NC12 0131 NC2 0122 NC212 0132 NC260 0133 NC3 0123 NC4 0124 NC5 0125 NC6 0126 NC7 0127 NCMDF 2407 NEXTIN 0432 NOARG 0002 NONE 7340 NTHREE 7346 NTOPIB 7200 NTOPOB 6200 NTWO 7344 NXTSTR 0037 OBCNT 2175 OBLK 5625 OBUF 0600 OCNT 0073 OCURSR 0043 OFHANL 0245 OFLAG 0056 OFLEN 0254 OFLNM 0253 OFLTAB 7600 OHAN 0054 OLINE 2227 ONAME 0104 ONE 7301 OR 0016 ORCODE 2431 OUTBLK 2174 OUTF 0063 OUTHAN 6400 OVERF 0077 P1 5126 P2 5127 PACCUR 4414 PAGFIN 2555 PAGJMP 2531 PAGLEN 0035 PAGLIT 0076 PALEN1 2027 PALEN2 2035 PALEN3 2047 PALEN4 2057 PALEND 2017 PATCAL 2565 PLINE 4421 POLEND 7775 POLINE 2230 PRINT 0147 PRN 5674 PRN0 5702 PRN1 5714 PRN2 5723 PRX 5732 PTATOM 0065 PTNAM1 4333 PTNAM2 4341 PTNAME 4332 PTOUT 2200 PUT0 2216 PUT1 2242 PUT2 2243 PUT3 2255 PUT4 2271 PUT5 2276 PUT6 2307 PUT7 2231 PUTACR 0150 PUTCHR 0151 PUTNAM 0152 PUTO1 5112 PUTOC 0153 PUTOCT 5106 PUTOUT 0154 RDCH 5411 RDCH1 5451 RDCH2 5477 RDCH3 5505 RDCH4 5511 RDCH5 5522 RDCH6 5542 RDCH7 5546 RDCH8 5557 RDCH9 5562 RDCHR 5400 RDCHR0 5416 RDCHRS 5413 RDP0 5131 RDP1 5144 RDPOL 5130 RDPOOL 0155 RETORN 0156 RETRN 4445 RETTRN 0157 RETURN 2247 RPAREN 0004 SACCUM 2217 SARG 0120 SAVACM 0162 SCAN 0160 SCAN00 2424 SCAN01 2440 SCAN02 2455 SCAN03 2507 SCAN04 2513 SCAN05 2522 SCAN06 2527 SCAN07 2552 SCAN08 2562 SCAN09 2600 SCAN0A 2546 SCAN10 2621 SCAN11 2646 SCAN12 2652 SCAN13 2660 SCAN14 2661 SCAN15 2706 SCAN16 2714 SCAN20 2733 SCAN21 2742 SCAN22 3000 SCAN23 3055 SCAN24 3120 SCAN25 3305 SCAN27 3432 SCAN28 3444 SCAN29 3465 SCAN2A 3215 SCAN2B 3235 SCAN2C 3317 SCAN2D 3136 SCAN2E 3243 SCAN2F 3221 SCAN2G 2750 SCAN2H 3076 SCAN2I 3021 SCAN2J 3134 SCAN2K 3200 SCAN2L 3414 SCAN2M 3332 SCAN2N 3146 SCAN2P 3102 SCAN2Q 3231 SCAN2R 3312 SCAN2S 3113 SCAN2T 3014 SCAN30 3474 SCANNR 2402 SCURS 0041 SEARCH 0161 SEMI 0017 SERCH 5004 SERCH1 5006 SERCH2 5016 SERCH3 5025 SERCH4 5034 SERCHA 5043 SHACUM 0163 SHFT1 4763 SHFT3 2455 SHFTAC 4754 SIX 7327 unreferenced SLASH 0002 SNOBOL 0200 SPACE 0020 SPFNPL 1720 STAR 0003 STOR 2515 STRDEL 0000 STRF 0067 SUB 0000 SVAC1 4407 SVACUM 4400 T1 0024 T1MAT 0040 T2 0025 T3 0026 T4 0027 TADCON 2264 TADGV 2270 TESTQ 2312 TESTSF 2274 THREE 7325 TMODE 0036 TOCNT 0074 TOP 0032 TOPF1 3527 TPRN 5747 TRASEN 0062 TTYP1 4501 TTYP2 4505 TTYPE 4477 TWO 7305 TX 0030 TXX 0031 TYPE 0164 TYRET 5000 ULBPOL 2233 UPARR 0023 USR 0165 VALID 0046 VAR 0020 VARORL 0001 VARPOL 2232 VINDF 0101 WPSTR 5350 WPSTR1 5352 WPSTR2 5356 WRCH1 5633 WRCH3 5663 WRCHR 5600 WRIP1 4511 WRIP2 4515 WRIPO 4507 WRITO 4547 WRITPO 4626 WROC1 4667 WROCO 0166 WROCTO 4657 WROLIN 0167 WRP0 5163 WRP1 5200 WRP2 5205 WRPA0 5212 WRPA1 5214 WRPA10 5263 WRPA2 5216 WRPA3 5235 WRPA4 5247 WRPA5 5261 WRPA6 5246 WRPA7 5244 WRPAA 5207 WRPCA 5301 WRPCA2 5332 WRPCA3 5341 WRPOL 5147 WRPOLN 0170 WRPOOL 0171 WRPP1 4602 WRPP2 4606 WRPPO 4600 WRPPSO 0172 WRPS 0174 WRPSO 0173 WRSPO 4641 WRSPO1 4647 WRSPO2 4654 WRSTO 4610 WRSTO1 4616 WRSTO2 4623 WRSTPO 0175 WRSTR 0176 WRSTR1 4542 WRSTRG 4540 WRSTRO 0177 WT1 5166 WT2 5344 WT3 5345 WT4 5346 WT5 5347 XASC 2377 XINT 2403 YEAR 2245 ZERO 7300