lisp storage 7-30-64
constants
sbuf, sbuf+lbuf/
/special symbols
ssy,
1fa, funarg
1la, lambda
1ap, apval
1ob, ob
1sb, subr
1fs, fsubr
1xp, expr
1fx, fexpr
fre, nil
tr, t
n1, add nil
ar1, nil
ar2, nil
arf, nil
pa3, 0
pdl, frs
pdo,
/load storage parameters
lio (77
tyo-i
jsp tni
sub (1
and (177777
dac hi1
jsp tni
and (177777
dac lp1
jsp tni
and (177777
dac t1
add lp1
dac lp1
add (pdo
dac fro
lac t1
add (pdo
dac ebp
lac hi1
sub (ms
sma
jmp pdo
law i frs
add fro
spa
jmp pdo
law i end-frs
add hi1
sub fro
spa
jmp pdo
lac (cs
sub fro
spa
jmp pdo
getmem
cli
law end
dac t0
cld, doa t0
idx t0
sas hi1
jmp cld
/set up registers
stu, lac fro
lio hi1
rcr 1s
ril 1s
dio hi
lio ebp
lac (jmp
rcl 3s
rir 3s
dio bse
dac bse+1
law end
dac t0
/relocate storage
rrs, law i 1
add t0
dac t0
jsp rrl
jsp mvs
law i 1
add t0
dac t0
laa t0
and (370000
sza i
jsp rrl
jsp mvs
lac t0
sas (frs
jmp rrs
law ssy
dac t0
/relocate special registers
rss, jsp rrl
idx t0
sas (pdo
jmp rss
lac fre
dac n
dac npn
lac 1ob
jda gfr
law 4
dap gcx
jmp g2e
/relocate 1 word, move 1 word
rrl, dap rrx
laa t0
and (177777
sub (pdo
spa
jmp rrx
laa t0
add fro
sub (frs
daa t0
rrx, jmp .
mvs, dap mvx
lac t0
add fro
sub (frs
dac t1
laa t0
daa t1
mvx, jmp .
lp1, 0
hi1, 0
/type number in
tni, dap tnx
tnz, dzm t1
tnn, cla>>05<<cli 7
cksb 3
tyi
swap
sad (27
jmp tnz
sad (77
jmp tne
rcr 3s
lac t1
rcl 3s
dac t1
jmp tnn
tne, lac t1
tnx, jmp .
constants
frs,
/macros for oblist
define link k,p,a,b,c
. 2 o'k o'k=.-2
add . 2 p
nn a
repeat 0if vz flexo b . 1 nn b
repeat 0if vz flexo c . 1 nn c
nil
termin link
define numb n
numr=n
numr^77777>>05<<jmp numrx10^7
termin numb
define su k,l,a,b,c/g
link k,g,a,b,c
g, . 2 nil
subr . 1
repeat 1if vz l numb jmp a'b'c
repeat 0if vz l numb l
termin su
define fsu k,l,a,b,c/g
link k,g,a,b,c
g, . 2 nil
fsubr . 1
repeat 1if vz l numb jmp a'b'c
repeat 0if vz l numb l
termin fsu
define blob k,a,b
a'b=. 2 link k,nil,a,b
termin blob
define ap k,l,a,b/g
a'b=. 2 link k,g,a,b
g, . 2 nil
apval l
termin ap
define nn c
nf=flexo c
repeat 2 repeat 1if vz nf^77 nf=nfxi opr
nf
termin nn
define slirp u
define sl b u termin sl
sl 1 sl 2 sl 3
sl 4 sl 5 sl 6 sl 7
sl 10 sl 11 sl 12 sl 13
sl 14 sl 15 sl 16 sl 17
termin slirp
/oblist (h.c.)
ob, o0
slirp [. 1 o'b]
nil
ob nhb nhb,
/initialize oblist (h.c.)
nil=. 2 o0=nil
slirp [o'b=nil]
/objects
ap 3,nil,nil
ap 1,t,t
ap 14,ob,obl,ist
ap 1,bso,bpo
ap 0,bse,bpe
bso, numb pdo
bse, numb pdo
blob 11,lam,bda
blob 16,apv,al
blob 11,sub,r
blob 15,fsu,br
blob 4,exp,r
blob 4,fex,pr
blob 0,fun,arg
/SUBRs, FSUBRs
su 13,,ato,m
su 17,,car
su 2,,cdr
fsu 0,,con,d
su 0,,con,s
su 15,,eq
su 3,,gen,sym
su 7,,gre,ate,rp
fsu 17,,lis,t
su 4,,min,us
su 16,,num,ber,p
su 14,jmp stp,sto,p
su 13,,pri,n1
su 3,,quo,tie,nt
su 4,,rpl,aca
su 4,,rpl,acd
su 5,,xeq
su 15,,loc
su 11,jmp errr,err,or
fsu 13,,set,q
su 11,,err,ors,et
su 1,,app,ly
su 7,,caa,r
su 12,,cad,r
su 12,,cda,r
su 15,,cdd,r
su 2,,equ,al
su 7,opr,pro,g1
su 7,lac a1,pro,g2
su 16,,mem,ber
su 4,,rem,ob
su 13,,adv,anc,e
su 17,,put,ob
su 0,,nco,nc
su 15,,pac,k
su 1,,unp,ack
fsu 7,,pro,g
su 2,,ret,urn
su 15,jmp goe,go
su 6,,sas,soc
su 1,,rea,d
su 14,,eva,l
su 13,jmp pnt,pri,nt
fsu 3,jmp car,quo,te
su 15,jmp nul,nul,l
fsu 17,,plu,s
fsu 1,,tim,es
fsu 2,,log,and
fsu 2,,log,or
su 16,,cha,rp
end,
0/ jmp pdo
start 0