1 2 / 8BAL : PDP-8 MACRO LANGUAGE 3 /PB 4 5 / 6 / 7 / 8 / 8BAL---MACRO PROCESSOR FOR THE PDP-8 9 / REQUIRES PS/8 AND AT LEAST 8K OF CORE 10 / WRITTEN BY DAVID M. KRISTOL, SUMMER, 1971 11 / 12 / THIS IS 8BAL VERSION 4.1 7DEC72 13 / 14 / 15 / ASSEMBLY PARAMETERS: 16 / INBLSZ: NUMBER OF RECORDS IN INPUT BLOCK 17 / OUBLSZ: NUMBER OF RECORDS IN OUTPUT BLOCK 18 / MPCHR: CHARACTER TO BE USED TO DISTINGUISH 19 / 8BAL TEXT. SUGGESTED: @ OR # 20 / TBLSLT: NUMBER OF SYMBOL TABLE SLOTS 21 / HTBLST: HALF OF TBLSLT + 1 22 / LNKNUM: NUMBER OF LINKS ALLOWED 23 / MCARG: NUMBER OF MACRO ARGUMENTS 24 / INCLUDES 1 FOR POTENTIAL LABEL 25 / SFLD: FIELD FOR STRING STORAGE 26 / PFLD: FIELD FOR PUSH DOWN STORAGE 27 / NOTE!!: OVERFLOW CHECKS IN 28 / 'LNKCHK', 'PUSHA' MUST REFLECT 29 / VALUES OF SFLD, PFLD 30 / 31 / 32 33 34 /FOLLOWING FOUR PARAMETERS SET BY TABLE ENTRIES 35 /IN FIELD 1 --TBL12K, TBL16K 36 37 / INBLSZ= 8K:1; 12K:2; >12K:7 38 / OUBLSZ= 8K:2; 12K:3; >12K:8 39 / SFLD= 8K:10; 12K:20; >12K:30 40 / PFLD= 8K:10; 12K:10; >12K:20 41 MPCHR="@ 42 LINLIM=200 43 44 DECIMAL 45 TBLSLT=91 46 HTBLST=46 47 LNKNUM=TBLSLT /NUMBER OF LINKS 48 MCARG=15 /14 MACRO ARGUMENTS PLUS LABEL 49 OCTAL 50 ZZZ=0 /TO INDICATE FILL-INS 51 52 FIELD 0 53 54 *0 55 000000 0004 4;HLT /FOR SAFETY SAKE 000001 7402 56 57 *5 /PUT IN START-UP PATCH HERE 58 000005 6213 XSTART, CDF CIF 10 /FIELD 1 59 000006 5407 JMP I .+1 60 000007 3400 START /DO REAL START-UP 61 62 63 /THIS AREA USED BY CORS AND TEMPORARIES!! 64 /NOTE OVERLAP IN DEFINITIONS, BELOW 65 66 *10 67 68 000010 0000 CORS, .-. /GET CORE SIZE 69 000011 6221 CDF 20 /TRY FOR FIELD 2 70 000012 7332 CLA STL RTR /2000 71 000013 3442 DCA I CORLNK 72 000014 7200 CLA 73 000015 1442 TAD I CORLNK 74 000016 7000 NOP 75 000017 6201 CDF 0 76 TAD (-2000 page zero ^ page zero ^ 000020 1177 77 000021 7640 SZA CLA /IS THERE A FIELD 2? 78 000022 5037 JMP CORE1 /NO 79 000023 6231 CDF 30 /YES. TRY FIELD 3 80 000024 7332 CLA STL RTR 81 000025 3442 DCA I CORLNK 82 000026 7200 CLA 83 000027 1442 TAD I CORLNK 84 000030 7000 NOP 85 000031 6201 CDF 0 86 000032 1043 TAD CORLOC 87 TAD (-2000 page zero ^ page zero ^ 000033 1177 88 000034 7650 SNA CLA 89 000035 7001 IAC 90 000036 7001 IAC 91 000037 7001 CORE1, IAC 92 000040 6213 CDF CIF 10 /RETURN TO FIELD 1 93 000041 5410 JMP I CORS 94 95 000042 0043 CORLNK, CORLOC 96 000043 0000 CORLOC, 0 97 98 /PB 99 100 101 /***************************************** 102 *10 /OVERLAPPED USAGE BEGINS HERE 103 104 XR10, *.+1 105 XR11, *.+1 106 XR12, *.+1 107 XR13, *.+1 108 XR14, *.+1 109 CDP, *.+1 /POINTER TO FIELD 1 CD INPUT LIST 110 111 GATHBF, *.+3 /OUTPUT FROM 'GATHER': UP TO SIX CHAR FIELD 112 SCANP1, *.+1 /POINT TO BEGINNING OF SCAN - 1 113 SCANP2, *.+1 /POINT TO SEPARATOR THAT ENDS SCAN 114 SCANP3, *.+1 /POINT TO FIRST NON-SPACE IN SCAN (=SCANP1) 115 116 SEPCOD, *.+1 /SEPARATOR CODE FROM LAST CALL TO 'CCHECK' 117 118 TBLWD1, *.+1 /POINTER TO 'TYPE' WORD IN SYMBOL TABLE 119 TBLWD2, *.+1 /POINTER TO 'VALUE' WORD IN SYMBOL TABLE 120 TBLFLG, *.+1 /'LOOKUP' 'WRONG TYPE' FLAG: 121 /0 : RIGHT NAME, WRONG TYPE 122 /7777 : ANY OTHER SITUATION 123 124 MATCP1, *.+1 /POINTER TO LAST MATCHING CHARACTER OF 125 /LAST SUCCESSFUL PATTERN 126 MATFLD, *.+1 /POINTER TO FIELD IN LAST SUCCESSFUL PATTERN 127 128 MQ, *.+1 /* EAE SIMULATOR LOCATIONS 129 AC, *.+1 /* 130 EAESC, *.+1 /* 131 132 LINCNT, *.+1 /- COUNT FOR CURRENT LINE IN LINBUF 133 LINBUF, *.+1 /POINTER TO CURRENT LINE BUFFER - 1 134 135 MCXALK, *.+1 /MACRO EXPANSION: ARGUMENT LINK # 136 MCXBLK, *.+1 /MACRO EXPANSION: MACRO BODY LINK # 137 138 LINSV1, *.+1 /SAVE LINE # FOR 'IF', 'RET' LOOPS 139 140 LINSV2, *.+1 /SAVE LINE # FOR 'IRP' 141 142 /*********************END OF SHARED AREA 143 144 *CORLOC+1 145 /THESE CELLS ARE ALL INITIAL VALUES! 146 147 000044 0001 LNKEND, 1 /LOWER BOUND FOR LINK STORAGE 148 000045 0000 LNKLIM, ZZZ /8K:0 (USE PUSHP); 12K:7600; >12K:7600 149 000046 6177 PUSHP, 6177 /8K:6177; 12K:5177; >12K:7577 150 000047 6177 PUSHST, 6177 /PD INITIAL VALUE (SEE PUSHP) 151 000050 0000 MACON, 0 /MACRO EXPANDER 'ON' SWITCH: 1 = EXPANDING 152 000051 0000 OCTDEC, 0 /OCTAL-DECIMAL CONVERSION SWITCH: 153 / 0 - OCTAL. 1 - DECIMAL 154 000052 0000 DLTESW, 0 /SET TO 1 IF LINK HAS BEEN DELETED 155 /(USED BY 'MACX') 156 000053 0001 PAGES, 1 /NUMBER OF EDITOR PAGES SO FAR. INITIALLY 1 157 000054 0000 LINES, 0 /NUMBER OF LINES (I.E., CR'S) READ, THIS 158 /PAGE. GETS PUSHED AND CLEARED BY MACX, 159 /RESET BY 'IRP' AND LOOPING 'IF' 160 161 000055 0000 INHNDL, 0 /ADDRESS OF CURRENT INPUT HANDLER 162 000056 5153 OUHNDL, ODUMMY /ADDRESS OF CURRENT OUTPUT HANDLER 163 /INITIALLY 'ODUMMY' 164 000057 0400 INPUT, RDCHR /ADDRESS OF PRESENT INPUT ROUTINE (CAN ALSO 165 /BE 'MACINP') 166 167 000060 0000 OUTCD, 0;FILENAME 8BALOU.TM /FILE NAME SET UP 000061 7002 000062 0114 000063 1725 000064 2415 168 /SO 8BALOU.TM WILL BE USED AS 169 /NAME IF CHAINING WITH NO NAME 170 /OCCURS 171 172 173 000065 0000 SF, .-. /CHANGE DATA FIELD TO SFLD 174 000066 6211 CDF 10 /8K:10; 12K:20; >12K:30 175 000067 5465 JMP I SF /RETURN 176 177 SFLD=JMS SF /DEFINE OPERATION 178 179 180 181 182 /SWAP ROUTINES FOR LIBRARY SEARCHING 183 184 185 SYSHND=7607 /SYSTEM HANDLER 186 187 000070 0000 SWOUT, .-. /SWAP IN LIBRARY ROUTINES, 188 /SWAP OUT BASIC 8BAL STUFF 189 000071 7000 NOP /CHANGED BY /Y TO ISZ TBLFLG 190 /COMING FROM LOOKUP: UNDEFINED? 191 000072 5776 JMP MPEXPD /NO. OTHER SYMBOL TYPE THAN MACRO 192 JMS I (SYSHND /CALL SYS HANDLER page zero ^ page zero ^ 000073 4575 193 000074 4400 4400 /WRITE FOUR PAGES 194 000075 2600 RCSET /STARTING AT RCSET 195 000076 0033 33 /BLOCK 33 (MONITOR FIELD 0 AREA) 196 000077 5117 JMP FNDMER /ERROR 197 JMS I (SYSHND page zero ^ page zero ^ 000100 4575 198 000101 0401 401 /READ FOUR PAGES FORWARD 199 000102 2600 RCSET 200 000103 0046 46 /END OF LOADER AREA 201 000104 5117 JMP FNDMER 202 000105 5506 JMP I FNDML 203 000106 3000 FNDML, FNDMAC /GETS INCREMENTED, FIRST CALL 204 205 SWIN1, TAD (MPEXPD /SWAP IN BASIC 8BAL STUFF page zero ^ page zero ^ 000107 1176 206 000110 3070 DCA SWOUT /DIDN'T FIND MACRO 207 /SET UP TO JUST EXPAND LINE 208 SWIN2, JMS I (SYSHND page zero ^ page zero ^ 000111 4575 209 000112 0400 400 210 000113 2600 RCSET 211 000114 0033 33 /READ GOOD STUFF BACK IN 212 000115 7610 SKP CLA 213 000116 5470 JMP I SWOUT 214 215 ZSYSHN=[SYSHND /USED BY FNDMAC OVERLAY 216 217 218 000117 4574 FNDMER, JMS I [SERROR /SYSTEM TYPE ERROR 219 000120 0315 "M 220 /NO RETURN 221 222 000121 0000 PUTCS2, .-. /FROM PUTCHR. CHECK CORE OVERFLOW 223 000122 7100 CLL 224 TAD (200 page zero ^ page zero ^ 000123 1173 225 000124 7430 SZL /ADDRESS >=7600?? 226 000125 4572 JMS I [TERROR /YES. HURTING!! 227 TAD (-200 /NO. RESTORE POINTER page zero ^ page zero ^ 000126 1171 228 000127 5521 JMP I PUTCS2 /RETURN 229 230 231 000130 0000 XPND, .-. /DO TWO PASS EXPAND 232 000131 4770 JMS XPND1 /FIRST PASS 233 000132 7001 IAC 234 000133 4770 JMS XPND1 /1 INDICATES SECOND PASS 235 000134 5530 JMP I XPND /RETURN 236 237 /PB 238 /PB 239 240 PAGE 241 242 GETCHR=. /GET CHAR BY TWO POINTERS 243 /ALSO, ALTERNATE STARTING POINT OF 244 /PROGRAM, BECAUSE OF ONCE-ONLY CODE 245 /JUMPING TO START-UP 246 000200 5005 JMP XSTART /THIS GETS CLOBBERED WITH FIRST 247 /SUBROUTINE CALL, BUT IT WILL HAVE 248 /SERVED ITS PURPOSE 249 000201 1600 TAD I GETCHR /POINTER TO POINTERS 250 000202 2200 ISZ GETCHR 251 000203 3260 DCA GETCPB 252 000204 1660 TAD I GETCPB /POINTER TO BUFFER 253 000205 2260 ISZ GETCPB /'GETPCB' POINTS NOW TO BYTE 254 000206 3257 DCA GETCPP 255 000207 1600 TAD I GETCHR /FIELD OF BUFFER 256 000210 2200 ISZ GETCHR 257 000211 3213 DCA GETC1 258 000212 1660 TAD I GETCPB /BYTE INDICATOR 259 000213 0000 GETC1, ZZZ 260 000214 7710 SPA CLA /THIRD BYTE? 261 000215 5221 JMP .+4 /YES 262 000216 1657 TAD I GETCPP /NO. SIMPLE FETCH 263 000217 0167 AND [377 264 000220 5236 JMP GETC2 265 266 000221 1657 TAD I GETCPP 267 000222 0377 AND (7400 268 000223 7112 CLL RTR 269 000224 7012 RTR 270 000225 3256 DCA GETCT1 /FIRST HALF 271 000226 7040 CMA 272 000227 1257 TAD GETCPP 273 000230 3257 DCA GETCPP 274 000231 1657 TAD I GETCPP 275 000232 0377 AND (7400 276 000233 1256 TAD GETCT1 277 000234 7112 CLL RTR 278 000235 7012 RTR 279 000236 6201 GETC2, CDF 0 280 000237 3256 DCA GETCT1 /SAVE FOR A MOMENT 281 000240 1660 TAD I GETCPB 282 000241 7104 CLL RAL 283 000242 7520 SMA SNL 284 000243 7132 STL RTR 285 000244 3660 DCA I GETCPB /CHANGE BYTE INDICATOR 286 000245 1660 TAD I GETCPB 287 000246 7710 SPA CLA /BECOME -? 288 000247 5254 JMP GETC3 /YES. DON'T CHANGE POINTER 289 000250 7240 CLA CMA 290 000251 1260 TAD GETCPB 291 000252 3257 DCA GETCPP /POINT AT POINTER 292 000253 2657 ISZ I GETCPP /INCREMENT IT 293 000254 1256 GETC3, TAD GETCT1 /RETRIEVE CHAR 294 000255 5600 JMP I GETCHR /AND RETURN 295 296 000256 0000 GETCT1, 0 /TEMPORARY 297 000257 0000 GETCPP, 0 298 000260 0000 GETCPB, 0 299 300 301 302 000261 0000 PUTCHR, .-. /PUT CHARACTER INTO BUFFER BY 303 /POINTER TO POINTERS 304 000262 0167 AND [377 305 000263 3351 DCA PUTCT1 /SAVE CHARACTER 306 000264 1661 TAD I PUTCHR 307 000265 2261 ISZ PUTCHR 308 000266 3260 DCA PUTCPB /SAVE POINTER TO POINTERS 309 000267 1660 TAD I PUTCPB 310 000270 2260 ISZ PUTCPB 311 000271 4121 JMS PUTCS2 /CHECK FOR OVERFLOW 312 000272 3257 DCA PUTCPP /SAVE POINTER 313 000273 1661 TAD I PUTCHR /FIELD 314 000274 2261 ISZ PUTCHR 315 000275 3277 DCA PUTC1 316 000276 1660 TAD I PUTCPB /GET BYTE 317 000277 0000 PUTC1, ZZZ 318 000300 7710 SPA CLA /THIRD BYTE? 319 000301 5307 JMP PUTC2 /YES 320 000302 1657 TAD I PUTCPP /GET OLD CONTENTS 321 000303 0377 AND (7400 322 000304 1351 TAD PUTCT1 323 000305 3657 DCA I PUTCPP /JUST PUT AWAY 324 000306 5317 JMP PUTC3 325 326 000307 1351 PUTC2, TAD PUTCT1 327 000310 7110 CLL RAR 328 000311 4335 JMS PUTCS1 329 000312 7060 CMA CML /TO PERMIT LINK TO STAY SAME 330 000313 1257 TAD PUTCPP 331 000314 3257 DCA PUTCPP /BACK UP POINTER 332 000315 1351 TAD PUTCT1 333 000316 4335 JMS PUTCS1 334 000317 6201 PUTC3, CDF 0 335 000320 1660 TAD I PUTCPB 336 000321 7104 CLL RAL 337 000322 7520 SMA SNL 338 000323 7132 STL RTR 339 000324 3660 DCA I PUTCPB /SAVE UPDATED BYTE 340 000325 1660 TAD I PUTCPB 341 000326 7710 SPA CLA /- ? 342 000327 5661 JMP I PUTCHR /YES 343 000330 7040 CMA 344 000331 1260 TAD PUTCPB 345 000332 3257 DCA PUTCPP 346 000333 2657 ISZ I PUTCPP /INCREMENT POINTER 347 000334 5661 JMP I PUTCHR 348 349 PUTCPB=GETCPB /SHARE FOR SPACE 350 PUTCPP=GETCPP /LIKEWISE 351 352 000335 0000 PUTCS1, .-. /PUTCHR SUBR. 353 000336 7012 RTR 354 000337 7012 RTR 355 000340 3351 DCA PUTCT1 /SAVE TEMP 356 000341 1657 TAD I PUTCPP /OLD CONTENTS 357 000342 0167 AND [377 358 000343 3657 DCA I PUTCPP /SAVE BACK 359 000344 1351 TAD PUTCT1 360 000345 0377 AND (7400 /JUST 4 BITS 361 000346 1657 TAD I PUTCPP 362 000347 3657 DCA I PUTCPP /ALL TOGETHER NOW,... 363 000350 5735 JMP I PUTCS1 364 365 366 000351 0000 PUTCT1, 0 367 368 000352 0000 LFSUP, .-. /SUPPRESS MORE THAN 1 CONSECUTIVE 369 /LINE FEED 370 000353 3373 DCA LFSPT1 /SAVE CHAR 371 000354 1373 TAD LFSPT1 372 000355 1376 TAD (-212 /CHECK FOR LF 373 000356 7640 SZA CLA /IS THIS CHAR A LF? 374 000357 5365 JMP LFSP1 /NO 375 000360 7040 CMA /YES. PREPARE TO SET SWITCH 376 000361 2374 ISZ LFSPI1 /PREVIOUS LF SET LF SWITCH? 377 000362 5365 JMP LFSP1 /NO. OUTPUT LF, SETTING SWITCH 378 000363 3374 DCA LFSPI1 /YES. SET SWITCH, IGNORE CHAR 379 000364 5752 JMP I LFSUP 380 381 000365 3374 LFSP1, DCA LFSPI1 /SET SWITCH: 0 = ANYTHING BUT LF, 382 / -1 = LF 383 000366 1373 TAD LFSPT1 /PICK UP CHAR AGAIN 384 000367 4566 JMS I [PUTCHR /PUT CHAR IN OUTPUT BUFFER 385 000370 0504 WRTCP1 386 000371 6211 CDF 10 387 000372 5752 JMP I LFSUP 388 389 000373 0000 LFSPT1, 0 390 000374 0000 LFSPI1, 0 /INITIALLY 0 391 392 /PB 393 /PB 394 000376 7566 PAGE 000377 7400 395 / 396 / ELEMENTAL I/O ROUTINES 397 / 398 399 000400 0000 RDCHR, .-. /READ ONE CHAR FROM INPUT DEVICE 400 000401 2267 ISZ RDCHC1 /COUNT OVERFLOW? 401 000402 5223 JMP RDCH2 /NO 402 000403 4455 RDCH1, JMS I INHNDL /GET NEXT BUFFER LOAD 403 000404 0210 210 /COMMAND WORD 404 /8K:210; 12K:410; >12K:1610 405 000405 7200 INBUFP, 7200 /8K:7200; 12K:6600; >12K:4200 406 000406 0000 INBLK, ZZZ /BLOCK TO READ 407 000407 7700 SMA CLA /FATAL ERROR? 408 000410 5213 JMP .+3 /NO. ASSUME TTY EOF 409 000411 4574 IOERR, JMS I [SERROR /YES. SYSTEM ERROR AND TERM. 410 000412 0311 "I 411 000413 1273 TAD INBLSZ 412 000414 1206 TAD INBLK 413 000415 3206 DCA INBLK /FOR NEXT READ 414 000416 1205 TAD INBUFP 415 000417 3271 DCA RDCHP1 416 000420 3272 DCA RDCHP1+1 /SET POINTER AND BYTE 417 000421 1274 TAD INBLCT /BUFFER LENGTH (CHARS) 418 000422 3267 DCA RDCHC1 /CHARACTER COUNT 419 000423 4573 RDCH2, JMS I [GETCHR 420 000424 0471 RDCHP1 421 000425 6211 CDF 10 /FIELD 1 422 000426 0377 AND (177 423 000427 1173 TAD [200 /MAKE WELL-BEHAVED CHARS 424 000430 1376 TAD (-232 /^Z 425 000431 7450 SNA 426 000432 5240 JMP RDCH3 /END OF FILE ENCOUNTERED 427 000433 1375 TAD (232-377 /CHECK FOR RUBOUT 428 000434 7450 SNA 429 000435 5201 JMP RDCHR+1 /GET ANOTHER CHARACTER 430 000436 1167 TAD [377 431 000437 5600 JMP I RDCHR /RETURN FETCHED CHARACTER 432 433 000440 6211 RDCH3, CDF 10 434 000441 1415 TAD I CDP /COMMAND DECODER, NEXT FILE 435 000442 6201 CDF 0 436 000443 7450 SNA /0? 437 000444 5774 JMP INEOF /COMPLETE END OF FILE 438 000445 3270 DCA RDCHT1 /SAVE 439 000446 6211 CDF 10 440 000447 1415 TAD I CDP 441 000450 3206 DCA INBLK /SAVE STARTING BLOCK 442 000451 6201 CDF 0 443 000452 1373 TAD (INHNDB /INPUT HANDLER BUFFER (1 PAGE) 444 000453 3260 DCA INHNDP 445 000454 1270 TAD RDCHT1 446 000455 6212 CIF 10 447 000456 4565 JMS I [7700 /FETCH HANDLER 448 000457 0001 1 449 000460 7200 INHNDP, INHNDB 450 000461 5265 JMP RDCH4 /ERROR 451 000462 1260 TAD INHNDP 452 000463 3055 DCA INHNDL /SAVE ENTRY POINT 453 000464 5203 JMP RDCH1 /TRY AGAIN 454 455 000465 4574 RDCH4, JMS I [SERROR /ERROR FETCHING HANDLER 456 000466 0310 "H 457 458 459 000467 7777 RDCHC1, -1 /COUNT 460 /^ SET AS INITIAL VALUE 461 000470 0000 RDCHT1, 0 462 463 000471 0000 RDCHP1, 0;0 /READ POINTERS 000472 0000 464 000473 0001 INBLSZ, 1 /8K:1; 12K:2; >12K:7 465 000474 7200 INBLCT, -600 /8,12,>12K:-600*INBLSZ 466 467 468 000475 0000 WRTCHR, .-. /WRITE CHARACTER TO OUTPUT DEVICE 469 000476 4772 JMS LFSUP /PUT CHAR, SUPPRESS EXTRA LF'S 470 000477 2303 ISZ WRTCC1 /INCREMENT COUNT 471 000500 5675 JMP I WRTCHR /KEEP GOING 472 000501 4306 JMS OUTBUF /OUTPUT BUFFER 473 000502 5675 JMP I WRTCHR 474 475 000503 6400 WRTCC1, -1400 /ALL: -600*OUBLSZ 476 477 000504 6200 WRTCP1, 6200;0 /8K,12K,>12K:C(OUTBFP) 000505 0000 478 /ABOVE IS INITIAL VALUE 479 480 000506 0000 OUTBUF, .-. /FILL BUFFER TO EVEN PAGE, PURGE 481 000507 1346 OUTB1, TAD OUTBFP /GET BUFFER POINTER 482 000510 7041 CIA 483 000511 1304 TAD WRTCP1 /GET OFFSET OF BUFFER PAGE 484 000512 0377 AND (177 /MODULO 200 485 000513 7650 SNA CLA /EVEN PAGE? 486 000514 5317 JMP .+3 /YES 487 000515 4772 JMS LFSUP /NO. USE LFSUP TO WRITE CHAR 488 000516 5307 JMP OUTB1 /CONTINUE 489 490 000517 1346 TAD OUTBFP /BUFFER POINTER 491 000520 7041 CIA 492 000521 1304 TAD WRTCP1 /GET OFFSET AGAIN 493 000522 7110 CLL RAR /START # OF PAGES AT BIT 5 (NOT 4) 494 000523 1371 TAD (4010 /MAGIC # TO CREATE CONTROL WORD: 495 /WRITE, FIELD 1 496 000524 3345 DCA OUTBT1 /SAVE CONTROL WORD 497 000525 1345 TAD OUTBT1 /GET CONTROL WORD BACK 498 000526 1370 TAD (100-4010 /STRIP OFF BITS WE JUST ADDED, CAUSE 499 /ROUND UP TO NEAREST BLOCK 500 000527 7106 CLL RTL 501 000530 7006 RTL 502 000531 7006 RTL /SAME AS R7R 503 000532 3364 DCA OUTBT2 /SAVE # OF BLOCKS WRITTEN 504 000533 1364 TAD OUTBT2 /GET BACK 505 000534 1767 TAD OUTFSZ /PRESENT FILE LENGTH 506 000535 3767 DCA OUTFSZ /SAVE UPDATED LENGTH 507 000536 7100 CLL /FOR TEST 508 000537 1767 TAD OUTFSZ 509 000540 1362 TAD OUTFLM /FILE LENGTH LIMIT 510 000541 7430 SZL /EXCEED LIMIT? 511 000542 4574 JMS I [SERROR /YES. GIVE ERROR 'L' 512 000543 0314 "L /NO. FALL THROUGH HARMLESSLY 513 /NO RETURN FROM SERROR 514 000544 4456 JMS I OUHNDL /OUTPUT GOODIES 515 000545 0000 OUTBT1, ZZZ /COMMAND WORD 516 /8K:4410; 12K:4610; >12K:6010 517 000546 6200 OUTBFP, 6200 /8K:6200; 12K:5200; >12K:200 518 000547 0000 OUTBLK, ZZZ /BLOCK NUMBER 519 000550 5211 JMP IOERR /FATAL WRITE ERROR 520 000551 1364 TAD OUTBT2 521 000552 1347 TAD OUTBLK 522 000553 3347 DCA OUTBLK /UPDATE OUTPUT BLOCK 523 000554 1346 TAD OUTBFP 524 000555 3304 DCA WRTCP1 /SET POINTER 525 000556 3305 DCA WRTCP1+1 /AND BYTE 526 000557 1363 TAD OUBLCT /OUTPUT BUFFER LENGHT (CHARS) 527 000560 3303 DCA WRTCC1 /SAVE COUNT 528 000561 5706 JMP I OUTBUF 529 530 000562 0000 OUTFLM, 0 /LIMIT OF OUTPUT FILE (FROM CD) 531 000563 6400 OUBLCT, -1400 /8K,12K,>12K: -600*OUBLSZ 532 000564 0000 OUTBT2, 0 533 534 /PB 535 /PB 536 000567 1633 PAGE 000570 4070 000571 4010 000572 0352 000573 7200 000574 1616 000575 7633 000576 7546 000577 0177 537 538 000600 0000 GETLIN, .-. /GET ONE LINE OF INPUT 539 000601 1164 TAD [LNBUF1-1 540 000602 3014 DCA XR14 541 000603 1014 TAD XR14 542 000604 3036 DCA LINBUF /SAVE LINE START 543 000605 1036 TAD LINBUF 544 000606 3022 DCA SCANP2 /AND SCAN POINTER 545 000607 3035 DCA LINCNT /FOR CHECKING O'FLOW 546 000610 4457 GETL1, JMS I INPUT /NO. GET CHAR. MAY BE FROM RDCHR 547 /OR MACINP 548 000611 3265 DCA GETLT1 549 000612 1035 TAD LINCNT 550 000613 7640 SZA CLA /FIRST CHAR ON LINE? 551 000614 5231 JMP GETL2 /NO 552 000615 1265 TAD GETLT1 /YES 553 000616 1377 TAD (-212 554 000617 7450 SNA /LF? 555 000620 5262 JMP GETL3 /YES 556 000621 1376 TAD (-214+212 557 000622 7450 SNA /FF? 558 000623 5260 JMP GETL2A /YES. MARK OFF PAGE 559 000624 1375 TAD (-200+214 560 000625 7650 SNA CLA /LT CODE? 561 000626 5262 JMP GETL3 /YES 562 000627 1374 TAD (-LINLIM-1 /SET COUNT 563 000630 3035 DCA LINCNT 564 000631 2035 GETL2, ISZ LINCNT /END OF LINE? 565 000632 5235 JMP .+3 /NO 566 000633 3414 DCA I XR14 /YES. MARK FOR ERROR 567 000634 4572 JMS I [TERROR /TABLE OVERFLOW 568 000635 1265 TAD GETLT1 569 000636 3414 DCA I XR14 /SAVE CHAR 570 000637 1265 TAD GETLT1 571 000640 1163 TAD [-215 /REACH END OF LINE? 572 000641 7640 SZA CLA 573 000642 5210 JMP GETL1 574 000643 2054 ISZ LINES /MARK OFF ANOTHER LINE 575 000644 1035 TAD LINCNT 576 000645 7041 CIA 577 000646 1374 TAD (-LINLIM-1 578 000647 3035 DCA LINCNT /CORRECT COUNT 579 000650 6031 KSF /ANYTHING TYPED? 580 000651 5600 JMP I GETLIN /NO 581 000652 6034 KRS /READ WITHOUT CLEARING FLAG 582 000653 1373 TAD (-203 /-^C 583 000654 7640 SZA CLA /IS THAT WHAT AM? 584 000655 5600 JMP I GETLIN /NO. KEEP GOING 585 000656 4772 JMS ERRLST /YES. LEAVE INDICATION OF PLACE 586 000657 5571 JMP I [7600 /BEFORE RUNNING OFF 587 588 000660 2053 GETL2A, ISZ PAGES /MARK ANOTHER PAGE 589 000661 3054 DCA LINES /CLEAR LINES COUNTER 590 591 000662 1265 GETL3, TAD GETLT1 /FETCH CHAR 592 000663 4771 JMS WRTCHR /PASS TO OUTPUT 593 000664 5210 JMP GETL1 /CONTINUE 594 595 000665 0000 GETLT1, 0 596 597 598 000666 0000 CCHECK, .-. /CHECK CHAR FOR SEPARATOR 599 000667 3324 DCA CCHKT1 /SAVE 600 000670 1324 TAD CCHKT1 601 000671 1370 TAD (-"0 602 000672 7510 SPA /LEGAL RANGE 603 000673 5305 JMP CCHK2 /NO 604 000674 1367 TAD ("0-"9 605 000675 7550 SPA SNA 606 000676 5303 JMP CCHK1 /OKAY FOR NUMERAL 607 000677 1366 TAD ("9-"A 608 000700 7510 SPA /IN RANGE 609 000701 5305 JMP CCHK2 /NO 610 000702 1365 TAD ("A-"Z 611 000703 7750 CCHK1, SPA SNA CLA 612 000704 5666 JMP I CCHECK /LEGAL ALPHA CHAR 613 614 000705 7200 CCHK2, CLA 615 000706 1364 TAD (CCHKL1-1 616 000707 3012 DCA XR12 617 000710 1412 CCHK3, TAD I XR12 618 000711 7450 SNA 619 000712 5320 JMP CCHK4 /REACHED END OF LIST 620 000713 1324 TAD CCHKT1 621 000714 7650 SNA CLA /CHAR MATCH TABLE? 622 000715 5320 JMP CCHK4 /YES 623 000716 2012 ISZ XR12 /NO. SKIP SEP. VALUE 624 000717 5310 JMP CCHK3 /KEEP GOING 625 626 000720 1412 CCHK4, TAD I XR12 /GET SEPCOD VALUE 627 000721 3024 DCA SEPCOD /SAVE SEPARATOR VALUE 628 000722 2266 ISZ CCHECK 629 000723 5666 JMP I CCHECK /RETURN 630 631 000724 0000 CCHKT1, 0 632 633 634 000725 0000 LNKGET, .-. /GET COUNT AND POINTER FOR 635 /LINK # IN AC 636 000726 1363 TAD (LNKLST-1 637 000727 3345 DCA LNKGP1 /POINT TO LINK CHAIN 638 000730 1745 TAD I LNKGP1 639 000731 7450 SNA /NULL LINK?? 640 000732 4562 JMS I [IERROR /INTERNAL ERROR 641 000733 3345 DCA LNKGP1 /POINTER TO SFLD STORAGE 642 000734 4065 SFLD 643 000735 1745 TAD I LNKGP1 /GET CHAR COUNT 644 000736 6201 CDF 0 645 000737 7041 CIA 646 000740 3725 DCA I LNKGET /SAVE AS ARG 1 647 000741 2325 ISZ LNKGET 648 000742 7001 IAC 649 000743 1345 TAD LNKGP1 /RETURN POINTER TO GOODIES 650 000744 5725 JMP I LNKGET 651 652 000745 0000 LNKGP1, 0 653 654 655 000746 0000 PUSHA, .-. /PUSH ONE WORD INTO PD LIST 656 000747 6211 CDF 10 /8K:10; 12K:10; >12K:20 657 000750 3446 DCA I PUSHP 658 000751 6201 CDF 0 659 000752 7160 CMA STL 660 000753 1046 TAD PUSHP 661 000754 3046 DCA PUSHP /LINK NOW CLEAR 662 000755 1046 TAD PUSHP /8K:USE INSTEAD OF 'LNKLIM' 663 000756 7141 PUSHA1, CIA CLL /8K; >8K:SZA CLA 664 000757 1044 TAD LNKEND /8K; >8K:JMP I PUSHA 665 000760 7620 SNL CLA /8K; >8K:JMS I [TERROR 666 000761 5746 JMP I PUSHA 667 000762 4572 JMS I [TERROR 668 669 /PB 670 /PB 671 000763 7043 PAGE 000764 5520 000765 7747 000766 7770 000767 7767 000770 7520 000771 0475 000772 2536 000773 7575 000774 7577 000775 0014 000776 7776 000777 7566 672 673 674 001000 0000 LNKCHK, .-. /CHECK LINK FOR STORAGE O'FLOW 675 001001 1044 TAD LNKEND 676 001002 3741 DCA I LNKRP1 /SET LINK POINTER FINALLY 677 001003 1600 TAD I LNKCHK 678 001004 2200 ISZ LNKCHK 679 001005 4065 SFLD 680 001006 3444 DCA I LNKEND /STORE COUNT 681 001007 1444 TAD I LNKEND 682 001010 4342 JMS LNKCNT /FORM COUNT 683 001011 7001 IAC /INCLUDE COUNT IN COUNT 684 001012 1044 TAD LNKEND 685 001013 3044 DCA LNKEND /NEW END POINT OF STORAGE 686 001014 1046 TAD PUSHP /8K; >8K:TAD LNKLIM 687 001015 7141 CIA CLL 688 001016 1044 LCHK1, TAD LNKEND 689 001017 7620 SNL CLA /O'FLOW? 690 001020 5600 JMP I LNKCHK /NO 691 001021 4572 JMS I [TERROR /SPACE EXCEEDED 692 693 694 695 696 697 001022 0000 LNKDEL, .-. /DELETE LINK (# IN AC) 698 001023 7450 SNA /LINK ZERO DOESN'T EXIST 699 001024 5622 JMP I LNKDEL 700 001025 1377 TAD (LNKLST-1 701 001026 3312 DCA LNKDT1 702 001027 1712 TAD I LNKDT1 703 001030 3313 DCA LNKDT2 /STARTING POINT OF LINK 704 001031 3712 DCA I LNKDT1 /KILL REFERENCE IN LNKLST 705 001032 4065 SFLD 706 001033 1713 TAD I LNKDT2 /COUNT 707 001034 4342 JMS LNKCNT /FORM COUNT 708 001035 7040 CMA /GIVES -(WORD COUNT + 1) 709 001036 3314 DCA LNKDT3 710 001037 1314 TAD LNKDT3 711 001040 7040 CMA 712 001041 1313 TAD LNKDT2 713 001042 3010 DCA XR10 /'FROM' ADDRESS 714 001043 7040 CMA 715 001044 1313 TAD LNKDT2 716 001045 3011 DCA XR11 /'TO' ADDRESS 717 001046 1376 TAD (LNKLST 718 001047 3312 DCA LNKDT1 719 001050 1375 TAD (-LNKNUM 720 001051 3315 DCA LNKDC1 /NUMBER OF LINKS TO CHANGE 721 001052 1712 LNKD1, TAD I LNKDT1 /GET LINK 722 001053 7450 SNA /IGNORE EMPTY LINK 723 001054 5264 JMP LNKD2 724 001055 7160 CMA STL 725 001056 1010 TAD XR10 /> DELETED LINK? 726 001057 7620 SNL CLA 727 001060 5264 JMP LNKD2 /NO 728 001061 1712 TAD I LNKDT1 /YES 729 001062 1314 TAD LNKDT3 /CREATE 'NEW' ADDRESS 730 001063 3712 DCA I LNKDT1 731 001064 2312 LNKD2, ISZ LNKDT1 /NEXT LINK 732 001065 2315 ISZ LNKDC1 /DONE? 733 001066 5252 JMP LNKD1 /NO 734 735 001067 1044 TAD LNKEND 736 001070 1314 TAD LNKDT3 737 001071 3044 DCA LNKEND /CHANGE END 738 001072 1044 TAD LNKEND 739 001073 7040 CMA 740 001074 1011 TAD XR11 741 001075 7001 IAC 742 001076 7450 SNA 743 001077 5622 JMP I LNKDEL /DONE IF NOTHING TO MOVE 744 001100 3315 DCA LNKDC1 745 001101 4065 SFLD 746 001102 1410 TAD I XR10 747 001103 3411 DCA I XR11 748 001104 2315 ISZ LNKDC1 749 001105 5302 JMP .-3 750 001106 6201 CDF 0 751 001107 7001 IAC 752 001110 3052 DCA DLTESW /LEAVE INDICATOR FOR MACX 753 001111 5622 JMP I LNKDEL 754 755 001112 0000 LNKDT1, 0 756 001113 0000 LNKDT2, 0 757 001114 0000 LNKDT3, 0 758 001115 0000 LNKDC1, 0 759 760 001116 0000 LNKCRT, .-. /CREATE NEW LINK 761 001117 1375 TAD (-LNKNUM 762 001120 3342 DCA LNKRC1 763 001121 1376 TAD (LNKLST 764 001122 3341 DCA LNKRP1 765 001123 1741 LNKR1, TAD I LNKRP1 766 001124 7650 SNA CLA /FIND EMPTY SLOT? 767 001125 5332 JMP LNKR2 /YES. SET UP LINK 768 001126 2341 ISZ LNKRP1 /NO. POINT AHEAD 769 001127 2342 ISZ LNKRC1 /SEARCH ALL SLOTS? 770 001130 5323 JMP LNKR1 /NO 771 001131 4572 JMS I [TERROR /OUT OF SLOTS 772 773 001132 1044 LNKR2, TAD LNKEND 774 001133 7001 IAC 775 001134 3716 DCA I LNKCRT /SAVE DATA ADDRESS 776 001135 2316 ISZ LNKCRT /SKIP 777 001136 1341 TAD LNKRP1 778 001137 1374 TAD (-LNKLST+1 /GENERATE LINK NUMBER 779 001140 5716 JMP I LNKCRT 780 781 001141 0000 LNKRP1, 0 782 LNKRC1=. /TO SAVE MORE SPACE 783 784 785 786 001142 0000 LNKCNT, .-. /FORM WORD COUNT FROM CHAR COUNT 787 001143 6201 CDF 0 788 001144 7101 IAC CLL 789 001145 7004 RAL /MULTIPLY BY 2 790 001146 3032 DCA MQ 791 001147 7004 RAL /PUT LINK IN LOW ORDER AC 792 001150 4561 JMS I [DVI 793 001151 0003 3 794 001152 4560 JMS I [CLAMQA 795 001153 5742 JMP I LNKCNT 796 797 001154 0000 TRNSFR, .-. /TRANSFER ACCORDING TO SEPCOD 798 001155 1354 TAD TRNSFR 799 001156 3313 DCA TRNSP1 /IF NO MATCH, RETURN HERE 800 001157 1024 TAD SEPCOD 801 001160 7160 CMA STL /WATCH THE LINK! 802 001161 3312 DCA TRNSC1 /SAVE COUNT 803 001162 2354 ISZ TRNSFR 804 001163 1754 TAD I TRNSFR /GET MATCH MASK 805 001164 7430 TRNS1, SZL /BIT SET? 806 001165 2354 ISZ TRNSFR /YES. SKIP 807 001166 7104 CLL RAL 808 001167 2312 ISZ TRNSC1 /REACH PROMISED LAND? 809 001170 5364 JMP TRNS1 /NO 810 001171 7630 SZL CLA /YES. BIT SET? 811 001172 5754 JMP I TRNSFR /YES 812 001173 5713 JMP I TRNSP1 /NO 813 814 TRNSP1=LNKDT2 /CHEAT AGAIN 815 TRNSC1=LNKDT1 /CHEAT 816 817 /PB 818 /PB 819 001174 0735 PAGE 001175 7645 001176 7044 001177 7043 820 821 001200 0000 GATHER, .-. /COLLECT CHARACTERS OF FIELD 822 001201 2022 ISZ SCANP2 823 001202 1022 TAD SCANP2 824 001203 3021 DCA SCANP1 /SET POINTER 825 001204 1022 TAD SCANP2 826 001205 3023 DCA SCANP3 /THIS ONE TOO 827 001206 1377 TAD (GATHBF 828 001207 3255 DCA GATHP1 /FOR COLLECTED FIELD 829 001210 7144 CMA CLL RAL /-2 830 001211 3253 DCA GATHBT /BYTE 831 001212 3016 DCA GATHBF /CLEAR BUFFER 832 001213 3017 DCA GATHBF+1 833 001214 3020 DCA GATHBF+2 834 001215 1376 TAD (-6 835 001216 3254 DCA GATHC1 /FIELD LENGTH 836 001217 1422 GATH1, TAD I SCANP2 837 001220 4557 JMS I [CCHECK /CHECK CHAR 838 001221 5226 JMP GATH2 /ALPHA-NU 839 001222 1016 TAD GATHBF /SEP. 840 001223 7640 SZA CLA /ANY FIELD? 841 001224 2200 ISZ GATHER /YES 842 001225 5600 JMP I GATHER /RETURN 843 844 001226 1254 GATH2, TAD GATHC1 845 001227 7650 SNA CLA /COUNT ALREADY 0? 846 001230 5251 JMP GATH3 /YES. DON'T BUFFER 847 001231 1422 TAD I SCANP2 /NO. GET CHAR 848 001232 0156 AND [77 /SAVE TRIMMED ONLY 849 001233 3250 DCA GATHT1 850 001234 1655 TAD I GATHP1 851 001235 7106 CLL RTL 852 001236 7006 RTL 853 001237 7006 RTL 854 001240 1250 TAD GATHT1 855 001241 3655 DCA I GATHP1 856 001242 2253 ISZ GATHBT /DONE WORD? 857 001243 5247 JMP .+4 858 001244 2255 ISZ GATHP1 /YES 859 001245 7144 CMA CLL RAL /POINT AHEAD, RESET BYTE 860 001246 3253 DCA GATHBT 861 001247 2254 ISZ GATHC1 /INDICATE CHAR SEEN 862 001250 0000 GATHT1, ZZZ /TEMP. 863 001251 2022 GATH3, ISZ SCANP2 864 001252 5217 JMP GATH1 /PROCEED 865 866 001253 0000 GATHBT, 0 867 001254 0000 GATHC1, 0 868 001255 0000 GATHP1, 0 869 870 871 001256 0000 POP, .-. /POP PARAMS BY LIST 872 001257 7240 CLA CMA /-1 873 001260 1656 TAD I POP 874 001261 3012 DCA XR12 /USE FOR CHEAPNESS SAKE 875 001262 2256 ISZ POP 876 001263 1412 POP1, TAD I XR12 877 001264 7450 SNA /0 ADDRESS? 878 001265 5313 JMP POP3 /YES 879 001266 3326 DCA POPP1 880 001267 7144 CMA CLL RAL /-2 881 001270 1012 TAD XR12 882 001271 3012 DCA XR12 /BACK UP 883 001272 1412 TAD I XR12 884 001273 3325 DCA POPC1 /COUNT 885 001274 1325 TAD POPC1 886 001275 7040 CMA 887 001276 1326 TAD POPP1 888 001277 3326 DCA POPP1 /START AT END! 889 001300 7144 CLL CMA RAL /-2 890 001301 1012 TAD XR12 891 001302 3012 DCA XR12 892 001303 4775 POP2, JMS POPA /GET ONE WORD 893 001304 3726 DCA I POPP1 894 001305 7040 CMA 895 001306 1326 TAD POPP1 896 001307 3326 DCA POPP1 897 001310 2325 ISZ POPC1 898 001311 5303 JMP POP2 899 001312 5263 JMP POP1 900 901 001313 7144 POP3, CLL CMA RAL /-2 902 001314 1012 TAD XR12 903 001315 3012 DCA XR12 904 001316 1412 TAD I XR12 905 001317 7450 SNA 906 001320 5656 JMP I POP 907 001321 3326 DCA POPP1 908 001322 4775 JMS POPA 909 001323 3726 DCA I POPP1 910 001324 5313 JMP POP3 911 912 001325 0000 POPC1, 0 913 POPP1=. /FOR SPACE 914 915 001326 0000 TYO, .-. /YEA OLDE TELETYPE OUTPUT 916 001327 5332 JMP .+3 /FIRST TIME 917 001330 6041 TSF 918 001331 5330 JMP .-1 919 001332 6046 TLS 920 001333 7200 CLA 921 001334 1353 TAD MCRT1 /SKP, WHICH DOES NOTHING 922 001335 3327 DCA TYO+1 /SO WE SAVE TIME LATER 923 001336 5726 JMP I TYO 924 925 926 001337 1050 MCRET, TAD MACON /FORCED RETURN FROM MACRO, SKIP 927 001340 7650 SNA CLA /PRESENTLY EXPANDING MACRO? 928 001341 4555 JMS I [EERROR /NO. ERROR 929 001342 4774 JMS MACPOP /YES. RESTORE STATUS 930 /FALL THROUGH TO DETERMINE # OF 931 /LINES TO SKIP 932 001343 2030 ISZ MATCP1 /FIRST CHECK FOR MPCHR 933 001344 1430 TAD I MATCP1 934 001345 1154 TAD [-MPCHR 935 001346 7640 SZA CLA /SEE MPCHR? 936 001347 5355 JMP MPSKIP /NO. TRY FOR EXPR 937 001350 2030 ISZ MATCP1 /YES. CHECK FOR SEPARATOR 938 001351 1430 TAD I MATCP1 939 001352 4557 JMS I [CCHECK /LOOK FOR ANY SEPARATOR 940 001353 7410 MCRT1, SKP /SAW ALPHA 941 001354 5773 JMP IF7 /SAW SEPARATOR. CAUSE LOOP 942 001355 4772 MPSKIP, JMS EVAL /MATCH HAS SET EVERYTHING UP. 943 /EVALUATE EXPRESSION 944 001356 7550 MPSK1, SPA SNA /=>0? (IF10 JUMPS HERE!) 945 001357 5365 JMP MPSK2 /NO. IGNORE SKIP 946 001360 7041 CIA /YES 947 001361 3367 DCA MPSC1 /SAVE COUNT 948 001362 4771 JMS GETLIN /GET LINE 949 001363 2367 ISZ MPSC1 /IGNORE IT. DONE SKIPPING? 950 001364 5362 JMP .-2 951 001365 7200 MPSK2, CLA /FOR MPSK1+1 952 001366 5553 JMP I [INLUP /PROCESS NEXT LINE 953 954 001367 0000 MPSC1, 0 /COUNT 955 956 957 958 /PB 959 /PB 960 961 001371 0600 PAGE 001372 4400 001373 5067 001374 4252 001375 2764 001376 7772 001377 0016 962 963 / 964 / TABLE LOOKUP ROUTINE 965 / TABLE IS HASHED, QUADRATIC (CACM 1/68 - MAURER) 966 / 967 / CALL: JMS I [LOOKUP /LABEL IN GATHBF 968 / IOR OF SYMBOL TYPE BITS (+40 TO CREATE) 969 / ERROR RETURN 970 / NORMAL RETURN 971 / 972 / ADDRESS OF DATA IN TBLWD1, TBLWD2 973 / 974 975 976 / THIS IS TABLE OF RETURNS, DEPENDING ON CALL: 977 / 978 / FOUND WRONG CREATE? 979 / TYPE? 980 / Y Y Y /ERR. RET., TBLFLG=0 981 / Y Y N /ERR. RET., TBLFLG=0 982 / Y N Y /NOR. RET., TBLFLG=7777 983 / Y N N /NOR. RET., TBLFLG=7777 984 / N Y Y /*****NOT POSSIBLE 985 / N Y N /*****NOT POSSIBLE 986 / N N Y /NOR. RET. (CREATED), 987 /TBLFLG=-1 988 / N N N /ERR. RET., TBLFLG=7777 989 990 001400 0000 LOOKUP, .-. 991 001401 1377 TAD (-HTBLST 992 001402 3311 DCA TBLSC1 /HALF OF TABLE ADEQUATE FOR SEARCH 993 001403 7040 CMA /SET TBLFLG AS DEFAULT CONDITION 994 001404 3027 DCA TBLFLG 995 001405 1376 TAD (10 /ARBITRARY 996 001406 3313 DCA TBLST2 /FIRST INCREMENT 997 001407 1020 TAD GATHBF+2 /START HASH 998 001410 7112 CLL RTR 999 001411 1016 TAD GATHBF 1000 001412 7112 CLL RTR 1001 001413 1017 TAD GATHBF+1 1002 001414 7112 CLL RTR /DONE HASH 1003 001415 4552 JMS I [MQLDVI 1004 001416 0133 TBLSK1, TBLSLT /DIVIDE BY TABLE LENGTH 1005 001417 3312 TBLS1, DCA TBLST1 /REMAINDER IS SLOT NUMBER 1006 001420 1312 TAD TBLST1 1007 001421 7106 CLL RTL 1008 001422 1312 TAD TBLST1 /SLOT * 5 (SLOT SIZE) 1009 001423 1375 TAD (SYMTBL-1 1010 001424 3011 DCA XR11 /POINT TO SLOT 1011 001425 1411 TAD I XR11 1012 001426 7450 SNA 1013 001427 5270 JMP TBLS4 /SLOT EMPTY 1014 001430 1016 TAD GATHBF 1015 001431 7640 SZA CLA /FIRST CHARS MATCH? 1016 001432 5252 JMP TBLS2 /NO 1017 001433 1411 TAD I XR11 /YES 1018 001434 1017 TAD GATHBF+1 1019 001435 7640 SZA CLA /SECOND TWO? 1020 001436 5252 JMP TBLS2 1021 001437 1411 TAD I XR11 1022 001440 1020 TAD GATHBF+2 1023 001441 7640 SZA CLA /THIRD TWO? 1024 001442 5252 JMP TBLS2 /NO 1025 001443 1411 TAD I XR11 1026 001444 0165 AND [7700 /GET 'TYPE BITS' 1027 001445 0600 AND I LOOKUP /LOOKING FOR THIS TYPE? 1028 001446 7640 SZA CLA 1029 001447 5301 JMP TBLS5 /YES. EVERYTHING HUNKY-DOREY 1030 001450 3027 DCA TBLFLG /NO. SET WRONG TYPE 1031 001451 5302 JMP TBLS6 1032 1033 001452 2311 TBLS2, ISZ TBLSC1 /TRY HALF OF TABLE? 1034 001453 5261 JMP TBLS3 /NO 1035 001454 1374 TAD (40 /YES 1036 001455 0600 AND I LOOKUP /TRYING TO CREATE ENTRY? 1037 001456 7650 SNA CLA 1038 001457 5307 JMP TBLS7 /NO. JUST RETURN 'NOT FOUND' 1039 001460 4572 JMS I [TERROR /YES. TABLE FULL 1040 1041 001461 2313 TBLS3, ISZ TBLST2 /INCREMENT THE INCREMENT 1042 001462 1313 TAD TBLST2 1043 001463 1312 TAD TBLST1 /FORM NEW SLOT NUMBER 1044 001464 1373 TAD (-TBLSLT 1045 001465 7510 SPA /EXCEED TABLE SIZE 1046 001466 1216 TAD TBLSK1 /NO. RESTORE VALUE 1047 001467 5217 JMP TBLS1 /AC HAS SLOT MODULO TABLE SIZE 1048 1049 001470 1374 TBLS4, TAD (40 1050 001471 0600 AND I LOOKUP /MASK CREATE BIT IN CALL 1051 001472 7650 SNA CLA /CREATE REQUESTED? 1052 001473 5307 JMP TBLS7 /NO. ERR. RET. (NOT FOUND) 1053 001474 7040 CMA /YES. BACK UP 1054 001475 1011 TAD XR11 1055 001476 3011 DCA XR11 /FOR SUBROUTINE 1056 001477 4314 JMS TBLSUB /PUT GATHBF IN TABLE 1057 001500 7001 IAC /WATCH FALL THROUGH 1058 001501 2200 TBLS5, ISZ LOOKUP /SKIP ARG. WORD 1059 001502 1011 TBLS6, TAD XR11 /GET 'TYPE' WORD ADDRESS 1060 001503 3025 DCA TBLWD1 /SAVE 1061 001504 7001 IAC 1062 001505 1025 TAD TBLWD1 1063 001506 3026 DCA TBLWD2 /VALUE WORD 1064 001507 2200 TBLS7, ISZ LOOKUP /INCREMENT ONE MORE TIME 1065 001510 5600 JMP I LOOKUP /RETURN 1066 1067 1068 001511 0000 TBLSC1, 0 1069 001512 0000 TBLST1, 0 1070 001513 0000 TBLST2, 0 1071 1072 001514 0000 TBLSUB, .-. /MOVE GATHBF THRU XR11 1073 001515 1016 TAD GATHBF 1074 001516 7041 CIA 1075 001517 3411 DCA I XR11 1076 001520 1017 TAD GATHBF+1 1077 001521 7041 CIA 1078 001522 3411 DCA I XR11 1079 001523 1020 TAD GATHBF+2 1080 001524 7041 CIA 1081 001525 3411 DCA I XR11 1082 001526 5714 JMP I TBLSUB 1083 1084 1085 001527 0000 PUSH, .-. /PUSH PARAMS BY LIST 1086 001530 7240 CLA CMA 1087 001531 1727 TAD I PUSH 1088 001532 3012 DCA XR12 1089 001533 2327 ISZ PUSH 1090 001534 1412 PUSH1, TAD I XR12 1091 001535 7450 SNA /DONE SINGLES? 1092 001536 5344 JMP PUSH2 /YES 1093 001537 3360 DCA PUSHP1 1094 001540 1760 TAD I PUSHP1 1095 001541 4772 JMS PUSHA 1096 001542 3760 DCA I PUSHP1 /CLEAR OLD REGISTER 1097 001543 5334 JMP PUSH1 1098 1099 001544 1412 PUSH2, TAD I XR12 1100 001545 7450 SNA 1101 001546 5727 JMP I PUSH 1102 001547 3361 DCA PUSHC1 1103 001550 7040 CMA 1104 001551 1412 TAD I XR12 1105 001552 3011 DCA XR11 1106 001553 1411 TAD I XR11 1107 001554 4772 JMS PUSHA 1108 001555 2361 ISZ PUSHC1 1109 001556 5353 JMP .-3 1110 001557 5344 JMP PUSH2 1111 1112 001560 0000 PUSHP1, 0 1113 001561 0000 PUSHC1, 0 1114 1115 001562 0000 IERROR, .-. /INTERNAL 1116 001563 4551 JMS I [ERROR 1117 001564 0311 "I 1118 001565 5571 JMP I [7600 1119 1120 001566 0000 TERROR, .-. /TABLE 1121 001567 4551 JMS I [ERROR 1122 001570 0324 "T 1123 001571 5571 JMP I [7600 /PUNT ON INTERNAL OR TABLE 1124 TTERR=[TERROR /FOR FIELD 1 INITIALIZATION 1125 1126 /PB 1127 /PB 1128 001572 0746 PAGE 001573 7645 001574 0040 001575 6134 001576 0010 001577 7722 1129 / 1130 / PRINCIPLE LOOP OF PROGRAM 1131 / 1132 1133 001600 4777 INLUP, JMS GETLIN /GET LINE 1134 001601 1035 TAD LINCNT /FETCH COUNT 1135 001602 3215 DCA INLPC1 /SAVE 1136 001603 1022 INLUP0, TAD SCANP2 /POINT TO BEGINNING OF LINE -1 1137 001604 3010 DCA XR10 1138 001605 1410 INLUP1, TAD I XR10 1139 001606 1154 TAD [-MPCHR /MACRO PROCESSOR SIGNAL? 1140 001607 7650 SNA CLA 1141 001610 5776 JMP MPCHK /YES 1142 001611 2215 ISZ INLPC1 1143 001612 5205 JMP INLUP1 1144 001613 4312 INLUP2, JMS PUTLIN /OUTPUT LINE AS IS 1145 001614 5200 JMP INLUP /CONTINUE PROCESSING 1146 /CONTROL GOES TO 'INEOF' ON ^Z 1147 1148 1149 001615 0000 INLPC1, 0 1150 1151 001616 1375 INEOF, TAD (232 /WRITE EOF. GET HERE FROM 'RDCHR' 1152 001617 4774 JMS WRTCHR 1153 001620 4773 JMS OUTBUF /PURGE BUFFER 1154 001621 6212 CIF 10 1155 001622 4565 JMS I [7700 /FETCH USR 1156 001623 0010 10 /USRIN 1157 001624 1060 TAD OUTCD /POINTER TO OUTPUT FILE DESCRIPTION 1158 001625 7450 SNA /WAS THERE ONE? 1159 001626 5235 JMP INEOF2 /NO. AVOID TRYING TO CLOSE FILE 1160 001627 6212 CIF 10 1161 001630 4573 JMS I [USR /CLOSE OUTPUT 1162 001631 0004 4 1163 001632 0061 OUTCD+1 /POINTER TO NAME 1164 001633 0000 OUTFSZ, ZZZ /OUTPUT FILE SIZE KEPT HERE 1165 001634 5251 JMP ENDER1 /CLOSING ERROR 1166 001635 1777 INEOF2, TAD GETLIN 1167 001636 1372 TAD (-INLUP-1 1168 001637 7640 SZA CLA /GETLIN CALLED FROM INLUP? 1169 001640 5250 JMP ENDER2 /NO. MCDF OR IF RAN PAST EOF 1170 001641 7040 CMA /YES. 1171 001642 1303 TAD CHNDEV /DEVICE #, FIRST INPUT FILE 1172 001643 7450 SNA /1? 1173 001644 5253 JMP INEOF3 /YES 1174 001645 7750 SPA SNA CLA /NULL 1175 001646 5571 JMP I [7600 /YES 1176 001647 1371 TAD ("D-"R /WRONG DEVICE. (PRINT 'D') 1177 001650 1370 ENDER2, TAD ("R-"C /RAN OUT OF INPUT (PRINT 'R') 1178 001651 4303 ENDER1, JMS SERROR 1179 001652 0303 "C 1180 1181 001653 1233 INEOF3, TAD OUTFSZ /WILL CHAIN 1182 001654 0367 AND (7400 /CHECK >377 1183 001655 7650 SNA CLA /OUTPUT FILE > 255 BLOCKS? 1184 001656 1233 TAD OUTFSZ /NO 1185 001657 7041 CIA 1186 001660 0167 AND [377 /GET READY TO FORM INPUT CD FORMAT 1187 001661 7106 CLL RTL 1188 001662 7006 RTL 1189 001663 3235 DCA INEOF2 /SAVE MODIFIED FILE LENGTH 1190 001664 1233 TAD OUTFSZ 1191 001665 7041 CIA 1192 001666 1766 TAD OUTBLK /GIVES START BLOCK 1193 001667 6213 CDF CIF 10 /CIF FOR LATER 1194 001670 3765 DCA I (7620 /BLOCK OF CD FIRST INPUT 1195 001671 1060 TAD OUTCD 1196 001672 0370 AND (17 /DEVICE PART 1197 001673 1235 TAD INEOF2 /FORM CD INPUT WORD ONE, FILE 1 1198 001674 3764 DCA I (7617 /STORE IN POSITION 1199 001675 3763 DCA I (7621 /0 TO END LIST 1200 001676 6201 CDF 0 /BACK TO THIS FIELD 1201 001677 2762 ISZ I (7746 /SET JSW TO FUDGE BUG IN 1202 /PAL8, ETC SINCE THEY THINK USR IS 1203 /ALWAYS IN CORE ON CHAINING 1204 001700 4573 JMS I [USR 1205 001701 0006 6 /CHAIN 1206 001702 0000 CHNBLK, ZZZ /FROM START-UP 1207 /NO RETURN 1208 1209 CHNDEV=. /USE SERROR, SINCE THERE'LL BE NO CHAIN 1210 /IF THAT ERROR COMES UP 1211 1212 001703 0000 SERROR, .-. /SYSTEM RELATED ERROR 1213 001704 1703 TAD I SERROR 1214 001705 1361 TAD (-"0 /SINCE MONITOR ROUTINE ADDS 1215 /"0 TO WHAT IT THINKS IS A DIGIT 1216 001706 3312 DCA .+4 1217 001707 6212 CIF 10 1218 001710 4565 JMS I [7700 1219 001711 0007 7 /SIGNAL USER ERROR 1220 /USE PUTLIN, SINCE WE'RE GOING 1221 /BYE-BYE 1222 1223 1224 001712 0000 PUTLIN, .-. /OUTPUT LINE 1225 001713 1036 TAD LINBUF 1226 001714 3010 DCA XR10 /POINTER 1227 001715 3022 DCA SCANP2 /IN CASE OF /W OPTION 1228 001716 1410 PUTL1, TAD I XR10 /GET CHAR 1229 001717 1154 TAD [-MPCHR 1230 001720 7450 SNA /FIND MPCHR? 1231 001721 2022 ISZ SCANP2 /YES. NOTE IT 1232 001722 1150 TAD [MPCHR /RESTORE CHAR 1233 001723 4774 JMS WRTCHR /WRITE IT 1234 001724 2035 ISZ LINCNT /DONE LINE? 1235 001725 5316 JMP PUTL1 /NO 1236 001726 1022 TAD SCANP2 /YES. FIND MPCHR? 1237 001727 7640 SZA CLA 1238 001730 4760 PUTL2, JMS ERRS1 /YES. PRINT LINE 1239 001731 1050 TAD MACON 1240 001732 7650 SNA CLA /MACRO EXPANSION ON? 1241 001733 5712 JMP I PUTLIN /NO 1242 001734 1357 TAD (212 /YES 1243 001735 4774 JMS WRTCHR /OUTPUT LF 1244 001736 5712 JMP I PUTLIN 1245 1246 001737 0000 MCCRSM, .-. /CREATE AND SAVE MACRO CREATED 1247 /SYMBOL 1248 001740 1356 TAD ("Z /FIRST CHAR OF CRSM 1249 001741 4745 JMS I MCCRP1 /DISPOSE OF IT 1250 001742 2350 ISZ MCCRT1 /OBTAIN NEXT CRSM VALUE 1251 001743 1350 TAD MCCRT1 1252 001744 4755 JMS DECOUT /PRODUCE DECIMAL 1253 001745 3760 MCCRP1, MACXS1 /PUSH DIGITS THRU MACXS1 1254 001746 4000 4000 /PERMIT LEADING 0'S 1255 001747 5737 JMP I MCCRSM 1256 1257 001750 0000 MCCRT1, 0 /CREATED SYMBOL # 1258 1259 1260 /PB 1261 /PB 1262 001755 2517 PAGE 001756 0332 001757 0212 001760 4320 001761 7520 001762 7746 001763 7621 001764 7617 001765 7620 001766 0547 001767 7400 001770 0017 001771 7762 001772 6177 001773 0506 001774 0475 001775 0232 001776 2000 001777 0600 1263 1264 / 1265 / PATTERN MATCHING ALGORITHM FOR 8BAL. SEE PROGRAM 1266 / WRITE-UP FOR RESTRICTIONS AND DESCRIPTION OF PATTERN 1267 / STORAGE 1268 / 1269 1270 002000 1377 MPCHK, TAD (PATLST-1 /LIST OF POINTERS TO PATTERNS 1271 002001 3010 DCA XR10 1272 002002 1022 TAD SCANP2 1273 002003 3021 DCA SCANP1 /PUT SCAN POINTER WHERE IT BELONGS 1274 002004 1176 TAD [MPEXPD 1275 002005 3247 DCA MPCHP2 /SET UP DEFAULT TRANSFER 1276 002006 1410 MPCH1, TAD I XR10 /GET POINTER TO PATTERNS 1277 002007 7450 SNA /END OF LIST? 1278 002010 5216 JMP MPCH2 /YES 1279 002011 1376 TAD (-1 /CORRECT POINTER 1280 002012 3011 DCA XR11 /NO. POINT TO CONTROL WORD 1281 002013 3411 DCA I XR11 /0 IT 1282 002014 3411 DCA I XR11 /AND FIELD POINTER 1283 002015 5206 JMP MPCH1 1284 1285 002016 3250 MPCH2, DCA MPCHI1 /0 LIVE INDICATOR 1286 002017 1377 TAD (PATLST-1 1287 002020 3010 DCA XR10 /POINT TO POINTERS AGAIN 1288 002021 2021 ISZ SCANP1 /POINT TO NEXT CHARACTER IN LINE 1289 002022 1410 MPCH3, TAD I XR10 1290 002023 7440 SZA /END OF PATTERN LIST? 1291 002024 5233 JMP MPCH4 /NO 1292 002025 1250 TAD MPCHI1 /YES. GET 'LIVE' INDICATOR 1293 002026 7640 SZA CLA /ANY PATTERN STILL ACTIVE? 1294 002027 5216 JMP MPCH2 /YES. CONTINUE 1295 002030 1030 TAD MATCP1 /NO. SET UP SCANP2 1296 002031 3022 DCA SCANP2 1297 002032 5647 JMP I MPCHP2 /AND GO WHERE INDICATED 1298 1299 002033 3246 MPCH4, DCA MPCHP1 /POINT TO CONTROL WORD 1300 002034 1646 TAD I MPCHP1 1301 002035 7710 SPA CLA /PATTERN REJECTED? 1302 002036 5222 JMP MPCH3 /YES 1303 002037 4251 JMS MATCH /NO. PATTERN MATCH CHARACTER? 1304 002040 5243 JMP MPCH5 /NO 1305 002041 2250 ISZ MPCHI1 /YES. SET 'LIVE' 1306 002042 5222 JMP MPCH3 /CONTINUE 1307 1308 002043 7130 MPCH5, STL RAR 1309 002044 3646 DCA I MPCHP1 /SET REJECT BIT 1310 002045 5222 JMP MPCH3 1311 1312 002046 0000 MPCHP1, 0 1313 002047 0000 MPCHP2, 0 /ADDRESS TO GO WHEN MATCHING 1314 /COMPLETE. 1315 002050 0000 MPCHI1, 0 /INDICATOR 1316 1317 / 1318 / MATCH PATTERN CHAR TO LINE BUFFER CHAR 1319 / (IN (SCANP1)) 1320 / 1321 1322 002051 0000 MATCH, .-. 1323 002052 1646 MATC1, TAD I MPCHP1 /CHARACTER NUMBER 1324 002053 1352 TAD MATCC3 /PATTERN IS AT +3 FROM THIS POINT 1325 002054 0147 AND [777 /KILL CONTROL BITS 1326 002055 1246 TAD MPCHP1 /FORM POINTER 1327 002056 3272 DCA MATCP2 /SAVE 1328 002057 1672 TAD I MATCP2 /GET PATTERN WORD 1329 002060 7500 SMA /SINGLE CHARACTER MATCH? 1330 002061 5270 JMP MATC4 /NO 1331 002062 1421 MATC1A, TAD I SCANP1 /YES. GET CHARACTER 1332 002063 7640 SZA CLA /MATCH? 1333 002064 5651 JMP I MATCH /NO. RETURN 'NO' 1334 1335 002065 2646 MATC2, ISZ I MPCHP1 /INCREMENT CHARACTER NUMBER 1336 002066 2251 MATC3, ISZ MATCH /RETURN 'YES' 1337 002067 5651 JMP I MATCH 1338 1339 002070 1273 MATC4, TAD .+3 /FORM JUMP 1340 002071 3272 DCA .+1 1341 002072 0000 MATCP2, ZZZ 1342 002073 5674 JMP I .+1 1343 002074 2101 MATCX0;MATCX1;MATCX2;MATCX3;MATCX4 002075 2115 002076 2145 002077 2065 002100 2147 1344 1345 002101 7001 MATCX0, IAC 1346 002102 1246 TAD MPCHP1 1347 002103 3247 DCA MPCHP2 /POINT AT FIELD POINTER 1348 002104 1647 TAD I MPCHP2 1349 002105 3031 DCA MATFLD /SAVE FIELD POINTER FOR LATER 1350 002106 2247 ISZ MPCHP2 /POINT AT TRANFER VECTOR 1351 002107 1647 TAD I MPCHP2 /GET IT 1352 002110 3247 DCA MPCHP2 /SAVE THIS FOR LATER, TOO 1353 002111 7040 CMA 1354 002112 1021 TAD SCANP1 1355 002113 3030 DCA MATCP1 /KEEP POINTER TO CHAR 1356 002114 5651 JMP I MATCH /RETURN FAIL TO INACTIVATE PATTERN 1357 1358 002115 1646 MATCX1, TAD I MPCHP1 /GET CONTROL BITS 1359 002116 0146 AND [1000 1360 002117 7640 SZA CLA /NAME FIELD IN PROGRESS 1361 002120 5335 JMP MATC11 /YES 1362 002121 1421 TAD I SCANP1 /NOT YET. 1363 002122 4557 JMS I [CCHECK /IS CHARACTER ALPHA OR NUMBER? 1364 002123 7410 SKP /YES 1365 002124 5651 JMP I MATCH /NO 1366 002125 1146 TAD [1000 1367 002126 1646 TAD I MPCHP1 1368 002127 3646 DCA I MPCHP1 /SET FIELD BIT 1369 002130 2246 ISZ MPCHP1 1370 002131 7040 CMA 1371 002132 1021 TAD SCANP1 1372 002133 3646 DCA I MPCHP1 /SAVE FIELD POINTER 1373 002134 5266 JMP MATC3 /RETURN 'YES' 1374 1375 002135 1421 MATC11, TAD I SCANP1 1376 002136 4557 JMS I [CCHECK /IS CHARACTER ALPHA OR NUMBER? 1377 002137 5266 JMP MATC3 /YES SUCCEED 1378 002140 1646 TAD I MPCHP1 1379 002141 0147 AND [777 /CLEAR CONTROL BITS 1380 002142 3646 DCA I MPCHP1 /AND SAVE CONTROL WORD 1381 002143 2646 ISZ I MPCHP1 /TRY NEXT CHARACTER IN PATTERN 1382 002144 5252 JMP MATC1 1383 1384 002145 1154 MATCX2, TAD [-MPCHR 1385 002146 5262 JMP MATC1A /SNEAK INTO SINGLE CHAR COMPARE 1386 1387 MATCX3=MATC2 /AUTOMATIC 'SUCCEED' 1388 1389 1390 002147 2024 MATCX4, ISZ SEPCOD /FORCE NON-ZERO 1391 002150 1421 TAD I SCANP1 1392 002151 4557 JMS I [CCHECK /CHECK CHAR (SET SEPCOD) 1393 002152 0003 MATCC3, 3 /SERVES AS NOP 1394 002153 7132 STL RTR 1395 002154 0646 AND I MPCHP1 1396 002155 7650 SNA CLA /SPACE IN PROGRESS? 1397 002156 5366 JMP MATC41 /NO 1398 002157 1024 TAD SEPCOD /YES 1399 002160 7650 SNA CLA /WAS CHAR SPACE OR TAB? 1400 002161 5266 JMP MATC3 /YES 1401 002162 1646 TAD I MPCHP1 1402 002163 0147 AND [777 1403 002164 3646 DCA I MPCHP1 /REMOVE CONTROL BITS 1404 002165 5345 JMP MATCX2 /AND LOOK FOR MPCHR 1405 1406 002166 1024 MATC41, TAD SEPCOD 1407 002167 7640 SZA CLA /SPACE OR TAB? 1408 002170 5651 JMP I MATCH /NO. FAIL 1409 002171 7132 STL RTR 1410 002172 1646 TAD I MPCHP1 1411 002173 3646 DCA I MPCHP1 /SET SPACES BIT 1412 002174 5266 JMP MATC3 /RETURN 'YES' 1413 1414 /PB 1415 /PB 1416 1417 002176 7777 PAGE 002177 5177 1418 1419 002200 0000 XPND1, .-. /PERFORM ONE PASS EXPANSION 1420 002201 3365 DCA XPNDI2 /SAVE PASS # (0 OR 1 FOR 1 OR 2) 1421 002202 1022 TAD SCANP2 1422 002203 3363 DCA XPNDSV /SAVE 1423 002204 3364 DCA XPNDI1 /CLEAR INDICATOR 1424 002205 2022 XPND2, ISZ SCANP2 /LOOK AT NEXT CHAR 1425 002206 1422 XPND3, TAD I SCANP2 /GET CHAR 1426 002207 1154 TAD [-MPCHR 1427 002210 7650 SNA CLA /MPCHR? 1428 002211 5231 JMP XPND6 /YES 1429 002212 1422 TAD I SCANP2 /NO 1430 002213 1163 TAD [-215 1431 002214 7450 SNA /HOW ABOUT CR? 1432 002215 5304 JMP XPND12 /YES 1433 002216 1377 TAD (-"'+215 1434 002217 7650 SNA CLA /HOW ABOUT ' ? 1435 002220 5227 JMP XPND5 /YES 1436 002221 1364 TAD XPNDI1 /NO 1437 002222 7650 SNA CLA /MOVED ANY CHARS YET? 1438 002223 5205 JMP XPND2 /NO 1439 002224 1422 XPND3A, TAD I SCANP2 /YES 1440 002225 3413 XPND4, DCA I XR13 /SAVE CHAR 1441 002226 5205 JMP XPND2 1442 1443 002227 4344 XPND5, JMS XPNDS1 /MAKE SURE POINTERS ARE SET 1444 002230 5205 JMP XPND2 /THEN, DO NEXT CHAR 1445 1446 002231 4344 XPND6, JMS XPNDS1 /MAKE SURE POINTERS ARE SET 1447 002232 4545 JMS I [GATHER /GET NAME AFTER MPCHR 1448 002233 5253 JMP XPND10 /NO FIELD 1449 002234 4544 JMS I [LOOKUP 1450 002235 7000 7000 /SET, SSET, CSET 1451 002236 5247 JMP XPND7 /NOT FOUND 1452 002237 1425 TAD I TBLWD1 /GET SYMBOL TYPE WORD 1453 002240 7106 CLL RTL /CSET BIT IN LINK 1454 002241 7420 SNL /CSET? 1455 002242 5776 JMP XPND20 /NO. SSET OR SET 1456 002243 1426 TAD I TBLWD2 /CSET. GET CHAR 1457 002244 7440 SZA /NULL? 1458 002245 3413 XPND6A, DCA I XR13 /NO. SAVE 1459 002246 5206 JMP XPND3 /CONTINUE 1460 1461 002247 1023 XPND7, TAD SCANP3 /PICK UP POINTER TO FIRST CHAR IN 1462 /NAME 1463 002250 3022 DCA SCANP2 /PUT IN SCANP2 FOR RE-SCAN. THEN... 1464 002251 1150 XPND8, TAD [MPCHR 1465 002252 5245 JMP XPND6A 1466 1467 002253 1422 XPND10, TAD I SCANP2 1468 002254 1375 TAD (-"" 1469 002255 7440 SZA /IS NEXT CHAR "? 1470 002256 5340 JMP XPND14 /NO. CHECK ' 1471 002257 2022 ISZ SCANP2 /YES 1472 002260 1422 TAD I SCANP2 1473 002261 1154 TAD [-MPCHR 1474 002262 7640 SZA CLA /MPCHR FOLLOW MPCHR" ? 1475 002263 5273 JMP XPND11 /NO. 1476 002264 1365 TAD XPNDI2 /YES. GET PASS 1477 002265 7640 SZA CLA /SECOND PASS? 1478 002266 5277 JMP XPN11A /YES. TREAT MPCHR LIKE OTHER 1479 /CHARS 1480 002267 1422 TAD I SCANP2 /NO. COPY MPCHR" 1481 002270 3413 DCA I XR13 /THIS GETS MPCHR 1482 002271 1423 TAD I SCANP3 /THIS, " 1483 002272 5245 JMP XPND6A /SAVE CHAR 1484 1485 002273 1422 XPND11, TAD I SCANP2 1486 002274 1163 TAD [-215 /MAKE SURE CHAR IS NOT NULL 1487 002275 7650 SNA CLA /NEXT CHAR CR? 1488 002276 5303 JMP XPN11Z /YES. ERROR 1489 002277 1022 XPN11A, TAD SCANP2 /NO 1490 002300 3026 DCA TBLWD2 /LET POINT AT CHAR TO FAKE SET 1491 002301 2022 ISZ SCANP2 /SKIP THE CHAR 1492 002302 5776 JMP XPND20 /WILL GO TO XSET TO CONVERT CHAR 1493 1494 002303 4543 XPN11Z, JMS I [WERROR /NULL CHAR IN MPCHR" CONST. 1495 002304 1364 XPND12, TAD XPNDI1 1496 002305 7650 SNA CLA /MOVE ANY CHARS? 1497 002306 5335 JMP XPND13 1498 002307 1422 TAD I SCANP2 /YES 1499 002310 3413 DCA I XR13 /SAVE CR 1500 002311 1013 TAD XR13 1501 002312 1374 TAD (-LINLIM-LNBUF1 1502 002313 7740 SMA SZA CLA /EXCEED END OF LINE BUFFER? 1503 002314 4572 JMS I [TERROR /YES 1504 002315 1013 TAD XR13 1505 002316 7041 CIA 1506 002317 1367 TAD XPNDT2 1507 002320 3370 DCA XPNDC1 /NUMBER OF CHARS TO MOVE BACK 1508 002321 1367 TAD XPNDT2 1509 002322 3013 DCA XR13 /WHERE TO MOVE FROM 1510 002323 1366 TAD XPNDT1 1511 002324 3011 DCA XR11 /WHERE TO MOVE TO 1512 002325 1413 TAD I XR13 1513 002326 3411 DCA I XR11 1514 002327 2370 ISZ XPNDC1 1515 002330 5325 JMP .-3 1516 002331 1011 TAD XR11 1517 002332 7041 CIA 1518 002333 1036 TAD LINBUF 1519 002334 3035 DCA LINCNT /NEW LINCNT 1520 002335 1363 XPND13, TAD XPNDSV 1521 002336 3022 DCA SCANP2 /RESTORE SCANP2 1522 002337 5600 JMP I XPND1 1523 1524 1525 002340 1373 XPND14, TAD (""-"' 1526 002341 7650 SNA CLA /CHAR '? 1527 002342 5224 JMP XPND3A /YES. COPY ' OF MPCHR' 1528 002343 5251 JMP XPND8 /NO. COPY MPCHR, RE-DO SEP. 1529 1530 1531 002344 0000 XPNDS1, .-. /XPND SUBROUTINE 1532 002345 1364 TAD XPNDI1 1533 002346 7640 SZA CLA /MOVING CHARS YET? 1534 002347 5744 JMP I XPNDS1 /YES 1535 002350 2364 ISZ XPNDI1 /SET INDICATOR 1536 002351 7040 CMA 1537 002352 1022 TAD SCANP2 1538 002353 3366 DCA XPNDT1 /SAVE FOR LATER 1539 002354 1035 TAD LINCNT 1540 002355 7041 CIA 1541 002356 1036 TAD LINBUF 1542 002357 3013 DCA XR13 /POINT TO LAST CHAR IN LINBUF 1543 002360 1013 TAD XR13 1544 002361 3367 DCA XPNDT2 /SAVE THIS TOO 1545 002362 5744 JMP I XPNDS1 1546 1547 002363 0000 XPNDSV, 0 1548 002364 0000 XPNDI1, 0 1549 002365 0000 XPNDI2, 0 1550 002366 0000 XPNDT1, 0 1551 002367 0000 XPNDT2, 0 1552 002370 0000 XPNDC1, 0 1553 1554 /PB 1555 /PB 1556 1557 002373 7773 PAGE 002374 1745 002375 7536 002376 2400 002377 7746 1558 1559 002400 7700 XPND20, SMA CLA /FROM XPND6. SSET? 1560 002401 5223 JMP XSET /NO. MUST BE SET 1561 002402 1426 XSSET, TAD I TBLWD2 /GET LINK NUMBER 1562 002403 4777 JMS LNKGET /GET GOODIES 1563 002404 0000 XCSST1, ZZZ /COUNT GOES HERE 1564 002405 3221 DCA XCSSTP /POINTER 1565 002406 3222 DCA XCSSTP+1 /BYTE 1566 002407 1204 TAD XCSST1 /GET COUNT 1567 002410 7650 SNA CLA 1568 002411 5776 JMP XPND3 /IF NULL SSET SYMBOL 1569 002412 4573 XCSST2, JMS I [GETCHR /GET CHARACTER 1570 002413 2421 XCSSTP 1571 002414 4065 SFLD 1572 002415 3413 DCA I XR13 /SAVE CHAR 1573 002416 2204 ISZ XCSST1 /DONE? 1574 002417 5212 JMP XCSST2 /NO 1575 002420 5776 JMP XPND3 /YES. RESUME EXPANSION 1576 1577 002421 0000 XCSSTP, 0;0 /POINTER, BYTE 002422 0000 1578 1579 1580 002423 1051 XSET, TAD OCTDEC /EXPAND SET SYMBOL 1581 002424 7650 SNA CLA /OCTAL? 1582 002425 1375 TAD (3 /YES. USES DIFFERENT CONVERSION 1583 /TABLE 1584 002426 4235 JMS CONVS1 /INITIALIZE CONVERSION 1585 002427 3306 DCA CONVI1 /SUPPRESS LEADING ZEROES 1586 002430 1426 TAD I TBLWD2 /GET VALUE 1587 002431 4243 JMS CONVS2 /RETURNS ONE DIGIT AT A TIME 1588 002432 3413 DCA I XR13 /SAVE 1589 002433 5231 JMP .-2 1590 002434 5776 JMP XPND3 /CONVS2 COMES HERE WHEN OUT 1591 /OF DIGITS 1592 1593 1594 002435 0000 CONVS1, .-. /SET UP NUMBER CONVERSION 1595 002436 1374 TAD (TAD CONVL1 /CONSTANTS FETCH 1596 002437 3253 DCA CONV4 1597 002440 7146 CMA CLL RTL /ACTUALLY YIELDS 4 DIGITS 1598 002441 3307 DCA CONVC1 /SAVE DIGIT COUNT 1599 002442 5635 JMP I CONVS1 1600 1601 002443 0000 CONVS2, .-. /CRANK OUT DIGITS IN A SNEAKY WAY 1602 002444 5645 JMP I CONVS3 /WHOOPS!! 1603 002445 2450 CONVS3, CONV1+1 /INITIAL VALUE 1604 002446 5643 JMP I CONVS2 1605 1606 002447 4245 CONV1, JMS CONVS3 /RETURN LAST VALUE, WAIT FOR 1607 /NEXT CALL 1608 002450 3305 DCA CONVT1 /SAVE INCOMING # 1609 002451 3310 CONV2, DCA CONVC2 /0 DIGIT 1610 002452 7100 CONV3, CLL /FOR CHECK 1611 002453 0000 CONV4, ZZZ /FILLED BY CONVS1 1612 002454 1305 TAD CONVT1 /ADD DATA TO CONSTANT FROM LIST 1613 002455 7420 SNL /O'FLOW? 1614 002456 5262 JMP CONV5 /YES. FAR ENOUGH 1615 002457 3305 DCA CONVT1 /NO. SAVE DATA 1616 002460 2310 ISZ CONVC2 /ADD TO DIGIT COUNT 1617 002461 5252 JMP CONV3 /CONTINUE 1618 1619 002462 7200 CONV5, CLA /DON'T NEED THIS GARBAGE 1620 002463 2253 ISZ CONV4 /POINT TO NEXT CONSTANT 1621 002464 1310 TAD CONVC2 /GET DIGIT 1622 002465 1306 TAD CONVI1 /AND ZERO SUPPRESSION INDICATOR 1623 002466 7450 SNA /RETURN THIS DIGIT? 1624 002467 5275 JMP CONV6 /NO 1625 002470 1373 TAD ("0 /YES. FORM NUMERAL 1626 002471 0167 AND [377 /REMOVE ZERO SUPPRESS BIT, IF ANY 1627 002472 4245 JMS CONVS3 /CALL SUBR. TO GET OUT 1628 002473 7130 STL RAR 1629 002474 3306 DCA CONVI1 /SET INDICATOR: PRINT ALL DIGITS 1630 002475 2307 CONV6, ISZ CONVC1 /DONE FIRST 3 DIGITS? 1631 002476 5251 JMP CONV2 /NO 1632 002477 1305 TAD CONVT1 /YES. ALWAYS RETURN LAST DIGIT 1633 002500 1373 TAD ("0 1634 002501 4245 JMS CONVS3 /GET RID OF LAST 1635 002502 2243 ISZ CONVS2 /SKIP OVER TWO WORDS 1636 002503 2243 ISZ CONVS2 /THAT FOLLOW CALL 1637 002504 5247 JMP CONV1 /GET OUT THIS WAY 1638 1639 002505 0000 CONVT1, 0 1640 002506 0000 CONVI1, 0 /0 ZERO SUPPRESS; 4000 - RETURN ALL CHARS 1641 002507 0000 CONVC1, 0 /ITERATION COUNTER 1642 002510 0000 CONVC2, 0 /DIGIT VALUE COUNTER 1643 002511 6030 CONVL1, -1750;-144;-12;-1000;-100;-10 002512 7634 002513 7766 002514 7000 002515 7700 002516 7770 1644 1645 002517 0000 DECOUT, .-. /PUSH DECIMAL THROUGH ARGUMENT 1646 /SUBROUTINE 1647 002520 3305 DCA CONVT1 /SAVE AC 1648 002521 1717 TAD I DECOUT /SUBR. ADDRESS 1649 002522 2317 ISZ DECOUT 1650 002523 3335 DCA DECOP1 1651 002524 1717 TAD I DECOUT 1652 002525 2317 ISZ DECOUT 1653 002526 3306 DCA CONVI1 /LEADING 0 SUPPRESSION 1654 002527 4235 JMS CONVS1 /SET UP 1655 002530 1305 TAD CONVT1 1656 002531 4243 JMS CONVS2 /LET'S HAVE THE DIGITS 1657 002532 4735 JMS I DECOP1 /PUSH DIGITS THROUGH SUBROUTINE 1658 002533 5331 JMP .-2 1659 002534 5717 JMP I DECOUT 1660 1661 002535 0000 DECOP1, 0 /POINTER TO DIGIT SINK 1662 1663 1664 002536 0000 ERRLST, .-. /PRODUCE TRACE BACK ERROR LISTING, 1665 /GIVING PAGE AND LINES ON PAGE OF 1666 /ERROR 1667 002537 7650 SNA CLA /COMING FROM ERRS1: 1 MEANS CALL 1668 /FROM 'ERROR', SKIP CRLF 1669 002540 4772 JMS CRLF 1670 002541 1053 TAD PAGES 1671 002542 4771 JMS ERRLS1 /PRINT PAGES# 1672 002543 0243 "# 1673 002544 1047 TAD PUSHST /START OF PUSH DOWN LIST 1674 002545 3366 ERRL1, DCA ERRLP1 /SAVE 1675 002546 1366 TAD ERRLP1 1676 002547 7161 CIA STL 1677 002550 1046 TAD PUSHP 1678 002551 7620 SNL CLA /IS PD LIST THIS FAR DOWN? 1679 002552 5363 JMP ERRL3 /NO. GET LAST ACTIVE LINE 1680 002553 6211 ERRL2, CDF 10 /8K:10; 12K:10; >12K:20; YES 1681 002554 1766 TAD I ERRLP1 /FIRST ENTRY AT EACH PD LEVEL 1682 /IS 'LINES' 1683 002555 6201 CDF 0 1684 002556 4771 JMS ERRLS1 /PRINT SAVED 'LINES' 1685 002557 0256 ". 1686 002560 1366 TAD ERRLP1 1687 002561 1370 TAD (-PDLEN /INCREMENT POINTER BY LENGTH OF 1688 /STACK GROUP 1689 002562 5345 JMP ERRL1 1690 1691 002563 1054 ERRL3, TAD LINES /FOR FINAL PRINT-OUT 1692 002564 4771 JMS ERRLS1 /PRINT 1693 002565 5736 JMP I ERRLST 1694 1695 002566 0000 ERRLP1, 0 1696 1697 /PB 1698 /PB 1699 1700 002570 7743 PAGE 002571 4145 002572 4133 002573 0260 002574 1311 002575 0003 002576 2206 002577 0725 1701 1702 /!!!!NOTE: DO NOT MOVE RCSET FROM TOP OF THIS PAGE... 1703 / THAT NAME IS USED TO DETERMINE SWAPPING LOC. 1704 / FOR LIBRARY 1705 1706 002600 4225 RCSET, JMS CSETS1 /DO COMMON GOODIES 1707 002601 3430 DCA I MATCP1 /THIS CLEARS '=' IN INPUT LINE. IF 1708 /ONLY CR FOLLOWS '=', THE CSET SYM. 1709 /IS NULL, AND THIS INSURES THAT 1710 /SUCH IS THE CASE 1711 002602 1035 TAD LINCNT 1712 002603 7040 CMA 1713 002604 1036 TAD LINBUF 1714 002605 3030 DCA MATCP1 /POINT AT CHAR BEFORE CR 1715 002606 5211 JMP CSET1 /HOP IN FOR COMMON STUFF 1716 1717 002607 4225 LCSET, JMS CSETS1 /GET SYMBOL, ETC. 1718 002610 2030 ISZ MATCP1 /POINT AT CHAR AFTER '=' 1719 002611 1430 CSET1, TAD I MATCP1 /GET CHAR 1720 002612 1163 TAD [-215 /POINTING AT LAST CHAR? 1721 002613 7440 SZA 1722 002614 1377 TAD (215 /NO. RESTORE CHAR 1723 002615 3426 DCA I TBLWD2 /YES. SAVE 0 OR CHAR 1724 002616 5553 JMP I [INLUP /ONWARD!! 1725 1726 002617 0000 GETPNM, .-. /COLLECT PATTERN FIELD VIA GATHER 1727 002620 1031 TAD MATFLD /SAVED POINTER FROM MATCH 1728 002621 3022 DCA SCANP2 /SAVE FOR COLLECTION 1729 002622 4545 JMS I [GATHER /GET THE NAME 1730 002623 4562 JMS I [IERROR /UH, OH!!!!! 1731 002624 5617 JMP I GETPNM /DONE 1732 1733 002625 0000 CSETS1, .-. /COMMON SUBROUTINE FOR LCS, RCS 1734 002626 1030 TAD MATCP1 1735 002627 3022 DCA SCANP2 /GET POINTER TO = IN INPUT LINE 1736 002630 4130 JMS XPND /EXPAND FROM THERE 1737 /THIS MUST PRECEDE LOOKUP, BECAUSE 1738 /TBLWD2 GETS CHANGED IN XPND 1739 002631 4542 JMS I [GETPNM /GET PARAM. NAME 1740 002632 4544 JMS I [LOOKUP /LOOK FOR SET OR CSET, CREATE 1741 002633 6040 6040 1742 002634 5240 JMP CSTS2 /WRONG TYPE FOUND 1743 002635 7132 CSTS1, STL RTR /2000 1744 002636 3425 DCA I TBLWD1 /SET CSET TYPE SYMBOL 1745 002637 5625 JMP I CSETS1 /RETURN 1746 1747 002640 1425 CSTS2, TAD I TBLWD1 /GET TYPE WORD 1748 002641 0146 AND [1000 /CHECK FOR SSET 1749 002642 7650 SNA CLA /ANYTHING ELSE IS AN ERROR 1750 002643 4555 JMS I [EERROR /NOT SSET 1751 002644 1426 TAD I TBLWD2 /WAS SSET 1752 002645 4776 JMS LNKDEL /DELETE ITS LINK 1753 002646 5235 JMP CSTS1 /AND MAKE SYMBOL CSET 1754 1755 1756 002647 7001 LDLTE, IAC 1757 002650 3336 RDLTE, DCA LDLTI1 /SET INDICATOR 1758 002651 4542 JMS I [GETPNM /GET PATTERN FIELD 1759 002652 4544 JMS I [LOOKUP 1760 002653 1000 1000 /SSET ONLY 1761 002654 4555 JMS I [EERROR /NAME MISSING 1762 002655 1036 TAD LINBUF 1763 002656 3012 DCA XR12 /STORE CHARS IN LINBUF 1764 002657 1426 TAD I TBLWD2 /LINK # 1765 002660 4775 JMS LNKGET /GET APPROPRIATE LINK 1766 002661 0000 LDLTC1, ZZZ /COUNT GOES HERE 1767 002662 3334 DCA LDLTP1 /SAVE POINTER 1768 002663 3335 DCA LDLTP1+1 /AND BYTE 1769 002664 1261 TAD LDLTC1 1770 002665 7640 SZA CLA /NULL LINK? 1771 002666 5271 JMP LDLT1 /NO 1772 002667 4543 JMS I [WERROR /YES. GIVE WARNING 1773 002670 5553 JMP I [INLUP /PROCEED 1774 1775 002671 4573 LDLT1, JMS I [GETCHR /GET CHAR 1776 002672 2734 LDLTP1 1777 002673 4065 SFLD 1778 002674 3412 DCA I XR12 /SAVE 1779 002675 2261 ISZ LDLTC1 /ALL CHARS? 1780 002676 5271 JMP LDLT1 /NO 1781 002677 1426 TAD I TBLWD2 /YES 1782 002700 4776 JMS LNKDEL /DELETE USED LINK 1783 002701 4774 JMS LNKCRT /CREATE NEW ONE 1784 002702 0000 LDLT2, ZZZ /POINTER HERE 1785 002703 3426 DCA I TBLWD2 /SAVE NEW LINK NUMBER 1786 002704 1302 TAD LDLT2 1787 002705 3334 DCA LDLTP1 /SAVE POINTER 1788 002706 3335 DCA LDLTP1+1 /AND BYTE 1789 002707 3332 DCA LDLT5 /INITIALIZE COUNT 1790 002710 1012 TAD XR12 1791 002711 7041 CIA 1792 002712 1036 TAD LINBUF 1793 002713 7001 IAC /ONE LESS CHAR TO MOVE 1794 002714 7450 SNA 1795 002715 5331 JMP LDLT4 /IF NOW NULL 1796 002716 3261 DCA LDLTC1 1797 002717 1036 TAD LINBUF 1798 002720 1336 TAD LDLTI1 /0 FOR RDEL, 1 FOR LDEL 1799 002721 3012 DCA XR12 /SAVE POINTER 1800 002722 1412 LDLT3, TAD I XR12 1801 002723 4566 JMS I [PUTCHR 1802 002724 2734 LDLTP1 1803 002725 4065 SFLD 1804 002726 2332 ISZ LDLT5 1805 002727 2261 ISZ LDLTC1 1806 002730 5322 JMP LDLT3 1807 002731 4773 LDLT4, JMS LNKCHK /CHECK NEW LINK 1808 002732 0000 LDLT5, ZZZ /COUNT 1809 002733 5553 JMP I [INLUP 1810 1811 002734 0000 LDLTP1, 0;0 002735 0000 1812 002736 0000 LDLTI1, 0 1813 1814 002737 0000 MQLMUY, .-. /EAE MULTIPLY SIMULATOR 1815 002740 3032 DCA MQ /PERFORM MQL 1816 002741 3033 DCA AC 1817 002742 1372 TAD (-15 1818 002743 3034 DCA EAESC 1819 002744 5354 JMP MUY2 1820 1821 002745 7620 MUY1, SNL CLA 1822 002746 5351 JMP .+3 1823 002747 7100 CLL 1824 002750 1737 TAD I MQLMUY 1825 002751 1033 TAD AC 1826 002752 7010 RAR 1827 002753 3033 DCA AC 1828 002754 1032 MUY2, TAD MQ 1829 002755 7010 RAR 1830 002756 3032 DCA MQ 1831 002757 2034 ISZ EAESC 1832 002760 5345 JMP MUY1 1833 002761 1033 TAD AC 1834 002762 2337 ISZ MQLMUY /RETURN, SKIPPING MULTIPLIER 1835 002763 5737 JMP I MQLMUY 1836 1837 1838 002764 0000 POPA, .-. /POP ONE WORD FROM PUSH-DOWN 1839 002765 2046 ISZ PUSHP 1840 002766 6211 CDF 10 /8K:10; 12K:10; >12K:20 1841 002767 1446 TAD I PUSHP /PICK UP WORD 1842 002770 6201 CDF 0 1843 002771 5764 JMP I POPA /RETURN 1844 1845 /PB 1846 /PB 1847 1848 002772 7763 PAGE 002773 1000 002774 1116 002775 0725 002776 1022 002777 0215 1849 1850 003000 4130 SSET, JMS XPND /FROM =. POINTERS SET BY MATCH 1851 003001 4542 JMS I [GETPNM /GET PATTERN FIELD 1852 003002 4544 JMS I [LOOKUP 1853 003003 1040 1040 /SSET. (CREATE) 1854 003004 5237 JMP SSET5 /NOT SSET 1855 003005 1426 TAD I TBLWD2 1856 003006 4777 JMS LNKDEL /DELETE OLD LINK, IF ANY 1857 003007 1146 SSET1, TAD [1000 1858 003010 3425 DCA I TBLWD1 /SET SYMBOL TYPE 1859 003011 4776 JMS LNKCRT 1860 003012 0000 SSETT1, ZZZ /CREATE LINK (THIS IS POINTER) 1861 003013 3426 DCA I TBLWD2 /SAVE NEW LINK NUMBER 1862 003014 1212 TAD SSETT1 1863 003015 3244 DCA SSETP1 /SAVE POINTER 1864 003016 3245 DCA SSETP1+1 /CLEAR BYTE 1865 003017 3235 DCA SSETC1 /AND COUNTER 1866 003020 1030 TAD MATCP1 /END OF PATTERN 1867 003021 3010 DCA XR10 1868 003022 1410 SSET2, TAD I XR10 /GET CHAR 1869 003023 1163 TAD [-215 /END OF LINE? 1870 003024 7450 SNA 1871 003025 5234 JMP SSET4 /YES 1872 003026 1375 TAD (215 /RESTORE CHAR 1873 003027 4566 JMS I [PUTCHR /STORE CHAR 1874 003030 3044 SSETP1 1875 003031 4065 SFLD 1876 003032 2235 ISZ SSETC1 /INDICATE CHAR 1877 003033 5222 JMP SSET2 /(NOT A COUNT LOOP) 1878 1879 003034 4774 SSET4, JMS LNKCHK /CHECK FOR O'FLOW 1880 003035 0000 SSETC1, ZZZ 1881 003036 5553 JMP I [INLUP /ALLES IST IN ORDNUNG 1882 1883 003037 1425 SSET5, TAD I TBLWD1 /WRONG TYPE DETECTED 1884 003040 0373 AND (6000 /CHECK FOR SET OR CSET 1885 003041 7640 SZA CLA /ONE OF THOSE? 1886 003042 5207 JMP SSET1 /YES. OKAY 1887 003043 4555 JMS I [EERROR /NO. WRONG SYMBOL TYPE 1888 1889 003044 0000 SSETP1, 0;0 003045 0000 1890 1891 1892 /MACRO DEFINITION BEGINS HERE: 1893 /PHASE 1 - PUT MACRO NAME IN TABLE, GET ARGUMENT 1894 / NAMES 1895 /PHASE 2 - ENTER MACRO BODY INTO SFLD STORAGE 1896 1897 1898 003046 7001 MCDF1, IAC 1899 003047 3772 MCDF2, DCA MCDFI1 /SET INDICATOR 1900 003050 4542 JMS I [GETPNM /GET PATTERN FIELD (MACRO NAME) 1901 003051 4544 JMS I [LOOKUP /LOOKUP NAME 1902 003052 0440 440 /MACRO (CREATE) 1903 003053 4555 JMS I [EERROR /SYMBOL USED AS DIFFERENT TYPE 1904 003054 1141 MCDF3, TAD [400 /FOR MACRO 1905 003055 3425 DCA I TBLWD1 1906 003056 1426 TAD I TBLWD2 /0 IF NEW NAME 1907 003057 4777 JMS LNKDEL /GET RID OF LINK 1908 003060 3426 DCA I TBLWD2 /PRECLUDE USE, IN CASE OF ERROR: 1909 /MACX WILL CHOKE ON 0 LINK # 1910 003061 1371 TAD (MCDFL1-1 1911 003062 3011 DCA XR11 /LIST TO STORE ARGUMENTS 1912 003063 4770 JMS TBLSUB /STORE GATHBF IN TBL (I.E., 1913 /MACRO NAME) 1914 003064 1772 TAD MCDFI1 1915 003065 7640 SZA CLA /LABEL PRESENT? 1916 003066 5275 JMP MCDF4 /NO 1917 003067 1036 TAD LINBUF /YES 1918 003070 3022 DCA SCANP2 1919 003071 4545 JMS I [GATHER 1920 003072 4562 JMS I [IERROR /INTERNAL 1921 003073 4770 JMS TBLSUB /STORE IN TABLE 1922 003074 1367 TAD (3 /TO FIX COUNT 1923 003075 1366 MCDF4, TAD (-MCARG^3 /THREE SPACES PER ARG 1924 003076 3765 DCA MCDFC1 1925 003077 3411 DCA I XR11 /0 TABLE 1926 003100 2765 ISZ MCDFC1 1927 003101 5277 JMP .-2 1928 003102 7001 IAC 1929 003103 1030 TAD MATCP1 1930 003104 3022 DCA SCANP2 /POINT TO CHAR AFTER NAME 1931 003105 1364 TAD (2^3+MCDFL1-1 /POINT TO ENTRY AFTER LABEL 1932 003106 3011 DCA XR11 1933 003107 1422 TAD I SCANP2 1934 003110 1363 TAD (-": /ANY ARGS? 1935 003111 7640 SZA CLA 1936 003112 5762 JMP MCDF6 /NO 1937 003113 4545 MCDF5, JMS I [GATHER /YES 1938 003114 4555 JMS I [EERROR /SYNTAX ERROR. NO FIELD 1939 003115 1425 TAD I TBLWD1 /GET TYPE WORD WITH # OF ARGS 1940 003116 1361 TAD (-400-MCARG+1 /GET RID OF 400 BIT, 1941 /1 LESS FOR UNCOUNTED LABEL 1942 003117 7700 SMA CLA /TOO MANY ARGS? 1943 003120 4555 JMS I [EERROR /YES 1944 003121 4770 JMS TBLSUB /NO. PUT IN TABLE 1945 003122 2425 ISZ I TBLWD1 /MARK OFF ONE MORE ARG. 1946 003123 7040 CMA 1947 003124 1024 TAD SEPCOD 1948 003125 7740 SMA SZA CLA /SEP A CR OR SPC? 1949 003126 5313 JMP MCDF5 /NO. LOOPTY-LOOP 1950 003127 5760 JMP MCDF7 /YES, AT LAST! ENTER PHASE TWO 1951 1952 1953 1954 1955 1956 003130 4757 CSX, JMS EVAL /CHARACTER SET TO EXPRESSION 1957 003131 3347 DCA CSXT1 /EVALUATE AND SAVE FROM = 1958 003132 4756 JMS CSETS1 /DO NAME LOOKUP, ETC FOR CSET, 1959 /PERFORM SUPERFLUOUS XPND 1960 003133 1347 TAD CSXT1 /CHECK VALUE 1961 003134 7450 SNA /NULL CHAR? 1962 003135 5343 JMP CSX1 /YES. OK 1963 003136 1355 TAD (-" /CHECK SPACE AT LOW END 1964 003137 0165 AND [7700 /LEGAL SIX-BIT CHAR? 1965 003140 7640 SZA CLA 1966 003141 5345 JMP CSX2 /NO 1967 003142 1347 TAD CSXT1 /YES 1968 003143 3426 CSX1, DCA I TBLWD2 /STORE CHAR VALUE 1969 003144 5553 JMP I [INLUP /AND PROCEED 1970 1971 003145 4543 CSX2, JMS I [WERROR /ILLEGAL CODE WARNING 1972 003146 5343 JMP CSX1 /SET TO NULL 1973 1974 003147 0000 CSXT1, 0 1975 1976 1977 003150 0000 WERROR, .-. /WARNING ERROR 1978 003151 4551 JMS I [ERROR 1979 003152 0327 "W 1980 003153 5750 JMP I WERROR /RETURN TO CALLER 1981 1982 /PB 1983 /PB 1984 1985 003155 7540 PAGE 003156 2625 003157 4400 003160 3204 003161 7362 003162 3200 003163 7506 003164 6057 003165 3274 003166 7723 003167 0003 003170 1514 003171 6051 003172 3205 003173 6000 003174 1000 003175 0215 003176 1116 003177 1022 1986 1987 003200 7040 MCDF6, CMA /NO ARGS. CHECK SEPARATOR 1988 003201 1024 TAD SEPCOD 1989 003202 7740 SMA SZA CLA /CR OR SPC? 1990 003203 4543 JMS I [WERROR /NO. NAUGHTY! 1991 003204 4777 MCDF7, JMS LNKCRT /SECOND PHASE MACRO DEFINE 1992 MCDFI1=. /TIGHT ON SPACE 1993 003205 0000 MCDF8, ZZZ /POINTER HERE 1994 003206 3426 DCA I TBLWD2 /SAVE LINK # 1995 003207 1205 TAD MCDF8 1996 003210 3323 DCA MCDFP1 /SAVE POINTER 1997 003211 3324 DCA MCDFP1+1 /INITIALIZE BYTE 1998 003212 3274 DCA MCDFC1 /AND CHAR COUNT 1999 003213 4776 MCDF9, JMS GETLIN /GET NEXT LINE 2000 003214 7040 CMA /SET FIRST SCAN SWITCH 2001 003215 3205 MCDF10, DCA MCDFI1 /SET INDICATOR 2002 003216 4545 JMS I [GATHER 2003 003217 5257 JMP MCDF13 /NO FIELD 2004 003220 1205 TAD MCDFI1 2005 003221 7640 SZA CLA /FIRST SCAN? 2006 003222 7346 CLA CMA CLL RTL /YES 2007 003223 1375 TAD (MCDFL1-1+3 /POINT TO SECOND TABLE ENTRY 2008 003224 3011 DCA XR11 2009 003225 1374 TAD (-MCARG 2010 003226 1205 TAD MCDFI1 2011 003227 3325 DCA MCDFC2 /SET COUNT 2012 003230 3326 DCA MCDFC3 /ARG # 2013 003231 1411 MCDF11, TAD I XR11 /GET FIRST WORD 2014 003232 7450 SNA /ARG EXIST? 2015 003233 5276 JMP MCDF15 /NO 2016 003234 1016 TAD GATHBF /YES 2017 003235 7640 SZA CLA /COMPARE 2018 003236 5276 JMP MCDF15 /NO 2019 003237 1411 TAD I XR11 2020 003240 1017 TAD GATHBF+1 2021 003241 7640 SZA CLA 2022 003242 5277 JMP MCDF16 2023 003243 1411 TAD I XR11 2024 003244 1020 TAD GATHBF+2 2025 003245 7640 SZA CLA 2026 003246 5300 JMP MCDF17 2027 003247 1326 TAD MCDFC3 /ARG NUMBER 2028 003250 2205 ISZ MCDFI1 /FIRST SCAN? 2029 003251 5255 JMP MCDF12 /NO 2030 003252 7450 SNA /YES. ZERO ARG? 2031 003253 5266 JMP MCDF14 /YES. CHECK END OF DEFINITION 2032 003254 7410 SKP 2033 003255 7001 MCDF12, IAC /CORRECT ARG # 2034 003256 4315 JMS MCDFS1 /OUTPUT AS 8 BIT CHAR 2035 003257 1422 MCDF13, TAD I SCANP2 /GET SEPARATOR 2036 003260 4315 JMS MCDFS1 /OUTPUT 2037 003261 7040 CMA 2038 003262 1024 TAD SEPCOD 2039 003263 7640 SZA CLA /CR = 1; REACH END OF LINE? 2040 003264 5215 JMP MCDF10 /NO 2041 003265 5213 JMP MCDF9 /YES 2042 2043 003266 1422 MCDF14, TAD I SCANP2 /FIELD SAME AS MACRO NAME 2044 003267 1154 TAD [-MPCHR /SEPARATOR MPCHR? 2045 003270 7640 SZA CLA 2046 003271 5300 JMP MCDF17 /NO 2047 003272 4315 JMS MCDFS1 /YES. CLOSE UP. 0 CHAR ENDS 2048 003273 4773 JMS LNKCHK /CHECK DEFINITION LINK 2049 003274 0000 MCDFC1, ZZZ /COUNT OF CHARS 2050 003275 5553 JMP I [INLUP /BACK TO THE USUAL 2051 2052 003276 2011 MCDF15, ISZ XR11 2053 003277 2011 MCDF16, ISZ XR11 2054 003300 2326 MCDF17, ISZ MCDFC3 /ARG NUMBER 2055 003301 2325 ISZ MCDFC2 2056 003302 5231 JMP MCDF11 /MORE TO CHECK 2057 003303 1022 TAD SCANP2 /DIDN'T FIND AS ARG 2058 003304 7041 CIA 2059 003305 1023 TAD SCANP3 2060 003306 3325 DCA MCDFC2 /CHARS TO MOVE 2061 003307 1423 MCDF18, TAD I SCANP3 2062 003310 2023 ISZ SCANP3 2063 003311 4315 JMS MCDFS1 /MOVE TO LINK 2064 003312 2325 ISZ MCDFC2 2065 003313 5307 JMP MCDF18 /MORE 2066 003314 5257 JMP MCDF13 /CHECK SEPARATOR 2067 2068 2069 003315 0000 MCDFS1, .-. /MOVE ONE CHAR TO LINK, COUNT 2070 003316 4566 JMS I [PUTCHR 2071 003317 3323 MCDFP1 2072 003320 4065 SFLD 2073 003321 2274 ISZ MCDFC1 /INCLUDE IN COUNT 2074 003322 5715 JMP I MCDFS1 2075 2076 003323 0000 MCDFP1, 0;0 /POINTER (& BYTE) TO MACRO DEF. 003324 0000 2077 003325 0000 MCDFC2, 0 2078 003326 0000 MCDFC3, 0 2079 2080 003327 0000 LNKSKP, .-. /SKIP TO PROPER PLACE IN LINK 2081 /LINK # IN AC; PTR IN ARG 1 2082 /CHAR # IN ARG 2 2083 003330 3343 DCA LNKST1 /SAVE LINK # 2084 003331 1727 TAD I LNKSKP /GET PTR 2085 003332 2327 ISZ LNKSKP 2086 003333 7001 IAC /POINT AT BYTE 2087 003334 3350 DCA LNKS1 2088 003335 3750 DCA I LNKS1 /ZERO BYTE 2089 003336 7040 CMA 2090 003337 1350 TAD LNKS1 2091 003340 3350 DCA LNKS1 /RESET TO POINT AT PTR 2092 003341 1343 TAD LNKST1 /GET LINK # 2093 003342 4772 JMS LNKGET /GET THE LINK 2094 003343 0000 LNKST1, ZZZ /LENGTH GOES HERE (DISCARD) 2095 003344 3750 DCA I LNKS1 /SAVE PTR TO LINK 2096 003345 1727 TAD I LNKSKP /FETCH CHAR # 2097 003346 2327 ISZ LNKSKP 2098 003347 4771 JMS MCXSKP /SET UP CORRECTED PTRS VIA MCXSKP 2099 003350 0000 LNKS1, ZZZ /GETS PTR TO LINK 2100 003351 5727 JMP I LNKSKP /RETURN 2101 2102 2103 2104 003352 1036 MPEXPD, TAD LINBUF /COME HERE TO... 2105 003353 3022 DCA SCANP2 /EXPAND WHOLE LINE 2106 003354 4130 JMS XPND 2107 003355 5770 JMP INLUP2 /THEN OUTPUT AS IS 2108 2109 003356 0000 MQA, .-. /SIMULATED MQA 2110 003357 3033 DCA AC 2111 003360 1032 TAD MQ /BEGIN 'OR' OF AC, MQ 2112 003361 7040 CMA 2113 003362 0033 AND AC 2114 003363 1032 TAD MQ 2115 003364 5756 JMP I MQA 2116 2117 /PB 2118 /PB 2119 2120 003370 1613 PAGE 003371 3516 003372 0725 003373 1000 003374 7761 003375 6054 003376 0600 003377 1116 2121 2122 / RECURSIVE MACRO EXPANDER 2123 2124 003400 7040 MACX0, CMA 2125 003401 1030 TAD MATCP1 /COMING FROM 'IF'. BACK UP 2126 003402 3030 DCA MATCP1 /MATCP1 TO POINT AT ':' 2127 003403 7144 CMA CLL RAL /-2. BACK UP MATFLD: 2128 /'IF' PROCESSOR JUMPS HERE ON 2129 /UNRECOGNIZED IF=IFXX. MATFLD 2130 /POINTS AT XX. WE WANT TO POINT 2131 /AT IFXX AS MACRO NAME 2132 MACX1, 2133 003404 4542 MACX2, JMS I [GETPNM /BOTH ENTER THIS WAY. LABEL IS 2134 /ALWAYS PICKED UP OR CREATED 2135 /(BELOW) 2136 003405 4544 JMS I [LOOKUP 2137 003406 0400 400 /LOOK UP MACRO 2138 003407 4070 JMS SWOUT /NOT FOUND. CHECK FOR LIBRARY 2139 003410 4777 JMS PUSH /PUSH ALL THE OLD GOODIES 2140 003411 5477 MACXL2 /ACCORDING TO THIS LIST 2141 003412 2050 ISZ MACON /SET MACRO ON 2142 003413 4776 JMS LNKCRT /LINK FOR ARG. STRING 2143 003414 0000 ZZZ /POINTER HERE 2144 003415 3037 DCA MCXALK /ARG. LINK # 2145 003416 1214 TAD .-2 2146 003417 3307 DCA MACXP1 2147 003420 3310 DCA MACXP1+1 /PUTCHR POINTERS 2148 003421 3264 DCA MACXC2 /CHAR LENGTH OF ARG. LINK 2149 003422 1375 TAD (MACXL1-1 2150 003423 3013 DCA XR13 /POINT TO FIRST ARG. 2151 /ARG 1 ALWAYS AT CHAR 0 2152 003424 3413 DCA I XR13 /ZERO CHAR # 2153 003425 1036 TAD LINBUF 2154 003426 3022 DCA SCANP2 2155 003427 4545 JMS I [GATHER /FIND OUT IF LABEL EXISTS 2156 003430 5243 JMP MACX3 /NO. CREATE ONE 2157 003431 1022 TAD SCANP2 2158 003432 7041 CIA 2159 003433 1023 TAD SCANP3 /LENGTH 2160 003434 3311 DCA MACXC1 /SAVE # OF CHARS 2161 003435 1423 TAD I SCANP3 2162 003436 2023 ISZ SCANP3 2163 003437 4774 JMS MACXS1 /SAVE CHARS IN ARG. LINK 2164 003440 2311 ISZ MACXC1 /DONE? 2165 003441 5235 JMP .-4 /NO 2166 003442 7410 SKP /YES 2167 003443 4773 MACX3, JMS MCCRSM /CREATE SYMBOL 2168 003444 2030 ISZ MATCP1 /POINT TO SEP. AFTER NAME 2169 003445 1430 TAD I MATCP1 /GET CHAR 2170 003446 4557 JMS I [CCHECK 2171 003447 4562 JMS I [IERROR /INTERNAL 2172 003450 4772 JMS TRNSFR /BRANCH ON SEP. 2173 003451 5302 JMP MACX4 /ILLEGAL SEP. 2174 003452 6400 6400 /SP CR : 2175 003453 7000 NOP 2176 003454 7000 NOP 2177 003455 2030 ISZ MATCP1 /POINT TO NEXT CHAR 2178 003456 1425 TAD I TBLWD1 2179 003457 0371 AND (37 /NUMBER OF ARGS 2180 003460 3262 DCA .+2 2181 003461 4770 JMS GETARG /GET ALL THE ARGUMENTS STORED 2182 003462 0000 ZZZ /INDICATOR 2183 003463 4767 JMS LNKCHK /CHECK THE NEW LINK 2184 003464 0000 MACXC2, ZZZ /NUMBER OF CHARS USED (FROM MACXS2) 2185 003465 1426 TAD I TBLWD2 /GET BODY LINK NUMBER 2186 003466 7450 SNA /ILL-DEFINED MACRO? 2187 003467 5302 JMP MACX4 /YES 2188 003470 4766 JMS LNKGET 2189 003471 0000 ZZZ /COUNT (IGNORED) 2190 003472 3312 DCA MACIP1 /POINTER TO BODY 2191 003473 3313 DCA MACIP1+1 2192 003474 1426 TAD I TBLWD2 2193 003475 3040 DCA MCXBLK /SAVE MACRO BODY LINK 2194 003476 3052 DCA DLTESW /DON'T CARE ABOUT PREVIOUS DELETIONS 2195 003477 1365 TAD (MACINP 2196 003500 3057 DCA INPUT /SET UP INPUT SOURCE 2197 003501 5553 JMP I [INLUP /PRETEND NOTHING HAPPENED 2198 2199 003502 1030 MACX4, TAD MATCP1 2200 003503 3022 DCA SCANP2 /FOR MESSAGE 2201 003504 4764 JMS POP /FOR INLUP CALL TO GETLIN 2202 003505 5517 MACXL3 2203 003506 4555 JMS I [EERROR 2204 2205 003507 0000 MACXP1, 0;0 /TEXT POINTERS 003510 0000 2206 003511 0000 MACXC1, 0 2207 003512 0000 MACIP1, 0;0 003513 0000 2208 003514 0000 MACIP3, 0;0 003515 0000 2209 2210 2211 / SOME AUXILIARY SUBROUTINES 2212 2213 003516 0000 MCXSKP, .-. /SKIP OVER CHARS IN LINK 2214 003517 4552 JMS I [MQLDVI 2215 003520 0003 3 /DIVIDE NUMBER OF CHARS BY 3 2216 003521 7112 CLL RTR /TAKE REMAINDER (0-2) 2217 003522 7010 RAR 2218 003523 3343 DCA MCXSP1+1 /GIVES PROPER BYTE (LINK NOW 0) 2219 003524 1716 TAD I MCXSKP /POINTER TO POINTERS 2220 003525 2316 ISZ MCXSKP 2221 003526 3342 DCA MCXSP1 /SAVE 2222 003527 1343 TAD MCXSP1+1 2223 003530 7640 SZA CLA /BYTE 0? 2224 003531 7120 STL /NO. WILL ADD 1 TO POINTER 2225 003532 1032 TAD MQ 2226 003533 7004 RAL /GIVES OFFSET FROM VIRGIN POINTER 2227 003534 1742 TAD I MCXSP1 2228 003535 3742 DCA I MCXSP1 /SAVE CORRECTED POINTER 2229 003536 2342 ISZ MCXSP1 2230 003537 1343 TAD MCXSP1+1 /GET BYTE 2231 003540 3742 DCA I MCXSP1 2232 003541 5716 JMP I MCXSKP 2233 2234 003542 0000 MCXSP1, 0;0 003543 0000 2235 2236 003544 0000 EERROR, .-. /'E' TYPE ERROR 2237 003545 4551 JMS I [ERROR /CALL ERROR ROUTINE 2238 003546 0305 "E 2239 003547 5553 JMP I [INLUP /RETURN TO 'INLUP' ON EERROR 2240 2241 2242 / I HATED LIKE HECK TO PUT THIS HERE, BUT WHAT DO 2243 / YOU DO WHEN YOU HAVE GOOD AFTERTHOUGHTS?? 2244 2245 003550 0000 PAT19, ZBLOCK 2;CSX /CHARACTER SET TO EXPRESSION 003551 0000 003552 3130 2246 003553 0004 4;-"C;-"S;-"X;4;1;-"=;0 003554 7475 003555 7455 003556 7450 003557 0004 003560 0001 003561 7503 003562 0000 2247 /PB 2248 2249 003564 1256 PAGE 003565 4200 003566 0725 003567 1000 003570 3603 003571 0037 003572 1154 003573 1737 003574 3760 003575 6032 003576 1116 003577 1527 2250 2251 003600 7001 DEC, IAC 2252 003601 3051 OCT, DCA OCTDEC / SET OCTAL-DECIMAL SWITCH 2253 003602 5553 JMP I [INLUP /THAT'S ALL! 2254 2255 003603 0000 GETARG, .-. /GET ARGUMENTS FOR MACX, IRP 2256 003604 3357 DCA GETAI2 2257 003605 1603 TAD I GETARG /INDICATOR 2258 003606 7700 SMA CLA /FROM MACX? 2259 003607 5316 JMP GETA11 /YES. CLOSE LABEL ARG. 2260 2261 003610 3356 GETA2, DCA GETAI1 /CLEAR INDICATOR 2262 003611 1430 TAD I MATCP1 /GET CHAR 2263 003612 1377 TAD (-"< 2264 003613 7640 SZA CLA /START OF NEST? 2265 003614 5267 JMP GETA7 /NO 2266 003615 2356 ISZ GETAI1 /YES. SET LEVEL 2267 003616 2030 GETA3, ISZ MATCP1 2268 003617 1430 TAD I MATCP1 2269 003620 1377 TAD (-"< /NEXT LEVEL? 2270 003621 7440 SZA 2271 003622 5227 JMP GETA5 /NO 2272 003623 2356 ISZ GETAI1 /YES 2273 003624 1430 GETA4, TAD I MATCP1 2274 003625 4360 JMS MACXS1 /SAVE CHAR 2275 003626 5216 JMP GETA3 2276 2277 003627 1376 GETA5, TAD ("<-"> 2278 003630 7440 SZA /UP ONE LEVEL? 2279 003631 5253 JMP GETA6 /NO 2280 003632 7040 CMA /YES 2281 003633 1356 TAD GETAI1 2282 003634 3356 DCA GETAI1 2283 003635 1356 TAD GETAI1 /REACH SURFACE? 2284 003636 7640 SZA CLA 2285 003637 5224 JMP GETA4 /NO 2286 003640 2030 ISZ MATCP1 /NEXT CHAR 2287 003641 1430 TAD I MATCP1 2288 003642 3024 DCA SEPCOD /VALUE >2 IN CASE OF ALPHA 2289 003643 1024 TAD SEPCOD 2290 003644 4557 JMS I [CCHECK 2291 003645 5315 JMP GETA10 /ALPHA AFTER <> NEST 2292 003646 7144 CMA CLL RAL 2293 003647 1024 TAD SEPCOD 2294 003650 7700 SMA CLA /CR OR SP 2295 003651 2024 ISZ SEPCOD /NO. FORCE TO LOOK LIKE UNKNOWN 2296 003652 5315 JMP GETA10 2297 2298 003653 1375 GETA6, TAD (">-215 /CHECK FOR SLOPPY USER 2299 003654 7640 SZA CLA 2300 003655 5224 JMP GETA4 2301 003656 1603 GETA6A, TAD I GETARG 2302 003657 7710 SPA CLA /FOR MACX? 2303 003660 5263 JMP .+3 /NO 2304 003661 4774 JMS POP /YES. MUST POP HERE 2305 003662 5517 MACXL3 2306 003663 1030 TAD MATCP1 2307 003664 3022 DCA SCANP2 /FOR ERROR MESSAGE 2308 003665 4555 JMS I [EERROR /UNBALANCED <> NEST 2309 2310 003666 2030 GETA7Z, ISZ MATCP1 2311 003667 3356 GETA7, DCA GETAI1 /SET INDICATOR 2312 003670 1430 TAD I MATCP1 /GET CHAR 2313 003671 4557 JMS I [CCHECK 2314 003672 5352 JMP GETA14 /JUST STORE 2315 003673 7144 CMA CLL RAL 2316 003674 1024 TAD SEPCOD 2317 003675 7750 SPA SNA CLA /END OF ARG? 2318 003676 5307 JMP GETA8 /YES 2319 003677 1430 TAD I MATCP1 2320 003700 1377 TAD (-"< /< IS END ALSO 2321 003701 7450 SNA /FIND < ? 2322 003702 5307 JMP GETA8 /YES 2323 003703 1376 TAD ("<-"> /NO. HOW ABOUT EXTRA < ? 2324 003704 7640 SZA CLA 2325 003705 5352 JMP GETA14 /NO. INCLUDE IN ARGUMENT 2326 003706 5256 JMP GETA6A /YES. ERROR 2327 2328 003707 1356 GETA8, TAD GETAI1 2329 003710 7640 SZA CLA /NULL ARG? 2330 003711 5315 JMP GETA10 /NO 2331 003712 1603 TAD I GETARG /YES 2332 003713 7700 SMA CLA /CREATE SYMBOL? 2333 003714 4773 GETA9, JMS MCCRSM /YES 2334 003715 2357 GETA10, ISZ GETAI2 /CHALK UP ANOTHER ARG. 2335 003716 4360 GETA11, JMS MACXS1 /MARK END 2336 003717 1603 TAD I GETARG 2337 003720 7710 SPA CLA /FOR MACX? 2338 003721 5324 JMP GETA12 /NO 2339 003722 1772 TAD MACXC2 2340 003723 3413 DCA I XR13 /YES. SAVE ARG CHAR NUMBER 2341 003724 7144 GETA12, CMA CLL RAL 2342 003725 1024 TAD SEPCOD 2343 003726 7450 SNA /, ? 2344 003727 5266 JMP GETA7Z /YES 2345 003730 7700 SMA CLA /CR SP? 2346 003731 5210 JMP GETA2 /NO 2347 003732 1603 TAD I GETARG /INDICATOR AGAIN 2348 003733 7700 SMA CLA /FOR MACX? 2349 003734 5337 JMP GETA13 /YES 2350 003735 1357 TAD GETAI2 /GET NUMBER OF ARGS 2351 003736 5603 JMP I GETARG /RETURN IT 2352 2353 003737 1603 GETA13, TAD I GETARG 2354 003740 7041 CIA /- # OF LEGAL ARGS 2355 003741 1357 TAD GETAI2 2356 003742 7450 SNA /RIGHT NUMBER? 2357 003743 5603 JMP I GETARG /YES 2358 003744 7710 SPA CLA /NO 2359 003745 5314 JMP GETA9 /TOO FEW. CREATE SOME 2360 003746 1030 TAD MATCP1 2361 003747 3022 DCA SCANP2 /FOR ERROR 2362 003750 4543 JMS I [WERROR /WARNING. TOO MANY ARGS 2363 003751 5603 JMP I GETARG 2364 2365 003752 1430 GETA14, TAD I MATCP1 2366 003753 4360 JMS MACXS1 2367 003754 7001 IAC 2368 003755 5266 JMP GETA7Z 2369 2370 003756 0000 GETAI1, 0 2371 003757 0000 GETAI2, 0 2372 2373 003760 0000 MACXS1, .-. /MOVE CHAR TO ARG. LINK 2374 003761 4566 JMS I [PUTCHR 2375 003762 3507 MACXP1 2376 003763 4065 SFLD 2377 003764 2772 ISZ MACXC2 2378 003765 5760 JMP I MACXS1 2379 2380 /PB 2381 /PB 2382 2383 003772 3464 PAGE 003773 1737 003774 1256 003775 0061 003776 7776 003777 7504 2384 2385 2386 / IRP PROCESSOR 2387 / HAS PRIVILEGED ACCESS TO MACXC3, MCXALK, MACIP2 (WHEN 2388 / ARGUMENT WAS PICKED UP), MACXL1, MCXBLK 2389 / 2390 / THE FOLLOWING ARE 'PUSH'-ED: IRPP2, IRPBCH, IRPC1, 2391 / 'LINSV2' 2392 2393 2394 004000 1050 MCIRP, TAD MACON 2395 004001 7650 SNA CLA /MACRO EXPANSION ON? 2396 004002 4555 JMS I [EERROR /NO 2397 004003 1430 TAD I MATCP1 2398 004004 4557 JMS I [CCHECK /CHECK CHAR AFTER 'P' 2399 004005 4562 JMS I [IERROR /ALPHA-NU. 2400 /SHOULD HAVE BEEN PICKED UP AS MACRO 2401 004006 4777 JMS TRNSFR 2402 004007 4555 JMS I [EERROR /ILLEGAL SEP 2403 004010 6400 6400 /SP CR : 2404 004011 7000 NOP /SP. TREAT LIKE CR. 2405 004012 7001 IAC /CR. NO FIELD 2406 004013 7110 CLL RAR / : 2407 004014 1331 TAD IRPBCH /GET INDICATOR 2408 004015 7650 SNA CLA /IRP ALREADY ON? 2409 004016 5242 JMP MCIRP3 /NO 2410 004017 7420 SNL /YES. FIELD PRESENT? 2411 004020 4555 JMS I [EERROR /YES. ERROR 2412 004021 2332 MCIRP1, ISZ IRPC1 /REACH LAST CALL? 2413 004022 5225 JMP MCIRP2 /NO 2414 004023 3331 DCA IRPBCH /YES. 0 INDICATOR 2415 004024 5553 JMP I [INLUP /AND FALL THROUGH 2416 2417 004025 4305 MCIRP2, JMS MCIRS1 /GET TO ARG CHAR 2418 004026 2730 MCIR2A, ISZ I IRPP2 /INCREMENT POINTER IN MACXL1 2419 004027 4573 JMS I [GETCHR 2420 004030 4126 IRPP1 2421 004031 4065 SFLD 2422 004032 7640 SZA CLA /REACH END OF THIS PART? 2423 004033 5226 JMP MCIR2A /NO 2424 004034 1331 TAD IRPBCH /YES. 2425 004035 3776 DCA MACXC3 /FORCE LOOP IN MACX 2426 004036 1042 TAD LINSV2 /GET LINE # SAVED FROM OPENING 'IRP' 2427 004037 3054 DCA LINES /RESET 'LINES' FOR ERRORS 2428 004040 2052 ISZ DLTESW 2429 004041 5553 JMP I [INLUP 2430 2431 004042 7430 MCIRP3, SZL /FIELD PRESENT ON FIRST CALL? 2432 004043 4555 JMS I [EERROR /NO. ERROR 2433 2434 / THE FOLLOWING IS A DESPERATION CHECK TO BE SURE 2435 / AN OPENING IRP IS HAS THE FORM IRP:ARG 2436 / IS ARG DOESN'T IMMEDIATELY PRECEDE CR, FIRST TEST WILL 2437 / FAIL (SEE 'MACIN2'). THEN CHECK 3 CHARS THAT 2438 / PRECEDE THE ARG THAT PRECEDES CR. THEY SHOULD BE 2439 / 'RP:'. THIS CHECK IS NOT FOOLPROOF, BUT 2440 / IT'S BETTER THAN NOTHING, WHICH IS WHAT THERE WAS 2441 / BEFORE. BESIDES, WHO USES 'IRP'S', ANYWAY? 2442 2443 004044 1254 TAD IRPI1 /VALUE SET IN MACIN2 2444 004045 1375 TAD (-4 /SINCE WE'RE POINTING 1 PAST, 2445 /BACK UP 3+1 2446 004046 7510 SPA /IF -, ARG DOESN'T PRECEDE CR 2447 004047 4555 JMS I [EERROR 2448 004050 3254 DCA IRPI1 /SAVE CHAR # OF 3 BACK FROM ARG 2449 004051 1040 TAD MCXBLK /BODY LINK 2450 004052 4774 JMS LNKSKP /SKIP TO 3 CHARS BACK 2451 004053 4126 IRPP1 2452 004054 0000 IRPI1, ZZZ /SET ABOVE, AND IN MACIN2 2453 004055 4315 JMS MCIRS2 /CHECK CHARS 2454 004056 7456 -"R 2455 004057 4315 JMS MCIRS2 2456 004060 7460 -"P 2457 004061 4315 JMS MCIRS2 2458 004062 7506 -": 2459 /TEST SUCCEEDED 2460 004063 1773 TAD MACIP2 /POINTER TO ARG CHAR # 2461 /(FROM 'MACIN2') 2462 004064 3330 DCA IRPP2 /SAVE 2463 004065 4305 JMS MCIRS1 /SKIP TO NEXT ARG CHAR 2464 004066 1326 TAD IRPP1 2465 004067 3772 DCA MACXP1 2466 004070 1327 TAD IRPP1+1 2467 004071 3771 DCA MACXP1+1 /SET UP FOR MACXS1 2468 004072 2030 ISZ MATCP1 /POINT AFTER : 2469 004073 4770 JMS GETARG /GET ARGUMENTS (STORED BACK) 2470 004074 7450 SNA /4000 BIT IS SIGNAL TO 'GETARG' 2471 004075 7001 IAC 2472 004076 7041 CIA /SAVE COUNTER 2473 004077 3332 DCA IRPC1 2474 004100 1776 TAD MACXC3 /BODY CHAR TO LOOP TO 2475 004101 3331 DCA IRPBCH /SAVE AS FLAG 2476 004102 1054 TAD LINES /GET PRESENT LINE # 2477 004103 3042 DCA LINSV2 /SAVE FOR LOOPS, SO 'LINES' 2478 /WILL BE RIGHT 2479 004104 5553 JMP I [INLUP 2480 2481 2482 004105 0000 MCIRS1, .-. /SKIP TO NEXT ARG. CHAR 2483 004106 1730 TAD I IRPP2 2484 004107 3313 DCA .+4 2485 004110 1037 TAD MCXALK 2486 004111 4774 JMS LNKSKP 2487 004112 4126 IRPP1 2488 004113 0000 ZZZ 2489 004114 5705 JMP I MCIRS1 2490 2491 2492 004115 0000 MCIRS2, .-. /CHECK CHARS 2493 004116 4573 JMS I [GETCHR 2494 004117 4126 IRPP1 2495 004120 4065 SFLD 2496 004121 1715 TAD I MCIRS2 2497 004122 7640 SZA CLA /CHAR MATCH? 2498 004123 4555 JMS I [EERROR 2499 004124 2315 ISZ MCIRS2 /YES 2500 004125 5715 JMP I MCIRS2 2501 2502 004126 0000 IRPP1, 0;0 004127 0000 2503 004130 0000 IRPP2, 0 2504 004131 0000 IRPBCH, 0 /IRP BODY CHAR TO LOOP WITH 2505 004132 0000 IRPC1, 0 /ITERATION COUNT 2506 2507 2508 004133 0000 CRLF, .-. 2509 004134 1367 TAD (215 2510 004135 4747 JMS I ERRLP2 2511 004136 1366 TAD (212 2512 004137 4747 JMS I ERRLP2 2513 004140 5733 JMP I CRLF 2514 2515 004141 0000 CLAMQA, .-. /PUT MQ IN AC 2516 004142 7200 CLA 2517 004143 1032 TAD MQ 2518 004144 5741 JMP I CLAMQA 2519 2520 004145 0000 ERRLS1, .-. /SUBROUTINE FOR ERROR LISTING 2521 004146 4765 JMS DECOUT /PRINT AC IN DECIMAL 2522 004147 1326 ERRLP2, TYO /PUSH DIGITS THROUGH 'TYO' 2523 004150 0000 0 /SUPPRESS LEADING 0'S 2524 004151 1745 TAD I ERRLS1 /FIRST ARG. 2525 004152 7500 SMA /WAS THERE ONE? 2526 004153 4747 JMS I ERRLP2 /YES. PRINT AS CHAR 2527 004154 7200 CLA /FALLING THROUGH CHAR WON'T HURT 2528 004155 5745 JMP I ERRLS1 /WHEN WE RETURN 2529 2530 004156 0000 ERRS2, .-. /LITTLE ERROR SUBROUTINE 2531 004157 1756 TAD I ERRS2 /GET ARG. 2532 004160 4747 JMS I ERRLP2 /PRINT 2533 004161 2764 ISZ ERRC2 /UPDATE CHAR POSITION 2534 004162 5756 JMP I ERRS2 /EXIT THRU CHAR 2535 2536 /PB 2537 /PB 2538 2539 004164 4252 PAGE 004165 2517 004166 0212 004167 0215 004170 3603 004171 3510 004172 3507 004173 4242 004174 3327 004175 7774 004176 4267 004177 1154 2540 004200 0000 MACINP, .-. /GET CHARS FROM MACRO LIKE INPUT 2541 /SOURCE 2542 004201 5602 JMP I MACOUT 2543 004202 4204 MACOUT, MACIN1 /INITIALIZED TO 'MACIN1' 2544 004203 5600 JMP I MACINP /WATCH THESE CO-ROUTINES! 2545 2546 004204 4260 MACIN1, JMS MACXS3 /GET CHAR FROM BODY 2547 004205 7450 SNA /END OF MACRO? 2548 004206 5243 JMP MACIN4 /YES 2549 004207 3230 DCA MACOT1 /NO 2550 004210 1230 TAD MACOT1 2551 004211 0173 AND [200 2552 004212 7650 SNA CLA /ARG. #? (<200) 2553 004213 5220 JMP MACIN2 /YES 2554 004214 1230 TAD MACOT1 /NO 2555 004215 4202 JMS MACOUT /RETURN 2556 004216 3777 DCA IRPI1 /CLEAR INDICATOR ONE CHAR AFTER 2557 /ARG IS RETURNED (SEE MCIRP) 2558 004217 5204 JMP MACIN1 2559 2560 004220 1230 MACIN2, TAD MACOT1 /ARG NUMBER 2561 004221 1376 TAD (MACXL1-1 2562 004222 3242 DCA MACIP2 2563 004223 1642 TAD I MACIP2 2564 004224 3230 DCA MACOT1 2565 004225 1037 TAD MCXALK 2566 004226 4775 JMS LNKSKP 2567 004227 3514 MACIP3 2568 004230 0000 MACOT1, ZZZ 2569 004231 1267 TAD MACXC3 /SAVE INDICATOR FOR MCIRP OF 2570 004232 3777 DCA IRPI1 /START OF ARG. 2571 004233 4573 MACIN3, JMS I [GETCHR /GET NEXT CHAR 2572 004234 3514 MACIP3 2573 004235 4065 SFLD 2574 004236 7450 SNA /END OF ARG? 2575 004237 5204 JMP MACIN1 /YES. FETCH FROM BODY 2576 004240 4202 JMS MACOUT 2577 004241 5233 JMP MACIN3 2578 2579 2580 004242 0000 MACIP2, 0 /MUST BE AVAILABLE TO MCIRP 2581 /AS POINTER TO MACXL1 (WHICH 2582 /GIVES # OF FIRST CHAR OF EACH 2583 /ARG.) 2584 2585 004243 4252 MACIN4, JMS MACPOP /POP OUT OF MACRO 2586 004244 1200 TAD MACINP 2587 004245 3457 DCA I INPUT /PROCEED TO FAKE A 'JMS' 2588 004246 1057 TAD INPUT 2589 004247 7001 IAC 2590 004250 3242 DCA MACIP2 /GO WHERE WE WOULD HAVE GONE, BUT 2591 /FOR THE LAST CALL TO 'MACINP' 2592 004251 5642 JMP I MACIP2 2593 2594 2595 2596 ERRC2=. /SQUEEZE 2597 004252 0000 MACPOP, .-. /POP OUT OF MACRO. CALLED BY 2598 / 'MCRET', TOO 2599 004253 1037 TAD MCXALK 2600 004254 4774 JMS LNKDEL /KILL ARGUMENT LINK 2601 004255 4773 JMS POP /RETRIEVE FORMER STATUS 2602 004256 5517 MACXL3 2603 004257 5652 JMP I MACPOP 2604 2605 2606 ERRC1=. /TIGHT! 2607 004260 0000 MACXS3, .-. /FETCH CHAR 2608 004261 1052 TAD DLTESW 2609 004262 7650 SNA CLA /LINK RECENTLY DELETED? 2610 004263 5271 JMP MCXS31 /NO 2611 004264 1040 TAD MCXBLK /YES 2612 004265 4775 JMS LNKSKP 2613 004266 3512 MACIP1 2614 004267 0000 MACXC3, ZZZ /# OF PRESENT CHAR IN MACRO 2615 004270 3052 DCA DLTESW 2616 004271 4573 MCXS31, JMS I [GETCHR /GET NEXT CHAR 2617 004272 3512 MACIP1 2618 004273 4065 SFLD 2619 004274 2267 ISZ MACXC3 /NEXT CHAR 2620 004275 5660 JMP I MACXS3 2621 2622 2623 2624 2625 004276 0000 ERROR, .-. /PRINT ERROR INDICATION 2626 004277 7200 CLA 2627 004300 4772 JMS CRLF 2628 004301 1676 TAD I ERROR /GET ERROR TYPE CHAR 2629 004302 4771 JMS TYO 2630 004303 1357 TAD ERRSC1 /SPACE 2631 004304 4771 JMS TYO 2632 004305 7001 IAC /SO ERRS1 WON'T PRINT CRLF 2633 004306 4320 JMS ERRS1 2634 004307 5312 JMP .+3 /DON'T PRINT SPACE, IN CASE 2635 /FIRST CHAR POSITION IS IN 2636 /ERROR 2637 004310 1357 ERR1, TAD ERRSC1 /SPACE 2638 004311 4771 JMS TYO 2639 004312 2260 ISZ ERRC1 /SET IN ERRS1 2640 004313 5310 JMP ERR1 /KEEP SPACING 2641 004314 4770 JMS ERRS2 2642 004315 0336 "^ 2643 004316 4772 JMS CRLF 2644 004317 5676 JMP I ERROR 2645 2646 004320 0000 ERRS1, .-. /PRINT LINE 2647 004321 4767 JMS ERRLST /GENERATE ERROR LIST FIRST 2648 004322 1164 TAD [LNBUF1-1 /PRINT WHOLE LINE BUFFER 2649 004323 3013 DCA XR13 2650 004324 4772 JMS CRLF 2651 004325 3252 DCA ERRC2 2652 004326 1413 ERRS11, TAD I XR13 /GET CHAR 2653 004327 3335 DCA ERRT1 /SAVE 2654 004330 1335 TAD ERRT1 2655 004331 1366 TAD (-211 /TAB? 2656 004332 7650 SNA CLA 2657 004333 5356 JMP ERRS14 /YES 2658 004334 4770 JMS ERRS2 /NO, PRINT CHAR 2659 004335 0000 ERRT1, ZZZ 2660 004336 1013 ERRS12, TAD XR13 /REACH ERROR POSITION? 2661 004337 7041 CIA 2662 004340 1022 TAD SCANP2 2663 004341 7640 SZA CLA 2664 004342 5346 JMP ERRS13 /NO 2665 004343 1252 TAD ERRC2 /YES 2666 004344 7041 CIA 2667 004345 3260 DCA ERRC1 /SAVE FOR ERROR 2668 004346 1335 ERRS13, TAD ERRT1 2669 004347 7440 SZA /TREAT 0 LIKE CR 2670 004350 1163 TAD [-215 2671 004351 7640 SZA CLA /REACH END OF LINE? 2672 004352 5326 JMP ERRS11 /NO 2673 004353 4770 JMS ERRS2 /YES. OUTPUT LF AFTER CR 2674 004354 0212 212 2675 004355 5720 JMP I ERRS1 2676 2677 004356 4770 ERRS14, JMS ERRS2 /TAB TO NEXT 8 SPOT 2678 004357 0240 ERRSC1, " 2679 004360 1252 TAD ERRC2 2680 004361 0365 AND (7 2681 004362 7650 SNA CLA /REACH MULTIPLE OF 8? 2682 004363 5336 JMP ERRS12 2683 004364 5356 JMP ERRS14 /NO 2684 2685 2686 2687 /PB 2688 /PB 2689 2690 004365 0007 PAGE 004366 7567 004367 2536 004370 4156 004371 1326 004372 4133 004373 1256 004374 1022 004375 3327 004376 6032 004377 4054 2691 2692 / EVALUATE EXPRESSION, STARTING AT (SCANP2)+1 2693 2694 / OPERATOR STACK ('OPSTK') CONSISTS OF PAIRS: 2695 / SEPCOD FOR OPERATOR; OPERATOR (EVALP1) 2696 2697 / OPERAND STACK ('EVALPD') IS SINGLE WORD 2698 / VALUES (EVALP2) 2699 2700 004400 0000 EVAL, .-. /ENTRY POINT 2701 004401 4130 JMS XPND /EXPAND LINE FIRST 2702 004402 1377 TAD (EVALPD 2703 004403 3315 DCA EVALP2 /START PUSH-DOWN 2704 004404 4545 JMS I [GATHER /START OFF WITH FIELD? 2705 004405 7410 SKP /NO 2706 004406 5216 JMP EVAL1 /YES 2707 004407 4776 JMS TRNSFR /CHECK SEPARATOR 2708 004410 4775 JMS EVALER /NOT FOUND. ERROR 2709 /MAY SKIP IF MPCHR IS 2710 /FOUND, FOLLOWED BY 2711 /FIELD (UNEXPANDED SYMBOL 2712 /ERROR) 2713 004411 7100 7100 /SP CR , + - 2714 004412 5217 JMP EVAL2 2715 004413 5217 JMP EVAL2 2716 004414 5217 JMP EVAL2 2717 004415 7410 SKP 2718 004416 4774 EVAL1, JMS GETNUM /PICK UP NUMBER 2719 004417 3715 EVAL2, DCA I EVALP2 /PUSH 2720 004420 2315 ISZ EVALP2 2721 004421 1373 TAD (OPSTK-1 2722 004422 3314 DCA EVALP1 /START OPERATOR STACK 2723 004423 4776 JMS TRNSFR 2724 004424 5275 JMP EVAL7 2725 004425 0160 160 /ARITH OPS + - * / \ ! & 2726 004426 7410 SKP 2727 004427 7200 EVAL2A, CLA 2728 004430 1422 EVAL3, TAD I SCANP2 /GET SEPARATOR 2729 004431 2314 ISZ EVALP1 2730 004432 3714 DCA I EVALP1 /PUSH IT 2731 004433 1024 TAD SEPCOD 2732 004434 2314 ISZ EVALP1 2733 004435 3714 DCA I EVALP1 /PUSH HIERARCHY (SEPCOD) 2734 004436 4545 EVAL4, JMS I [GATHER /GET NEW FIELD 2735 004437 4775 JMS EVALER /FIELD MISSING (SEE EVAL+8) 2736 004440 4774 JMS GETNUM /FORM VALUE 2737 004441 3715 EVAL5, DCA I EVALP2 /PUSH ON STACK 2738 004442 2315 ISZ EVALP2 2739 004443 1714 TAD I EVALP1 /GET OLD HIERARCHY 2740 004444 7450 SNA /TOP OF STACK? 2741 004445 5275 JMP EVAL7 /YES 2742 004446 7041 CIA /NO 2743 004447 1024 TAD SEPCOD /GIVES NEW - OLD 2744 004450 7740 SMA SZA CLA / NEW > OLD ? 2745 004451 5230 JMP EVAL3 /YES. JUST SAVE 2746 004452 1372 TAD (EVALL1-1 /NO 2747 004453 3012 DCA XR12 /LIST OF OPERATIONS TO PERFORM 2748 004454 7040 CMA 2749 004455 1314 TAD EVALP1 2750 004456 3314 DCA EVALP1 /POP TO LOOK AT OP. CHAR 2751 004457 1412 EVAL6, TAD I XR12 /GET CHAR 2752 004460 7450 SNA /END OF LIST? 2753 004461 4562 JMS I [IERROR /YES. INTERNAL 2754 004462 1714 TAD I EVALP1 /GET SEP 2755 004463 7650 SNA CLA /FOUND? 2756 004464 5267 JMP .+3 /YES 2757 004465 2012 ISZ XR12 /NO 2758 004466 5257 JMP EVAL6 2759 2760 004467 7040 CMA 2761 004470 1314 TAD EVALP1 2762 004471 3314 DCA EVALP1 /POP AGAIN 2763 004472 1412 TAD I XR12 /TRANSFER VECTOR 2764 004473 3333 DCA EVALT1 2765 004474 5733 JMP I EVALT1 /PERFORM OP 2766 2767 004475 1024 EVAL7, TAD SEPCOD 2768 004476 1371 TAD (-5 2769 004477 7500 SMA /ARITH OP? 2770 004500 5227 JMP EVAL2A /YES. JUST PUSH ONTO STACKS 2771 004501 1370 TAD (3 2772 004502 7740 SMA SZA CLA /SEPCOD 0, 1, 2 (FOR SP CR ,)? 2773 004503 4543 JMS I [WERROR /NO 2774 004504 4306 JMS POPE /END OF EXPRESSION 2775 004505 5600 JMP I EVAL /RETURN VALUE IN AC 2776 2777 004506 0000 POPE, .-. /POP FROM VALUE STACK 2778 004507 7240 CLA CMA 2779 004510 1315 TAD EVALP2 2780 004511 3315 DCA EVALP2 2781 004512 1715 TAD I EVALP2 2782 004513 5706 JMP I POPE 2783 2784 004514 0000 EVALP1, 0 2785 004515 0000 EVALP2, 0 2786 2787 004516 5600 EVALRT, JMP I EVAL /RETURN 0 VALUE. ESCAPE 2788 /FOR EVALER 2789 2790 2791 / 2792 / ARITHMETIC OPS ARE PERFORMED BELOW 2793 / 2794 2795 004517 4306 EVALPL, JMS POPE /+ 2796 004520 3333 EVLPL1, DCA EVALT1 2797 004521 4306 JMS POPE 2798 004522 1333 TAD EVALT1 2799 004523 5241 JMP EVAL5 2800 2801 004524 4306 EVALMI, JMS POPE 2802 004525 7041 CIA 2803 004526 5320 JMP EVLPL1 /- 2804 2805 004527 4306 EVALTM, JMS POPE /* 2806 004530 3333 DCA EVALT1 2807 004531 4306 JMS POPE 2808 004532 4767 JMS I (MQLMUY 2809 004533 0000 EVALT1, ZZZ 2810 004534 4560 JMS I [CLAMQA 2811 004535 5241 JMP EVAL5 2812 2813 004536 7040 EVALRM, CMA / \ 2814 004537 3333 EVALDV, DCA EVALT1 / / 2815 004540 4306 JMS POPE 2816 004541 3344 DCA EVALT2 2817 004542 4306 JMS POPE 2818 004543 4552 JMS I [MQLDVI 2819 004544 0000 EVALT2, ZZZ 2820 004545 7430 SZL /DIVIDE CHECK? 2821 004546 4543 JMS I [WERROR /YES 2822 004547 2333 ISZ EVALT1 2823 004550 4560 JMS I [CLAMQA 2824 004551 5241 JMP EVAL5 2825 2826 004552 4306 EVALAN, JMS POPE /& 2827 004553 3333 DCA EVALT1 2828 004554 4306 JMS POPE 2829 004555 0333 AND EVALT1 2830 004556 5241 JMP EVAL5 2831 2832 004557 4306 EVALOR, JMS POPE /! 2833 004560 3032 DCA MQ 2834 004561 4306 JMS POPE 2835 004562 4766 JMS I (MQA 2836 004563 5241 JMP EVAL5 2837 2838 2839 2840 2841 /PB 2842 /PB 2843 2844 004566 3356 PAGE 004567 2737 004570 0003 004571 7773 004572 5552 004573 5571 004574 4634 004575 4702 004576 1154 004577 5602 2845 2846 / 2847 / SET INSTRUCTION 2848 / 2849 2850 004600 4777 SET, JMS EVAL /EXPR AFTER =. GET VALUE 2851 004601 3222 DCA SETT1 /SAVE 2852 004602 4542 JMS I [GETPNM /GET PATTERN FIELD 2853 004603 4544 JMS I [LOOKUP 2854 004604 6040 6040 /CREATE 2855 004605 5213 JMP SET2 /NOT FOUND (OR SYM. CREATED) 2856 004606 7130 SET1, STL RAR /4000 FOR SET 2857 004607 3425 DCA I TBLWD1 2858 004610 1222 TAD SETT1 /RETRIEVE VALUE 2859 004611 3426 DCA I TBLWD2 /SAVE IN TABLE 2860 004612 5553 JMP I [INLUP 2861 2862 004613 1425 SET2, TAD I TBLWD1 /GET TYPE WORD 2863 004614 0146 AND [1000 /CHECK SSET BIT 2864 004615 7650 SNA CLA /WAS SYMBOL AN SSET? 2865 004616 4555 JMS I [EERROR /NO. SOMETHING ELSE 2866 004617 1426 TAD I TBLWD2 /YES. PICK UP LINK # 2867 004620 4776 JMS LNKDEL /GET RID OF LINK 2868 004621 5206 JMP SET1 /THEN CONTINUE 2869 2870 004622 0000 SETT1, 0 2871 2872 2873 2874 2875 004623 1050 MCLOOP, TAD MACON /LOOP COMMAND COMES HERE 2876 004624 7650 SNA CLA /MACRO EXPANSION ON? 2877 004625 4555 JMS I [EERROR /NO. ERROR 2878 004626 1775 TAD MACXC3 2879 004627 3233 DCA LUPCHR /SET LOOPING CHARACTER 2880 004630 1054 TAD LINES 2881 004631 3041 DCA LINSV1 /SAVE PRESENT LINE # FOR MACRO 2882 /LOOPING 'IF' RESETS THIS TO GIVE 2883 /PROPER LINE IN SOURCE 2884 004632 5553 JMP I [INLUP /THAT'S ALL! 2885 2886 004633 0000 LUPCHR, 0 /CHAR TO LOOP TO IN MACRO 2887 2888 004634 0000 GETNUM, .-. /FETCH VALUE FROM NUMBER. CALLED 2889 /AFTER GATHER HAS FOUND NAME 2890 004635 1022 TAD SCANP2 2891 004636 7041 CIA 2892 004637 1023 TAD SCANP3 2893 004640 3301 DCA GETNC1 /LENGTH OF FIELD 2894 004641 3276 GETN1, DCA GETNT1 /SET VALUE 2895 004642 1051 TAD OCTDEC /SWITCH 2896 004643 7040 CMA 2897 004644 3300 DCA GETNI1 /SET INDICATOR 2898 004645 2300 ISZ GETNI1 2899 004646 7144 CMA CLL RAL /IF DECIMAL 2900 004647 1421 TAD I SCANP1 2901 004650 1374 TAD (-"7 2902 004651 7740 SMA SZA CLA /> 7 (OR 9) 2903 004652 5274 JMP GETN2 /YES. ERROR 2904 004653 1421 TAD I SCANP1 /NO 2905 004654 1373 TAD (-"0 2906 004655 7510 SPA /< 0? 2907 004656 5274 JMP GETN2 /YES. ERROR 2908 004657 3277 DCA GETNT2 /NO. SAVE DIGIT 2909 004660 1276 TAD GETNT1 2910 004661 7104 CLL RAL 2911 004662 7104 CLL RAL 2912 004663 2300 ISZ GETNI1 2913 004664 7410 SKP 2914 004665 1276 TAD GETNT1 /IF DEC 2915 004666 7104 CLL RAL 2916 004667 1277 TAD GETNT2 /ADD NEW DIGIT 2917 004670 2021 ISZ SCANP1 /NEXT CHAR 2918 004671 2301 ISZ GETNC1 /DONE? 2919 004672 5241 JMP GETN1 2920 004673 5634 JMP I GETNUM 2921 004674 4543 GETN2, JMS I [WERROR /RETURN WARNING 2922 004675 5634 JMP I GETNUM /AND 0 VALUE FOR PARAM 2923 2924 004676 0000 GETNT1, 0 2925 004677 0000 GETNT2, 0 2926 004700 0000 GETNI1, 0 2927 004701 0000 GETNC1, 0 2928 2929 2930 004702 0000 EVALER, .-. /SUBROUTINE TO GET AROUND COMMON 2931 /ERROR SITUATION IN EVAL: 2932 /UNEXPANDED NAME RESULTS IN 2933 /MPCHR FOLLOWED BY FIELD 2934 004703 4543 JMS I [WERROR /SIGNAL WARNING 2935 004704 1422 TAD I SCANP2 2936 004705 1154 TAD [-MPCHR 2937 004706 7640 SZA CLA /WAS OFFENDING SEP. MPCHR? 2938 004707 5772 JMP EVALRT /NO. CAN'T DO ANY MORE 2939 004710 2302 ISZ EVALER /YES. SKIP RETURN 2940 004711 4545 JMS I [GATHER /GET FIELD, SO IT WILL BE SKIPPED 2941 004712 5772 JMP EVALRT /NO FIELD. NOTHING TO BE DONE 2942 004713 5702 JMP I EVALER /RETURN. WILL ACT LIKE 0 WAS 2943 /EVALUATED 2944 2945 2946 004714 4570 MCXEC, JMS I [XPND1 /EXPAND AFTER ':' 2947 004715 1036 TAD LINBUF 2948 004716 7041 CIA 2949 004717 1030 TAD MATCP1 /CHARS UP TO : 2950 004720 1035 TAD LINCNT 2951 004721 7500 SMA 2952 004722 4562 JMS I [IERROR /INTERNAL ERROR 2953 004723 3035 DCA LINCNT /SAVE CORRECTED COUNT 2954 004724 1030 TAD MATCP1 2955 004725 3036 DCA LINBUF /PRETEND TO HAVE SHORTER BUFFER 2956 004726 5771 JMP INLUP0 /THEN, PROCESS LINE AS USUAL 2957 2958 004727 0000 MQLDVI, .-. /SET MQ, DIVIDE 2959 004730 3032 DCA MQ 2960 004731 1327 TAD MQLDVI 2961 004732 3334 DCA DVI 2962 004733 5335 JMP DVI+1 /FAKE JMS, LET DVI GET ARG 2963 2964 004734 0000 DVI, .-. /EAE DIVIDE SIMULATOR 2965 004735 3033 DCA AC 2966 004736 1370 TAD (-15 2967 004737 3034 DCA EAESC /STEP COUNT 2968 004740 1734 TAD I DVI 2969 004741 7141 CIA CLL 2970 004742 1033 TAD AC 2971 004743 7630 SZL CLA /DIVIDE CHECK? 2972 004744 5365 JMP DVI2 /YES 2973 004745 1734 DVI1, TAD I DVI 2974 004746 7141 CIA CLL 2975 004747 1033 TAD AC 2976 004750 7430 SZL 2977 004751 3033 DCA AC 2978 004752 7200 CLA 2979 004753 1032 TAD MQ 2980 004754 7004 RAL 2981 004755 3032 DCA MQ 2982 004756 1033 TAD AC 2983 004757 7004 RAL 2984 004760 3033 DCA AC 2985 004761 2034 ISZ EAESC 2986 004762 5345 JMP DVI1 2987 004763 1033 TAD AC 2988 004764 7010 RAR /CORRECTION FOR REMAINDER 2989 004765 2334 DVI2, ISZ DVI 2990 004766 5734 JMP I DVI 2991 2992 2993 /PB 2994 /PB 2995 2996 004770 7763 PAGE 004771 1603 004772 4516 004773 7520 004774 7511 004775 4267 004776 1022 004777 4400 2997 2998 /NOTE: 'IF----' MAY IN FACT BE MACRO CALL. 2999 / THIS ROUTINE ASSUMES THAT AN UNRECOG- 3000 / NIZED 'IF' IS REALLY A MACRO 3001 3002 005000 4542 IF, JMS I [GETPNM /'IF' PROCESSOR. GET PATTERN FIELD 3003 005001 1017 TAD GATHBF+1 3004 005002 7640 SZA CLA /CHARS 3 AND 4 MUST NOT EXIST 3005 005003 5777 JMP MACX0 /ASSUME TO BE MACRO NAME 3006 005004 1376 TAD (IFL1-1 3007 005005 3011 DCA XR11 /POINT TO IF-TYPES 3008 005006 1411 IF1, TAD I XR11 3009 005007 7450 SNA /END OF LIST? 3010 005010 5777 JMP MACX0 /YES. TYPE NOT FOUND. ASSUME MACRO 3011 005011 1016 TAD GATHBF 3012 005012 7650 SNA CLA /LIST MATCH SOURCE? 3013 005013 5216 JMP IF2 /YES 3014 005014 2011 ISZ XR11 /NO. SKIP TRANSFER VECTOR 3015 005015 5206 JMP IF1 3016 3017 005016 1411 IF2, TAD I XR11 /GET TRANSFER VECTOR 3018 005017 7130 STL RAR /PUT SWITCH BIT IN LINK, FORM OPR 3019 005020 7430 SZL /SPECIAL? 3020 005021 5302 JMP IF8 /YES 3021 005022 3224 DCA IFSKP /NO. SAVE SKIP 3022 005023 4775 JMS EVAL /THEN EVALUATE EXPRESSION 3023 005024 0000 IFSKP, ZZZ /CHECK VALUE 3024 005025 5553 JMP I [INLUP /TEST FAILED. IGNORE IF 3025 005026 7144 CMA CLL RAL /TEST SUCCEEDED 3026 005027 1024 TAD SEPCOD 3027 005030 7640 SZA CLA /SEPARATOR A COMMA? 3028 005031 4555 JMS I [EERROR /NO. ERROR 3029 005032 4545 JMS I [GATHER /YES. PICK UP FOLLOWING FIELD 3030 005033 5263 JMP IF6 /NO FIELD 3031 005034 1422 TAD I SCANP2 3032 005035 1374 TAD (-"^ 3033 005036 7650 SNA CLA /IS THIS A SKIP TYPE? 3034 005037 5320 JMP IF10 /YES 3035 005040 1016 TAD GATHBF /NO. FIRST TWO CHARS 3036 005041 7041 CIA 3037 005042 3313 DCA IFT1 /SAVE - 3038 005043 4327 JMS IFS1 /FIELD OF PROPER FORM? 3039 005044 4555 JMS I [EERROR /NO. ERROR 3040 005045 5251 JMP IF4 /YES. CONTINUE 3041 3042 3043 005046 7040 IF3, CMA 3044 005047 1024 TAD SEPCOD /CHECK SEPARATOR 3045 005050 7650 SNA CLA /CR? 3046 005051 4773 IF4, JMS GETLIN /YES. GET NEXT LINE 3047 005052 4545 IF5, JMS I [GATHER /GET NEXT FIELD 3048 005053 5246 JMP IF3 /NO FIELD 3049 005054 4327 JMS IFS1 /CHECK FIELD FORM 3050 005055 5246 JMP IF3 /WRONG FORM 3051 005056 1313 TAD IFT1 /FORM OK 3052 005057 1016 TAD GATHBF /CHECK 3053 005060 7650 SNA CLA /SAVED TWO CHARS MATCH FIELD? 3054 005061 5553 JMP I [INLUP /YES. END OF SOURCE SKIPPING 3055 005062 5252 JMP IF5 /NO. CONTINUE THIS LINE 3056 3057 3058 / SKIP PROCESSING FOR MACRO LOOP 3059 3060 005063 1422 IF6, TAD I SCANP2 /CHECK THE CHAR 3061 005064 1154 TAD [-MPCHR /FOR MPCHR 3062 005065 7640 SZA CLA /FIND IT? 3063 005066 4555 JMS I [EERROR /NO. ERROR 3064 005067 1050 IF7, TAD MACON /YES. CHECK MACRO EXPANSION 3065 005070 7650 SNA CLA /MACRO EXPANSION ON? 3066 005071 4555 JMS I [EERROR /NO. ERROR 3067 005072 1772 TAD LUPCHR /YES 3068 005073 7450 SNA /WAS THERE A LOOP INSTRUCTION? 3069 005074 4555 JMS I [EERROR /NO. ERROR 3070 005075 3771 DCA MACXC3 /YES. SAVE CHAR # 3071 005076 1041 TAD LINSV1 /GET LINE # SAVED IN 'LOOP' 3072 005077 3054 DCA LINES /RESTORE 'LINES' TO GIVE PROPER # 3073 005100 2052 ISZ DLTESW /FORCE SKIP TO LOOP CHAR 3074 005101 5553 JMP I [INLUP /DISAPPEAR 3075 3076 3077 005102 7130 IF8, STL RAR /SPECIAL IF 3078 005103 3224 DCA IFSKP /FORM FINAL SKIP 3079 005104 7430 SZL /PUTS SWITCH IN LINK 3080 005105 5322 JMP IF11 /IFDF TYPE IF 3081 005106 4340 JMS IFS2 /IFNL TYPE IF. CLEAR INDICATOR 3082 005107 1000 1000 /SYMBOL TYPE (SSET) 3083 005110 5315 JMP IF9 /NOT FOUND 3084 005111 1426 TAD I TBLWD2 /GET LINK # 3085 005112 4770 JMS LNKGET /TO FIND LENGTH 3086 005113 0000 IFT1, ZZZ 3087 005114 7610 SKP CLA /DON'T NEED POINTER 3088 005115 4543 IF9, JMS I [WERROR /GIVE WARNING 3089 005116 1313 TAD IFT1 /PICK UP COUNT SUPPLIED BY LNKGET 3090 005117 5224 JMP IFSKP /JUMP BACK IN 3091 3092 3093 005120 4767 IF10, JMS GETNUM /NUMBER OF LINES TO SKIP 3094 005121 5766 JMP MPSK1 /GO TO SKIP PROCESSOR 3095 3096 3097 005122 7001 IF11, IAC /SET TO 1 SO 'ND' IS FORCED IF 3098 /NO FIELD 0 FOUND IN IFS2 3099 005123 4340 JMS IFS2 /IFDF TYPE IF 3100 005124 7000 7000 /SET, SSET, CSET SYMBOLS 3101 005125 7001 IAC /NOT FOUND 3102 005126 5224 JMP IFSKP /FOUND (0) 3103 3104 005127 0000 IFS1, .-. /SUBROUTINE TO CHECK FOR MPCHR, 3105 /AND ONLY TWO CHAR FIELD 3106 005130 1017 TAD GATHBF+1 3107 005131 7640 SZA CLA /LONGER THAN TWO CHARS? 3108 005132 5727 JMP I IFS1 /YES 3109 005133 1422 TAD I SCANP2 /GET SEPARATOR 3110 005134 1154 TAD [-MPCHR 3111 005135 7650 SNA CLA 3112 005136 2327 ISZ IFS1 /FOUND MPCHR 3113 005137 5727 JMP I IFS1 /RETURN 3114 3115 3116 005140 0000 IFS2, .-. /SUBR. TO CHECK SYMBOL DEF. 3117 / FOR IFNL, IFDF 3118 005141 3313 DCA IFT1 /SET INDICATOR 3119 005142 2022 ISZ SCANP2 3120 005143 1422 TAD I SCANP2 /NEXT CHAR 3121 005144 1154 TAD [-MPCHR 3122 005145 7650 SNA CLA /MPCHR? 3123 005146 4545 JMS I [GATHER /YES 3124 005147 5315 JMP IF9 /NO NAME, OR NO MPCHR. ERROR 3125 005150 1340 TAD IFS2 /SET UP FOR FAKE JMS 3126 005151 3544 DCA I [LOOKUP /SO LOOKUP PICKS UP ARG. AND 3127 /PERFORMS LOOKUP 3128 005152 5765 JMP LOOKUP+1 /GO GO GO! 3129 3130 3131 005153 0000 ODUMMY, .-. /DUMMY OUTPUT ROUTINE 3132 005154 7326 CLA STL RTL /2 3133 005155 7124 STL RAL /5 TOTAL 3134 005156 1353 TAD ODUMMY 3135 005157 3353 DCA ODUMMY /NO ERRORS 3136 005160 5753 JMP I ODUMMY /RETURN 3137 3138 /PB 3139 /PB 3140 3141 005165 1401 PAGE 005166 1356 005167 4634 005170 0725 005171 4267 005172 4633 005173 0600 005174 7442 005175 4400 005176 5605 005177 3400 3142 3143 / 3144 / TABLES AND BUFFERS FOR MACRO PROCESSOR 3145 / 3146 3147 3148 3149 3150 / 3151 / PATTERN STORAGE 3152 / 3153 3154 005200 5412 PATLST, PAT13;PAT14;PAT1;PAT2;PAT3;PAT4;PAT5;PAT15 005201 5420 005202 5224 005203 5236 005204 5251 005205 5262 005206 5275 005207 5427 3155 005210 5310 PAT6;PAT7;PAT8;PAT9;PAT10;PAT11;PAT12;PAT16 005211 5324 005212 5337 005213 5350 005214 5361 005215 5372 005216 5402 005217 5442 3156 005220 5455 PAT17;PAT18;PAT19;0 /END 005221 5466 005222 3550 005223 0000 3157 3158 005224 0000 PAT1, ZBLOCK 2;MCDF1 /DEFINE MACRO (1) 005225 0000 005226 3046 3159 005227 0004 4;-"D;-"E;-"F;4;1;0 005230 7474 005231 7473 005232 7472 005233 0004 005234 0001 005235 0000 3160 3161 005236 0000 PAT2, ZBLOCK 2;MCDF2 /DEFINE MACRO (2) 005237 0000 005240 3047 3162 005241 0001 1;4;-"D;-"E;-"F;4;1;0 005242 0004 005243 7474 005244 7473 005245 7472 005246 0004 005247 0001 005250 0000 3163 3164 005251 0000 PAT3, ZBLOCK 2;MCIRP /IRP 005252 0000 005253 4000 3165 005254 0004 4;-"I;-"R;-"P;3;0 005255 7467 005256 7456 005257 7460 005260 0003 005261 0000 3166 3167 005262 0000 PAT4, ZBLOCK 2;SET /SET 005263 0000 005264 4600 3168 005265 0004 4;-"S;-"E;-"T;4;1;-"=;0 005266 7455 005267 7473 005270 7454 005271 0004 005272 0001 005273 7503 005274 0000 3169 3170 005275 0000 PAT5, ZBLOCK 2;LCSET /LCS 005276 0000 005277 2607 3171 005300 0004 4;-"L;-"C;-"S;4;1;-"=;0 005301 7464 005302 7475 005303 7455 005304 0004 005305 0001 005306 7503 005307 0000 3172 3173 005310 0000 PAT6, ZBLOCK 2;SSET /STRING SET 005311 0000 005312 3000 3174 005313 0004 4;-"S;-"S;-"E;-"T;4;1;-"=;0 005314 7455 005315 7455 005316 7473 005317 7454 005320 0004 005321 0001 005322 7503 005323 0000 3175 3176 005324 0000 PAT7, ZBLOCK 2;LDLTE /LEFT DELETE 005325 0000 005326 2647 3177 005327 0004 4;-"L;-"D;-"E;-"L;4;1;0 005330 7464 005331 7474 005332 7473 005333 7464 005334 0004 005335 0001 005336 0000 3178 3179 005337 0000 PAT8, ZBLOCK 2;MCLOOP /LOOP 005340 0000 005341 4623 3180 005342 0004 4;-"L;-"O;-"O;-"P;0 005343 7464 005344 7461 005345 7461 005346 7460 005347 0000 3181 3182 005350 0000 PAT9, ZBLOCK 2;IF /GENERALIZED 'IF' 005351 0000 005352 5000 3183 005353 0004 4;-"I;-"F;1;-":;0 005354 7467 005355 7472 005356 0001 005357 7506 005360 0000 3184 3185 005361 0000 PAT10, ZBLOCK 2;MCXEC /EXECUTE 005362 0000 005363 4714 3186 005364 0004 4;-"X;-"E;-"C;-":;0 005365 7450 005366 7473 005367 7475 005370 7506 005371 0000 3187 3188 005372 0000 PAT11, ZBLOCK 2;OCT /SET OCTAL 005373 0000 005374 3601 3189 005375 0004 4;-"O;-"C;-"T;0 005376 7461 005377 7475 005400 7454 005401 0000 3190 3191 005402 0000 PAT12, ZBLOCK 2;DEC /SET DECIMAL 005403 0000 005404 3600 3192 005405 0004 4;-"D;-"E;-"C;0 005406 7474 005407 7473 005410 7475 005411 0000 3193 3194 005412 0000 PAT13, ZBLOCK 2;MACX1 /MACRO EXPAND (1) 005413 0000 005414 3404 3195 005415 0004 4;1;0 005416 0001 005417 0000 3196 3197 005420 0000 PAT14, ZBLOCK 2;MACX2 /MACRO EXPAND (2) 005421 0000 005422 3404 3198 005423 0001 1;4;1;0 005424 0004 005425 0001 005426 0000 3199 3200 005427 0000 PAT15, ZBLOCK 2;RCSET /RCS 005430 0000 005431 2600 3201 005432 0004 4;-"R;-"C;-"S;4;1;-"=;0 005433 7456 005434 7475 005435 7455 005436 0004 005437 0001 005440 7503 005441 0000 3202 3203 005442 0000 PAT16, ZBLOCK 2;RDLTE /RIGHT DELETE 005443 0000 005444 2650 3204 005445 0004 4;-"R;-"D;-"E;-"L;4;1;0 005446 7456 005447 7474 005450 7473 005451 7464 005452 0004 005453 0001 005454 0000 3205 3206 005455 0000 PAT17, ZBLOCK 2;MPSKIP /SKIP LINES 005456 0000 005457 1355 3207 005460 0004 4;-"S;-"K;-"P;-":;0 005461 7455 005462 7465 005463 7460 005464 7506 005465 0000 3208 005466 0000 PAT18, ZBLOCK 2;MCRET /FORCED MACRO RETURN 005467 0000 005470 1337 3209 005471 0004 4;-"R;-"E;-"T;-":;0 005472 7456 005473 7473 005474 7454 005475 7506 005476 0000 3210 3211 3212 3213 3214 3215 3216 /*************************************** 3217 3218 / THESE HUMBLE LINES MUST BE AS THEY APPEAR, FUNNY 0 AND 3219 / LABELS, AND EVERYTHING 3220 3221 / 0 /0 IN PRECEDING PATTERN IS USED AS 3222 /TERMINATION FOR THIS SET OF LISTS!!!! 3223 /'LINES' MUST BE FIRST ENTRY IN THIS TABLE FOR 'ERRLST' 3224 005477 0054 MACXL2, LINES;MACON;INPUT;MACIP1;MACIP1+1;MACXC3;MCXALK 005500 0050 005501 0057 005502 3512 005503 3513 005504 4267 005505 0037 3225 005506 0040 MCXBLK;IRPP2;IRPBCH;IRPC1;LUPCHR;LINSV1;LINSV2;0 005507 4130 005510 4131 005511 4132 005512 4633 005513 0041 005514 0042 005515 0000 3226 005516 7761 -MCARG 3227 005517 6033 MACXL3, MACXL1;0 005520 0000 3228 3229 PDLEN=16+MCARG /LENGTH OF PD GROUP FOR 'ERRLST' 3230 3231 /*************************************** 3232 3233 005521 7540 CCHKL1, -" ;0 005522 0000 3234 005523 7567 -211;0 /TAB 005524 0000 3235 005525 7563 -215;1 /CR 005526 0001 3236 005527 7524 -",;2 005530 0002 3237 005531 7506 -":;3 005532 0003 3238 005533 7525 -"+;5 005534 0005 3239 005535 7523 -"-;5 005536 0005 3240 005537 7526 -"*;6 005540 0006 3241 005541 7521 -"/;6 005542 0006 3242 005543 7444 -"\;6 005544 0006 3243 005545 7532 -"&;7 005546 0007 3244 005547 7537 -"!;7 005550 0007 3245 005551 0000 0;4 /END OF LIST. SECOND # IS DEFAULT SEPCOD 005552 0004 3246 3247 3248 /PB 3249 /PB 3250 3251 005553 7525 EVALL1, -"+;EVALPL 005554 4517 3252 005555 7523 -"-;EVALMI 005556 4524 3253 005557 7526 -"*;EVALTM 005560 4527 3254 005561 7521 -"/;EVALDV 005562 4537 3255 005563 7444 -"\;EVALRM 005564 4536 3256 005565 7532 -"&;EVALAN 005566 4552 3257 005567 7537 -"!;EVALOR;0 /END OF LIST 005570 4557 005571 0000 3258 3259 005572 0000 OPSTK, ZBLOCK 4^2 /MAXIMUM DEPTH=4 005573 0000 005574 0000 005575 0000 005576 0000 005577 0000 005600 0000 005601 0000 3260 /USE PRECEDING 0 AS TOP OF STACK 3261 /INDICATION 3262 005602 0000 EVALPD, ZBLOCK 4 /MAXIMUM PD DEPTH 005603 0000 005604 0000 005605 0000 3263 3264 3265 / LIST OF IF-TYPES 3266 3267 005606 7257 IFL1, -0521;SZA CLA^2 /EQ 005607 7500 3268 005610 6173 -1605;SNA CLA^2 /NE 005611 7520 3269 005612 7073 -0705;SPA CLA^2 /GE 005613 7620 3270 005614 7054 -0724;SPA SNA CLA^2 /GT 005615 7720 3271 005616 6354 -1424;SMA CLA^2 /LT 005617 7600 3272 005620 6373 -1405;SMA SZA CLA^2 /LE 005621 7700 3273 005622 6164 -1614;SZA CLA^4+1 /NL (SPECIAL) 005623 7201 3274 005624 6162 -1616;SNA CLA^4+1 /NN (SPECIAL) 005625 7241 3275 005626 7372 -0406;SZA CLA^4+2+1 /DF (SPECIAL') 005627 7203 3276 005630 6174 -1604;SNA CLA^4+2+1 /ND (SPECIAL') 005631 7243 3277 005632 0000 0 /END OF LIST 3278 3279 /PB 3280 /PB 3281 3282 /LOTS OF IMPORTANT TABLES AND BUFFERS 3283 3284 LNBUF1, *.+LINLIM /ONE LINE BUFFER 3285 3286 MACXL1, *.+MCARG /PLACED HERE TO ALLOW OVERRUN INTO... 3287 3288 MCDFL1, *3^MCARG+3+3+. /EXTRA 3 FOR MACRO NAME, INSURANCE 3289 3290 SYMTBL, *5^TBLSLT+. /MUST BE ADJACENT TO... 3291 3292 LNKLST, *.+LNKNUM /FOR TABLE CLEARING IN 'TBLZRO' 3293 3294 AAAEND=. /SO WE KNOW WHERE THINGS END 3295 3296 PAGE /TO PAGE BOUNDARY 3297 3298 INHNDB, *.+200 /ONE PAGE INPUT HANDLER 3299 3300 OUHNDB, *.+200 /ONE PAGE OUTPUT HANDLER 3301 3302 3303 EJECT 3304 3305 *LNBUF1 /INSERT SOME START-UP CODE 3306 3307 005633 0000 F0ENTR, .-. /CALLED FORM FIELD 1 3308 005634 1377 TAD (1001 /NON-RUNNABLE, FIELD 1 EXPENDABLE 3309 005635 3776 DCA I (7746 /SET JSW 3310 005636 1060 TAD OUTCD /GET FIRST WORD OF OUTPUT SPEC. 3311 005637 7450 SNA /IS THERE A FILE? 3312 005640 5265 JMP F0EN1 /NO. SAVES SOME WORK 3313 005641 6212 CIF 10 /YES 3314 005642 4775 JMS I (USR /GET HANDLER 3315 005643 0001 1 3316 005644 7400 OUHNDB /FOR OUTPUT 3317 005645 5323 JMP F0ENER /ERROR 3318 005646 1244 TAD .-2 /ENTRY POINT 3319 005647 3056 DCA OUHNDL 3320 005650 1060 TAD OUTCD /CONTAINS FILE LENGTH, TOO 3321 005651 6212 CIF 10 3322 005652 4775 JMS I (USR 3323 005653 0003 3 /ENTER OUTPUT 3324 005654 0061 F0EN0, OUTCD+1 /POINTER TO FILENAME 3325 /IF THERE WAS NONE, 8BALOU.TM WILL 3326 /BE THERE. OTHERWISE, THE SPECIFIED 3327 /ONE IS USED 3328 005655 0000 0 /FILLED IN BY 'ENTER' 3329 005656 5323 JMP F0ENER /ERROR OF SOME SORE 3330 005657 1060 TAD OUTCD 3331 005660 0374 AND (17 3332 005661 3060 DCA OUTCD /JUST SAVE DEVICE # FOR LATER 3333 005662 1254 TAD F0EN0 /START BLOCK 3334 005663 3773 DCA OUTBLK /SAVE 3335 005664 1255 TAD F0EN0+1 /FILE LENGTH FOR REAL 3336 005665 3772 F0EN1, DCA OUTFLM /SAVE FILE LIMIT 3337 005666 1371 TAD (7617-1 3338 005667 3015 DCA CDP /INITIALIZE REAL 'CDP' IN FIELD 0 3339 005670 6211 CDF 10 /DATA IN FIELD 1 3340 005671 1415 TAD I CDP 3341 005672 6201 CDF 0 3342 005673 0374 AND (17 /JUST WANT DEVICE #, IF ANY 3343 005674 3770 DCA CHNDEV /SET UP DEVICE FOR CHAINING 3344 005675 6211 CDF 10 3345 005676 1415 TAD I CDP 3346 005677 6201 CDF 0 3347 005700 3767 DCA CHNBLK /AND START BLOCK 3348 005701 6211 CDF 10 3349 005702 1415 TAD I CDP /FIRST REAL INPUT 3350 005703 6201 CDF 0 3351 005704 7450 SNA /IS THERE ONE? 3352 005705 5323 JMP F0ENER /NO. ERROR 3353 005706 6212 CIF 10 /YES 3354 005707 4775 JMS I (USR 3355 005710 0001 1 /FETCH HANDLER 3356 005711 7200 INHNDB /ONE PAGE 3357 005712 5323 JMP F0ENER /ERROR FETCHING 3358 005713 1311 TAD .-2 /HANDLER ENTRY POINT 3359 005714 3055 DCA INHNDL /SAVE 3360 005715 6211 CDF 10 3361 005716 1415 TAD I CDP /START BLOCK 3362 005717 6201 CDF 0 3363 005720 3766 DCA INBLK /SAVE 3364 005721 6213 CDF CIF 10 /BACK UP-STAIRS 3365 005722 5633 JMP I F0ENTR /RETURN 3366 3367 005723 4574 F0ENER, JMS I [SERROR /SYSTEM ERROR 3368 005724 0323 "S /START-UP 3369 /NO RETURN 3370 3371 005766 0406 PAGE /FORCE OUT LINKS 005767 1702 005770 1703 005771 7616 005772 0562 005773 0547 005774 0017 005775 0200 005776 7746 005777 1001 3372 /PB 3373 /PB 3374 3375 /*****************PAGE0, FIELD 0 LITERALS***************/ 3376 3377 000141 0400 FIELD 1 000142 2617 000143 3150 000144 1400 000145 1200 000146 1000 000147 0777 000150 0300 000151 4276 000152 4727 000153 1600 000154 7500 000155 3544 000156 0077 000157 0666 000160 4141 000161 4734 000162 1562 000163 7563 000164 5632 000165 7700 000166 0261 000167 0377 000170 2200 000171 7600 000172 1566 000173 0200 000174 1703 000175 7607 000176 3352 000177 6000 3378 3379 *RCSET+200 /SHOULD BE AT 3000. WILL BE 3380 /IN FIELD 0 AT THAT POINT 3381 3382 / OVERLAY SWAPPED IN TO SEEK MACRO IN LIBRARY 3383 3384 013000 7410 FNDMAC, SKP /FIRST TIME ONLY 3385 013001 5220 JMP FNDM0 /NORMAL PROCESSING HERE 3386 013002 2106 ISZ FNDML /CHANGE LINK SO CONTROL GOES 3387 /TO FNDMAC+1 AFTER THIS 3388 013003 7040 CMA 3389 013004 1363 TAD FNDBLK /POINT AT LIBRARY DIRECTORY 3390 013005 3211 DCA .+4 3391 013006 4762 FNDMP1, JMS I DSKHND /READ LIBRARY DIRECTORY 3392 /THIS USED LATER AS PTR 3393 013007 0201 201 /READ FORWARD 3394 013010 3200 FNDB 3395 013011 0000 ZZZ 3396 013012 5117 JMP FNDMER 3397 013013 4575 FNDMP2, JMS I ZSYSHN /SYSTEM HANDLER PAGE 0 LINK 3398 /THIS USED LATER AS PTR 3399 013014 4200 4200 3400 013015 3200 FNDB 3401 013016 0047 47 /LOADER AREA 3402 013017 5117 JMP FNDMER 3403 013020 3361 FNDM0, DCA FNDMT1 /INITIALIZE SLOT # 3404 013021 1377 TAD (-63 3405 013022 3302 DCA FNDMC1 /51 SLOTS TOTAL 3406 013023 1361 FNDM1, TAD FNDMT1 3407 013024 7106 CLL RTL 3408 013025 1361 TAD FNDMT1 /*5 3409 013026 1326 TAD FNDBUF /ALSO WHERE DIRECTORY IS 3410 013027 3013 DCA XR13 3411 013030 1413 TAD I XR13 3412 013031 7450 SNA /ENTRY PRESENT? 3413 013032 5246 JMP FNDM2 /NO 3414 013033 1016 TAD GATHBF /YES. COMPARE WITH GATHBF 3415 013034 7640 SZA CLA 3416 013035 5246 JMP FNDM2 /NO MATCH 3417 013036 1413 TAD I XR13 3418 013037 1017 TAD GATHBF+1 3419 013040 7640 SZA CLA 3420 013041 5246 JMP FNDM2 /NO MATCH 3421 013042 1413 TAD I XR13 3422 013043 1020 TAD GATHBF+2 3423 013044 7650 SNA CLA 3424 013045 5252 JMP FNDM3 /MATCH 3425 013046 2361 FNDM2, ISZ FNDMT1 /NEXT ENTRY 3426 013047 2302 ISZ FNDMC1 3427 013050 5223 JMP FNDM1 3428 013051 5107 JMP SWIN1 /NOT IN LIBRARY. PROCEED 3429 3430 013052 1413 FNDM3, TAD I XR13 /GET QUARTER 3431 013053 3361 DCA FNDMT1 3432 013054 7144 CMA CLL RAL 3433 013055 0361 AND FNDMT1 /STRIP OFF LOW ORDER BIT 3434 013056 7112 CLL RTR /SO ROTATED BIT WON'T GO TO BIT 0 3435 013057 1363 TAD FNDBLK /ADD TO DIRECTORY BLOCK+1 3436 013060 3327 DCA FNDBL /FOR READ 3437 013061 1361 TAD FNDMT1 3438 013062 0376 AND (3 3439 013063 7106 CLL RTL 3440 013064 7006 RTL 3441 013065 7006 RTL /QUARTER * 100 WORDS 3442 013066 3361 DCA FNDMT1 /OFFSET IN BLOCK (WDS) 3443 013067 1361 TAD FNDMT1 3444 013070 1326 TAD FNDBUF 3445 013071 3206 DCA FNDMP1 /INITIAL POINTER 3446 013072 3207 DCA FNDMP1+1 /CLEAR BYTE 3447 013073 4775 JMS LOOKUP /FORCE CREATED ENTRY 3448 013074 0440 440 /OF MACRO 3449 013075 4774 JMS IERROR /CANNOT HAVE ALREADY EXISTED! 3450 013076 1425 TAD I TBLWD1 /LOOK AT 'TYPE WORD' 3451 013077 7640 SZA CLA /ALREADY DEFINED? 3452 013100 4774 JMS IERROR /YES! 3453 013101 4773 JMS LNKCRT /CREATE LINK 3454 013102 0000 FNDMC1, ZZZ /POINTER 3455 013103 3426 DCA I TBLWD2 /SAVE LINK NUMBER 3456 013104 1302 TAD .-2 3457 013105 3213 DCA FNDMP2 /SAVE POINTER 3458 013106 3214 DCA FNDMP2+1 /CLEAR BYTE 3459 013107 3357 DCA FNDMC2 /NUMBER OF CHARS IN LINK 3460 013110 1361 TAD FNDMT1 3461 013111 7110 CLL RAR 3462 013112 1361 TAD FNDMT1 /1.5 * WD OFFSET = CHARS 3463 013113 1372 TAD (-600 3464 013114 3302 DCA FNDMC1 /# OF CHARS IN THIS BLOCK 3465 013115 5324 JMP FNDM5 /GET FIRST BLOCK 3466 3467 013116 1372 FNDM4, TAD (-600 /BLOCK COUNT 3468 013117 3302 DCA FNDMC1 3469 013120 2327 ISZ FNDBL /NEXT BLOCK 3470 013121 1326 TAD FNDBUF 3471 013122 3206 DCA FNDMP1 /RESET POINTER 3472 013123 3207 DCA FNDMP1+1 3473 013124 4762 FNDM5, JMS I DSKHND /CALL DSK: HANDLER 3474 013125 0200 200 /2 PAGE (1BLOCK) READ 3475 013126 3200 FNDBUF, FNDB 3476 013127 0000 FNDBL, ZZZ 3477 013130 5117 JMP FNDMER /ONLY WAY OUT 3478 013131 4771 FNDM6, JMS GETCHR /GET CHAR FROM BUFFER 3479 013132 3006 FNDMP1 3480 013133 6201 CDF 0 3481 013134 7450 SNA /END OF MACRO? 3482 013135 5345 JMP FNDM7 /YES 3483 013136 4770 JMS PUTCHR /NO. STORE IN LINK 3484 013137 3013 FNDMP2 3485 013140 4065 SFLD 3486 013141 2357 ISZ FNDMC2 3487 013142 2302 ISZ FNDMC1 /DONE BUFFER? 3488 013143 5331 JMP FNDM6 /NO 3489 013144 5316 JMP FNDM4 /YES 3490 3491 013145 4770 FNDM7, JMS PUTCHR /PUT 0 CHAR 3492 013146 3013 FNDMP2 3493 013147 4065 SFLD 3494 013150 2357 ISZ FNDMC2 3495 013151 4771 JMS GETCHR 3496 013152 3006 FNDMP1 3497 013153 6201 CDF 0 3498 013154 1367 TAD (400 /CHAR IS # OF ARGS 3499 013155 3425 DCA I TBLWD1 /SET TYPE WORD 3500 013156 4766 JMS LNKCHK 3501 013157 0000 FNDMC2, ZZZ 3502 013160 5111 JMP SWIN2 /PROCESS THIS MACRO 3503 3504 013161 0000 FNDMT1, 0 3505 3506 013162 0000 DSKHND, 0 /FILLED IN BY /Y PROCESSOR 3507 013163 0000 FNDBLK, 0 /FILLED IN BY /Y PROCESSOR 3508 3509 /PB 3510 /PB 3511 3512 013166 1000 PAGE 013167 0400 013170 0261 013171 0200 013172 7200 013173 1116 013174 1562 013175 1400 013176 0003 013177 7715 3513 3514 FNDB=. /IN FIELD 0 AT EXECUTION TIME 3515 3516 013200 0000 SLASHY, .-. /PROCESS LIBRARY OPTION 3517 013201 7330 CLA STL RAR /4000 3518 013202 0777 AND I (7645 /CHECK /Y 3519 013203 7650 SNA CLA 3520 013204 5600 JMP I SLASHY /NOT THERE. TREAT AS REGULAR CD 3521 013205 6202 CIF 0 3522 013206 4776 JMS I (SYSHND /WRITE SCRATCH FIRST 3523 013207 4200 4200 /2 PAGES, FIELD 0 3524 013210 2600 RCSET 3525 013211 0033 33 /MONITOR FIELD 0 AREA 3526 013212 5312 JMP SLYER 3527 013213 1775 TAD I (7617 /FIRST CD INPUT 3528 013214 7440 SZA /PRESENT? 3529 013215 5273 JMP SLY4 /YES. USE IT 3530 013216 4774 JMS I (USR /NO. GET DSK:8BALIB.ML 3531 013217 0001 1 3532 013220 0423 DEVICE DSK 013221 1300 3533 013222 2600 SLY1, RCSET /LOAD THERE 3534 013223 5312 JMP SLYER 3535 013224 1222 TAD SLY1 /ADDRESS OF HANDLER 3536 013225 3773 DCA DSKHND 3537 013226 1221 TAD SLY1-1 /DEVICE # 3538 013227 4774 SLY1A, JMS I (USR 3539 013230 0002 2 /LOOKUP 3540 013231 3317 SLY2, SLYNME /8BALIB.ML 3541 013232 0000 0 3542 013233 5261 JMP GOGO /NOT FOUND 3543 013234 1231 SLY2A, TAD SLY2 /START BLOCK 3544 013235 7450 SNA /FOR NON-FILE-STRUCTURED? 3545 013236 5261 JMP GOGO /YES. SKIP THIS STUFF 3546 013237 7001 IAC 3547 013240 3772 DCA FNDBLK /SAVE FIRST DATA BLOCK 3548 013241 6211 SLY3, CDF 10 3549 013242 1715 TAD I SLYP1 3550 013243 6201 CDF 0 3551 013244 3715 DCA I SLYP1 /MOVE FNDMAC 3552 013245 2315 ISZ SLYP1 3553 013246 2316 ISZ SLYC1 3554 013247 5241 JMP SLY3 3555 013250 1371 TAD (ISZ TBLFLG 3556 013251 3770 DCA I (SWOUT+1 /REPLACE NOP 3557 013252 6211 CDF 10 3558 013253 6202 CIF 0 3559 013254 4776 JMS I (SYSHND 3560 013255 4200 4200 /WRITE GOODIES 3561 /(HANDLER AND FNDMAC) 3562 013256 2600 RCSET 3563 013257 0046 46 /LOADER AREA 3564 013260 5312 JMP SLYER 3565 013261 6202 GOGO, CIF 0 3566 013262 4776 JMS I (SYSHND /RETRIEVE BASIC 8BAL 3567 013263 0200 200 3568 013264 2600 RCSET 3569 013265 0033 33 3570 013266 5312 JMP SLYER 3571 013267 4774 JMS I (USR 3572 013270 0005 5 /CD 3573 013271 7002 7002 /.8B RECALL CD FOR REAL INPUT 3574 013272 5600 JMP I SLASHY 3575 3576 3577 013273 4774 SLY4, JMS I (USR /FETCH HANDLER 3578 013274 0001 1 3579 013275 2600 SLY5, RCSET 3580 013276 5312 JMP SLYER 3581 013277 1275 TAD SLY5 /HANDLER ENTRY 3582 013300 3773 DCA DSKHND 3583 013301 1275 TAD SLY5 3584 013302 3222 DCA SLY1 /SET FOR LATER 3585 013303 1767 TAD I (7620 3586 013304 7450 SNA /FILE SPECIFIED? 3587 013305 5310 JMP .+3 /NO. WILL LOOK UP 8BALIB.ML 3588 013306 3231 DCA SLY2 /YES. SAVE START BLOCK 3589 013307 5234 JMP SLY2A /CONTINUE BY READING DIREC... 3590 013310 1775 TAD I (7617 /RETRIEVE DEVICE NUMBER 3591 013311 5227 JMP SLY1A /LOOKUP FILE 3592 3593 013312 4774 SLYER, JMS I (USR 3594 013313 0007 7 /SIGNAL ERROR 3595 013314 0035 "M-"0 3596 /NO RETURN 3597 3598 3599 013315 3000 SLYP1, RCSET+200 3600 013316 7600 SLYC1, -200 3601 3602 013317 7002 SLYNME, FILENAME 8BALIB.ML 013320 0114 013321 1102 013322 1514 3603 3604 /AT THIS POINT, SYS: HAS: 3605 3606 /BLOCK 33: BASIC 8BAL, 2600-3177 3607 /BLOCK 34: WILL GET BASIC 8BAL, 3200-3577 3608 /BUT, THIS AREA IS USED FOR SCRATCH LATER 3609 3610 /BLOCK 46: DSK: HANDLER; FNDMAC 3611 /BLOCK 47: D WILL GET DIRECTORY FOR LIBRARY 3612 3613 3614 /*****************NOTE!!!******************/ 3615 / REGULAR CD CALL PERFORMS 'RESET', 3616 / WHICH WILL EFFECTIVELY FORGET THE 3617 / LIBRARY HANDLER. THEREFORE, 3618 / NEITHER INPUT NOR OUTPUT HANDLER WILL 3619 / TRY TO USE LIBRARY HANDLER 3620 /******************************************/ 3621 3622 /PB 3623 /PB 3624 3625 013367 7620 PAGE 013370 0071 013371 2027 013372 3163 013373 3162 013374 0200 013375 7617 013376 7607 013377 7645 3626 3627 USR=200 3628 3629 013400 2203 START, ISZ STARC1 /INDICATE KEYBOARD START 3630 013401 6202 CIF 0 /COME HERE ON CHAIN CALL 3631 013402 4010 JMS CORS /GET CORE SIZE 3632 013403 0000 STARC1, 0 /ALWAYS SKIPPED 3633 013404 3777 DCA XCORSZ /SAVE CORE SIZE FOR LATER 3634 013405 4776 JMS I (7700 /CALL USR 3635 013406 0010 10 /AND LOCK 3636 013407 1203 TAD STARC1 /CHECK FLAG 3637 013410 7650 SNA CLA /KEYBOARD CALL? 3638 013411 5216 JMP STAR1 /YES. DON'T CALL CD 3639 013412 4775 JMS I (USR /NO. GET CD STRING 3640 013413 0005 5 3641 013414 7002 7002 /.8B ASSUMED 3642 013415 4774 JMS SLASHY /CHECK POSSIBLE LIBRARY CALL 3643 013416 4775 STAR1, JMS I (USR 3644 013417 0012 12 /INQUIRE 3645 STAR2=.+1 /GETS DEVICE CODE LATER 3646 013420 0423 DEVICE DSK /CHECK DSK 013421 1300 3647 013422 0000 0 3648 013423 5301 JMP STARER /NO DSK!! 3649 013424 1373 TAD (7600-1 3650 013425 3015 DCA CDP /POINT AT CD OUTPUT 3651 013426 1372 TAD (OUTCD-1 /IN FIELD 0 3652 013427 3010 DCA XR10 /POINT AT PLACE WHERE FIRST 3653 /OUTPUT FILE WILL END UP 3654 013430 1415 TAD I CDP 3655 013431 7440 SZA /IS THERE AN OUTPUT DEVICE? 3656 013432 5237 JMP STAR3 /YES 3657 013433 1771 TAD I (7617 /NO. FIRST INPUT (CHAIN) 3658 013434 7650 SNA CLA /HAS A CHAIN BEEN REQUESTED? 3659 013435 5266 JMP STAR5 /NO. NO FURTHER OUTPUT SETUP, 3660 /FIELD 0 ALREADY HAS RIGHT GOODIES 3661 013436 1221 TAD STAR2 /YES. DEVICE IS DSK: BY DEFAULT 3662 013437 4273 STAR3, JMS STARS1 /STORE, GET NEXT 3663 013440 7450 SNA /IS THERE A FILENAME? 3664 013441 5251 JMP STAR4 /NO. 8BALOU.TM ALREADY SET UP 3665 013442 4273 JMS STARS1 /YES. MOVE 3666 013443 4273 JMS STARS1 /FILE 3667 013444 4273 JMS STARS1 /NAME 3668 013445 7450 SNA /IS THERE AN EXTENSION? 3669 013446 1370 TAD (2001 /NO. MAKE IT .PA 3670 013447 6201 CDF 0 /PICK PROPER FIELD 3671 013450 3410 DCA I XR10 /YES. STORE EXTENSION 3672 013451 6211 STAR4, CDF 10 /BACK TO THIS FIELD 3673 013452 1367 TAD (7600+5-1 /POINT AT SECOND OUTPUT FILE 3674 013453 3015 DCA CDP 3675 013454 1373 TAD (7600-1 /AND FIRST OUTPUT FILE 3676 013455 3010 DCA XR10 3677 013456 1366 TAD (-12 3678 013457 3203 DCA STARC1 3679 013460 1415 TAD I CDP 3680 013461 3410 DCA I XR10 /MOVE UP OTHER TWO OUTPUTS 3681 013462 2203 ISZ STARC1 3682 013463 5260 JMP .-3 3683 013464 3410 DCA I XR10 /MAKE THIRD OUTPUT DISAPPEAR 3684 013465 3410 DCA I XR10 3685 013466 6203 STAR5, CDF CIF 0 3686 013467 4765 JMS F0ENTR /GO TO FIELD 0 TO DO SOME STUFF 3687 013470 4775 JMS I (USR /THEN, 3688 013471 0011 11 /KICK OUT USR 3689 013472 5764 JMP TBLZRO /AND DO SOME MORE STUFF 3690 3691 3692 013473 0000 STARS1, .-. /PULL A QUICKIE 3693 013474 6201 CDF 0 3694 013475 3410 DCA I XR10 3695 013476 6211 CDF 10 3696 013477 1415 TAD I CDP 3697 013500 5673 JMP I STARS1 3698 3699 3700 013501 4775 STARER, JMS I (USR /START UP ERROR 3701 013502 0007 7 /SIGNAL USER 3702 013503 0043 "S-"0 /WITH AN 'S' 3703 /NO RETURN 3704 3705 /PB 3706 /PB 3707 3708 013564 3600 PAGE 013565 5633 013566 7766 013567 7604 013570 2001 013571 7617 013572 0057 013573 7577 013574 3200 013575 0200 013576 7700 013577 3652 3709 3710 TBLZP1=. /WHEN YOU'RE TIGHT, YOU'RE TIGHT (AND LAZY) 3711 013600 1377 TBLZRO, TAD (-5^TBLSLT-LNKNUM /LENGTH OF AREA TO ZERO 3712 013601 3251 DCA TBLZC1 3713 013602 1376 TAD (SYMTBL-1 3714 013603 3010 DCA XR10 3715 013604 7126 STL RTL /2 3716 013605 0775 AND I (7644 /SECOND OPTION WORD (/W) 3717 013606 6201 CDF 0 3718 013607 7650 SNA CLA /SET? 3719 013610 5213 JMP .+3 /NO 3720 013611 1244 TAD TBLZGO /YES. 'CLA' TO SUPPRESS /W TYPE-OUTS 3721 013612 3774 DCA I (PUTL2 3722 013613 3410 DCA I XR10 3723 013614 2251 ISZ TBLZC1 3724 013615 5213 JMP .-2 3725 013616 6211 CDF 10 /TO GET OPTION 3726 013617 7001 IAC 3727 013620 0775 AND I (7644 /SECOND OPTION WORD (/X) 3728 013621 7640 SZA CLA /SET? 3729 013622 5244 JMP TBLZGO /YES. LEAVE WITH 8K VERSION 3730 013623 7144 CMA CLL RAL /-2 3731 013624 1252 TAD XCORSZ /FETCH SAVED CORE SIZE 3732 013625 7510 SPA />8K AVAILABLE? 3733 013626 5244 JMP TBLZGO /NO. USE 8K 3734 013627 7640 SZA CLA />12K? 3735 013630 1373 TAD (TBL16K-TBL12K /YES 3736 013631 1372 TAD (TBL12K-1 3737 013632 3012 DCA 12 3738 013633 6211 TBLZ1, CDF 10 3739 013634 1412 TAD I 12 3740 013635 7450 SNA 3741 013636 5244 JMP TBLZGO 3742 013637 3200 DCA TBLZP1 3743 013640 1412 TAD I 12 3744 013641 6201 CDF 0 3745 013642 3600 DCA I TBLZP1 3746 013643 5233 JMP TBLZ1 3747 3748 013644 7200 TBLZGO, CLA 3749 013645 6203 CDF CIF 0 3750 013646 1371 TAD (1000 3751 013647 3770 DCA I (7746 /SET JSW=1000 3752 013650 5767 JMP INLUP /START PROGRAM 3753 3754 013651 0000 TBLZC1, 0 3755 013652 0000 XCORSZ, 0 /FILLED AT 'START' 3756 3757 013653 0045 TBL12K, LNKLIM;7600; PUSHP;5177; RDCH1+1;410; INBUFP;6600 013654 7600 013655 0046 013656 5177 013657 0404 013660 0410 013661 0405 013662 6600 3758 013663 0047 PUSHST;5177 /INITIAL VALUE OF PD (FOR 'ERRLST') 013664 5177 3759 013665 0473 INBLSZ;2; INBLCT;-1400; OUTBFP;5200 013666 0002 013667 0474 013670 6400 013671 0546 013672 5200 3760 013673 0563 OUBLCT;-2200; PUSHA1;SZA CLA 013674 5600 013675 0756 013676 7640 3761 013677 0757 PUSHA1+1;PUSHA&177+5600 /JMP I PUSHA 013700 5746 3762 013701 0760 PUSHA1+2; JMS I TTERR; LCHK1;LNKEND+1000 /TAD LNKEND 013702 4572 013703 1016 013704 1044 3763 013705 0503 WRTCC1;-2200; WRTCP1;5200 013706 5600 013707 0504 013710 5200 3764 013711 0066 SF+1;CDF 20; 0 013712 6221 013713 0000 3765 3766 013714 0045 TBL16K, LNKLIM;7600; PUSHP;7577; RDCH1+1;1610; INBUFP;4200 013715 7600 013716 0046 013717 7577 013720 0404 013721 1610 013722 0405 013723 4200 3767 013724 0047 PUSHST;7577 /INITIAL VALUE OF PD (FOR 'ERRLST') 013725 7577 3768 013726 0473 INBLSZ;7; INBLCT;-5200; OUTBFP;200 013727 0007 013730 0474 013731 2600 013732 0546 013733 0200 3769 013734 0563 OUBLCT;-6000; PUSHA1;SZA CLA 013735 2000 013736 0756 013737 7640 3770 013740 0757 PUSHA1+1;PUSHA&177+5600 /JMP I PUSHA 013741 5746 3771 013742 0760 PUSHA1+2;JMS I TTERR; PUSHA+1;CDF 20;ERRL2;CDF 20 013743 4572 013744 0747 013745 6221 013746 2553 013747 6221 3772 013750 2766 POPA+2;CDF 20; LCHK1;LNKEND+1000 /TAD LNKEND 013751 6221 013752 1016 013753 1044 3773 013754 0503 WRTCC1;-6000; WRTCP1;200 013755 2000 013756 0504 013757 0200 3774 013760 0066 SF+1;CDF 30; 0 013761 6231 013762 0000 3775 3776 013767 1600 $ 013770 7746 013771 1000 013772 3652 013773 0041 013774 1730 013775 7644 013776 6134 013777 6736 AAAEND 7177 unreferenced AC 0033 CCHECK 0666 CCHK1 0703 CCHK2 0705 CCHK3 0710 CCHK4 0720 CCHKL1 5521 CCHKT1 0724 CDP 0015 CHNBLK 1702 CHNDEV 1703 CLAMQA 4141 CONV1 2447 CONV2 2451 CONV3 2452 CONV4 2453 CONV5 2462 CONV6 2475 CONVC1 2507 CONVC2 2510 CONVI1 2506 CONVL1 2511 CONVS1 2435 CONVS2 2443 CONVS3 2445 CONVT1 2505 CORE1 0037 CORLNK 0042 CORLOC 0043 CORS 0010 CRLF 4133 CSET1 2611 CSETS1 2625 CSTS1 2635 CSTS2 2640 CSX 3130 CSX1 3143 CSX2 3145 CSXT1 3147 DEC 3600 DECOP1 2535 DECOUT 2517 DLTESW 0052 DSKHND 3162 DVI 4734 DVI1 4745 DVI2 4765 EAESC 0034 EERROR 3544 ENDER1 1651 ENDER2 1650 ERR1 4310 ERRC1 4260 ERRC2 4252 ERRL1 2545 ERRL2 2553 ERRL3 2563 ERRLP1 2566 ERRLP2 4147 ERRLS1 4145 ERRLST 2536 ERROR 4276 ERRS1 4320 ERRS11 4326 ERRS12 4336 ERRS13 4346 ERRS14 4356 ERRS2 4156 ERRSC1 4357 ERRT1 4335 EVAL 4400 EVAL1 4416 EVAL2 4417 EVAL2A 4427 EVAL3 4430 EVAL4 4436 unreferenced EVAL5 4441 EVAL6 4457 EVAL7 4475 EVALAN 4552 EVALDV 4537 EVALER 4702 EVALL1 5553 EVALMI 4524 EVALOR 4557 EVALP1 4514 EVALP2 4515 EVALPD 5602 EVALPL 4517 EVALRM 4536 EVALRT 4516 EVALT1 4533 EVALT2 4544 EVALTM 4527 EVLPL1 4520 F0EN0 5654 F0EN1 5665 F0ENER 5723 F0ENTR 5633 FNDB 3200 FNDBL 3127 FNDBLK 3163 FNDBUF 3126 FNDM0 3020 FNDM1 3023 FNDM2 3046 FNDM3 3052 FNDM4 3116 FNDM5 3124 FNDM6 3131 FNDM7 3145 FNDMAC 3000 FNDMC1 3102 FNDMC2 3157 FNDMER 0117 FNDML 0106 FNDMP1 3006 FNDMP2 3013 FNDMT1 3161 GATH1 1217 GATH2 1226 GATH3 1251 GATHBF 0016 GATHBT 1253 GATHC1 1254 GATHER 1200 GATHP1 1255 GATHT1 1250 GETA10 3715 GETA11 3716 GETA12 3724 GETA13 3737 GETA14 3752 GETA2 3610 GETA3 3616 GETA4 3624 GETA5 3627 GETA6 3653 GETA6A 3656 GETA7 3667 GETA7Z 3666 GETA8 3707 GETA9 3714 GETAI1 3756 GETAI2 3757 GETARG 3603 GETC1 0213 GETC2 0236 GETC3 0254 GETCHR 0200 GETCPB 0260 GETCPP 0257 GETCT1 0256 GETL1 0610 GETL2 0631 GETL2A 0660 GETL3 0662 GETLIN 0600 GETLT1 0665 GETN1 4641 GETN2 4674 GETNC1 4701 GETNI1 4700 GETNT1 4676 GETNT2 4677 GETNUM 4634 GETPNM 2617 GOGO 3261 HTBLST 0056 IERROR 1562 IF 5000 IF1 5006 IF10 5120 IF11 5122 IF2 5016 IF3 5046 IF4 5051 IF5 5052 IF6 5063 IF7 5067 IF8 5102 IF9 5115 IFL1 5606 IFS1 5127 IFS2 5140 IFSKP 5024 IFT1 5113 INBLCT 0474 INBLK 0406 INBLSZ 0473 INBUFP 0405 INEOF 1616 INEOF2 1635 INEOF3 1653 INHNDB 7200 INHNDL 0055 INHNDP 0460 INLPC1 1615 INLUP 1600 INLUP0 1603 INLUP1 1605 INLUP2 1613 INPUT 0057 IOERR 0411 IRPBCH 4131 IRPC1 4132 IRPI1 4054 IRPP1 4126 IRPP2 4130 LCHK1 1016 LCSET 2607 LDLT1 2671 LDLT2 2702 LDLT3 2722 LDLT4 2731 LDLT5 2732 LDLTC1 2661 LDLTE 2647 LDLTI1 2736 LDLTP1 2734 LFSP1 0365 LFSPI1 0374 LFSPT1 0373 LFSUP 0352 LINBUF 0036 LINCNT 0035 LINES 0054 LINLIM 0200 LINSV1 0041 LINSV2 0042 LNBUF1 5633 LNKCHK 1000 LNKCNT 1142 LNKCRT 1116 LNKD1 1052 LNKD2 1064 LNKDC1 1115 LNKDEL 1022 LNKDT1 1112 LNKDT2 1113 LNKDT3 1114 LNKEND 0044 LNKGET 0725 LNKGP1 0745 LNKLIM 0045 LNKLST 7044 LNKNUM 0133 LNKR1 1123 LNKR2 1132 LNKRC1 1142 LNKRP1 1141 LNKS1 3350 LNKSKP 3327 LNKST1 3343 LOOKUP 1400 LUPCHR 4633 MACIN1 4204 MACIN2 4220 MACIN3 4233 MACIN4 4243 MACINP 4200 MACIP1 3512 MACIP2 4242 MACIP3 3514 MACON 0050 MACOT1 4230 MACOUT 4202 MACPOP 4252 MACX0 3400 MACX1 3404 MACX2 3404 MACX3 3443 MACX4 3502 MACXC1 3511 MACXC2 3464 MACXC3 4267 MACXL1 6033 MACXL2 5477 MACXL3 5517 MACXP1 3507 MACXS1 3760 MACXS3 4260 MATC1 2052 MATC11 2135 MATC1A 2062 MATC2 2065 MATC3 2066 MATC4 2070 MATC41 2166 MATCC3 2152 MATCH 2051 MATCP1 0030 MATCP2 2072 MATCX0 2101 MATCX1 2115 MATCX2 2145 MATCX3 2065 MATCX4 2147 MATFLD 0031 MCARG 0017 MCCRP1 1745 MCCRSM 1737 MCCRT1 1750 MCDF1 3046 MCDF10 3215 MCDF11 3231 MCDF12 3255 MCDF13 3257 MCDF14 3266 MCDF15 3276 MCDF16 3277 MCDF17 3300 MCDF18 3307 MCDF2 3047 MCDF3 3054 unreferenced MCDF4 3075 MCDF5 3113 MCDF6 3200 MCDF7 3204 MCDF8 3205 MCDF9 3213 MCDFC1 3274 MCDFC2 3325 MCDFC3 3326 MCDFI1 3205 MCDFL1 6052 MCDFP1 3323 MCDFS1 3315 MCIR2A 4026 MCIRP 4000 MCIRP1 4021 unreferenced MCIRP2 4025 MCIRP3 4042 MCIRS1 4105 MCIRS2 4115 MCLOOP 4623 MCRET 1337 MCRT1 1353 MCXALK 0037 MCXBLK 0040 MCXEC 4714 MCXS31 4271 MCXSKP 3516 MCXSP1 3542 MPCH1 2006 MPCH2 2016 MPCH3 2022 MPCH4 2033 MPCH5 2043 MPCHI1 2050 MPCHK 2000 MPCHP1 2046 MPCHP2 2047 MPCHR 0300 MPEXPD 3352 MPSC1 1367 MPSK1 1356 MPSK2 1365 MPSKIP 1355 MQ 0032 MQA 3356 MQLDVI 4727 MQLMUY 2737 MUY1 2745 MUY2 2754 OCT 3601 OCTDEC 0051 ODUMMY 5153 OPSTK 5572 OUBLCT 0563 OUHNDB 7400 OUHNDL 0056 OUTB1 0507 OUTBFP 0546 OUTBLK 0547 OUTBT1 0545 OUTBT2 0564 OUTBUF 0506 OUTCD 0060 OUTFLM 0562 OUTFSZ 1633 PAGES 0053 PAT1 5224 PAT10 5361 PAT11 5372 PAT12 5402 PAT13 5412 PAT14 5420 PAT15 5427 PAT16 5442 PAT17 5455 PAT18 5466 PAT19 3550 PAT2 5236 PAT3 5251 PAT4 5262 PAT5 5275 PAT6 5310 PAT7 5324 PAT8 5337 PAT9 5350 PATLST 5200 PDLEN 0035 POP 1256 POP1 1263 POP2 1303 POP3 1313 POPA 2764 POPC1 1325 POPE 4506 POPP1 1326 PUSH 1527 PUSH1 1534 PUSH2 1544 PUSHA 0746 PUSHA1 0756 PUSHC1 1561 PUSHP 0046 PUSHP1 1560 PUSHST 0047 PUTC1 0277 PUTC2 0307 PUTC3 0317 PUTCHR 0261 PUTCPB 0260 PUTCPP 0257 PUTCS1 0335 PUTCS2 0121 PUTCT1 0351 PUTL1 1716 PUTL2 1730 PUTLIN 1712 RCSET 2600 RDCH1 0403 RDCH2 0423 RDCH3 0440 RDCH4 0465 RDCHC1 0467 RDCHP1 0471 RDCHR 0400 RDCHT1 0470 RDLTE 2650 SCANP1 0021 SCANP2 0022 SCANP3 0023 SEPCOD 0024 SERROR 1703 SET 4600 SET1 4606 SET2 4613 SETT1 4622 SF 0065 SFLD 4065 SLASHY 3200 SLY1 3222 SLY1A 3227 SLY2 3231 SLY2A 3234 SLY3 3241 SLY4 3273 SLY5 3275 SLYC1 3316 SLYER 3312 SLYNME 3317 SLYP1 3315 SSET 3000 SSET1 3007 SSET2 3022 SSET4 3034 SSET5 3037 SSETC1 3035 SSETP1 3044 SSETT1 3012 STAR1 3416 STAR2 3421 STAR3 3437 STAR4 3451 STAR5 3466 STARC1 3403 STARER 3501 STARS1 3473 START 3400 SWIN1 0107 SWIN2 0111 SWOUT 0070 SYMTBL 6135 SYSHND 7607 TBL12K 3653 TBL16K 3714 TBLFLG 0027 TBLS1 1417 TBLS2 1452 TBLS3 1461 TBLS4 1470 TBLS5 1501 TBLS6 1502 TBLS7 1507 TBLSC1 1511 TBLSK1 1416 TBLSLT 0133 TBLST1 1512 TBLST2 1513 TBLSUB 1514 TBLWD1 0025 TBLWD2 0026 TBLZ1 3633 TBLZC1 3651 TBLZGO 3644 TBLZP1 3600 TBLZRO 3600 TERROR 1566 TRNS1 1164 TRNSC1 1112 TRNSFR 1154 TRNSP1 1113 TTERR 0172 TYO 1326 USR 0200 WERROR 3150 WRTCC1 0503 WRTCHR 0475 WRTCP1 0504 XCORSZ 3652 XCSST1 2404 XCSST2 2412 XCSSTP 2421 XPN11A 2277 XPN11Z 2303 XPND 0130 XPND1 2200 XPND10 2253 XPND11 2273 XPND12 2304 XPND13 2335 XPND14 2340 XPND2 2205 XPND20 2400 XPND3 2206 XPND3A 2224 XPND4 2225 unreferenced XPND5 2227 XPND6 2231 XPND6A 2245 XPND7 2247 XPND8 2251 XPNDC1 2370 XPNDI1 2364 XPNDI2 2365 XPNDS1 2344 XPNDSV 2363 XPNDT1 2366 XPNDT2 2367 XR10 0010 XR11 0011 XR12 0012 XR13 0013 XR14 0014 XSET 2423 XSSET 2402 unreferenced XSTART 0005 ZSYSHN 0175 ZZZ 0000