TITLE MCOMP - P R SAMSON MUSIC COMPILER - DEC V3 - 19 NOV 69
SUBTTL  MODIFIED FOR TIMESHARING BY R CLEMENTS, DEC. /RCC
VMCOMP=3		;VERSION NUMBER

;MUSIC COMPILER WRITTEN BY PETER R SAMSON, MIT PROJECT MAC.
;THIS COMPILER IS COMPATIBLE IN SOURCE AND OUTPUT WITH THE
;PREVIOUS COMPILER, FOR THE PDP-1 COMPUTER.

;MODIFIED BY ROBERT CLEMENTS, DEC, AS FOLLOWS:
;1) CONVERTED FROM MIDAS TO MACRO SOURCE LANGUAGE
;2) MODIFIED FOR DEC TIME-SHARING I/O
;3) CODE HAS BEEN LARGELY COMMENTED
;4) CORE MANAGEMENT HAS BEEN ADDED

	SUBTTL PHASE 1 OF THE COMPILER

;AC'S

; 0 IS OCCASIONALLY USED AS VERY TEMP
A=1
B=2
C=3
D=4
E=5	;INPUT BUFFER POINTER
F=6	;TEMP
G=7
H=10	;CARRIES MESSAGE OF WHERE NOTE IS.
	;0=REST, 1=COMMA, 2=NUMBER
I=11	;CARRIES DURATION IN 64THS FROM S1 TO S2
M=12	;HOLDS COUNT OF NUMBERS INPUT TO NOTE
N=13	;HOLDS NUMBER BEING CREATED
CS=14	;CHECKSUM
Z=15	;MOSTLY I/O
ZZ=16	;DITTO
P=17	;PUSHDOWN

INCHN==1
OUTCHN==2

IFNDEF JIFSEC,<JIFSEC=^D60>	;GOOD OLD EUROPE AND AUSTRALIA

EXTERN JOBFF,JOBREL
INTERN MCOMP,MCEND

DVDIR=4
DVDTA=100
DVPTP=400

LOC 137
EXP VMCOMP
RELOC
PREP:	0			;CALLED HERE FROM PHASE TWO. 
				;ONE PART WILL NOW BE COMPILED
	SETZB 0,LMB
	MOVE P,[IOWD PDLL,PDL]
	SETOM BC
	SETOM NL	;NOTE TABLE LENGTH
	MOVNI A,2
	MOVEM A,MJP	;INITIALIZE ERROR COUNT
	PUSHJ P,RCH9	;FILL BUFFER WITH FIRST LINE
	MOVE E,[XWD 700,INBUFF-1]	;BEGINNING OF BUFFER
	SETOM TC
	PUSHJ P,ERF	;PRINT TITLE
	SETZM X1U	;UNITS
	SETZM X3U	;3 * UNITS
	SETOB I,IRL
	SETZM TLL	;UP/DOWN TRANSLATE LENGTH
	MOVEI A,1
	MOVEM A,SID
	SETZM ROB	;GRACE NOTE ROBBED TIME
	SETZM GI	;GRACE INDICATOR
	SETZM GIS	;"
	SETZM AO
	SETZM TC
	SETZM MM
	SETZM SS	;STANDARD STACCATONESS (EIGHTHS)
	MOVEM A,TBC	;BAR COUNT :=1
	MOVEI B,26
	MOVEM B,ST	;STANDARD CLEF (TREBLE)

PUM:	PUSHJ P,PUN	;HERE ON KEY ) (NO SH OR FL)
	JRST S1		;GO START PROCESSING
;PRINT OFFENDING MEASURE

ERF:	SETZM BLC	;ERROR, FIRST (TITLE)
	TLZ F,1		;NOT RED
	MOVEI A,1
	MOVEM A,ETC	;ERROR TYPE COUNT := 1

ERR:	ILDB A,E
	JUMPE A,ET1
	CAIE A,175	;ALTMODE
	CAIN A,"/"	;END OF MEASURE
	JRST EC0
	MOVE Z,A
	PUSHJ P,TYO
	JRST ETR

ET1:	AOS A,ETC
	SUB A,TC
	JUMPE A,ET2
	CAIE A,1
	JRST ET4
	MOVEI Z,">"
	PUSHJ P,TYO
	TLZ F,1
	JRST ET4

ET2:	MOVEI Z,"<"	;OFFENDING ITEM
	PUSHJ P,TYO	;TYPE "<"
	TLO F,1		;MARK "COLOR SHIFT"
ET4:	MOVE A,BLC
	CAIGE A,100
	JRST ETS
	PUSHJ P,CRLF
	SETZM BLC
	JRST ERR

ETS:	MOVEI Z,40	;SPACE
	PUSHJ P,TYO
ETR:	AOS BLC
	JRST ERR

EC0:	MOVEI Z,">"
	TLZE F,1
	PUSHJ P,TYO
	MOVEI Z,"/"
	PUSHJ P,TYO
	JRST CRLF
	POPJ P,0
S1Y:	PUSHJ P,ER1
	ASCIZ /TMF
/
	JRST TE
S1X:	PUSHJ P,ER1
	ASCIZ /TFF
/
	JRST TE
S1W:	PUSHJ P,ER1
	ASCIZ /UNC
/
	JRST TE
S1V:	PUSHJ P,ER1
	ASCIZ /ERT
/
	JRST TE
UNCH:	PUSHJ P,ER
	ASCIZ /UCH
/
	JRST S20
S3X:	PUSHJ P,CRLF
	PUSHJ P,WRITE
	ASCIZ /
NOT ENOUGH CORE FOR TABLES. SUBDIVIDE SOURCE PROGRAM./
	CALLI 12

RRZ:	PUSHJ P,WRITE
	ASCIZ /
MEASURE HAS TOO MANY CHARACTERS. REARRANGE TAPE.
/
	CALLI 12

PUN:	MOVE A,[XWD NT,KT]	;INITIALIZE OFFSET TO 0
	BLT A,KT+43
PUE:	MOVE A,[XWD KT,MT]
	BLT A,MT+43
	POPJ P,0

NOSUCH:	PUSHJ P,ER1	;NO SUCH PSEUDO OP
	ASCIZ /NPS
/
	JRST PSR
RCH1:	PUSHJ P,RDCH	;SKIP COMMENTS
	CAIE A,"]"	;DONE?
	JRST RCH1	;NO. LOOP
RCH0:	PUSHJ P,RDCH	;RPA
	CAIN A,"["	;COMMENT?
	JRST RCH1	;YES. SKIP IT
	CAIN A,15	;CR?
	JRST RCH0	;YES. IGNORE IT
	CAMN E,[XWD 10700,INBUFE]	;FILLED UP INPUT BUFFER?
	JRST RRZ	;YES. GO BITCH.
	CAIL A,11
	CAIL A,15	;BREAK CHAR?
	CAIN A,40	;OR SPACE?
	MOVEI A,0	;GO TO NULL
	IDPB A,E	;STORE IN INPUT BUFFER
	CAME A,RCHP(D)	;LOOK FOR "END "
	MOVSI D,-4	;NO.
	CAMN A,RCHP(D)	;AGAIN.
	AOBJP D,RCH2	;JUMPS ON THE SPACE OR CR
	CAIE A,"/"	;END OF BAR?
	JRST RCH0	;NO. CONTINUE READING
RCH2:	MOVEI A,175	;MAKE MEASURE END WITH ALTMODE
	IDPB A,E	;INTO BUFFER
	MOVE E,[XWD 700,INBUFF-1]	;READY TO PARSE BAR
	MOVEM E,FL1	;COPY E TO FL1
	MOVEM E,FL2	;AND FL2

RCH:	ILDB A,E	;GET BUFFERED CHARACTER
	SKIPN A	;END OF NOTE?
	MOVEM E,FL1	;YES. SAVE THIS POINTER
	JUMPE A,.+2	;AND SKIP
	MOVE D,FL1	;NO. UPDATE FL2
	MOVEM D,FL2
	CAIE A,175	;END OF BAR?
	POPJ P,0	;NO. RETURN
RCH9:	MOVE E,[XWD 700,INBUFF-1]	;INITIALIZE E TO INPUT BUFFER
	MOVSI D,-4	;FOR END TEST
	JRST RCH0

RCHP:	"E"	;THIS BLOCK TESTS FOR END PSEUDO-OP
	"N"
	"D"
	0	;BREAK CHAR AFTER "END"
ER:	TDZA F,F
ER1:	MOVNI F,1
	MOVEM E,ERCE
	MOVN A,MJP
	CAIGE A,2
	JRST ERQ
	PUSHJ P,WRITE	;SPEAK SAGELY ON FIRST ERROR
	ASCIZ /
[ TO ERR IS HUMAN---TO FORGIVE, DIVINE.]
/

ERQ:	MOVE A,TJP
	CAME A,TC
	JRST ERK
	MOVE A,MJP
	CAMN A,BC
	JRST EC3

ERK:	MOVE E,[XWD 700,INBUFF-1]
	PUSHJ P,ERF

EC3:	MOVE A,BC
	MOVEM A,MJP
	MOVE A,TC
	MOVEM A,TJP
	MOVE E,ERCE

WRITE:	POP P,ZZ		;GET CALLER ADDRESS
	HRLI ZZ,440700	;MAKE IT A BYTE POINTER
WRITE1:	ILDB Z,ZZ	;GET A CHAR
	JUMPE Z,1(ZZ)	;RETURN AFTER NULL
	PUSHJ P,TYO	;TYPE THE CHAR
	JRST WRITE1	;BACK FOR MORE
RDCH:	SOSLE RIB+2
	JRST RDCHOK
	INPUT INCHN,0
	STATZ INCHN,740000
	JRST RDERR
	STATZ INCHN,20000
	JRST EOFRET
RDCHOK:	ILDB A,RIB+1
	JUMPE A,RDCH	;SKIP LEADER
	CAIL A,177	;AND RUBOUTS
	JRST RDCH
	CAIL A,175
	MOVEI A,12
	CAIL A,140
	TRZ A,40
	CAIE A,32		;DEC EOF?
	CAIN A,3		;MAC EOF?
	JRST EOFRET		;RETURN.
	POPJ P,0

GETCHA:	0
	MOVS 0,[XWD 1,SAVAC]	;RESTORE ACS 1 TO 17
	BLT 0,17	;"
	MOVE 0,GETCHA	;MOVE RETURN ADDRESS
	MOVEM 0,PREP	;TO PREP
	MOVEM A,GOTCHA	;SAVE A (WHICH WAS TO BE PUNCHED ON
			; PREVIOUS CALL TO PBW) IN GOTCHA
			; IT WILL BE RETURNED TO PHASE 2 ON NEXT PBW
	POPJ P,0	;RETURN TO CALLER OF PBW VIA SAVED PDL

