music player_  28 sept 1967

org=20000	/origin of music on drum
nbuf=34.	/number of drum buffers
lbuf=120.	/size of each
size=lbufxnbuf	/space taken on each field (4080.)
mar=16.	/margin after each buffer
la2=iot 5077

/common section

3/	jmp brk
4,	jmp go
beg,	lio (i	/initial entry
	dia
	cla>>05<<cli
	dcc
	xx
tun,	lio (1200	/load tuning word
	dia
	lio (i pr2-1200
	law 1200
	dcc
	xx
	jmp tn1
dun,	lsm
	cli>>05<<cla>>05<<hlt>>05<<lai>>05<<clf 7
pla,	lio (200	/play
	dia 
	lio (i pr2-200
	law 200
	dcc
	xx
	jmp pl1
go,	lsm
	szs 50 i
	jmp .+4
	lat
	dac twd
	jmp tun
	szs 60
	jmp pla
com,	lio (pr2	/load tape and compile
	dia
	lio (i pr3-pr1
	law pr1
	dcc
	xx
	jmp cm1
	constants
twd,	333300
vol1,	0	/last volume word read
vol2,	0	/last volume word on drum
tempo,	0
op,	0	/compiler buffer pointer
dp,	0	/drum pointer
mss,	skp	/skip if any music is on drum
pr1,
                
e                                
/player

dimension buf(lbuf+mar)

1200/
tn1,	law 200	/load tuning word
	dap to
tn2,	law pt
	dap ti
	cla
	lio twd
	rcl 3s
	dio twd
	sub (3
	dac mpa
ti,	lac .
	mul mpa
	scl 9s
	add i ti
	lia
to,	dio .
	idx to
	xct to
	idx to
	sad (dio 1200
	jmp tn3
	idx ti
	sad (lac pt+100
	jmp tn2
	jmp ti
tn3,	lio (i 200
	dia
	lio (1000
	law 200
	dcc
	xx
	jmp dun
                
>>37<<                                
brk,	cks
	ril 5s
	spi i
	jmp dsb
	lio mpa
	dia
	lio mpf
	law buf
	dcc
	hlt
	law i lbuf
	adm ptr
	law 7777
	and 1
	sub (saf
	spa
	jmp .+3	/not safe to bump XR
	law 15.
	X+AX
	lac i p11
	ral 4s
	adm t11
	lac i p22
	ral 4s
	adm t22
	lac i p33
	ral 4s
	adm t33
	lac 2
	ral 4s
	adm t44
dsb,	lac 0
	lio 2
	jmp i 1

pl1,	xct mss	/play
	jmp dun	/nothing to play
	cli>>05<<cmi
	la2
	dzm t11
	dzm t22
	dzm t33
	dzm t44
	law 252
	lea
	law buf
	dap ptr
	lio (org lbuf+mar
	dio .mpf
	dzm .mpa
	cli
	dia
	lio (org lbuf+mar
	law buf
	dcc	/read first buffer
	xx
	cbs
	esm
	jmp ptr
                
s                                
.+.^1/
vol,	sni
	jmp fin	/end of music
	TXI
	lei
	lac i p11
	ral 1s
	adm t11
	iot 14
	lac i p22
	ral 1s
	adm t22
	iot 114
	lac i p33
	ral 1s
	adm t33
	iot 214
	xct p44
	jmp nxm

ptr,	lxr .
	idx ptr
	lai	/make up for some lost time
	ral 1s
	adm t44
	iot 114
	lio i ptr
	TI|=
	jmp vol	/change volume or end of music
	law i 73
	rcl 6s
	ral 1s
	dap p22
	lac i p11	/fix up other parts
	ral 1s
	adm t11
	iot 14
	lac i p22
	ral 1s
	adm t22
	iot 314
	lac i p33
	ral 1s
	adm t33
	iot 214
	rir 2s
	X.IX
saf,	law 1
	rcl 6s
	ral 1s
	dap p11
	law 2
	rcl 6s
	ral 1s
	dap p44
	law 3
	rcl 6s
	ral 1s
	dap p33
                
l                                
p44,	lio .
	lai	/make up for more lost time
	ral 1s
	adm t44
	iot 114
	lac i p11
	ral 1s
	adm t11
	iot 14
	lac i p22
	ral 1s
	adm t22
	iot 314
	lac i p33
	ral 1s
	adm t33
	iot 214
p00,	lai
	adm t44
	iot 114
p11,	lac .	/this location must be odd
	adm t11
	iot 14
p22,	lac .
	adm t22
	iot 314
p33,	lac .
	adm t33
	iot 214
	SXX.>
	jmp p00
nxm,	idx ptr
	sas (lxr buf+lbuf
	jmp ptr
	lai
	ral 1s
	adm t44
	iot 114
	law lbuf
	adm mpa
	sas (size
	jmp nx2
	dzm mpa
	lac (i
	adm mpf
	jmp nx3
nx2,	repeat 6,nop
                
6                                
nx3,	lac i p11
	ral 1s
	adm t11
	iot 14
	lac i p22
	ral 1s
	adm t22
	iot 314
	lac i p33
	ral 1s
	adm t33
	iot 214
	law i 15.
	add mpa
	lia
	dba
	xct p44
	jmp ptr

fin,	lsm
	szs 60
	jmp pl1
	jmp dun

.>>05<<./
t11,	0
t22,	0
t33,	0
t44,	0

repeat ifn p22^1,[printx /try again
/]

pt,	/prototype pitch table

/twelfth root of 2 = 1.059463094359295264581

0	2147	2252	2361
2474	2614	2740	3072
3231	3375	3547	3730
4120	4316	4524	4742
5171	5430	5701	6164
6461	6772	7317	7660
10237	10634	11250	11704
12361	13060	13602	14350
15143	15764	16636	17541
20476	21470	22521	23611
24742	26140	27404	30717
32305	33751	35474	37301
41175	43161	45241	47421
51705	54300	57007	61636
64613	67721	73170	76603
102372	106342	112502	117042

pt+100,

constants
pr2,
variables
                
x                                
/phase 2 compiler

	offset pr2-pr1
pr1/
dimension bf2(lbuf)	/compiler buffer

b,	b+4/	/bar pointer
n,	n+4/	/note pointer
t,	t+4/	/time
p,	p+4/	/pitch
f,	f+4/	/articulation flag (- when part runs out)
a,	a+4/	/articulation

cm1,	eem
	dzm ij
	law not
	dac .nl
gnp,	rpb	/read one part
	spi
	jmp er	/end of all parts
	cmi
	dio .ct1
	law 4
	sad ij
	jmp tm	/too many parts
	law b
	add ij
	dap b1
	dzm .fl	/0 while reading notes
	lac nl
	dac .off	/note offset
re1,	lac fl
	dac .fls	/save in case of checksum
	lac ct1
	dac .cts
	lac nl
	dac .nls
	law i 104
	dac .ct
	dzm .csm
re3,	lac nl
	dac i b1
	rpb
	lai
	adm csm
	lai
	lio fl
	sni i
	add off	/relocate
	sza i
	jmp re6	/note/bar marker
	dac i nl
	idx nl
	sad (100000
	jmp sf	/storage full
	sad (20000
	lac (70000
	dac nl
                
8                                
re7,	isp ct1
	jmp re4
	rpb	/done
	lai
	sas csm	/last checksum
	jmp re5
	idx ij
	jmp gnp
re4,	isp ct
	jmp re3
	rpb	/end of block
	lai
	sad csm
	jmp re1
re5,	jsp txx
	text /cksm
_/
	clc>>05<<cli>>05<<cmi>>05<<hlt
	lac cts
	dac ct1
	lac fls
	dac fl
	lac nls
	dac nl
	jmp re1
er,	lac ij
	dac .np
	sza
	jmp re8
	jsp txx
	text /No parts
_/
	jmp dun
re6,	idx fl
	jmp re7
sf,	jsp txx
	text /Storage full. Subdivide all parts.
_/
	jmp dun
tm,	jsp txx
	text /No jump block after 4 parts.
_/
	jmp er
ts,	jsp txx
	text /too slow
_/
	jmp tf1
tf,	jsp txx
	text /too fast
_/
tf1,	clc>>05<<cli>>05<<cmi>>05<<hlt
                
u                                
re8,	lat
	dac .tm2
	and (777
	sas tm2
	jmp tf
	law i 40
	add tm2
	spa
	jmp ts
	law 170.
	dac tempo
	law 252
	dac vol1
	dac vol2
	szs 20
	xct mss
	jmp r10	/reset drum pointers
	law i 2
	adm op
	law 7777
	and dp
	lia
	dia
	xor dp
	ior (lbuf
	lia
	law bf2
	dcc
	hlt
	jmp q0
r10,	lac (org	/erase previous music
	dac dp
	law bf2
	dac op
                
2                                
q0,	dzm .bc	/bar count
	dzm .mes	/last bar in error
	law (600000
	dac n
	dac n+1
	dac n+2
	dac n+3
	law t	/clear out unused parts
	dap .+1
	dzm .
	idx .-1
	sas .+2
	jmp .-3
	dzm p+3
q8,	idx .bc	/initialize measure
	clf 2
	dzm ij
	clc
	dac .pro
lu2,	law b
	add ij
	dap b1
	add (n-b
	dap n1
	add (t-n
	dap t1
	add (p-t
	dap p1
	add (f-p
	dap f1
q89,	lac i n1
	dac .foo
	lac i foo
	and (law
	sas (jmp
	jmp .	/?
b1,	lac .
	dac .foo
	lac i foo
	sad (jmp
	jmp q88	/part has run out
	stf 2	/F2 means some part still has bars
	dac i n1
	law i 1
	adm i b1
q86,	dzm i f1
	dzm i t1
	idx ij
	sas np
	jmp lu2
	szf 2 i
	jmp end
	lac .pro
	sma
	jmp q56	/some part has run out
                
6                                
/get time for each part. If part is at end of bar or end of music,
/get zero
q9,	dzm .ij
	law 2s
	dac .sfl	/shift counter for volume
	clc
	dac ps
	clf 5
q10,	law b	/check this part
	add ij
	dap b1	/set pointers
	add (n-b
	dap n1
	add (t-n
	dap t1
	add (p-t
	dap p1
	add (f-p
	dap f1
	add (a-f
	dap a1
q15,	law i 7
t1,	add .
	sma
	jmp q13	/sufficient time exists
f1,	lac .	/refill
	szm
	jmp q14	/flag on, get articulation
n1,	lac .
	dac .po1
	lac i po1
	ral 3s
	and (7
	add (q1x
	dap q12
	law 777
	and i po1
	dac .temp	/duration
q12,	xct .
e,	dac i a1
	cma
	adm i t1
	idx i f1
l,	lac i po1
	ral 9s
	and (77	/pitch
	dac i p1
	idx i n1
	lac temp
	ral 3s
	adm i t1
	jmp q15
                
                                
Q"X=	JMP L	?L
	JMP S	?S
	NOP	?E
	RAL "S	?H
	RAL 'S	?Q
	JMP SVL	?SET VOLUME
	JMP Q"~	?END OF BAR= CAN't get any time
	jmp q1y	/set tempo

q1y,	law 7777
	and i po1
	dac tempo
q1z,	idx i n1
	sad (and
	lac (law
	dac i n1
	jmp n1
s,	ral 2s
	add temp
	jmp e

svl,	lac sfl
	ior (ral
	dac sv1
	add (rar-ral
	dac sv2
	lac vol1
	rar 8s
sv1,	xx
	lio temp
	rcr 2s
sv2,	xx
	rar 8s
	dac vol1
	jmp q1z

q14,	dzm i p1
a1,	lac .
	adm i t1
	dzm i f1
	jmp q15
q13,	lac i t1
	sza i
	jmp .+3	/no time
	stf 5	/F5 means some part has time
	jmp q77+1
	lac i f1
	spa
	jmp q77	/end of part already noted
	lac ij
	dac .ps	/some part is short
q77,	dzm i p1	/if no time, make it a rest
	lac sfl
	ral 2s
	add (2s
	dac sfl	/sfl=2s,4s,6s,8s
	idx ij
	sas np
	jmp q10	/check next part
                
m                                
	szf 5 i
	jmp q8	/no time in any part
	lac .ps
	sma
	jmp mis	/some part is short
q99,	lac t	/calculate least time
	sza i
	law 7777
	lio t+1
	sni
	jmp .+5
	sub t+1
	sma
	cla
	add t+1
	lio t+2
	sni
	jmp .+5
	sub t+2
	sma
	cla
	add t+2
	lio t+3
	sni
	jmp .+5
	sub t+3
	sma
	cla
	add t+3
	dac temp
	cma>>05<<lia
	add t
	sma
	dac t
	lai
	add t+1
	sma
	dac t+1
	lai
	add t+2
	sma
	dac t+2
	lai
	add t+3
	sma
	dac t+3
	lac temp
	mul tempo
	rcr 1s
	div tm2
	hlt
	dac temp
	lac vol1
	sad vol2
	jmp d2
	dac vol2
	jda put
	clc
	jda put
                
>>17<<                                
d2,	lac p
	ral 6s
	ior p+1
	ral 6s
	ior p+2
	jda put
	law 7770
	sub temp
	sma
	cla
	add temp
	lia
	cma
	adm temp
	cmi>>05<<lai
	and (7777
	ral 6s
	ior p+3
	rar 6s
	jda put
	lac temp
	sza
	jmp d2	/if too long, break it up
	jmp q9

end,	cla	/end of music
	jda put
	jsp put+1
	lio dp
	dia
	lio (lbuf
	law bf2
	dcc	/write out last buffer
	hlt
	law 7777
	and dp
	sza
	jmp en2
	law i i-size
	add dp
	dia
	lio (i-size
	law bf2
	dcc	/write out patch at top of last field
	hlt
en2,	law 600
	dap mss	/music now exists
	lem
	szs i 10
	jmp dun
	jmp pla
                
>>32<<                                
put,	0
	dap pux
	law bf2+lbuf
	sad op
	jmp wrb
	lac put
	dac i op
	idx op
pux,	jmp .

wrb,	lio dp
	dia
	lio (lbuf
	law bf2
	dcc
	hlt
	law bf2
	dac op
	law lbuf
	adm dp
	and (7777
	sad (lbufxnbuf
	jmp wr2
	sas (lbuf
	jmp put+5
	law i lbuf+i-size
	add dp
	lia
	dia
	lio (i-size
	law bf2
	dcc
	hlt
	jmp put+5
wr2,	law i-size
	adm dp
	jmp put+5

p1,	lac .

q88,	lac i f1	/part is out of music
	spa
	jmp q86+1	/already know about it
	lac ij
	dac .pro	/record that fact
	clc
	dip i f1
	jmp q86+1

q56,	jsp txx
	text /Part _/
	law 1
	add pro
	jdp dpt
	jsp txx
	text / is out of music at measure _/
	lac bc
	jdp dpt
	jsp txx
	774000
	jmp q9
                
t                                
mis,	lac bc
	sad mes
	jmp q99	/error already printed
	jsp txx
	text /Measure _/
	lac bc
	jdp dpt
	jsp txx
	text / of part _/
	law 1
	add ps
	jdp dpt
	jsp txx
	text / is too short.
_/
	lac bc
	dac mes
	jmp q99

dpt,	0
	dac .dp1
	dzm .dp2
dpp,	dac .dp3
	mul (1
	div .+1
	10.
	sas dp2
	jmp dpp
	sni
	lio (20
	tyo
	lac dp3
	dac dp2
	lac dp1
	sas dp2
	jmp dpp
	jmp i dpt

txx,	dap txy
	lio i txy
	idx txy
	lac (607600
	rcl 6s
	sad (lai
txy,	jmp .
	sad .+2
	jmp txx+1
	swp
	tyo
	lia
	jmp txy-3
constants
pr3,
variables
not,
start 5
                
>>32<<                             7