/PDP-8 MUSIC MAKER
/RICH WILSON - 1975

PLAY=2400
JIFFY=76	/62
T1=474	/316
T2=442	/290
T3=5744	/3044	/DIVIDE TIME
TIM6=7
MDEFAULT=30^74%2	/C=60

/WORKING LOCATIONS
*10
AXA,	0
AXB,	0
AXC,	0
LOWAIT,	0
OOPS,	0
LIMIT,	0

*20
WSA,	0
WSB,	0

SAVE,	0
CHAR,	0
FLG,	0
GETPTR,	0
LOSAVE,	0
HOSAVE,	7777
LOLONG,	0
HOLONG,	7700
LOTIM,	0
HOTIM,	0
BUFGET,	0
TRAN,	0

NOTTAB,
AC,	0
AR,	0
AT,	0
RTOT,	0
BC,	0
BR,	0
BT,	0
OLDS,	0
CC,	0
CR,	0
CT,	0
SAVS,	0
DC,	0
DR,	0
DT,	0
OLDE,	0
*100
LOFUDG,	2465
HOFUDG,	2235

DOIT,	0
	TAD I	DOIT	/HOW LONG 'TILL NEXT CALL?
	DCA	LIMIT	/REMEMBER
	CDF	20
DOIT1,	TAD	LIMIT
	CLL
	TAD	LOWAIT	/IS THERE ENOUGH TIME TO RETURN
	SNL		/AND GET BACK IN TIME?
	JMP	DOIT5	/YES
	ISZ I	BUFGET	/HOW ABOUT HIGH ORDER TIME?
	JMP	DOIT6	/YES, TIME
	CLA CLL		/NOT ENOUGH TIME
	TAD	LOWAIT	/HOW LONG WE HAVE TO WAIT
	TAD	OOPS	/ERROR LAST TIME
	SZL		/HAVE WE WAITED OUR TIME?
	JMP	.+4	/YES
	TAD	(JIFFY	/NO, UPDATE AC
	NOP
	JMP	.-4	/AND TRY AGAIN
	DCA	OOPS	/SAVE ERROR
	ISZ	BUFGET	/NOW HOW MANY SPIKES?
	JMP	.+3
	JMP	.+2	/COVER SKIP
	CAF		/MAKE A SPIKE
	ISZ I	BUFGET
	JMP	.-2	/ANOTHER SPIKE
	ISZ	BUFGET
	SKP		/COVER ISZ SKIP
	NOP		/MAKING UP FOR TIMING ERROR
	TAD I	BUFGET	/LOW ORDER TIME
	DCA	LOWAIT	/SAVE IT
	ISZ	BUFGET	/POINT TO HO TIME
	JMP	DOIT1
	JMP	DOIT1	/COVER ISZ SKIP

DOIT5,	TAD	[0	/TIMING CORRECTOR
	NOP
DOIT6,	DCA	LOWAIT
	CDF
	ISZ	DOIT
	JMP I	DOIT
*PLAY
	DCA	FLG	/RESET PACKING FLAG
	DCA	GETPTR
	TAD	(BFR1
	DCA	TRAN
	CDF	20
	DCA	AXB
	DCA	BUFGET
	STL RAR
	DCA I	BUFGET
	STA
	DCA I	AXB
	CDF
	DCA	OOPS
	TAD	(MDEFAULT
	JMP	DOM1	/SET METER DEFAULT
RESTM,	JMS	DOIT
	T1+236	/158
	TAD	(100
	DCA I	AXA
	DCA I	AXA
NEXT1,	STA
	DCA I	AXA
NEXT,	JMS	DOIT
	T1+T2+276	/190
	JMS I	[GET
	CLL RAR
	SNL
	JMP	SPECIAL
	RTR
	AND	(7
	TAD	(JMPTAB
	DCA	WSA
	TAD I	WSA
	DCA	WSA
	JMS	DOIT
	T1+200	/128
	TAD	CHAR
	AND	(6
	CLL RAL
	TAD	(NOTTAB-1
	DCA	AXA
	JMP I	WSA

REST,	JMS	DOIT
	T1+236	/158
	TAD	(100
	DCA I	AXA	/LOW FREQUENCY
	DCA I	AXA	/NO SPIKES
NEXT2,	STA
	DCA I	AXA
	JMS	DOIT
	T1+T2+14	/12
	JMS I	[GET	/GET DURATION
	SNA CLA
	JMP	NEXHOL	/IT'S A LONG ONE
	JMS	DOIT
	T1+5406		/2822
	TAD	CHAR
	CLL RTL
	RTL
	RTL
	DCA	WSB
	TAD	(-6
	DCA	WSA
	DCA	LOTIM
	DCA	HOTIM
/NOW WE'RE ALL SET TO MULTIPLY
NEXLUP,	TAD	WSB
	RAL
	DCA	WSB
	SNL
	JMP	NEXNO2
	CLL
	TAD	LOSAVE
	TAD	LOTIM
	DCA	LOTIM
	RAL
	TAD	HOSAVE
	TAD	HOTIM
	DCA	HOTIM
NEXNO,	ISZ	WSA
	JMP	NEXSH
	JMP	NEXINI
NEXNO2,	TAD
	DCA
	TAD
	DCA
	TAD
	DCA
	JMP	NEXNO

NEXSH,	TAD	LOTIM
	CLL RAL
	DCA	LOTIM
	TAD	HOTIM
	RAL
	DCA	HOTIM
	JMP	NEXLUP

NEXHOL,	JMS	DOIT
	T1+416	/270
	TAD	LOLONG
	DCA	LOTIM
	TAD	HOLONG
	DCA	HOTIM
NEXINI,	TAD	AR
	TAD	BR
	TAD	CR
	TAD	DR
	CIA
	DCA	RTOT
	JMP	PLAY2
PAGE
SPECIA,	TAD	(JMPTB2-1
	DCA	AXA
	TAD I	AXA
	DCA	WSA
	JMP I	WSA

SETN,	JMS	DOIT
	T1+T2+750	/488
	STA
SETN2,	DCA	WSB
	JMS I	[GET	/GET PITCH
	TAD	TRAN
	DCA	WSA
	TAD I	WSA
	DCA I	AXA
	LAS
	CMA
	AND	(77
	TAD	CHAR
	CLL RAR
	TAD	(BFR2
	DCA	WSA
	TAD I	WSA
	DCA I	AXA
	ISZ	WSB	/CHECK FLAG
	JMP	NEXT1
	JMP	NEXT2

SETNM,	JMS	DOIT
	T1+T2+750	/488
	JMP	SETN2

ERR0,	HLT

DOEND,	JMS	DOIT
	T1+162	/114
	TAD	BUFGET
	CIA
	TAD	AXB
	AND	(7760
	SZA CLA
	JMP	DOEND
	LAS
	SPA CLA
	JMP	PLAY
	JMP	200

PAGE
DIVP=LOLONG
DIVM=HOLONG

DOMETE,	JMS	DOIT
	T1+T2+T2+400	/256
	JMS I	[GET
	CLL RTL
	RTL
	RTL
	DCA	DIVP
	JMS I	[GET	/GET RIGHT HALF
	TAD	DIVP
DOM1,	DCA	DIVP
	TAD	DIVP
	CIA
	DCA	DIVM	/- LENGTH
	TAD	HOFUDG
	DCA	LOTIM
	DCA	HOTIM
	JMS	DOIT
	T1+T3+116	/78
	JMS	DIV	/DIVIDE
	DCA	HOSAVE
	TAD	LOFUDG
	DCA	LOTIM
	JMS	DOIT
	T1+T3+32	/26
	JMS	DIV	/DIVIDE LO
	DCA	LOSAVE
	JMS	DOIT
	T1+2214	/1164
	TAD	(-6
	DCA	WSA	/WE MUST NOW SHIFT IT 6
	TAD	LOSAVE	/PLACES TO THE LEFT
	DCA	LOLONG	/FOR LONG NOTES
	TAD	HOSAVE
	DCA	HOLONG
DOM2,	TAD	LOLONG
	CLL RAL
	DCA	LOLONG
	TAD	HOLONG
	RAL
	DCA	HOLONG
	ISZ	WSA
	JMP	DOM2
	JMP	NEXT


DIV,	0		/HOTIM,LOTIM/DIVP(DIVM)
	TAD	(-15	/REM IN HOTIM, QUO IN LOTIM
	DCA	WSA	/SET UP DIVIDE COUNT
	JMP	DIVB	/AND GO DO IT

DIVA,	RAL		/SHIFT DIVIDEND
	NOP		/FOR TIMING
	TAD	DIVM	/MINUS DIVISOR
	DCA	HOTIM
	SNL		/DID WE OVER-SUBTRACT?
	JMP	DIVD	/YES, WE'LL START ADDING DIVISOR
	NOP		/FOR TIMING
DIVB,	TAD	LOTIM	/SHIFT DIVIDEND
	CML RAL
	DCA	LOTIM
	TAD	HOTIM
	ISZ	WSA	/ARE WE THROUGH?
	JMP	DIVA	/NO, CONTINUE SUBTRACTING
	DCA	HOTIM	/SAVE REMAINDER
	AND		/FOR TIMING
	TAD	LOTIM	/GET QUOTIENT
	JMP I	DIV	/AND RETURN

DIVC,	RAL		/SHIFT DIVIDEND
	CML		/MAKE IT WORK
	TAD	DIVP	/POSITIVE DIVISOR
	DCA	HOTIM
	SZL		/HAVE WE ADDED ENOUGH?
	JMP	DIVB	/YES, GO SUBTRACT FOR A WHILE
	NOP		/FOR TIMING
DIVD,	TAD	LOTIM	/SHIFT DIVIDEND
	CML RAL
	DCA	LOTIM
	TAD	HOTIM
	ISZ	WSA	/ARE WE THROUGH?
	JMP	DIVC	/NO, GO ADD SOME MORE
	TAD	DIVP	/YES, CORRECT REMAINDER
	DCA	HOTIM	/AND SAVE IT
	TAD	LOTIM	/GET QUOTIENT
	JMP I	DIV	/AND RETURN

DOTRAN,	JMS	DOIT	/DO TRANSPOSE
	T1+200	/128
	TAD	CHAR
	AND	(70
	TAD	(BFR1
	DCA	TRAN
	JMP	NEXT

DOJMS,
DOJMP,	HLT

GET,	0
	CDF 10
	TAD I	GETPTR
	CDF
	ISZ	FLG
	JMP	GETL
	ISZ	GETPTR
	AND	(77
	DCA	CHAR
	NOP
	NOP
	JMP	GET2

GETL,	BSW
	AND	(77
	DCA	CHAR
	STA
	DCA	FLG
GET2,	TAD	CHAR
	JMP I	GET
PAGE
PLAYIT,	JMS	DOIT
	T1+2150	/1128
	TAD	RTOT
	MQL
	TAD	AT
	CIA CLL
	TAD	BT
	SZL
	CLA SKP
	CIA
	TAD	BT
	CIA CLL
	TAD	CT
	SZL
	CLA SKP
	CIA
	TAD	CT
	CIA CLL
	TAD	DT
	SZL
	CLA SKP
	CIA
	TAD	DT
	CIA CLL
	DCA	SAVE

	TAD	AT
	TAD	SAVE
	SNA
	JMP	DELA
	DCA	AT
	MQA
	TAD	AR
	MQL

RA,	TAD	BT
	TAD	SAVE
	SNA
	JMP	DELB
	DCA	BT
	MQA
	TAD	BR
	MQL

RB,	TAD	CT
	TAD	SAVE
	SNA
	JMP	DELC
	DCA	CT
	MQA
	TAD	CR
	MQL

RC,	TAD	DT
	TAD	SAVE
	SNA
	JMP	DELD
	DCA	DT
	MQA
	TAD	DR
	MQL

RD,	MQA
	DCA	SAVS
	TAD	SAVE
	CLL
	TAD	LOTIM
	DCA	LOTIM
	SNL
	AND
	SZL
	ISZ	HOTIM
	SKP
	JMP	NEXT
	NOP
PLAY2,	JMS	DOIT
	T1+330	/216
	TAD	OLDE
	TAD	(-TIM6
	TAD	SAVS
	SPA
	STL
	SMA
	CLL
	TAD	SAVE
	SZL
	JMP	TRYAGN
	CIA
	TAD	[7700
	DCA	WSA
	JMS	DOIT
	T1+1242	/674
	TAD	WSA
	BSW
	MQL
	MQA
	AND	(7700
	DCA	WSA
	JMP	SAVIT

TRYAGN,	TAD	(+TIM6
	DCA	OLDE
	JMS	DOIT
	T1+414	/268
	TAD	AXB
	DCA	WSA
	TAD	SAVS
	CDF	20
	TAD I	WSA
	DCA I	WSA
	TAD	SAVS
	CDF
	TAD	OLDS
	DCA	OLDS
	JMP	PLAYIT


DELA,	TAD	AC
	DCA	AT
	JMP	RA
DELB,	TAD	BC
	DCA	BT
	JMP	RB
DELC,	TAD	CC
	DCA	CT
	JMP	RC
DELD,	TAD	DC
	DCA	DT
	JMP	RD

PAGE
SAVIT,	TAD	OLDS
	TAD	SAVS
	TAD	FUDGE
	CLL RAL
	TAD	WSA
	CDF	20
	DCA I	AXB
	TAD	[7700
	MQA
	SZL
	NOP
	SNL
	IAC
	DCA I	AXB
	STA
	TAD	SAVS
	DCA I	AXB
	CDF
	DCA	OLDS
	DCA	OLDE
WAIT1,	CLL STA RTL
	TAD	BUFGET
	CIA
	TAD	AXB
	SZA CLA
	JMP I	[PLAYIT
	MQL
	NOP
	JMS	DOIT
	T1+310	/200
	KRB		/ANYTHING TYPED?
	AND	C1	/FORGET PARITY
	TAD	C2	/^C?
	SZA CLA
	JMP	WAIT1	/NO ^C
	JMP I	.+1	/START OVER
	200
C1,	177
C2,	-3

FUDGE,	-2	/HALF OF 4
BFR1,
DECIMAL
-4018;-3792;-3579;-3378;-3189;-3010
/A--
-2841;-2681;-2531;-2389;-2255;-2128;-2009;-1896;-1790;-1689;-1594;-1505
/A-
-1420;-1341;-1265;-1194;-1127;-1064;-1004;-948;-895;-845;-797;-752
/A
-710;-670;-633;-597;-564;-532;-502;-474;-447;-422;-399;-376
/A+
-355;-335;-316;-299;-282;-266;-251;-237;-224;-211;-199;-188
/A++
-178;-168;-158;-149;-141;-133;-126;-119;-112;-106;-100;-94
/A+++
-89;-84;-79;-75;-70;-67;-63;-59;-56;-53;-50;-47
-44	/A++++!!
/NUMBER OF PULSES GENERATED DETERMINE LOUDNESS
BFR2,
64;60;56;52;48;45;42;39
37;34;32;30;28;26;24;23
21;20;18;17;16;15;14;13
12;11;10;9;9;8;8;7
7;6;6;6;5;5;5;4
4;4;3;3;3;3;3;2
2;2;2;2;2;2;2;1
1;1;1;1;1;1;1;1
OCTAL
JMPTAB,	REST
	RESTM
	SETN
	SETNM
	ERR0
	ERR0
	ERR0
	ERR0

JMPTB2,	DOEND
	NEXHOL
	DOMETER
	DOTRANSPOSE
	DOJMS
	DOJMP
	ERR0;DOTRANSPOSE;
	ERR0;ERR0;ERR0;DOTRANSPOSE
	ERR0;ERR0;ERR0;DOTRANSPOSE
	ERR0;ERR0;ERR0;ERR0;ERR0;ERR0;ERR0;ERR0
	ERR0;ERR0;ERR0;ERR0;ERR0;ERR0;ERR0;ERR0
$