EOFRET:	SETOM EOFFLG
PBW:	MOVE 0,[XWD 1,SAVAC]	;SAVE ACS
	BLT 0,SAVAC+16	;1-17
	MOVE 0,GOTCHA
	JRST @PREP

CRLF:	MOVEI Z,15
	PUSHJ P,TYO
	MOVEI Z,12
TYO:	TTCALL 1,Z
	POPJ P,0

RDERR:	PUSHJ P,WRITE
	ASCIZ /READ ERROR
/
	CALLI 12		;SHOULD BE CLEANED UP
;R H OF F

LDL=1000	;NUMBER INPUT
GCOUNT=2000	;GRACE COUNT
RCOUNT=4000	;REST
COMCNT=10000	;COMMA

S1:	SETZB M,NDIG	;# OF DIGITS:=0,# OF #'S :=0
	SETZB F,CHINC	;FLAGS:=0,CHARACTER INDICATOR :=0
	MOVEI A,40
	MOVEM A,FC	;FC :=32.
	MOVEI A,100
	MOVEM A,FU	;FU:=64.

S10A:	MOVEI N,0	;INITIALIZE INPUT NUMBER
S10:	PUSHJ P,RCH	;READ CHAR FROM BUFFER
	CAIL A,60
	CAILE A,71	;A DIGIT?
	JRST S11	;NO
	AOS NDIG	;YES. COUNT DIGITS
	TRO F,LDL	;MARK DIGIT SEEN
	IMULI N,12	;DECIMAL NUMBER
	ADDI N,-60(A)
	JRST S10	;READ NEXT CHAR

S11:	TRZN F,LDL	;NO MORE NUMBER. WAS THERE ONE?
	JRST S15	;NO
	JUMPN M,.+2	;YES. HOW MANY?
	MOVEM N,NUM+1	;MORE THAN 1. SAVE IN #2
	CAIG M,1	;MORE THAN 2?
	MOVEM N,NUM(M)	;NO. OK TO SAVE
	ADDI M,1	;CAOUNT NUMBERS

S15:	JUMPE A,S18	;END OF NOTE?
	CAIN A,"/"	;OR END OF BAR?
	JRST S18	;YES.
	AOS CHINC	;CHARACTER COUNT
	AOS NDIG
	CAIN A,"."	;DOTTED NOTE?
	JRST S19	;YES
	CAIN A,"X"	;HALF DOT?
	JRST S1A
	CAIN A,"R"	;REST?
	TRO F,RCOUNT	;YES. MARK
	CAIN A,"G"	;GRACE NOTE?
	TRO F,GCOUNT	;YES
	CAIN A,","	;COMMA?
	TRO F,COMCNT	;YES. MARK
	JRST S10A	;BACK INTO LOOP.
			;IGNORING OTHER CHARACTERS.
S19:	MOVE A,FC
	;HERE ON A DOT
	MOVEM A,FU	;FU:=FC
S1A:	MOVE A,FC	;HERE ON X
	ASH A,-1	;FC:=FC/2
	MOVEM A,FC
	JRST S10A	;RETURN FOR MORE CH'S

S18:	AOS TC		;TERM COUNT
	MOVEM A,TRM	;TERMINATING CHARACTER
	SKIPN NDIG
	JRST TE
	JUMPN M,.+3	;ANY NUMBERS?
	TRNN F,COMCNT	;NO. ANY COMMAE?
	JRST PC	;NO
	SKIPE CHINC
	JRST S1E
	SKIPE AO
	POPJ P,
	MOVE A,TBC
	CAMN A,NUM
	JRST TE
	PUSHJ P,ER	;A SOLO NUMBER, .NE. BAR #
	ASCIZ /BBL
/
	JRST TE

S1E:	SKIPN AO
	JRST S1H
	SETZM AO
	PUSHJ P,ER
	ASCIZ /AGM
/
S1H:	MOVEM M,B
	TRNE F,COMCNT
	ADDI M,1	;ADD A # FOR THE COMMA
	TRNE F,RCOUNT
	ADDI M,1	;ADD A # FOR A REST
	CAILE M,2	;SHOULD HAVE 2 OR LESS
	JRST S1Y	;TOO MANY FIELDS
	TRNE F,COMCNT
	JRST S1S
	TRNE F,GCOUNT	;NO COMMA. GRACE?
	ADDI M,1	;YES. FREE #
	SUBI M,2	;SHOULD NOW BE 3 OR 2
	JUMPL M,S1X	;TOO FEW FIELDS
	JUMPN M,S1T	;3 IF JUMPS
	TRNN F,GCOUNT	;2. GRACE?
;SEE ABOVE, WHICH SKIPS
S1T:	TDZA G,G	;NUM+1 IS TIME
	MOVEI G,1	;G TIME
SLI:	TRNE F,RCOUNT
	JRST S1K	;REST
	MOVEI H,0
	JUMPN B,S1L	;NUMBER SEEN? (OLD VALUE OF M)
	MOVEI H,2	;NO
	JRST S1L

S1S:	MOVEI G,2	;COMMA TIME
	JRST SLI

S1K:	MOVEI H,1	;REST
	MOVE A,NL
	MOVE B,@PNOT
	SKIPN SID
	CAIL B,600000
	JRST S1L
	ANDI B,117777
	ADDI B,400000
	MOVEM B,@PNOT

S1L:	JUMPE G,S1N
	CAIL G,2
	JRST S1M	;COMMA TIME
	MOVEI I,2
	JRST S1O

S1M:	JUMPL I,S1W
	JRST S1O
S1N:	MOVEI I,100	;CONVERT NUM+1 FOR DURATION.
			;I IS NUMBER OF 64THS
	MOVEI B,1	;SETUP FOR POWER OF 2 CHECK
	MOVE C,NUM+1	;GET NUMBER TO TEST
	JUMPE C,S1V	;ZERO DURATION SPECIFIED. ERROR.
	CAIL C,100
	JRST S1V	;DURATION .GE. 64. ERROR.

S1Q:	ASH C,-1
	JUMPE C,S1P
	ASH I,-1
	ASH B,1
	MOVE A,FU
	ASH A,-1
	MOVEM A,FU
	JRST S1Q
S1P:	CAME B,NUM+1	;B WAS SHIFTED LEFT AS C WAS RIGHT
	JRST S1V	;DURATION NOT A POWER OF 2
	SKIPE FU	;DOT TIME SHIFTED OFF END?
	JRST S1O	;NO. OK
	PUSHJ P,ER
	ASCIZ /DTU
/
S1O:	MOVE A,I	;LENGTH IN 64THS
	ASH A,-1
	MOVEM A,FC
	JRST S2
S2:	SETZM FU
	SETZM SR
	SETZM X3I	;TRIPLET INDICATOR
	SETZM SI
	SETZM ACI	;ACCIDENTAL INDICATOR
	SETZM ACC	;ACCIDENTAL OFFSET
	SETZM ET
	SETZM ETE
	MOVE E,FL2	;RESCAN NOTE
	MOVEM E,FL1

S20:	PUSHJ P,RCH	;RCH USES E, SO RESCAN
	CAIL A,140
	JRST UNCH	;FLUSH LOWER CASE
	MOVE B,ACI	;ACCIDENTAL INDICATOR
	MOVE C,A
	MOVEI A,0	;CLEAR A FOR COMPUTATION
	JRST @S21T(C)	;DISPATCH TO APPROPRIATE HANDLER

S21T:	S2R	;BREAK CHAR
	UNCH	;^A
	UNCH	;^B
	UNCH	;^C
	S2R	;^D
	UNCH	;^E
	UNCH	;^F
	UNCH	;^G
	UNCH	;^H
	S2R	;TAB
	S2R	;LF
	S2R	;VT
	S2R	;FF
	S2R	;CR
	UNCH	;^N
	UNCH	;^O
	UNCH	;^P
	UNCH	;^Q
	UNCH	;^R
	UNCH	;^S
	UNCH	;^T
	UNCH	;^U
	UNCH	;^V
	UNCH	;^W
	UNCH	;^X
	UNCH	;^Y
	UNCH	;^Z
	UNCH	;^[
	UNCH	;^BACKSL
	UNCH	;^]
	UNCH	;^^
	UNCH	;^_
	S2R	;SPACE
	UNCH	;!
	UNCH	;"
	UNCH	;#
	UNCH	;$
	UNCH	;%
	UNCH	;&
	UNCH	;'
	S2H	;(
	S2J	;)
	UNCH	;*
	S2H	;+
	S20	;,
	S2I	;-
	S2P	;.
	S2R	;/
	S20	;0
	S20	;1
	S20	;2
	S20	;3
	S20	;4
	S20	;5
	S20	;6
	S20	;7
	S20	;8
	S20	;9
	UNCH	;:
	UNCH	;;
	UNCH	;<
	S2J	;=
	UNCH	;>
	UNCH	;?

	UNCH	;@
	S2E	;A
	S2F	;B
	S2G	;C
	S2K	;D
	S2D	;E
	UNCH	;F
	S20	;G
	X2SS	;H
	UNCH	;I
	UNCH	;J
	UNCH	;K
	S2C	;L
	S2L	;M
	S2M	;N
	UNCH	;O
	S38	;P
	X2SR	;Q
	S20	;R
	S2B	;S
	S20	;T
	S2N	;U
	UNCH	;V
	S2O	;W
	S2Q	;X
	UNCH	;Y
	UNCH	;Z
	UNCH	;[
	UNCH	;BACKSL
	S20	;]
	UNCH	;^
	UNCH	;_

S2B:	SUBI A,200000	;S STACCATO 200000
S2C:	ADDI A,360000	;L LEGATO   400000
X2SR:	SUBI A,20000	;Q QUARTER   20000
X2SS:	ADDI A,40000	;H HALF      40000
S2D:	MOVEM A,SV	;E END           0
	AOS SI
	JRST S20

S2E:	ADDI A,30	;A ABOVE
S2F:	SUBI A,14	;B BELOW
	ADDM A,SR
	JRST S20
S2G:	MOVEI A,100000	;C TRIPLET
	MOVEM A,X3I	;TRIPLET INDICATOR
	JRST S20

S2H:	MOVEI A,2	;(
S2I:	SUBI A,1	;-
	JUMPL B,S24
	ADDM A,ACC	;ACCIDENTAL
	MOVMM A,ACI	;INDICATOR
	JRST S20

S24:	PUSHJ P,ER
	ASCIZ /NOR
/	;NATURAL AFTER SHARP OR FLAT
	JRST S20

S2J:	JUMPG B,S26	;)
	SETOM ACI
	JRST S20

