
doctor 4 = part 2


stp,	tsx fee
	lda (trn 51
	tsx p3c
	tsx fee
	ldx (pbf
	sxa psw
	ldx est
	tix .+1
	sxa st1
	slr org

st2,	tsx pu1
	ldx (-76
	lda (buf
	sto org
st3,	lda mon
	sto tem
	llr tn
st4,	slx buf+76
	ado st1
	add cbot
	tze dne
st1,	lda .
	alr
	trn st6
st5,	tix .+1
	ado tem
	trn st4
	slx buf+76
	tix st3
	llr st4
	tra st2

dne,	cla
	stx buf+76
	tix .-1
	llr st4
	tsx pu1
	lda (add 3074
	sto wrd
	tra jbk

st6,	lda tem
	add one
	trn st4
	tra st5

ln,	add c33		|letter number logic
	trn n
	sto let

ln1,	stz chi
	ado chc
	add m4
	tze ln2
	add (trn 4-7
	trn lsr
ln4,	lda sym r
	cyl
	cyl
	add sym r
	cyl
	cyl
	cyl
	lad
	add one
	sto sym r
	lda chc
	add (trn-4
	trn lsr
	lcc
	tsx gch
	llr chm
	ano 10
	cyl
	cyl
	add fsm
	cyr
	sto fsm
	tra lsr

ln2,	lda sym r
	sto sym l
	stz sym r
	tra ln4

n,	lda num
	cyl
	cyl
	cyl
	lad
	sto num
	lda dnm
	cyl
	cyl
	add dnm
	cyl
	lad
	sto dnm
	tra ln1

pac,	sxa xe1		|print addr and contents
	lda adr
	tsx opa
	lda hcn
	tsx p3
	ldx adr
	lax 0
	ldx xe1

pt,	tra vs1		|print word sw

opa,	sxa opx		|print addr
	sto tem
	sto chi
asw,	tra vsf		|address mode sw

tr,	sto ac		|break trap
	ado chi
	trn pr2
	slr lr
	xac
	sto xr
	lda bk1
	add (lda-slr
	sto pra
	add (tra-lda+1
	sto prc
	lda (flex ac 
	tsx p3
	lda ac
	tsx pt
	tsx lct
	lda (flex lr 
	tsx p3
	lda lr
	tsx pt
	tsx lct
	lda (flex xr 
	tsx p3
	lda xr
	tsx pt
tls,	tra lis



xe1,	0		|execute trap
	sto ac
	slr lr
	xac
	sto xr
	tra lis


es,	sxa esx		|evaluate symbol
	ldx est
	aux (-syt
	llr sym l
esl,	lax syt
	trn esn
	cla
es3,	lcd
	tze es2
esi,	tix .+1
	tix esl
esf,	llx syt+1
esx,	tra .

esn,	tix .+1
	add mtn
	tra es3

es2,	lax syt
cm,	com
	add sym r
	tze esf
	tra esi

vs1,	sxa opx		|print as instr
	sto tem
	sto chi
	llr (760000
	anl+com-opr
	trn vsp
	cyl
	trn vsp
	tra vsf

vsp,	slr chi		|addressable
	tsx vsy
	lda cxs
	tsx brlle
	pno

vsf,	tsx vsy		|op class or address
	lda cxp
	tsx brlle
	pno
	lda tem
opc,	tra opn

vsy,	sxa vsx
	move mtn, let
	ldx est
	aux (-syt
ev1,	lax syt
	trn evn
	cla
eva,	sto sym r
	tix .+1
	lax syt
	llr chi
	lpd
	trn ev2
	com+cry-opr
	tze ev3
	trn ev2

	alr+com-opr
	add let
	trn ev2
	slr let
	sxa slo

ev5,	lda sym r
	com
	sto sym l
ev2,	tix ev1

ev4,	ldx slo
	lax syt		|get best value
	com
	add tem
	sto tem
	lax syt-1
	com
	sto sym r
	tsx spt
	lda tem
	tze opx
	sto chi
vsx,	tra .

ev3,	sxa slo
	xro
	tra ev5

evn,	tix .+1
	add mtn
	tra eva

lcr,	lda (101001+222202
p3,	sxa p3x		|print 3 chars
	ldx two
p31,	llr al6s
	anp
	tze p32
	add (-111101
	tze dns
	add hun
	tze ups
	add ucx
	sxa xreg
	tsx brlle
	prt
	ldx xreg
p32,	lar
	tix p31
	lda lwt
p3x,	tra .

ups,	lda cas
	tze .+2
	tra p32
	lda ucx
	sxa xreg
	tsx brlle
	pno
	ldx xreg
	lda elv
up3,	sto cas
	tra p32

dns,	lda cas
	tze p32
	lda lcx
	sxa xreg
	tsx brlle
	pno 40
	ldx xreg
	tra up3

	r3c
soi,	r3c+com-opr
	trn .-2

rbk,	sxa rbx		|read binary block
	init rbs, buf-1
	sxa gwg
	r3c
	alr
	add mon
	sto adr
	add .
	trn lse
	r3c+lad-opr
	alr+xro-opr
	add mon
	sto fsm

rbl,	ado rbs
	r3c
rbs,	sto
	lad
	alo
	tix rbl
	r3c+lad-opr
rbx,	tze .
	clc
	hlt+alr-opr
	tra rbk+1

mgrd,	sxa mrbx
	init mrbs, buf-1
	sxa gwg
	rtb 1		|read binary record
	cpyUlac
	trn maybe
	sto ck
	add mon
	sto adr
	lal
	trn lse
	cpyUlac
	add ck
	axr
	sto ck
	add mon
	sto fsm

mrbl,	ado mrbs
	add ctop		|check that mrbs less than buf+100
	trn loserd
	cpyUlac

mrbs,	sto buf-1
	add ck
	sto ck
	tix mrbl
	cpyUlad
mrbx,	tze .		|checksum ok

loserd,	clc		|checksum error
	hltUalr		|halt, display -1 in ac and lr
	tac		|check tac on restart
	trn mgrd+1
	bsr 1
	tra mgrd+1

maybe,	cyl
	trn mgrd+4
	tra lse


brlle,	trx 0		|braille output
	slr lreg
	sxa brlx
	llx 0
	slr .+1
prnt,	xx		|type character
	sto .-1		|save ac after typing
	ado brlx
	lda accum
	stz brlwrd
	ldx m5

cycle,	sto accum
	llx bdv
	ana
	add brlwrd
	tix .+2
	tra tlr		|flexo code now in ac bits 12-17
	sto brlwrd
	lda accum
	cyr
	cyr
	tra cycle

inbrl,	sto prnt		|braille input
	lac		|put flexo code in bits 1-6
	sxa brlx
	add mtn
	ldx six
	cyl
	tix .-1		|put flexo code in ac bits 12-17
tlr,	add cldac
	sto .+1

	xx		|get braille value
	ldx cas
	cyl
	tix .-1
	alr
	ldx four
	opr
	tix .-1		|wait loop
	opr+12000	|braille character
	llr lreg
	lda prnt
brlx,	tra .		|return, held up until ex2 completion given


c,	071071	accum,0	021021	046046
cldac,	lda c	063056	001001	022022
	100100	077034	016016	062062
	012012	054014	045045	006006
	051051	050076	031031	042042
	027027	002002	032032	066066
	035035	074067	013013	026026
	011011	044044	005005	lreg,0

	036036	xreg,0	065065	102102
	007007	106106	072072	brlwrd,0
	023023	101101	075075	ck,0
	017017	c377,377	037037	m377,-377
	025025	030030	003003	brlck,-0
	033033	fmsk,16000	024024	cundf,flex U
	015015	040040	055055	eof,4444
	047047	060060	064064	070070


	1	2	four,4
	10	20	bdv,40

spt,	sxa spx		|symbol print
	ldx one
spc,	llx sym
	sxa chc
	lda (add spd
	sto spa

spq,	ldx mon
	lac

spr,	alr
spa,	xx		|add spd
	aux one
	trn spr

spp,	xcc
	tze sps
	add one
	tsx gch
	tsx brlle
	pno
sps,	ado spa
	add (-add-spd-2
	trn spq
	ldx chc
	tix spc
spx,	tra .

spd,	50X50
	50
one,	1

gch,	sxa gcx
	cyrUcom
	axr
	trn gc1
	lax gct
gcx,	tra .

gc1,	lax gct
	cyr
	tra gcx

gct,	text .01 23 45 67 89 ab cd ef gh .
	text .ij kl mn op qr st uv wx yz .
	111001+222202

dtb,	disp del		|delete
	letter 0, dnp	|0
	disp lc		|l. c.
	letter 37, vfy	|v
rdx,	add odv+5
	letter 41, alm+2	|x
	disp uc		|u. c.
	letter 26, alm	|m
ucx,	111001
	letter 9, ppt	|9
lcx,	111101
	letter 20, beg	|g
al6s,	666666
	letter 13, bk	|b
	disp stpcd	|stop
	letter 30, oad	|o
cxp,	char r+
	letter 32, q	|q
c33,	33
	letter 31, pr	|p
c77,	77
	letter 42, rd	|y
	disp cr		|car ret
	letter 21, hed	|h
mopr,	-opr
	letter 40, ser	|w
	disp ta		|tab
	letter 25, alm+3	|l
	disp bs		|backsp
	letter 43, zro	|z
cad,	add
	letter 35, tbl	|t
cdel,	flex x
	letter 24, kil	|k
	oper min, p1r	|-_
	letter 14, cns	|c
	letter 6, mgtp	|6
	letter 17, alm+1	|f
	oper cma, lp	|,(
	letter 27, nws	|n
	letter 7, nobrl	|7
	letter 23, jbk	|j
	letter 1, quo	|1
	letter 33, rad	|r
	letter 5, nbrlin	|5
	letter 15, pun	|d
	oper dot, rp	|.)
	disp lsr		|color

	letter 2, t7094	|2
	letter 36, xec	|u
	oper pls, sls	|+/
	letter 22, pi	|i
	letter 4, brl	|4
	letter 34, ins	|s
	oper eql, sor	|=:
	disp pls		|space
	letter 3, pfl	|3
	letter 12, alm+4	|a
	oper bar, imp	|||
ctop,	-trn-zzzzzz
	letter 8, onp	|8
	letter 16, eas	|e
card,	ado readn
	disp fs		|tf

i=err

stpcd=i


ftp,	tra stp	mtw,-2	m44,-44	tn,trn
	313113	701007	212112	343443
msa,	17777	mtn,-trn	chm,111111	000000
	211311	344744	210012	343443
	0	0	003030	007070
	212012	303443	021300	322722
	200002	311113	000300	011711
	111112	444443	210213	344307

	tra he1	six,6	22	elv,11
	311113	344443	313012	703443
	311311	344324	020002	111113
	000012	444443	300000	742111
	131111	445564	two,2	11
	313111	701000	213112	303443
	211112	340043	000300	000700
	111311	421124	sym,0	0

	300000	711111	mon,-1	fsm,0
	300213	742007	tra pi2	let,0
	111113	svn,7	tra prs	chi,0
	111132	445562	slo,-0	chc,0
	111311	444744	tra pir	cas,11
	120000	421111	lwt,0	tem,0
	311311	344300	num,0	dnm,0
	211112	344525	bki,0	baa,0

	211112	344443	232232	272272
	313113	343443	m4,-4	adr,0
	211112	300743	m5,-5	org,0
	211202	344743	neg,0	wrd,0
	131111	465544	130000	260000
	120021	421124	cbot,-lda-syb	hcn,200303
	111220	444231	320000	640000
	211112	344443	333333	777777

define	sqooze a,b,c
	zz=50Xa+b
	zz1=50Xzz+c
	-zz1
	termin

define	squze a,b,c,d,e,f
	zz=50Xa+b
	zz1=50Xd+e
	zz2=50Xzz+c
	50Xzz1+f-zz2
	termin

rrd,	sqooze 34, 17, 13
dmp,	squze 16, 37, 27, 34, 17, 13

constants

ac,	0
lr,	0
xr,	0
est,	syb
msk,	-0
ll,	0
ul,	17777

buf,

define	sqoze a, b, c
	zz=50Xa+b
	50Xzz+c
	termin

brllis-nsy-nsy-12|

syb,	sqoze 45, 13, 46		ac
	sqoze 45, 26, 46		lr
	sqoze 45, 42, 46		xr
	sqoze 45, 20, 46		est
	sqoze 45, 27, 46		msk

|Doctor vocabulary

	sqoze 13, 16, 16		add
	sqoze 13, 16, 31		ado
	sqoze 13, 16, 42		adx
	sqoze 13, 26, 15		alc
	sqoze 13, 26, 26		all
	sqoze 13, 26, 31		alo
	sqoze 13, 26, 34		alr
	sqoze 13, 26, 42		alx
	sqoze 13, 27, 44		amz
	sqoze 13, 30, 13		ana
	sqoze 13, 30, 26		anl
	sqoze 13, 30, 31		ano
	sqoze 13, 34, 42		arx
	sqoze 13, 37, 42		aux
	sqoze 13, 42, 15		axc
	sqoze 13, 42, 31		axo
	sqoze 13, 42, 34		axr
	sqoze 14, 35, 34		bsr
	sqoze 15, 13, 26		cal
	sqoze 15, 13, 42		cax
	sqoze 15, 26, 13		cla
	sqoze 15, 26, 15		clc
	sqoze 15, 26, 26		cll
	sqoze 15, 26, 34		clr
	sqoze 15, 31, 27		com
	sqoze 15, 32, 20		cpf
	sqoze 15, 32, 43		cpy
	sqoze 15, 34, 43		cry
	sqoze 15, 43, 26		cyl
	sqoze 15, 43, 34		cyr
	sqoze 16, 23, 35		dis
	sqoze 16, 35, 31		dso
	sqoze 17, 42, 1			ex0
	sqoze 17, 42, 2			ex1
	sqoze 17, 42, 3			ex2
	sqoze 17, 42, 4			ex3
	sqoze 17, 42, 5			ex4
	sqoze 17,42, 6			ex5
	sqoze 17, 42, 7			ex6
	sqoze 17, 42, 10		ex7
	sqoze 22, 26, 36		hlt
	sqoze 23, 13, 16		iad
	sqoze 23, 13, 26		ial
	sqoze 23, 42, 26		ixl
	sqoze 26, 13, 15		lac
	sqoze 26, 13, 16		lad
	sqoze 26, 13, 26		lal
	sqoze 26, 13, 34		lar
	sqoze 26, 13, 42		lax
	sqoze 26, 13, 44		laz
	sqoze 26, 15, 15		lcc
	sqoze 26, 15, 16		lcd
	sqoze 26, 16, 13		lda
	sqoze 26, 16, 42		ldx
	sqoze 26, 26, 34		llr
	sqoze 26, 26, 42		llx
	sqoze 26, 32, 16		lpd
	sqoze 26, 34, 31		lro
	sqoze 26, 42, 34		lxr

	sqoze 31, 32, 34		opr
	sqoze 30, 31, 32		nop
	sqoze 31, 34, 13		ora
	sqoze 31, 34, 26		orl
	sqoze 31, 34, 31		oro
	sqoze 32, 7, 14		p6b
	sqoze 32, 7, 22		p6h
	sqoze 32, 7, 31		p6o
	sqoze 32, 7, 35		p6s
	sqoze 32, 10, 22		p7h
	sqoze 32, 10, 31		p7o
	sqoze 32, 17, 30		pen
	sqoze 32, 30, 15		pnc
	sqoze 32, 30, 31		pno
	sqoze 32, 30, 36		pnt
	sqoze 32, 34, 36		prt
	sqoze 34, 2, 15			r1c
	sqoze 34, 2, 34			r1r
	sqoze 34, 4, 15			r3c
	sqoze 34, 13, 42		rax
	sqoze 34, 16, 35		rds
	sqoze 34, 17, 41		rew
	sqoze 34, 32, 20		rpf
	sqoze 34, 36, 14		rtb
	sqoze 34, 36, 16		rtd
	sqoze 34, 42, 13		rxa
	sqoze 35, 22, 34		shr
	sqoze 35, 26, 34		slr
	sqoze 35, 26, 42		slx
	sqoze 35, 32, 20		spf
	sqoze 35, 36, 31		sto
	sqoze 35, 36, 42		stx
	sqoze 35, 36, 44		stz
	sqoze 35, 42, 13		sxa
	sqoze 36, 13, 15		tac
	sqoze 36, 14, 34		tbr
	sqoze 36, 23, 42		tix
	sqoze 36, 26, 40		tlv
	sqoze 36, 32, 26		tpl
	sqoze 36, 34, 13		tra
	sqoze 36, 34, 30		trn
	sqoze 36, 34, 42		trx
	sqoze 36, 35, 42		tsx
	sqoze 36, 43, 32		typ
	sqoze 36, 44, 17		tze
	sqoze 41, 34, 35		wrs
	sqoze 41, 36, 14		wtb
	sqoze 41, 36, 16		wtd
	sqoze 42, 13, 15		xac
	sqoze 42, 13, 16		xad
	sqoze 42, 13, 26		xal
	sqoze 42, 15, 15		xcc
	sqoze 42, 15, 16		xcd
	sqoze 42, 26, 34		xlr
	sqoze 42, 34, 31		xro


zzzzzz=buf+77


start add lis




v