/Lisp interpreter 3-20-64, part 2 /PRINT 1235 240041 pnt, dac a0 1236 240042 dac a1 1237 160700 cal tpr /// print, sub one 1240 230041 pn1, lio i a0 1241 642000 spi 1242 601253 jmp pn2 1243 700057 law 57 1244 160117 pn5, cal pc 1245 200041 lac a0 1246 160554 cal cdr /// push result on stack 1247 170044 jda pwl 1250 230041 lio i a0 1251 320041 dio a0 1252 601240 jmp pn1 /// print, sub two 1253 200041 pn2, lac a0 1254 160703 cal pr1 1255 620055 pn6, jsp uwl 1256 760200 cla 1257 320041 dio a0 1260 642000 spi 1261 601277 jmp pn7 1262 230041 lio i a0 1263 652000 spi i 1264 601244 jmp pn5 1265 200041 lac a0 1266 500234 sad n 1267 601274 jmp pn3 1270 700073 law 73 1271 160117 cal pc 1272 200041 lac a0 1273 160703 cal pr1 1274 700055 pn3, law 55 1275 160177 cal pc 1276 601255 jmp pn6 1277 160177 pn7, cal pc 1300 200042 lac a1 1301 600041 jmp a0 /READ 1302 000000 ri8, 0 1303 000000 ri9, 0 /// READ in 1304 200561 rin, lac rx 1305 242345 dac ar1 1306 341303 dzm ri9 /// read ins symbol 1307 621333 ris, jsp rhe 1310 650100 sza i 1311 601504 jmp ric 1312 503564 sad (57 1313 601526 jmp ria 1314 503565 sad (55 1315 601543 jmp rib /. /// read in, dot 1316 642000 rid, spi 1317 601330 jmp ri2 /// read in, sub q 1320 442345 riq, idx ar1 1321 212345 lac i ar1 1322 332345 dio i ar1 1323 241303 dac ri9 1324 621333 jsp rhe 1325 601547 jmp rix /// read in, sub 3 1326 241303 ri3, dac ri9 1327 601324 jmp ri3-2 /// push this on stack 1330 203566 ri2, lac (jmp ri3 1331 170044 jda pwl 1332 701504 law ric /read symbol and terminator /// read in, entry; /// (a "terminator" is a left parenthesis, period, space, /// comma, or tab) (mnemonic: h precedes i) 1333 261503 rhe, dap rhx 1334 760005 clf 5 1335 340022 dzm t1 1336 700032 law isi-1 1337 240033 dac isi 1340 340032 dzm isi-1 1341 700072 law 72 1342 240027 dac cso /// read symbol and terminator, next 1343 161133 rhn, cal ava 1344 240100 dac 100 1345 220026 lio csi 1346 672007 rir 3s 1347 642000 spi 1350 601360 jmp rhb 1351 503567 sad (33 1352 760200 cla 1353 523565 sas (57 1354 503566 sad (55 1355 601411 jmp rye 1356 503570 sad (73 1357 601411 jmp (rye 1360 503571 rhb, sad (56 1361 601407 jmp ryo 1362 503532 sad (77 1363 601343 jmp rhn 1364 503572 sad (36 1365 760200 cla 1366 650100 sza i 1367 601411 jmp rye 1370 503570 sad (75 1371 601334 jmp rhe+1 1372 710007 law i 7 1373 020100 and 100 1374 650100 sza i 1375 601464 jmp ryn 1376 200100 lac 100 1377 503553 sad (20 1400 601464 jmp ryn /// symbol lookup, pack 1401 760015 ryp, stf 5 1402 161224 cal pak 1403 601343 jmp rhn /// symbol lookup, sub j 1404 200022 ryj, lac t1 1405 160112 cal crn 1406 601476 jmp rhr /// symbol lookup, sub o 1407 161133 ryo, cal ava 1410 601401 jmp ryp /symbol lookup /// search for symbol in object list and /// if not found, put at beginning 1411 241302 rye, dac ri8 1412 161212 cal mkn 1413 240041 dac a0 1414 500234 sad n 1415 601473 jmp ryy 1416 650005 szf i 5 1417 601404 jmp ryj 1420 212334 lac i 1ob /// symbol lookup, search for symbol 1421 240021 rys, dac t0 1422 500234 sad n 1423 601455 jmp ryc 1424 210021 lac i t0 1425 240022 dac t1 1426 210022 lac i t1 1427 240022 dac t1 1430 200041 lac a0 /// symbol lookup, search for word 1431 240042 ryw, dac a1 1432 520234 sas n 1433 601441 jmp ryt 1434 500022 sad t1 1435 601462 jmp rhh /// symbol lookup, index 1436 440021 ryd, idx t0 1437 210021 lac i t0 1440 601421 jmp rys /// symbol lookup, test 1441 200022 ryt, lac t1 1442 500234 sad n 1443 601436 jmp ryd 1444 210042 lac i a1 1445 530022 sas i t1 1446 601436 jmp ryd 1447 440022 idx t1 1450 210022 lac i t1 1451 240022 dac t1 1452 440042 idx a1 1453 210042 lac i a1 1454 601431 jmp ryw /// symbol lookupm create (creating what is necessary to /// put something on the OBLIST 1455 200041 ryc, lac a0 1456 160611 cal mka 1457 232334 lio i 1ob 1460 160614 cal cns 1461 252334 dac i 1ob 1462 210021 rhh, lac i t0 1463 601476 jmp rhr /// symbol lookup, number 1464 220100 ryn, lio 100 1465 200022 lac t1 1466 672007 rir 3s 1467 663007 rcl 3s 1470 240022 dac t1 1471 200100 lac 100 1472 601402 jmp ryp+1 /// symbol lookup, exit 1473 764200 ryy, clc 1474 223541 lio (isi-1 1475 320033 dio isi /// read symbol and terminator, sub r 1476 240021 rhr, dac t0 1477 201303 lac ri9 1500 221302 lio ri8 1501 321303 dio ri9 1502 220021 lio t0 /// read symbol and terminator, exit 1503 rhx, exit +1503 600000 jmp /, space tab /// read in, comma 1504 202345 ric, lac ar1 1505 642000 spi 1506 601307 jmp ris 1507 640200 spa 1510 601524 jmp ri4 /// read in, sub o 1511 320021 rio, dio t0 1512 160554 cal cdr 1513 220021 lio t0 /// read in, sub e 1514 rie, swap /// swap AC & IO +1514 663777 rcl 9s +1515 663777 rcl 9s 1516 160614 cal cns 1517 442345 idx ar1 1520 200021 lac t0 1521 252345 dac i ar1 1522 242345 dac ar1 1523 601307 jmp ris /// read in, sub 4 1524 200021 ri4, lac t0 1525 602345 jmp ar1 /( /// read in, left parenthesis 1526 320021 ria, dio t0 /// push ar1 on stack 1527 202345 lac ar1 1530 170044 jda pwl 1531 200021 lac t0 1532 640200 spa 1533 601541 jmp riz /// read in, sub y 1534 160613 riy, cal cns-1 1535 242345 dac ar1 1536 222345 lio ar1 1537 160605 cal rdc 1540 601307 jmp ris /// read in, zeroing 1541 342345 riz, dzm ar1 1542 601307 jmp ris /) /// read in, right parenthesis 1543 442345 rib, idx ar1 1544 212345 lac i ar1 1545 220234 lio n 1546 332345 dio i ar1 /// read in, exit 1547 170054 rix, jda uw 1550 322345 dio ar1 1551 662001 ril 1s 1552 200054 lac uw 1553 642000 spi 1554 602345 jmp ar1 1555 220054 lio uw 1556 202345 lac ar1 1557 640100 sza 1560 601511 jmp rio 1561 200054 lac uw 1562 601534 jmp riy /EVAL 1563 322346 evl, dio ar2 /// EVAL, old 1564 242345 evo, dac ar1 /evaluate current expression /// evaluate current expression, sub 2 1565 202345 ev2, lac ar1 1566 640010 szs 10 1567 161235 cal pnt 1570 212345 lac i ar1 1571 640200 spa 1572 601626 jmp e1 1573 240021 dac t0 1574 210021 lac i t0 1575 640200 spa 1576 601661 jmp e2 /car[x] not atomic 1577 502332 sad 1la 1600 602077 jmp e3 /// push ar2 on stack 1601 202346 lac ar2 1602 170044 jda pwl /// push ar1 on stack 1603 202345 lac ar1 1604 170044 jda pwl 1605 212345 lac i ar1 1606 161564 cal evo 1607 620055 jsp uwl 1610 322345 dio ar1 1611 620055 jsp uwl 1612 322346 dio ar2 1613 601620 jmp evc /evaluate function name and try again /// evaluate, sub 3 1614 212345 ev3, lac i ar1 1615 160403 cal asr 1616 602171 jmp qa8 1617 160554 cal cdr /// evaluate, construct 1620 442345 evc, idx ar1 1621 232345 lio i ar1 1622 200054 lac uw 1623 342345 dzm ar1 1624 160614 cal cns 1625 601564 jmp evo /x is atomic : search a-list, / then p-list /// evaluate, sub one 1626 661001 e1, ral 1s 1627 640200 spa 1630 601655 jmp en1 1631 202345 lac ar1 1632 160402 cal asr 1633 601636 jmp ev5 1634 160554 cal cdr 1635 601656 jmp ex 1636 202345 ev5, lac ar1 /// evaluate, sub 4 1637 160554 ev4, cal cdr 1640 500234 sad n 1641 602171 jmp qa8 1642 240021 dac t0 1643 210021 lac i t0 1644 502333 sad 1ap 1645 601651 jmp ev6 1646 440021 idx t0 1647 210021 lac i t0 1650 601637 jmp ev4 1651 440021 ev6, idx t0 1652 210021 lac i t0 1653 160555 cal car 1654 601656 jmp ex /// evaluate, number, sub one 1655 202345 en1, lac ar1 /exit from EVAL 1656 640010 ex, szs 10 1657 601235 jmp pnt 1660 600556 jmp x /car[x] is atomic : search / its p-list /// evaluate, sub 2; CAR X is atomic, search its P-list 1661 200021 e2, lac t0 1662 160554 ev8, cal cdr 1663 500234 sad n 1664 601614 jmp ev3 1665 210054 lac i uw 1666 502336 sad 1fs 1667 601701 jmp efs 1670 502335 sad 1sb 1671 601757 jmp esb 1672 502337 sad 1xp 1673 601746 jmp exp 1674 502340 sad 1fx 1675 601715 jmp efx 1676 440022 idx t1 1677 210022 lac i t1 1700 601662 jmp ev8 /function is FSUBR 1701 440054 efs, idx uw 1702 210054 lac i uw 1703 160555 cal car 1704 160144 cal vag 1705 241713 dac exx 1706 442345 idx ar1 1707 212345 lac i ar1 1710 222346 lio ar2 1711 240100 exy, dac 100 1710 342345 dzm ar1 /// evaluate, exit, execute 1713 000000 exx, 0 1714 601656 jmp ex /function is FEXPR 1715 440054 efx, idx uw 1716 210054 lac i uw 1717 160555 cal car /// push result on stack 1720 170044 jda pwl 1721 202345 lac ar1 1722 160554 cal cdr 1723 161736 cal efq 1724 170044 jda pwl 1725 202346 lac ar2 1726 161736 cal efq 1727 160613 cal cns-1 1730 620055 jsp uwl 1731 161743 cal efc 1732 620055 jsp uwl 1733 161743 cal efc 1734 242345 dac ar1 1735 601565 jmp ev2 /// evaluate, function sub q 1736 160613 efq, cal cns-1 1737 220021 lio t0 1740 202331 lac 1qu 1741 240100 dac 100 1742 600614 jmp cns /// evaluate, function sub c 1743 320100 efc, dio 100 1744 220021 lio t0 1745 600614 jmp cns /function is EXPR 1746 440054 exp, idx uw 1747 210054 lac i uw 1750 240042 dac a1 1751 442345 idx ar1 1752 232345 lio i ar1 1753 342345 dzm ar1 1754 212345 lac i ar1 1755 160614 cal cns 1756 601564 jmp evo /function is SUBR 1757 440054 esb, idx uw 1760 210054 lac i uw 1761 160555 cal car 1762 170044 jda pwl 1763 202345 lac ar1 1764 160554 cal cdr 1765 162346 lio ar2 1766 161770 cal elc 1767 602050 jmp els /evaluate argument list : also LIST /// evaluate, argument is a list; also LIST 1770 500234 elc, sad n 1771 600556 jmp x 1772 242345 dac ar1 1773 322346 dio ar2 1774 202346 lac ar2 1775 170044 jda pwl 1776 202345 lac ar1 1777 342345 dzm ar1 /// evaluate, list, entry 2000 172344 ele, lio i pdl 2001 240021 dac t0 2002 170044 jda pwl 2003 202345 lac ar1 2004 170044 jda pwl 2005 210021 lac i t0 2006 161563 cal evl 2007 160613 cal cns-1 2010 620055 jsp uwl 2011 322345 dio ar1 2012 160021 lio t0 2013 202345 lac ar1 2014 650100 sza i 2015 322345 dio ar1 2016 442345 idx ar1 2017 423530 sub (1 2020 520021 sas t0 2021 172345 lio i ar1 2022 200021 lac t0 2023 252345 dac i ar1 2024 242345 dac ar1 2025 440021 idx t0 2026 330021 dio i t0 2027 620055 jsp uwl /// swap AC & IO 2030 swap +2030 663777 rcl 9s +2031 663777 rcl 9s 2032 160554 cal cdr 2033 520234 sas n 2034 602000 jmp ele 2035 620055 jsp uwl 2036 322346 dio ar2 2037 442345 idx ar1 2040 212345 lac i ar1 2041 160234 lio n 2042 332345 dio i ar1 2043 242345 dac ar1 2044 640010 szs 10 2045 161235 cal pnt 2046 202345 lac ar1 2047 600556 jmp x /// evaluate, list, subroutine 2050 242345 els, dac ar1 2051 620055 jsp uwl /// swap AC & IO 2052 swap +2052 663777 rcl 9s +2053 663777 rcl 9s 2054 160144 cal vag 2055 241713 dac exx /// address of a0-1 into esa 2056 init esa,a0-1 +2056 700040 law a0-1 +2057 262067 dap esa /store arguments for subroutine 2060 202345 lac ar1 /// entry, deposit argument /// (store arguments for subroutine) 2061 500234 eda, sad n 2062 602074 jmp exs 2063 442067 idx esa 2064 503574 sad (dac a2+1 2065 602166 jmp qa7 2066 212345 lac i ar1 /// evaluate, store argument 2067 240000 esa, dac xy 2070 442345 idx ar1 2071 212345 lac i ar1 2072 242345 dac ar1 2073 602061 jmp eda /// eval, exit, subroutine 2074 200041 exs, lac a0 2075 220042 lio a1 2076 601711 jmp exy /caar[x] = LAMBDA /// evaluate, sub 3; CAAR X equals LAMBDA 2077 202345 e3, lac ar1 2100 170044 jda pwl 2101 202346 lac ar2 2102 170044 jda pwl 2103 212345 lac i ar1 2104 160554 cal cdr 2105 160555 cal car 2106 170044 jda pwl 2107 202345 lac ar1 2110 160054 cal cdr 2111 222346 lio ar2 2112 161770 cal elc 2113 242345 dac ar1 2114 620055 jsp uwl 2115 320041 dio a0 2116 620055 jsp uwl 2117 322346 dio ar2 /// evaluate, pair, sub one 2120 200041 ep1, lac a0 2121 500234 sad n 2122 602143 jmp ep2 2123 202345 lac ar1 2124 500234 sad n 2125 602211 jmp qf3 2126 210041 lac i a0 2127 232345 lio i ar1 2130 160614 cal cns 2131 222346 lio ar2 2132 160614 cal cns 2133 242346 dac ar2 2134 440041 idx a0 2135 210041 lac i a0 2136 240041 dac a0 2137 442345 idx ar1 2140 212345 lac i ar1 2141 242345 dac ar1 2142 602120 jmp ep1 /// evaluate, pair, sub two 2143 522345 ep2, sas ar1 2144 602206 jmp qf2 2145 620055 jsp uwl 2146 322345 dio ar1 2147 212345 lac i ar1 2150 160554 cal cdr 2151 160554 cal cdr 2152 160555 cal car 2153 601564 jmp evo /error halt entries /// error halt, illegal COND ; icd 2154 200234 qa3, lac n 2155 522347 sas pa3 2156 600556 jmp x 2157 error flex icd /illegal COND +2157 620216 jsp err +2160 716364 flex icd 2161 200234 lac n 2162 600556 jmp x /// error halt, undefined atom in SETQ; uss 2163 qa4, error flex uss /undefined atom in SETQ +2163 620216 jsp err +2164 242222 flex uss 0005 602241 jmp prx /// error halt, too many arguments; tma 2166 qa7, error flex tma /too many args +2166 620216 jsp err +2167 234461 flex tma 2170 602074 jmp exs /// error halt, unbound atomic symbol; uas 2171 qa8, error flex uas /unbound atomic symbol +2171 620216 jsp err +2172 246122 flex uas 2173 760006 clf 6 2174 202345 lac ar1 2175 161235 cal pnt 2176 160700 cal tpr 2177 600004 jmp go /// error halt, illegal parity; ilp 2200 qc3, error flex ilp /illegal parity +2200 620126 jsp err +2201 714347 flex ilp 2202 700377 law 377 2203 021152 and avc 2204 764401 hlt+cli-opr+1 2205 601133 jmp ava /// error halt, LAMBDA list too short; lts 2206 qf2, error flex lts /LAMBDA list too short +2206 620216 jsp err +2207 432322 flex lts 2210 600004 jmp go /// error halt, argument list too short; ats 2211 qf3, error flex ats /arglist too short +2211 620216 jsp err +2212 612322 flex ats 2213 600004 jmp go /// error halt, pushdown capacity exceeded; pce 2214 qg2, error flex pce /pushdown cap. exc. +2214 620216 jsp err +2215 476365 flex pce 2216 600004 jmp go /// error halt, storage capacity exceeded; sce 2217 qg1, error flex sce /storage cap. exc. +2217 620216 jsp err +2220 226365 flex sce 2221 600004 jmp go /// error halt, nonnumeric argument for arithmetic; nna 2222 200100 qi3, lac 100 2223 240043 dac a2 2224 error flex nna /non-numeric arg for arith. +2224 620216 jsp err +2225 454561 flex nna 2226 760006 clf 6 2227 200043 lac a2 2230 161235 cal pnt 2231 160700 cal tpr 2232 602235 jmp qix /// error halt, overflow; ovf 2233 qi4, error flex ovf /overflow +2233 620216 jsp err +2234 462566 flex ovf /// error halt, exit 2235 760216 qix, cla 16 2236 600112 jmp crn /// error halt, argument non-atom for PRIN1 2237 qp1, error flex ana /arg non-atom for PRIN1 +2237 620216 jsp err +2240 614561 flex ana /// false (value is NIL) /// print, exit after finishing print 2241 200234 prx,fal, lac n 2242 600556 jmp x start