
DOCTOR 4 = 2 sept 66 - part 1

ill:lalUalr	pnl:prtUcyl	anc:ana 40
anz:ana 50	orc:ora 40	xx:hlt
ran:cyrUcry	anp:anl+20


define	move a,b	llr a	slr b	terminate

define	load a,c	llr (c	slr a	terminate


opsyn	char,character
opsyn	flex,flexo

define	init a,b	ldx (b	sxa a	terminate

l=1	r=0	nsy=162

define	oper a, b
	zz1=a-lis+44
	zz2=b-lis+44
	2000Xzz2+2Xzz1
	termin

define	disp a	oper a, a	termin

define	letter a, b
	oper a+lis-44, b
	termin


14777|

syt=.-1

brllis,	ado brlck

lis,	llr bki		|entry point
bk1,	slr chc		|restore break instr

lse,	tsx lcr
lss,	clc
	sto chi
	stz wrd
pl1,	llr eql		|lac
lsq,	slr sgn
lsp,	stz num
	stz dnm
lst,	stz sym l
	stz sym r
	stz fsm
	stz chc
	stz let

lsr,	move ptc, ta7
	init srw, msk
	cal 1

ls1,	lcc
	trn ls1
	tra .+1		|exit to braille input
	ldx six
	cyl
	tix .-1
	axr
	lax dtb+177
	ldx cas
	cyr
	tix .-1
	cll+alr-opr
	add m44
	trn ln
	add tls
	sto lsx
	add (-tra-lnr
	trn lsy

	llr num
	lda let
	tze sgn
	tsx es
	tze sgn
undef,	lda cundf		|undefined
erp,	tsx p3
	lda (flex 		|lower case, tab, l.c.
	tsx p3
	tra lss


sgn,	xx		|lac or lcc
	add wrd
	sto wrd
lsy,	ldx cc
cc,	lda chi
	llr lwt
	trn .+3
	llr wrd
	ldx crs
lsx,	xx		|exit to routines

uc,	lda elv
lc,	sto cas
	tra lsr

t7094,	trn err
	lda sym+1		|7094 tape dump and read
	add rrd		|check for read
	tze read
	add dmp		|check for dump
	tze dump
	tra undef

err,	lda (flex X
	tsx p3
	lda (flex 		|lower case, tab, l.c.
	tsx p3
	tra lsr		|ignored

del,	lda cdel
	tra erp

dot,	lda chc
	tze do1
	move dnm, num
	tra lsr

do1,	lda baa
	tra lsd

quo,	lda fsm
	tra lsd

kil,	load est, syb
	tra lse

rad,	lda (vsf-opn
oad,	add opc
	sto asw
	tra lse

cns,	lda (opt-vs1
ins,	add (tra vs1
	sto pt
	tra lse

dnp,	add six
onp,	add (add odv+5
	sto rdx
	lda chi
	trn .+2
	lda one
	sto neg
	tra lse

imp,	ldx lwt
	tra .+2

cma,	ldx baa
	stz org
	sxa org
rp,	lda let		|define symbol
	tze err
	ldx pix

dfs,	sxa dfx
	tsx es
	llr org
	tze df1
	ldx est		|not def
	aux mtw
	lda sym r
	stx 0
	slx 1
	lda sym l
	tze df2
	tix .+1
	add tn
	stx 0
df2,	sxa est
dfx,	tra .

df1,	slx syt+1
lnr,	tra dfx		|last no-eval routine

alm,	add one		|a, l, x, f, m logic
	add one
	add one
	add one
	add tr		|ac

lsd,	sto num
	sto dnm
lsi,	stz chi
	tra lst

ta,	slx 0		|tab
	lxr
	sxa baa
ta3,	tsx lcr
	lda baa
	tsx opa		|print addr
	lda hcn
	tsx brlle
	pno
	ldx baa

ta6,	sxa crs		|open register
	llx 0
	tsx lcts
ta7,	xx		|tsx pt, opt, or vs1
ptb,	ldx cr1
	tra lct

fs,	lda mtw		|forward space
	add baa
	sto baa
	lda chi

bs,	trn .+2		|backspace
	slx 0
	ado baa
	tra ta3

lp,	add (opt-vs1
sls,	add pic
	sto ta7
	lda chi

bar,	lxr
	trn ta6
	stz baa
	sxa baa
	tra ta6

cr,	trn .+2
crs,	slr chi		|addr of reg open
	slr lwt
	ldx cc
	sxa crs
cr1,	tra lss

pls,	tra pl1

min,	llr ls1		|minus
	tra lsq

q,	lda lwt
	tra lsd

sor,	slr org
	slr lwt
	tra lss

bk,	trn ebk		|breakpoint
	slr lwt
bk3,	lxr
	sxa bk1
	tra lse

ebk,	llr cc
	tra bk3

pr,	orl		|set proceed count
pra,	lda prc		|get instr to execute
	sto bix

pr1,	lcc
	add one
	sto chi
	tsx lcr
	ldx bk1
	llx 0		|set breakpoint
	slr bki
	llr (tra tr
	slx 0
	llr lr
	ldx xr

pr2,	lda ac
bix,	tra err
prc,	tra err

xec,	slr xe1		|execute
	llr .-1

beg,	trn err		|go to
	lda .+4
	sto bix
	lxr+lro-opr
	sxa bix
	tra pr1

pfl,	tsx lcts		|print as flexo
	tsx p3
	tra ptb

nws,	llr cm
	tra ser+1

eas,	ldx cmsa
	sxa srw

ser,	llr np
	trn err		|word search
	slr srs
	tsx lcr
	lda ll
	add mon
	sto adr
	tra .+1
sr3,	tsx asq
rtn,	trn lse
	llr wrd
	lax 0
	lpd
srw,	llr		|msk or msa
	ana
	trn .+2
	tze srs
	clc
srs,	xx		|com or axr
	trn sr3
	tsx pac
	tsx lcr
	tra sr3

hed,	tsx lcr		|title punch
	tsx fee

he1,	lro 1
	lcc
	trn .-1
	lal
	ldx six
	cyl
	tix .-1
np,	axr
	lax ftp-200
	sto chi
	trn chi
	p6h
	p6o
	lax ftp-177
	p6h
	p6h
	p6o
	p6s
	tra he1

p1r,	trn .+2
	slx 0
	llr crs
	slr org
	cla

pun,	trn err		|punch binary blocks
	ldx rtn
pu1,	sxa pu2
cmsa,	lda msa
	anc
	sto wrd
	lda org
	llr msa
	ana+lro-opr
	sto org
pu3,	add wrd
	com
pu2,	trn .		|exit
	lda c77
	orc
	sto let
	llr wrd
	lcd
	trn psw
	slr let		|last block
psw,	tra pbf		|or pri

jbk,	trn err		|start block
	tsx fee
	lda wrd
	add cad
	tsx p3c
	tsx fee
fer,	ldx rtn

fee,	sxa fex
	ldx c33
	p6s 200
	tix .-1
fex,	tra .

rd,	tsx soi		|read
rdl,	tsx gwd
	tsx asq
	trn rdl
	slx 0
	tra rdl

vfy,	tsx lcr		|verify
	tsx soi
vfl,	tsx gwd
	tsx asq
	trn vfl
	lax 0
	lpd
	trn .+2
	tze vfl
	tsx pac
	tsx lct
	ldx gwg
	lax 0
ptc,	tsx pt
	tsx lcr
	tra vfl

tbl,	lda msa		|table
	anc+lro-opr
	slr chc		|+
	sto wrd		|-
	tsx soi
	tsx rbk

tb1,	tsx gwd
	slr sym l
	tsx gwd
	slr sym r
	lac
	tze tbs
	tsx gwd
	slr org
	lda sym l
	llr mopr
	anp 40
	trn tb1
	tra tb3

zro,	com
	trn .+3
	stz org
zr2,	llr est
	lxrUlac
	trn err
	llr est
	lcdUlro
	tze zr3
	trn zr2

zrl,	xcc
	add org
	com
	trn lse
	slx 0
zr3,	tix zrl
	tra lse

pi,	ldx sls		|print as instr
lcts,	slr lwt
lct,	lda (100101+222202
	tra p3

pic,	tsx vs1
pix,	tra ptb


ppt,	lda (r3cUcom	|paper tape mode
	sto soi
	lda (sxa rbx
	llr (tsx rbk
	sto rbk
	slr tb1-1
	tra lse

mgtp,	lda (tra mgrd	|mag tape mode
	sto soi
	llr (tra tb1
	tra ppt+4


brl,	llr (tsx inbrl	|braille input and output
	lda brlck
	trn err
	lda cycle
	sto brlle
	slr ls1+2
	tra lse

nbrlin,	llr (tra ls1+3	|braille output only
	tra brl+1

nobrl,	lda (trx 0	|suppress all brailling
	llr (tra ls1+3
	tra brl+4


eql,	lac		|equal sign
	ldx pix		|last addressable routine
opt,	sxa opx
	sto lwt
opn,	ldx neg
	tix ngp
	com
	sto tem
	llr (tze dvs
	lda m5
	sto chi
	slr dvt

dvl,	add rdx
	sto dv1
	sto dv2
	ldx one
	lda tem

dvv,	aux mon
	trn dv3
dv1,	xx
	tra dvv

dv3,	sto tem
dv2,	xx
	trn dvv
	xac
	llr np
dvt,	xx		|tze or nop
	slr dvt
	tsx gch
	tsx brlle
	pno
dvs,	ado chi
	tze dvl-1
	trn dvl
opx,	tra .

ngp,	trn .+2
	tra opn+2
	sto tem
	lda (char r-
	pno
	tra opn+4

odv,	100000
	10000
cxs,	1000
hun,	100
	10
	1

ddv,	100000.
	10000.
	1000.
	100.
	10.
	1.

dump,	lda ll

tes,	sto buf+1		|7094 tape dump
	add c377		|M+1 is lower limit to be dumped
	com
	add ul		|M+2 is last word to be dumped
	ldx buf+1
	sxa wordgt
	ldx .+1
	sxa get1
	trn .+2
ccla,	cla
	add c377
	sto buf
	trn endof

finis,	wtb 1
	cpf
	cpyUlro
	lda buf+1
	cpyUalr
	cpyUlro
	add buf
	sto buf+2
	cpyUalr
	ldx buf
	tra .+2
loop,	ado wordgt
	cpyUlro
wordgt,	lda .
	cpyUalr
	tix loop
	wtb 1


out,	bsr 1
	ldx .+1
	sxa wordgt
	ldx buf+1
	sxa get1
	rtb 1
	cpy
	lda buf+1
	cpyUlcd
	tze .+2
	tra wer
	cpy
	lda buf+2
	cpyUlcd
	tze .+2
	tra wer

	ldx buf
	tra .+2
cont,	ado get1		|check write loop
	cpy
get1,	lda .
	cpyUlcd
	tze .+2
	tra wer
	tix cont
wck,	llr fmsk
	rpf 7
	tze out1
wer,	hltUalo
	tra lse

out1,	ado buf+2
	tra tes

endof,	ldx m5		|write end of file
	wtd 1
	tix .-1
	lda eof
	cpyUalr
	wtd 1
	tra lse


read,	lda ll
	sto readn
	llr est
	lda ul
	lcd
	trn .+2
	llr ul
	slr buf+4		|routine to read in 7094 tapes
	lda card
	sto readn+1

loop1,	llr m5
	slr buf+6
loop2,	rtb 1
	cpf
	cpy
	cpyUlac
	cpy
	cpyUlcd
	axr
	lda readn
	sto buf+5

loop3,	cpy
	com
	add buf+4
	trn tcc
	cpyUlac
readn,	sto .
	ado .-1
	tix loop3

	rpf
	tze .-1		|check flags
	llr fmsk
	ana
	tze loop1
	llr odv+1
	ana
	tze erck
	bsr 1
	rtd 1
	lda eof
	cpyUlcd
	tze lse

erck,	ado buf+6
	trn .+3
	hltUalo
	tra loop1
	bsr 1
	lda buf+5
	sto readn
	tra loop2


tcc,	lda ccla
	sto readn
	tra loop1-1


tb3,	slr sym l	|more table
	lda sym r
	llr mopr
	anp 40
	slr sym r
	trn tb2
	cyl
	llr chc
	trn .+2
	llr wrd
	lac
	add org
	sto org
tb2,	tsx dfs
	tra tb1

tbs,	tsx lct
	lda est
	tsx opt
	tsx rbk		|skip rest of tape
	tra .-1

gwd,	sxa gwx
gw2,	ldx fsm
	tix gw1
	tsx rbk
	tra gw2

gw1,	sxa fsm
	ado gwg
gwg,	llr
gwx,	tra .

asq,	ado adr		|address sequencer
	sxa asx		|ok
	aux mtw
	sxa asy		|ng
	axr+com-opr
	add est		|bottom of pgm
	trn as1
asd,	xcc
	add ll
	com
	trn asy
	xcc
	add ul
asx,	tra .		|ok

as1,	xcc
	add (buf+100		|top of pgm
	trn asd
asy,	tra .		|ng

pir,	load org, trn 17756	|punch input routine
	ldx prk
	sxa psw
	tsx fee
	llr msa
	tsx pu1
pi3,	lda (trn 17756
	tsx p3c
	ldx (pbf
pi4,	sxa psw
	tra fer

pi2,	tsx fee
	tra pi3

prs,	ldx prk
	tra pi4

pbf,	stz tem		|punch block format
	tsx p3g
	lda let
	tsx p3c
pb2,	ldx org
	lax 0
	tsx p3c
	ado org
	add let
	trn pb2
	lda tem
	com
	tsx p3c
	tra pr3

pri,	tsx p3g		|iunch read-in mode
	ldx org
	lax 0
	tsx p3c
	ado org
	add let
prk,	trn pri

pr3,	ldx m4
	p6s 200
	tix .-1
	lda org
	llr org
	tra pu3

p3g,	lda org
p3c,	p7h		|punch one word
	p7h
	p7h+cyl-cyr
	cyl
	add tem
	sto tem
pxx,	trx 0

start
g