music player_  14 july 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,
                
                                
/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
                
                                
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
                
                                
.+.^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
                
                                
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
                
                                
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

	decimal
0	1283	1359	1440
1525	1616	1712	1814
 1922	2036	2157	2285
2421	2565	2718	2879
3051	3232	3424	3628
3844	4072	4314	4571
4843	5130	5436	5759
6101	6464	6848	7256
7687	8144	8628	9141
9685	10261	10871	11518
12202	12928	13697	14511
 15374	16288	17257	18283
19370	20522	21742	23035
24405	25856	27393	29022
30748	32577	34514	36566
38740	41044	43484	46070
	octal
pt+100,

constants
pr2,
variables
                
                                
/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
                
                                
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
                
                                
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
                
                                
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
                
                                
/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
                
                                
q1x,	jmp l	/l
	jmp s	/s
	nop	/e
	ral 1s	/h
	ral 2s	/q
	jmp svl	/set volume
	jmp q13	/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
                
                                
	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
                
                                
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
                
                                
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
                
                                
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