system debug - 19 august 66
5001/


define	init a,b
	law b
	dap a
termin

define	index a,b,c
	idx a
	sas b
	jmp c
termin

define	item a
	flexo a
	a
	terminate


cop=low 1
cad=low 3
c7=low 5	/jda
clw=low 7
ci=low 11
cdi=low 13

low,	item opr	 /)opr, add, jda, law used as constants
	item add	/)i, dio also used as constants
	ite   jd	/)they _ust not be killed
	item law	/)
	item   i	/)
	item dio	/)
tpt,	jda top	/constant
	0	/ditto
item adm
item and
                
                                item dac
item dap
item dip
item dzm
item idx
item ior
item iot
item isp
item jdp
item jmp
item jsp
ite  lac
item kio
item sad>>76<<item sas
item sft
item skp
item sub
item xct
tp,	item xor

6651/

top,	flexo  .a
ac,	0
flexo  .b
bk1,	-0
flexo  .i
io,	0
flexo  .m
msk,	-0
flexo  .q
lw,	0
flexo  .f
pf,	0
flexo  .e
be,	0
flexo  .l
ll,	70000
flexo  .u
ul,	70000 low-1
flexo   .
loc,	70000

est,	jda low

len=top-tp

start
                
                                /tsddt part 2

define disp lc,uc
ucx1000 lc-ev4x1001
termin

6676/

/services X
xe1,	hlt		/X ins placed here
	jmp lis

lis,	dac ac		/entry to program
	jdp ovf	/saves io, pf,be,seq br mode, resets bkpts
		/leaves seq br mode, saves state of ext ff
		/and overflow ff
lse,	jsp lcc
lss,	lac ll	/set ul to core of ll
	dip ul
	clf 6	/flag 6 is 1 when a char has been typed in
		/since last typeout or car ret

lsp,	dzm wrd	/numerical quantity being assembled
	lac cad	/add
ssn,	dip sgn	/sgn init  add
	dzm syl	/octal number being assembled
n2,	dzm sym	/alpha symbol being assembled
	clf 2	/flag 2 is 1 if letter in symbol

lsr,	lio sk1	/sza
	dio wea	/init searches for W or E
	clf 1	/flag 1 set when char typed in
	szf i 1
	jmp .-1	/wait till char typed
	tyi
ps1,	dio ch	/stores character typed
	law dtb	/beginning of dispatch table
	add ch
	dap . 1
	lac .	/get entry in disp tab
	szf 5	/flag 5 is 1 if in uc
	rar 9s
	and c10	/c(c10)=777
	add tls	/c(tls)=jmp ev4
	dap lsx	/set up exit
	sub cdl	/c(cdl)=jmp del,  the last no-eval routine
	spq
	jmp lsx	/no-eval routine, leave
	law syl	/set up sgn for number
	szf i 2	/skip if letter in symbol
	jmp ev4 1
	lac est
	jdp evl	/evaluate symbol
tls,	jmp ev4	/set up for eval exit
	law 7424	/um>>60<<df  ed sym_k    U
	jdp tys
	jmp lse
                
                                /eval exit
ev4,	idx ev2	/set up for eval exit
	dap sgn
	lac wrd
sgn,	add .	/add or sub  symbol value or number
	dac wrd	/put back in wrd
	szf i 6	/skip if typein since last cr or typeout
	lac lw
lsx,	jmp .	/dispatch exit

/evaluate symbols
evl,	0
evc,	d>>60<<p ev2
ev2,	lac .
	sa  s m
	jmp h evl
	idx d  
	idx ev2
	 as pev 1
	_mp ev2
	idx dvl
	jmp i evl
                
                                /no-eval routines

/numbers and letters
n,	rir 3s	/digit in io bits 15-17
	lac syl	/number assembled in syl
	rcl 3s
	dac syl
	jmp l1

l,	stf 2	/flag 2 on if letter in symbol
l1,	lac sym
	rcl 6s
	ior ch
	dac sym
	stf 6	/flag 6 on if letter or no. typed
	jmp lsr	/in since last car. or tab

/case shifts
uc,	stf 5	/set flag 5 in uc
	jmp lsr

