1 LISP=5000 2 / 3 / These defines make the binary output of the 4 / assembler match the original binary tape. 5 / 6 LISTIN=3 7 PROG=7 8 EVER2=40 9 EVEVAL=41 10 FREE=42 11 EVFREE=42 12 EVBEG=43 13 EVLEN=44 14 EVOUT=45 15 EVIN=46 16 PUSH=47 17 POP=50 18 EV=51 19 TEST=52 20 CVBIN=53 21 CVDEC=54 22 CNLIST=55 23 LILIST=55 24 EQLIST=55 25 EVTABL=55 26 ACLST1=55 27 ACLST2=56 28 SHLIST=55 29 30 EVAL=JMS I EVEVAL 31 32 HLT=JMS I EVER2 33 34 MQA=7501 35 MQL=7421 36 MUL=7405 37 DIV=7407 38 SHL=7413 39 SL1=7541 40 LSR=7417 41 42 ICF=6342 43 EFC=6324 44 45 *LISP-0200 46 EJECT/INIT ROUTINE 100-120 47 /THIS ROUTINE IS CALLED AT THE BEGINNING OF PROGRAM EXECUTION. 48 /IT INITIALIZES THE LIST STORAGE, ETC. 49 04600 0000 AINIT, 0 50 04601 7200 CLA 51 04602 1600 TAD I AINIT /SET PARAMETERS 52 04603 3714 DCA I AIPNT 53 04604 2200 ISZ AINIT 54 04605 2314 ISZ AIPNT 55 04606 2312 ISZ AICNTR 56 04607 5202 JMP .-5 57 04610 7240 STA 58 04611 1600 TAD I AINIT /GET PD LIST SIZE 59 04612 2200 ISZ AINIT 60 04613 1325 TAD FAINIT 61 04614 3727 DCA I AIPTR 62 04615 1727 TAD I AIPTR 63 04616 7041 CIA 64 04617 3730 DCA I AIMIN 65 04620 7240 STA 66 04621 1730 TAD I AIMIN 67 04622 3731 DCA I AIMIN2 68 04623 7240 STA /SET SUBLOC 69 04624 1200 TAD AINIT 70 04625 3726 DCA I AILOC 71 04626 1600 TAD I AINIT /SKIP TO END 72 04627 7450 SNA 73 04630 5235 JMP .+5 74 04631 7041 CIA 75 04632 3600 DCA I AINIT 76 04633 2200 ISZ AINIT 77 04634 5226 JMP .-6 78 04635 3715 DCA I AIWRK /CLEAR TABLE OF WORKING LOCATIONS 79 04636 2315 ISZ AIWRK 80 04637 2316 ISZ AIREF 81 04640 5235 JMP .-3 82 04641 1311 TAD AIEVAL /ADJUST VALUES 83 04642 3041 DCA EVEVAL 84 04643 1313 TAD AIERR 85 04644 3040 DCA EVER2 86 04645 1317 TAD AIPUSH /SET MACH LINKS 87 04646 3047 DCA PUSH 88 04647 1320 TAD AIPOP 89 04650 3050 DCA POP 90 04651 1321 TAD AIEV 91 04652 3051 DCA EV 92 04653 1322 TAD AITEST 93 04654 3052 DCA TEST 94 04655 1323 TAD AIDECB 95 04656 3053 DCA CVBIN 96 04657 1324 TAD AIBIND 97 04660 3054 DCA CVDEC 98 04661 1043 TAD EVBEG /IF PD LIST OVERLAPS STORAGE AREA, ADJUST 99 04662 7041 CIA / STORAGE SIZE. 100 04663 1044 TAD EVLEN 101 04664 1727 TAD I AIPTR 102 04665 7001 IAC 103 04666 7500 SMA 104 04667 5273 JMP .+4 105 04670 7041 CIA 106 04671 1044 TAD EVLEN 107 04672 3044 DCA EVLEN 108 04673 7200 CLA 109 04674 1044 TAD EVLEN /SET ABS VAL TO NEXT LOWEST EVEN VAL IF NECESSARY. 110 04675 7041 CIA 111 04676 7010 RAR 112 04677 7104 CLL RAL 113 04700 7041 CIA 114 04701 3044 DCA EVLEN 115 04702 1043 TAD EVBEG /SET VAL TO NEXT EVEN LOCATION IF NECESSARY. 116 04703 7010 RAR 117 04704 7430 SZL 118 04705 7001 IAC 119 04706 7104 CLL RAL 120 04707 3043 DCA EVBEG 121 04710 5600 JMP I AINIT 122 04711 5200 AIEVAL, LEVAL 123 04712 7774 AICNTR, -4 124 04713 7536 AIERR, ERR 125 04714 0043 AIPNT, EVBEG 126 04715 5562 AIWRK, WORK 127 04716 7762 AIREF, WORK-ENDWRK 128 04717 6521 AIPUSH, LPUSH 129 04720 6536 AIPOP, LPOP 130 04721 5207 AIEV, EVAL2 131 04722 6327 AITEST, ATEST 132 04723 7110 AIDECB, DECBIN 133 04724 7265 AIBIND, BINDEC 134 04725 5000 FAINIT, ENDINT 135 04726 5262 AILOC, EVLOC 136 04727 6561 AIPTR, STPTR 137 04730 6562 AIMIN, STMIN 138 04731 6677 AIMIN2,COMIN 139 PAGE 140 ENDINT=. 141 /Commented out by VRS: *.-1 142 EJECT PAGE/100-140 143 POP1=POP 144 PUSH1=PUSH 145 05000 5223 RET1, EVRET 146 EV1=EV 147 TEST1=TEST 148 /LISTIN2 ROUTINE 149 /INPUTS A LIST AND RETURNS A REFERENCE TO IT. 150 ALSTIN, 151 05001 4452 JMS I LITEST /REALLY? 152 05002 5600 JMP I LIRET /NO 153 05003 4260 JMS INCHR /READ A CHAR INTO INBUFF 154 05004 4206 JMS INLIST /GET A LIST OR AN ATOM 155 05005 5600 JMP I LIRET /RETURN 156 LIRET=RET1 157 LITEST=TEST1 158 05006 0000 INLIST, 0 159 05007 4447 JMS I INPUSH 160 05010 5006 INLIST 161 05011 4447 JMS I INPUSH 162 05012 0055 LILIST 163 05013 4447 JMS I INPUSH 164 05014 5122 LILAST 165 05015 1325 TAD INBUFF 166 05016 1327 TAD INMCL /-')' 167 05017 7450 SNA 168 05020 4440 HLT /')' CANNOT OCCUR HERE 169 05021 1333 TAD INDIF /')'-'(' 170 05022 7640 SZA CLA 171 05023 5247 JMP INAT /READ IN AN ATOM 172 05024 1340 TAD LIALST /A(LILIST) 173 05025 3322 DCA LILAST / INTO LILAST 174 05026 4260 INBACK, JMS INCHR /READ A CHAR INTO INBUFF 175 05027 3722 DCA I LILAST /NIL INTO L(LILAST) 176 05030 1325 TAD INBUFF 177 05031 1327 TAD INMCL /-')' 178 05032 7650 SNA CLA 179 05033 5250 JMP INRET /RETURN 180 05034 4735 JMS I INEXTR /EXTRACT 181 05035 3336 DCA INCELL / INTO CELL 182 05036 1336 TAD INCELL /A(CELL+1) INTO L(LAST) 183 05037 7001 IAC 184 05040 3722 DCA I LILAST 185 05041 1336 TAD INCELL /A(CELL) INTO LAST 186 05042 3322 DCA LILAST 187 05043 4206 JMS INLIST /GET A LIST 188 05044 3722 DCA I LILAST / INTO L(INLAST) 189 05045 2322 ISZ LILAST /INLAST=INLAST+1 190 05046 5226 JMP INBACK 191 05047 4723 INAT, JMS I INAM /GET AN ATOM INTO LILIST 192 05050 1055 INRET, TAD LILIST 193 05051 4450 JMS I INPOP 194 05052 5122 LILAST 195 05053 4450 JMS I INPOP 196 05054 0055 LILIST 197 05055 4450 JMS I INPOP 198 05056 5006 INLIST 199 05057 5606 JMP I INLIST 200 05060 0000 INCHR, 0 /GET A CHARACTER 201 05061 1326 TAD INBUF2 /SHIFT BUFFER 202 05062 3325 DCA INBUFF 203 05063 3326 DCA INBUF2 204 05064 1325 TAD INBUFF /BUFFER EMPTY? 205 05065 7640 SZA CLA 206 05066 5307 JMP INARND 207 05067 4446 JMS I EVIN 208 05070 3325 DCA INBUFF 209 05071 1325 TAD INBUFF 210 05072 1332 TAD INMQUT /-"'" 211 05073 7640 SZA CLA 212 05074 5300 JMP .+4 213 05075 4446 JMS I EVIN 214 05076 1341 TAD IN4000 215 05077 3325 DCA INBUFF 216 05100 1325 TAD INBUFF 217 05101 4724 JMS I INQCTL /CONTROL? 218 05102 5307 JMP INARND /NO 219 05103 1325 TAD INBUFF /YES: SET BUFF2 TO BUFF 220 05104 3326 DCA INBUF2 221 05105 1331 TAD INSP /SET BUFF TO SPACE 222 05106 3325 DCA INBUFF 223 05107 1325 INARND, TAD INBUFF /PRES CHAR = ' '? 224 05110 1330 TAD INMSP /-' ' 225 05111 7640 SZA CLA 226 05112 5317 JMP INZIP /NO 227 05113 1337 TAD INLCHR/YES: LAST CHAR = CONTROL ( '(',')',' ' )? 228 05114 4724 JMS I INQCTL /CONTROL? 229 05115 5317 JMP INZIP /NO 230 05116 5261 JMP INCHR+1 231 05117 1325 INZIP, TAD INBUFF /LAST CHAR = PRES CHAR 232 05120 3337 DCA INLCHR 233 05121 5660 JMP I INCHR 234 05122 0000 LILAST, 0 235 05123 5437 INAM, INATOM 236 05124 5515 INQCTL, INCTLQ 237 05125 0000 INBUFF, 0 238 05126 0000 INBUF2, 0 239 05127 7727 INMCL, -51 240 05130 7740 INMSP, -40 241 05131 0040 INSP, 40 242 05132 7731 INMQUT, -47 243 05133 0001 INDIF, 51-50 244 05134 0010 INDIF2, 50-40 245 05135 5543 INEXTR, XTRACT 246 05136 0000 INCELL, 0 247 05137 0040 INLCHR, 40 248 05140 0055 LIALST, LILIST 249 05141 4000 IN4000, 4000 250 INPUSH=PUSH1 251 INPOP=POP1 252 /NOT ROUTINE 253 /IF ARG VAL=0 THEN RETURNS 1; ELSE RETURNS 0. 254 ANOT, 255 05142 4451 JMS I NTEV /GET AN ARG 256 05143 4452 JMS I NTTEST /REALLY? 257 05144 5600 JMP I NTRET /NO 258 05145 7650 SNA CLA /VALUE T? 259 05146 7001 IAC /NO: RETURN T 260 05147 5600 JMP I NTRET /ELSE RETURN F 261 NTEV=EV 262 NTTEST=TEST 263 NTRET=RET1 264 /ENTRY ROUTINE 265 /USED IN CONJUNCTION WITH QUOTE. ENTERS THE ROUTINE INDICATED 266 / BY THE CONTENTS OF THE CONTENTS OF THE CELL FOLLOWING 267 / THE CALL ON 'ENTRY'. 268 AENTRY, 269 05150 4451 JMS I EV 270 05151 3366 DCA ENSAV 271 05152 2764 ISZ I ENEVAL 272 05153 1764 TAD I ENEVAL 273 05154 3365 DCA ENLOC 274 05155 1366 TAD ENSAV 275 05156 3765 DCA I ENLOC 276 05157 7240 STA 277 05160 1764 TAD I ENEVAL 278 05161 3764 DCA I ENEVAL 279 05162 4451 JMS I EV 280 05163 5600 JMP I ENRET 281 05164 5200 ENEVAL, LEVAL 282 05165 0000 ENLOC, 0 283 05166 0000 ENSAV, 0 284 ENRET=RET1 285 PAGE /Added by VRS 286 EJECT PAGE/100-160 287 EV2=EV 288 PUSH2=PUSH 289 POP2=POP 290 /EVAL ROUTINE 291 /CONTROLLING SUBROUTINE WHICH GOVERNS THE LIST PROCESSING 292 / FUNCTIONS 293 05200 0000 LEVAL,0 294 05201 7240 STA 295 05202 1200 TAD LEVAL 296 05203 3200 DCA LEVAL 297 05204 4207 JMS EVAL2 298 05205 2200 ISZ LEVAL 299 05206 5600 JMP I LEVAL 300 /EVAL2 ROUTINE 301 /ACTUALLY MAIN ROUTINE. THIS DOES THE ACTUAL CALLING, ETC.. 302 05207 0000 EVAL2,0 303 05210 4447 JMS I EVPUSH 304 05211 5207 EVAL2 305 05212 2200 ISZ LEVAL 306 05213 4303 JMS EVPRIM 307 05214 5231 JMP EVSTAN 308 05215 1600 TAD I LEVAL 309 05216 1260 TAD EVTAB 310 05217 3266 DCA EVTMP 311 05220 1666 TAD I EVTMP 312 05221 3266 DCA EVTMP 313 05222 5666 JMP I EVTMP 314 05223 4450 EVRET, JMS I EVPOP 315 05224 5207 EVAL2 316 05225 5607 JMP I EVAL2 317 05226 1200 EVERR, TAD LEVAL 318 05227 4440 HLT 319 05230 5223 JMP EVRET 320 05231 4267 EVSTAN, JMS EVFUN 321 05232 5253 JMP EVON 322 05233 1200 TAD LEVAL 323 05234 3261 DCA EVSAVE 324 05235 1600 TAD I LEVAL 325 05236 3200 DCA LEVAL 326 05237 5663 JMP I EVENT /ENTER: GETS ARGUMENTS, PUSHES ARG LOCS. 327 05240 4447 EVR1, JMS I EVPUSH /PUSH RETURN-TO-MAIN 328 05241 5261 EVSAVE 329 05242 4452 JMS I EVTEST /ARE WE REALLY EXECUTING? 330 05243 7410 SKP /NO 331 05244 4207 JMS EVAL2 /EVALUATE THE FUNCTION 332 05245 4450 JMS I EVPOP /POP RETURN-TO-MAIN 333 05246 5200 LEVAL 334 05247 3265 DCA EVPTR /SAVE THE VALUE 335 05250 5664 JMP I EVEXIT /EXIT: POPS ARG LOCS 336 05251 1265 EVR2, TAD EVPTR 337 05252 5223 JMP EVRET 338 05253 1600 EVON, TAD I LEVAL 339 05254 3266 DCA EVTMP 340 05255 1666 TAD I EVTMP 341 05256 5223 JMP EVRET 342 05257 7740 EVAND1, 7740 343 05260 6601 EVTAB, TAB 344 05261 0000 EVSAVE, 0 345 05262 0000 EVLOC, 0/SET BY INIT 346 05263 6000 EVENT, AENTER 347 05264 6103 EVEXIT, AEXIT 348 05265 0000 EVPTR,0 349 05266 0000 EVTMP, 0 350 EVPUSH=PUSH2 351 EVPOP=POP2 352 EVTEST=TEST 353 /SKIP-IF-FUNCTION SUBROUTINE 354 05267 0000 EVFUN, 0 355 05270 1262 TAD EVLOC 356 05271 3265 DCA EVPTR 357 05272 2265 ISZ EVPTR 358 05273 1665 TAD I EVPTR 359 05274 7450 SNA 360 05275 5667 JMP I EVFUN 361 05276 1600 TAD I LEVAL 362 05277 7640 SZA CLA 363 05300 5272 JMP .-6 364 05301 2267 ISZ EVFUN 365 05302 5667 JMP I EVFUN 366 /SKIP-IF-PRIMITIVE SUBROUTINE 367 05303 0000 EVPRIM, 0 368 05304 1600 TAD I LEVAL 369 05305 0257 AND EVAND1 370 05306 7640 SZA CLA 371 05307 5703 JMP I EVPRIM 372 05310 2303 ISZ EVPRIM 373 05311 5703 JMP I EVPRIM 374 /TL ROUTINE 375 /RETURNS THE RIGHT POINTER OF THE CELL POINTED TO BY THE ARG 376 ATL, 377 05312 4451 JMS I TLEV /GET ARG 378 05313 4452 JMS I TLTEST 379 05314 5223 JMP EVRET 380 05315 7010 RAR 381 05316 7420 SNL 382 05317 7200 CLA /RETURN 0 IF IT POINTS TO AN ATOM 383 05320 7104 CLL RAL 384 05321 7450 SNA 385 05322 5223 JMP EVRET 386 05323 7001 IAC 387 05324 3331 DCA TLTMP 388 05325 1731 TAD I TLTMP 389 05326 7010 RAR 390 05327 7124 CLL CML RAL 391 05330 5223 JMP EVRET 392 05331 0000 TLTMP, 0 393 TLTEST=EVTEST 394 TLEV=EV2 395 /ATOM ROUTINE 396 /RETURNS +1 IF THE ARGUMENT POINTS TO AN ATOM OR IS NULL. 397 /RETURNS 0 OTHERWISE. 398 AATOM, 399 05332 4451 JMS I AAEV /GET ARG 400 05333 4452 JMS I AATEST 401 05334 5223 JMP EVRET 402 05335 7110 CLL RAR /SEE IF NULL 403 05336 7450 SNA 404 05337 7100 CLL /YES 405 05340 7220 CML CLA 406 05341 7004 RAL 407 05342 5223 JMP EVRET 408 AATEST=EVTEST 409 AAEV=EV2 410 /GO ROUTINE 411 /TRANSFERS CONTROL TO SPECIFIED LOCATION. 412 AGO, 413 05343 2200 ISZ LEVAL/INCREMENT POINTER 414 05344 4267 JMS EVFUN/FUNCTION? 415 05345 7410 SKP /NO 416 05346 5351 JMP .+3/YES 417 05347 4303 JMS EVPRIM/PRIMITIVE? 418 05350 5357 JMP .+7/NO 419 05351 7240 STA /YES 420 05352 1200 TAD LEVAL 421 05353 3200 DCA LEVAL 422 05354 4207 JMS EVAL2 423 05355 3765 DCA I GOVAL 424 05356 5343 JMP AGO 425 05357 4452 JMS I TEST/REALLY? 426 05360 5223 JMP EVRET/NO 427 05361 7240 STA /YES;RESET POINTER 428 05362 1600 TAD I LEVAL 429 05363 3200 DCA LEVAL 430 05364 5223 JMP EVRET 431 05365 7512 GOVAL, BGVAL 432 /ENTER PATCH 433 05366 4303 AEPAT, JMS EVPRIM /PRIMITIVE? 434 05367 7410 SKP /NO 435 05370 5774 JMP I AEGO /YES 436 05371 4267 JMS EVFUN /FUNCTION? 437 05372 1600 TAD I LEVAL /NO 438 05373 5774 JMP I AEGO 439 05374 6033 AEGO, AEPATB 440 PAGE /Added by VRS 441 EJECT PAGE/100-180 442 EV3=EV 443 POP3=POP 444 PUSH3=PUSH 445 05400 5223 RET3, EVRET 446 /CONS ROUTINE 447 /FORMS A NEW CELL WHOSE DOWN POINTER POINTS TO THE FIRST 448 /PARAMETER, AND WHOSE RIGHT POINTER POINTS TO THE SECOND 449 /PARAMETER. THE SECOND PARAMETER MUST BE ZERO OR A LIST 450 /REFERENCE (1 IN BIT 11). 451 ACONS, 452 05401 4447 JMS I ACPUSH /RECURSIVE SELF-PROTECTION 453 05402 0055 ACLST1 454 05403 4451 JMS I ACEV /GET ARGUMENT 455 05404 3055 DCA ACLST1 456 05405 4451 JMS I ACEV /GET 2ND ARG 457 05406 3056 DCA ACLST2 /ARGUMENT PROTECTION 458 05407 4636 JMS I ACTEST 459 05410 5230 JMP ACEXIT 460 05411 4635 JMS I ACXTR 461 05412 3233 DCA ACVAL 462 05413 1055 TAD ACLST1 463 05414 3633 DCA I ACVAL 464 05415 2233 ISZ ACVAL 465 05416 1056 TAD ACLST2 466 05417 7450 SNA 467 05420 5225 JMP ACOK 468 05421 7010 RAR 469 05422 7420 SNL 470 05423 4440 HLT /INVALID ARGUMENT 471 05424 7004 RAL 472 05425 3633 ACOK, DCA I ACVAL 473 05426 3056 DCA ACLST2 474 05427 1233 TAD ACVAL 475 05430 4450 ACEXIT, JMS I ACPOP 476 05431 0055 ACLST1 477 05432 5600 JMP I ACRET 478 05433 0000 ACVAL, 0 479 ACRET=RET3 480 05434 0000 ACTMP, 0 481 05435 5543 ACXTR, XTRACT 482 05436 6327 ACTEST, ATEST 483 ACPUSH=PUSH3 484 ACPOP=POP3 485 ACEV=EV3 486 /INATOM ROUTINE 487 05437 0000 INATOM, 0 488 05440 1330 TAD LILLST /SET BLD TO A(LILIST) 489 05441 3331 DCA INBLD 490 05442 3731 INEXEL, DCA I INBLD /SET L(BLD) TO NIL 491 05443 4301 JMS INCTL /SKIP IF BUFF NOT ' ', ERROR EXIT IF '(' OR ')' 492 05444 5274 JMP INOUT /RETURN 493 05445 7421 MQL /SET MQ 494 05446 1740 TAD I INLBUF 495 05447 7413 SHL 496 05450 0005 5 497 05451 3332 DCA INSAVE /STORE SHIFTED CHAR IN INSAVE 498 05452 4741 JMS I INCHRL /GET ANOTHER 499 05453 4301 JMS INCTL /CONTROL? 500 05454 5262 JMP INAR2 /YES: SKIP NEXT PART 501 05455 1740 TAD I INLBUF /GET CHAR 502 05456 0333 AND IN77 /MASK OFF 503 05457 1332 TAD INSAVE /ADD INSAVE 504 05460 3332 DCA INSAVE /STORE 505 05461 4741 JMS I INCHRL /GET ANOTHER 506 05462 4343 INAR2, JMS XTRACT /EXTRACT 507 05463 3342 DCA INCEL2 / INTO INCELL 508 05464 1342 TAD INCEL2 /INCELL TO L(INBLD) 509 05465 3731 DCA I INBLD 510 05466 1342 TAD INCEL2 /INCELL+1 INTO INBLD 511 05467 7001 IAC 512 05470 3331 DCA INBLD 513 05471 1332 TAD INSAVE /CHARS INTO L(CELL) 514 05472 3742 DCA I INCEL2 515 05473 5242 JMP INEXEL 516 05474 1455 INOUT, TAD I LILIST /IS IT 0? 517 05475 1334 TAD INM0 518 05476 7650 SNA CLA 519 05477 3055 DCA LILIST/YES: RETURN NIL 520 05500 5637 JMP I INATOM 521 05501 0000 INCTL, 0 522 05502 1740 TAD I INLBUF 523 05503 1735 TAD I INLMCL /-')' 524 05504 7450 SNA 525 05505 4440 HLT 526 05506 1736 TAD I INLDIF /')'-'(' 527 05507 7450 SNA 528 05510 4440 HLT 529 05511 1737 TAD I INLDF2 /'('-' ' 530 05512 7640 SZA CLA 531 05513 2301 ISZ INCTL 532 05514 5701 JMP I INCTL 533 05515 0000 INCTLQ, 0 /SKIP IF CONTROL 534 05516 1735 TAD I INLMCL /-')' 535 05517 7450 SNA 536 05520 2315 ISZ INCTLQ 537 05521 1736 TAD I INLDIF /')'-'(' 538 05522 7450 SNA 539 05523 2315 ISZ INCTLQ 540 05524 1737 TAD I INLDF2 /'('-' ' 541 05525 7650 SNA CLA 542 05526 2315 ISZ INCTLQ 543 05527 5715 JMP I INCTLQ 544 05530 0055 LILLST, LILIST 545 05531 0000 INBLD, 0 546 05532 0000 INSAVE, 0 547 05533 0077 IN77, 77 548 05534 2000 INM0, -6000 549 05535 5127 INLMCL, INMCL 550 05536 5133 INLDIF, INDIF 551 05537 5134 INLDF2, INDIF2 552 05540 5125 INLBUF, INBUFF 553 05541 5060 INCHRL, INCHR 554 05542 0000 INCEL2, 0 555 /XTRACT ROUTINE 556 /EXTRACTS A CELL FROM THE FREE LIST AND RETURNS THE ADDRESS OF 557 /THIS CELL. HD & TL OF THE CELL ARE SET TO NIL. 558 05543 0000 XTRACT, 0 559 05544 1042 TAD FREE 560 05545 7450 SNA 561 05546 5356 JMP XTARND 562 05547 3360 DCA XTVAL 563 05550 1442 TAD I FREE 564 05551 3042 DCA FREE 565 05552 3760 DCA I XTVAL/SET TL(CELL) TO NIL. (HD(CELL) ALREADY SET TO NIL) 566 05553 7240 STA 567 05554 1360 TAD XTVAL 568 05555 5743 JMP I XTRACT 569 05556 4761 XTARND, JMS I XTCOL 570 05557 5344 JMP XTRACT+1 571 05560 0000 XTVAL, 0 572 05561 5601 XTCOL, COLECT 573 574 /WORK LOCATIONS FOR ENTER/EXIT 575 05562 0000 WORK, 0 576 PAGE 577 *.-1 578 ENDWRK=.+1 579 PAGE /Added by VRS 580 EJECT PAGE/100-200 581 POP4=POP 582 PUSH4=PUSH 583 /GARBAGE COLLECTOR 584 /CALLED WHEN FREE STRING EXHAUSTED 585 05600 0000 COLN, 0/NUMBER OF COLLECTIONS PERFORMED. 586 05601 0000 COLECT, 0 587 05602 2200 ISZ COLN /INCREMENT NUMBER OF COLLECTIONS 588 05603 7000 NOP 589 /PASS 1--SET 11TH BIT OF POINTERS TO 1 590 05604 1044 TAD EVLEN 591 05605 3370 DCA COCNT 592 05606 1043 TAD EVBEG 593 05607 7001 IAC 594 05610 3371 DCA CONDX 595 05611 1771 COLADD, TAD I CONDX 596 05612 7010 RAR 597 05613 7124 CLL CML RAL 598 05614 3771 DCA I CONDX 599 05615 2371 ISZ CONDX 600 05616 2371 ISZ CONDX 601 05617 2370 ISZ COCNT 602 05620 2370 ISZ COCNT 603 05621 5211 JMP COLADD 604 /PASS II--UNMARK ALL CELLS IN USE 605 05622 1372 TAD CODTAB 606 05623 3375 DCA COAUTO 607 05624 1775 COLOOP, TAD I COAUTO 608 05625 2375 ISZ COAUTO 609 05626 7040 CMA 610 05627 7450 SNA 611 05630 5776 JMP I COLLON /CHECK THE PUSH DOWN LIST 612 05631 7040 CMA 613 05632 3234 DCA .+2 614 05633 4301 JMS COMAIN 615 05634 0000 0 616 05635 5224 JMP COLOOP 617 /PASS III--COLLECT ALL CELLS NOT IN USE 618 05636 1044 COLNXT, TAD EVLEN 619 05637 3370 DCA COCNT 620 05640 1043 TAD EVBEG 621 05641 7001 IAC 622 05642 3371 DCA CONDX 623 05643 1771 COLZOT, TAD I CONDX 624 05644 7010 RAR 625 05645 7620 SNL CLA 626 05646 5267 JMP COLEND /IN USE--DO NOT FREE 627 05647 1042 TAD EVFREE 628 05650 7640 SZA CLA 629 05651 5257 JMP COLARND /NOT FIRST PASS 630 05652 1371 TAD CONDX /FIRST PASS 631 05653 3042 DCA EVFREE 632 05654 1042 TAD EVFREE 633 05655 3373 DCA COLAST 634 05656 5267 JMP COLEND 635 05657 1371 COLARND, TAD CONDX 636 05660 3773 DCA I COLAST 637 05661 1773 TAD I COLAST 638 05662 3373 DCA COLAST 639 05663 7240 STA /SET HD OF COLLECTED CELL TO NIL. 640 05664 1371 TAD CONDX 641 05665 3374 DCA COI 642 05666 3774 DCA I COI 643 05667 2371 COLEND, ISZ CONDX 644 05670 2371 ISZ CONDX 645 05671 2370 ISZ COCNT 646 05672 2370 ISZ COCNT 647 05673 5243 JMP COLZOT 648 05674 3773 DCA I COLAST 649 05675 1042 TAD EVFREE 650 05676 7650 SNA CLA 651 05677 4440 HLT /NO MORE STORAGE AREA AVAILABLE--ENLARGE AREA 652 05700 5601 JMP I COLECT 653 /COMAIN ROUTINE--RECURSIVE 654 /UNMARK A LIST OR AN ATOM 655 05701 0000 COMAIN,0 656 /ENTER LINKAGES 657 05702 4447 JMS I COPUSH /SAVE PARAMETER 658 05703 5774 COI 659 05704 1701 TAD I COMAIN 660 05705 3374 DCA COI 661 05706 2301 ISZ COMAIN 662 05707 4447 JMS I COPUSH /SAVE RETURN ADDRESSES 663 05710 5701 COMAIN 664 05711 1374 TAD COI /SEE IF ARGUMENT IS IN RANGE 665 05712 4767 JMS I COGOOD 666 05713 5350 JMP CORET /NOT IN RANGE; EXIT 667 05714 1374 COLAHA, TAD COI /CHECK IF NULL 668 05715 7110 CLL RAR 669 05716 7450 SNA 670 05717 5350 JMP CORET 671 05720 7420 SNL /CHECK IF ATOM 672 05721 5340 JMP COATOM 673 05722 7104 CLL RAL /REMOVE LIST INDICATOR 674 05723 4355 JMS COCOMP 675 05724 3374 DCA COI 676 05725 1774 TAD I COI 677 05726 3330 DCA .+2 678 05727 4301 JMS COMAIN 679 05730 0000 0 680 05731 2374 ISZ COI /SET COI TO POINT TO TL 681 05732 1774 TAD I COI 682 05733 7110 CLL RAR 683 05734 7120 CLL CML 684 05735 7004 RAL 685 05736 3374 DCA COI 686 05737 5314 JMP COLAHA 687 05740 7004 COATOM, RAL 688 05741 7450 SNA 689 05742 5350 JMP CORET 690 05743 4355 JMS COCOMP 691 05744 7001 IAC 692 05745 3371 DCA CONDX 693 05746 1771 TAD I CONDX 694 05747 5341 JMP COATOM+1 695 05750 4450 CORET, JMS I COPOP /POP RETURN ADDRESSES AND PARAMETER VALUE 696 05751 5701 COMAIN 697 05752 4450 JMS I COPOP 698 05753 5774 COI 699 05754 5701 JMP I COMAIN 700 /COCOMP ROUTINE 701 /SETS THE USE INDICATOR OFF FOR THE CELL WHOSE ADDRESS IS IN 702 / THE AC. 703 05755 0000 COCOMP, 0 704 05756 7001 IAC 705 05757 3370 DCA COCNT 706 05760 1770 TAD I COCNT 707 05761 7010 RAR 708 05762 7104 CLL RAL 709 05763 3770 DCA I COCNT 710 05764 7040 CMA 711 05765 1370 TAD COCNT 712 05766 5755 JMP I COCOMP 713 /DECLARATIVES 714 05767 6662 COGOOD, CORANG 715 05770 0000 COCNT, 0 716 05771 0000 CONDX, 0 717 05772 0055 CODTAB, EVTABL 718 05773 0000 COLAST, 0 719 05774 0000 COI, 0 720 05775 0000 COAUTO, 0 721 COPUSH=PUSH4 722 COPOP=POP4 723 05776 6641 COLLON, COLON 724 PAGE /Added by VRS 725 EJECT PAGE/100-220 726 EV5=EV 727 POP5=POP 728 PUSH5=PUSH 729 /ENTER SUBROUTINE 730 /SETS UP LINKAGES FOR SUBROUTINES 731 /FORM IS: 732 / F1 733 / F2 734 / . 735 / . 736 / . 737 / END 738 /WHERE FI ARE FORMAL VARIABLE LOCATIONS WHICH MUST APPEAR IN 739 / THE LIST REFERENCE TABLE. 740 /STACK USAGE: T1,A1,...,TN,AN,F1,F2,...,FN WHERE AI=0 IF 741 / ARGI IN CALLING CODE IS NOT SIMPLE, AI=ADDRESS OF ARGI 742 / OTHERWISE. 743 AENTER, 744 06000 4447 JMS I AEPUSH /RECURSIVE SELF-PROTECTION 745 06001 6075 AEPNT 746 06002 4447 JMS I AEPUSH / " 747 06003 6027 AEREF 748 06004 4447 JMS I AEPUSH / " 749 06005 6076 AETMP 750 06006 4447 JMS I AEPUSH / " 751 06007 6077 AESCR 752 /SWITCH POINTERS 753 06010 1700 TAD I AEVAL /LEVAL 754 06011 3275 DCA AEPNT 755 06012 1701 TAD I AESAVE 756 06013 3700 DCA I AEVAL 757 /SCAN THE PARAMETERS I: PUSH TEMP LOCS, MOVE ARGS TO TEMP LOCS, 758 / PUSH SIMPLE ARG ADDRESSES 759 06014 1275 TAD AEPNT 760 06015 3276 DCA AETMP 761 06016 1302 TAD AEWORK 762 06017 3227 DCA AEREF 763 06020 1676 AESCAN, TAD I AETMP 764 06021 3277 DCA AESCR 765 06022 1677 TAD I AESCR 766 06023 7040 CMA 767 06024 7650 SNA CLA /-1? 768 06025 5246 JMP AEON /YES 769 06026 4447 JMS I AEPUSH /NO: PUSH A TEMP LOC 770 06027 0000 AEREF, 0 771 06030 2700 ISZ I AEVAL 772 06031 5632 JMP I .+1 /JUMP TO PATCH ROUTINE--DETERMINE IF ARG IS 773 06032 5366 AEPAT /SIMPLE OR NOT. 774 06033 3277 AEPATB, DCA AESCR 775 06034 7240 STA 776 06035 1700 TAD I AEVAL 777 06036 3700 DCA I AEVAL 778 06037 4451 JMS I AEEV /GET AN ARG 779 06040 3627 DCA I AEREF 780 06041 4447 JMS I AEPUSH /PUSH INDICATOR 781 06042 6077 AESCR 782 06043 2276 ISZ AETMP 783 06044 2227 ISZ AEREF 784 06045 5220 JMP AESCAN 785 /SCAN THE PARAMETERS II: PUSH FORMAL VARIABLES, MOVE FROM 786 / TEMP LOCS TO FORMAL VARIABLES. 787 06046 1275 AEON, TAD AEPNT 788 06047 3276 DCA AETMP 789 06050 1302 TAD AEWORK 790 06051 3227 DCA AEREF 791 06052 1676 AESC2, TAD I AETMP 792 06053 3261 DCA AELOC 793 06054 1661 TAD I AELOC /IS IT -1? 794 06055 7040 CMA 795 06056 7650 SNA CLA 796 06057 5267 JMP AEREST 797 06060 4447 JMS I AEPUSH /PUSH FORMAL VARIABLE 798 06061 0000 AELOC, 0 799 06062 1627 TAD I AEREF 800 06063 3661 DCA I AELOC 801 06064 2276 ISZ AETMP 802 06065 2227 ISZ AEREF 803 06066 5252 JMP AESC2 804 /RESTORE POINTERS 805 06067 1700 AEREST, TAD I AEVAL 806 06070 3701 DCA I AESAVE 807 06071 1276 TAD AETMP 808 06072 3700 DCA I AEVAL 809 06073 5674 JMP I AER1 810 06074 5240 AER1, EVR1 811 06075 0000 AEPNT, 0 812 06076 0000 AETMP, 0 813 06077 0000 AESCR, 0 814 06100 5200 AEVAL, LEVAL 815 06101 5261 AESAVE, EVSAVE 816 06102 5562 AEWORK, WORK 817 AEPUSH=PUSH5 818 AEEV=EV5 819 /EXIT SUBROUTINE 820 /SEE ENTER COMMENTS FOR NOTES. 821 AEXIT, 822 /MOVE FORMAL VARIABLES TO TEMP LOCATIONS, POP FORMAL 823 / VARIABLES 824 06103 3261 DCA AECNT /SET CNT=0 825 06104 1275 TAD AEPNT 826 06105 3277 DCA AESCR 827 06106 1227 TAD AEREF 828 06107 3360 DCA AEREF2 829 06110 7240 AESC10, STA 830 06111 1276 TAD AETMP 831 06112 3276 DCA AETMP 832 06113 7240 STA 833 06114 1360 TAD AEREF2 834 06115 3360 DCA AEREF2 835 06116 2261 ISZ AECNT 836 06117 1677 TAD I AESCR 837 06120 3332 DCA AELOC2 838 06121 1732 TAD I AELOC2 /IS IT -1? 839 06122 7040 CMA 840 06123 7650 SNA CLA 841 06124 5335 JMP AEXEL /YES: GO ON 842 06125 1676 TAD I AETMP /NO: MOVE 843 06126 3332 DCA AELOC2 844 06127 1732 TAD I AELOC2 845 06130 3760 DCA I AEREF2 846 06131 4450 JMS I AEPOP 847 06132 0000 AELOC2, 0 848 06133 2277 ISZ AESCR 849 06134 5310 JMP AESC10 850 /REPLACE SIMPLE PARAMETERS WITH TEMP LOCS, POP TEMP LOCS 851 06135 1261 AEXEL, TAD AECNT 852 06136 7041 CIA 853 06137 3261 DCA AECNT 854 06140 1227 TAD AEREF 855 06141 3360 DCA AEREF2 856 06142 7240 AESC11, STA 857 06143 1360 TAD AEREF2 858 06144 3360 DCA AEREF2 859 06145 2261 ISZ AECNT /THROUGH? 860 06146 7410 SKP 861 06147 5362 JMP AEFINI /YES: RETURN 862 06150 4450 JMS I AEPOP /NO: POP ARG ADDRESS 863 06151 6077 AEA 864 06152 1277 TAD AEA /IS IT 0? 865 06153 7650 SNA CLA 866 06154 5357 JMP .+3 /YES: DON'T REPLACE 867 06155 1760 TAD I AEREF2 /NO: REPLACE 868 06156 3677 DCA I AEA 869 06157 4450 JMS I AEPOP /POP A TEMP LOC 870 06160 0000 AEREF2, 0 871 06161 5342 JMP AESC11 872 AEFINI, /POP & RETURN 873 06162 4450 JMS I AEPOP 874 06163 6077 AESCR 875 06164 4450 JMS I AEPOP 876 06165 6076 AETMP 877 06166 4450 JMS I AEPOP 878 06167 6027 AEREF 879 06170 4450 JMS I AEPOP 880 06171 6075 AEPNT 881 06172 5773 JMP I AER2 882 06173 5251 AER2, EVR2 883 AECNT=AELOC 884 AEPOP=POP5 885 AEA=AESCR 886 PAGE /Added by VRS 887 EJECT PAGE/100-240 888 EV6=EV 889 POP6=POP 890 PUSH6=PUSH 891 06200 5223 RET6, EVRET 892 TEST6=TEST 893 /EQ ROUTINE 894 /COMPARES BOTH ARGUMENTS. IF THEY ARE EQUAL, THEN IT RETURNS 895 /1 (I.E., TRUE); ELSE RETURNS 0 (I.E., FALSE). 896 /BOTH ARGUMENTS MUST BE ATOMS. 897 AEQ, 898 06201 4447 JMS I EQPUSH /RECURSIVE SELF PROTECTION 899 06202 0055 EQLIST 900 06203 4451 JMS I EQEV /GET 1ST ARGUMENT 901 06204 3055 DCA EQLIST 902 06205 4451 JMS I EQEV /GET 2ND ARGUMENT 903 06206 3252 DCA EQP2 904 06207 4452 JMS I EQTEST /REALLY 905 06210 5247 JMP EQNO /NO 906 06211 1055 EQON, TAD EQLIST /SEE IF ATOM OR NULL 907 06212 7110 CLL RAR 908 06213 7650 SNA CLA 909 06214 5241 JMP EQYEP /NULL 910 06215 7430 SZL 911 06216 4440 HLT /NOT ATOM 912 06217 1252 TAD EQP2 /SEE IF ATOM OR NULL 913 06220 7110 CLL RAR 914 06221 7650 SNA CLA 915 06222 5247 JMP EQNO /NULL 916 06223 7430 SZL 917 06224 4440 HLT /NOT ATOM 918 06225 1455 TAD I EQLIST /SEE IF = 919 06226 7041 CIA 920 06227 1652 TAD I EQP2 921 06230 7640 SZA CLA 922 06231 5247 JMP EQNO /NOT = 923 06232 2055 ISZ EQLIST 924 06233 2252 ISZ EQP2 925 06234 1455 TAD I EQLIST 926 06235 3055 DCA EQLIST 927 06236 1652 TAD I EQP2 928 06237 3252 DCA EQP2 929 06240 5211 JMP EQON 930 06241 1252 EQYEP, TAD EQP2 /SEE IF ATOM OR NULL 931 06242 7110 CLL RAR 932 06243 7650 SNA CLA 933 06244 7001 IAC /NULL: RETURN 1(T) 934 06245 7430 SZL 935 06246 4440 HLT /NOT ATOM 936 06247 4450 EQNO, JMS I EQPOP /NO; RETURN 0(F) 937 06250 0055 EQLIST 938 06251 5600 JMP I EQRET 939 06252 0000 EQP2, 0 940 EQTEST=TEST6 941 EQRET=RET6 942 EQPUSH=PUSH6 943 EQPOP=POP6 944 EQEV=EV6 945 /COND ROUTINE 946 /EVALUATES EVEN ARGUMENTS 947 /IF ONE OF THESE IS TRUE, THEN RETURNS THE VALUE OF THE 948 /FOLLOWING ARGUMENT; AFTER A TRUE HAS BEEN ENCOUNTERED, 949 /EVALUATION OF SUBSEQUENT ARGUMENTS CEASES. 950 ACOND, 951 06253 4447 JMS I CNPUSH /RECURSIVE SELF PROTECTION 952 06254 0055 CNLIST 953 06255 4447 JMS I CNPUSH /RECURSIVE SELF PROTECTION 954 06256 6324 CNSW2 955 06257 4447 JMS I CNPUSH /RECURSIVE SELF PROTECTION 956 06260 6325 CNMODE 957 06261 1323 TAD CNSW /SAVE SWITCH 958 06262 3324 DCA CNSW2 959 06263 1323 TAD CNSW /SET MODE 960 06264 3325 DCA CNMODE 961 06265 1325 CNGO, TAD CNMODE /SET SWITCH 962 06266 3323 DCA CNSW 963 06267 4451 JMS I CNEV /GET NEXT EVEN ARG 964 06270 7040 CMA /-1? 965 06271 7450 SNA 966 06272 5311 JMP CNEND /YES 967 06273 7040 CMA /NO 968 06274 3323 DCA CNSW /SET SWITCH 969 06275 1325 TAD CNMODE /MODE = 0? 970 06276 7650 SNA CLA 971 06277 3323 DCA CNSW /YES: SET SWITCH = 0 972 06300 4451 JMS I CNEV /GET NEXT ODD ARG 973 06301 3326 DCA CNSAVE 974 06302 1323 TAD CNSW /SW = 1? 975 06303 7650 SNA CLA 976 06304 5265 JMP CNGO /NO: GO BACK 977 06305 3325 DCA CNMODE /YES: SET MODE = 0 978 06306 1326 TAD CNSAVE /SET RETURN VALUE 979 06307 3055 DCA CNLIST 980 06310 5265 JMP CNGO 981 06311 1324 CNEND, TAD CNSW2 /RESTORE SWITCH 982 06312 3323 DCA CNSW 983 06313 1055 TAD CNLIST 984 06314 4450 JMS I CNPOP 985 06315 6325 CNMODE 986 06316 4450 JMS I CNPOP 987 06317 6324 CNSW2 988 06320 4450 JMS I CNPOP 989 06321 0055 CNLIST 990 06322 5600 JMP I CNRET 991 06323 0001 CNSW, 1 992 06324 0000 CNSW2, 0 993 06325 0000 CNMODE, 0 994 06326 0000 CNSAVE, 0 995 CNPUSH=PUSH6 996 CNPOP=POP6 997 CNEV=EV6 998 CNRET=RET6 999 /SKIP-IF-CNSW=1 SUBROUTINE 1000 06327 0000 ATEST, 0 1001 06330 3337 DCA ATSAVE 1002 06331 1323 TAD CNSW 1003 06332 7650 SNA CLA /SKIP IF CNSW=1 1004 06333 5727 JMP I ATEST /NO SKIP IF CNSW=0 1005 06334 1337 TAD ATSAVE 1006 06335 2327 ISZ ATEST 1007 06336 5727 JMP I ATEST 1008 06337 0000 ATSAVE, 0 1009 /SET ROUTINE 1010 /SETS THE CONTENTS OF THE CELL FOLLOWING THE SET INSTRUCTION TO 1011 /THE VALUE OF THE SUBSEQUENT PARAETER. RETURNS THE SECOND 1012 /PARAMETER. 1013 ASET, 1014 06340 4447 JMS I ASPUSH /RECURSIVE SELF-PROTECTION 1015 06341 6360 AS1 1016 06342 2757 ISZ I ASEVAL 1017 06343 1757 TAD I ASEVAL 1018 06344 3360 DCA AS1 1019 06345 1760 TAD I AS1 1020 06346 3360 DCA AS1 1021 06347 4451 JMS I ASEV /GET PARAMETER 1022 06350 4452 JMS I ASTEST 1023 06351 5354 JMP ASZOT 1024 06352 3760 DCA I AS1 1025 06353 1760 TAD I AS1 1026 06354 4450 ASZOT, JMS I ASPOP 1027 06355 6360 AS1 1028 06356 5600 JMP I ASRET 1029 06357 5200 ASEVAL, LEVAL 1030 06360 0000 AS1, 0 1031 ASRET=RET6 1032 ASTEST=TEST6 1033 ASPUSH=PUSH6 1034 ASPOP=POP6 1035 ASEV=EV6 1036 PAGE /Added by VRS 1037 EJECT PAGE/100-260 1038 EV7=EV 1039 POP7=POP 1040 PUSH7=PUSH 1041 /LISTOUT ROUTINE 1042 /OUTPUTS THE LIST POINTED TO BY THE ARGUMENT 1043 ALSTOT, 1044 06400 4451 JMS I ALEV /GET ARG 1045 06401 3205 DCA .+4 1046 06402 4612 JMS I ALYAC1 /REALLY? 1047 06403 5207 JMP ALYAC2 /NO 1048 06404 4213 JMS OUTLST /YES; OUTPUT A LIST 1049 06405 0000 0 1050 06406 1205 TAD .-1 /RETURN ARGUMENT AS VALUE 1051 06407 5611 ALYAC2, JMP I ALZOT 1052 06410 0077 AL77, 77 1053 06411 5223 ALZOT, EVRET 1054 06412 6327 ALYAC1, ATEST 1055 ALEV=EV7 1056 /OUTLIST ROUTINE--MAIN 1057 06413 0000 OUTLST, 0 1058 06414 4447 JMS I OUPUSH 1059 06415 6513 OUI 1060 06416 1613 TAD I OUTLST 1061 06417 3313 DCA OUI 1062 06420 2213 ISZ OUTLST 1063 06421 4447 JMS I OUPUSH 1064 06422 6413 OUTLST 1065 06423 1313 TAD OUI 1066 06424 7110 CLL RAR 1067 06425 7450 SNA /NULL? 1068 06426 5304 JMP OUNIL /YES 1069 06427 7420 SNL /NO; ATOM? 1070 06430 5270 JMP OUATOM /YES 1071 06431 7100 CLL /NO; REMOVE LIST INDICATOR 1072 06432 7004 RAL 1073 06433 3313 DCA OUI 1074 06434 1315 TAD OUOP /'(' 1075 06435 4445 JMS I EVOUT 1076 06436 1313 OURENT, TAD OUI 1077 06437 3314 DCA OUIT 1078 06440 1313 TAD OUI 1079 06441 7450 SNA 1080 06442 5265 JMP OUDONE 1081 06443 7001 IAC 1082 06444 3313 DCA OUI 1083 06445 1713 TAD I OUI 1084 06446 7110 RAR CLL 1085 06447 7104 RAL CLL 1086 06450 3313 DCA OUI 1087 06451 1714 TAD I OUIT 1088 06452 3314 DCA OUIT 1089 06453 1314 TAD OUIT 1090 06454 3256 DCA .+2 1091 06455 4213 JMS OUTLST 1092 06456 0000 0 1093 06457 1313 TAD OUI 1094 06460 7650 SNA CLA 1095 06461 5265 JMP OUDONE 1096 06462 1316 TAD OUSP /' ' 1097 06463 4445 JMS I EVOUT 1098 06464 5236 JMP OURENT 1099 06465 1317 OUDONE, TAD OUCL /')' 1100 06466 4445 JMS I EVOUT 1101 06467 5306 JMP OUWHAK 1102 06470 7004 OUATOM, RAL 1103 06471 7650 SNA CLA 1104 06472 5306 JMP OUWHAK 1105 06473 1713 TAD I OUI 1106 06474 4445 JMS I EVOUT 1107 06475 1313 TAD OUI 1108 06476 7001 IAC 1109 06477 3313 DCA OUI 1110 06500 1713 TAD I OUI 1111 06501 3313 DCA OUI 1112 06502 1313 TAD OUI 1113 06503 5271 JMP OUATOM+1 1114 06504 1320 OUNIL, TAD OUZERO /IF NULL ATOM, PRINT 0 1115 06505 4445 JMS I EVOUT 1116 06506 4450 OUWHAK, JMS I OUPOP /RETURN 1117 06507 6413 OUTLST 1118 06510 4450 JMS I OUPOP 1119 06511 6513 OUI 1120 06512 5613 JMP I OUTLST 1121 06513 0000 OUI, 0 1122 06514 0000 OUIT, 0 1123 06515 0050 OUOP, 50 /'(' 1124 06516 0040 OUSP, 40 /' ' 1125 06517 0051 OUCL, 51/')' 1126 06520 6000 OUZERO, 6000 /'0', SHIFTED, STRIPPED & PACKED 1127 OUPUSH=PUSH7 1128 OUPOP=POP7 1129 /STACK OPERATIONS 1130 /PUSH ROUTINE 1131 /PUSHES THE VALUES OF THE ARGUMENT LIST ONTO THE STACK. 1132 /AC IS CLEARED ON EXIT. 1133 06521 0000 LPUSH, 0 1134 06522 7200 CLA 1135 06523 2361 LPBACK, ISZ STPTR 1136 06524 1361 TAD STPTR 1137 06525 1363 TAD STMAX 1138 06526 7650 SNA CLA 1139 06527 4440 HLT /NOT ENOUGH STACK STORAGE PROVIDED 1140 06530 1721 TAD I LPUSH 1141 06531 3357 DCA STLOC 1142 06532 1757 TAD I STLOC 1143 06533 3761 DCA I STPTR 1144 06534 2321 ISZ LPUSH 1145 06535 5721 JMP I LPUSH 1146 /POP ROUTINE 1147 /SAME AS PUSH EXCEPT THAT IT POPS THE LIST INTO THE ARGUMENT 1148 /LOCATIONS. 1149 /AC ON EXIT = AC ON ENTRY 1150 06536 0000 LPOP, 0 1151 06537 3356 DCA STSAV 1152 06540 1736 LPRET, TAD I LPOP 1153 06541 3357 DCA STLOC 1154 06542 2336 ISZ LPOP 1155 06543 1761 TAD I STPTR 1156 06544 3757 DCA I STLOC 1157 06545 7040 CMA 1158 06546 1361 TAD STPTR 1159 06547 3361 DCA STPTR 1160 06550 1361 TAD STPTR 1161 06551 1362 TAD STMIN 1162 06552 7710 SPA CLA 1163 06553 4440 HLT /MORE POPS THAN PUSHES 1164 06554 1356 TAD STSAV 1165 06555 5736 JMP I LPOP 1166 06556 0000 STSAV, 0 1167 06557 0000 STLOC, 0 1168 06560 0000 STCNT, 0 1169 06561 0000 STPTR, 0/SET BY INIT 1170 06562 0000 STMIN, 0/SET BY INIT 1171 06563 3000 STMAX, -ENDINT 1172 PAGE /Added by VRS 1173 EJECT PAGE/100-280 1174 EV9=EV 1175 POP9=POP 1176 PUSH9=PUSH 1177 06600 5223 RET9, EVRET 1178 TEST9=TEST 1179 /TABLE OF LISP SYSTEM ROUTINES 1180 06601 6702 TAB, AAND /0 0 1181 06602 7001 AHD /1 1 1182 06603 5312 ATL /2 2 1183 06604 5001 ALSTIN /3 3 1184 06605 6400 ALSTOT /4 4 1185 06606 7202 ANULL /5 5 1186 06607 5332 AATOM /6 6 1187 06610 7211 APROG /7 7 1188 06611 6201 AEQ /8 10 1189 06612 6253 ACOND /9 11 1190 06613 5226 EVERR /10 12 1191 06614 6340 ASET /11 13 1192 06615 7501 ABEGIN /12 14 1193 06616 7513 ARETURN /13 15 1194 06617 7402 ASETHD /14 16 1195 06620 7406 ASETTL /15 17 1196 06621 5401 ACONS /16 20 1197 06622 6710 AOR /17 21 1198 06623 5343 AGO /18 22 1199 06624 7014 AMACH /19 23 1200 06625 7025 APLUS /20 24 1201 06626 7032 AMINUS /21 25 1202 06627 7040 ATIMES /22 26 1203 06630 7101 ANUMBER /23 27 1204 06631 6751 AGREATP /24 30 1205 06632 7455 AIF /25 31 1206 06633 7554 APAUSE /26 32 1207 06634 5142 ANOT /27 33 1208 06635 7545 AEXIT2 /28 34 1209 06636 7562 AQUOTE /29 35 1210 06637 5150 AENTRY /30 36 1211 06640 5226 EVERR /31 37 1212 /GARBAGE COLLECTOR PATCH 1213 06641 1676 COLON, TAD I COSTK 1214 06642 3301 DCA COYAP 1215 06643 1301 COLZAP, TAD COYAP 1216 06644 1277 TAD COMIN 1217 06645 7710 SPA CLA 1218 06646 5700 JMP I COLZIP 1219 06647 1701 TAD I COYAP 1220 06650 4262 JMS CORANG 1221 06651 5256 JMP COLEXL 1222 06652 1701 TAD I COYAP 1223 06653 3255 DCA .+2 1224 06654 4675 JMS I COLPAT 1225 06655 0000 0 1226 06656 7240 COLEXL, STA 1227 06657 1301 TAD COYAP 1228 06660 3301 DCA COYAP 1229 06661 5243 JMP COLZAP 1230 06662 0000 CORANG, 0 /SKIP-IF-ARG-IN-RANGE SUB 1231 06663 7041 CIA 1232 06664 1043 TAD EVBEG 1233 06665 7041 CIA 1234 06666 7510 SPA 1235 06667 5273 JMP CORON /NOT IN RANGE 1236 06670 1044 TAD EVLEN 1237 06671 7510 SPA 1238 06672 2262 ISZ CORANG /IN RANGE 1239 06673 7200 CORON, CLA 1240 06674 5662 JMP I CORANG 1241 06675 5701 COLPAT, COMAIN 1242 06676 6561 COSTK, STPTR 1243 06677 0000 COMIN, 0/SET BY INIT 1244 06700 5636 COLZIP, COLNXT 1245 06701 0000 COYAP, 0 1246 /AND & OR ROUTINES 1247 AAND, /COMPUTES THE LOGICAL "AND" OF AN INDEFINATE SET OF ARGS. 1248 06702 7001 IAC 1249 06703 3350 DCA LOSW 1250 06704 1307 TAD ANSUB 1251 06705 3343 ANON, DCA LOSUB 1252 06706 5324 JMP LOGDO 1253 06707 0350 ANSUB, AND LOSW 1254 AOR, /COMPUTES THE LOGICAL "OR" OF AN INDEFINATE SET OF ARGS. 1255 06710 3350 DCA LOSW 1256 06711 1313 TAD ORSUB 1257 06712 5305 JMP ANON 1258 06713 5314 ORSUB, JMP OROR 1259 06714 7040 OROR, CMA 1260 06715 3323 DCA ORTMP 1261 06716 1350 TAD LOSW 1262 06717 7040 CMA 1263 06720 0323 AND ORTMP 1264 06721 7040 CMA 1265 06722 5344 JMP LOSUB+1 1266 06723 0000 ORTMP, 0 1267 /MAIN ROUTINE 1268 LOGDO, 1269 06724 4447 JMS I LOPUSH /RECURSIVE SELF PROTECTION 1270 06725 6750 LOSW 1271 06726 4447 JMS I LOPUSH /RECURSIVE SELF PROTECTION 1272 06727 6743 LOSUB 1273 06730 4451 JMS I LOEV /GET AN ARG 1274 06731 4450 JMS I LOPOP 1275 06732 6743 LOSUB 1276 06733 4450 JMS I LOPOP 1277 06734 6750 LOSW 1278 06735 7040 CMA /-1? 1279 06736 7450 SNA 1280 06737 5346 JMP LOEND /YES 1281 06740 7040 CMA /NO 1282 06741 4452 JMS I LOTEST /REALLY? 1283 06742 5324 JMP LOGDO /NO 1284 06743 0000 LOSUB, 0 /SUPLIED BY AND & OR 1285 06744 3350 DCA LOSW 1286 06745 5324 JMP LOGDO 1287 06746 1350 LOEND, TAD LOSW 1288 06747 5600 JMP I LORET 1289 06750 0000 LOSW, 0 /SUPLIED BY AND & OR 1290 LOPUSH=PUSH9 1291 LOPOP=POP9 1292 LOEV=EV9 1293 LORET=RET9 1294 LOTEST=TEST9 1295 /GREATP ROUTINE 1296 /RETURNS T IF FIRST ARG IS GREATER NUMERICALLY THAN SECOND 1297 / ARG. RETURNS F OTHERWISE. NO TEST IS MADE TO SEE IF 1298 / ARGS ARE ACTUALLY NUMERICAL (OR IF THEY ARE BOTH ATOMS). 1299 AGREATP, 1300 06751 4447 JMS I GRPUSH /RECURSIVE SELF-PROTECTION 1301 06752 6767 GRA 1302 06753 4451 JMS I GREV /GET 1ST ARG 1303 06754 4770 JMS I GRDECB /CONVERT TO BINARY 1304 06755 3367 DCA GRA 1305 06756 4451 JMS I GREV /GET SECOND ARG 1306 06757 4770 JMS I GRDECB /CONVERT TO BINARY 1307 06760 7041 CIA 1308 06761 1367 TAD GRA 1309 06762 7741 SL1 CLA 1310 06763 7001 IAC /-B+A>0 IMPLIES T 1311 06764 4450 JMS I GRPOP /ELSE F 1312 06765 6767 GRA 1313 06766 5600 JMP I GRRET 1314 06767 0000 GRA, 0 1315 06770 7110 GRDECB, DECBIN 1316 GRPUSH=PUSH9 1317 GRPOP=POP9 1318 GREV=EV9 1319 GRRET=RET9 1320 PAGE /Added by VRS 1321 EJECT PAGE/100-300 1322 EV10=EV 1323 POP10=POP 1324 PUSH10=PUSH 1325 07000 5223 RET10, EVRET 1326 TEST10=TEST 1327 /HD ROUTINE 1328 /RETURNS THE DOWN POINTER OF THE CELL POINTED TO BY IT'S ARG 1329 AHD, 1330 07001 4451 JMS I AHEV /GET ARG 1331 07002 7010 RAR 1332 07003 7420 SNL 1333 07004 7200 CLA 1334 07005 7104 CLL RAL 1335 07006 7450 SNA 1336 07007 5600 JMP I AHRET 1337 07010 3213 DCA AHTMP 1338 07011 1613 TAD I AHTMP 1339 07012 5600 JMP I AHRET 1340 07013 0000 AHTMP,0 1341 AHRET=RET10 1342 AHEV=EV10 1343 /MACH ROUTINE 1344 /TRANSFERS CONTROL TO SPECIFIED LOCATION 1345 AMACH, 1346 07014 2624 ISZ I MAEVAL 1347 07015 1624 TAD I MAEVAL 1348 07016 3223 DCA MATMP 1349 07017 1623 TAD I MATMP 1350 07020 3223 DCA MATMP 1351 07021 4623 JMS I MATMP 1352 07022 5600 JMP I MARET 1353 07023 0000 MATMP, 0 1354 07024 5200 MAEVAL, LEVAL 1355 MARET=RET10 1356 /PLUS, MINUS, TIMES ROUTINES 1357 APLUS, /COMPUTES THE SUM OF AN INDEFINATE NUMBER OF ARGS. 1358 07025 1231 TAD PLSUB 1359 07026 3270 DCA ARSUB 1360 07027 3247 DCA ARSUM 1361 07030 5252 JMP ARDO 1362 07031 1247 PLSUB, TAD ARSUM 1363 AMINUS, /NEGATES ITS ARGUMENT 1364 07032 4451 JMS I AREV /GET AN ARGUMENT 1365 07033 4452 JMS I ARTEST /REALLY 1366 07034 5600 JMP I ARRET /NO 1367 07035 4310 JMS DECBIN /CONVERT TO BINARY 1368 07036 7041 CIA /NEGATE IT 1369 07037 5276 JMP ARON 1370 ATIMES, /COMPUTES THE PRODUCT OF AN INDEFINATE NUMBER OF ARGS. 1371 07040 7001 IAC 1372 07041 3247 DCA ARSUM 1373 07042 1245 TAD TISUB 1374 07043 3270 DCA ARSUB 1375 07044 5252 JMP ARDO 1376 07045 5246 TISUB, JMP TIMTIM 1377 07046 7425 TIMTIM, MQL MUL 1378 07047 0000 ARSUM, 0 1379 07050 7701 CLA MQA 1380 07051 5271 JMP ARSUB+1 1381 /MAIN ARITMETIC ROUTINE 1382 ARDO, 1383 07052 4447 JMS I ARPUSH /RECURSIVE SELF PROTECTION 1384 07053 7047 ARSUM 1385 07054 4447 JMS I ARPUSH /RECURSIVE SELF PROTECTION 1386 07055 7070 ARSUB 1387 07056 4451 JMS I AREV /GET AN ARG 1388 07057 4450 JMS I ARPOP 1389 07060 7070 ARSUB 1390 07061 4450 JMS I ARPOP 1391 07062 7047 ARSUM 1392 07063 7040 CMA /-1? 1393 07064 7450 SNA 1394 07065 5273 JMP AREND /YES 1395 07066 7040 CMA /NO 1396 07067 4310 JMS DECBIN /CONVERT TO BINARY 1397 07070 0000 ARSUB, 0 /SUPPLIED BY ARITH SUBS 1398 07071 3247 DCA ARSUM 1399 07072 5252 JMP ARDO 1400 07073 4452 AREND, JMS I ARTEST /REALLY? 1401 07074 5600 JMP I ARRET /NO 1402 07075 1247 TAD ARSUM /CONVERT TO DECIMAL 1403 07076 4700 ARON, JMS I ARBIND 1404 07077 5600 JMP I ARRET 1405 07100 7265 ARBIND, BINDEC 1406 ARPUSH=PUSH10 1407 ARPOP=POP10 1408 ARRET=RET10 1409 AREV=EV10 1410 ARTEST=TEST10 1411 /NUMBER ROUTINE 1412 /RETURNS 1 (T) IF ARG IS NUMBER; RETURNS 0 (F) OTHERWISE. 1413 ANUMBER, 1414 07101 4451 JMS I NUEV /GET ARG 1415 07102 4310 JMS DECBIN /CONVERT TO BINARY 1416 07103 7200 CLA 1417 07104 1366 TAD DERR /ERROR? 1418 07105 7650 SNA CLA 1419 07106 7001 IAC /NO: SET TO T 1420 07107 5600 JMP I NURET /YES: SET TO F & RETURN 1421 NUEV=EV10 1422 NURET=RET10 1423 /DECBIN ROUTINE 1424 /CONVERTS A CHARACTER CODED ATOM TO BINARY 1425 07110 0000 DECBIN, 0 1426 07111 7110 CLL RAR/ATOM? 1427 07112 7430 SZL 1428 07113 4440 HLT /NO 1429 07114 7004 RAL /YES 1430 07115 3365 DCA DETMP 1431 07116 3366 DCA DERR 1432 07117 3367 DCA DETTL 1433 07120 1365 DEBAK, TAD DETMP 1434 07121 7650 SNA CLA /NULL? 1435 07122 5336 JMP DECEND /YES: EXIT 1436 07123 1765 TAD I DETMP 1437 07124 7417 LSR 1438 07125 0005 5 1439 07126 4340 JMS DECON 1440 07127 1765 TAD I DETMP 1441 07130 0364 AND DE77 1442 07131 4340 JMS DECON 1443 07132 2365 ISZ DETMP 1444 07133 1765 TAD I DETMP 1445 07134 3365 DCA DETMP 1446 07135 5320 JMP DEBAK 1447 07136 1367 DECEND, TAD DETTL 1448 07137 5710 JMP I DECBIN 1449 07140 0000 DECON, 0 1450 07141 7450 SNA /LAST? 1451 07142 5336 JMP DECEND /YES 1452 07143 1361 TAD DEM72 /-72 1453 07144 7500 SMA 1454 07145 2366 ISZ DERR /NOT A NUMBER 1455 07146 1362 TAD DEDIF /72-60 1456 07147 7510 SPA 1457 07150 2366 ISZ DERR /NOT A NUMBER 1458 07151 3363 DCA DELOC 1459 07152 1367 TAD DETTL /MULTIPLY BY 10 1460 07153 7425 MQL MUL 1461 07154 0012 12 1462 07155 7701 CLA MQA 1463 07156 1363 TAD DELOC /ADD DIGIT 1464 07157 3367 DCA DETTL 1465 07160 5740 JMP I DECON 1466 07161 7706 DEM72, -72 1467 07162 0012 DEDIF, 72-60 1468 07163 0000 DELOC, 0 1469 07164 0077 DE77, 77 1470 07165 0000 DETMP, 0 1471 07166 0000 DERR, 0 1472 07167 0000 DETTL, 0 1473 PAGE /Added by VRS 1474 EJECT PAGE/100-320 1475 PUSH11=PUSH 1476 POP11=POP 1477 07200 5223 RET11, EVRET 1478 EV11=EV 1479 TEST11=TEST 1480 07201 5200 EVAL11, LEVAL 1481 /NULL ROUTINE 1482 /RETURNS +1 IF THE CELL POINTED TO BY THE ARGUMENT IS NULL. 1483 /RETURNS 0 OTHERWISE. 1484 ANULL, 1485 07202 4451 JMS I ANEV /GET ARG 1486 07203 4452 JMS I ANTEST 1487 07204 5600 JMP I ANRET 1488 07205 7110 RAR CLL 1489 07206 7650 SNA CLA 1490 07207 7001 IAC 1491 07210 5600 JMP I ANRET 1492 ANTEST=TEST11 1493 ANEV=EV11 1494 ANRET=RET11 1495 /PROG ROUTINE 1496 /PERMITS IN-LINE CODING OF LISP INSTRUCTIONS 1497 /VALUE RETURNED IS THAT OF LAST ARGUMENT 1498 /FORM: 1499 / PROG 1500 / T1 1501 / T2 1502 / . 1503 / . 1504 / . 1505 / END 1506 / (INSTRUCTIONS) 1507 / END 1508 /WHERE TI IS A TEMPORARY WORKING LOCATION WHICH IS PUSHED 1509 / DOWN ON ENTRY TO PROG & SET TO NULL. IT IS POPPED ON 1510 / EXIT. 1511 APROG, 1512 07211 4447 JMS I PRPUSH /RECURSIVE SELF-PROTECTION 1513 07212 7262 PRPNT 1514 07213 1601 TAD I PREVAL /PUSH THE TEMP LOCATIONS & SET THEM TO NULL 1515 07214 3262 DCA PRPNT 1516 07215 3663 DCA I PR1 1517 07216 2262 PRLP1, ISZ PRPNT 1518 07217 1662 TAD I PRPNT 1519 07220 3226 DCA PRTMP 1520 07221 1626 TAD I PRTMP /-1? 1521 07222 7040 CMA 1522 07223 7650 SNA CLA 1523 07224 5231 JMP PRON 1524 07225 4447 JMS I PRPUSH 1525 07226 0000 PRTMP, 0 1526 07227 3626 DCA I PRTMP 1527 07230 5216 JMP PRLP1 1528 07231 1262 PRON, TAD PRPNT 1529 07232 3601 DCA I PREVAL 1530 07233 4451 PRON2, JMS I PREV /GET AN ARGUMENT 1531 07234 7040 CMA 1532 07235 7450 SNA /END? 1533 07236 5242 JMP PRZOT /YES 1534 07237 7040 CMA /NO 1535 07240 3663 DCA I PR1 1536 07241 5233 JMP PRON2 1537 07242 7240 PRZOT, STA /POP TEMP LOCS 1538 07243 1262 TAD PRPNT 1539 07244 3262 DCA PRPNT 1540 07245 1662 TAD I PRPNT 1541 07246 1264 TAD PRMPROG 1542 07247 7650 SNA CLA 1543 07250 5256 JMP PRZAP 1544 07251 1662 TAD I PRPNT 1545 07252 3254 DCA PRTMP2 1546 07253 4450 JMS I PRPOP 1547 07254 0000 PRTMP2, 0 1548 07255 5242 JMP PRZOT 1549 07256 1663 PRZAP, TAD I PR1 1550 07257 4450 JMS I PRPOP 1551 07260 7262 PRPNT 1552 07261 5600 JMP I PRRET 1553 07262 0000 PRPNT, 0 1554 07263 7512 PR1, BGVAL 1555 PREVAL=EVAL11 1556 07264 7771 PRMPROG, -PROG 1557 PRPUSH=PUSH11 1558 PRPOP=POP11 1559 PREV=EV11 1560 PRRET=RET11 1561 /BINDEC ROUTINE 1562 07265 0000 BINDEC, 0 /CONVERTS A BINARY WORD TO A CHARACTER CODED ATOM. 1563 07266 3312 DCA BIN1 /SAVE 1564 07267 3314 DCA BINCTR /INITIALIZE 1565 07270 3315 DCA BINSW 1566 07271 1316 TAD BININS 1567 07272 3332 DCA BINARR 1568 07273 1601 TAD I BINEV /SAVE 1569 07274 3317 DCA BINSAV 1570 07275 1046 TAD EVIN /SAVE INPUT ROUTINE 1571 07276 3313 DCA BININ 1572 07277 1321 TAD BINSUB 1573 07300 3046 DCA EVIN 1574 07301 4441 EVAL /CONVERT 1575 07302 0003 LISTIN 1576 07303 3314 DCA BINCTR /SAVE 1577 07304 1313 TAD BININ /RESTORE INPUT ROUTINE 1578 07305 3046 DCA EVIN 1579 07306 1317 TAD BINSAV /RESTORE 1580 07307 3601 DCA I BINEV 1581 07310 1314 TAD BINCTR 1582 07311 5665 JMP I BINDEC /RETURN 1583 07312 0000 BIN1, 0 1584 07313 0000 BININ, 0 1585 07314 0000 BINCTR, 0 1586 07315 0000 BINSW, 0 1587 07316 1363 BININS, TAD BIN10P 1588 BINEV=EVAL11 1589 07317 0000 BINSAV, 0 1590 07320 0000 BINSTR, 0 1591 07321 7322 BINSUB, BINBIN 1592 07322 0000 BINBIN, 0 /CONVERSION SUBROUTINE. LEADING ZEROS STRIPPED. 1593 07323 1314 TAD BINCTR /0 IS CONVETED TO 0. 1594 07324 1357 TAD BINM3 1595 07325 7450 SNA /LAST? 1596 07326 2315 ISZ BINSW /YES 1597 07327 7740 SMA SZA CLA /THROUGH? 1598 07330 5355 JMP BINRET /YES 1599 07331 2314 ISZ BINCTR /INCREMENT COUNTER 1600 07332 1363 BINARR, TAD BIN10P /GET DIVISOR 1601 07333 2332 ISZ .-1 1602 07334 3337 DCA .+3 1603 07335 1312 TAD BIN1 /GET DIVIDEND 1604 07336 7427 MQL DIV /DIVIDE 1605 07337 0000 0 1606 07340 3312 DCA BIN1 1607 07341 7501 MQA /GET REMAINDER 1608 07342 3360 DCA BINLOC 1609 07343 1315 TAD BINSW /SWITCH SET? 1610 07344 7640 SZA CLA 1611 07345 5352 JMP BINON /YES 1612 07346 1360 TAD BINLOC /NO; = 0? 1613 07347 7650 SNA CLA 1614 07350 5323 JMP BINBIN+1 /YES 1615 07351 2315 ISZ BINSW /NO 1616 07352 1360 BINON, TAD BINLOC 1617 07353 1362 TAD BIN60 /MAKE STRIPPED ASCII CHAR 1618 07354 5722 JMP I BINBIN /RETURN 1619 07355 1361 BINRET, TAD BIN40 /BL 1620 07356 5722 JMP I BINBIN 1621 07357 7775 BINM3, -3 1622 07360 0000 BINLOC, 0 1623 07361 0040 BIN40, 40 1624 07362 0060 BIN60, 60 1625 DECIMAL 1626 07363 1750 BIN10P, 1000 1627 07364 0144 100 1628 07365 0012 10 1629 07366 0001 1 1630 OCTAL 1631 PAGE /Added by VRS 1632 EJECT PAGE/100-340 1633 PUSH12=PUSH 1634 POP12=POP 1635 EV12=EV 1636 07400 5223 RET12, EVRET 1637 07401 5200 EVAL12, LEVAL 1638 TEST12=TEST 1639 /SETHD & SETTL ROUTINES 1640 ASETHD, /WILL SET THE DOWN POINTER TO THE ARGUMENT. 1641 07402 1205 TAD SHTYPE 1642 07403 3244 SHON, DCA DOITS 1643 07404 5211 JMP DOIT 1644 07405 7104 SHTYPE, CLL RAL 1645 ASETTL, /WILL SET THE NEXT POINTER TO THE ARGUMENT. 1646 07406 1210 TAD STTYPE 1647 07407 5203 JMP SHON 1648 07410 7124 STTYPE, CLL CML RAL 1649 /MAIN ROUTINE. NOT DEFINED FOR NULL ARGUMENTS, OR FOR 1650 / ATOMIC ARGUMENTS. 1651 DOIT, 1652 07411 4447 JMS I SHPUSH /RECURSIVE SELF-PROTECTION 1653 07412 0055 SHLIST 1654 07413 4451 JMS I SHEV /1ST ARGUMENT 1655 07414 3055 DCA SHLIST /SAVE IT 1656 07415 4447 JMS I SHPUSH /RECURSIVE SELF-PROTECTION 1657 07416 7444 DOITS 1658 07417 4451 JMS I SHEV /2ND ARGUMENT 1659 07420 4450 JMS I SHPOP 1660 07421 7444 DOITS 1661 07422 3254 DCA SH1 /SAVE IT 1662 07423 4452 JMS I SHTEST /REALLY? 1663 07424 5251 JMP SHRETR /NO 1664 07425 1244 TAD DOITS/SETHD OR SETTL? 1665 07426 7041 CIA 1666 07427 1210 TAD STTYPE 1667 07430 7640 SZA CLA 1668 07431 5236 JMP .+5/SETHD 1669 07432 1254 TAD SH1/GET 2ND ARG 1670 07433 7110 CLL RAR 1671 07434 7620 SNL CLA 1672 07435 4440 HLT /2ND ARG OF SETTL NOT A LIST 1673 07436 1055 TAD SHLIST /GET 1ST ARG 1674 07437 7010 RAR 1675 07440 7420 SNL /ATOM? 1676 07441 4440 HLT /YES 1677 07442 7450 SNA /NULL? 1678 07443 4440 HLT /YES 1679 07444 0000 DOITS, 0 /PUT IN BY SETHD & SETTL 1680 07445 3055 DCA SHLIST /SAVE IT 1681 07446 1254 TAD SH1 /GET 2ND ARG 1682 07447 3455 DCA I SHLIST /SET HEAD OR TAIL, AS SPECIFIED 1683 07450 1455 TAD I SHLIST /RETURN 2ND ARG AS VALUE 1684 07451 4450 SHRETR, JMS I SHPOP /POP & RETURN 1685 07452 0055 SHLIST 1686 07453 5600 JMP I SHRET 1687 07454 0000 SH1, 0 1688 SHEV=EV12 1689 SHPUSH=PUSH12 1690 SHPOP=POP12 1691 SHRET=RET12 1692 SHTEST=TEST12 1693 /IF ROUTINE 1694 /IF FIRST ARGUMENT IS T, THEN RETURNS (EXECUTES) SECOND ARG. 1695 / ELSE DOES NOT EXECUTE SECOND ARG. 1696 AIF, 1697 07455 4447 JMS I IFPUSH /RECURSIVE SELF-PROTECTION 1698 07456 7477 IFSAVE 1699 07457 1676 TAD I IFSW /SAVE SWITCH 1700 07460 3277 DCA IFSAVE 1701 07461 4451 JMS I IFEV /GET CONDITION 1702 07462 3676 DCA I IFSW /SAVE IT 1703 07463 1277 TAD IFSAVE /COND SW=1? 1704 07464 7650 SNA CLA 1705 07465 3676 DCA I IFSW /NO: SET SWITCH=0 1706 07466 4451 JMS I IFEV /GET VALUE 1707 07467 3300 DCA IFVAL 1708 07470 1277 TAD IFSAVE /RESTORE SWITCH 1709 07471 3676 DCA I IFSW 1710 07472 1300 TAD IFVAL /RETURN VALUE 1711 07473 4450 JMS I IFPOP 1712 07474 7477 IFSAVE 1713 07475 5600 JMP I IFRET 1714 07476 6323 IFSW, CNSW 1715 07477 0000 IFSAVE, 0 1716 07500 0000 IFVAL, 0 1717 IFPUSH=PUSH12 1718 IFPOP=POP12 1719 IFEV=EV12 1720 IFRET=RET12 1721 /BEGIN ROUTINE 1722 /SIMILAR TO PROG, BUT WITHOUT THE AUTOMATIC PUSH-DOWN 1723 ABEGIN, 1724 07501 4451 JMS I BGEV /GET AN ARG 1725 07502 7040 CMA /-1? 1726 07503 7450 SNA 1727 07504 5310 JMP BGEND /YES 1728 07505 7040 CMA /NO 1729 07506 3312 DCA BGVAL /SAVE VALUE 1730 07507 5301 JMP ABEGIN /TRY AGAIN 1731 07510 1312 BGEND, TAD BGVAL 1732 07511 5600 JMP I BGRET 1733 07512 0000 BGVAL, 0 1734 BGEV=EV12 1735 BGRET=RET12 1736 /RETURN ROUTINE 1737 /FOR USE IN THE IMMEDIATE RANGE OF A PROG. THIS WILL CAUSE 1738 / THE PROG TO 'DROP THROUGH', RETURNING AS THE PROG VALUE 1739 / THE VALUE OF THE RETURN ARGUMENT. 1740 ARETURN, 1741 07513 4447 JMS I REPUSH /RECURSIVE SWITCH PROTECTION 1742 07514 6323 CNSW 1743 07515 4451 JMS I REEV /GET RETURN VALUE 1744 07516 4452 JMS I RETEST /REALLY? 1745 07517 5333 JMP REARND /NO 1746 07520 3723 DCA I RE1 1747 07521 3734 DCA I RESW /SET SWITCH VALUE F 1748 07522 4447 JMS I REPUSH /RECURSIVE SELF PROTECTION 1749 07523 7512 RE1, BGVAL 1750 07524 4451 JMS I REEV /GET NEXT 1751 07525 4450 JMS I REPOP /RECURSIVE SELF PROTECTION 1752 07526 7512 BGVAL 1753 07527 7040 CMA 1754 07530 7640 SZA CLA 1755 07531 5322 JMP .-7 1756 07532 7240 STA /RETURN -1 1757 07533 4450 REARND, JMS I REPOP 1758 07534 6323 RESW, CNSW 1759 07535 5600 JMP I RERET 1760 RETEST=TEST12 1761 REPUSH=PUSH12 1762 REPOP=POP12 1763 REEV=EV12 1764 RERET=RET12 1765 /ERR ROUTINE 1766 /THIS ROUTINE CALLED WHENEVER A HLT IS NORMALLY EXECUTED. 1767 07536 0000 ERR, 0 1768 07537 7200 CLA 1769 07540 1336 TAD ERR /DISPLAY ERROR ADDRESS 1770 07541 7421 MQL 1771 07542 1601 TAD I EREVAL/DISPLAY POINTER ADDRESS 1772 07543 7402 7402 /HLT 1773 07544 5337 JMP ERR+1 1774 EREVAL=EVAL12 1775 /EXIT, PAUSE ROUTINES 1776 AEXIT2, 1777 07545 4452 JMS I STTEST 1778 07546 5600 JMP I STRET 1779 07547 6342 ICF /CLEAR INK FLAG 1780 07550 6042 TCF /CLEAR PRINT FLAG 1781 07551 6324 EFC /CLEAR ERASE FLAG 1782 07552 5753 JMP I .+1 1783 07553 7600 7600 1784 07554 4452 APAUSE, JMS I STTEST 1785 07555 5600 JMP I STRET 1786 07556 7421 MQL 1787 07557 1601 TAD I STEVAL 1788 07560 7402 7402 1789 07561 5600 JMP I STRET 1790 STEVAL=EVAL12 1791 STRET=RET12 1792 STTEST=TEST12 1793 /QUOTE ROUTINE 1794 /PREVENTS THE EVALUATION OF ITS ARGUMENT. HAS AS ITS VALUE 1795 / THE CONTENTS OF THE CELL FOLLOWING THE CALL ON 'QUOTE' 1796 AQUOTE, 1797 07562 2601 ISZ I QUEVAL 1798 07563 1601 TAD I QUEVAL 1799 07564 3367 DCA QUTMP 1800 07565 1767 TAD I QUTMP 1801 07566 5600 JMP I QURET 1802 QUEVAL=EVAL12 1803 07567 0000 QUTMP, 0 1804 QURET=RET12 1805 $ AAEV 0051 AAND 6702 AATEST 0052 AATOM 5332 ABEGIN 7501 ACEV 0051 ACEXIT 5430 ACLST1 0055 ACLST2 0056 ACOK 5425 ACOND 6253 ACONS 5401 ACPOP 0050 ACPUSH 0047 ACRET 5400 ACTEST 5436 ACTMP 5434 unreferenced ACVAL 5433 ACXTR 5435 AEA 6077 AECNT 6061 AEEV 0051 AEFINI 6162 AEGO 5374 AELOC 6061 AELOC2 6132 AENTER 6000 AENTRY 5150 AEON 6046 AEPAT 5366 AEPATB 6033 AEPNT 6075 AEPOP 0050 AEPUSH 0047 AEQ 6201 AER1 6074 AER2 6173 AEREF 6027 AEREF2 6160 AEREST 6067 AESAVE 6101 AESC10 6110 AESC11 6142 AESC2 6052 AESCAN 6020 AESCR 6077 AETMP 6076 AEVAL 6100 AEWORK 6102 AEXEL 6135 AEXIT 6103 AEXIT2 7545 AGO 5343 AGREAT 6751 AHD 7001 AHEV 0051 AHRET 7000 AHTMP 7013 AIBIND 4724 AICNTR 4712 AIDECB 4723 AIERR 4713 AIEV 4721 AIEVAL 4711 AIF 7455 AILOC 4726 AIMIN 4730 AIMIN2 4731 AINIT 4600 AIPNT 4714 AIPOP 4720 AIPTR 4727 AIPUSH 4717 AIREF 4716 AITEST 4722 AIWRK 4715 AL77 6410 unreferenced ALEV 0051 ALSTIN 5001 ALSTOT 6400 ALYAC1 6412 ALYAC2 6407 ALZOT 6411 AMACH 7014 AMINUS 7032 ANEV 0051 ANON 6705 ANOT 5142 ANRET 7200 ANSUB 6707 ANTEST 0052 ANULL 7202 ANUMBE 7101 AOR 6710 APAUSE 7554 APLUS 7025 APROG 7211 AQUOTE 7562 ARBIND 7100 ARDO 7052 AREND 7073 ARETUR 7513 AREV 0051 ARON 7076 ARPOP 0050 ARPUSH 0047 ARRET 7000 ARSUB 7070 ARSUM 7047 ARTEST 0052 AS1 6360 ASET 6340 ASETHD 7402 ASETTL 7406 ASEV 0051 ASEVAL 6357 ASPOP 0050 ASPUSH 0047 ASRET 6200 ASTEST 0052 ASZOT 6354 ATEST 6327 ATIMES 7040 ATL 5312 ATSAVE 6337 BGEND 7510 BGEV 0051 BGRET 7400 BGVAL 7512 BIN1 7312 BIN10P 7363 BIN40 7361 BIN60 7362 BINARR 7332 BINBIN 7322 BINCTR 7314 BINDEC 7265 BINEV 7201 BININ 7313 BININS 7316 BINLOC 7360 BINM3 7357 BINON 7352 BINRET 7355 BINSAV 7317 BINSTR 7320 unreferenced BINSUB 7321 BINSW 7315 CNEND 6311 CNEV 0051 CNGO 6265 CNLIST 0055 CNMODE 6325 CNPOP 0050 CNPUSH 0047 CNRET 6200 CNSAVE 6326 CNSW 6323 CNSW2 6324 COATOM 5740 COAUTO 5775 COCNT 5770 COCOMP 5755 CODTAB 5772 COGOOD 5767 COI 5774 COLADD 5611 COLAHA 5714 COLARN 5657 COLAST 5773 COLECT 5601 COLEND 5667 COLEXL 6656 COLLON 5776 COLN 5600 COLNXT 5636 COLON 6641 COLOOP 5624 COLPAT 6675 COLZAP 6643 COLZIP 6700 COLZOT 5643 COMAIN 5701 COMIN 6677 CONDX 5771 COPOP 0050 COPUSH 0047 CORANG 6662 CORET 5750 CORON 6673 COSTK 6676 COYAP 6701 CVBIN 0053 CVDEC 0054 DE77 7164 DEBAK 7120 DECBIN 7110 DECEND 7136 DECON 7140 DEDIF 7162 DELOC 7163 DEM72 7161 DERR 7166 DETMP 7165 DETTL 7167 DIV 7407 DOIT 7411 DOITS 7444 EFC 6324 ENDINT 5000 ENDWRK 5600 ENEVAL 5164 ENLOC 5165 ENRET 5000 ENSAV 5166 EQEV 0051 EQLIST 0055 EQNO 6247 EQON 6211 EQP2 6252 EQPOP 0050 EQPUSH 0047 EQRET 6200 EQTEST 0052 EQYEP 6241 EREVAL 7401 ERR 7536 EV 0051 EV1 0051 unreferenced EV10 0051 EV11 0051 EV12 0051 EV2 0051 EV3 0051 EV5 0051 EV6 0051 EV7 0051 EV9 0051 EVAL 4441 EVAL11 7201 EVAL12 7401 EVAL2 5207 EVAND1 5257 EVBEG 0043 EVENT 5263 EVER2 0040 EVERR 5226 EVEVAL 0041 EVEXIT 5264 EVFREE 0042 EVFUN 5267 EVIN 0046 EVLEN 0044 EVLOC 5262 EVON 5253 EVOUT 0045 EVPOP 0050 EVPRIM 5303 EVPTR 5265 EVPUSH 0047 EVR1 5240 EVR2 5251 EVRET 5223 EVSAVE 5261 EVSTAN 5231 EVTAB 5260 EVTABL 0055 EVTEST 0052 EVTMP 5266 FAINIT 4725 FREE 0042 GOVAL 5365 GRA 6767 GRDECB 6770 GREV 0051 GRPOP 0050 GRPUSH 0047 GRRET 6600 ICF 6342 IFEV 0051 IFPOP 0050 IFPUSH 0047 IFRET 7400 IFSAVE 7477 IFSW 7476 IFVAL 7500 IN4000 5141 IN77 5533 INAM 5123 INAR2 5462 INARND 5107 INAT 5047 INATOM 5437 INBACK 5026 INBLD 5531 INBUF2 5126 INBUFF 5125 INCEL2 5542 INCELL 5136 INCHR 5060 INCHRL 5541 INCTL 5501 INCTLQ 5515 INDIF 5133 INDIF2 5134 INEXEL 5442 INEXTR 5135 INLBUF 5540 INLCHR 5137 INLDF2 5537 INLDIF 5536 INLIST 5006 INLMCL 5535 INM0 5534 INMCL 5127 INMQUT 5132 INMSP 5130 INOUT 5474 INPOP 0050 INPUSH 0047 INQCTL 5124 INRET 5050 INSAVE 5532 INSP 5131 INZIP 5117 LEVAL 5200 LIALST 5140 LILAST 5122 LILIST 0055 LILLST 5530 LIRET 5000 LISP 5000 LISTIN 0003 LITEST 0052 LOEND 6746 LOEV 0051 LOGDO 6724 LOPOP 0050 LOPUSH 0047 LORET 6600 LOSUB 6743 LOSW 6750 LOTEST 0052 LPBACK 6523 unreferenced LPOP 6536 LPRET 6540 unreferenced LPUSH 6521 LSR 7417 MAEVAL 7024 MARET 7000 MATMP 7023 MQA 7501 MQL 7421 MUL 7405 NTEV 0051 NTRET 5000 NTTEST 0052 NUEV 0051 NURET 7000 OROR 6714 ORSUB 6713 ORTMP 6723 OUATOM 6470 OUCL 6517 OUDONE 6465 OUI 6513 OUIT 6514 OUNIL 6504 OUOP 6515 OUPOP 0050 OUPUSH 0047 OURENT 6436 OUSP 6516 OUTLST 6413 OUWHAK 6506 OUZERO 6520 PLSUB 7031 POP 0050 POP1 0050 POP10 0050 POP11 0050 POP12 0050 POP2 0050 POP3 0050 POP4 0050 POP5 0050 POP6 0050 POP7 0050 POP9 0050 PR1 7263 PREV 0051 PREVAL 7201 PRLP1 7216 PRMPRO 7264 PROG 0007 PRON 7231 PRON2 7233 PRPNT 7262 PRPOP 0050 PRPUSH 0047 PRRET 7200 PRTMP 7226 PRTMP2 7254 PRZAP 7256 PRZOT 7242 PUSH 0047 PUSH1 0047 PUSH10 0047 PUSH11 0047 PUSH12 0047 PUSH2 0047 PUSH3 0047 PUSH4 0047 PUSH5 0047 PUSH6 0047 PUSH7 0047 PUSH9 0047 QUEVAL 7401 QURET 7400 QUTMP 7567 RE1 7523 REARND 7533 REEV 0051 REPOP 0050 REPUSH 0047 RERET 7400 RESW 7534 RET1 5000 RET10 7000 RET11 7200 RET12 7400 RET3 5400 RET6 6200 RET9 6600 RETEST 0052 SH1 7454 SHEV 0051 SHL 7413 SHLIST 0055 SHON 7403 SHPOP 0050 SHPUSH 0047 SHRET 7400 SHRETR 7451 SHTEST 0052 SHTYPE 7405 SL1 7541 STCNT 6560 unreferenced STEVAL 7401 STLOC 6557 STMAX 6563 STMIN 6562 STPTR 6561 STRET 7400 STSAV 6556 STTEST 0052 STTYPE 7410 TAB 6601 TEST 0052 TEST1 0052 TEST10 0052 TEST11 0052 TEST12 0052 TEST6 0052 TEST9 0052 TIMTIM 7046 TISUB 7045 TLEV 0051 TLTEST 0052 TLTMP 5331 WORK 5562 XTARND 5556 XTCOL 5561 XTRACT 5543 XTVAL 5560