Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50011/mcomp.mac
There are no other files named mcomp.mac in the archive.
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,FCT
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