lc,	clf 5	/clear flag 5 in lc
	jmp lsr
                
                                /define symbol
cpr,	szf i 2	/)
	jmp err
	lac stp
	jdp evl
	jmp df2
	lio sym
	dzm sym
kl2,	lac stp
	jdp evl
	jmp df3
	jmp tls+1
df3,	lem
df1,	dio i ev2	/used as constant
df2,	lem
	idx ev2
	lio wrd
	dio i ev2
	dio lw	/update last word typed
	eem
	jmp lse

/kill symbols
kil,	cli	/K
	szf 2	/go to error routine if no letter in symbol
	jmp kl2

/error routine
err,	law 7421
	jdp tys
	jmp lse

/delete
del,	jmp b_w	/x
                >>12<<                                        _ _ utines

smb,	law pi	/S
	jmp cns+1

cns,	law opt	/C
	dap pns
	jmp lse

/equals
eql,	dac lw	/=
	jsp lct
	lac lw
	jdp opt
cdl,	jmp del	/used as constant

/plus
pls,	jmp ssn-1

0minus
min,	clc>>05<<lia	/set up -0 for unary minus
sk3,	szf i 6	/skip if not unary minus
	dio wrd
	lac csu
	jmp ssn
                
                                /carriage return
cr,	jdp dep	/make any modificashons
	dac lw	/modify las  word typed_	law 600		 _d r ss par  _f   a>>04<<sma
	dap ope		/set switch  o register closed
	jmp lss

/backspace
bs,	jdp dep	/make any modifications
	jsp lcc
	law 1
	add loc	/increment location pointer
	dap loc
	j__ pad	/print location, /, tab
	jmo  >>60<<6  
                
                                /modify registers
bar,	szf 6	/slash - skhp if no ch>>60<<r typed simce last
		 tyo>>60<<out or br - c(lw) >>60<<m ac
	lac wrd	/pick up word typed
ta6,	dap loc	/set location pointer
	jsp lct
	lac bar	/set switch for register open
	dac ope
	lac i loc
	jdp lwt
bax,	 j  lct
	jmp lss

/under bar
ub,	szf 6	/select current core - no argument calls ignored
	dip loc
	jmp lse
                
                                
/  zero memory routine
/	does not protect itself
/	zeros between limits
zro,	lac ll
	dac opt		/temp
zr1,	dzm i opt	/zero it
	idx opt		/bump pointer
	sub ul
	spq		 /done?
	jmp zr1		/no
	jmp lse
                
                                /verify
vfy,	jsp lcc		/type lower case, car. ret.
	lac csd	/sad i
	jmp .+2

/yank
rd,	lac df1	  get dio i
  ip vf4

so_>>32<<	rpb	>>32<<2skh_ over read_m qoutine
	spi
	jmp rbk
	rpb
	jmp soi

rbk,	rpb		/read "first address"
	dio t
	dio chi		/checksum
	spi		/jump block?
	jmp lse		/yes, go to listen loop
	rpb		/read "last address + 1"
	dio t3
	lai
	adm chi		/add to cksum
vf1,	rpb		/get a datum word
	dio t2
	lac ll
	dip t		/make t "first addr" in current core
	dip t3
	sub t
	szm_ jmp vf2		   _6lower kim_t

	lac t		/check against upper limit
csu,	sub ul	/used as constant
	szm
	_mp vf2		/ h8upper lh_hs
                
                                /verify, page 2

	lai		/get word read in
vf4,	t		/dio i t  or  sad i t
	jmp vf2

vf3,	jsp pac	/print routine for verify
	jsp lct
	lac t2		/get word read in
	jdp lwt
	jsp lcc		/ lower case ,  car. ret

vf2,	lac t2		/get word read in
	adm chi		/add word to cksum
	index t,t3,vf1	/done check
	rpb		/readin checksum from tape
	lai
	sas chi		/test checksum
	hlt>>05<<clc		/checksum error, push cont _ d 
ee
			/to   y  a a 
	jmp rbk		/ok,  cmsinue wit_ next bloc                       
                                T, read in s  bols

tbl,  aw i len-1 /-l _ - _ add ttpttpt
	   c cc opt	  _   n3er
