music player_ 16/3/68
mot=ivk 77
dat=ivk 21
/change stuff at re8 and q1y+7 to calibrate tempo
org=20000 /origin of music on drum
nbuf=34. /number of drum buffers per field
lbuf=120. /size of each
size=lbufxnbuf /space taken on each field (4080.)
mar=16. /margin after each buffer
la2=iot 5077
dimension sec(1) /section number
dimension msn(1) /beginning measure number
dimension bno(1) /initial block number of file
dimension rep(1) /tape word pointer
dimension ptb(1000) /tape block table
0/ jmp set /initial entry
3/ jmp .
4, law 600
dap pls /tell control not to play
dap tys /tell it to type
gtc, lio (sct /read in control section
dia
lio (i enm-sct
gts, law sct
dcc
hlt
jmp sct
set, lio (i
dia
cli>>05<<cla
dcc /write out entire program
hlt
jmp 4
tm2, 1000. /tempo word
twn, 3 3 3 3
tpn, -0
vol1, 0
vol2, 0
op, 0
dp, 0
mss, skp /skip if any music is on drum
pls, skp /switch to play after compilation
tys, skp /switch to type c.r. at entry to control
j
txx, dap txy
aam
lio txy
idx txy
lac (607600
rcl 6s
sad (lai
txy, jmp .
sad . 2
jmp txx 1
swp
tyo
lia
jmp txy-3
h
/read tape, block number in AC
/F4 . forward
/F5 . in end zone
/F6 . moving
rdt, 0
dap trx
law 777
and rdt /desired block
sub (400 /translate it
TAAI<
cma
ral 1s
add (776
spi
add (3
dac trb /translated block
/main loop
mtl, mot 100 /skip if ready
jmp mt0 /no
mot 300 /skip if end of tape
jmp mt1
clf 6 /tape not moving any more
lio enz
szf 5
jmp sre /already know about it
stf 5
rpf
rir 3s
dio enz /store end info
jmp sre
mt1, clf 5 /out of end zone
lac trb
sub bkn
szf i 6
jmp ms1 /not moving
szf i 4
cma /number of blocks to go
add (5
szm
jmp try
mst, clf 6 /5 blocks past, turn around
law 1
szf i 4
cma
adm bkn /coast distance
jmp mtl
l
ms1, TAI> /start tape
cma
sub (5
spq
cmi /too close, go away from it
srt, law 4 /IO + to go forward, - for reverse
spi i
cma
adm bkn /accelerate distance
sre, spi i
mot 600 /fwd
spi
mot 700 /rev
mot 400 /go
stf 6
clf 4
spi i
stf 4 /direction flag
try, lac trb /try reading it
dat 4500 /read
dat 300 /get status
spi
jmp m16 /wrong block
ril 2s
spi
jmp mtl /block timing error
ril 1s
spi
jmp mtl /end of tape
rir 2s
dac bkn /actual block number
spi
trx, jmp . /transfer finished
cla>>05<<clf 6
ril 1s
SAA
TI.<
jmp .-3
skp i
mt0, cla>>05<<clf 6
mot 500 /stop
hlt /error
jmp mtl
m16, dat 200 /read block number
law 1777
A^IA
dac bkn
jmp mtl
enz, 0 /end zone flag, - . 777, + . 0
trb, 0 /translated block
bkn, 0 /actual block number
constants
variables
sct,
a
/control section
dimension dir(1000) /directory from tape
dimension cb(1) /end-of-symbol flag
dimension ca(1) /symbol terminator
dimension c(1) /character packing count
dimension num(1) /value of number
dimension poi(1) /end of text buffer
dimension tex(20) /input symbol buffer
sct, xct pls
jmp go /play music
xct tys
jmp lup
in, lio (77
tyo
u
/read command
lup, iam
eem
law 600
dap tys
jdp res
szf i 5
jmp lup
law cmt
jdp lkp
jmp err
jmp i flv
err, jsp txx
text .?_.
jmp in
app, law 600 /append
dap pls
xct mss
jmp loa /drum is empty
jmp plb
pla, ZAP /play
loa, law 600 /load
dap pls
lac (org /clear the drum
dac dp
law bf2+2
dac op
plb, clc
sad tpn
jmp ntt /no tape mounted
mot 100
jmp tnr /not ready
dac sec
dac msn
law 1
dac flv /pointer to entire directory
lo1, law 77
sad ca
jmp lo9 /end of line
jdp res
szf i 5
jmp lo1 /no symbol
lac flv
spa
jmp lo6 /already at lowest level
add (dir
jdp lkp
jmp nof
aam
lac flv
jmp lo1-1
5 lo6, lio num /section number or measure number
lac sec
TAM|
dio sec /section number
TAM
dio msn /starting measure number
jmp lo1
lo9, lac flv
sma
hlt /several files at once
and (777
dac bno /initial block number
lac (77777
dac rep
lio (i sct /write out control section
dia
lio (enm-sct
law sct
dcc
hlt
lio (enm /read in compiler
dia
lio (i enc-sct
jmp gts
ntt, jsp txx
text .no tape_.
jmp in
tnr, jsp txx
text .tape not ready_.
jmp in
/read and copy block, block number in IO, address in AC
cpb, 0
dap cpx
lai
jda rdt
lac (77400
dac rdt
nam
lio i rdt
dio i cpb
idx cpb
idx rdt
sas (100000
jmp .-5
iam
cpx, jmp .
lkp, 0 /look up name
dzm .flv
dac .dlp
aam
add dlp
dac .dz
idx dlp
q, dap dq
sub dz
sma
jmp z /directory ran out
stf 6
stf 5
ZX
a, law i 3
dac .c
lac i tex
dq, lio i .
SXX|
b, lac .t
ral 6s
dac t
ril 6s
and (77
sad (77
clf 5 /typed string ran out
law 77
A^IA
sad (77
jmp d /directory entry ran out
xor t
and (77
sza>>05<<szf 5
clf 6 /entries don't agree
isp c
jmp b
jmp a
d, szf i 6
jmp lke /wrong entry
lac flv /right entry
sza
jmp amb /too many
lac dlp
dac .flo
X+AA
dac flv
lke, SXA
adm dlp
jmp q
z, sza
jmp ano
lxr .flv
TXP
idx lkp
jmp i lkp
>>60<<
ano, jsp txx
text .anomalous directory_.
jmp in
amb, jsp txx
text .amb_.
jmp in
nof, jsp txx
text .not found_.
jmp in
wai, cli>>05<<cla>>05<<hlt>>05<<lai>>05<<clf 7
go, xct mss /play
jmp err /no music
ZAX /set up tuning tables
law twn
dap tn2+3
tn2, law pt
dap ti
cla
lac .
sub (3
dac ca
ti, lac .
mul ca
scl 9s
swp
xct ti
A+IA
dac i 4000
dac i 4001
law 2
A+XXA
sad (1000
jmp tn3
idx ti
sas (lac pt+100
jmp ti
idx tn2+3
jmp tn2
tn3, lio (i sct /write out control section
dia
lio (enm-sct
law sct
dcc
hlt
lio (enm+enc-sct /read in player
dia
lio (i enp-sct
jmp gts
l
tem, law 77 /load tempo
sad ca
jmp err
jdp res
szf i 5
jmp tem
law i 300.
add num
spa
jmp ts
lac (5000.
sub num
spa
jmp tf
lac num
dac tm2
jmp in
ts, jsp txx
text .too slow_.
jmp in
tf, jsp txx
text .too fast_.
jmp in
tun, law twn
dap tu1
tu0, law 77
sad ca
jmp lup
jdp res
szf i 5
jmp tu0
law 7
and num
tu1, dac .
idx tu1
sas (dac twn+4
jmp tu0
law 77
sad ca
jmp lup
jmp in
unt, jdp rwt /unload tape
jmp in
.
rwt, 0
clc
sad tpn
jmp i rwt
dac tpn
mot 700 /reverse
mot 400 /go
dat 4400 /search
mot 300 /wait for end zone
jmp .-2
jmp i rwt
tap, law 77 /load tape
sad ca
jmp err /no argument
jdp res
szf i 5
jmp tap
jdp rwt /rewind old tape
law 17
and num
dac tpn
rcr 6s
dat /data select
mot /motion select
law 7400
dat 100 /channel address
clf 7
law dir
lio (4
jda cpb /read directory
law dir+400
lio (5
jda cpb
law ptb
lio (6
jda cpb /and block table
law ptb+400
lio (7
jda cpb
mot 500 /stop
jmp in
/read and pack symbol
res, 0
clf 7
ZX
dzm num
lu0, law i 3
dac c
lu1, clf 1
szf i 1
jmp .-1
tyi
lai
sad (40
jmp in /cancel
sad (36
cla
dac ca /space, comma, c.r., or symbol
sas (33
sza i
law 77
dac cb /c.r. or symbol
sad (77
jmp lu4
sad (charac r0
cla
lia
lac num
ral 2s
add num
ral 1s
A+IA
dac num
stf 5
lu4, lio i tex
lac cb
rar 6s
rcl 6s
dio i tex
isp c
jmp lu3
SXXA
dac poi
sad (20
hlt /text buffer overflow
law 77
sas cb
jmp lu0
jmp i res
lu3, law 77
sas cb
jmp lu1
jmp lu4
(
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,
cmt, cme-cmt
text /load/ 7777 jmp loa
text /append/
-0 jmp app
text /play/ 7777 jmp pla
text /go/ 77 jmp go
text /wait/ 7777 jmp wai
text /tempo/ 77 jmp tem
text /tune/ 7777 jmp tun
text /untape/
-0 jmp unt
text /tape/ 7777 jmp tap
cme,
constants
variables
enm, /end of control section
/compiler section
offset enm-sct
dimension bf2(lbuf) /drum buffer
dimension off(1) /measure offset
dimension nl(1) /packing pointer
dimension ij(1) /part number
dimension np(1) /number of parts
dimension ct(1) /word count
dimension tm3(1) /tempo information
dimension b1(4) /bar pointers
dimension n1(4) /note pointers
dimension t1(4) /time left in this note
dimension p1(4) /pitch
dimension f1(4) /articulation flag (- when part runs out)
dimension a1(4) /articulation time
sct/ eem
iam
law i 2 /read back last buffer
adm op
law 7777
and dp
lia
dia
xor dp
ior (lbuf
lia
law bf2
dcc
hlt
gns, dzm ij /compile one section
law not
dac nl
clf 7 /initialize tape
gnp, jdp gwd /read one part
spa
jda er /no more parts
cma
dac ct
law 4
sad ij
jmp tm /too many parts
clf 2 /goes on when bars begin
lac nl
dac off /note offset
g
re1, jdp gwd
szf 2
add off /relocate
sza i
jmp re6 /note/bar marker
aam
dac nl
idx nl
sad (77400
jmp sf /storage full
sad (20000
lac (70000
dac nl
jmp .+2
re6, stf 2
isp ct
jmp re1
lxr ij /end of part
law i 1
add nl
dac i b1
idx ij
jmp gnp
er, 0
mot 500 /stop tape
lac sec
TAM
sub (1
dac sec
cma>>05<<lia
TI=
jmp end /skip this section
ior er
dac er
lac ij
dac np
sza
jmp re8
jsp txx
text /No parts
_/
hlt
sf, mot 500
jsp txx
text /Storage full. Subdivide all parts.
_/
hlt
tm, mot 500
jsp txx
text /Too many parts.
_/
lac (jmp
jda er
p
re8, law 5 /begin compilation
lio (634520
/playing speed is inversely proportional to number in (AC,IO)
div tm2
hlt
cli
scr 9s
div (120.
hlt
dac tm3 /set initial tempo=120
law 252
dac vol1
dac vol2
q0, dzm .bc /bar count
dzm .mes /last bar in error
law (600000
lxr (-4
dzm i t1+4 /clear out all unused parts
dzm i p1+4
dac i n1+4 /initialize first measure
SXXP
jmp .-4
q8, idx .bc /initialize measure
clf 2
dzm ij
clc
dac .pro
lu2, lxr ij
q89, lac i n1
dac .foo
aam
lac foo
and (law
sas (jmp
hlt /last measure not ended
lac i b1
dac .foo
aam
lac 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
q86+1, dzm i t1
idx ij
sas np
jmp lu2
szf 2 i
jmp end /all parts are out
lac .pro
sma
jmp q56 /some part has run out
c
/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, lxr ij /check this part
q15, lac i t1
mul tm3
scl 8s
sub (12.
sma /see if 5 ms. exist in this note
jmp q13 /sufficient time exists
lac i f1 /refill
szm
jmp q14 /flag on, get articulation
gnn, lac i n1
dac .po1
aam
lac po1
dac po1
ral 3s
and (7
add (q1x
dap q12
law 777
and po1
dac .temp /duration
q12, xct .
e, dac i a1
cma
adm i t1
idx i f1
l, lac po1
ral 9s
and (77 /pitch
dac i p1
idx i n1
sad (20000
lac (70000
dac i n1
lac temp
ral 3s
adm i t1
jmp q15
6
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 1777 /set new tempo
and po1
dac po1
sub (20.
CAA>P
cla
adm po1
law 5
lio (634520
div tm2
hlt
cli
scr 9s
div po1
hlt
dac tm3
q1z, idx i n1
sad (and
lac (law
dac i n1
jmp gnn
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
>>52<<
q14, dzm i p1
lac i a1
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
>>53<<
q99, lac t1 /calculate least time
sza i
law 7777
lio t1+1
sni
jmp .+5
sub t1+1
sma
cla
add t1+1
lio t1+2
sni
jmp .+5
sub t1+2
sma
cla
add t1+2
lio t1+3
sni
jmp .+5
sub t1+3
sma
cla
add t1+3
dac temp
cma>>05<<lia
add t1
sma
dac t1
lai
add t1+1
sma
dac t1+1
lai
add t1+2
sma
dac t1+2
lai
add t1+3
sma
dac t1+3
lac bc
sub msn
spa
jmp q9 /haven't reached starting measure yet
lac temp
mul tm3
scl 6s
dac temp
lac vol1
sad vol2
jmp d2
dac vol2
jda put
clc
jda put
x
d2, lac p1
ral 6s
ior p1+1
ral 6s
ior p1+2
jda put
law 1770
sub temp
sma
cla
add temp
cma>>05<<lia
adm temp
sil 2s
SIA /cut out 4 music cycles to compensate
and (7777 /for setup time
ral 6s
ior p1+3
rar 6s
jda put
lac temp
sza
jmp d2 /if too long, break it up
jmp q9
end, lac er
ral 1s
sma
jmp gns /compile more
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 /was first buffer on a field
add dp
lia
dia
lio (i-size
law bf2
dcc /write out patch at top of last field
hlt
en2, law 600
dap mss /music now exists
jmp gtc /bring back control section
put, 0
dap pux
law bf2+lbuf
sad op
jmp wrb
lac put
aam
dac op
idx op
pux, jmp .
wrb, lio dp /write out buffer
dia
lio (lbuf
law bf2
dcc
hlt
law bf2
dac op
law lbuf
adm dp /advance to next buffer
and (7777
sad (lbufxnbuf
jmp wr2 /end of field
sas (lbuf
jmp put+5
law i lbuf+i-size /first buffer
add dp
lia
dia
lio (i-size
law bf2
dcc /copy patch onto previous field
hlt
jmp put+5
wr2, law i-size /start a new field
adm dp
jmp put+5
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
737740
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
gwd, 0 /read word from tape
idx rep
sad (100000
jmp .+4
aam
lac rep
jmp i gwd
lac (77400
dac rep
lac bno
sza i
hlt /ran off end of file
jda rdt
lxr bno
lac i ptb
dac bno
jmp gwd+4
constants
enc,
variables
not,
/
/player
dimension buf(lbuf+mar)
offset enm+enc-2xsct
sct/ lem
nam
law brk
dap 3
jmp pl1
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, cli>>05<<cmi
la2
dzm t11
dzm t22
dzm t33
dzm t44
law 252
lea
law buf
dap ptr
cli
dia
lio (org lbuf+mar
dio .mpf
dzm .mpa
law buf
dcc /read first buffer
xx
cbs
esm
cli
jmp ptr
>>12<<
.+.^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 54
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 4s
X.IX
saf, law 20
rcl 6s
ral 1s
dap p11
law 21
rcl 6s
ral 1s
dap p44
law 22
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
t
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
nx2, nop
nop
jmp nx3
fin, lsm
szs 60
jmp pl1
law 3
dap 3
law 600
dap pls
cla
jmp gtc-1 /return to control section
.>>05<<./
t11, 0
t22, 0
t33, 0
t44, 0
repeat ifn p22^1,[printx /try again
/]
constants
enp,
variables
start 0
>>60<< 1