lisp 8-2-64 _. part 1

3/	jmp break
go,	lsm
	csys
	lac ap1
	dac ap2
	cbs
	esm
	clf 7

beg,	dzm pa3
	lac fro
	dac pdl
	lac n
	dac ar2
	dzm erl
	cal read
	dac arf
	cal cdr
	dac ar1
	laa arf
	cal apl-1
	cal pnt
	jmp beg

fro,	frs
ebp,	frs
t0,	0
t1,	0
hi,	0
csi,	0
cso,	0
isj,	0
isi,	isj-1
erl,	0
gst,	repeat 5,20
a0,	0
a1,	0
a2,	0
cst,	72

/append word to pdl

pwl,	0
	dap pwx
	undex pdl
	sad ebp
	jmp qg2
	lac pwl
	dac i pdl

pwx,	exit
       
                                        
/retrieve word from pdl

uw,	0
uwl,	dap uwx
	lio i pdl
	idx pdl

uwx,	exit

100/	0
	dap rx
	sub (1
	dap .+1
	lac
	dap sx
	undex pdl
	sad ebp
	jmp qg2
	lac rx
	dac i pdl
	lac 100
sx,	exit

117,	.+gap/

/create number

loc,
crn,	lio (jmp
	rcl 3s
	rar 3s
	dac 100
	jmp cpf

/get numeric value

vag,	loa 100
	cla
	rcl 3s
	sas (6
	jmp qi3
	lad 100
	rcl 7s
	rcl 8s
	jmp x

/get two values

vad,	dio a1
	cal vag
	dac a0
	lac a1
	cal vag
	dac a1
	jmp x1
       
                                        
/pack character onto end of buffer

oc,	rar 6s
	loa isi
	rcl 6s
	sad (76
	jmp oc1
	lac 100
	ior (767600
	cal cf
	lio t0
	dod isi
	dio isi
	jmp x1

oc1,	doa isi
	jmp x1

/NCONC

nconc,	dio 100
	sad n
	jmp x1
	dac 100
nconc1,	dac a0
	lad a0
	sas n
	jmp nconc1
	doa a0
	jmp x1
       
                                        
/SASSOC

sassoc,	cal asc
	jmp ase
	jmp x1
ase,	lac a2
	cal cns-1
	jmp evo

asr,	lio ar2
asc,	dio a0
	dac t1
	laa 100
	and (jmp
	lio (sad 100
	sad (jmp
	lio (jmp as4
	dio asw
	lac a0

as1,	sad n
	jmp x
	laa a0
	dac t0
	laa t0
asw,	0
	jmp as2
as3,	ldad a0
	jmp as1
as4,	lio t1
	cal eq
	sad n
	jmp as3

as2,	idx i pdl
	lac t0
	jmp x

/program feature

/PROG

prog,	lac pa3
	jda pwl
	dio ar2
	loa 100
	lad 100
	dac pa3
	dio ar1
       
                                        
/append program variables

	lac ar1

pg5,	sad n
	jmp pg6
	laa ar1
	cal cns-1
	lio ar2
	cal cns
	dac ar2
	ldad ar1
	jmp pg5

/expand go-list (on a-list)

pg6,	lac pa3

pg7,	dac ar1
	sad n
	jmp pg0
	loa ar1
	dio t0
	loa t0
	spi i
	jmp pg9
	lio ar2
	cal cns
	dac ar2

pg9,	lad ar1
	jmp pg7

/process program

pg0,	lac ar2
	jda pwl
	lac pa3
pg1,	sad n
	jmp pg2
	laa pa3
	dac a0
	loa a0
	spi
	jmp pg8
	lio i pdl
	cal evl
pg8,	lad pa3
pg8a,	dac pa3
	jmp pg1
       
                                        
/terminate program

pg2,	jda uw
	dio ar2
	jsp uwl
	dio pa3
	lac uw
	jmp x

/SETQ

setq,	dac ar1
	laa ar1
	cal asr
	jmp qa4
	jda pwl
	lad ar1
	lio ar2
	cal eva
	idx i pdl
	dac t0
	idx pdl
	lac 100
	daa t0
	jmp x1
       
                                        
/CAR, CDR, etc.

cadr,	idx 100
caar,	laa 100
	dac 100
	jmp car
cddr,	idx 100
cdar,	laa 100
	dac 100
cdr,	idx 100
car,	laa 100

x,	dac 100
x1,	lac i pdl
	dap rx
	idx pdl
	lac 100
rx,	exit

/ATOM

atom,	laa 100
	sma
	jmp fal

tru,	lac tr
	jmp x

/NULL

nul,	sad n
	jmp tru
	jmp fal

/RETURN, GO

return,	law pg2
	jmp pgpop
goe,	law pg8a
pgpop,	dap pgpopx
pgpop1,	lac i pdl
	sad (jmp pg8
	jmp pgpop2
	idx pdl
	jmp pgpop1
pgpop2,	idx pdl
	lac 100
pgpopx,	jmp .
       
                                        
/EQ

eq,	dio a1
	sad a1
	jmp tru
	laa a1
	dac pwl
	laa 100
	sas pwl
	jmp fal
	and (jmp
	sas (jmp
	jmp fal
	lad a1
	dac pwl
	lad 100
	sas pwl
	jmp fal
	jmp tru

/RPLACD

rplacd,
rdc,	idx 100
	sub (1

/RPLACA

rplaca,
rda,	doa 100
	jmp x
       
                                        
/EQUAL

equal,	lac pdl
	jda pwl
eu1,	dio a1
	lac a0
	cal eq
	sad n
	jmp eup
eut,	jsp uwl
	dio a0
	sad a0
	jmp tru
	jsp uwl
	jmp eu1
eui,	idx pdl
euu,	law i 1
	add i pdl
	sas pdl
	jmp eui
	idx pdl
	jmp fal
eup,	laa a0
	dac pwl
	laa a1
	ior pwl
	spa
	jmp euu
	loa a0
	lad a0
	jda pwl
	dio a0
	loa a1
	lad a1
	jda pwl
	jmp eu1
       
                                        
/create atom

mka,	ior (add
	dac 100
	lio n

/CONS

cons,
cns,	idx ffi

cnc,	lac fre
	sad n
	jmp gcs

cna,	dac t0
	lac 100
	daa fre
	lad fre
	doa fre
	dac fre
	lac t0
	jmp x

gcs,	jsp gc
	lac fre
	sas n
	jmp cna
	jmp qg1
       
                                        
/PLUS

plus,	cal elc
	lio (add a0
plz,	dzm a0
pl1,	dio plo
pl2,	dac a1
	sad n
	jmp ple
	laa a1
	cal vag
plo,	0
	dac a0
	lad a1
	jmp pl2
ple,	lac a0
	jmp crn

/LOGAND, LOGOR, TIMES

logand,	cal elc
	lio (-0		dio a0
	lio (and a0	jmp pl1
logor,	cal elc
	lio (ior a0	jmp plz
times,	cal elc
	lio (1		dio a0
	lio (jmp tic	jmp pl1

tic,	mul a0
	scr 1s
	dio 100
	add 100
	jmp plo+1
       
                                        
/NUMBERP

numberp,	laa 100
	and (law
	sad (jmp
	jmp tru
	jmp fal

/do a CONS of a full word and a pointer

cf,	lio n

cpf,	dzm ffi
	jmp cnc

/MINUS

minus,	cal vag
	cma
	jmp crn

/XEQ

xeq,	cal vad
	lac tr
	dac t1
	lac a2
	cal vag
	lio a0
	dio xei
	lac a1
	lio 100
xei,	0
	dzm t1
	dio a2
	cal crn
	dac ar1
	lac a2
	cal crn
	dac ar2
	lac t1
	sza i
	lac n
	cal cns-1
	lio ar2
	cal efc
	lio ar1
	jmp efc
       
                                        
/CHARP

charp,	laa 100
	and (law
	sad (law
	jmp tru
	jmp fal

/GENSYM

gensym,	law gst
	dac t0

gsi,	idx i t0
	sad (12
	jmp gsn
	sad (21
	law 1
	dac i t0

gsc,	lac gst+2
	ral 6s
	ior gst+1
	ral 6s
	ior gst
	cal cf
	law 6700
	ior gst+4
	ral 6s
	ior gst+3
	lio t0
	cal cpf
	jmp mka

gsn,	law 20
	dac i t0
	idx t0
	sas (gst+5
	jmp gsi
	jmp gsc
       
                                        
/QUOTIENT

quotient,	cal vad
	law 1
	mul a0
	div a1
	jmp qi4
	jmp crn

/COND

cond,	dio pwl
	jsp pwl+1
	lac 100

cd1,	dac ar1
	sad n
	jmp qa3
	lio i pdl
	jda pwl
	laa ar1
	cal eva
	jda uw
	dio ar1
	lac uw
	sas n
	jmp cdy
	lad ar1
	jmp cd1

cdy,	jsp uwl
	laa ar1
	dac 100
	ldad 100
	jmp eva
       
                                        
/STOP

stp,	cal vag
	cli
	szs i 20
	jmp .-1
	jmp prx

/GREATERP

greaterp,	cal vad
	clo
	sub a0
	szo
	lac a1
	sma
	jmp fal
	jmp tru


start
       
                               b