/pdp-1 music 13
/  050117...051206 (change to cxt 060330) (bumped nog 060525)
/  061203 adj. to detuning, added sense switches 5, 6
/  070417 minor changes
/  080813 inverted sense switch 1
/  plays from core banks 1...2
/  (assumes compiled there)

4/	repeat 4, opr
	jmp go
11/
tuw,	642017	/detuning increments (3 bits each)
tpf,	100000	/tempo fudge factor
noe,	5400	/top of available mem (bank 1) if DDT present
nof,	7776	/top of available mem (each bank) if DDT absent
nog,	700	/bottom of avail. mem (banks 1, etc.)
npt,	0	/number of parts
top,	0	/top of available bank 0
f1,	0	/freq of first voice
f2,	0
f3,	0
f4,	0
sum,	0	/checksum
ib,	0	/tape buffer pointer
tpg,	252	/tempo factor from test word
tix,	scl 8s	/scale of detuning

30/
/multiply routine (assumes signed operands in AC, IO)
/ returns 34-bit product, 2 signs
mp2,	0
mpr,	0

mpy,	0
	dap mpx
	dio mpr
mps,	hlt	/skp for mul, skp i for mus
	jmp mpu
	lac mpy
	spa
	cma
	rcr 9s
	rcr 9s
mp1,	lac mpr
	spa
	cma
	dac mp2
	cla
	repeat 21, mus mp2
	dac mp2
	lac mpr
	xor mpy
	sma
	jmp mp3
	lac mp2
	cma
	rcr 9s
	rcr 9s
	cma
	rcr 9s
	rcr 9s
	jmp mpx

mp3,	lac mp2
	jmp mpx

mpu,	lac mpy
	mul mpr
mpx,	jmp .

/divide routine (assumes positive operands)
/ lac hi-dividend, lio lo-dividend, jda dvd, lac divisor,
/ overflow return, normal return (quot in AC, remdr in IO)
dv0,	0
dv1,	0
dv2,	0
dvd,	0
	dap dv0	/works extended
	xct i dv0
	dac dv1	/divisor
	idx dv0
	lac dvd
dvs,	hlt	/skp for div, skp i for dis
	jmp dvu
	sub dv1
	sma
	jmp dve	/if overflow
	repeat 22, dis dv1
	add dv1
	dio dv2	/temp
	cli
	rcr 1s
	dac dvd
	jmp dvw

dvu,	div dv1
	jmp i dv0	/if overflow
	dac dv2
	idx dv0
	lac dv2
	jmp i dv0
	
dvw,	idx dv0
dve,	lac dv2
	lio dvd
	jmp i dv0


f5,	0
f6,	0
/ jsp gfg to get flags 5, 6 from memory
gfg,	dap gfx
	cla
	clf 5
	sas f5
	stf 5
	clf 6
	sas f6
	stf 6
gfx,	jmp .


