TITLE H10D  710923 2320
RELOCATABLE

A=1
B=2
C=3
C1=4
D=5
E=6
F=7
P=10

DEFINE GCMD AC
	DATAI AC
TERMINATE

DEFINE PART N
P!N:	ADDI N,
III==1_<6-N>
	TLNE N,1
	TROA III
	TRZ III
TERMINATE

DEFINE SET N
	ILDB 15,16
PP!N:	MOVE 15,BOT+400(15)
	HRRM 15,P!N
TERMINATE

DEFINE ADJUST N
	HRRZ 16,P!N
	IMULI 16,3
	ADD N,16
TERMINATE


OFST=100-$.

LODBEG":

OFFSET 100-.

	JRST WAIT
	JRST RDI

WAIT":	JSR INIT
	AOS CMD		;GENERATE <JFCL 1> IN CMD
WAIT2:	XCT CMDQ	;MAYBE A QUIT PENDING
	XCT CMD		;MAYBE GET COMMAND FROM OTHER PROCESSOR
	GCMD B		;IF NOT THEN GET COMMAND FROM DATA SWITCHES
	JUMPL B,WAIT2
	TLNE B,200000
	JRST PLAY
	TLNE B,2000
	JRST WAIT2
	TLNE B,100000
	JRST TUNE
	TLNE B,10000
	JRST RDI1
	JRST WAIT2

INIT:	0		;SET UP PDL ETC.
	MOVEI P,PDL
	MOVE B,[LUPQ]	;INITIALIZE COMMAND AREA
	MOVEM B,CMDQ2
	MOVSI B,(JFCL)
	MOVEM B,CMD
	MOVEM B,CMDQ
	JRST @INIT

	;STANDARD ROUTINES CALLED FROM OTHER PROCESSOR:
		;PLAYNT" - PLAY WITH DEFAULT TEMPO
		;PLAYST" - PLAY WITH SPECIFIED TEMPO
		;ADJST" - ADJUST TO SPEED OF MACHINE (RESTART)
		;TUNE" - DETUNE SLIGHTLY ACCORDING TO ARG
		;PLAYSL" - PLAY FROM SELECTED LOCATION (MUST BE EVEN)

	;COMMAND AREA

QUITC"==.-OFST
QUITB":		;BEGINNING OF QUIT AREA
CMDQ2:	JRST SAVPC	;EXECUTED FROM J-1, MUNGED TO LUPQ (AOJL 15,Q)
CMDQ":	JRST WAIT	;OR JFCL
QUITE":		;END OF QUIT AREA