S26:	SETOM ACI
	JRST S24

S38:	ADDI A,1	;P
S2O:	ADDI A,1	;W
S2N:	ADDI A,1	;U
S2M:	ADDI A,1	;N
S2L:	ADDI A,1	;M
S2K:	ADDI A,1	;D
	MOVEM A,ET	;EMBELLISHMENT TEMP
	SKIPN ETE	;PREVIOUS ONE?
	JRST S29
	PUSHJ P,ER	;YES. COMPLAIN
	ASCIZ /TME
/
	MOVE A,ET
S29:	MOVEM A,ETE	;STORE THIS EMBELLISHMENT
	JRST S20
S2P:	MOVE A,FC	;. GET DURATION OF .
	ADDM A,FU	;ADD IT INTO INCREMENTAL DURATION
S2Q:	MOVE A,FC	;X
	ASH A,-1	;HALVE VALUE OF NEXT .
	MOVEM A,FC
	JRST S20
;SECOND SCAN COMPLETE

S2R:	MOVE A,SI	;ARTICULATION CHARS?
	JUMPE A,S51	;IF 0 USE STANDARD (SS)
	CAIG A,1	;SHOULD BE JUST 1
	JRST S52	;OK. SV WAS SET BY CHAR.
	PUSHJ P,ER	;TOO MANY ARTICULATIONS
	ASCIZ /TMS
/
S51:	MOVE A,SS	;SET NORMAL ARTICULATION
	MOVEM A,SV	;FOR THIS NOTE

S52:	TRNE F,COMCNT
	JRST S69	;COMMA
	MOVE A,X3I	;TRIPLET IN THIS NOTE?
	MOVEM A,CCC	;SET TRIPLET INDIC.
X2S3:	MOVE A,I	;DURATION IN 64THS
	ADD A,FU	;ANY DOTS?
	MOVEM A,NFT	;TIME PART
	MOVEM A,NFP
	TRNE F,GCOUNT	;ANY GRACE NOTE MARK?
	JRST X2S1	;GRACE
	SETZM GI	;NO.
	MOVE A,ROB	;ANY LEFT-OVER STOLEN TIME?
	JUMPE A,S2S
	MOVNS A		;YES. NEGATE
	ADDB A,NFT	;AND ADD INTO TIME
	CAIGE A,2	;ANY TIME LEFT?
	JRST X2S2	;NOT MUCH
X22S:	SETZM ROB
	JRST S2S	;RESTORE ROB TO 0 AND PROCEED

X2S2:	SUB A,ROB	;IS NOTE AT LEAST AS BIG AS ROB?
	JUMPGE A,X22S	;JUMP IF YES.
	MOVE A,NLS	;NO. TOO SHORT
	MOVEM A,NL	;FLUSH OUT A NOTE
	SETZM ROB	;ABORT GRACE ACTION
	PUSHJ P,ER	;COMPLAIN
	ASCIZ /ITG
/			;INSUFFICIENT TIME FOR GRACE
	JRST X2S3	;GO TRY IT W/O GRACE
X2S1:	ADDM I,ROB	;THIS NOTE IS GRACE.
			;ADD TO ANY PREVIOUS GRACES
	MOVEI A,1
	MOVEM A,GI	;GRACE INDICATOR
	JRST S2S

S69:	MOVE A,NFP	;COMMA. USE PREVIOUS DURATION
	MOVEM A,NFT	;FOR THIS ONE
	MOVE B,CCC
	SKIPN X3I	;TRIPLET IN THIS NOTE?
	MOVEM B,X3I	;NO. COPY PREVIOUS.
	SKIPN FU	;WAS THERE A DOT
	JRST X2S4	;NO
	PUSHJ P,ER	;YES. COMPLAIN AND IGNORE
	ASCIZ /TIC
/
X2S4:	TRNE F,GCOUNT	;GRACE NOTE AS WELL AS COMMA?
	JRST X2S1	;YES. GO BACK TO PROCESS G TIME
	SETZM GI	;NO

S2S:	JUMPE H,S2U	;IF PITCH IS IN NUM
	CAILE H,1
	JRST SV2	;IF COMMA
	MOVE A,ACI	;IF REST. ACCIDENTAL IND?
	ADD A,ETE	;OR EMBELLISHMENT?
	JUMPE A,S2W	;NO IF JUMP
	PUSHJ P,ER	;ACCIDENTAL IN REST!
	ASCIZ /AIR
/
S2W:	MOVEI A,200	;NUMBER FOR REST
	MOVEM A,TNE	;TO TONE
	JRST S70	;GO WRAP UP.

S2U:	MOVE A,NUM	;PITCH IS NUM
	ADD A,SR	;ABOVE OR BELOW
	ADD A,ST	;CLEF
	MOVEM A,TON	;STORE
	JUMPL A,S40	;BAD IF < 0
	CAIGE A,44	;OR > 43
	JRST S2V	;OK
S40:	PUSHJ P,ER	;UNAVAILABLE TONE
	ASCIZ /UAT
/
	JRST S2W	;MAKE IT A REST
SV2:	MOVE A,TNE	;PITCH VIA COMMA
	CAIN A,200	;WAS IT A REST BEFORE?
	JRST S70	;YES. GO WRAP UP
S2V:	MOVE A,TON
	SKIPN ACI	;ACCIDENTAL?
	JRST S31	;NO. GO AHEAD
	MOVE B,NT(A)	;APPLY ACCIDENTAL
	ADD B,ACC	;# HALF TONES UP FOR THE ACC.
	CAIGE B,2
	JRST S41	;TOO LOW
	CAIGE B,77
	JRST S42	;OK
S41:	PUSHJ P,ER	;ACC. MOVED NOTE OUT OF RANGE
	ASCIZ /AOR
/
	JRST S2W
S42:	MOVEM B,MT(A)	;REMEMBER ACCIDENTAL FOR REST OF LINE
S31:	MOVE B,MT(A)	;GET PITCH VALUE
	ADD B,TLL	;UP/DOWN OFFSET
	CAIL B,2	;CHECK RANGE AGAIN
	CAIL B,77
	JRST S40	;BAD. SAY UAT
	ASH B,7
	MOVEM B,TNE	;TONE *200
	SKIPN ETE	;EMBELLISH?
	JRST S70	;NO. GO WRAP UP
	SKIPN X3I	;YES. TRIPLET TOO?
	JRST S71	;NO. GOOD
	PUSHJ P,ER	;EMBELLISHMENT ON TRIPLET
	ASCIZ /ETR
/
	JRST S70	;SKIP THE EMB.
S71:	MOVE A,ETE	;EMBELLISHMENT TABLE ENTRY
	MOVE A,EBL-1(A)	;GET LENGTH OF EMB
	SUB A,NFT	;MINUS NOTE LENGTH
	MOVNS A	;NEGATE
	MOVEM A,EX	;SAVE EXCESS
	JUMPGE A,S73	;BETTER BE .GE. 0 LEFT
S79:	PUSHJ P,ER	;LOSES. EMB ON SHORT NOTE
	ASCIZ /EIT
/
	JRST S70	;GIVE UP EMB.
;CONTROL OF EMBELLISHMENT.
S73:	MOVE A,TON	;WHERE DID THIS NOTE START?
	MOVE B,MT+1(A)	;HALF TONE UP
	ADD B,TLL	;UP/DOWN OFFSET
	CAIL B,2	;RANGE CHECK
	CAILE B,76
	JRST S39	;NO. OUT OF RANGE
	ASH B,7		;PUT IN POSITION
	MOVEM B,TNF	;STORE
	MOVE B,MT-1(A)	;LIKEWISE FOR FLAT
	ADD B,TLL	;UP/DOWN-NESS
	CAIL B,2	;CHECK RANGE
	CAILE B,76
	JRST S39
	ASH B,7
	MOVEM B,TND	;STORE "TONE DOWN"
	MOVE A,ETE	;GET THE INDEX BACK
	JRST @EBD-1(A)	;DISPATCH TO ROUTINE

EBL:	6	;D	;LENGTHS OF EMB'S
	4	;M
	10	;N
	10	;U
	4	;W
	5	;P

EBD:	S81		;EMBELLISHMENT DISPATCH
	S82
	S83
	S84
	S85
	S86

S81:	MOVE B,TNE	;D EMBELLISHER
	ADDI B,2	;DURATION 32
	PUSHJ P,CN	;CREATE NOTE
	MOVE B,TND	;FLAT
	ADDI B,2	;32ND
	PUSHJ P,CN
	JRST S75	;NATURAL, 3/16

S82:	TDZA A,A	;M EMB
S83:	MOVEI A,4	;N EMB
	MOVEM A,CUT
	MOVE A,NFT	;NOTE TIME
	TRNE A,3	;64 OR 32?
	JRST S79	;YES. TOO SHORT
	MOVEM A,C	;SAVE IN C
S77:	CAMG C,CUT	;TRILL THROUGH END OF NOTE
	JRST S78	;DONE
	MOVEI B,2
	ADD B,TNF
	PUSHJ P,CN
	MOVEI B,2
	ADD B,TNE
	PUSHJ P,CN
	MOVEI B,4
	ADDM B,CUT
	JRST S77

S84:	MOVEI B,400002	;U EMB.  SIGN BIT = LEGATO
	ADD B,TNF
	PUSHJ P,CN
	MOVEI B,400002
	ADD B,TNE
	PUSHJ P,CN
	MOVEI B,400002
	ADD B,TND
	PUSHJ P,CN
	JRST S75

S85:	MOVEI B,2	;W EMB (NOT DOCUMENTED)
	ADD B,TNE
	PUSHJ P,CN
	JRST S83

S86:	MOVEI B,1	;P EMB
	ADD B,TNF
	PUSHJ P,CN
	MOVEI B,1
	ADD B,TNE
	PUSHJ P,CN
	MOVEI B,1
	ADD B,TNF
	PUSHJ P,CN
S75:	MOVE B,EX	;EXCESS
	ADDI B,2	;+1/32
	ADD B,TNE	;+NATURAL TONE
	ADD B,SV	;+ARTICULATION
	PUSHJ P,CN	;OUTPUT REST OF NOTE
	JRST S32	;DONE
S78:	MOVE A,ETE	;DISPATCH TO FINISH UP EMB
	JRST @EBE-1(A)

EBE:	S32	;D
	S32	;M
	S93	;N
	S32	;U
	S95	;W
	S32	;P

