midas assembler_. extended memory, part 1.
/1-10-64

putdrum

/start over entry

sa/	enter
	law 1
	dac 91p
	move 92p, 93p
	rrb
	esm
	lat>>05<<cli
	swap
	lac sov
	dap .+2
	spi i
	jmp .

so1,	ondrum
	law pss
	dap so3

so2,	ril 1s
	law 1
	spi i
	cla
so3,	dac .
	index so3, (dac tit+1, so2
	ril 1s
	spi
	jsp res
	lac npa
	sza
	jmp np2
	lac pss
	sza
	jmp ps4
	jmp ps1
	endrum
          
                                                                 	
/load symbol table

ls,	enter		/enter to load table
	move .+1, 91r
	move 92r, 93r
	cbs
	esm
	ondrum
	law i 4000
	lat+cma-cla 4
	sza i
	jsp res
	jsp gc
	jsp rbk
	 nop

ls1,	jsp gwd
	dio sym l
	dio ls3
	jsp gwd
	dio sym r
	dio t2
	lac sym r
	ior sym l
	sza i
	jmp ls2
	jsp gwd
	dio tvl
	lac sym l
	and (600000
	sad (200000
	jmp ls5
ls6,	lac t2
	jda vsm
ls3,	0
	jmp ls1

ls5,	lac sym r
	and (600000
	sza
	jmp ls6
	lac tvl
	add mai
	dac tvl
	jmp ls6
          
                                                                  
ls2,	jsp rbk

ls4,	jsp gwd
	idx mai
	sad (mil+lmi
	jsp sce
	extend
	dio i mai
	jmp ls4

gwd,	dap gwx
	lac fee
	sad pt6
	jsp rbk
	extend
	lio i fee
	idx fee
gwx,	jmp .
rbk,	dap rbx
	lac (pbf
	dac fee
	dac pt6
	rpb
	dio t2		/word counter
	dio t3		/checksum
	spi
	jmp ps3		/start block
	rpb
	dio opt		/end check

rb0,	rpb
	extend
	dio i pt6
	swap
	add t3
	dac t3
	idx pt6
	index t2, opt, rb0
	add t3
	rpb
	dio t3
	sad t3
rbx,	jmp .
	hlt
	jmp rbk+1
	endrum
          
                                                                 
/set and reset terminators and indicators

sts,	dac stx
	lac i stx
	dap ct
	idx stx
	lac i stx
	dap tt
	idx stx
	init bt, ilf
	dap qt
	jmp i stx
stx,	0

rst,	law rr
	dap rsx
	init ct, c
	init tt, tab
	init bt, b
	init qt, q
	init lt, lp
	init rt, ilf
	init bs, rsw
	init cfx, cfx+1
	jmp rsw+2

rsw,	law rr
	dap rsx
	dzm wrd
	dzm amn
	dzm asa l
	dzm asa r
	dzm rlc
	dzm nsm
	dzm def
	dzm gsi
	dzm gsj
	clc
	dac syl
	law 0
	dap psn		/opr
	jmp rsp+2

rsp,	law rr
	dap rsx
	dzm fct
	dzm fcr
	dzm fci
	load fcn, jda ad
	jmp rss+2
          
                                                                 
nrss|
rss,	law rr
	dap rsx
	dzm num
	dzm dnm
	dzm nmr
	dzm sym l
	dzm sym r
	dzm chc
	dzm let
	clf 2		/liu
	stf 5		/overbar ind
rsx,	jmp .

/read and write characters for macro definitions

rr,	jsp rch

cfr,	law dtb
	add lsc
	dap .+1
	lac .
	szf 6
	rar 9s
	cli
	rcr 6s
	ril 6s
	dio cfn
	and (7
	add (cf6+1
	dap cf6
	lac mdi
	add irpdf
cf6,	jmp .

	jmp cg
	jmp cf1
cfj,	jmp ilc		/used as constant at wch

cf2,	sza i		/ignored
	jmp rr
	jsp wcl
	 (mil+lmi
	jmp rr

cg,	sza i		/alphanumeric
	jmp ln
	jsp wcl
	 (mil+lmi
	jmp ln
          
                                                                 
cf1,	sza i		/delimiters
	jmp cfx
	lac chc
	sza i
	jmp cfm
	jsp es
	 jmp cfg
	extend
	lac i sp1
	and (600000
	sas (200000
	jmp cfg
	extend
	lac i sp2
	and (600000
	sas (400000
	jmp cfg
	lac num
	sas (irc
	sad (ir
	jmp cf3
	sad (ipe
	jmp cf4
	sad (dfn
	jmp cfd
	sad (ter
	jmp cft
          
                                                                 
cfg,	lac (dsm-1
	dac cfn

cfb,	idx cfn
	sad dsk
	jmp cfm
	lac sym l
	extend
	sad i cfn
	jmp cff
	idx cfn
	jmp cfb

cff,	idx cfn
	lac sym r
	extend
	sas i cfn
	jmp cfb
cf5,	move wfp, wcp
	law 60		/dsm flag
	jda wch
	 (mil+lmi
	lac (-dsm-1
	add cfn
	sar 1s
	jda wch
	 (mil+lmi

cfm,	lac mdi
	add irpdf
	sas one
	jmp cfq
	law 74		/uc
	sad lsc
	jmp csc
	law char r2
	szf i 6		/skip on u.c.
	jmp cfq
	sad lsc
	jmp .+3
cfq,	jsp wcl		/'
	 (mil+lmi
	move wcp, wfp
	jmp rsw
          
                                                                 
csc,	move wcp, wfp	/upper case
	jsp rch
	sad (char r2
	jmp csd
csl,	law 74
	jda wch
	 (mil+lmi
	move wcp, wfp
rsc,	jsp rsw+1
	jmp cfr

csd,	jsp rch		/upper case,2
	sad (72
	jmp rsw
	jmp csl

cfd,	idx mdi		/define
	jmp cfm

cft,	law i 1		/terminate
	add mdi
	dac mdi
	ior irpdf
	sza i
	jmp te5
	jmp cfm

cf3,	idx irpdf	/irp
	jmp cfm

cf4,	law i 1
	add irpdf
	dac irpdf
	ior mdi
	sza i
	jmp ip1
	jmp cfm

cfx,	jmp .		/control char exit
	law adt
	add cfn
	dap .+2
	cla
	jmp .
cfn,	0

ilc,	rir 6s		/illegal codes
	spi+sza i-skp
	jmp ich
	jmp cf2+2
          
                                                                 
/dispatch table

dtb,	oper pl, pl		/space
	disp 1, 240		/1"
	number 2, ign		/2'
	number 3, til		/3~
	disp 4, 240		/4>>04<<
	number 5, uni		/5>>05<<
	number 6, isc		/6^
	disp 7, 240		/7<
	disp 8, 240		/8>
	disp 9, 240		/9^
	illegal
	disp 300, 300		/stop code
	repeat 4, illegal
dtb+20,	disp 0, 240		/0.
	disp bt+100-adt, 240	//?
	repeat 8, letter .-dtb-22+35	/s-z
	illegal
	oper ct, qt		/,=
	illegal			/black
	illegal			/red
	oper tt, tt		/tab
	illegal
dtb+40,	illegal 40		/_.
	repeat 9, letter .-dtb-41+24	/j-r
	illegal
	illegal
	oper adt, pl		/-+
	oper rt, ign		/)]
	oper ovb, vbr	/.|
	oper lt, ign		/([
dtb+60,	illegal
	repeat 9, letter .-dtb-61+13	/a-i
	oper ign, ign		/lower
	disp 45, tms+100-adt	/.x
	oper ign, ign		/upper
	illegal 40	/backspace
	illegal
	oper tt, tt		/car ret
dtb+100,

adt,	law cma-opr		/-
pl,	jmp pls			/+
ovb,	clf 5			/.
ign,	jmp rr			/', [, ], etc.
bt,	jmp .			//
ct,	jmp .			/,
vbr,	jmp abs			/|
qt,	jmp .			/=
tt,	jmp .			/tab, cr
rt,	jmp .			/)
lt,	jmp .			/(
tms,	lac (jda mpy-xor-num	/x
til,	add (xor-ior		/~
uni,	add (ior-and		/>>05<<
          
                                                                 
/syllable combining operators

isc,	add (and num	/^
	dac t
	lac chc
	sza i
	jsp ilf
	jsp tsy
	lac t
	dac fcn
	lio mze
	sas (jmp mpy
	lio one
	dio fci
	jmp rss

pls,	dac t
	lac chc
	sza i
	jmp pm1
	jsp ev1
	lac t
	dap psn
	jmp rsp

pm1,	lac t
	dap psn
	jmp rr

mpy,	0		/integer multiply
	dap mpx
	swap
	mul mpy
	scr 1s
	jda ad
	dac mpy
	lio mpy
mpx,	jmp .

ad,	0		/minus zero add
	dap adx
	lac ad
	dio pt6
	cma
	sub pt6
	cma
adx,	jmp .
          
                                                                 
/storage word termination character

tab,	lac syl
	add chc
	sza i
	jmp rsw
	jsp evl
	 flex usw
	spq
	jsp udf
	jsp pgs
	sub (pbf+100
	sma
	jsp pub
tb4,	law rsw

tb3,	dap bs
	cla
	sad pss
	jmp tb5
	lac wrd
	extend
	dac i ts
	jsp rlck
	 flex irw
	spi i
	jsp ilr
	lio rlp
	spi i
	jmp tb7		/absolute
tb8,	and rlm
	ior rlw
	dac rlw
	lac rlm
	rar 2s
	dac rlm
	spa
	jsp srw

tbn,	idx aml
	idx loc
	and (177777
	dac loc
	idx ts
	sad (pbf+100
	jsp pub
	jmp bs

tb7,	sas rct
	jmp rci
	jmp tbn

tb5,	lio rlp
	spi i
	jmp tbn
	jmp tb8
          
                                                                 
ts,	0
srt,	0

srw,	dap srwx
	lac rlw
	extend
	dac i srt
	dzm rlw
	idx ts
	dac srt
	sad (pbf+100
	jsp pub
srwx,	jmp .

/relocation check subroutine

rlck,	dap alp
	add one
rcj,	dap rcy
	lac rlc
	spa
	cma
	sub (2
	sma
	jmp rci
rdr,	law rct
	add rlc
	dap .+1
	lac
	lio mze
rcy,	jmp .

rci,	lac rct
	cli
	dzm rlc
	jmp rcy

	525252
rct,	252525
mze,	-0
          
                                                                 
/location assignment

b1,	lac pss
cz,	sza
	jmp b2
	clc
	dac indef
	jmp b5

b2,	jsp udf
	jmp b5

b,	jsp evl
	 flex usl
	lac syl
	add chc
	sza i
	jmp itt
	lac gsi
	sza
	jsp ilf
	add wrd
	dac wrd
	dzm asm r
	lac nsm
	spq
	jmp ba2
	lac asa l
	dac asm l
	lac asa r
	dac asm r
	lac amn
	dac aml

ba2,	spi
	jmp b1

ba1,	dzm indef
	lac rlc
	add ofstr
	dac rlc
	jsp rlck
	 flex irl
	ral 1s
	spi>>05<<spa i
	jsp ilr
	lac rlc
	sub ofstr
	dac rlc

b5,	law rsw
	dap bs
	lac wrd
	sas loc
	jmp b6
	lac rlc
	sad rli
	jmp bs
          
                                                                 
b6,	jsp pun
	lac wrd
	and (177777
	dac org
	dac loc
bs,	jmp .

/punch binary block

pub,	lio rli
	dio rlc
pun,	dap pux
	lac ts
	lio rlp
	spi
	sub one
	sad (pbf
	jmp bnp

	lac pss
	and pch
	spq
	jmp bnp
	lac rlw
	spi i
	jmp pu1
	extend
	dac i srt

pu1,	dzm t1
	law i 5
	jda fee
	lac (pbf
	dac pt6
	lio rim
	spi
	jmp pur		/readin mode
	lac blt
	sza i
	lac rli
	rar 2s
	dac blt
	add org
	jda pnb
	lac blt
	add ts
	sub (pbf
	add org
	jda pnb

pur,	spi i
	jmp pu2
	lac org
	add (dio
	jda pnb
	idx org
          
                                                                 
pu2,	extend
	lac i pt6
	jda pnb
	idx pt6
	sas ts
	jmp pur
	spi
	jmp puc
	lac t1
	jda pnb

puc,	law i 5
	jda fee

bnp,	lac loc		/form origin for next block
	dac org
	dzm rlw
	lac (pbf
	dac srt
	lio rlp
	spi
	add one
	dac ts
	load rlm, 600000
bnq,	lac rlc
	dac rli
pux,	jmp .

/evaluate product

evl,	dap alp
	add one
ev1,	dap evx
	jsp pgs
	sub (pbf+100
	sma
	jsp pub
	jsp tsy
	lac fct
psn,	opr		/opr or cma
	lio wrd
	jda ad
	dac wrd
	lac fct
	xct psn
	add amn
	dac amn
	lac fcr
	xct psn
	add rlc
	dac rlc
	law 2
	add def
	sub pss
	lio def
evx,	jmp .
          
                                                                 
/terminate syllable

tsy,	dap tsz
	cla+cli-opr
	sad chc
	jmp tsya
	lac let
	sma
	jmp es2
	dzm nmr
	jsp es
	 jmp tsu
	spi
	jmp tsc
	ril 1s
	spi i
	jmp tsj		/variable
	move2 sym, api
	jsp rss+1
	extend
	lac i sp2
	sma
	jmp mac
	clc
	jmp i t3

tsc,	ril 1s
	spi
	jmp etsc
	szf i 5
	jsp mdv
	szf 2
	jmp tsca
es1,	extend
	lio i sp2
	jsp erk

es2,	lio nmr
	lac fci
	sza i
	jmp tk4
	szf 2
	jsp ilf
	swap
	sza i
	jmp tk1
	spi
	jmp irx
	lac fcr
	sza
	jmp irx
	lac fct
	lio nmr
	jmp tk3

tk1,	lac fcr
	spi+sza-skp
	jmp irx
	lio num
          
                                                                 
tk3,	jda mpy
tk4,	dio fcr

ts2,	law 1
	dac syl
	szf i 2
	jmp ts2a
	clc
	dac gsi
	dac gsj
ts2a,	lio num
	lac fct
fcn,	xx		/factor combination operator
	dac fct
tsz,	jmp .

tsu,	lac pss
	sza
	jmp tsn
	szf 2
	jmp tsuu
	szf 5
	jmp tsn
	idx vct
	sub one
	dac tvl
	lac (200000
	jda vsm
	 0

tsn,	move2 sym, lus
	law i 1
	dac def
	dzm num
	jmp es2

erk,	dap erx
	cla
	spi i
	jmp erx-1
	law 1
	ril 1s
	spi
	law i 1
	dac nmr
erx,	jmp .
          
                                                                 
tsya,	sas fci
	jsp ilf
	jmp fcn

tsj,	and (600000
	sad (200000
	jmp tsja
	szf i 2
	jmp es1
	ior num
	dac tvl
	cla
	jda vsm
	 600000
	jmp etsc

tsja,	szf i 2
	jmp tsn
	lac num
	jmp tsjb

tsca,	dzm tvl
	lac (400000
	jda vsm
	 600000
	jmp etsc

tsuu,	szf i 5
	jmp tsuua
	dzm tvl
	lac (600000
	jda vsm
	 600000

etsc,	stf 2
	dzm num
	lac sym r
	and (-600000
	dac gls r
	lac sym l
	and (-600000
	lio psn
	ril 8s
	spi
	ior (400000
	dac gls l
	extend
	lio i sp2
	spi
	jmp etsc1
	ril 1s
	lac pss
	sza i
	spi i
	jmp es2
	jmp tsn
          
                                                                 
etsc1,	ril 1s
	spi i
	jmp etsc2
	lac pss
	sza i
	szf 5
	jmp es2
tsuua,	idx vct
	sub one
tsjb,	dac tvl
	lac (200000
	jda vsm
	 600000
	jmp tsn

etsc2,	szf i 5
	jsp mdv
	jmp es2

pgs,	dap pgx
	lac gsj
	dzm gsj
	and rlp
	and pss
	sza i
pgx,	jmp .
	lac rt
	sas .+1		/no g.s. in constants now
	jmp ilf
	lac rlm
	rar 2s
	dac rlm
	spa
	jsp srw
	lio gls l
	extend
	dio i ts
	idx ts
	lio gls r
	extend
	dio i ts
	idx ts
	jmp pgx
          
                                                                 
/pseudo-instructions expunge and offset

xpn|	jsp sts
	 xpn2
	 xpn1
	init xpn3, rsw
	jmp rsw

xpn1,	lac chc
	sza
	jmp xpn4
	expurgate
	load pt6, vco+ipt-ist
	init resx, rst
	jmp re2

xpn4,	init xpn3, rst

xpn2,	lac syl
	lio let
	spa>>05<<spi>>05<<szf 5 i
	jsp ilf
	jsp es
	 jmp xpn3
	extend
	idx i sp1
	extend
	dzm i sp2
xpn3,	jmp .


off|	jsp sts
	 ilf
	 off1
	jmp rsc

off1,	jsp evl
	 flex usf
	spi
	jsp udf
	lac gsi
	sza
	jsp ilf
	lac rlc
	dac ofstr
	add rli
	dac rlc
	jsp rlck
	 flex irf
	ral 1s
	spi>>05<<spa i
	jsp ilr
	lac wrd
	dac ofst
	jmp rst
          
                                                                 
start