anticompiler

/this program does not initialize itself and is not re-usable

/it will ask for n (number of parts)
/and p (part to be anticompiled)

/When it asks for a tempo, the tempo should divide the first number
/that it types. The second number that it types is its guess for
/the tempo.

beg,	law 51
	arq
	bpt
	law 47
	arq
	bpt
	lio (45
	tyo
	cli
	tyo
	tyi
	dio n
	cli 100
	tyo
	lio (47
	tyo
	cli
	tyo
	tyi
	law i 1
	A+II
	dio pt
	cli 100
	tyo
	law 5
	add n
	mul (1
	div (3
	hlt
	dac .mn
	rpb
	jdp gwd
pu,	dac buf
	idx pu
	sas (dac end
	jmp pu-1

/get one note

g1n,	lac i oup
	TAAM|
	jmp fin	/end of music, mm should be zero
	lio tpo
	spi
	jmp gnt	/get new tempo
	cma
	mul (1
	div tpo
	hlt
	sni i
	jmp gnt	/tempo not acceptable
	dac .lst	/number of 192nds
	law i 30
	mul un
	lac mm
	sza i
	dio mm
	lac lst
	adm mm
uua,	szm
	jmp nuu	/ran over measure
/mm has number of 192nds left in measure after this note
	jdp gbf
	ZIX	/load pitches
lp1,	lac t1
	sni i
	jmp .+3
	jdp gbf
	cli>>05<<cmi
	rcl 6s
	dac t1
	lai
	and (77
	aam
	dac ton
	A~II
	SXXA
	sas n
	jmp lp1
                
>>37<<                                
/now have a note, if mm = 0 it is last in measure

	lxr pt
	aam
	lac ton

/pick out desired part

	dac ton
aza,	lac tn1
	TAAM
	jmp abc
	lac ton	/first note
	dac tn1
	lac lst
	dac ls1
dcb,	clc
	dac ton
	lac mm
	sza i
	jmp bcd
	jmp g1n
abc,	sas ton	/combine notes of same pitch
	jmp bcd
	lac lst
	adm ls1
	jmp dcb
                
a                                
/note is now in tn1, ls1
/ton=-0 if it is last in measure

bcd,	lac tn2
	clf 7
	TAAM
	jmp two	/process two notes
	sad ton
	jmp one	/process one note
	lac tn1
	dac tn2
	lac ls1
	dac ls2
	jmp en9

two,	lac ls2
	dac .aaa
	lac tn2
	dac .bbb
	law 1
	sas tn2
	sas tn1
	jmp tw1
	lac ls1
	dac .ccc
	jdp huh	/articulated note
	clc
	dac tn2
	lac ccc
	TAA|=
	jmp en9	/following rest was used up
	dac ls1	/time remaining
	jmp bcd

tw1,	lac tn2
	dac bbb
	lac ls2
	dac aaa
	clc
	dac ccc
	jdp huh
	clc
	dac tn2
	jmp bcd

one,	lac tn1
	dac bbb
	lac ls1
	dac aaa
	clc
	dac ccc
	jdp huh
	jmp en9
                
o                                
define dv a,b,c
	law 1
	mul a
	div (b'.
	hlt
	sni
	c
terminate

huh,	0
	lac ccc
	TAAM|
	jmp nar
	sub (300
	spa	/don't articulate if rest is longer than 1/8th note
	jmp art	/articulated
nar,	clf 7
	dv aaa,24,jmp lll
	stf 6
	dv aaa,16,jmp lll
	lac ccc	/can't
	TA|=
	hlt	/lose, lose, lose
	jmp art	/try one more time
/"l" articulation, triplet if F6, time in AC
lll,	dac tt
	scr 7s
	sza
	jmp jjj	/note is too long, need to join them
	lac bbb
	rcl 7s
	szf 6
	ior (100000
	lia
	law 1
	xor bbb
	TAP
	lac (400000
	A>>05<<IA	/turn on l bit if not rest
	jdp opt
	lac ccc
	TAAM|
	jmp i huh
	dac aaa
	clc
	dac ccc
	law 1
	dac bbb
	jmp huh+1

jjj,	scr 1s
	sza
	jmp jjj
	lac bbb
	rcl 7s
	dac .fgq
	szf 6
	ior (100000
	lia
	law 1
	xor bbb
	TAP
	lac (400000
	A>>05<<IA
	jdp opt
	law 177
	and fgq
	cma
	add tt
	jmp lll

define al n,l
	dv aaa,n,jmp l'l'l
terminate

art,	clf 7
	al 21,e
	al 18,q
	al 12,h
	al 9,s
arc,	clf 7
	stf 6
	al 14,e
	al 12,q
	al 8,h
	al 6,s
	jmp los

eee,	dac .tt
	mul (3
	stf 2
	jmp zzz
qqq,	dac tt
	mul (6.
	stf 3
	jmp zzz
hhh,	dac tt
	mul (12.
	stf 4
	jmp zzz
sss,	dac tt
	mul (15.
	stf 5
zzz,	scr 1s
szf i 6
	jmp yyy
	lai
	mul (2
	div (3
	hlt
	lia
yyy,	CIA
	add ccc
	spa
	jmp noo
	sza>>05<<szf 6
	jmp los	/don't use triplet unless it comes out exactly
	dac ccc
yyr,	lac tt	/win
	scr 7s
	sza
	hlt
	lac bbb
	rcl 7s
	szf 6
	ior (100000
	szf 4
	ior (040000	/h
	szf 3
	ior (020000	/q
	szf 5
	ior (200000	/s
	jdp opt
	jmp i huh

noo,	szf i 6
	jmp arc

/look for exact match with rest, splice note as needed

define gl n,l
	clf 2
	clf 3
	clf 4
	clf 5
	dv ccc,n,jdp l'l'x
terminate

los,	clf 7
	gl 3,e
	gl 6,q
	gl 12,h
	gl 15,s
	stf 6
	gl 2,e
	gl 4,q
	gl 8,h
	gl 10,s
	jmp nar	/can't

eex,	0
	lio eex
	dio ssx
	dac tt
	mul (21.
	stf 2
	jmp zzs
qqx,	0
	lio qqx
	dio ssx
	dac tt
	mul (18.
	stf 3
	jmp zzs
hhx,	0
	lio hhx
	dio ssx
	dac tt
	mul (12.
	stf 4
	jmp zzs
ssx,	0
	dac tt
	mul (9.
	stf 5
zzs,	scr 1s
	szf i 6
	jmp yys
	lai
	mul (2
	div (3
	hlt
	lia
yys,	CIA
	add aaa
	spa
	jmp i ssx
/AC = amount of aaa left over
	sza i
	hlt	/?
	dac eex
	mul (1
	div (24.
	hlt
	sni
	jmp llz
	law 1
	mul eex
	div (16.
	hlt
	sni i
	jmp i ssx
	scr 7s
	sza
	hlt
	lac bbb
	rcl 7s
	ior (100000
	jmp llq
llz,	scr 7s
	sza
	hlt
	lac bbb
	rcl 7s
llq,	ior (400000
	jdp opt
	dzm ccc
	jmp yyr

/if ton=-0, end of measure
en9,	clc
	dac tn1
	sas ton
	jmp aza	/more notes waiting in this measure
	lac (600000
	jdp opt
	lac p3
	dac i sbc
	lac p1
	sas sbc
	jmp en7
	lac nlo
	dac i sbc
en7,	law i 1
	adm sbc
	law not
	dac p3
	dac p2
	law 7777
	dac p1
	lac nl
	dac nlo
en8,	jmp g1n
                
.                                
nuu,	lio (714524	/get new units
	tyo
	repeat 2,rir 6s	tyo
	lio (2223
	tyo
	repeat 2,rir 6s	tyo
	law 30
	mul un
	lai
	adm mm
	clc
	dac un
ut5,	tyi
	lai
	sad (77
	jmp ut8
	sad (20
	cli
	lac un
	sal 2s
	add un
	sal 1s
	A+IA
	dac un
	jmp ut5
ut8,	law i 30
	mul un
	lai
	adm mm
	jmp uua

gnt,	clc	/get new tempo
	dac .g
	lac oup
	dac .t1
gnl,	lac i t1
	cma
	lio g
	TIIM|
	jmp gn8
	AMI<
	jmp . 4
	lia
	lac g
	dio g
	mul (1
	div g
	hlt
	sni i
	jmp .-6
	jmp . 2
gn8,	dac g
	lac mn
	cma
	dac .t2
gn9,	idx t1
	sad (end
	law buf
	dac t1
	sad oup
	jmp gn0
	lac i t1
	TAM|
	jmp gn0
	isp t2
	jmp gn9
	jmp gnl
gn0,	lio (flexo tem
	repeat 3,ril 6s	tyo
	lio (flexo po 
	repeat 3,ril 6s	tyo
	lac g
	jdp dpt
	law 1
	mul g
	div (3
	hlt
	sni
gt4,	dac g	/if divisible by 3, do so
	law i 200.
	add g
	spa
	jmp . 5	/try to get tempo below 200
	lac g
	rar 1s
	sma
	jmp gt4	/by dividing by 2
	lio (33
	tyo
	lac g
	jdp dpt	/guessed tempo
	cli
	tyo
	clc
	dac tpo
gt5,	tyi
	lai
	sad (77
	jmp tm8
	sad (20
	cli
	lac tpo
	sal 2s
	add tpo
	sal 1s
	A+IA
	dac tpo
	jmp gt5

tm8,	lac tpo	/tempo change done
	ior (700000
	lio pt
	sni
	jdp opt	/punch it if part 1
	jmp g1n
                
z                                
/output note

opt,	0
	dac .tac
	lac p1
	sad sbc
	jmp app
	lac i p2
	sad tac
	jmp sam
pp1,	law i 1
	adm p1
	sad sbc
	jmp cpy
	lac p3
	dac p5
	lac i p1
	dac p4
	dac p6
pp2,	lac p2
	sad p5
	jmp pp3
	lac i p5
	sas i p4
	jmp pp1
	idx p4
	idx p5
	jmp pp2
pp3,	lac p6
	dac p3
	lac p4
	dac p2
	jmp opt+2

sam,	idx p2
	jmp i opt

cpy,
cp2,	lac i p3
	dac i nl
	lac p3
	sad p2
	jmp app
	idx nl
	idx p3
	jmp cp2

app,	lac tac
	dac i nl
	idx nl
	jmp i opt
                
/                                
fin,	lac mm
	sza
	hlt	/not on even bar
	law i not
	add nl
	jdp pbw
	dzm csi
	law not
	dac tt
	lac i tt
	jdp pbw
	idx tt
	sas nl
	jmp .-4
	lac csi
	jdp pbw
	law i 6
	cli
	ppa
	SAAP
	jmp .-3
	lac (10000
	sub sbc
	jdp pbw
	dzm csi
	law 7777
	dac tt
	law i not
	add i tt
	jdp pbw
	law i 1
	adm tt
	sas sbc
	jmp .-6
	lac (600000
	jdp pbw
	lac csi
	jdp pbw
	law i 200
	cli
	ppa
	SAAP
	jmp .-3
	law i 51
	arq
	law i 47
	arq
	dsm

pbw,	0
	lia
	adm csi
	repeat 3,	ppb	ril 6s
	jmp i pbw
                
.                                
dpt,	0
	dac .dp1
	dzm .dp2
dpa,	dac .dp3
	cli 60
	rcl 1
	div . 1
	10.
	sas dp2
	jmp dpa
	sni
	lio (20
	tyo
	lac dp3
	dac dp2
	lac dp1
	sas dp2
	jmp dpa
	jmp i dpt

/get word from tape

gbf,	0	/get word and refill buffer
	jdp gwd
	lio i oup
	dac i oup
	idx oup
	sad (end
	law buf
	dac oup
	lai
	jmp i gbf

gwt,	0
	lac enf
	TAAM|
	jmp i gwt
	lac fa
	TAM|
	jmp gw1
	rpb
	dio t
	lai
	adm csi
	idx fa
	sas la
	jmp gw2
	rpb
	lai
	sas csi
	hlt
	clc
	dac fa
gw2,	lac f2
	dac wrd
	lio f1
	dio f2
	lio t
	dio f1
	TAAM|
	jmp gwt+1
	jmp i gwt

gw1,	rpb
	spi
	jmp gw3
	dio fa
	dio csi
	rpb
	dio la
	lai
	adm csi
	jmp gwt+1
gw3,	lac f1
	ior f2
	CAAM
	hlt
	dac enf
	dac wrd
	jmp i gwt

gwd,	0
	lac w1f
	sza i
	jmp rd1	/wb1 empty
	sub (1
	dac w1f
	SAA
	cma
	add mn
	add (wb1
	dap . 1
	lac .
	jmp i gwd

rd1,	jmp . 1	/becomes rd2
	law rd2
	dap rd1
	jdp gwt
	dac wb2
	idx .-1
	sub (dac wb2
	sas mn
	jmp .-5
rd2,	law wb1
	dap . 4
	law wb2
	dap . 1
	lac .
	dac .
	idx .-2
	idx .-2
	sas (dac wb1 6
	jmp .-5
	lac mn
	dac w1f
rd3,	law wb2
	dap rd5-1
	clf 6
	lac (skp 600
	dac rd5
rd4,	jdp gwt
	lia
	dac .
rd5,	skp 600
	stf 6	/no match
	lac rd5-1
	add (sas wb1+1-wb2-dac
	dac rd5
	idx rd5-1
	sub (dac wb2
	sas mn
	jmp rd4
	szf i 6
	TIM|
	jmp gwd 1
	lac wb2
	clo
	add wb1
	szo
	jmp gwd 1
	dac wb1
	jmp rd3

w1f,	0
dimension wb1(6),wb2(6)
enf,	0
f1,	-0
f2,	-0
fa,	-0
la,	0
tn1,	-0
tn2,	-0
ls1,	0
ls2,	0
csi,	0
wrd,	0
t,	0
mm,	0
oup,	buf
tpo,	-0	/tempo
un,	-1	/units
n,	0	/number of parts
pt,	0	/this part-1
buf,	.+300/
end,
ton,	.+10/

p1,	7777
sbc,	7777
p3,	not
p2,	not
nl,	not
nlo,	not
p4,	0
p5,	0
p6,	0

variables
constants
not,
start