tw0,	0
tw1,	0
tw2,	0
/ jsp tun to set up detuned frequencies tab from pt, tuw
tun,	dap tux
	lac tuw	/detuning increments for each part
	dac tw0
	and (77
	rar 6s
	sar 6s
	sar 5s	/overall detuning, twice scale of per-part
	dac tw2
tn1,	law tab
	dap to
tn2,	law pt
	dap ti
	cla
	lio tw0
	rcl 3s
	dio tw0
	sub (4	/offset of increment
	add tw2
	dac tw1
tl,	cla
ti,	add .
	lio tw1
	jda mpy	/multiply
	xct tix	/scale
	xct ti
to,	dac .
	idx to
	sad (dac tbe
tux,	jmp .	/exit
	idx ti
	sas (add pt+100
	jmp tl	/next pitch
	jmp tn2	/next voice


cb,	0	/compiler data
eb,	0	/end of current block
ij,	0	/voice number
off,	0	/offset of voice's notes

t6=3		/tab right 6
tab=t6*100	/detuned frequencies for voice 0...3
tbe=tab+400

nbk=3		/number of core banks

/ flags 5, 6:	meaning		Continue:	Start at 4:
/	0, 0	pgm loaded	(none)		Read first voice
/	1, 0	voice(s) read	Compile & play	Read subseq. voice
/	1, 1	compiled	Play again	Read first voice

700/
		/come here on readin only
beg,	clf 7
	dzm f5	/nothing read in
	dzm f6	/nothing compiled
	jsp ini	/initialize pointers
	law 10
	cli
	mul (10	/which works, mul or mus?
	lio (skp
	sza	/0 in AC if mul
	lio (skp i
	dio mps	/will skip for mus
	cla
	lio (200
	div (10	/which works, div or dis?
	opr
	lio (skp
	spa	/pos. in AC if div
	lio (skp i
	dio dvs	/will skip for dis
	dzm npt
stp,	lio ib	/where read up to
	szf 6
	lio cb	/where compiled up to
	lac npt	/number of parts read
	hlt
con,	eem
	jsp gfg	/set flags from memory
	szf i 5	/come here on Continue	
	jmp stp	/if nothing to play
	szs 20	/switch 2 says recompile
	clf 6
	szf i 6
	jsp cpl	/compile (set flag 6 if successful)
	dzm f6
	szf 6
	idx f6
	szf i 6
	jmp stp
	jsp tun
	jmp pla	/if something to play

b,		/bar pointer
b+4/
n,		/note pointer
n+4/
t,		/time left in note (192 * 8)
t+4/
a,		/time left in artic (192 * 8)
a+4/
p,		/pitch
p+4/

1000/
		/set test address to here
go,	szs i 10	/come here on Start
	jmp con	/switch 1 to read tape
	eem
	jsp gfg	/get flags from memory
	szf 6
	clf 5
	dzm f5
	szf 5
	idx f5
	clf 6
	dzm f6
	szf 5
	jmp rdp	/read a voice
/ here to initialize all voices
rdi,	jsp ini	/initialize pointers
	dzm npt
	dzm ij	/start with voice 0
	dzm b
	dzm b+1
	dzm b+2
	dzm b+3

/ here to read a voice
rdp,	lac nof	/use all bank 0
	szs 30
	lac noe	/leave room for DDT
	dac top
	law i 4
	add ij
	sma
	jmp stp	/nope, we're full
	jsp rdg
	lac ib
	dac off
rd1,	rpb	/a note
	dio i ib
	lac i ib
	add sum
	dac sum
	idx ib
	sad top
	hlt	/too much data
	isp ct
	jmp rd1
	rpb	/checksum
	dio ct
	lac sum
	sas ct
	hlt	/checksum error
rdm,	jsp rdg
	law b
	add ij
	dap rd2
	lac ib
rd2,	dac .	/b(ij)
rd3,	rpb	/a bar pointer
	dio i ib
	lac i ib
	add sum
	dac sum
	lac i ib
	sma
	add off
	dac i ib
	idx ib
	sad top
	hlt	/too much data
	isp ct
	jmp rd3
	rpb	/checksum
	dio ct
	lac sum
	sas ct
	hlt	/checksum error
	idx ij	/ready for next voice
	stf 5	/got some data
	idx f5
	idx npt	/count the part
	jmp stp

/ jsp rdg to set up to read a section
rdg,	dap rgx
	rpb
	dio ct	/note count
	lac ct
	sma
	sza i
	hlt	/count too small
	cma
	dac ct
	dzm sum
rgx,	jmp .

pit,	0	/pitch
tem,	0
tpx,	0	/max fract for tempo
tpm,	0	/tempo multiplier
min,	0	/min fract
mn2,	0	/min loopct / 2
ceb,	0

/ jsp cpl to compile
cpl,	dap cpx
	lac (clf 2
	lio (stf 2
	dac p2c
	dac p2d
	dac p3c
	dac p3d
	dac p3e
	dio p2s
	dio p3s
	lac (clf 3
	lio (stf 3
	szs 50	/switch 5 swaps alto, tenor
	jmp cp1
	dac p3c
	dac p3d
	dac p3e
	dio p3s
	jmp cp0

cp1,	dac p2c
	dac p2d
	dio p2s
cp0,	lac (10000
	add nog
	dac cb
	lac b
	dac sb
	lac b+1
	dac sb+1
	lac b+2
	dac sb+2
	lac b+3
	dac sb+3
	law (600000
	dac n	/prime the pump
	dac n+1
	dac n+2
	dac n+3
	lat	/test word contain tempo?
	dac tem
	sub (1400
	sma
	jmp cp2	/if too big
	add (1340
	spa
	jmp cp2	/if too small
	lac tem
	jmp cp3
cp2,	law 252	/default, 170.
cp3,	dac tpg	/save tempo value from test word
	law 252
	jda tpo	/set tempo
	lac nof
	add cb
	sub nog
	dac eb
ca,	lac (600000	/are all voices at bar line?
	sad i n
	sas i n+1
	jmp cc
	sad i n+2
	sas i n+3
	jmp cc
	/ here to advance to next measure
	law t
	dap ca0
ca0,	dzm .
	idx ca0
	sas (dzm a+4
	jmp ca0
	
	dzm ij
ca1,	law b
	add ij
	dap ca2
	dap ca4
	add (n-b
	dap ca3
ca2,	lac .	/get bar ptr
	sza i
	jmp ca9	/if voice is over
	dac tem
	lac i tem
	sad (600000
	jmp ca9	/if voice is over
ca3,	dac .	/put note ptr
	sas (600000
ca4,	idx .	/advance bar ptr
ca9,	idx ij
	sas (4
	jmp ca1

	lac (600000
	sad i n
	sas i n+1
	jmp cc
	sad i n+2
	sas i n+3
	jmp cc
	/ here if all done
	lac sb
	dac b
	lac sb+1
	dac b+1
	lac sb+2
	dac b+2
	lac sb+3
	dac b+3
	lac (10000
	add nog
	sas cb
	stf 6	/set flag if successful
	cli
	jsp put	/0, 0, 0
	cli
	jsp put	/0, 0
cpx,	jmp .	/exit

	/ here to compile a segment
cc,	dzm ij
	lac (177700
	dac min
	dzm ceb	/count end bars
	/ find minimum time
cc1,	law b
	add ij
	/dap c0b
	/dap c1b
	add (n-b
	dap c0n
	dap c1n
	add (t-n
	dap c0t
	dap c1t
	add (a-t
	dap c0a
	dap c1a
	add (p-a
	dap c0p
c0t,	lac .	/time left in note
	sza
	jmp cc2
c0a,	lac .	/time left in artic
	sza
	jmp cc2
	/ need a new note
c0n,	lac i .	/get note
	and (700000
	sas (700000
	jmp c9c
	xct c0n	/get note
	and (77777
	jda tpo	/set tempo
c1n,	idx .	/advance note ptr
	jmp c0n

c9c,	xct c0n	/get note
	sas (600000
	jmp cc3	/it's really a note
	idx ceb	/it's a bar line
	cla
	xct c1t	/0 to note time
	xct c1a	/0 to artic time
	xct c0p	/0 to pitch
	jmp cc2	/with 0 as time

cc3,	rcl 9s
	rcl 9s	/note to IO
	xct c1n	/advance note ptr
	cla
	rcl 2s	/articulation bits
	clf 6
	spi
	stf 6	/triplet
	ril 1s
	rcl 2s	/rest of articulation bits
	add (cxt
	dap c0x	/articulation
	cla
	rcl 6s	/pitch
	sad (1
	cla	/1 is a rest too
c0p,	dac .	/put pitch
	sza
	jmp cca
	law (cla
	dap c0x	/don't split a rest
cca,	cla
	rcl 7s	/get dur in 64ths
	dac tem
	sal 1s
	szf i 6	/triplet?
	add tem
	clf 6	/now have dur in 192nds
	sal 3s	/allow for precise artic
	sma
	sza i
	jmp c0n	/if no time there
	dac tem
c0x,	xct .	/compute time of artic
	spa
	cla
c1a,	dac .	/put artic time
	cma
	add tem
	spa
	cla
c1t,	dac .	/put note time
	jmp c0t

cxt,	sar 3s	/e
	sar 2s	/q
	sar 1s	/h
	hlt
	jda c58	/s
	hlt
	hlt
	hlt
	cla	/l
	hlt
	hlt
	hlt
	hlt	/bar line
	hlt
	hlt
	hlt

c58,	0
	dap c5x
	lac c58
	sar 2s
	add c58
	sar 1s
c5x,	jmp .

cc2,	sza i
	jmp cc5	/0 doesn't count
	sub min
	sma
	jmp cc5	/> min doesn't count
	add min
	dac min
cc5,	idx ij
	sas (4
	jmp cc1
	lac tpx
	sub min
	sma
	jmp cc6
	add min
	dac min	/min 192nds * 8
cc6,	lac min
	lio tpm
	jda mpy	/multiply
	scl 8s
	dac mn2	/loop ct / 2

	law 4
	sad ceb
	jmp ca	/all at bar line
	law i 1	/2 loops for combo fetch
	add mn2
	dac mn2
	sma
	sza i
	jmp cc	/no time there
	/ here to form segment
cc4,	lac t
	sza	/no time = rest
	lac p	/pitch
	rar 6s
	rcl 6s
	lac t+1
	sza
	lac p+1
	rar 6s
	rcl 6s
	lac t+2
	sza
	lac p+2
	rar 6s
	rcl 6s
	jsp put	/pitch, pitch, pitch
	lac t+3
	sza
	lac p+3
c4m,	rcr 6s	/pitch to IO
	lac mn2
	rcr 6s
	rcr 6s
	jsp put	/time, pitch

c4n,	dzm ij
c4o,	law t
	add ij
	dap c4p
	dap c4q
	add (a-t
	dap c4r
	dap c4s
c4p,	lac .	/lac t...
	sub min
	sma
	jmp c4q
c4r,	lac .	/lac a...
	sub min
	sma
c4s,	dac .	/dac a...
	jmp c4x

c4q,	dac .	/dac t...
c4x,	idx ij
	sas (4
	jmp c4o
	jmp cc

/ jda tpo to set tempo from AC
tpo,	0
	dap stx
	lac tpo
	lio tpg	/1st factor: from TW
	jda mpy
	jda dvd
	 law 252
	hlt	/if overflow
	lio tpf	/2nd factor: location 12
	jda mpy	/multiply
	scl 5s
	lio (1131
	jda mpy
	scl 9s
	dac tpm
	cla
	lio (17760	/7770 and a null bit
	rcl 9s
	jda dvd
	 lac tpm
	hlt	/if overflow
	dac tpx
stx,	jmp .

/ jsp ini to initialize pointers
ini,	dap inx
	lac (10000
	add nog
	dac cb
	law not
	dac ib
inx,	jmp .

/ jsp put to put IO in compiled area
put,	dap pux
	dio i cb
	idx cb
	sas eb
pux,	jmp .	/exit
	add (10000
	sub nof
	add nog
	dac cb
	sub nog
	sad (nbk*10000
	jmp cpx	/full, fail
	add nof
	dac eb
	jmp pux

ptr,	0	/player fetch pointer
ct,	0	/loop count
hop,	0	/step from end of one bank to start of next
gap,	0	/step from start of bank to end

plq,	szs i 60	/ loop play on switch 6
	jmp stp
/ jmp pla to play (jmps back to stp when done)
pla,	lac (10000
	add nog
	sad cb	/where compiler put last data
	jmp stp	/if no real music there
	dac ptr
	add nof
	sub nog
	dac eb	/end of block
	lac (10000
	sub nof
	add nog
	dac hop
	lac nof
	sub nog
	dac gap
	cla
	dac f1
	dac f2
	dac f3
	dac f4
	jmp nxt

xbk,	/ here to advance to next core bank (ptr in AC)
	add hop
	dac ptr
	add gap
	dac eb
	lac f1
	add p1
	dac p1
	lac f2
	add p2
	dac p2
	lac f3
	add p3
	dac p3
	lac f4
	add p4
	dac p4
	nop	/with a cycle to spare!
	jmp lup

nxt,	/ here to get next note
	lio i ptr
	law t6
	rcl 6s
	dap .+1
	lac .
	dac f1
	sal 1s
	add p1
	dac p1
	law t6+1
	rcl 6s
	dap .+1
	lac .
	dac f2
	sal 1s
	add p2
	dac p2
	law t6+2
	rcl 6s
	dap .+1
	lac .
	dac f3
	sal 1s
	add p3
	dac p3
	idx ptr
		/0 in IO
	lac i ptr	/loopct/2, pitch
	rcr 6s
	sza i
	jmp plq	/the end
	sal 1s	/(loopct/2) * 2
	cma
	dac ct
	law t6+3
	rcl 6s
	dap .+1
	lac .
	dac f4
	sal 1s
	add p4
	dac p4
	idx ptr
	sad eb
	jmp xbk	/if to next core bank

/ fall into playing loop
lup,	lac f1
	add p1
	spa
	jda p1
	dac p1
	clf 1
	lac f2
	add p2
	spa
	jda p2
	dac p2
p2c,	clf 2
	lac f3
	add p3
	spa
	jda p3
	dac p3
p3c,	clf 3
	lac f4
	add p4
	spa
	jda p4
	dac p4
	clf 4
	isp ct
	jmp lup
	jmp nxt

p1,	0
	stf 1
	lac f2
	add p2
	spa
	jda p2
	dac p2
p2d,	clf 2
	lac f3
	add p3
	spa
	jda p3
	dac p3
p3d,	clf 3
	lac f4
	add p4
	spa
	jda p4
	dac p4
	clf 4
	isp ct
	jmp lup
	jmp nxt

p2,	0
p2s,	stf 2
	lac f3
	add p3
	spa
	jda p3
	dac p3
p3e,	clf 3
	lac f4
	add p4
	spa
	jda p4
	dac p4
	clf 4
	isp ct
	jmp lup
	jmp nxt

p3,	0
p3s,	stf 3
	lac f4
	add p4
	spa
	jda p4
	dac p4
	clf 4
	isp ct
	jmp lup
	jmp nxt

p4,	0
	stf 4
	isp ct
	jmp lup
	jmp nxt

/ equal-tempered frequencies, assuming 175 microsec loop
pt,	decimal
	0				/rest
	/1337				/as0
	1416				/b0
	1500	1589	1684		/c1, cs1, d1
	1784	1890	2003	2122	/ds1, e1, f1, fs1
	2248	2382	2523	2673	/g1, gs1, a1, as1
	2832	3001	3179	3368	/b1, c2, cs2, d2
	3568	3780	4005	4243	/ds2, e2, f2, fs2
	4496	4763	5046	5346	/g2, gs2, a2, as2
	5664	6001	6358	6736	/b2, c3, cs3, d3
	7136	7561	8010	8487	/ds3, e3, f3, fs3
	8991	9526	10092	10693	/g3, gs3, a3, as3
	11328	12002	12716	13472	/b3, c4, cs4, d4
	14273	15122	16021	16973	/ds4, e4, f4, fs4
	17983	19052	20185	21385	/g4, gs4, a4, as4
	22657	24004	25432	26944	/b4, c5, cs5, d5
	28546	30243	32042	33947	/ds5, e5, f5, fs5
	35966	38104	40370	42771	/g5, gs5, a5, as5
	45314	48008			/b5, c6
	50863				/cs6
	/53887				/d6

octal

sb,
sb+4/

consta

not=.-20	/notes & bars (tape buffer area)

start beg