/Lisp interpreter 3-20-64, part 1 0004 4/ /go 0004 764607 go, hlt+cla+cli+7-opr-opr 0005 760016 stf 6 /// does nothing 0006 extend 0006 340077 dzm 77 0007 700077 law 77 0010 261136 dap avx /// beginning 0011 702350 beg, law pdo-1 0012 242344 dac pdl 0013 200234 lac n 0014 242346 dac ar2 0015 161304 cal rin 0016 161564 cal evo 0017 161235 cal pnt 0020 600011 jmp beg /// temporary storage, sub zero 0021 000000 t0, 0 /// temporary storage, sub one 0022 000000 t1, 0 /// garbage collector, temporary storage, sub zero 0023 000000 g0, 0 /// garbage collector, temporary storage, sub one 0024 000000 g1, 0 0025 000000 hi, 0 0026 000072 csi, 72 0027 000072 cso, 72 0030 000000 ffi, 0 /// garbage collector, argument one 0031 000000 ga1, 0 0032 000000 0 /// input string initial (points to a string of characters just read in) 0033 000032 isi, isi-1 /// table for symbol generator 0034 gst, repeat 5,20 +0034 000020 20 +0035 000020 20 +0036 000020 20 +0037 000020 20 +0040 000020 20 /// Argument sub 0 0041 000000 a0, 0 /// Argument sub 1 0042 000000 a1, 0 0043 000000 a2, 0 /// push word on list (append word to push-down list) /append word to pdl 0044 000000 pwl, 0 /// put return address into jmp instruction 0045 260053 dap pwx /// next position on push-down list 0046 442344 idx pdl 0047 502342 sad bfw /// ran into bfw 0050 602214 jmp qg2 /// restore accumulator 0051 200044 lac pwl /// put it onto list 0052 252344 dac i pdl /// push word exit 0053 pwx, exit +0053 60000 jmp /retrieve word from pdl /unsave word; retrieve word from push down list /unsave word from list 0054 000000 uw, 0 0055 260062 uwl, dap uwx 0056 232344 lio i pdl /// subtract 1 from pdl 0057 undex pdl +0057 710001 law i 1 +0060 402344 add pdl +0061 242344 dac pdl /// unsave word, exit 0062 uwx, exit +0062 600000 jmp /// buffer 0063 buf, 0077 000000 77/ 0 /// This is where cal goes! /// This is the eval interpreter, duh-head! /// so... where >is< rx? A fair question, methinks. 0100 000000 0 /// save return address 0101 260561 dap rx /// get address of original cal instruction 0102 423530 sub (1 /// put it into next instruction 0103 260104 dap .+1 /// get what was at that address 0104 200000 lac xy /// make that the return adddress from the interpreter 0105 260111 dap ave+1 /// get return address back and push on stack 0106 200561 lac rx 0107 170044 jda pwl /// advance, end /// restore AC 0110 200100 ave, lac 100 0111 exit +0111 600000 jmp /create number 0112 223531 crn, lio (jmp 0113 663003 rcl 2s 0114 671003 rar 2s 0115 240100 dac 100 0116 600762 jmp cpf /print or punch character 0117 023532 pc, and (77 0120 503533 sad (76 0121 600556 jmp x 0122 043534 ior (ral 0123 240135 dac pcc 0124 503535 sad (ral 77 0125 600132 jmp pcc-3 0126 460143 isp pch 0127 460134 jmp pcc-1 0130 700000 law 277 0131 160210 cal out 0132 710100 law i 100 0133 240143 dac pch 0134 700252 law 252 /// punch character, computer correct parity for punching 0135 760400 pcc, xx 0136 023536 and (200 0137 040135 ior pcc 0140 240100 dac 100 0141 760012 stf 2 0142 600210 jmp out /// punch charater count, producing carriage return (generated after 64 /// (decimal) characters) 0143 777677 pch, -100 /get numeric value 0144 230100 vag, lio i 100 0145 760200 cla 0146 663003 rcl 2s 0147 523537 sas (3 0150 602222 jmp qi3 0151 440100 idx 100 0152 210100 lac i 100 0153 663377 rcl 8s 0154 663377 rcl 8s 0155 600556 jmp x /get two values 0156 320042 vad, dio a1 0157 160144 cal vag 0160 240041 dac a0 0161 200042 lac a1 0162 160144 cal vag 0163 240042 dac a1 0164 600556 jmp x /// output character /pack character onto end of buffer 0165 671077 oc, rar 6s 0166 230033 lio i isi 0167 663077 rcl 6s 0170 503533 sad (76 0171 600206 jmp oc1 0172 200100 lac 100 0173 043540 ior (767600 0174 160761 cal cf 0175 230021 lio t0 0176 440021 idx t0 0177 440033 idx isi 0200 240042 dac a1 0201 320033 dio isi 0202 210042 lac i a1 0203 250021 dac i t0 0204 330042 dio i a1 0205 600556 jmp x /// output character, sub one 0206 330033 oc1, dio i isi 0207 600556 jmp x /output routine 0210 220100 out, lio 100 0211 640036 szs 36 0212 720005 ppa 0213 650066 szs i 66 0214 720003 tyo 0215 600556 jmp x /error printout 0216 760006 err, clf 6 0217 260226 dap erx 0220 210226 lac i erx 0221 240231 dac ern 0222 700227 law erm 0223 160712 cal pra 0224 760016 stf 6 0225 440226 idx erx /// error exit 0226 erx, exit +0226 600000 jmp /// error message 0227 357776 erm, 357776 0230 000231 .+1 /// error name 0231 000000 ern, 0 0232 000233 .+1 0233 347776 347776 /// NIL (register containing) 0234 002500 n,fro, nil define error F 0000 620216 jsp err 0001 000000 F termin /garbage collector, non-compacting 0235 260356 gc, dap gcx 0236 320031 dio ga1 0237 320267 dio gfr 0240 200267 lac gfr 0241 675003 sar 2s 0242 640100 sza 0243 620268 jsp gfr+1 0244 200030 lac ffi 0245 650100 sza i 0246 600251 jmp gco 0247 200100 lac 100 0250 170267 jda gfr 0251 212334 gco, lac i 1ob 0252 170267 jda gfr 0253 200033 lac isi 0254 523541 sas (isi-1 0255 600363 jmp gci 0256 702345 law pdl+1 0257 240024 dac g1 /// garbage collector, push-down 0260 210024 gcp, lac i g1 0261 170267 jda gfr 0262 440024 idx g1 0263 423530 sub (1 0264 502344 sad pdl 0265 600341 jmp g2e 0266 600260 jmp gcp /// garbage, free; (not returned to free storage) /mark one list 0267 000000 gfr, 0 0270 260322 dap gfx 0271 200267 lac gfr 0272 661001 ral 1s 0273 650600 spq 0274 600322 jmp gfx /// push pdl on stack 0275 202344 lac pdl 0276 170044 jda pwl /// garbage, free, next 0277 230267 gfn, lio i gfr 0300 440267 idx gfr 0301 210267 lac i gfr 0302 640200 spa 0303 600316 jmp gfu 0304 043542 ior (add 0305 250267 dac i gfr 0306 642000 spi /// push gfd on stack 0307 600313 jmp gfd 0310 170044 jda pwl 0311 320267 dio gfr 0312 600277 jmp gfn 0313 662001 gfd, ril 1s 0314 652000 spi i 0315 600323 jmp gfa /// garbage, free, unsave 0316 620055 gfu, jsp uwl 0317 320267 dio gfr 0320 520267 sas gfr 0321 600277 jmp gfn /// garbage, free, exit 0322 gfx, exit +0322 600000 jmp 0323 672001 gfa, rir 1s 0324 320023 dio g0 0325 240267 dac gfr 0326 440023 gfl, idx g0 0327 210023 lac i g0 0330 640200 spa 0331 600277 jmp gfn 0332 043542 ior (add 0333 250023 dac i g0 0334 240023 dac g0 0335 063542 xor (add 0336 520234 sas n 0337 600326 jmp gfl 0340 600277 jmp gfn /// garbage collector, part 2, entry / garbage collector, linear sweep phase 0341 200234 g2e, lac fro 0342 240023 dac g0 /// garbage collector, part 2, next 0343 440023 g2n, idx g0 0344 230023 lio i g0 0345 652000 smi 0346 600357 jmp g2f 0347 662001 ril 1s 0350 676001 sir 1s /// garbage collector, part 2, advance 0351 330023 g2a, dio i g0 0352 440023 idx g0 0353 520025 sas hi 0354 600343 jmp g2n /// garbage collector, part 2, exit 0355 220031 g2x, lio ga1 /// garbage collector, exit 0356 gcx, exit +0356 600000 jmp /// garbage collector, part 2, free 0357 222341 g2f, lio fre 0360 423530 sub (1 0361 242341 dac fre 0362 600351 jmp g2a 0363 500234 gci, sad n 0364 600256 jmp gcp-2 0365 240267 dac gfr 0366 240023 dac g0 /// push pdl on stack 0367 202344 lac pdl 0370 170044 jda pwl 0371 700256 law gcp-2 0372 260322 dap gfx 0373 600326 jmp gfl /// ASSOC origin /SASSOC 0374 160403 aso, cal asc 0375 600377 jmp ase 0376 600556 jmp x /// ASSOC entry 0377 200043 ase, lac a2 0400 160613 cal cns-1 0401 601564 jmp evo 0402 222346 asr, lio ar2, 0403 320042 asc, dio a1 0404 200042 lac a1 0405 500234 as1, sad n 0406 600556 jmp x 0407 210042 lac i a1 0410 240021 dac t0 0411 210021 lac i t0 0412 500100 sad 100 0413 600420 jmp as2 0414 440042 idx a1 0415 210042 lac i a1 0416 240042 dac a1 0417 600405 jmp as1 /// ASSOC sub 2 0420 452344 as2, idx i pdl 0421 200021 lac t0 0422 600556 jmp x /program feature /PROG /// push pa3 on stack 0423 202347 pgm, lac pa3 0424 170044 jda pwl /// push pa4 on stack 0425 202350 lac pa4 0426 170044 jda pwl 0427 342350 dzm pa4 0430 322346 dio ar2 0431 230100 lio i 100 0432 440100 idx 100 0433 210100 lac i 100 0434 242347 dac pa3 0435 322345 dio ar1 /append program variables 0436 202345 lac ar1 0437 500234 pg5, sad n 0440 600452 jmp pg6 0441 212345 lac i ar1 0442 160613 cal cns-1 0443 222346 lio ar2 0444 160614 cal cns 0445 242346 dac ar2 0446 442345 idx ar1 0447 212345 lac i ar1 0450 242345 dac ar1 0451 600437 jmp pg5 /expand go-list (on a-list) 0452 212347 pg6, lac pa3 0453 242345 pg7, dac ar1 0454 500234 sad n 0455 600471 jmp pg0 0456 212345 lac i ar1 0457 160555 cal car 0460 640400 sma 0461 600466 jmp pg9 0462 292345 lac ar1 0463 222346 lio ar2 0464 160614 cal cns 0465 242346 dac ar2 0466 442345 pg9, idx ar1 0467 212345 lac i ar1 0470 600453 jmp pg7 /// program feature, sub zero /process program 0471 202347 pg0, lac pa3 /// program feature, sub one 0472 500234 pg1, sad n 0473 600516 jmp pg2 0474 212347 lac i pa3 0475 160555 cal car 0476 640200 spa 0477 600511 jmp pg3 /// push ar2 on stack 0500 202346 lac ar2 0501 170044 jda pwl 0502 200100 lac 100 0503 161564 cal evo 0504 620055 jsp uwl 0505 322346 dio ar2 0506 760200 cla 0507 522350 sas pa4 0500 600515 jmp pg4 0511 442347 pg3, idx pa3 0512 212347 lac i pa3 0513 242347 dac pa3 0514 600472 jmp pg1 /terminate program 0515 202350 pg4, lac pa4 /// program feature, sub 2 0516 170054 pg2, jda uw 0517 322350 dio pa4 0520 620055 jsp uwl 0521 322347 dio pa3 0522 200054 lac uw 0523 600556 jmp x /RETURN 0524 242350 ret, dac pa4 0525 600556 jmp x /// GOE (lengthened) /GO 0526 220100 goe, lio 100 0527 200234 lac n 0530 160614 cal cns 0531 242347 dac pa3 0532 602241 jmp prx /SETQ 0533 242345 stq, dac ar1 0534 322502 dio t1 0535 212345 lac i ar1 0536 160403 cal asc /// push qa4 on stack 0537 602163 jmp qa4 0540 170044 jda pwl 0541 202345 lac ar1 0542 160554 cal cdr 0543 160555 cal car 0544 222502 lio t1 0545 161563 cal evl 0546 170054 jda uw 0547 320021 dio t0 0550 440021 idx t0 0551 200054 lac uw 0552 250021 dac i t0 0553 600556 jmp x /// (Contents of Decrement Register) /CDR 0554 440100 cdr, idx 100 /// (Contents of Address Register) /CAR 0555 210100 car, lac i 100 /// exit from machine language LISP functions 0556 170054 x, jda uw 0557 320561 dio rx 0560 200054 lac uw /// return to calling sequence of a subroutine 0561 rx, exit +0561 600000 jmp /ATOM 0562 210100 atm, lac i 100 0563 640400 sma 0564 602241 jmp fal /// true 0565 202343 tru, lac tr 0566 600556 jmp x /NULL 0567 220234 nul, lio n /// entry point of EQ (lengthened) /EQ 0570 320042 eqq, dio a1 0571 500042 sad a1 0572 600565 jmp tru 0573 210042 lac i a1 0574 030100 and i 100 0575 023531 and (jmp 0576 523531 sas (jmp 0577 602241 jmp fal 0600 200100 lac 100 0601 160156 cal vad 0602 500041 sad a0 0603 600565 jmp tru 0604 602241 jmp fal /RPLACD 0605 440100 rdc, idx 100 0606 423530 sub (1 /RPLACA 0607 330100 rda, dio i 100 0610 600556 jmp x /create atom 0611 043542 mka, ior (add 0612 240100 dac 100 0613 220234 lio n /CONS 0614 440030 cns, idx ffi 0615 202341 cnc, lac fre 0616 500234 sad n 0617 600673 jmp gcs /// CONS, sub a 0620 240021 cna, dac t0 0621 200100 lac 100 0622 252341 dac i fre 0623 442341 idx fre 0624 212341 lac i fre 0625 332341 dio i fre 0626 242341 dac fre 0627 200021 lac t0 0630 600556 jmp x /PLUS 0631 161770 pls, cal elc 0632 223543 lio (add a0 /// plus, zero sum storage register 0633 340041 plz, dzm a0 /// plus, sub one 0634 320642 pl1, dio plo /// plus, sub two 0635 500234 pl2, sad n 0636 600647 jmp ple 0637 240042 dac a1 0640 210042 lac i a1 064l 160144 cal vag /// plus, operation 0642 000000 plo, 0 0643 240041 dac a0 0644 200042 lac a1 0645 160554 cal cdr 0646 600635 jmp pl2 /// plus, exit 0647 200041 ple, lac a0 0650 600112 jmp crn /LOGAND, LOGOR, TIMES /// LOGAND 0651 161770 lga, cal elc 0652 223544 lio (-0 0653 320041 dio a0 0654 223545 lio (and a0 0655 600634 jmp pl1 /// LOGOR 0656 161770 lgo, cal elc 0657 223546 lio (ior a0 0660 600633 jmp plz /// TIMES 0661 161770 tim, cal elc 0662 223530 lio (1 0663 320041 dio a0 0664 223547 lio (jmp tic 0665 600634 jmp pl1 /// times, complete 0666 540041 tic, mul a0 0667 677001 scr 1s 0670 320100 dio 100 0671 400100 add 100 0672 600643 jmp plo+1 /// garbage collector, step 0673 620235 gcs, jsp gc 0674 202341 lac fre 0675 520234 sas n 0676 600620 jmp cna 0677 602217 jmp qg1 /// make a carriage return, TERPRI (terminate printing) /TERPRI 0700 700077 tpr, law 77 0701 160117 cal pc 0702 602241 jmp prx /PRIN1 0703 210100 pr1, lac i 100 0704 640400 sma 0705 602237 jmp qp1 0706 423550 sub (lac 0707 640200 spa 0710 600730 jmp prn 0711 023551 and (-jmp 0712 500234 pra, sad n 0713 600556 jmp x 0714 240041 dac a0 0715 210041 lac i a0 0716 661077 ral 6s 0717 160117 cal pc 0720 210041 lac i a0 0721 671077 rar 6s 0722 160117 cal pc 0723 210041 lac i a0 0724 160117 cal pc 0725 440041 idx a0 0726 210041 lac i a0 0727 600712 jmp pra 0730 200100 prn, lac 100 0731 160144 cal vag 0732 242502 dac t1 0733 760002 clf 2 0734 setup t0,6 +0734 710006 law i 6 +0735 240021 dac t0 0736 220022 prv, lio t1 0737 503552 sad (-1 0740 760012 stf 2 0741 760200 cla 0742 663007 rcl 3s 0743 320022 dio t1 0744 650100 sza i 0745 700020 law 20 0746 503553 sad (20 0747 640002 szf 2 0750 160117 cal pc 0751 460021 isp t0 0752 600736 jmp prv 0753 602241 jmp prx /// ("is a number") /NUMBERP 0754 210100 nmp, lac i 100 0755 023531 and (jmp 0756 503531 sad (jmp 0757 600565 jmp tru 0760 602241 jmp fal /do a CONS into full word space 0761 220234 cf, lio n /// CONS pair in full word space 0762 340030 cpf, dzm ffi 0763 600615 jmp cnc /MINUS 0764 160144 min, cal vag 0765 761000 cma 0766 600112 jmp crn /XEQ 0767 160156 xeq, cal vad 0770 202343 lac tr 0771 240022 dac t1 0772 200043 lac a2 0773 160144 cal vag 0774 220041 lio a0 0775 321000 dio xei 0776 200042 lac a1 0777 220054 lio uw 1000 000000 xei, 0 1001 601017 jmp xen 1002 320043 dio a2 1003 160112 xer, cal crn 1004 242345 dac ar1 1005 200043 lac a2 1006 160112 cal crn 1007 242346 dac ar2 1010 200022 lac t1 1011 160614 cal cns-1 1012 222346 lio ar2 1013 161743 cal efc 1014 222345 lio ar1 1015 240100 dac 100 1016 601743 jmp efc 1017 320043 xen, dio a2 1020 220234 lio n 1021 320022 dio t1 1022 601003 jmp xer /GENSYM /// gensym, entry 1023 700034 gsm, law gst 1024 240021 dac t0 /// gensym, index 1025 450021 gsi, idx i t0 1026 503554 sad (12 1027 601951 jmp gsn 1030 503555 sad (21 1031 700001 law 1 1032 250021 dac i t0 /// gensym, produce 1033 200036 gsp, lac gst+2 1034 661077 ral 6s 1035 040035 ior gst+1 1036 661077 ral 6s 1037 040034 ior gst 1040 160761 cal cf 1041 706700 law 6700 1042 040038 ior gst+4 1043 661077 ral 6s 1044 040037 ior gst+3 1045 220021 lio t0 1046 160762 cal cpf 1047 160611 cal mka 1050 600556 jmp x /// gensym, next 1051 700020 gsn, law 20 1052 250021 dac i t0 1053 440021 idx t0 1054 523556 sas (gst+5 1055 601025 jmp gsi 1056 601033 jmp gsp /QUOTIENT 1057 160156 qot, cal vad 1060 220041 lio a0 1061 760200 cla 1062 642000 spi 1063 764200 clc 1064 663001 rcl 1s 1065 560042 div a1 1066 602233 jmp qi4 1067 600112 jmp crn /COND 1070 322346 cnd, dio ar2 /// COND sub one 1071 242345 cd1, dac ar1 1072 500234 sad n /// push qa3 on stack 1073 602154 jmp qa3 1074 170044 jda pwl /// push ar2 on stack 1075 202346 lac ar2 1076 170044 jda pwl 1077 212345 lac i ar1 1100 160555 cal car 1101 161564 cal evo 1102 170054 jda uw 1103 322346 dio ar2 1104 620055 jsp uwl 1105 322345 dio ar1 1106 200054 lac uw 1107 520234 sas n 1110 601114 jmp cdy 1111 442345 idx ar1 1112 212345 lac i ar1 1113 601071 jmp cd1 /// COND sub y 1114 212345 cdy, lac i ar1 1115 160554 cal cdr 1116 160555 cal car 1117 601564 jmp evo /STOP 1120 160156 stp, cal vag 1121 764400 hlt+cli-opr 1122 602241 jmp prx /GREATERP /// (is greater than) 1123 160156 grp, cal vad 1124 651600 clo 1125 420041 sub a0 1126 641000 szo 1127 200042 lac a1 1130 640400 sma 1131 602241 jmp fal 1132 600565 jmp tru /get a character /// get a character, advance 1133 640050 ava, szs 50 1134 601204 jmp avi 1135 764000 cli /// advance, index 1136 200077 avx, lac 77 1137 650100 sza i 1140 601165 jmp avr 1141 663777 rcl 9s 1142 331136 dio i avx 1143 66103 ral 2s 1144 650500 spq 1145 601133 jmp ava 1146 661177 ral 7s 1147 043557 ior (rar 1150 241152 dac avc 1151 700525 law 525 /// advance, compute parity 1152 760400 avc, xx 1153 640400 sma 1154 602200 jmp qc3 /// advance, truncate (to 6 bits from reader); /// also, detect upper or lower case in sign bit. 1155 700077 avt, law 77 1156 021152 and avc 1157 523560 sas (72 1160 503561 sad (74 1161 240026 dac csi 1162 500026 sad csi 1163 601133 jmp ava 1164 600556 jmp x /// advance, reader 1165 avr, index avx,ave,avx +1165 441136 idx avx +1166 523562 sas ave +1167 601136 jmp avx /// address of buf into avx 1170 init avx,buf +1170 700063 law buf +1171 261136 dap avx 1172 dap avs /// advance, next 1173 720001 avn, rpa 1174 673777 rcr 9s 1175 720001 rpa 1176 663777 rcl 9s /// advance, store 1177 320000 avs, dio xy 1200 step avs,dio 100,avn +1200 441177 idx avs +1201 523563 sas (dio 100 +1202 601173 jmp avn 1203 601133 jmp ava /// advance, in from typewriter 1204 650001 avi, szf i 1 1205 601133 jmp ava 1206 720004 tyi 1207 760001 clf 1 1210 321152 dio avc 1211 601155 jmp avt /terminate a print name /// terminate print name, and make name 1212 700072 mkn, law 72 1213 520027 sas cso 1214 160165 cal oc 1215 440033 idx isi 1216 240021 dac t0 1217 220234 lio n 1220 320033 dio isi 1221 210021 lac i t0 1222 330021 dio i t0 l223 600556 jmp x /pack character into print name 1224 261232 pak, dap pk1 1225 200026 lac csi 1226 500027 sad cso 1227 601232 jmp pk1 1230 240027 dac cso 1231 160165 cal oc /// pack character into print name, sub one 1232 700000 pk1, law 1233 240100 dac 100 1234 600165 jmp oc start