S93:	MOVEI B,2	;FINISH N
	ADD B,TND
	PUSHJ P,CN
	MOVEI B,2
	ADD B,TNE
	PUSHJ P,CN
	JRST S32

S95:	MOVEI B,2	;FINISH W
	ADD B,TNF
	PUSHJ P,CN
	JRST S32

S39:	PUSHJ P,ER	;EMB OUT OF RANGE
	ASCIZ /EOR
/
S70:	MOVE B,NFT	;TIME	;HERE TO CLEAN UP NOTE
	ADD B,TNE	;+TONE*200
	ADD B,SV	;+ARTICULATION
	ADD B,X3I	;+TRIPLET INDICATOR
	PUSHJ P,CN	;CREATE NOTE
	SKIPN GI	;GRACE?
	JRST X2SA	;NO
	SKIPE GIS	;PREVIOUS GRACE?
	JRST X2SB	;YES
	MOVNI A,1	;NO. NLS_NL-1
	ADD A,NL
	MOVEM A,NLS
	AOSA GIS	;GIS _ 1
X2SA:	SETZM GIS	;NOW NO GRACE
S32:
X2SB:	MOVE A,NFT	;TIME
	SKIPN X3I
	ASH A,1		;DOUBLE TIME UNLESS TRIPLET
	ADD A,NFT	;+TIME
	ADDM A,MM	;MEASURE LENGTH
	MOVE A,SI
	MOVEM A,SID	;SAVE PREVIOUS ARTICULATION
PSR:	SETZM AO	;PSEUDO OP RETURN
TE:	SKIPN TRM	;WAS TERM CH A NOTE DELIMITER?
	JRST S1		; I.E., STILL BEFORE END OF MEASURE?
	MOVEI A,1	;NO
	MOVEM A,SID	;PREVIOUS ARTICULATION :=1
	SETZM TC
	MOVE A,X3U	;3 * UNITS
	ASH A,1		;6 UNITS
	CAMN A,MM	;EQUAL MEASURE LENGTH?
	JRST TE1	;YES. OK
	SETZM TJP	;NO. CLEAR MEASURE PRINTED
	CAML A,MM	;SAY BIG OR LITTLE
	JRST TE9	;TOO SHORT
	PUSHJ P,ER	;TOO LONG
	ASCIZ /MTL
/
	JRST TE1
TE9:	PUSHJ P,ER
	ASCIZ /MTS
/
TE1:	SKIPN ROB	;LEFTOVER ROB TIME?
	JRST TE0	;NO. OK
	PUSHJ P,ER
	ASCIZ /ITG
/			;APPOGIATURA TOO SHORT
	SETZM ROB
	SETZM GI
	SETZM GIS
	MOVE A,NLS
	MOVEM A,NL
TE0:	MOVEI B,600000	;OUTPUT A JUMP 0 (= BAR FLAG)
	PUSHJ P,CN	;CREATE AS A NOTE
	PUSHJ P,SBC	;STEP BAR COUNT
	MOVE B,LMB
	MOVEM B,@BAR
	MOVEI A,1
	ADD A,NL
	MOVEM A,LMB
	SETZM MM
	SETZM AO
	PUSHJ P,PUE	;END OF MEASURE, REMOVE ACCIDENTALS
	JRST S1
;LOOK UP PSEUDO OP

PC:	SKIPN AO
	JRST PC01
	SETZM AO
	PUSHJ P,ER
	ASCIZ /AGM
/
PC01:	MOVE E,FL2
	MOVEM E,FL1
	MOVEI B,0
PC0:	PUSHJ P,RCH
	JUMPE A,PC1
	CAIN A,"/"
	JRST PC1
	SUBI A,40
	ROT A,-6
	ROTC A,6
	JRST PC0
PC1:	MOVSI A,-NPI	;SEARCH P.I. TABLE
	CAME B,PNM(A)
	AOBJN A,.-1
	MOVEI B,0
	JRST @PCD(A)	;DISPATCH

PNM:	SIXBIT /     S/	;PSEUDO OP NAME TABLE
	SIXBIT /     L/
	SIXBIT /     E/
	SIXBIT /   END/
	SIXBIT /  BASS/
	SIXBIT /TREBLE/
	SIXBIT / TENOR/
	SIXBIT /  ALTO/
	SIXBIT / UNITS/
	SIXBIT /   KEY/
	SIXBIT /  REST/
	SIXBIT /  COPY/
	SIXBIT /    UP/
	SIXBIT /  DOWN/
	SIXBIT /     H/
	SIXBIT /     Q/
	SIXBIT / TEMPO/
	SIXBIT /  BEAT/
	SIXBIT /    RG/
	SIXBIT /    GR/
	SIXBIT /     P/
	SIXBIT /     F/
	SIXBIT /    MF/
	SIXBIT /    MP/
	SIXBIT /    PP/
	SIXBIT /    FF/
NPI=.-PNM
PCD:	PV1
	PV2
	PV3
	PV4
	PV5
	PV6
	PV7
	PV8
	PV9
	PVA
	PVB
	PVC
	PVD
	PVE
	PVF
	PVG
	PVH
	PVI
REPEAT ^D8,<	PSR>
	NOSUCH

PV2:	ADDI B,200000	;L LEGATO  SS_400000
PV1:	ADDI B,140000	;S STACCATO SS_200000
PVF:	ADDI B,20000	;H HALF    SS_40000
PVG:	ADDI B,20000	;Q QUARTER SS_20000
PV3:	MOVEM B,SS	;E EIGHTHS SS_0
	JRST PSR

PV6:	ADDI B,6	;TREBLE ST_22.
PV8:	ADDI B,2	;ALTO   ST_16.
PV7:	ADDI B,4	;TENOR  ST_14.
PV5:	ADDI B,12	;BASS   ST_10.
	MOVEM B,ST
	JRST PSR

PV9:	MOVEI A,1	;UNITS
	MOVEM A,AO
	PUSHJ P,TE
	MOVE A,NUM
	MOVEM A,X1U	;UNITS*1
	IMULI A,3
	MOVEM A,X3U	;UNITS*3
	SETOM IRL
	JRST PSR

PV4:	PUSHJ P,SBC	;END OF A PART.
			; OUTPUT DATA FOR THE PART. STEP BAR COUNT
	MOVEI B,600000
	MOVEM B,@BAR
	AOS A,NL
	PUSHJ P,PBW	;OUTPUT SIZE OF NOTE TABLE
			; SETS LOC 0
	SETZB E,F
	JRST P410
P41:	MOVE A,E
	MOVE A,@PNOT	;OUTPUT THE NOTE TABLE
	ADD F,A
	CAIL F,-1
	SUBI F,-1
	PUSHJ P,PBW
	ADDI E,1
P410:	CAMGE E,NL
	JRST P41
	MOVE A,F	;CHECKSUM THE NOTES
	PUSHJ P,PBW
	AOS A,BC
	PUSHJ P,PBW	;NUMBER OF BARS
	SETZB E,F
P42:	MOVN D,E
	MOVE A,D
	MOVE A,@BAR
	ADD F,A
	CAIL F,-1
	SUBI F,-1
	PUSHJ P,PBW	;OUTPUT BAR DATA
	ADDI E,1
	CAME E,BC
	JRST P42
	MOVE A,F
	PUSHJ P,PBW	;CHECKSUM OF BARS
	JRST PBW	;EXIT FROM PHASE ONE

PVH:	AOS AO		;TEMPO
	PUSHJ P,TE
	MOVE B,NUM
	ANDI B,37777
	ADDI B,700000
	PUSHJ P,CN
	JRST PSR

PVA:	PUSHJ P,RCH		;KEY
	JUMPE A,PVA	;SKIP SPACE
	MOVEI B,1
	CAIE A,")"
	CAIN A,"="
	JRST PUM	;NO SHARPS OR FLATS
	CAIE A,"("
	CAIN A,"+"
	JRST PUS	;SHARPS
	CAIN A,"-"
	JRST PUF	;FLATS
	PUSHJ P,ER	;MYSTERIOUS KEY
	ASCIZ /MYK
/
	JRST S1
PUS:	MOVEM B,AO	;SHARPS
	PUSHJ P,S1
	PUSHJ P,PUN
	MOVEI A,1
	MOVEI B,4
	MOVEI C,3
	JRST PUW

PUF:	MOVEM B,AO	;FLATS
	PUSHJ P,S1
	PUSHJ P,PUN
	MOVNI A,1
	MOVEI B,3
	MOVEI C,6
PUW:	MOVEM A,ACC
	MOVEM B,ACI
PUW1:	MOVEM C,TNE
	SKIPN NUM
	JRST PW2
	MOVE D,TNE
PW1:	MOVE A,NT(D)
	ADD A,ACC
	MOVEM A,KT(D)
	ADDI D,7
	CAIGE D,44
	JRST PW1
	SOS NUM
	MOVE C,TNE
	ADD C,B
	CAIL C,7
	SUBI C,7
	JRST PUW1
PW2:	PUSHJ P,PUE
	JRST PSR

PVD:	AOS AO		;UP
	PUSHJ P,TE
	MOVE A,NUM
	MOVEM A,TLL
	JRST PSR
PVE:	AOS AO		;DOWN
	PUSHJ P,TE
	MOVN A,NUM
	MOVEM A,TLL
	JRST PSR

PVB:	AOS AO		;REST
	SKIPN MM
	JRST PB2
	PUSHJ P,ER1
	ASCIZ /ILR
/
	JRST I1A
PB2:	PUSHJ P,TE
	SKIPN NUM
	JRST PSR
	SKIPL IRL
	JRST PB3
	PUSHJ P,SNL
	MOVE B,X1U	;UNITS
	ADDI B,100
	ASH B,1
	MOVEM B,@PNOT		;2*UNITS+200.
	MOVEM A,IRL
	PUSHJ P,SNL	;COUNT STORAGE
	MOVEI B,600000
	MOVEM B,@PNOT
	ADDI A,1
	MOVEM A,LMB
PB3:	PUSHJ P,SBC
	MOVE B,IRL
	MOVEM B,@BAR
	SOSE NUM
	JRST PB3
	JRST PSR
PVC:	MOVEI A,2	;COPY
	ADDM A,AO
	SKIPN MM
	JRST COW
	PUSHJ P,ER1
	ASCIZ /ILC
/
	PUSHJ P,TE
I1A:	PUSHJ P,TE
	JRST PSR

COW:	PUSHJ P,TE
	MOVE A,NUM
	MOVEM A,CBH
	JUMPE A,CO3
	CAMGE A,TBC
	JRST CO4

CO3:	PUSHJ P,ER1
	ASCIZ /BLC
