lisp 8-2-64 _. part 2

/print or punch character

pc,	and (77
	sad (77
	jmp tpr
	sad (76
	jmp x1
	ior (ral
	dac pcc
	law 252

pcc,	xx
	and (200
	ior pcc
	cal out
	lac pcc
	sas (ral 74
	sad (ral 72
	jmp x1
	sas (ral 56
	sad (ral 40
	jmp x1
	isp pch
	jmp x1
tpr,	law i 100
	dac pch
	dac 100

/output routine

out,	szs i 36
	jmp ou1
	cksb 4
	lio 100
	ppa-i
ou1,	and (77
	clf 2
	szs i 66
	sad cst
	jmp x1
	sas (72
	sad (74
	dac cst
	cksb 2
	lio 100
	tyo-i
	jmp x1

pch,	-100
pc0,	jmp pc
       
                                        
/error printout

err,	lio erl
	spi
	jmp errs
	clf 6
	dap erx
	lac i erx
	dac ern
	law erm
	cal pra
	idx erx

erx,	exit

erm,	357776
	.+1
ern,	0
	.+1
	347776
n,	nil

define	error f
	jsp err
	flexo f
	termin
define	complain f
	jsp err+3
	flexo f
	termin

/ERROR

errr,	dac ar1
	error err
	lac ar1
	cal pnt
	jmp go

/garbage collector, non-compacting

gc,	dap gcx
	dio ga1
	dio gfr
	jsp gfr+1
	lac ffi
	sza i
	jmp gco
	lac 100
	jda gfr
gco,	lac 1ob
	jda gfr
       
                                        
	lac isj
	sza
	jda gci
gcw,	law ar1
	dac g1

gcp,	lac i g1
	jda gfr
	idx g1
	sas (pdl
	jmp gcp
	lac pdl
	dac g1
gcl,	sad fro
	jmp g2e
	lac i g1
	jda gfr
	idx g1
	jmp gcl

/intricate list marker

gfr,	0
	dap gkx
	lac gfr
	ral 1s
	spq
	jmp gkx
	sub (pdo+pdo
	spq
	jmp gkx
	cli
gkn,	law 1
	add gfr
	dac gk0
	laa gk0
	spa
	jmp gkz
	ior (add
	daa gk0
	laa gfr
	spa
	jmp gkd
	lac gfr
	dac gk0
gkh,	laa gk0
	rcl 1s
	rir 1s
	rar 1s
	doa gk0
	dac gfr
	dac gks
	lio gk0
	jmp gkn
       
                                        
gkz,	dio gkl
	lac gkl
	sza i
gkx,	jmp .
	loa gkl
	lac gks
	spi i
	jmp gkj
	ior (add
	daa gkl
	law i 1
	add gkl
	dac gks
	ril 1s
	sir 1s
	jmp gkz
gkj,	daa gkl
	idx gkl
	dac gk0
	ril 1s
	sir 1s
	jmp gkh
gkd,	ral 1s
	spa
	jmp gkz
	rar 1s
	dac gks
gkm,	lad gks
	ior (add
	daa gks
	dac gks
	sas n1
	jmp gkm
	jmp gkh
       
                                        
/garbage collector, linear sweep phase

g2e,	lac fro
	dac g0

g2n,	lod g0
	spi i
	jmp g2f
	ril 1s
	sir 1s

g2a,	doa g0
	idx g0
	sas hi
	jmp g2n

g2x,	lio ga1

gcx,	exit

g2f,	lio fre
	sub (1
	dac fre
	jmp g2a

gci,	0
	lad gci
	ior (add
	daa gci
	dac gci
	sas n1
	jmp gci+1
	jmp gcw

gks=gci
gkl=gfr

g0,gk0,	0
g1,	0
ga1,	0
ffi,	0
       
                                        
/service breaks

break,	chkb 1
	szs i 50
	szf i 6
	ril 2s
	spi i
	jmp 90d
	szs 50
	jmp 90i
	szf 6
	jmp 90r
90i,	tyi
	dzm 91r
90e,	lac i ap2
	rcl 9s
	lac ap2
	spa
	ril 9s
	dio i ap2
	add (add
	sad (sbuf lbuf
	law sbuf
	dac ap2
90d,	lac 0
	lio 2
	jmp i 1

ap1,	sbuf
ap2,	sbuf
90t,avc,	0
91t,	0
       
                                        
/PRIN1

prin1,	stf 2
pr1,	init pc0,pc
pr0,	laa 100
	sma
	jmp qp1
	sub (lac
	spa
	jmp prn
	and (-jmp

pra,	sad n
	jmp x
	dac a0
	laa a0	ral 6s	cal pc0
	laa a0	rar 6s	cal pc0
	laa a0		cal pc0
	lad a0
	jmp pra

/ERRORSET

errorset,	lac ar2
	jda pwl
	undex erl
	lac 100
	lio n
	cal evl
erre,	cal cns-1
errx,	jsp uwl
	dio ar2
	idx erl
	jmp x1
erri,	idx pdl
errs,	lac i pdl
	sas (jmp erre
	jmp erri
	lac n
	dac 100
	idx pdl
	jmp errx
       
                                        
prn,	ral 2s
	spa
	jmp prc
	lac 100
	cal vag
	spa
	jmp prm
	dac t1
prr,	stf 2
	setup np1,6

prv,	lio t1
	sad (-1
	clf 2
	cla
	rcl 3s
	dio t1
	sza i
	law 20
	sad (20
	szf i 2
	cal pc0
	isp np1
	jmp prv
	jmp prx
       
                                        
/print special character

prc,	ral 4s
	sub (10050
	sma
	sub (30004
	add (770076
	dac np1
	law 56
	szf i 2
	cal pc0
	jsp pra
np1,	0
npn,	nil

prm,	szf 2
	jmp prr-1
	cma
	dac t1
	law 54
	cal pc0
	jmp prr

/reader break

90r,	prbrk
91r,	jmp 90d
	law 2525
	rcr 9s
	ral 9s
	sad (2000
	law 2100
	dap 93r
93r,	ril
	spi i
	jmp .+3
	clf 6
	ior (400
	and (577
	dac 91t
	lac ap2
	sub ap1
	lio 91r+1
	sas (-add-1
	sad (-lbuf-add-1
	dio 91r
	lio 91t
	jmp 90e

/ADVANCE

advance,	cal ava
mkc,	add (law
	cli
	dac 100
	jmp cpf
       
                                        
/get a character

ava,	lac 91r
	sad 94n
	jmp av1
	lac ap2
	sub ap1
	ral 1s
	spa
	add (lbuf lbuf
	sub (20
	spa
	jmp 91n
av1,	law i 7777
	dac 90t
av2,	lac ap1
	sad ap2
	jmp 90n
	lio i ap1
	add (add
	sad (sbuf lbuf
	law sbuf
	dac ap1
	sma
	ril 9s
	cla 16
	rcl 9s
	dac avc
	rar 7s
	spa
	jmp ava
	rar 2s
	spa
	jmp qc3
	lac avc
	sas (74
	sad (72
	jmp avu
	add csi
	jmp x
avu,	szf 6
	szs 50
	dac cst
	sub (72
	ral 5s
	dac csi
	jmp ava
90n,	isp 90t
	jmp av2
91n,	szf 6
	szs 50
	jmp av1
	lac 94n
	dac 91r
94n,	strdr
	jmp av1
       
                                        
/PRINT

pnt,	dac a0
	dac a1
	cal tpr

pn1,	loa a0
	spi
	jmp pn2
	law 57

pn5,	cal pc
	lac a0
	cal cdr
	jda pwl
	loa a0
	dio a0
	jmp pn1
pn2,	lac a0
	cal pr1

pn6,	jsp uwl
	cla
	dio a0
	spi
	jmp pn7
	loa a0
	spi i
	jmp pn5
	lac a0
	sad n
	jmp pn3
	law 73
	cal pc
	lac a0
	cal pr1

pn3,	law 55
	cal pc
	jmp pn6

pn7,	cal pc
	lac a1
	jmp a0
       
                                        
/READ

ri9,	0
ri0,	cal tpr
	xct ryz+3
	dac pdl
read,	lac pdl
	dap ryz+3
	dzm ri9

rsr,	lac (jmp ar1-1
	dac ar1
ris,	jsp rhe
	sad (-57
	jmp ria
	sad (-55
	jmp rib
	sas (-73
	jmp ric

/.

rid,	jsp rhe
	spa
	jmp ri2
riq,	jda rhf
	sas (-55
	jmp qp3
	lio rhf
	jmp ri3
ri2,	sas (-57
	jmp qp3
	lac ar1
	jda pwl
	lac (add
	jmp ria+1
       
                                        
/read symbol and terminator

rhf,	0
rhe,	dap rhx
	clf 5
	clf 3
	clf 4
	clf 2
	dzm t1
	law isj-1
	dac isi
	dzm isj
	dzm cso
ryz,	lac ri9
	sza
	jmp ryy
	law		/old pdl
	sad pdl
	jmp rxx

rhn,	cal ava
	sad (54
	stf 4
	sad (73
	jmp rye
	sad (33
	jmp ry0
	sas (57
	sad (55
	jmp rye
	sad (56
	jmp ryo
       
                                        
	and (77
	sas (13
	sad (77
	jmp rhn
	sad (75
	jmp ryk
	sas (36
	sza i
	jmp ry0
	szf 2
	jmp rhn
	sad (54
	jmp ryp+1
	stf 3
	law i 7
	and 100
	sza i
	jmp ryn
	law 20
	sad 100
	jmp ryn

ryp,	stf 5
	lac 100
	cal pak
	jmp rhn

ryj,	szf i 3
	jmp rym-3
	lac t1
	szf 4
	cma
	cal crn
	jmp rhr
       
                                        
ryo,	stf 2
	cal advance
	dac isi
	jmp rhn

/symbol lookup

ry0,	cla
rye,	dac ri9
	lac isi
	sad (isj-1
	jmp ryz
	szf 2
	jmp rhr
	szf i 5
	jmp ryj
	cal rym
	jmp rhr
	jmp ryc
       
                                        
rym,	cal mkn
	lac isj
	cal hc
	dac a2
	laa a2

rys,	dac t0
	sad n
	jmp rhk
	laa t0
	dac t1
	laa t1
	dac t1
	lac isj

ryw,	dac a1
	sas n
	jmp ryt
	sad t1
	jmp rhh

ryd,	lad t0
	jmp rys

ryt,	lac t1
	sad n
	jmp ryd
	laa a1
	dac 100
	laa t1
	sas 100
	jmp ryd
	ldad t1
	lad a1
	jmp ryw

rhk,	idx i pdl
	jmp x1
       
                                        
ryn,	lio 100
	lac t1
	rir 3s
	rcl 3s
	dac t1
	jmp ryp+1

ryc,	lac isj
	cal mka
	dac a0
	cal pob
	lac a0
	jmp rhr

rhh,	lac isi
	sza i
	jmp rhl
	lio fre
	dod isi
	lac isj
	dac fre
	dzm isj
rhl,	laa t0
	jmp x

ryk,	law isj-1
	sas isi
	jmp rhe+1
	jmp ri0

rxx,	lac ar1
	spa
	jmp rhn
	laa ar1
	jmp x
       
                                        
/hash coder

hc,	laa 100
	dac 100
	ral 6s
	add 100
	ral 6s
	add 100
	and (nhb-1
	ral 1s
	add 1ob
	jmp x

ryy,	cma
	dzm ri9

rhr,	dac t0

rhx,	exit

/atomic symbol

ric,	lio ar1
	spi
	jmp ri4
	dio t1
	lod t1
	lac t0
	cal cns
rie,	idx ar1
	lac t0
	daa ar1
	dac ar1
	jmp ris

ri4,	cal cns-1
	dac ar1
	jmp rie
       
                                        
/(

ria,	lac ar1
	jda pwl
	jmp rsr

/)

rib,	lio n
ri3,	lad ar1
	doa ar1
	spa
	lac n
rix,	jda uw
	lac uw
	dac t0
	dio ar1
	spi i
	jmp ric
	ril 1s
	spi
	jmp ri4
	jsp uwl
	dio ar1
	lac t0
	jmp riq


start