rr

tb1,	 ym tys	/ini  alize symbo_>>76<<	jsp rdr	/next charact  
	 ad t77	  i c.r.,
 _mp tb1	/s   t again
	sad t33	/if '='
	jmp tb2	/go to number routine
	rcr  6s/as  u  pq  eq character
	lac tys	/get partial symbol
	rcl 6s	/appe d
	dac tys	0 ave
	jmp     1

tb2,	  p ts  2 ous ne to save  ymbols and  alues
	dzm  y  0/m ti_ hy   va  >>76<<>>76<<tb3,	jsp rdr	/next character
	scr 15	/3s
	and .-1	/mask for zone
	sza	/if not zero,
	jmp tb4	/character--assume done
	lac tys	/number, get partial value
	rcl 3s	/append
	dac tys	/save
	jmp tb3	/go for more

tb4,	jsp tsv	/save value in symbol table
	jmp tb1	/next pair

rdr,	dap rdx	/routine to get next character
	rpa	/read next from tape
	lai	/to ac
	and t77	/mask out channels 7 and 8
	rir 7s	/position channel 7
	sni i	/if blank tape,
	spi	/or if ch. 7 punched,
	jmp rdr 1	/ignore
	sas t72	/if upper
	sad t74	/or lower case,
	jmp rdr 1	/ignore
	sad t13	/if stop code,
	jmp lse	/ e aqe done
rdx,	jmp ._ tsu,	dap t x	/routin_    s   e sy_bols and values
	idx opt	/bump pointer
	sad tpt	/if top of table,
	jmp err	/too many symbols
	lac tys	/get symbol
	dac i opt	/store
tsx,	jmp .

t13,	13	t33,	33
t72,	72	t74,	74
t77,	77







                
                                /xecute, go, and proceed
/no breakpoints at  jsp, jdp, jda, or xct instructions
xec,	dac xe1		/X
	law xe1		/indirections not guaranteed to work

bgn,	szf i 6		/G
	jmp err		/no argument
	dap bix
	lac prc
	dip bix		/jmp
pra,	jsp lcc		/P - arguments ignored
	lem
	lio i bk1
	dio bki		/save bkpt instruction
	lio cjd		/c(cj)=jda tr
	lac bk1
	sma		/skip if no bkpt
	dio i bk1
	clo
	lac ovf
	ral 1s
	spa		/restore orig ext/non_ext mode
	eem
	rar 1s		/restore orig overflow bit
  dd cad		/>>60<<_d=400000
	kio pf		/re  ore prog f_ gs
	lpf
	t  
	lio io		  >>60<<ss orrore io  _d a c   ,	lac ac
b  7,	_t 	/bkpt ins placed here
prc,	jmp .
prd,	jmp .
                     
                               /E, N, W  searchs
/E expects 15 bit address for argument

eas,	xor ll	/E - check if word sought in search core
	dzm t3	/flag for this
	dip t3
	law ext
	jmp ws

nws,	lac sk2	/N search - c(sk2)=sza i
	dac wea

wds,	law ws1	/W search
ws,	dap ws2	/set up exit for ext or ws1
	jsp lcc
	lac ll
	dac t	/t has address of 1st level of srch

ws4,	lio est	/io shifts count depths of ind for E srch
	dac t2	/t2 has addr of pres level of srch
	law ws6
	dap es1
	lac i t2
ws2,	jmp .

ext,	dap t2	/E srch - assume in extend mode
	ral 5s
	spa i	/check for .i bit
	jmp ea1	/this level or never
	lac i t2
	sad wrd
es1,	jmp .	/match found - either ws6 or es1+1
	lac t3	/assume inditdction
	rcl 1s
sk1,	s a	/ac is    f  p   co_ =srch core ^(l_ el
  mp  s3 /    f ind     )_	la  es  1
	jmp ws2_ 	/che c nex   evel of   d

                
                                /searches, page 2
ea1,	lac t2	/ins part of t2 is srch core
ws1,	xor wrd
	and msk
wea,	sza
	jmp ws3	/no match
ws6,	law lcc