/
CO4:	PUSHJ P,TE
	MOVE A,NUM
	CAML A,CBH
	JRST CO7
CO6:	PUSHJ P,ER1
	ASCIZ /BRC
/
	JRST PSR
CO7:	SOS A,CBH
CO8:	MOVNS A
	MOVE B,@BAR
	PUSHJ P,SBC	;STEP BAR COUNT
	MOVEM B,@BAR
	AOS A,CBH
	CAMGE A,NUM
	JRST CO8
	JRST PSR
S3XQ:	HRRZ A,JOBREL
	ADDI A,2000
	CALLI A,11
	JRST S3X
	MOVEI A,2000
	ADDM A,ALL
	ADDM A,PNOTE
	ADDM A,BAR
	MOVE A,JOBREL
	SUB A,BAR
	ADD A,BC
	HRRZM A,S3XQT
	MOVE A,JOBREL
	PUSH P,-2000(A)
	POP P,0(A)
	SOSL S3XQT
	SOJA A,.-3
	POPJ P,0
PVI:	MOVEI A,2		;BEAT
	ADDM A,AO	;TAKES 2 ARGUMENTS EXCEPT BEAT 0
	PUSHJ P,TE	;GET AN ARG
	MOVE A,NUM	;SAVE IT
	MOVEM A,BEAT1
	JUMPE A,PVI3	;WAS IT A 0?
	PUSHJ P,TE	;NO. GET SECOND ARG
	MOVE A,BEAT1	;WAS FIRST ARG .G. 127.?
	TRZN A,-200
	JRST PVI1	;NO. OK.
	PUSHJ P,ER1	;YES. BAD.
	ASCIZ /BLB
/
	JRST PSR	;IGNORE PSEUDOOP
PVI1:	EXCH A,NUM	;GET SECOND ARG
	JUMPE A,.+3	;SECOND ARG 0? (ERR)
	TRZN A,-100	;OK. .G. 63.?
	JRST PVI2	;NO. OK.
	PUSHJ P,ER1	;YES. ERROR. MUST BE 1 TO 63
	ASCIZ /BRB
/
	JRST PSR
PVI2:	ASH A,7
	ADD A,NUM
PVI3:	MOVEI B,740000(A)
	PUSHJ P,CN	;CREATE NOTE. BITS 0-3=74,
			; 4=0, 5-10=ARG2, 11-17=ARG1
	JRST PSR

SBC:	AOS TBC		;STEP BAR COUNT
	AOS A,BC
	ADD A,NL
	CAML A,ALL
	PUSHJ P,S3XQ
	MOVN A,BC
	POPJ P,0

SNL:	AOS A,NL		;ADD A NOTE, IF ROOM
	ADD A,BC
	CAML A,ALL
	PUSHJ P,S3XQ	;TABLE OVERFLOW?
	MOVE A,NL
	POPJ P,0

CN:	PUSHJ P,SNL
	MOVEM B,@PNOT
	POPJ P,0
NUM:	BLOCK 2	;NUMBERS BEING GENERATED FOR A NOTE

MT:	BLOCK 44	;THIS BLOCK HAS ACCIDENTALS APPLIED
KT:	BLOCK 44	;BLOCK WITH KEY APPLIED
NT:	2		;VIRGIN NOTES
	4
	6
	7
	11
	13
	15
	16
	20
	22
	23
	25
	27
	31
	32
	34
	36
	37
	41
	43
	45
	46
	50
	52
	53
	55
	57
	61
	62
	64
	66
	67
	71
	73
	75
	76

PDLL=20
SAVAC:	BLOCK 17	;WHEN SWITCHING FROM OTHER HALF OF SYSTEM
PDL:	BLOCK PDLL	;THE PUSHDOWN STACK
INBUFF:	BLOCK 100	;500 OCTAL CHARACTERS BETWEEN /'S
INBUFE:
;VARIABLE STORAGE FOR PHASE ONE

ACC:	0	;ACCIDENTAL VALUE, HALFTONES + OR -
ACI:	0	;ACCIDENTAL INDICATOR FLAG
AO:	0	;NUMBER OF NUMERIC ARGUMENTS EXPECTED,
			; FOR PSEUDO-OPS. (0, 1 OR 2)
BC:	0	;
BEAT1:	0	;TEMP FOR BEAT PSEUDO
BLC:	0	;BAD LETTER COUNT (ERR TYO)
CBH:	0	;COPY BAR COUNT
CCC:	0	;TRIPLET STORAGE
CHINC:	0	;COUNT OF NON-NUMERIC CHARS. 0 AT START OF NOTE
CUT:	0	;WHEN TO CUT OFF TRILL (EMB)
ERCE:	0	;ERROR COUNT SAVE AC E
ET:	0	;
ETC:	0	;ERROR TYPE COUNT
ETE:	0	;EMBELLISHMENT TABLE ENTRY.
		;0=NONE, 1-6=DMNUWP
EX:	0	;EXCESS OF NOTE OVER EMBELLISHMENT TIME
FC:	0	;VALUE OF A DOT. 32 AT START OF NOTE.
		;HALVED BY X'S OR .'S
FL1:	0	;BYTE POINTER FOR LINE SCAN
FL2:	0	;DITTO
FU:	0	;STORAGE FOR DOT DURATION ACTUALLY SEEN
		;64 AT S1
GI:	0	;GRACE INDICATOR
GIS:	0	;GRACE INDICATOR SAVE
GOTCHA:	0	;SAVE A IN GETCHA
IRL:	0
LMB:	0
MJP:	0	;ERROR COUNT
MM:	0	;MEASURE LENGTH TOTAL
NDIG:	0	;NUMBER OF DIGITS IN NUMERIC BUILDER
NFP:	0	;PREVIOUS NOTE DURATION
NFT:	0	;TIME PART OF NOTE
NL:	0	;NOTE TABLE LENGTH
NLS:	0	;SAVE PREVIOUS NL
ROB:	0	;ROBBED TIME FOR GRACE NOTES
SI:	0	;ARTICULATION INDICATOR
SID:	0	;PREVIOUS SI
SR:	0	;14 FOR A, -14 FOR B
SS:	0	;STANDARD ARTICULATION (0 AT START)
ST:	0	;STANDARD CLEF (26, TREBLE, AT START)
SV:	0	;ARTICULATION VALUE IN S2, NORMAL =0
TBC:	0	;BAR COUNT
TC:	0
TJP:	0
TLL:	0	;TRANSPOSE, UP/DOWN VALUE
TND:	0	;TONE, DOWN 1, FOR EMBELLISHMENTS
TNE:	0	;TONE * 200
TNF:	0	;TONE, UP 1, FOR EMBELLISHMENTS
TON:	0	;TONE
TRM:	0	;TERMINATING CHARACTER
X1U:	0	;UNITS *1
X3U:	0	;UNITS *3
X3I:	0	;TRIPLET INDICATOR

RIB:	BLOCK 3

S3XQT:	0		;TEMP FOR CORE EXPANDER

C1END:		;END OF PHASE 1 OF THE COMPILER
	SUBTTL PHASE TWO OF COMPILER

MCOMP:	CALLI 0
	MOVE P,[IOWD PLL,PL]
	PUSHJ P,WRITE
	ASCIZ /
INPUT FILE: /
	PUSHJ P,FILSPC
	MOVEM A,INDEV
	MOVEM B,INFIL
	MOVEM C,INEXT

	SKIPN B,INDEV
	MOVSI B,(SIXBIT /DSK/)
	MOVEI A,0
	MOVEI C,RIB
	OPEN INCHN,A
	JRST MCOMP
	MOVE A,INFIL
	SKIPN B,INEXT
	MOVSI B,(SIXBIT /MUS/)
	SETZB C,D
	LOOKUP INCHN,A
	JRST MCOMP
	INBUF INCHN,2
	PUSHJ P,WRITE
	ASCIZ /
OUTPUT FILE: /
	PUSHJ P,FILSPC
	MOVEM A,OUTDEV
	MOVEM B,OUTFIL
	MOVEM C,OUTEXT
	SETZM SAVMOD
	SKIPN A,OUTDEV
	MOVSI A,(SIXBIT /PTP/)
	CALLI A,4
	MOVEM A,DEVCHR
	TLNE A,DVDIR
	SETOM SAVMOD
RDIN3:	MOVEI A,10
	SKIPN B,OUTDEV
	MOVSI B,(SIXBIT /PTP/)
	MOVSI C,POB
	OPEN OUTCHN,A
	JRST NOPTP
	MOVE A,DEVCHR
	TLNE A,DVDTA
	SKIPN SAVMOD
	SKIPA
	UGETF OUTCHN,A		;CAUSE EARLY BLOCK FOR TENDMP
	SKIPE A,OUTFIL
	JRST RDIN2
	SKIPN A,INFIL
	MOVE A,[SIXBIT /MUSIC/]
RDIN2:	SKIPE B,OUTEXT
	JRST RDIN4
	MOVSI B,(SIXBIT /MSB/)
	SKIPE SAVMOD
	MOVSI B,(SIXBIT /SAV/)
RDIN4:	SETZB C,D
	ENTER OUTCHN,A
	JRST NOPTP
	OUTBUF OUTCHN,2
	JRST RDIN1
NOPTP:	PUSHJ P,WRITE
	ASCIZ /CANT WRITE OUTPUT FILE
/
RDIN1:	SETZM EOFFLG
	HRRZ A,JOBFF
	MOVEM A,SJOBFF
	HRRM A,PNOT
	MOVSI B,A
	HLLM B,PNOT
	HLLM B,PNOTE
	HLLM B,BAR
	ADDI A,1000
	TRO A,1777
	CAMLE A,JOBREL
	CALLI A,11
	JFCL
	HRRZ A,JOBREL
	SUB A,SJOBFF
	ASH A,-1
	MOVEM A,ALL
	ADD A,SJOBFF
	HRRM A,BAR
	SOS BAR
	SOS ALL
	HRRM A,PNOTE
	AOS A,PNOTE
	MOVSI B,600000
	MOVEM B,-1(A)
	MOVE A,JOBREL
	SUB A,PNOTE
	HRRZM A,LENGTH
	SETZM NPT		;NO PARTS YET
	SETZM PUTI
	SETZM PUTJ
	SETOM L		;MEASURE NUMBER

STOP:	JSR PREP	;CALL PHASE 1 TO COMPILE A PART
	SKIPE EOFFLG
	JRST START
	MOVE P,[IOWD PLL,PL]
	MOVSI F,-2		;READ TWO BLOCKS OF DATA