H10CMD":		;COMMAND-TYPE COMMAND AREA
ARG:	0	;MAYBE ARGUMENT
CMD:	JFCL	;ACTUAL COMMAND (CLOBBERED TO JFCL BY INIT, AOS'ED BY WAIT)

PLAYNT":	SKIPA C,TMPO	;PLAY WITH DEFAULT TEMPO
PLAYST":	HRRZ C,ARG	;COMMAND FROM OTHER PROCESSOR TO PLAY WITH SPECIFIED TEMPO
	MOVEI 17,0	;START PLAYING AT BEGINNING
	JRST PLAY2	;FEED ARG TO REGULAR ROUTINE

PLAY:	MOVE C,B	;DATA SWITCH COMMAND TO PLAY,
	MOVEI 17,0	;START AT THE BEGINNING
	TDZA C,[-2,,400000]
PLAYSL":	SKIPA 17,ARG	;COMMAND FROM OTHER PROCESSOR TO START PLAYING AT SPECIFIED PLACE
	TLZN C,1	;FIGURE OUT WHETHER TO SET TEMPO
	HRRZ C,TMPO	;NO TEMPO SPECIFIED, GET DEFAULT TEMPO
PLAY2:	CAIGE C,100
	JRST WAIT
	HRRZM C,TMPO	;SAVE AS DEFAULT TEMPO
	IMUL C,TEMPC
	IDIV C,TEMPK
	HRRM C,TEMPO
	JRST J

TEMPO:	IDIVI 15,1000	;ADDRESS MODIFIED EACH TIME IT STARTS TO PLAY
	GCMD 16
	JUMPL 16,WAIT
	ADDI 17,2
	ADJUST 1
	ADJUST 2
	ADJUST 3
	ADJUST 4
	ADJUST 5
	ADJUST 6

Q:	PART 1
	PART 2
	PART 3
	PART 4
	PART 5
	PART 6
	XCT CMDQ2	;AOJL 15,Q OR JRST SAVPC
LUPQ=AOJL 15,Q

J:	MOVE 16,[617,,MUST]
	SET 1
	SET 2
	SET 3
	SET 4
	SET 5
	SET 6
	MOVE 15,MUST(17)	;NEGATIVE DURATION
	JUMPN 15,TEMPO
	JRST WAIT

SAVPC:	HRRZM 17,ARG	;QUIT ROUTINE (QUIT ORDERED BY OTHER PROCESSOR)
	XCT CMDQ	;JFCL OR JRST WAIT
	JRST .-1	;WAIT FOR .IOT TO FINISH

TEMPC":	0		;62213
TEMPK:	122700

TMPO":	1514		;TEMPO BEFORE COMPENSATION FOR MACHINE SPEED

TUNE":	HRL 0,B
	HRRZM B,DETUN
	MOVE C,[220300,,B]
	MOVNI D,21
TUNE1:	ILDB A,C
	IMULI A,100
	ADDI A,BOT
	HRRM A,J+23(D)
	ADDI D,3
	JUMPL D,TUNE1
TUNE2:	GCMD D
	TLNE D,100000
	JRST TUNE2
	JRST WAIT

RELOAD:	HRLZ 0,DETUN
	JRST RDI+1

RDI":	HRLZI 0,444444
	JSR INIT	;INITIALIZE PDL AND COMMAND AREA
	PUSHJ P,CRLF

ADJST":
RDI1:	SETZM TAB
	SETZM TAB+1
	CONO 635550
	CONO PI,11577
	MOVE A,[JSR BK0]
	MOVEM A,42
	MOVEI D,24
	HLLZS Q(D)
	SUBI D,4
	JUMPGE D,.-2
	HRLZI 15,400000	;0 BUT WITH SIGN BIT SET SO AS TO CAUSE AOJL TO JUMP
	MOVNI 14,60.
	CONO PI,12300	;TURN ON PI
	SETZM BK0	;CLEAR OUT JSR PC
	CONO 3001	;ENABLE CLOCK, CLEAR FLAG, SET PIA TO 1
	SKIPN BK0	;WAIT FOR FIRST INTERRUPT
	JRST .-1
	JRST Q		;SEE HOW FAR 15 INCREMENTS DURING 1 SECOND

CRLF:	MOVEI C,15
	PUSHJ P,TYO
	MOVEI C,12
TYO:	DATAO TTY,C
	CONSZ TTY,20
	JRST .-1
	POPJ P,


BK0:	0
	CONO 1001	;TURN OFF CLOCK FLAG
	AOJGE 14,BK1	;JUMP ON SIXTIETH BREAK
	JRST 12,@BK0

BK1:	CONO PI,11577	;DONE WITH PI, TURN IT OFF
	HRRZ A,BK0	;GET PC INTERRUPTED FROM
	SUBI A,Q	;CONVERT TO # INSTRUCTIONS EXECUTED
	TLZ 15,400000	;CONVERT TO # TIMES LOOP EXECUTED
	IMULI 15,J-Q	;CONVERT TO # INSTRUCTIONS EXECUTED DURING CLOSED LOOPS
	ADD A,15	;GET TOTAL # INSTRUCTIONS EXECUTED
	MOVE C,T1
	MOVE C1,T2
	DIV C,A
	MOVEM C,TEMPC
	MOVE B,C
	MOVEI A,TABX

BK1A:	HRRM A,BK1B
	MOVEI D,13
BK1B:	MOVEM C,(D)	;ADDRESS MODIFIED AT BK1A
	MUL C,MAGIC	;*DIVIDE* BY THE TWELFTH ROOT OF 2
	SOJGE D,.-2
	ASH B,-1
	MOVE C,B
	SUBI A,14
	CAIL A,TAB
	JRST BK1A	;GO PROCESS NEXT OCTAVE
	MOVEM C,13(A)
	MOVEI A,TAB-BOT-2
	MOVE C,BOT+100(A)
	MUL C,DTC
	MOVEM C,BOT(A)
	SOJGE A,.-3
BK1C:	GCMD D
	TLNE D,10000
	JRST BK1C
	JRST WAIT

DTC:	377400000000
DETUN:	444444
T1:	0
T2:	147320000000
MAGIC:	361503374705	;2^(-1/12)
CONSTANTS
LODEND"=.-OFST	;END OF AREA TO BE PUT INTO PDP10 CORE
BOT:	BLOCK 700
TAB:	BLOCK 77
TABT:	BLOCK 1
TABX=TABT-14

PDL:	BLOCK 20
MUST":		;BEGINNING OF DATA AREA

END	;END RDI"