pac,	dap pax	/routine to prnt adr, tab, ins
	lac t
	jdp pad
	lac i t
	jdp lwt
pax,	jsp .

ws3,	idx t	/index and loop
	sub ul
	sma
	jmp lse
	lac t
	jmp ws4

/end of disp>>60<<tched routines
                
                                /breakpoint trap
tr,	0	/breaks to here
	dap prc		/set for return
	dap prd
	idx prd
	jdp ovf		/save everything else
	lac bpp		/print ".a", tab
	jdp tys
	lac tr		/save ac
	dac ac
	jdp lwt		/pqhn  c(ac)
	jmp lse

ovf,	0		/used to store status of overflow bit
			/and extend mode ff
	tsf
	dio io
	rpf		/saves io,pf,be,seq br mode,bk ins
	dio pf
	clf 5		/flag 5 is 0 if in lc
	rbe
	dio be
	lem
	lio bki
	dio bix		/put break ins  in  bix
	lac bk1
	  a
	dio i bk1	/restore bk ins if was break
	eem
	jmp i ov_                 
                                /deposit subroutine
dep,	0	/called by jdp
ope,	skp 600	/szf 6 if register open
	dac i loc	/reg. open
	jmp i dep
                
                                /octal print routine
/suppress leading zeros
opt,	0		/also temp store
	lio clw		/law
sk2,	sza i		/used as constant
	jmp op1
	rcl 3s
	sni
	jmp .-2
	sni
op1,	lio op2
	tyo
	cli
op2,	rcl 620		/same as rcl 3s - used as constant
	sza
	jmp op1-1
	jmp i opt

/last word typed switch
lwt,	0
	dac lw		/update last word
pns,	jdp pi		/pi or opt
	jmp i lwt
                
                                /routine tys, type symbols and ignore leading blanks.
/called by jdp tys , with symbols in AC.
/no redundant case shift filter

tys,	0
	lio cop		/opr
	clf 5	/set case to lc
ty1,	rcl 6s
	sni i
	tyo
	sas cop		/opr
	jmp ty1
	cli		/leave with c(io)=0
	jmp i tys

/type lower case and carri ge return.  called by   s k _2 lcb>>32<< _    ys
	law 7277
	jmp tys+1

/type lower case and tab__/called by   p    >>60<<>>76<<k_ ,  daddac tysb  l    36
 	j  tys+1
                
                                /routine pad,  type address in format
/core nbr + symbol + remainder
/called by jdp pad  , with number in ac

pad,	0
	dap . 3
	and c7		/jda
	jdp tys
	law .
	jdp pi
	law 2136
	jdp tys
	jmp i pad
                
                                /pi, routine to print instruction.  called by   jdp pi