BLOK:	MOVE A,PUTI(F)
	MOVEM A,PUTIS(F)
	SETZB CS,NWR
	PUSHJ P,READ	;WHICH CALLS PHASE 1 FOR COUNT IN BLK
	MOVEM G,NWD

SWORD:	PUSHJ P,READ	;READ A DATUM FROM PHASE 1
	MOVE A,PUTI(F)
	ADD CS,G
	TLNN CS,1
	CAIL CS,-1
	SUBI CS,-1	;ACCOUNT FOR 18 BIT ONES COMP ARITH ON PDP-1
	XCT PUTY(F)	;SKIP UNLESS DATA ITEM IN SECOND BLOCK
	ADD G,PUTIS	;ADD BASE OF NOTES FOR THIS PART
	XCT PUTX(F)	;STORE IN NOTE(A). LH=NOTES, RH = BAR
	AOS G,NWR
	AOS A,PUTI(F)
	CAMLE A,LENGTH
	JRST FULLQ
FULLRT:	CAME G,NWD
	JRST SWORD
EKK:	PUSHJ P,READ	;CALL PHASE 1 FOR CHECKSUM
	CAMN G,CS	;CHECKSUM
	AOBJN F,BLOK	;TWO BLOCKS
	JUMPGE	F,EPART		;JUMP IF DONE WITH PART
	MOVE A,PUTIS(F)		;CHECKSUM ERROR. DELETE PART
	MOVEM A,PUTI(F)		;BY RESTORING INPUT PTR
	PUSHJ P,WRITE	;TYPE OUT ERROR COMMENT
	ASCIZ /CS
/
	JRST STOP

EPART:	AOS G,NPT	;END OF A PART. COUNT THEM
	MOVE A,PUTIS+1
	MOVEM A,PART-1(G)	;SAVE END OF PART POINTER
	MOVE A,NPT
	CAIGE A,10		;TOO MANY PARTS?
	JRST STOP	;NO. GO GET MORE
	JRST II		;YES. START PROCESSING AND OUTPUTING

FULLQ:	HRRZ A,JOBREL
	ADDI A,2000
	CALLI A,11
	JRST FULL
	MOVEI A,2000
	ADDM A,LENGTH
	JRST FULLRT

FULL:	PUSHJ P,WRITE
	ASCIZ /STORAGE FULL
/
START:	SKIPN NPT	;ANY PARTS YET?
	JRST MCOMP	;NO. DEMAND SOME
II:	MOVE G,NPT
	PUSHJ P,DPT
	PUSHJ P,WRITE
	ASCIZ / PARTS
/
	SETZM SWX1
	MOVE E,KC1
REPEAT 0,<
	DATAI 0,G		;READ SWITCHES
	JUMPL G,II1		;SUPPRESS LEADER? CONTINUE PREVIOUS PIECE
>
	MOVEI G,400	;STARTING ADR IN PDP1 CORE FOR MUSIC
	MOVEM G,RR
	MOVEI G,252	;DEFAULT TEMPO
	MOVEM G,TEMPO
	MOVEI G,600
	MOVEM G,MN1
	MOVEI G,60001
	MOVEM G,MN2
	SKIPE SAVMOD
	JRST IISAV
	MOVEI G,200	;LEADER FEED
	PUSHJ P, FEED
	MOVEI Z,607751	;TRADITIONAL PDP1 JUMP BLOCK
	PUSHJ P,PBWD		;OUTPUT IT
	MOVEI G,300		;MORE FEED
	PUSHJ P,FEED
IISRET:	MOVSI Z,-220	;220=144.=8.*18.
	MOVE G,RR		;CORE ADR
	MOVEM G,R
	SETZM WRIT(Z)	;CLEAR WRIT BLOCK
	AOBJN Z,.-1
	MOVSI Z,-10
	MOVEI G,1
	MOVEI F,-1
	HRRM G,MARG(Z)
	MOVEM F,BILD(Z)
	SETOM BEATI(Z)
	SETOM BEATJ(Z)
	AOBJN Z,.-4

;COME BACK HERE FOR EACH MEASURE, ONCE ALL PARTS ARE READ

III:	SETZM TERROR		;CLEAR FLAG FOR "TIME DIFFERENT IN MEASURES"
DELTA:	MOVEI A,377700		;MAX DURATION OF A TONE
	MOVEM A,Y
	SETZB I,Z0
	SETZM Q
III1:	HLRZ A,MARG(I)
	ADD A,MARG(I)
	MOVE M,WRIT(A)
	MOVEI N,377700
	AND N,M
	CAMGE N,Y
	MOVEM N,Y	;GET SHORTEST DURATION
	ANDI M,77
	HRLM M,BILD(I)
	AOS I
	CAMGE I,NPT
	JRST III1
	SKIPN SWX1	;DONT OUTPUT FIRST LOOP
	JRST FXY
ALPHA:	MOVN G,Y
	ASH G,-6
	IMUL G,TEMPO
	ANDI G,-1
	PUSHJ P,PUNCH
	HLRZ G,BILD
	HLRZ F,BILD+1
	ASH G,6
	ADD G,F
	HLRZ F,BILD+2
	ASH G,6
	ADD G,F
	PUSHJ P,PUNCH	;OUTPUT 3 PARTS.
	MOVE A,NPT		;ARE THERE MORE?
	SKIPE SAVMOD	;MAKING A SAVE FILE?
	JRST ALPHA1	;YES, ASSUME ALWAYS 6 PARTS
	CAIGE A,4
	JRST FXY	;NO.
ALPHA1:	HLRZ G,BILD+3
	HLRZ F,BILD+4
	ASH G,6
	ADD G,F
	HLRZ F,BILD+5
	ASH G,6
	ADD G,F
	PUSHJ P,PUNCH
	CAIGE A,7	;ARE THERE MORE THAN 6?
	JRST FXY	;NO.
	HLRZ G,BILD+6
	HLRZ F,BILD+7
	ASH G,6
	ADD G,F
	ASH G,6
	PUSHJ P,PUNCH		;OUTPUT PARTS 7,8
FXY:	SETOM SWX1
	MOVEI I,0
BETA:	SETZM Z1
	HLRZ D,MARG(I)
	ADD D,MARG(I)
	MOVE A,WRIT(D)
	ANDI A,377700
	CAME A,Y
	JRST GAMMA
	HRRZ D,MARG(I)
	SOJN D,ZETA

GNOTE:	HRRZ D,BILD(I)
	MOVE A,D
	HLRZ N,@PNOTE
	CAIN N,600000
	JRST GBAR
	CAIGE N,700000
	JRST DNOTE
	TRNE N,40000
	JRST TEMBE
	ANDI N,37777
	CAIGE N,526
	JRST TEMS
	CAILE N,1252
	JRST TEMB
	MOVEI A,300
	MOVEI B,30001
TEMR:	MOVEM A,MN1
	MOVEM B,MN2
	MOVEM N,TEMPO
TEMZ:	AOS D
	HRRM D,BILD(I)
	JRST GNOTE

TEMS:	MOVEI A,600
	MOVEI B,60001
	JRST TEMR

TEMB:	PUSHJ P,WRITE
	ASCIZ /TS
/
	MOVE G,N
	PUSHJ P,DPT
	JRST TEMZ
GBAR:	MOVEI A,1
	MOVEM A,Z0
	MOVEM A,Z1
	MOVE A,PART(I)
	AOS PART(I)
	HRRZ Z,@PNOTE
	CAIN Z,600000	;TWO CONSECUTIVE BARS?
	JRST THETA	;YES. END OF PART.
	HRRM Z,BILD(I)	;NO. GO ON
	JRST GNOTE

TEMBE:	MOVEM N,BEAT(I)	;STORE BEAT PSEUDO
	ANDI N,37600
	ASH N,-7		;GET SECOND ARG OF BEAT
	IMULI N,60		;TIMES 60
	MOVEM N,BEATI(I)	;STORE IN THIS PART'S BEATI
	MOVEM N,BEATJ(I)	;AND BEATJ
	MOVEI N,177
	AND N,BEAT(I)
	IMULI N,6		;6 TIMES ARG1
	MOVEM N,BEAT(I)	;GOES TO BEAT OF THIS PART
	JRST TEMZ
DNOTE:	MOVEI A,1	;ORDINARY NOTE. NOT A PSEUDO.
	HRRM A,MARG(I)
	AOS D
	HRRM D,BILD(I)
	SKIPN Z1
	SETOM Q
	MOVE A,N		;TIME
	ANDI A,177
	ASH A,3		;TIME * 8
	MOVEI B,3
	TRNE N,100000	;TRIPLET?
	MOVEI	B,2
	IMUL A,B
	MOVE B,N
	ANDI B,17600	;NOTE FREQUENCY
	ASH B,-7
	MOVEM B,NO	;FREQ.
	HLRZ D,MARG(I)
	ADD D,MARG(I)
	SOJE B,PSI	;IF JUMP, FREQ WAS 1. I.E., REST.
	TRNE N,400000	;LEGATO?
	JRST PSI	;YES
	MOVE B,A
	TRNE N,200000
	JRST STAC	;STACCATO
	ANDI N,60000
	CAIN N,20000
	JRST QUAR
	CAIN N,40000
	JRST HALF
	ASH B,-1
QUAR:	ASH B,-1
HALF:	ASH B,-1
BKTST:	MOVE N,BEATJ(I)
	SUB N,A		;-TIME+BEAT
	MOVEM N,BEATJ(I)	;BEATJ_BEATJ-LENGTH OF THIS NOTE
	JUMPE N,BET1		;GONE TO ZERO?
	JUMPG N,BET2

BET3:	MOVE N,BEATI(I)
	MOVEM N,BEATJ(I)	;BEATJ WENT NEGATIVE. RESET TO BEATI
BET2:	SUB A,B
BKTA:	MOVE C,B	;PUT THE OFF TIME FOR THIS TONE IN CORE
	SUB C,MN1
	JUMPLE C,PHI
	MOVE B,MN2
	MOVEM B,WRIT(D)
	MOVE B,C
	AOS MARG(I)
	AOJA D,BKTA
BET1:	CAML B,BEAT(I)	;IS OFF TIME .GE. BEAT TIME?
	JRST BET3		;YES. IGNORE BEAT
	MOVE N,A	;NO. OFF IS .L. BEAT. GET DURATION
	SUB N,BEAT(I)	;DURATION - BEAT
	CAIL N,10	;DURATION AT LEAST 1/8 MORE THAN BEAT?
	MOVE B,BEAT(I)	;YES. GET BEAT TIME AS OFF TIME.
	JRST BET3	; OTHERWISE IGNORE.

