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