/wi     mber in accumulator.  pi will print number in 
/format
/	(op. code.)	(i bi    (addres  _ 
   ,	0	/return address
	dac lw	/save as last word typed
	dac dep	/save
	and cop	/cop, opr.
	sad clw	/clw, law
	jmp pi2		/if law, print sym_olic address
	rar 1s	0oth qwise, make it positive
	sza	/skip if not an instruction
	sub cdi	/cdi, dho.  mainly, 220000
	sm>>60<<	/skip if addressable
	jmp ppk
pi2,	jsp pev	/print closest instruction
	sub ci	/test for indirect bit
	spa	/skip on i bit
	jmp ppk	/no i bit
	dac dep	/i bit, save remainder
	law 7100	/an i and a blank
	jdp tys	/go type out
ppk,	jsp pev	/print ins or addr
	jdp opt	/print octal
px,	jmp i pi	/exit directly
                
                                /pev, symbol lookup routine.  called by jda pev from routine pi.
  pe w_kl fimd the best match in the symbol table, print out its
/flexo code, a space, and return with the remainder in the ac 
/and in pev.  if there is no matching symbol, pev wi_l do nothinb
/pev stay  in extend m de, which     _xplain  ome of the >>60<< bious
/ind _ection trh__s.


pev,sd>>60<<p  _ 	/savd return
	lac est	/pointer to symbol table
	dac tr	/save for indirect pointer
	dac opt	/a high positive number
eal,	idx tr	/next table entry
	lac dep	/get number
	sub i tr	/see h  table lower
	spa	/skip if lower
	jmp eix	/if not, try >>60<<gain
	sub  p  	/		/se  _      i  iss ss a be   r  match	s_ 	/if not,
y mo eix	/try newt _ne
  dm o   /b>>60<<  er, save d_fference
	k_      1et iss address
8>>60<<io ch	/sav  it
eix,	idw tr	/ne   b  e  
	s		sas t     _6 tale      de_ ed,_  mp _>>60<<l	/try for more
	law i 1	/otherwise,
	adm ch	/get flexo of best match
	lac i ch	/to ac
	sad tpt	/if best match was 0,
	jmp . 3	/ignore it
	jdp tys	/otherwise, type it
	tyo	/then a space
	lac opt	/get remainder of number
	dac dep	/save it
	sza i	/skip if non zero
	sad lw	/if last word is 0,
pex,	jmp .	/return to pi
	jmp px	/otherwise, hfnore pi
                                                 /dispatch table
dtb,	disp pls, pls	/space
	disp n, err	/1,"
	disp n, err	/2,'
	disp n, err	/3,~
	disp n, err	/4,>>04<<
	disp n, err	/5,>>05<<
	disp n, err	/6,^
	disp n, err	/7,<
	disp n, err	/8,>
	disp n, err	/9,^
bki,	0	/breakpoint instruction
wrd,	0	/value of typed-in expression
t3,	0		/temp storage
sym,	0	/alpha symbol being assembled
ch,	0	/character - also temp storage
cjd,	jda tr	/constant
	disp n, err	/0,.
	disp bar, err	//,?
	disp l, smb	/s
	disp l, tbl	/t
	disp l, err	/u
	disp l, vfy
	disp l, wds	/w
	disp l, xec	/x
	disp l, rd	/y
	disp l, zro	/z
syl,	0	/syllable
	disp err, eql	/,=
t,	0	/temporary storage
t2,	0	/temp storage
	disp err, err	/tab
c10,	777	/constant
	disp err,ub	/_ ,.
	disp l, err	/j
	disp l, kil	/k
	disp l, err	/l
	disp l, err	/m
	disp l, nws	/n
                
                                	disp l, err	/o
	disp l, pra	/o>>76<<	disp l, err	/q
	disp l, err	/r
chi,	0	/temp storage
bpp,	flexo .a		/constant for bkpt print
	disp min, pls	/-,+
	disp cpr, err	/),]
	disp l, err	/.,|
	disp err, err	/(,[
stp,	tpt 2	/constant
	disp l, err	/a
	disp l, err	/b
	disp l, cns	/c
	disp l, err	/d
	disp l, eas	/e
	disp l, err	/f
	disp l, bgn	/g
	disp l, err	/h
	disp l, err	/i
	disp lc, lc	/lower case
	disp l, del	/.,x
	disp uc, uc	/upper case
	disp bs, bs	/backspace
csd,	sad i	/constant
	diso cr, cr	/carriage return

foo,
                
                                
a=720077

psf=a
bef=a+0100
bff=a+0200
rpf=a+0300
rpn=a+0400
rcn=a+0500
lar=a+0600
lrd=a+0700
psn=a+1000
ben=a+1100
bfn=a+1200
lpf=a+1300
spn=a+1400
scn=a+1500
ad1=a+1600
ad2=a+1700
rsb=a+2000
bpt=a+2100
arq=a+2200
dsm=a+2300
wat=a+2400
sbr=a+2500
srw=a+2600
sei=a+2700
sps=a+3000
sbe=a+3100
sbf=a+3200
sti=a+3300
sdl=a+3400
siw=a+3500
sxw=a+3600
rbe=a+3700
rsn=a+4000
rsf=a+4100
srs=a+4200
lqn  _a+4300
s__=a+4400
lei=a+4500
lea=a+4600
rer=a+4700
la2=a+5000
tsn=a+5100
tsf=a+5200
nmn=a+5300
nmf=a+5400
lbe=a+5500
usn=a+5600
usf=a+5700
ldc=a+6000
tln=a+6100
tlf=a+6200

isb=720052
eem=724074
lem=720074


start lis