STAC:	MOVE B,A
	ASH B,-3
	IMULI B,5
	JRST BKTST

PHI:	ASH B,6
	ADDI B,1
	MOVEM B,WRIT(D)
	AOS MARG(I)
	ADDI D,1
PSI:	MOVE C,A	;ENTER HERE ON REST
	SUB C,MN1	;PUT ARTICULATION INTO WRIT
	JUMPLE C,XI
	MOVE A,C
	MOVE B,NO
	ADD B,MN2
	SUBI B,1
	MOVEM B,WRIT(D)
	AOS MARG(I)
	AOJA D,PSI

XI:	MOVE B,A	;PUT FREQ AND TIME INTO WRIT
	ASH B,6
	ADD B,NO	;FREQ
	MOVEM B,WRIT(D)
CHI:	AOS I
	CAMGE I,NPT
	JRST BETA	;MORE PARTS TO GO
	SKIPN Z0
	JRST DELTA
	AOS L		;COUNT MEASURE NUMBER
	SKIPN Q	;DID IT COME OUT EVEN?
	JRST III	;YES
	SKIPE TERROR	;NO. HAPPENED BEFORE THIS MEASURE?
	JRST DELTA	;YES. ONE ERR MSG IS ENOUGH
	MOVE G,L	;COMPLAIN.
	PUSHJ P,DPT	;TYPE MEASURE NUMBER
	PUSHJ P,WRITE	;ADD COMMENT
	ASCIZ / MLD
/			;MEASURE LENGTHS DIFFER
	SETOM TERROR
	JRST DELTA
GAMMA:	MOVN A,Y
	ADDM A,WRIT(D)
	JRST IOTA

ZETA:	HRRM D,MARG(I)
IOTA:	SETOM Q
	JRST CHI

IISAV:	MOVE Z,[IOWD PLYLEN,PLYORG]
	PUSHJ P,PBWD
	MOVE A,[IOWD PLYLEN,PLYIMG]
	MOVE Z,1(A)
	PUSHJ P,PBWD
	AOBJN A,.-2
	SETOM SVSYNC	;ADDRESS WILL BE NEXT THING OUT
	MOVEI A,MUST
	MOVEM A,PLYADR
	SETZM PLYCNT	;NEED TO START AN IOWD
	JRST IISRET

PPAERR:	PUSHJ P,WRITE
	ASCIZ /OUTPUT ERROR
/
	CALLI 12
PUNCH:	AOBJN E,.+1
	MOVEM G,0(E)
	AOS G,R
	CAIL G,377774
	JRST WOOF
	JUMPL E,PPOPJ	;MORE TO GO IN BLOCK IF JUMP
PUNBLK:	SKIPE SAVMOD
	JRST PBKSAV	;SPECIAL HANDLING OF SAVE FILE
	MOVE Z,RR	;OUTPUT BLOCK OF TAPE
	ADDI Z,320000	;PDP1 DIO INST TO ADR OF BLOCK
	PUSHJ P,PBWD
	MOVE Z,R
	ADDI Z,320000	;DIO TO HIGHEST ADR
	PUSHJ P,PBWD
	ADD Z,RR
	ADDI Z,320000
	MOVEM Z,CS
	MOVE G,R
	MOVEM G,RR	;NEXT BLOCK ADR
	MOVE G,KC1
	AOBJN G,PWD
PWD:	MOVE Z,(G)
	ADD CS,Z
	CAIL CS,-1	;18 BIT CKSUM
	SUBI CS,-1
	PUSHJ P,PBWD
	AOBJN G,.+1
	CAMG G,E
	JRST PWD
	MOVE Z,CS
	PUSHJ P,PBWD	;OUTPUT THE CHECKSUM
PBK1:	MOVE E,KC1
	MOVEI G,6
	PUSHJ P,FEED	;SEPARATE BLOCKS
PPOPJ:	POPJ P,0

PBKSAV:	MOVE G,KC1
	AOBJN G,PWDS
PWDS:	MOVE Z,(G)
	SKIPL SVSYNC
	JRST PBKSV0
	HRROS Z		;MAKE TIME A NEGATIVE 36 BIT NO
	ASH Z,6		;STANDARD TEMPO
	JRST PBKSV3
PBKSV0:	SKIPE SVSYNC	;FIRST 3 OF 6 VOICES?
	JRST PBKSV1	;NO
	MOVSM Z,SVTEMP	;YES. JUST SAVE IT
	JRST PBKSV2

PBKSV1:	HLL Z,SVTEMP	;GET THE FIRST 3 VOICES
PBKSV3:	PUSHJ P,PBWDSV
PBKSV2:	AOS Z,SVSYNC
	CAILE Z,1
	SETOM SVSYNC
	AOBJN G,.+1
	CAMG G,E
	JRST PWDS
	JRST PBK1
WOOF:	PUSHJ P,WRITE	;OVERFLOW
	ASCIZ /STORAGE OVERFLOW
/
	MOVE G,L
	ADDI G,1
	PUSHJ P,DPT	; OUTPUT MEASURE NUMBER

THETA:	CAME E,KC1
	PUSHJ P,PUNBLK
	MOVEI G,100
	PUSHJ P,FEED
	MOVEI G,0
	PUSHJ P,PUNCH
	MOVEI G,0
	PUSHJ P,PUNCH	;ZEROES FOR END OF WORLD
	PUSHJ P,PUNBLK	;FINISH OUT BLOCK
	SKIPE SAVMOD
	JRST THETAS	;SPECIAL END IF A SAV FILE
	MOVEI G,20
	PUSHJ P,FEED		;TRAILER
	MOVEI Z,600100		;PDP1 JUMP TO 100 (PLAYER)
THETA1:	PUSHJ P,PBWD		;OUTPUT JUMP BLOCK
	MOVEI G,300
	PUSHJ P,FEED		;AND TRAILER
	RELEAS INCHN,0
	RELEAS OUTCHN,0
	PUSHJ P,WRITE
	ASCIZ /END OF COMPILATION
/
	JRST MCOMP		;SEE IF MORE TO COMPILE

THETAS:	SKIPL PLYCNT	;PARTIAL BUFFER THERE?
	JRST THETS2	;NO
	MOVEI Z,0	;YES. FILL WITH ZEROES
	PUSHJ P,PBWDSV
	JRST THETAS	;SEE IF THAT FILLED IT UP
THETS2:	MOVE Z,[JRST RELOAD]	;START OF PLAYER
	JRST THETA1
KC1:	XWD -100,PUNCHB		;COUNT THE OUTPUT BLOCK FOR PTP
PUNCHB:	BLOCK 101

FEED:	MOVE ZZ,DEVCHR
	TLNN ZZ,DVPTP		;WANT FEED?
	POPJ P,0		;NO
	MOVEI ZZ,0
	PUSHJ P,PPA
	SOJG G,.-1
	POPJ P,0

PBWD:	MOVEM Z,PBWZ
	MOVE ZZ,Z
	MOVE Z,DEVCHR
	TLNN Z,DVPTP
	JRST PBWDX
	MOVE Z,ZZ
	HRLI Z,2
	ROTC Z,30
	PUSHJ P,PPA
	MOVEI ZZ,2
	ROTC Z,6
	PUSHJ P,PPA
	MOVEI ZZ,2
	ROTC Z,6
PBWDX:	MOVE Z,PBWZ
	JRST PPA

DPT:	PUSH P,Z-1
	MOVE <Z-1>,G
	PUSHJ P,DPT0
	POP P,Z-1
	POPJ P,0

DPT0:	IDIVI <Z-1>,12
	HRLM Z,0(P)
	SKIPE Z-1
	PUSHJ P,DPT0
	HLRZ Z,0(P)
	ADDI Z,60
	JRST TYO

PBWDSV:	AOSG PLYCNT		;NEED TO START A BUFFER?
	JRST PBWD		;NO
	PUSH P,Z
	HRLOI Z,-101
	ADD Z,PLYADR		;MAKE IOWD 100,ADR
	PUSHJ P,PBWD
	MOVEI Z,100
	MOVNM Z,PLYCNT
	ADDM Z,PLYADR
	POP P,Z
	JRST PBWDSV
PPA:	SOSLE POB+2
	JRST PPAOK
	OUTPUT OUTCHN,0
	STATZ OUTCHN,760000
	JRST PPAERR
PPAOK:	IDPB ZZ,POB+1
	POPJ P,0

READ:	MOVE 0,[XWD 1,SAVAC2]
	BLT 0,SAVAC2+16
	JSR GETCHA		;CALL PHASE 1
	MOVEM 0,SAVAC2+G-1
	MOVE 0,[XWD SAVAC2,1]
	BLT 0,17
	POPJ P,0

;VARIABLES FOR THE I/O FILES

INDEV:	0
INFIL:	0
INEXT:	0

OUTDEV:	0
OUTFIL:	0
OUTEXT:	0
EOFFLG:	0

SAVMOD:	0		;-1 IF WRITING A .SAV FILE
DEVCHR:	0		;OUTPUT DEVICE BITS
SVSYNC:	0		;COUNTER FOR HALF WORDS WHEN MAKING .SAV
			; -1 MEANS ADR COMING,0=VOICES 1-3,1=4-6
PLYADR:	0		;ADDRESS FOR PLAYER DATA IN RUN TIME
SVTEMP:	0		;TEMP FOR FIRST 3 VOICES
PLYCNT:	0		;COUNT OF BLOCK OF PLAYER DATA IOWD
FILSPC:	SETZB A,B
	SETZB C,F
FILSPL:	PUSHJ P,SIXBRD
	CAIE Z,":"
	JRST FILSP1
	MOVE A,ZZ
	JRST FILSPL
FILSP1:	CAIE Z,"."
	JRST FILSP2
	MOVNI F,1
	MOVE B,ZZ
	JRST FILSPL
FILSP2:	CAIL Z,40
	JRST MCOMP
	SKIPE F
	HLLOM ZZ,C
	SKIPN F
	MOVEM ZZ,B
	POPJ P,0

SIXBRD:	MOVEI ZZ,0
	MOVE CS,[XWD 440600,ZZ]
SIXBRL:	TTCALL 4,Z
	CAIL Z,175
	MOVEI Z,12
	CAIN Z,15
	JRST SIXBRL
	CAIL Z,140
	TRZ Z,40
	CAIL Z,101
	CAIL Z,133
	SKIPA
	JRST SIXBR1
	CAIL Z,60
	CAIL Z,72
	POPJ P,0
SIXBR1:	SUBI Z,40
	TLNE CS,770000
	IDPB Z,CS
	JRST SIXBRL
;***** START OF PLAYER.MAC *****

