harmony compiler	phase 2  _   10/31/62

0/

start
          
                                                                                                                                                                                                                                                                                                                                                                                                                  macros  _ 1/6/62  (as amended by Acts of 1/15/62, 4/5/62, and 4/30/62)

/further amended 10/20/62

	define	load A	lac A	termin

	define	store A	dac A	termin

	define	addi A	add A	termin

	define	goto T	jmp T	termin

	define	govia P	jmp i P	termin

	define	subt A	sub A	termin

	define	zero A	dzm A	termin

	define	step1 J	idx J	termin

	define	call S	jda S	termin

	define	band U	and U	termin

	define	halt	hlt	termin

	define	clear	cla	termin

	define	comple	cma	termin

	define	x2to1	ral 1s	termin

	define	x2to6	ral 6s	termin

	define	x2to3	ral 3s	termin

	define	x2to2	ral 2s	termin

	define	x2to10	rar 8s	termin

	define	x2to12	rar 6s	termin

	define	halve	sar 1s	termin

	define	x2tom3	sar 3s	termin

	define	x2tom4	sar 4s	termin

	define	x2tom6	sar 6s	termin

	define	x2tom7	sar 7s	termin

	define	exit P	jmp	termin

	define	move A,B	lac A	dac B	termin

	define	sett A,B	lac (B	dac A	termin

	define	trze T	sza i	jmp T	termin
                     
                                                  
	define	trnz T	sza	jmp T	termin

	define	trpl T	sma	jmp T	termin

	define	trmi T	spa	jmp T	termin

	define	trel A,T	sad A	jmp T	termin

	define	trnl A,T	sas A	jmp T	termin

	define	type Q	lio Q	tyo	termin

	define	ftrel A,T	trel A,T	termin

	define	lookup V
		add (V	dap .+1	lac	termin

	define	feed N	law i N	jda fee	termin

	define	step J, I
		lac J	add I	dac J	termin

	define	stepa J, I
		law I	add J	dac J	termin

	define	istepa J, I
		law i I	add J	dac J	termin

	define	grow A, V, C
		lac A	add (V	dac C	termin

	define	tles C, T
		sub C	spa	jmp T	termin

	define	tlesc C, T
		sub (C	spa	jmp T	termin

	define	tgrel C, T
		sub C	sma	jmp T	termin

	define	tgrec C, T
		sub (C	sma+sza-skp	jmp T	termin

	define	test0 Y, Z
		lac Y	sza i	jmp Z	termin

	define	test1 Y, Z
		lac Y	sza	jmp Z	termin

	define	testp Y, Z
		lac Y	sma	jmp Z	termin

	define	testm Y, Z
		lac Y	spa	jmp Z	termin
                    
                                                 
	define	testel Y, Z, A
		lac Y	sad Z	jmp A	termin

	define	testnl Y, Z, A
		lac Y	sas Z	jmp A	termin

	define	dispat U
		add (U	dap .+1	jmp i	termin

	define	diswit L, U
		add (U	dap .+2	lac L	jmp i	termin

	define	putback U, Q
		add (U	dap .+2	lac Q	dac	termin

	define	answer X
		0	dap X	lac .-2	termin

	define	x10dec
		ral 1s	dac t1	ral 2s	add t1	termin

	define	copy H, I, N
		law H	dap .+3	law I	dap .+2
		lac	dac	idx .-2	idx .-2
		sas (dac I+N	jmp .-5	termin

	define	search W, N, ERR
		dac t1	law W	dap .+2	lac t1
		sad	jmp .+5	idx .-2	sas (sad W+N
		jmp .-5	jmp ERR	lac .-6	add (-sad-W
		termin

	define	print F
		lac F
		repeat 3	rcl 6s	tyo
		termin

start
                                   
            
          
                                                                                                                                                                                                                                                                                                                                                                                         /machine lang. subroutines

	em=377745


rb,	0
	dap rbx
	rpb
	rcr 9s
	rcr 9s
rbx,	jmp


fla,	0
	dap flx
	lac fa
	add (dio
	jda ppp
	lac la
	add (dio
	jda ppp
	lac fa
	add la
	add (dio+dio
	dac ckm
flx,	jmp


csm,	0
	lio ckm
	jmp pbp


ipu,	0
	lio (jmp 7751
	jmp pbp


fee,	0
	dap fex
	cli
	lat
	and (700
	sad (700
	jmp fex
	ppa
	isp fee
	jmp .-2
fex,	jmp


               
                                                 
ppp,	0
	lio ppp
pbp,	dap pbx
	lat
	and (700
	sad (700
	jmp pbx
	ppb
	ril 6s
	ppb
	ril 6s
	ppb
pbx,	jmp


jbk,	0
	lio (jmp 100
	jmp pbp


tsw,	0
	dap .+2
	lat
	jmp


start
                  
   
        
                                                                                                                                                                                                                                                                                                                                                                                                                                                                      /read in, setup, countdown+refill, merge, punch store


/read in


ph2,
yea,	zero npt
	zero nn
	zero nb
	sett mc, -1

h1,	halt
	move nn, nn1
	zero nn2

r1,	call rb
	store n1
	zero ckm

r2,	call rb
	store t2
	addi ckm
	store ckm
	load nn
	putback not, t2
	step1 nn2
	step1 nn
	addi nb
	tgrec all, rr
	testnl nn2, n1, r2
	call rb
	trel ckm, r3
	move nn1, nn

r2b,	print (flexo cs

	goto h1
          
                                                                
r3,	move nb, nb1
	call rb
	store n1
	zero ckm
	zero nn2

r2a,	call rb
	store t2
	addi ckm
	store ckm
	load t2
	addi nn1
	store t2
	load nb
	complement
	putback bar, t2
	step1 nn2
	step1 nb
	addi nn
	tgrec all, rr
	testnl nn2, n1, r2a
	call rb
	trel ckm, h1a
	move nb1, nb
	goto r2b
rr,	print (flexo sf

	goto pro

h1a,	step1 npt
	putback npl-1, nb1
	load npt
	tlesc 10, h1
	goto pro
          
                                                                /set up

pro,	test0 npt, h1
	zero mgi
	zero psi
	call tsw
	trmi h11
	sett fa, 400
	sett tpo, 252
	sett fy, 600
	sett 0f1, 60001
	feed 200
	call ipu
	feed 300

h11,	zero t1
	move fa, la

pr1,	load t1
	putback nos, (0
	step1 t1
	tlesc 220, pr1
	zero t1

pr2,	load t1
	putback npo, (1
	load t1
	putback nmu, ((600000)-not
	load t1
	putback ton, (0
	step1 t1
	tlesc 10, pr2
          
                                                                
/countdown and refill, merge


mma,	zero iii

ma,	sett lst, 377700
	zero ij
	zero i1
	zero i0

ma0,	call cta
	lookup nos
	store nox
	band (377700
	subt lst
	trpl ma1
	addi lst
	store lst

ma1,	load nox
	band (77
	store nox
	load ij
	putback ton, nox
	step1 ij
	tles npt, ma0

mg,	test0 mgi, mg9	/merge
mg1,	load lst
	x2tom6
	store t1
	load tpo
	call mul
	complement
	call ps
          
                                                                
	load ton
	x2to6
	addi ton+1
	x2to6
	addi ton+2
	call ps
	load npt
	tlesc 4, mb
	load ton+3
	x2to6
	addi ton+4
	x2to6
	addi ton+5
	call ps
	load npt
	tlesc 7, mb
	load ton+6
	x2to6
	addi ton+7
	x2to6
	call ps
	goto mb

mg9,	sett mgi, 1

mb,	zero ij

mb0,	zero j1
	call cta
	store t1a
	lookup nos
	band (377700
	subt lst
	trnz mb3
	load ij		/refill
	lookup npo
	subt (1
	store qqr
	trnz mb9

mc0,	load ij
	lookup nmu
	store qrq
          
                                                                
m02,	lookup not
	store qqs
	ftrel (600000, mr1
	band (700000
	trnl (700000, m01
	load qqs
	band (77777
	store tpo
	tlesc 526, m21
	load tpo
	tgrec 1252, m23
	sett fy, 300
	sett 0f1, 30001
	goto m22

m21,	sett fy, 600
	sett 0f1, 60001
	goto m22

m23,	print (flexo ts

	load tpo
	call dpt
	type (77

m22,	load qrq
	addi (1
	store qrq
	load ij
	putback nmu, qrq
	goto mc0

m01,	load ij
	putback npo, (1
	load qrq
	addi (1
	store qrq
	load ij
	putback nmu, qrq
	goto mc5

mr1,	sett i1, 1
	store j1
	load ij
	lookup npl
	store qpl
	addi (1
	store t1
	load ij
	putback npl, t1
	load qpl
	complement
	lookup bar
	store t1
	trel (600000, mb6
	load ij
	putback nmu, t1
	goto mc0
          
                                                                /translation

mc5,	test1 j1, mb5
	sett i0, 1

mb5,	load qqs
	band (177
	x2to3
	store tim

ta2,	load qqs
	band (100000
	trze ta9
	load tim
	x2to1
	goto ta8
ta9,	sett t1, 3
	load tim
	call mul
ta8,	store tim
	load qqs
	band (17600
	x2tom7
	store in
	trel (1, ta3

tb1,	load qqs
	trmi ta3
	band (200000
	trnz mr2

ta4,	load qqs
	band (60000
	ftrel (20000, taq
	trel (40000, tah
	load tim
	halve
	goto tar

taq,	load tim
tar,	halve
	goto tai

tah,	load tim
tai,	halve
	goto mr3

mr2,	sett t1, 5
	load tim
	x2tom3
	call mul

mr3,	store slc
	tlesc 4, ta3

ta5,	load tim
	subt slc
	store tim
          
                                                                
mr8,	load slc
	subt fy
	store slt
	tlesc 1, ms1
	move slt, slc
	call cta
	putback nos, 0f1
	call snp
	goto mr8

ms1,	load slc
	x2to6
	addi (1
	store t2
	call cta
	putback nos, t2
	call snp

ta3,	load tim
	subt fy
	store slt
	tlesc 1, mb4
	move slt, tim
	load 0f1
	subt (1
	addi in
	store t2
	call cta
	putback nos, t2
	call snp
	goto ta3

mb4,	load tim
	x2to6
	addi in
	store t2
	call cta
	putback nos, t2
	goto mb8

mb3,	load t1a
	lookup nos
	subt lst
	store qqq
	load t1a
	putback nos, qqq

m9a,	sett i0, 1
mb8,	step1 ij
	tles npt, mb0
	test0 i1, ma
	step1 mc
	test0 i0, mma
	test1 iii, ma
	load mc
	call dpt
	type (77
	sett iii, 1
	goto ma
          
                                                                
mb9,	load ij
	putack npo, qqr
	goto m9a


/decimal print

dpt,	answer dpx
	store t1
	zero dpi
	zero dpd
	zero dps
	trpl dp3
	type (54
	load t1
	complement

dp1,	store t1
dp3,	step1 dpd
	load dpi
	lookup dpb
	store t2
	addi t1
	trpl dp1
	istepa dpd, 1
	trnz dp2
	test0 dps,dp4
	sett dpd, 20

dp2,	type dpd
	sett dps, 1

dp4,	zero dpd
	step1 dpi
	tlesc 6, dp3
	test1 dps, dpx
	type (20
dpx,	exit dpt

	decimal
dpb,	-100000
	-10000
	-1000
	-100
	-10
	-1
	octal
          
                                                                
/multiply by  t1

mul,	answer mux
	zero t3
	store t2

mu2,	band (1
	trze mu1
	load t1

mu1,	addi t3
	store t3
	load t1
	x2to1
	store t1
	load t2
	halve
	store t2
	trnz mu2
	load t3

mux,	exit mul


cta,	answer ctw
	load ij
	lookup rlc
	store t1
	load ij
	lookup npo
	addi t1
ctw,	exit cta


snp,	answer snk
	load ij
	lookup npo
	addi (1
	store t1
	load ij
	putback npo, t1
snk,	exit snp
          
                                                                /punch store

ps,	answer psx
	store psa
	sett psh, psx
	load psi
	putback pb, psa
	step1 la
	step1 psi
	load la
	tgrel (em, emu

ps5,	load psi
	tlesc 100, psx

ps6,	zero psu
	call fla
	move la, fa

ps1,	load psu
	lookup pb
	store t1
	addi ckm
	store ckm
	load t1
	call ppp
	step1 psu
	tles psi, ps1
	call csm
	zero psi
	feed 6
	govia psh
psx,	exit ps

emu,	print (flexo of 	/o.f.space
	load mc
	addi (1
	call dpt
	type (77

mb6,	sett psh, ps7	/entry at end of tape
	test1 psi, ps6

ps7,	feed 100
	call tsw
	band (1
	trnz ph2
	clear
	call ps
	clear
	call ps
	sett psh, ps8
	goto ps6

ps8,	feed 20
	call jbk
	feed 300
	goto ph2

start
          
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  TEMPORARY^3 storage

fy,	0	/split-up value
0f1,	0	/100xfy+1

iii,	0	/suppress error prints
mgi,	0	/indicator to ignore 1st result
trr,	0	/translation results
fa,	0	/first address of block
la,	0	/last address in block+1
tpo,	0	/tempo
ckm,	0	/checksum
lst,	0	/smallest time
ij,	0	/handy index on part
npt,	0	/number of parts
nn,	0	/number of notes
nb,	0	/number of bars
nn1,	0	/saves nn
nb1,	0	/saves nb
n1,	0	/number of words in block
nn2,	0	/number of lines read in block
qqr,	0	/npo pointer_. no. of live entries
qrq,	0	/pointer to not
qqs,	0	/note
in,	0	/internal tone
psi,	0	/punch buffer index--filling
psu,	0	/punch buffer index--emptying
psh,	0	/punch routine return switch
qqq,	0	/time left (temp.)
t1a,	0	/index on nos
qpl,	0	/temp. bar index
slc,	0	/slice reserved for articulation
slt,	0	/temp. slc
tim,	0	/time (temp.)
nox,	0	/note temp.
psa,	0	/ps temp.
mc,	0	/measure count
i0,	0	/bar not crossed
i1,	0	/bar crossed
j1,	0	/marks i1 part
dpd,	0	/digit to be printed
dpi,	0	/index on depletion table
dps,	0	/zero-suppression switch


t1,	0
t2,	0
t3,	0
          
                                                                
constants

.-70/	ton,
ton+10/	nmu,
nmu+10/	npl,
npl+10/	npo,
npo+10/	nos,
nos+220/	rlc,	-1	21	43	65
		107	131	153	175

	pb,
pb+100/	not,
7750/	bar,

	all=bar-not-1
	at=pro

start yea
          
                                             7