lisp 29 may 1970 /assemble with SS3 up to include pprint repeat ifup 3,[printx .with pprint .] /F1 - push down buffers /F2 - apply /F3 - read (minus seen) /F4 - 0 if printing error /F5 - read (xx.xx seen) /F6 - read (letter seen) size.=100 /size of pdl buffers atoms.=220 /min. non-initial syms syms.=400 /words for printnames dfd.=15 repeat 1-if2,[equals retn return equals u character equals r repeat] function even x retn [x-1]>>05<<37+1 termin define error who,where q.=flexo who jsp err'where [q^77xi]>>05<<[q^7700]>>05<<[q^770000x100] terminate cn=(1nil cfrs=(frs c1frs=(100000-frs c1=(1 cp12=(lac pd1+pd2-1 bind=jdp bn push=jda pwl pop=jdp po zorch=jdp zo >>75<< 0/ jmp 102 100/ 0 ior (400000 /makes into a jmp (because of extend mode) 102, jmp pd1 /becomes jmp be0, then push sub c1 dap .+1 lac . dap pwl pwl-1, lac 100 pwl, 0 /push dap psx idx pdl sad top jmp p1 pw2, lac pwl dac i pdl psx, jmp . tru, lac (1t jmp x po, 0 /pop pdl, lac . dac pwl law i 1 adm pdl sad bot jmp ps2 po2, lac pwl jmp i po caddr, cal cdr /"caddr" cadr, SAA /"cadr" caar, cal car /"caar" jmp car cddr, SAA /"cddr" cdar, cal car /"cdar" cdr, idx 100 /"cdr" car, lac i 100 /"car" sza jmp x error cva,+1 fal, lac cn jmp x 0 /jmp here on fatal error stops, xct sect+3 jmp .stop loop, law 10 dap ers xct sect+1 cal read xct sect lac 100 cal eval xct sect+2 lac 100 cal print jmp loop cons-1, lio cn cons, lxr fre /"cons" TXXP| cal gc iam dac i 0 lac i 1 dio i 1 dac fre TXAIX dac t1 /for zorch x-1, nam quote,list, x, dac 100 pop ral 1s spa jmp pwl-1 lio pwl pop dio i pwl jmp x+1 imr, nam error imr jmp stops >>16<< /entries to "read" section read, jsp rdb gensym, jsp rdb readc, law rdb rdb, dap rbx lac sect+1 rdb+2, dac .+3 lac sect+4 /to get back to this section cpush, push 0 /get section wanted jmp sect+5 /entries to "print" section print, jsp pdb prin1, jsp pdb r ifup 3,pprint, jsp pdb terpri, jsp pdb prindef, jsp pdb 1err, jsp pdb out, jsp pdb character=. law pdb pdb, dap rbx lac sect+2 jmp rdb+2 /entries to "trace" section trace, jsp tdb untrace, jsp tdb dex, jsp tdb gc, jsp tdb stop=. law tdb tdb, dap rbx lac sect+3 jmp rdb+2 biw, 0 /bring in drum section biw+1, dap .+3 law sect mta lac . ivk dfd hlt lio ios jmp i biw xr, dac 100 /return from drum section pop dap .+1 xct . jmp x+1 pa3, 0 /prog return value pa4, 0 /prog current location a1, 0 /arguments to subr's a2, 0 a3, 0 t1, 0 t2, 0 rad, 10. /radix gst, 0 /gensym counter top, lac . /top of current buffer bot, lac . dp, 0 /next pushdown buffer ios, 0 /saved io during drum swaps rbx, jmp . /entry to drum sections cas, 72 /typewriter case chrct, 0 /print position ers, szs 10 /error recovery switch hih, i /end of core snd, lac esy /end of active symbol table hnd, enh /end of active heads low, frs /beg. of free storage rdx, jmp rd1 /last break character rpc, 0 /stuff for input file rip, rbf rdp, 0 ins, 0 /input source (isp rpc or jmp tin) ous, 0 /output destination odp, 0 /stuff for output file oup, 0 ocp, 0 fre, 0 /free storage pointer r p1, szf 1 i /push overflow jmp p1a /in upper buffer clf 1 /in lower buffer p1b, law pd2~pd3 /switch buffers xor top dac top law [pd1-1]~[pd2-1] xor bot dac bot SAA dac pdl /reset to bottom jmp pw2 p1a, dio ios /write out lower buffer lac cp12 sub bot mta lio dp law size+20 ivk dfd hlt law size adm dp lio ios sas (i jmp p1b pce, lac bot dap pdl error pce jmp stops ps2, szf 1 /pop overflow jmp p2a /in lower buffer stf 1 /in upper buffer p2b, law [pd1-1]~[pd2-1] /switch buffers xor bot dac bot law pd2~pd3 xor top dac top sub c1 dac pdl /reset to top jmp po2 p2a, dio ios /read in lower buffer law i size adm dp lia lac cp12 sub bot mta law size ivk dfd hlt lio ios jmp p2b v crn, TAAI>P /create number cma sub (20000 A.IAM TI< jmp cr2 add (260000 /short format number ral 1s jmp x cr2, cal cons-1 /long format number x4, xor (400000 jmp x vag, sma /get value of number jmp nna sub cfrs sma jmp nna sub c1frs sma jmp car /long format rar 1s /short sub (220000 jmp x zo,t3, 0 /zorch idx i pdl dac t2 idx t1 lac i t2 dac i t1 dio i t2 dio i pdl idx pwl lac i pwl jmp i zo err-2, lio a1 /error, print a1 jmp err+2 err, ZIP err+1, lio 100 /error, print 100 dap erx lac i erx cal 1err erx, jmp . constants pd1, law dfd /first pushdown buffer and setup routine mta 204 mta 300 bpt law be0 dap 102 law 100 mta lia law 7720 ivk dfd /save program hlt cli law 60 /in case started at 0 ivk dfd hlt be0, eem iam lac cpush /repair cal handler dac 102 law 2 mta 400 sza i jmp be1 law sect /read e.t.'s current page pointer mta lio (340 law 40 ivk 2 hlt law i 1 add sect+373-340 TAI rcr 5s ril 5s ral 5s dio rdp adm rip be1, tyi /read memory bound law 7 A^IA A~IP law 1 /assume 4k rar 6s dac hih mta 207 /set memory bound bpt law imr mta 203 /set illegal memory return lio ([oev ene-sect]^777740 law end-oev-ene sect [oev ene-sect]^777740 mta law even[oiv]-[oev ene-sect]^777740 ivk dfd /read in atom heads hlt lio (oiv^777740 law frs-oiv oiv^777740 mta law even[oiv tsy-frs]-oiv^777740 >>76<< ivk dfd /read in initial values hlt lio cn /set up non-initial heads lxr (enh dzm i 0 dio i 1 SXX SXXA sas cfrs jmp .-5 lio (be9 sr spr law sym mta law otv-be9-sr-spr ivk dfd hlt lio (otv law sect mta law st ivk dfd /get "trace" section hlt lxr (tsy cli /chain up free storage be7, dio i 1 TXXI law 2 A+XAX sas hih jmp be7 sub (2 dac fre nam jmp stops constants eni, be9=even[.] pd1+size/ pd2, pd2+size/ /second buffer pd3_, >>32<< /"read" section offset be9-sect sect, jsp ger /instruction to get eval nop /or read jsp gpr /or print jsp gtr /or trace jmp sect+1 /get this section law .+3-read adm rbx lac 100 jmp rbx jmp .read jmp .gensym jmp .readc chs, -2 /goes to 0 if printnames change chb, 1 /goes to 0 if input buffer read chr, 0 /rewrite printnames if changed dac biw dio ios isp chs jmp i chr .r1.=be9 sr spr [esy-sym]^777740 .r2.=sin-[esy-sym]^777740 .r3.=sym [esy-sym]^777740 r if2,r ifm .r2,.r1.=be9 sr spr .r2.=40 .r3.=sym law .r3 mta lio (.r1 law .r2+20 ivk dfd /write out symbols hlt jmp i chr ger, jdp chr /get eval from read lio (oev jsp biw 1 se gpr, jdp chr /get print section lio (be9+sr jsp biw 1 sp gtr, jdp chr /get trace section lio (otv jsp biw 1 st in, xct ins jmp rn2 law i 3 dac rpc idx rip sas (rbf+40 jmp rn2 law rbf dac rip law 40 rn1, adm rdp dzm chb TAI rcl 6s dap .+5 rir 6s law rbf mta law 40 ivk . hlt rn2, cla sas chb jmp rn1 lio i rip lac rpc rir 6s SAAP jmp .-2 rcl 6s sad (77 dzm rpc jmp gtc tin, tyi lai gtc, sas (74 /upper case sad (72 /lower case dac cas jmp x .readc, cal in sad cas jmp .readc lio cas rir 2s spi i add (100 cal crn jmp xr 1 rbf, .+40/ /input buffer m .read, cla>>05<>52<< vb, cal in /. rsl, stf 6 /letter seen pt1, lac . lio 100 rcr 6s dac i pt1 and (77 sad (76 jmp rlp idx pt1 jmp rd2 tbs, lac . lia rar 6s dap rdx spi i jmp rdx law i 4000 adm rdx lac i snd sad (767676 jmp rdx /no atom szf 5 i jmp iif sas (547676 szf 6 jmp int /atomic symbol lac a1 /number szf 3 cma cal crn jmp rxy+2 int, law sym /oblist lookup dap pt2 dzm chr /symbol count idx pt1 int2, lac snd dap sy1 pt2, lac . sy1, sad . jmp id2 and (77 /go to next name sad (76 jmp id1 idx pt2 xct pt2 jmp .-5 id1, idx chr idx pt2 sas snd jmp int2 law frs sad hnd jmp ace lac pt1 dac snd >>32<< law 2 adm hnd dzm chs fou, lac chr sal 1s add (add end jmp rxy+1 id2, idx sy1 xor (sad~lac sad pt1 jmp fou idx pt2 jmp pt2 ace, error ace jmp stops nce, error nce jmp stops iif, error iif jmp stops LPR= SZF I >>05<< ?[ JMP IIF LAC CN PUSH JMP RD" PER= LAC I PDL ?x SAD CN JMP IIF RAR "S SPQ >>05<< JMP IIF IDX I PDL JMP RD" RPR= LAW RD" ?] DAP RDX LAC I PDL RAR "S SPQ JMP IIF POP SZF >>05<< SAD CN JMP RXY IDX PWL LIO CN LAC I PWL DIO I PWL RXY= STF >>05<< DAC ".. POP SZA I JMP XR+1 push rar 1s spa jmp rd5 lac 100 cal cons-1 lac i pdl sad cn jmp rdn zorch jmp rdx rdn, idx t1 dio i t1 jmp rd7 rd5, lio i pwl lac 100 dac i pwl clf 5 rd7, dio i pdl jmp rdx >>53<< tb1, 20+100xnum /dispatch table 54+100xmin 55+100xrpr+add 57+100xlpr+add 73+100xper+add 00+100xrd1+add 36+100xrd1+add 77+100xrd1+add tb2, 56+100xvb 75+100xbsp 13+100xrlp tb3, c .gensym, cla /"gensym" push /this fools int lac snd dap gen1 SAA dap pt1 sub (lac end-1 sma jmp nce idx gst lio (767676 cal gen2 rir 6s dio i pt1 cal gen2 cal gen2 lac (u lg rcl 6s gen1, dio . jmp int gen2, dio t1 mul c1 div (10. gn1, 0 dac gn1 lac t1 A.IAP| law 20 rar 6s rcl 6s lac gn1 jmp x constants enr, sr=even[.-sect] 6 /"print" section offset be9+sr-sect sect/ jsp gep /instruction to get eval jsp grp /or read nop /or print jsp gtp jmp sect+2 law .+3-print adm rbx lac 100 jmp rbx jmp .print jmp .prin1 r ifup 3,jmp .pprint jmp .terpri jmp .prindef jmp .err jmp .out jmp .character chw, 1 /goes to 0 if obf contains data rwb, 0 /write out obf if needed dac biw dio ios lac chw sza jmp i rwb law obf mta lio odp cla rcl 6s rir 6s dap .+2 law 60 ivk . hlt jmp i rwb grp, jdp rwb /get read from print lio (be9 jsp biw 1 sr gep, jdp rwb /get eval from print lio (oev jsp biw 1 se gtp, jdp rwb lio (otv jsp biw 1 st . .err, clf 4 dio t2 dac pr0 idx erx law 3577 cal p2 lac pr0 cal p3 lac t2 sza cal print law 34 cal out cla>>05<>76<< .chara, TAX push jmp ch3 ch1, cal cdr push dio a2 lio i a2 ch3, TIAI>12<< pra, sub cfrs /print atom sma jmp prs /symbol lac 100 cal vag TAAI>P cma dac pr0 law u r- spi cal out dzm 100 dpl, lac pr0 dac t2 mul c1 div rad pr0, 0 sas 100 jmp dpl+1 TIAP| law u r0 cal out lac t2 dac 100 sas pr0 jmp dpl jmp x+1 prs, add (frs-end-add sar 1s SAA cma dac pr0 law sym-1 dac t2 jmp prp idx t2 /find printname law 77 and i t2 sas (76 jmp .-4 prp, isp pr0 jmp .-6 idx t2 /print it lac i t2 cal p3 and (77 sas (76 jmp .-5 jmp x+1 4 .terpri, law 77 /"terpri" dac chrct cal out fax, lac cn jmp xr .prin1, TAI /"prin1" push pn1, dio t1 TIA>P jmp pn2 law u r( pn5, xct ers jmp pn6 cal p4 lac t1 cal cdr push lio i t1 jmp pn1 pn2, cal pra pn6, pop dac t1 sza i jmp pn7 TAI>P xct ers jmp pn5 /print next item on list lai sad cn jmp pn3 law flexo . cal p3 lac t1 cal pra pn3, law u r) cal p4 jmp pn6 .print, dac t1 /"print" cal terpri lac t1 cal prin1 law 0 cal p4 pn7, lac a1 jmp xr a .prinde, sad cn /"prindef" jmp pf1 push cal caar cal cons-1 lac (1quote cal cons cal cons-1 lac i pdl cal car swp push swp cal cons-1 lac (1quote cal cons pop swp cal cons lac (1rplaca cal cons cal print cal terpri pop cal cdr jmp .prinde pf1, lac (1stop cal cons-1 jmp xr constants enp, sp=even[enp-sect] spr=sp r ifm sp-sr,spr=sr sym=spr+sect b /"trace" section offset otv-sect sect/ jsp get /instruction to bring in eval jsp grt /or read jsp gpt /or print nop /or trace jmp sect+3 /get this section law .+3-trace adm rbx lac 100 jmp rbx jmp .trace jmp .untrace jmp .dex jmp .gc jmp .stop get, dio ios lio (oev jda biw se grt, dac biw dio ios law sym mta lio (be9+sr+spr law sin ivk dfd hlt lio (be9 jsp biw 1 sr gpt, dio ios lio (be9+sr jda biw spr+sin constants m .trace, sad cn /"trace" jmp xr push lac i pwl dac t2 lac i t2 sza i jmp tr2 cal car sas (1nlambda sad (1nlamda jmp .+3 sas (1lambda jmp tr2 lac (199g cal cons-1 dac a1 lac (1print cal cons cal cons-1 lac (1return cal cons cal cons-1 push lac t2 cal cons-1 lac (1value cal cons cal cons-1 lac (1quote cal cons cal cons-1 lac (1print cal cons lio i pdl cal cons dio i pdl lac i t2 cal caddr cal cons-1 lac (199g cal cons lac (1setq cal cons lio i pdl cal cons dio i pdl lac i t2 cal cadr lia lac (1list cal cons cal cons-1 lac (1print cal cons lio i pdl cal cons dio i pdl lac t2 CAL CONS+" LAC ["ENTER CAL CONS CAL CONS+" LAC ["QUOTE CAL CONS CAL CONS+" LAC ["PRINT CAL CONS LIO I PDL CAL CONS LAC A" CAL CONS LAC ["PROG CAL CONS LAC I T' CAL CDDR DIO I ".. POP TR'= POP CAL CDR JMP xTRACE xUNTRAC= SAD CN ?"untrace" jmp xr cal car lac i 100 sza i jmp ut2 cal cddr dac t2 cal cdar lia cal caar sas (199g jmp ut2 lai cal cddr cal cadr cal caddr dac i t2 ut2, idx a1 lac i a1 dac a1 jmp .untrac n .dex, cal cdr /"dex" lia lac i a1 dac t2 lac (1lambda cal cons dio i t2 lac t2 jmp xr ( .stop, cli>>05<>05<>05<>05<P jmp gca lac i 1 /concatenation rar 1s spa jmp gfx idx i 1 /turn on mark bit lio i 0 law 1 ior g1 dac i 0 /point car back at previous thing jmp in2 /start working on car gca, sub (100000 /atom spa jmp gfx /direct number add c1frs sma jmp gfx /atomic symbol law 1 /indirect number ior i 1 dac i 1 gfx, lxr g1 /thing in IO is marked TXXP| jmp i gfr law i 1 /back up and i 1 dac g1 law 1 ior i 0 sas i 0 jmp gcb dac i 1 /point cdr back at previous thing dio i 0 /replace car lio g1 jmp in2 /start working on cdr gcb, X.IA /returning from cdr ior (1 dac i 1 /replace cdr jmp in3 constants ent, st=even[.-sect] >>16<< /"eval" section offset oev-sect sect/ nop /instruction to bring in eval jsp gre /or read jsp gpe /or print jsp gte /or trace jmp sect /get this section gre, dac biw /get read dio ios law sym /get names mta lio (be9+sr+spr law sin ivk dfd hlt lio (be9 jsp biw 1 sr constants gpe, dio ios lio (be9+sr jda biw spr+sin gte, dio ios lio (otv jda biw st z return=. dac pa3 /"return" go, dac pa4 /"go" jmp x prog, lio cn /"prog" lac i a1 dac 100 prog+3, spa jmp pr2 lac i 100 /get a prog variable bind lac 100 cal cdr jmp prog+3 pr2, lac a1 pr3, cal cdr TAAI>P jmp pr35 cal car spa bind /bind prog tags lai jmp pr3 pr35, lac pa3 push lac pa4 push dzm pa3 lac a1 pr4, cal cdr dac pa4 sad cn jmp pr6 /program finished lac i pa4 cal eval ik2, lac pa4 lio pa3 sni jmp pr4 lai /program returned pr6, dac 100 pop dac pa4 pop dac pa3 jmp x+1 ikd, pop sad .+1 jmp ik2 push error icd jmp fal cn2, pop cal cdr cond, spa /"cond" jmp ikd push cal caar cal eval sad cn jmp cn2 pop lac i pwl dac pwl prog3, idx pwl lac i pwl spa jmp x+1 prog2, push /"prog2" cal eval-1 pop jmp prog3 l enl, spi /function is "nlamda" jmp tma lac i 100 lio a2 bind clc jmp el7 elb, lac a1 /function is "label" cal cadr swp>>05<| jmp sr9 lac i 100 sp2, dac . idx sp2 lac 100 spa jmp tfa >>37<< cal cdr jmp sp1 sr9, lac 100 sas cn jmp tma exg, lac a1 lio a2 dac 100 exs, jmp . ( e4, lac i a1 /function is symbol sza sad a1 jmp uaf dac a1 jmp apl uaf, error uaf,-2 jmp fal e3, lac a1 /function is not atomic push lac i a1 sad (1nlambda jmp .+3 sas (1nlamda cal evlis /evaluate arguments pop dac a3 /entire function cal cdr dac a1 /cdr of function cal car /leave lambda list in 100 lia lac i a3 sas (1nlambda sad (1nlamda jmp enl sad (1lambda jmp el1 sad (1label jmp elb lac a2 /evaluate entire function push lac a3 cal eval dac a1 /evaluated function pop dac a2 /arg list apply, clf 2 /"apply" jmp apl s evlis, lac a2 szf 2 sad cn jmp x push cal eval-1 cal cons-1 lac i pdl dac pwl dio i pdl jmp el2 ele, push cal eval-1 cal cons-1 pop el2, zorch sma jmp ele el5, lio cn pop el5+2, idx pwl lac i pwl dio i pwl dac a2 /evaluated args jmp x bn, 0 /bind push lac i pwl dio i pwl push jmp i bn zerop, cal vag /"zerop" ZIP null, lio cn /"null" eq, A~IP /"eq" jmp fal jmp tru number, sma /"numberp" jmp fal sub cfrs atom, sma /"atom" jmp fal jmp tru minusp, cal vag /"minusp" jmp atom y eq4, pop cal cdr lia pop cal cdr equal, A~IP| /"equal" jmp tru A^I>P jmp eq3 A~I>P jmp fal push lai push lac i 100 lio i pwl cal equal sas cn jmp eq4 pxx, pop pop jmp x+1 eq3, lxr cfrs XMA.< XMI> jmp fal cal vag swp cal vag jmp eq minus, jsp nmop-1 /"minus" jmp .+1 minus+2, add t2 CAAM| cla /fix -0 jmp nm3 times, law 1 /"times" dac t2 jsp nmop jmp .+1 mul t2 scr 1s A+IA jmp nm3 r plus, law minus+2 /"plus" nmop-1, dzm t2 nmop, dap nm2 lac 100 nm1, dac a2 spa jmp nm9 lac i a2 cal vag nm2, xct nm9+1 /return 0 if nna error nm3, dac t2 lac a2 cal cdr jmp nm1 add1, cal vag /"add1" SAA| nm9, lac t2 nm9+1, jmp crn logand, clc /"logand" dac t2 jsp nmop and t2 logor, jsp nmop-1 /"logor" ior t2 logxor, jsp nmop-1 /"logxor" xor t2 greate, cal vag /"greaterp" dac a1 lac a2 cal vag clo sub a1 szo lac 100 jmp atom remain, cal divi /"remainder" swp jmp crn divi, lai cal vag dac a2 lac a1 cal vag mul c1 div a2 jmp .+2 jmp x error dze jmp nna+2 quotie, cal divi /"quotient" . jmp crn nna, error nna,+1 nna+2, cla>>05<>32<< sassoc, iam /"sassoc" TIX>P jmp ss2 lio i 1 lxr i 0 sas i 0 jmp sassoc+1 nam TXA jmp x ss2, nam lac cn lio a3 jmp apl-3 valp, sma /"valp" jmp fal sub cfrs TA>52<< subst, push /"subst" lai push cal subs1 jmp pxx subs1, lio a2 lac a3 cal equal sad cn jmp .+3 lac a1 jmp x lac a3 spa jmp x cal cdr push lac i a3 dac a3 cal subs1 lio i pdl dac i pdl dio a3 cal subs1 lia pop dac 100 jmp cons revers, lio cn /"reverse" sad cn jmp xi push cal car cal cons pop cal cdr jmp revers+1 setq, push /"setq" lai cal eval lia pop dac 100 setqq, dio i 100 /"setqq" xi, dio 100 jmp x+1 >>75<< nth, cal vag /"nth" cma>>05<>52<< define here apval nil su cons,2 su quote,11 su car,1 su cdr,1 su caar,1 su cadr,1 su cdar,1 su cddr,1 su caddr,1 su null,1 2rplac.=9rplac su rplacd,2 9rplac.=2rplac 2rplac.=8rplac su rplaca,2 8rplac.=2rplac su setq,12 su setqq,12 su prog,14 su go,1 su return,1 apval t su zerop,1 thing lambda thing nlambda thing nlamda thing label su cond,14 su apply,2 su eval,1 su list,4 su terpri,0 su valp,1 su numberp,1 su atom,1 su prog2,14 su read,0 su readc,0 su prin1,1 su print,1 su character,4 su stop,0 su eq,2 su equal,2 su add1,1 su sub1,1 2minus.=9minus su minusp,1 9minus.=2minus 2minus.=8minus su minus,4 8minus.=2minus su plus,4 su times,4 su logand,4 su logor,4 su logxor,4 8 su greaterp,2 su remainder,2 su quotient,2 su and,14 su or,14 su mapcar,2 su append,2 su nconc,2 su member,2 su gensym,0 su sassoc,3 su prindef,14 su dex,14 su subst,3 su fix,13 su reverse,1 su length,1 su nth,2 su trace,14 su untrace,14 r ifup 3,su pprint,1 thing 99g thing enter thing value scar 0,space scar 57,lpar scar 55,rpar scar 35,red scar 34,black scar 73,period scar 77,carret scar 36,tabul scar 75,backspace terminate j sym=sect+spr p.=777700 v.=767676 define pname name z=v irpc w,name z=[z^p u r'w]xi r ifn z^77-76,z z=v terminate z terminate define su name,num pname name terminate define apval name pname name terminate define thing name pname name terminate define scar name,sname namexi 7676 pname sname terminate offset be9+sr+spr-sym sym/ here /names esy, sin=even[syms esy-sym] r ifm sin spr-ste,sin=ste-spr end=sym sin sin=ste-spr r ifm sin-1,sin=40 /crock end=end^1+end oev=even[esy-sym] otv=be9 sr spr sin r ifm sin-oev,otv=otv-sin oev oev=otv st define su name,num 1'name.=add . 2'name 1nil terminate define apval name 1'name.=add . 1'name 1nil terminate define thing name 1'name.=add . 0 1nil terminate 9 define scar name,sname 2'sname.=add . 0 1nil 2'sname 1nil terminate offset oev ene-sect-end end/ here /heads enh, frs=2xatoms+enh oiv=oev+ene-sect+enh-end define su name,num 2'name.=add . jmp ixnum+name 1t terminate define apval name terminate define thing name terminate define scar terminate offset oiv-frs and.=and2 frs/ here /values and.=20000 tsy, pdo=[oiv+tsy-frs-1]>>05<<[size-1]+1 r 1-if2,start define wr x,what printx /what / printo x printc 36 decimal printo x octal printc 77 terminate wr [[i-frs]>2],[free storage] /size of free storage in 4K wr i-pdo,[pushdown capacity] wr end-esy,[symbol table] /size wr frs,frs /origin of program space wr pd1,[common section] /size wr ene-sect,[eval] /size wr ent-sect,trace /size wr enp-sect,print /size wr enr-sect,read /size wr end-ene,[space above eval] / wasted because syms is large wr pd3-eni,[setup margin] start 102 c