IFNDEF MCOMP,<TITLE PLAYER - EXEC MODE - EDIT DATE 17 NOV 69 - RCC

RIM10B
PLYORG=140
LOC PLYORG

A=1
B=2
C=3
D=4
E=5
F=6
G=7
P=17
>
IFDEF MCOMP,<
SUBTTL PLAYER IMAGE

PLYORG=140

PLYIMG:

PHASE PLYORG	;WHERE PLAYER LIVES WHEN RUNNING
>

MTOP=37174
TENDMP=37400
IFNDEF JIFSEC,<JIFSEC=^D60>	;WORLD-WIDE COMPUTABILITY

DEFINE PARTM (N) <
P'N:	ADDI N,.-.
PBIT==1
REPEAT 6-N,<PBIT==PBIT+PBIT>
	TLNE N,1
	TROA 0,PBIT
	TRZ 0,PBIT
>

DEFINE SET (N) <
	ILDB 15,16
PP'N:	MOVE 15,BOT+400(15)
	HRRM 15,P'N
>

DEFINE ADJUST (N) <
	HRRZ 16,P'N
	IMULI 16,3
	ADD N,16
>
PLAYER:	JRST RELOAD
WAIT:	MOVEI P,PPDL
	DATAI B
	JUMPL B,.-1
	TLNE B,200000
	JRST PLAYQ
	TLNE B,2000
	JRST TENDMP
	TLNE B,100000
	JRST TUNE
	TLNE B,60000
	JRST PREAD
	TLNE B,10000
	JRST RDI1
	TLNE B,30
	JRST APPEND
	JRST WAIT+1

APPEND:	SKIPE IS
	SKIPA E,WHERE
PREAD:	MOVSI E,MUST-MTOP
	MOVSI C,1
	MOVEI D,1000
	TLNN B,2
	JRST READ1-1
	HRRZ D,B
	CAIGE D,40
	JRST WAIT
	IDIV C,D

READ1:	HRRM C,TDIDL
	CONO PTR,20
	SETZM WDCNT
	SETZM IS
	SETZM MTOP+1
	SETZM MTOP
	SETZM WHERE
	MOVEI C,607751	;PDP1 JUMP BLOCK
	MOVEM C,CKSUM
WORDS:	PUSHJ P,GBW		;GET TIME FOR THIS SET OF FREQS
	JUMPE C,RZERO
	HRROS C
TDIDL:	IMULI C,1000
	ASH C,-3
WORDM:	MOVEM C,MUST(E)
	AOBJP E,OFLO
	PUSHJ P,GBW		;GET FIRST 3 VOICES
	MOVS A,C
	TLNE B,40010	;3 PART OR 6 PART?
	JRST .+3	;3 PART
	PUSHJ P,GBW	;6 PART, GET NEXT 3 VOICES
	ADD A,C
	MOVEM A,MUST(E)
	AOBJN E,WORDS

OFLO:	JRST PLAY

RZERO:	SKIPN WHERE
	MOVEM E,WHERE
	JRST WORDM

PLAYQ:	SKIPN IS
	JRST WAIT
PLAY:	DATAI C
PLAY1:	TLZ C,-2
	MOVEI 17,0
	TLZN C,1
	JRST J
	CAIGE C,100
	JRST WAIT
	HRRM C,PTEMPO
	JRST J
PTEMPO:	IDIVI 15,1000		;ADR MAY BE MODIFIED
	DATAI 16
	JUMPL 16,WAIT
	ADDI 17,2
	ADJUST 1
	ADJUST 2
	ADJUST 3
	ADJUST 4
	ADJUST 5
	ADJUST 6

PQ:	PARTM 1
	PARTM 2
	PARTM 3
	PARTM 4
	PARTM 5
	PARTM 6
	AOJL 15,PQ

J:	MOVE 16,J1
	SET 1
	SET 2
	SET 3
	SET 4
	SET 5
	SET 6

	MOVE 15,MUST(17)	;NEGATIVE DURATION
	JUMPN 15,PTEMPO
	JRST WAIT		;HERE AT END OF MUSIC

J1:	POINT 6,MUST+1(17)
J2:	POINT 3,B,17
WHERE:	XWD MUST-MTOP,0
GBW1:	MOVEM C,WDCNT
	PUSHJ P,RPB	;18 BIT READ TO C
	SUBM C,WDCNT	;LA-FA

GBW:	SOSL WDCNT
	JRST RPB	;POPJ'S TO CALLER
	MOVE D,CKSUM	;END OF BLOCK
	PUSHJ P,RPB	;READ CKSUM
	CAME C,D
	JRST 4,WAIT	;CKSUM ERROR
	CLEARM CKSUM
	PUSHJ P,RPB	;1ST WD OF BLK
	TRNN C,400000
	JRST GBW1	;POSITIVE. DIO.
GBW2:	SETOM IS	;JMP BLOCK
GBW3:	DATAI B
	TLNE B,60030
	JRST GBW3	;WAIT FOR OPR TO TURN OFF SW
	SOJA P,WAIT

RPB:	MOVE F,RDC1
	MOVEI C,0
RPB1:	DATAI G
	JUMPL G,GBW3	;ABORT READ
	CONSO PTR,10
	JRST RPB1
	DATAI PTR,G
	TRZN G,200	;BINARY 8 HOLE
	JRST RPB1	;NO. FEED. SKIP.
	TRZE G,100	;7 HOLE?
	JRST 4,.+1	;YES. SHOULDNT BE
	IDPB G,F	;ASSEMBLE 18 BIT WD
	TLNE F,770000
	JRST RPB1	;MORE TO GO
	EXCH C,CKSUM
	ADD C,CKSUM
	CAIL C,-1
	SUBI C,-1	;PDP1 IS 1'S COMP
	EXCH C,CKSUM
	POPJ P,0
TUNE:	HRL 0,B
	HRRZM B,DETUN
	MOVE C,J2
	MOVNI D,PP6-J
TUNE1:	ILDB A,C
	IMULI A,100
	ADDI A,BOT
	HRRM A,PP6+2(D)
	ADDI D,PP2-PP1
	JUMPL D,TUNE1
	DATAI D
	TLNE D,100000
	JRST .-2
	JRST WAIT

RELOAD:	HRLZ 0,DETUN
	JRST RDI+1

RDI:	MOVSI 0,444444
	MOVEI P,PPDL

RDI1:	SETZM TAB
	SETZM TAB+1
	CONO 200000
	CONO PI,10000
	MOVE A,RC1
	MOVEM A,42
	MOVEI C,0
	MOVEI D,P6-P1
	HRRM C,PQ(D)
	SUBI D,P2-P1
	JUMPGE D,.-2
	MOVSI 15,400000
	MOVNI 14,JIFSEC
	CONO PI,12300
	CONO 3000
	CONSO 1000
	JRST .-1
	CONO 1001
	JRST PQ
BK0:	0
	CONO 1001
	AOJGE 14,BK1
	JRST 12,@BK0

BK1:	CONO PI,11577
	CONO 0
	HRRZ A,BK0
	SUBI A,PQ
	TLZ 15,400000
	IMULI 15,J-PQ
	ADD A,15
	MOVE C,T1
	MOVE D,T2
	DIV C,A
	MOVE B,C
	MOVEI A,TABX

BK1A:	HRRM A,BK1B
	MOVEI E,13
BK1B:	MOVEM C,.-.(E)
	MUL C,MAGIC
	SOJGE E,.-2
	ASH B,-1
	MOVE C,B
	SUBI A,14
	CAIL A,TAB
	JRST BK1A
	MOVEM C,13(A)
	MOVEI A,TAB-BOT-2
	MOVE C,BOT+100(A)
	MUL C,DTC0
	MOVEM C,BOT(A)
	SOJGE A,.-3
	DATAI D
	TLNE D,10000
	JRST .-2
	JRST WAIT
IS:	IFDEF MCOMP,<-1>
	IFNDEF MCOMP,<0>
DTC0:	377400000000
DETUN:	444444
RDC1:	XWD 220600,C
RC1:	JSR BK0
WDCNT:	0
CKSUM:	0
T1:	0
T2:	147320000000
MAGIC:	361503374705	;2**(-1/12)

BOT=MAGIC+1
TAB=BOT+700
TABT=TAB+77
TABX=TABT-14
PPDL=TAB+100
MUST=PPDL+20

PLYLEN=.-PLAYER

IFDEF MCOMP,<	DEPHASE>

IFNDEF MCOMP,<	END RDI>

;***** END OF PLAYER.MAC *****
SUBTTL MORE DATA STORAGE
;VARIABLES FOR PHASE 2

L:	0		;MEASURE NUMBER
MN1:	0
MN2:	0
NO:	0		;FREQUENCY OF NOTE.
NPT:	0		;NUMBER OF PARTS
NWD:	0
NWR:	0
PBWZ:	0		;TEMP STORAGE OF AN AC
Q:	0
R:	0
RR:	0
SWX1:	0
TEMPO:	0
TERROR:	0		;TIME ERROR - DIFFERENCE BET PARTS
Y:	0
Z0:	0
Z1:	0
PUTI:	0
PUTJ:	0
PUTIS:	0
PUTJS:	0
PUTX:	HRLM G,@PNOTE
PUTXJ:	HRRM G,@PNOTE
PUTY:	SKIPA
PUTYJ:	CAIE G,600000

;POINTERS TO WRIT TABLE, EACH PART. RH IS COUNTER FOR
; EACH STORE. LH + RH IS INDEX TO WRIT
MARG:	0
	XWD 21,0
	XWD 43,0
	XWD 65,0
	XWD 107,0
	XWD 131,0
	XWD 153,0
	XWD 175,0

PART:	BLOCK 10
BILD:	BLOCK 10		;LH: 0-77 = TONE
WRIT:	BLOCK 220

;POINTERS TO DYNAMIC STORAGE

SJOBFF:	0
BAR:	0		;ADDRESS OF END OF PHASE 1'S TABLE BAR(A)
PNOT:	XWD A,0		;PHASE 1 NOT(A)
ALL:	0		;LENGTH OF PHASE 1'S TABLE NOT(A)
PNOTE:	XWD A,0		;PHASE 2 TABLE NOTE(A)
LENGTH:	0		;LENGTH OF PHASE 2 TABLE NOTE(A)
;STORAGE AREAS

BEAT:	BLOCK 10
BEATI:	BLOCK 10
BEATJ:	BLOCK 10
SAVAC2:	BLOCK 17

POB:	BLOCK 3

PLL=40

PL:	BLOCK PLL

LIT

VAR

MCEND:	END MCOMP