Add README.md

[pdp8.git] / sw / music / prog / MUSIC.PA

\f
\f
/MUSIC COMPILER
/RICH WILSON, 1975
/FOR CCL USE: SAVE SYS MUSIC;201=400

VERSION=3

/CONFIGURATION SECTION:
/	THE FOLLOWING MUST BE FILLED IN TO CUSTOMIZE THE
/	MUSIC COMPILER/PLAYER AS DESIRED.
/	OF THE MANY POSSIBLE CONFIGURATIONS, ONLY SOME
/	HAVE BEEN TRIED, AND OTHERS ARE NOT GUARANTEED
/	TO ASSEMBLE OR FUNCTION PROPERLY.

IFNDEF CPU <CPU=1>
	/FILL IN 1 FOR PDP-8/E (ALSO 8/F, 8/M)
	/FILL IN 2 FOR PDP-8/A (WITH CORE MEMORY)
	/FILL IN 4 FOR PDP-8/I OR OLD PDP-8

IFNDEF OS8 <OS8=10>
	/FILL IN 10 TO RUN UNDER OS/8
	/FILL IN 20 FOR PAPER TAPE INPUT ONLY

IFNDEF CORE <CORE=400>
	/FILL IN 100 FOR 4K SYSTEM (PAPER TAPE ONLY)
	/FILL IN 200 FOR 8K OR LARGER SYSTEM
	/FILL IN 400 FOR 12K OR LARGER SYSTEM
	/(ENABLES SPECIAL PLAYER)

IFNDEF NOISE <NOISE=CAF>
	/FILL IN THE SINGLE CYCLE INSTRUCTION WHICH IS
	/TO BE USED TO CREATE NOISE.  FOR 8/E OR 8/A WITHOUT
	/AN RX01, TRY CAF.  FOR OTHER SYSTEMS, TRY IOF.
	/DO NOT USE AN INSTRUCTION WHICH TAKES LONGER
	/THAN 1.5 MICROSECONDS.

IFZERO OS8+CORE-110 <ILLEGAL CONFIGURATION>
IFNZRO CPU-1<IFNZRO CPU-2<IFNZRO CPU-4<
ILLEGAL CONFIGURATION>>>
IFNZRO OS8-10<IFNZRO OS8-20<ILLEGAL CONFIGURATION>>
IFNZRO CORE-100<IFNZRO CORE-200<IFNZRO CORE-400<
ILLEGAL CONFIGURATION>>>

IFZERO CORE-400 <
IFNZRO CPU-4 <WOW=10>>

MARGIN=4	/DO WE CATCH FIELD CHANGES IN TIME?
AC7776=CLL STA RAL
AC4000=CLA STL RAR
AC0002=STL CLA RTL
BRANCH=JMS I [BRAN0
IFZERO OS8-10 <
DECODE=5
FETCH=1
>
\f
*20
WSA,	0
WSB,	0
WSC,	0

CHAR,	0
NOTE,	0	/-1 FOR REST THROUGH 6 FOR G
NOTEV,	0	/POINTER TO #! TABLE:KEYTAB
THIRD,	0	/-1 FOR 1/THIRD TIME
PAREN,	0	/-1 WHEN ( FOUND
OCTAVE,	0	/REMEMBER + AND -
THISLE,	0	/LENGTH THIS TIME
TOTLEN,	0	/LENGTH OF NOTE
ACC,	0	/REMEMBER ACCIDENTALS
NOTCNT,	0	/COUNT OF NOTES TO PRODUCE
OUTBUF,	-1
PROTAB,
TIMA,	ZBLOCK	3
TIMB,	ZBLOCK	3
TIMC,	ZBLOCK	3
TIMD,	ZBLOCK	3
Y,	0	/# OF Y'S SO FAR
L,	0	/# OF LINE FEEDS SINCE Y
TFLAG,	0	/-1 TO PRINT LINE
MINFLG,	0	/-1 TO SUBTRACT NOTES
TRANSP,	0
RTRAN,	0
OUTFLG,	0
PROTND,	/THE END OF WORKING LOCATIONS TO BE ZEROED
IFZERO OS8-10 <
INCHCT,	-1	/-# CHARACTERS IN BLOCK
INEOF,	1	/NON-ZEOR FOR EOF
INFPTR,	7617	/PNTR TO INPUT INFO
INCTR,	0	/-LENGTH IN BLOCKS
INPTR,	0	/BUFFER POINTER
INSAVE,	0	/HALF OF CHAR 3
>
\f
/WORKING STORAGE FOR MUSIC MAKER

DECIMAL
/THE FOLLOWING NUMBERS ALL REPRESENT TENTHS OF A MICROSECOND
IFDEF WOW <
IFZERO CPU-1 <
JIFFY=50
T1=316
T2=290
T3=3044	/DIVIDE TIME
TIM6=7
T6A=4
>
IFZERO CPU-2 <
JIFFY=60
T1=375
T2=330
T3=3600
TIM6=10
T6A=55		/TIM6*64-(DOIT TIME)
>>
OCTAL
IFNDEF WOW <
IFZERO CPU-1 <TIM6=26>
IFZERO CPU-2 <TIM6=26>
IFZERO CPU-4 <TIM6=36>>
MDEFAULT=30^74%2	/C=60
T64=0
IFDEF WOW <T64=1>
IFZERO CPU-1 <T64=1>
\f
/WORKING LOCATIONS
*10
AXA,	VERSION
LINE=AXB
AXB,	0
AXC,	0
LOWAIT,	0
OOPS,	0
LIMIT,	0
BUFTAB,	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
\f
*77

/SOME MAGIC NUMBERS
/USED TO FIGURE METER: HOW MANY 6.4US UNITS
/ARE THERE IN ONE MINUTE DIVIDED BY TWO?
IFNZRO T64 <
LOFUDG,	3214
HOFUDG,	2170
>
/AND IN 6.0US UNITS?
IFZERO T64 <
LOFUDG,	5500
HOFUDG,	2304
>
IFDEF WOW <

/AND THE MAGIC SUBROUTINE
DOIT,	0
	TAD I	DOIT	/HOW LONG 'TILL NEXT CALL?
	DCA	LIMIT	/REMEMBER
	CDF	10
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	.+3	/YES
	TAD	(JIFFY	/NO, UPDATE AC
	JMP	.-3	/AND TRY AGAIN
	DCA	OOPS	/SAVE ERROR
IFZERO CPU-1 <
	ISZ	BUFGET	/NOW HOW MANY SPIKES?
	JMP	.+3
	JMP	.+2	/COVER SKIP
NOISA,	NOISE		/MAKE A SPIKE
	ISZ I	BUFGET
	JMP	.-2	/ANOTHER SPIKE
	ISZ	BUFGET
	SKP		/COVER ISZ SKIP
	NOP		/MAKING UP FOR TIMING ERROR
>
IFZERO CPU-2 <
	ISZ	BUFGET
	SKP
	NOP
	TAD I	BUFGET
	DCA	LOWAIT
	ISZ	BUFGET
	JMP	.+3
	JMP	.+2
NOISA,	NOISE
	ISZ	LOWAIT
	JMP	.-2
>
	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
>
\f
/ALTERNATE RESTART ADDRESS TO BEGIN PLAYING
*0
	NOP
	JMP	PLAY	/GO PLAY
	NOISA		/ADDRESS OF NOISE, FOR CONVENIENCE
FIX,	-TIM6
	CPU+OS8+CORE	/FOR CONVENIENCE

*200
/BEGINNING OF EVERYTHING

START,
IFZERO OS8-10 <
IFDEF WOW <SKP;SKP>	/LEAVE ROOM FOR RESTORE TRAP
	JMS	OSDEC	/CALL COMMAND DECODER
>
START1,	TLS		/BRING UP PRINTER FLAG
	JMS	KEYC	/DEFAULT TO KEY OF C
	TAD	(BUFTBL-1
	DCA	BUFTAB
	TAD I	BUFTAB	/AUTO-INDEX
	DCA	OUTBUF	/BEGINNING OF BUFFER
	TAD I	BUFTAB
	DCA	LIMIT	/END OF BUFFER
IFNZRO CORE-100 <
	TAD I	BUFTAB
	DCA	OUTCDF	/FIELD OF BUFFER
CORINI,	JMS	INIT	/INITIALIZE CORE SIZE, ETC.
>
	TAD	[LINBUF-1
	DCA	LINE
	TAD	(PROTAB-PROTND	/CLEAR OUT ALL THE NOTES
	DCA	WSA	/AND OTHER THINGS
	TAD	(PROTAB-1
	DCA	AXA
	DCA I	AXA
	ISZ	WSA
	JMP	.-2

/INITIALIZE AFTER ; OR CR

START2,	DCA	NOTCNT

/INITIALIZE FOR NEXT NOTE

	DCA	THIRD
	DCA	PAREN
	DCA	TOTLEN
	DCA	MINFLG

/INITIALIZE FOR NEXT NOTE IN CHORD

START5,	BRANCH		/JMP BASED ON NEXT INPUT CHAR
	BRANA
\f
NEXNOT,	ISZ	PAREN	/ARE WE IN A CHORD?
	SKP
	JMP	DEFCH2	/YES
	DCA	TOTLEN	/NO-ANOTHER LENGTH
TIE,	BRANCH
	BRANB

TRIPLE,	STA
	DCA	THIRD	/REMEMBER IT'S A TRIPLET
	JMP	TIE

MINUS,	STA		/SUBTRACT NOTE DURATIONS
	DCA	MINFLG
	JMP	TIE

KEYF,	AC7776		/DEFINE FLATS
KEYS,	IAC		/DEFINE SHARPS
	DCA	WSC
	JMS	GETEQ	/BUMP PAST =
	JMP	BADLINE
	JMS	KEYC	/RESET TO KEY OF C
KEYL,	JMS	GETNOTE	/IS THERE A NOTE?
	JMP	BADLINE	/NO
	TAD	WSC
	DCA I	NOTEV	/REMEMBER SHARP/FLAT
	JMS	IN
	TAD	(-",
	SNA CLA		/IS THERE ANOTHER?
	JMP	KEYL	/YES
	TAD	CHAR	/NO
	JMP	START5	/DO SOMETHING ELSE

LENG,	IAC		/GRACE NOTE!
	ISZ	THIRD	/DID HE SAY TRIPLET?
	JMP	ADDLEN	/NO
	JMS	BADSTAR	/YES-THAT'S NO GOOD
	JMP	LENG

LENB,	IAC		/SEMI-BREVE
LENM,	IAC		/MINIM
LENC,	IAC		/CROTCHET
LENQ,	IAC		/QUAVER
LENS,	IAC		/SEMI-QUAVER
LEND,	CMA
	DCA	WSA
	STL RAL
	ISZ	THIRD	/THIRD TIME?
	STL
	RAL
	ISZ	WSA
	JMP	.-2
ADDLEN,	ISZ	MINFLG	/DO WE SUBTRACT?
	SKP		/NO
	CIA		/YES
	DCA	THISLEN	/LENGTH THIS NOTE
	TAD	THISLEN
	TAD	TOTLEN
	SPA SNA		/DID HE SUBTRACT TOO MUCH?
	JMP	ADDNEG	/YES
	DCA	TOTLEN		/TOTAL LENGTH
	JMS	GETNOTE	/IS THERE A NOTE YET?
	JMP	.+3	/NO, SOMETHING ELSE I GUESS
NMODS,	BRANCH		/YES, NOW WHAT?
	BRANE
	TAD	CHAR
	BRANCH
	BRAND

PUTNO,	JMS	BADSTA	/OUT OF CORE!
	JMS	MSG	/PRINT LAST LINE
	JMS	CRLF
	TAD	("$
	JMS	TYPE
	JMS	CRLF
	JMP	ENDM	/NOW PLAY IT

/DOTTED NOTES:
DOT,	TAD	THISLEN
	STL
	SMA		/FIX LINK TO SIGN OF NUMBER
	CLL
	RAR		/DIVIDE BY TWO
	SZL		/VALID?
ADDNEG,	JMS	BADSTA	/NO
	JMP	ADDLEN

PAGE
\f
/DEFINE METER:
/METER IS SAVED AS 12 BIT LENGTH*METER/2

DEFM,	ISZ	PAREN	/DEFINE METER
	SKP
	JMP	BADLINE	/OOPS--INSIDE A (?
	JMS	DECIN	/GET METER
	SNA
	JMP	BADLINE	/MUST BE VALID
	DCA	DEFM2
	TAD	TOTLEN	/LENGTH OF NOTE
	CLL RAR
	DCA	WSB
	JMS	MUL	/MULTIPLY
DEFM2,	.-.
	DCA	WSB
	TAD	(4	/DEFINE METER CODE
	JMS	OUT
	TAD	WSB
	RTR
	RTR
	RTR
	JMS	OUT	/HIGH ORDER
	TAD	WSB
	JMS	OUT	/LOW ORDER
	JMS	LIMTST	/TEST FOR END OF BUFFER AREA
	JMP	DEFV

/LEFT PAREN FOUND (
DEFCHO,	ISZ	PAREN
	SKP
	JMS	BADSTA	/NESTED ((
DEFCH2,	STA
	DCA	PAREN
	JMS	GETNOTE	/WE SHOULD HAVE A NOTE
	JMP	BADLINE	/OOPS
	JMP	NMODS	/NOW TRY FOR "!+=

/ACCIDENTALS
ACCF,	CLL STA RTL	/FLAT
ACCS,	TAD	(2	/SHARP
	TAD	ACC
	DCA	ACC
	JMP	NMODS
ACCN,	IAC		/NATURAL
	DCA	ACC
OCTMOR,	BRANCH		/LOOK FOR +-
	BRANF

OCTUP,	TAD	(30	/FOUND +
OCTDN,	TAD	(-14	/FOUND -
	TAD	OCTAVE
	DCA	OCTAVE
	JMP	OCTMOR	/ARE THERE MORE?
\f
PPRODU,	ISZ	PAREN	/WE SHOULD BE INSIDE ) HERE
	JMS	BADSTA
	BRANCH
	BRANG

SPRODU,	ISZ	PAREN	/WAS THERE A PAREN?
	JMP	PRODUCE	/NO, OK
	JMS	BADSTA	/YES--NO ) THOUGH
PRODUC,	TAD	NOTE
	SPA CLA		/REST?
	JMP	PRO7	/YES
	TAD	ACC
	SMA		/FLAT?
	CLL RAR		/NO, DIVIDE BY TWO
	SNA		/MAYBE ZERO IF NATURAL
	SZL		/NON-ZERO LINK IF NATURAL
	SKP
	TAD I	NOTEV	/GET DEFAULT #!"
	DCA	ACC	/-1 FOR !,1 FOR #
	TAD	NOTE
	TAD	(BASTAB
	DCA	NOTE
	TAD I	NOTE	/GET NOTE NUMBER
	TAD	ACC	/#!
	TAD	OCTAVE	/+-
	TAD	TRANSPOSE	/DID HE REQUEST TRANSPOSE
PRO3,	SMA		/MAKE SURE IT IS WITHIN RANGE
	JMP	PRO4
	TAD	(14
PRO3A,	DCA	WSB
	JMS	BADSTA	/OUT OF RANGE
	TAD	WSB
	JMP	PRO3
PRO4,	TAD	(-117
	SPA
	JMP	PRO6
	TAD	(117-14	/OUT OF RANGE
	JMP	PRO3A
PRO6,	TAD	(117
	DCA	NOTE
PRO7,	TAD	(PROTAB
	DCA	WSA
	TAD	(-4
	DCA	WSB
PRO8,	TAD I	WSA
	SNA CLA		/SPACE IN THE TABLE?
	JMP	PRO9	/YES
	ISZ	WSA	/GO TO NEXT ENTRY
	ISZ	WSA
	ISZ	WSA
	ISZ	WSB	/END?
	JMP	PRO8	/NO
	JMS	BADSTA	/TRYING TO PLAY 5 NOTES
	JMP	PROA

PAGE
\f
PRO9,	ISZ	NOTCNT	/COUNT HOW MANY
	TAD	TOTLEN
	DCA I	WSA
	ISZ	WSA
	STA
	DCA I	WSA	/SET FLAG SO WE WILL
	ISZ	WSA	/PROCESS NOTE LATER
	TAD	NOTE
	DCA I	WSA	/REMEMBER PITCH
	TAD	CHAR
PROA,	TAD	(-",
	SNA CLA		/DO WE EXPECT MORE NOTES?
	JMP	NEXNOT	/YES
PROB,	TAD	NOTCNT
	SNA
	JMP	START2	/THERE ARE NO NOTES TO WORRY ABOUT
	CIA
	DCA	NOTCNT
	TAD	(PROTAB
	DCA	WSA
	TAD	(-4
	DCA	WSB

/FIRST WORRY ABOUT NOTES WHICH MUST BE CHANGED TO RESTS
PUT0,	TAD I	WSA
	ISZ	WSA
	ISZ	WSA
	SZA CLA		/IS THIS A TIMED OUT NOTE?
	JMP	PUT2	/NO
	ISZ I	WSA	/IS IT A REST?
	JMP	PUT3	/NO-BETTER MAKE IT ONE
PUT1,	STA
	DCA I	WSA	/REMEMBER IT IS REST
PUT2,	JMS	LIMTST	/TEST FOR END OF BUFFER AREA
	ISZ	WSA
	ISZ	WSB
	JMP	PUT0	/GO FOR MORE
	TAD	(PROTAB	/START OVER AGAIN
	DCA	WSA
	TAD	(-4
	DCA	WSB

/NOW WORRY ABOUT OUR NEW NOTES
PUT4,	TAD I	WSA
	ISZ	WSA
	SZA CLA		/ACTIVE NOTE?
	JMP	PUT6	/YES
PUT5,	ISZ	WSA	/GO TO NEXT ENTRY
	ISZ	WSA
	ISZ	WSB
	JMP	PUT4
	HLT		/HLT HERE MEANS BUG
\f
PUT3,	TAD	(10	/DEFINE A REST
	TAD	WSB	/NOTE #
	STL RAL
	JMS	OUT
	JMP	PUT1

PUT6,	ISZ I	WSA	/FLAG SET?
	JMP	PUT5	/NO, IGNORE IT
	JMS	LIMTST	/TEST FOR END OF BUFFER AREA
	ISZ	WSA
	TAD I	WSA
	SPA CLA		/REST?
	JMP	PUT7	/YES
	TAD	RTRAN	/GET AUTOMATIC TRANSPOSE
	TAD I	WSA	/AND NOTE
/THERE ARE MORE THAN 64 NOTES, BUT ONLY 6 BITS
/TO REMEMBER WITH. SO WE DO THIS:
	AND	[7700	/IN RANGE?
	SNA
	JMP	PUT6A	/NOTHING TO DO
	SMA CLA
	TAD	(10
	TAD I	WSA	/TAD IN PITCH
	AND	(70	/GET TRANSPOSE AMOUNT
	DCA	RTRAN	/SAVE IT
	TAD	RTRAN
	TAD	(6	/PUT IN FUNCTION CODE
	JMS	OUT	/STASH IT IN BUFFER
	TAD	RTRAN
	CIA
	DCA	RTRAN
PUT6A,	TAD	(10
PUT7,	ISZ	NOTCNT	/LAST NOTE?
	TAD	(4
	TAD	(4
	TAD	WSB	/NOTE #
	STL RAL
	JMS	OUT
	TAD I	WSA
	TAD	RTRAN	/AUTOMATIC TRANSPOSE
	SMA		/REST?
	JMS	OUT	/NO, REMEMBER PITCH
	CLA CLL
	TAD	NOTCNT
	SZA CLA		/LAST NOTE?
	JMP	PUT5+1	/NO, GO FOR MORE
	JMP	PUT9
\f
/CHECK FOR THE END OF THE BUFFER SPACE
LIMTST,	0
	CLA CLL
	TAD	OUTBUF
	TAD	LIMIT
	SNL CLA		/AT OR NEAR END?
	JMP I	LIMTST	/OK
IFNZRO CORE-100 <
	TAD I	BUFTAB	/AUTO-INDEX
	SNA		/IS THERE MORE BUFFER AREA?
	JMP	PUTNO	/NO
	DCA	LIMIT	/LIMIT OF BUFFER IN THIS FIELD
	TAD	(14	/CODE FOR FIELD SWITCH
	JMS	OUT
	TAD I	BUFTAB	/CDF NEW FIELD
	DCA	OUTCDF
	DCA	OUTBUF	/START AT LOCATION ZERO
	DCA	OUTFLG
	JMP I	LIMTST
>
IFZERO CORE-100 <
	JMP	PUTNO
>

PAGE
\f
PUT9,	AC4000
	DCA	THISLEN

/NOW FIGURE OUT WHAT THE SHORTEST TIME LEFT
/IS OF THE FOUR NOTES, AND SUBTRACT THAT
/TIME FROM ALL NOTES
	TAD	TIMA
	JMS	SMALL
	TAD	TIMB
	JMS	SMALL
	TAD	TIMC
	JMS	SMALL
	TAD	TIMD
	JMS	SMALL
	TAD	TIMA
	SZA
	TAD	THISLEN
	DCA	TIMA
	TAD	TIMB
	SZA
	TAD	THISLEN
	DCA	TIMB
	TAD	TIMC
	SZA
	TAD	THISLEN
	DCA	TIMC
	TAD	TIMD
	SZA
	TAD	THISLEN
	DCA	TIMD
	TAD	THISLEN
	CIA
	JMS	OUT	/OUTPUT LENGTH

/NOW IF IT WAS LONGER THAN 64, WE NEED TO REMEMBER THAT
	TAD	THISLEN
	RTR
	RTR
	RTR
	AND	[77
	TAD	[7700
	DCA	WSA
	JMS	LIMTST	/CHECK FOR END OF BUFFER AREA
	AC0002
	ISZ	WSA	/WAS IT TOO LONG?
	JMS	OUT	/YES--CREATE LONGER NOTE
	SNA	CLA
	JMP	.-5
	JMP	START2	/GO FOR MORE

NEXLIN,	ISZ	TFLAG	/ERROR?
	SKP
	JMS	MSG	/YES-PRINT LINE
	TAD	[LINBUF-1
	DCA	LINE	/RESET BUFFER POINTER
	ISZ	L	/COUNT LINES
	JMP	START5
	JMP	START5
\f
DEFY,	TAD	TIMA	/WE FOUND A Y
	TAD	TIMB	/ARE ALL NOTES TIMED OUT?
	TAD	TIMC
	TAD	TIMD
	SZA CLA
	JMS	BADSTA	/NOTES DID NOT FINISH TOGETHER
	DCA	TIMA	/WHETHER THEY ARE OR NOT,
	DCA	TIMB	/WE WILL MAKE THEM SO
	DCA	TIMC
	DCA	TIMD
	ISZ	Y
	NOP
	DCA	L
	JMS	GETEQ	/IS THERE AN =
	JMP	DEFV	/NO
	JMS	DECIN	/GET DECIMAL #
	SZA
	DCA	Y	/SAVE IT

DEFV,	TAD	CHAR
	BRANCH		/LOOK FOR END OF LINE
	BRANC

DECIN,	0		/DECIMAL INPUT
DECIN1,	DCA	WSB
	JMS	IN
	TAD	(-"9-1
	CLL
	TAD	(12
	DCA	AXA
	SNL
	JMP	DECIN2
	JMS	MUL
	12
	TAD	AXA
	JMP	DECIN1
DECIN2,	TAD	WSB
	JMP I	DECIN
\f
SPACE,	0
	TAD	[240
	JMS	TYPE
	JMP I	SPACE

CRLF,	0
	TAD	(215
	JMS	TYPE
	TAD	(212
	JMS	TYPE
	JMP I	CRLF

TYPE,	0
	ISZ	COFLG	/CTRL/O?
	JMP	TYPENO	/YES-NO PRINTING
	TSF
	JMP	.-1
	TLS		/TYPE CHARACTER
TYPENO,	CLA
	KRS		/LASTLY TYPED CHARACTER
	AND	[177	/REMOVE PARITY
	TAD	(-"O+300
	SNA CLA		/IS IT CTRL/O?
	KSF		/AND IS FLAG SET?
	STA
	DCA	COFLG	/REMEMBER FLAG FOR NEXT TIME
	JMP I	TYPE
COFLG,	-1

PAGE
\f
IFZERO OS8-20 < IFNDEF WOW <
REMEM=.
*HOFUDG+1
>>
SMALL,	0	/FIND SMALLEST LENGTH
	SNA
	JMP I	SMALL	/IGNORE ZEROES
	TAD	THISLEN
	SMA
	JMP	SMALL2
	CIA		/FOUND A SMALLER ONE
	TAD	THISLEN
	DCA	THISLEN
SMALL2,	CLA
	JMP I	SMALL

IFZERO OS8-10 <
OSDEC,	0		/CALL OS8 COMMAND DECODER
	CIF	10
	JMS I	C7700
	DECODE
	"M-300^100+"U-300	/.MU DEFAULT
	STA
	DCA	INCHCT
	IAC
	DCA	INEOF	/CAUSE AN END OF FILE
	TAD	(7617	/INIT FILE POINTER
	DCA	INFPTR
	JMP I	OSDEC

OSIN,	0
INCHAR,	ISZ	INJMP	/UNPACKING SWITCH
	ISZ	INCHCT	/ANY MORE CHARACTERS?
INJMPP,	JMP	INJMP	/YES
	TAD	INEOF
	SNA CLA		/EOF?
	JMP	INGBUF	/NO-GO READ
GETNEW,	JMS	INNEWF	/GO TO NEXT FILE
	JMP	ENDM	/NO MORE FILES
INGBUF,	ISZ	INCTR
	SKP
	ISZ	INEOF	/WE'RE ON LAST BLOCK
	JMS I	INHNDL	/READ FROM INPUT
	200		/ONE BLOCK
INBUFP,	INBUF
INREC,	0
	JMP	INERRX
INBREC,	ISZ	INREC	/GO TO NEXT BLOCK
	TAD	(-600-1
	DCA	INCHCT
	TAD	INJMPP
	DCA	INJMP
	TAD	INBUFP
	DCA	INPTR
	JMP	INCHAR
INERRX,	ISZ	INEOF
C7700,	SMA CLA		/FATAL ERROR?
	JMP	INBREC	/END OF FILE
	HLT		/I/O ERROR
INJMP,	HLT		/UNPACKING JUMP
	JMP	ICHAR1
	JMP	ICHAR2
	TAD	INJMPP
	DCA	INJMP
	TAD I	INPTR
	AND	(7400
	CLL RTR
	RTR
	TAD	INSAVE
	RTR
	RTR
	ISZ	INPTR
	JMP	INCOMN
ICHAR2,	TAD I	INPTR
	AND	(7400
	DCA	INSAVE
	ISZ	INPTR
ICHAR1,	TAD I	INPTR
INCOMN,	AND	[177
	TAD	(-32	/CTRL/Z?
	SNA
	JMP	GETNEW	/TIME FOR NEXT FILE
	TAD	(232
	JMP I	OSIN

/GO TO NEXT INPUT FILE
INNEWF,	0
	TAD	(INDEVH+1
	DCA	INHNDL
	CDF	10
	TAD I	INFPTR
	CDF
	SNA
	JMP I	INNEWF	/NO MORE INPUT FILES
	CIF	10
	JMS I	C7700	/FETCH HANDLER
	FETCH
INHNDL,	.-.
	HLT
	CDF	10
	TAD I	INFPTR
	AND	(7760
	SZA
	TAD	(17
	STL RTR
	RTR
	DCA	INCTR
	ISZ	INFPTR
	TAD I	INFPTR
	CDF
	DCA	INREC
	ISZ	INFPTR
	DCA	INEOF
	STA
	DCA	INCHCT
	ISZ	INNEWF
	JMP I	INNEWF
IFDEF WOW <
RESTR2,	0
	JMS I	[RESTOR
	STA
	TAD	RESTR2
	DCA	RESTR2
	JMP I	RESTR2
>>
IFNZRO OS8-10 <
OSIN,	0
CH1,	TAD	[-20	/SET FOR DELAY OF A WHILE
	DCA	CHAR
CH2,	KSF		/ANYTHING AT LOW SPEED?
	JMP	CH3	/NO
	KRB		/YES-GET IT
	JMP I	OSIN	/AND RETURN

CH3,	RSF		/ANYTHING AT HIGH SPEED?
	JMP	CH4	/NO
	RRB RFC		/YES, GET IT
	JMP I	OSIN	/AND RETURN

CH4,	ISZ	CH5
	JMP	CH2
	ISZ	CHAR
	JMP	CH2
	LAS
	SNA CLA
	RFC		/TRY TO START THE READER
	CLA		/IN CASE OF FUNNY INTERFACES
	JMP	CH1
CH5,	0
>

PAGE
IFZERO OS8-20 < IFNDEF WOW <
*REMEM
>>
\f
BRAN0,	0		/BRANCH BASED ON CHARACTER
	DCA	CHAR	/MAYBE USE CHAR IN AC
	STA
	TAD I	BRAN0
	DCA	AXA
	TAD	CHAR
	SNA
	JMS	IN
	CLA SKP
BRAN1,	ISZ	AXA
	TAD I	AXA
	SMA
	SKP CLA
	TAD	CHAR
	SZA CLA
	JMP	BRAN1
	TAD I	AXA
	DCA	WSA
	JMP I	WSA	/BRANCH!

GETEQ,	0		/SKIP IF NEXT CHAR IS =
	JMS	IN
	TAD	(-"=
	SNA CLA
	ISZ	GETEQ
	JMP I	GETEQ

KEYC,	0		/SET TO KEY OF C
	TAD	(KEYTAB-1
	DCA	AXA
	TAD	(-10
	DCA	WSA
	DCA I	AXA
	ISZ	WSA
	JMP	.-2
	JMP I	KEYC

GETNOT,	0		/GET A NOTE
	JMS	IN
	TAD	(-"G-1
	CLL
	TAD	("G-"A+1
	SNL
	JMP	GETNR
GETN2,	DCA	NOTE
	TAD	NOTE
	TAD	(KEYTAB+1
	DCA	NOTEV
	DCA	OCTAVE	/CLEAR OUT +-
	DCA	ACC	/CLEAR ACCIDENTALS
	ISZ	GETNOTE
	JMP I	GETNOTE
\f
GETNR,	TAD	("A-"R
	SZA CLA
	JMP I	GETNOTE	/NO NOTE
	STA
	JMP	GETN2

/GET A CHARACTER, AND REMEMBER IN CASE OF ERROR
IN,	0
	JMS	OSIN
	AND	[177
	TAD	[200
	DCA	CHAR
	TAD	CHAR
	TAD	(-212
	SZA
	TAD	(-3
	SNA
	JMP	IN2	/CR OR LF
	TAD	(215-340
	CLL
	TAD	(340-240
	SNL CLA
	JMP	IN+1	/INVALID CHARACTER-IGNORE
IN2,	TAD	LINE
	TAD	(-LINBUF-100+2
	SPA CLA		/SOMEWHAT LONG?
	JMP	.+3
	TAD	[LINBUF-1	/YES, START OVER
	DCA	LINE
	TAD	CHAR
	DCA I	LINE	/SAVE IN LINE BUFFER
	TAD	CHAR
	TAD	(-240
	SNA CLA
	JMP	IN+1	/IGNORE(BUT PRINT) SPACES
	TAD	CHAR
	JMP I	IN

BADLIN,	JMS	BADSTA	/PRINT "*"
	JMP	DEFV	/FIND NEXT LINE

BADSTA,	0
	CLA
	TAD	LINE
	DCA	WSA
	TAD I	WSA	/GET LAST CHARACTER
	DCA I	LINE	/MOVE IT OVER
	TAD	("*
	DCA I	WSA	/PUT * IN LINE
	STA
	DCA	TFLAG	/PRINT THIS LINE
	JMP I	BADSTA	/RETURN
\f
/T=  :  TRANSPOSE
DEFT,	JMS	GETEQ	/BUMP OVER EQUAL
	JMP	BADLINE	/OOPS, NONE
	JMS	DECIN	/GET DECIMAL NUMBER
	TAD	(-144	/T=100 IS NO TRANSPOSE
	DCA	TRANSPOSE
	JMP	DEFV	/IGNORE REST OF LINE

PAGE
\f
ENDM,	JMS	OUT	/OUTPUT END CODE (0)
	JMP I	[PLAY	/NOW GO AND PLAY
IFDEF WOW < IFZERO OS8-10 <
*.-1			/UNLESS THIS IS ASSEMBLED
	TAD	[7600	/SINCE WE USE FIELD ONE AS A
	DCA	WSA	/4K BUFFER, WE MUST SAVE THE
	TAD	(SAVBUF-1
	DCA	AXA	/OS/8 STUFF WHICH IS THERE.
SAVEL,	CDF	10
	TAD I	WSA
	CDF
	DCA I	AXA
	ISZ	WSA
	JMP	SAVEL
	TAD I	[7600
	DCA	MSG
	TAD	(JMS I [RESTR2
	DCA I	[7600	/SET RESTART TRAP
	TAD	(JMS I	[RESTR2
	DCA I	[START
	JMP I	[PLAY	/NOW, WE CAN PLAY MUSIC!

RESTOR,	0		/SUBROUTINE TO RESTORE THE
	TAD	[7600	/TOP PAGE OF FIELD ONE
	DCA	WSA
	TAD	(SAVBUF-1
	DCA	AXA
RESTOL,	TAD I	AXA
	CDF	10
	DCA I	WSA
	CDF
	ISZ	WSA
	JMP	RESTOL
	TAD	MSG	/RESTORE 7600
	DCA I	[7600
	TAD	(SKP
	DCA I	[START
	JMP I	RESTOR
>>

MSG,	0		/PRINT LINE
	TAD	Y
	JMS	DECOUT	/PRINT Y NUMBER
	JMS	SPACE
	TAD	L
	JMS	DECOUT	/PRINT L NUMBER
	JMS	SPACE
	TAD	[LINBUF-1
	DCA	AXA
MSG1,	TAD	(-76
	DCA	WSA
MSG2,	TAD I	AXA
	JMS	TYPE
	TAD	AXA
	CIA
	TAD	LINE
	SNA CLA
	JMP I	MSG
	ISZ	WSA
	JMP	MSG2
	JMS	CRLF
	JMP	MSG1

OUT,	0
IFNZRO CORE-100 <
OUTCDF,	CDF	00 >
	AND	[77
	ISZ	OUTFLG
	JMP	OUT2
	TAD I	OUTBUF
	DCA I	OUTBUF
	ISZ	OUTBUF
	JMP	OUT3
OUT2,
IFNZRO CPU-4 <BSW>
IFZERO CPU-4 <
	CLL RTL
	RTL
	RTL
>
OUT3,	DCA I	OUTBUF
IFNZRO CORE-100 < CDF >
	TAD	OUTFLG
	CIA
	DCA	OUTFLG
	JMP I	OUT

DECOUT,	0
	SNA
	JMP	DECO2
	DCA	WSB
	TAD	(DECO9
	DCA	WSA
	JMS	DECO6
	SNA
	JMP	.-2
	TAD	("0
	JMS	TYPE
	JMS	DECO6
	JMP	.-3
DECO2,	TAD	("0
	JMS	TYPE
	JMP I	DECOUT

DECO6,	0
	DCA	WSC
DECO7,	TAD I	WSA
	SNA
	JMP I	DECOUT
	STL
	TAD	WSB
	SZL
	JMP	DECO8
	DCA	WSB
	ISZ	WSC
	JMP	DECO7
DECO8,	CLA
	ISZ	WSA
	TAD	WSC
	JMP I	DECO6

/MULTIPLY:AC=WSB*(JMS+1)
MUL,	0
	TAD	(-14
	DCA	WSA
	TAD I	MUL
	ISZ	MUL
MUL2,	CLL RAL
	SZL
	TAD	WSB
	ISZ	WSA
	JMP	MUL2
	JMP I	MUL

PAGE
\f
/THE START OF THE PLAYING PART OF THE COMPILER
PLAY,	DCA	FLG	/RESET PACKING FLAG
	TAD	(BFR1
	DCA	TRAN
IFDEF WOW <
	CDF	10
	DCA	AXB	/START OFF WITH A LONG
	DCA	BUFGET	/PAUSE (.84 SEC)
	STL RAR
	DCA I	BUFGET
	STA
	DCA I	AXB
	CDF
	DCA	OOPS
>
IFNDEF WOW <
	STA
>
	DCA	SAVS	/DON'T START WITH POP
	TAD	(BUFTBL-1
	DCA	BUFTAB
	TAD I	BUFTAB
	DCA	GETPTR
IFNZRO CORE-100 <
	ISZ	BUFTAB
	TAD I	BUFTAB
	DCA	GETCDF
>
	TAD	(MDEFAULT
	JMP	DOM1	/SET METER DEFAULT
RESTM,
IFDEF WOW <DECIMAL
	JMS	DOIT	/A REST...
IFZERO CPU-1 <	T1+158 >
IFZERO CPU-2 <	T1+180 >
OCTAL>
	TAD	(2000	/LOW FREQUENCY
	DCA I	AXA
	DCA I	AXA	/NO SPIKES
NEXT1,	STA
	DCA I	AXA	/KEEP SIMULTANEOUS NOTES
NEXT,
IFDEF WOW <DECIMAL
	JMS	DOIT	/IN PHASE
IFZERO CPU-1 <	T1+T2+190 >
IFZERO CPU-2 <	T1+T2+225 >
OCTAL>
	JMS I	[GET	/WHAT DO WE DO?
	CLL RAR
	SNL
	JMP	SPECIAL	/SOMETHING SPECIAL
	RTR
	AND	(7	/WHAT DO?
	TAD	(JMPTAB
	DCA	WSA
	TAD I	WSA	/GET DISPATCH ADDRESS
	DCA	WSA
IFDEF WOW <DECIMAL
	NOP
	JMS	DOIT
IFZERO CPU-1 <	T1+140 >
IFZERO CPU-2 <	T1+165 >
OCTAL >
	TAD	CHAR
	AND	(6	/WHICH NOTE?
	CLL RAL
	TAD	(NOTTAB-1
	DCA	AXA
	JMP I	WSA	/NOW DISPATCH

REST,
IFDEF WOW <DECIMAL
	JMS	DOIT	/DO A REST
IFZERO CPU-1 <	T1+158 >
IFZERO CPU-2 <	T1+180 >
OCTAL>
	TAD	(2000
	DCA I	AXA	/LOW FREQUENCY
	DCA I	AXA	/NO SPIKES
NEXT2,	STA
	DCA I	AXA	/KEEP SIMULTANEOUS NOTES
IFDEF WOW <DECIMAL
	JMS	DOIT	/IN PHASE
IFZERO CPU-1 <	T1+T2+12 >
IFZERO CPU-2 <	T1+T2+15 >
OCTAL>
	JMS I	[GET	/GET DURATION
	SNA CLA
	JMP	NEXHOL	/IT'S A LONG ONE
IFDEF WOW <DECIMAL
	JMS	DOIT
IFZERO CPU-1 <	T1+2678 >
IFZERO CPU-2 <	T1+3135 >
OCTAL>
	TAD	CHAR	/NOW WE WANT TO MULTIPLY DURATION
IFNZRO CPU-4 <BSW>
IFZERO CPU-4 <
	CLL RTL		/BY LENGTH OF A "G" IN
	RTL		/HOSAVE,LOSAVE (IN UNITS OF A
	RTL >		/6.4 MICROSECOND)
	DCA	WSB
	TAD	(-6
	DCA	WSA
	DCA	LOTIM
	DCA	HOTIM
	JMP	NEXLUP
/NOW WE'RE ALL SET TO MULTIPLY
NEXSH,	TAD	LOTIM
	CLL RAL
	DCA	LOTIM
	TAD	HOTIM
	RAL
	DCA	HOTIM
NEXLUP,	TAD	WSB
	RAL
	DCA	WSB	/BIT OF MULTIPLIER IN L
	SNL
	JMP	NEXNO2	/NO ADDING TO DO
	TAD	LOSAVE
	TAD	LOTIM
	DCA	LOTIM
	CML RAL		/REMEMBER CARRY!
	TAD	HOSAVE
	TAD	HOTIM
	DCA	HOTIM
IFNDEF WOW <NEXNO2,>
NEXNO,	ISZ	WSA
	JMP	NEXSH
	JMP	NEXINI	/DONE MULTIPLYING
IFDEF WOW <
NEXNO2,	TAD		/WASTE TIME
	DCA
	TAD
	DCA
	AND I	AXA	/NEED AUTO-INDEX FOR EXTRA .2US
	JMP	NEXNO
>

NEXHOL,
IFDEF WOW <DECIMAL
	JMS	DOIT	/HOLD FOR 64 "G"S
IFZERO CPU-1 <	T1+270 >
IFZERO CPU-2 <	T1+315 >
OCTAL>
	TAD	LOLONG
	DCA	LOTIM
	TAD	HOLONG
	DCA	HOTIM
NEXINI,	TAD	AR	/REMEMBER HOW MANY
	TAD	BR	/SPIKES IN ALL
	TAD	CR
	TAD	DR
IFDEF WOW <CIA>
IFNDEF WOW <CMA>
	DCA	RTOT
IFNDEF WOW <
	KRB		/WHAT WAS THE LAST CHARACTER TYPED?
	AND	(177	/MASK PARITY
	TAD	(-3	/CHECK FOR CTRL/C
	SNA		/IS IT?
IFZERO OS8-10 < JMP I [7600 >	/YES, RETURN TO MONITOR
IFNZRO OS8-10 < JMP START>	/YES, READ ANOTHER TAPE
	TAD	("C-"Q
	SNA CLA		/IS IT A CTRL/Q?
IFZERO OS8-10 < JMP DOEND2 >	/YES, GO TO NEXT PIECE
IFNZRO OS8-10 < JMP START  >	/YES, GO TO READ ANOTHER TAPE
>
	JMP	PLAY2	/AND GO PLAY!

PAGE
\f
DIVP=LOLONG
DIVM=HOLONG

/GIVEN THE DESIRED SPEED (12 BITS) AND
/(HOFUDG,LOFUDG) (24 BITS), CALCULATE
/HOW LONG A "G" IS (24 BITS) AND PUT
/IT IN (HOSAVE,LOSAVE)
DOMETE,
IFDEF WOW <DECIMAL
	JMS	DOIT
IFZERO CPU-1 <	T1+T2+T2+232 >
IFZERO CPU-2 <	T1+T2+T2+270 >
OCTAL >
	JMS I	[GET
IFNZRO CPU-4 <BSW>
IFZERO CPU-4<
	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
IFDEF WOW <DECIMAL
	JMS	DOIT
IFZERO CPU-1 <	T1+T3+78 >
IFZERO CPU-2 <	T1+T3+90 >
OCTAL >
	JMS	DIV	/DIVIDE
	DCA	HOSAVE
	TAD	LOFUDG
	DCA	LOTIM
IFDEF WOW <DECIMAL
	JMS	DOIT
IFZERO CPU-1 <	T1+T3+26 >
IFZERO CPU-2 <	T1+T3+30 >
OCTAL>
	JMS	DIV	/DIVIDE LO
	DCA	LOSAVE
IFDEF WOW <DECIMAL
	JMS	DOIT
IFZERO CPU-1 <	T1+1124 >
IFZERO CPU-2 <	T1+1320 >
OCTAL>
	TAD	(-6
	DCA	WSA	/WE MUST NOW SHIFT IT 6
	TAD	HOSAVE	/PLACES TO THE LEFT
	DCA	HOLONG	/FOR LONG NOTES
	TAD	LOSAVE
	SKP
DOM2,	TAD	LOLONG
	CLL RAL
	DCA	LOLONG
	TAD	HOLONG
	RAL
	DCA	HOLONG
	ISZ	WSA
	JMP	DOM2
	JMP I	[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
IFDEF WOW <	NOP >		/FOR TIMING
	TAD	DIVM	/MINUS DIVISOR
	DCA	HOTIM
	SNL		/DID WE OVER-SUBTRACT?
	JMP	DIVD	/YES, WE'LL START ADDING DIVISOR
IFDEF WOW <	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
IFDEF WOW<AND>
	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
IFDEF WOW <	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,
IFDEF WOW <DECIMAL
	JMS	DOIT	/DO TRANSPOSE
IFZERO CPU-1 <	T1+128 >
IFZERO CPU-2 <	T1+150 >
OCTAL>
	TAD	CHAR
	AND	(70
	TAD	(BFR1
	DCA	TRAN
	JMP I	[NEXT

/GET A BYTE FROM THE INFO BUFFER
GET,	0
IFNZRO CORE-100 <
GETCDF,	CDF	00	>
	TAD I	GETPTR
IFNZRO CORE-100 <CDF>
	ISZ	FLG
	JMP	GETL
	ISZ	GETPTR
	AND	[77
	DCA	CHAR
IFDEF WOW <
	NOP
	NOP
>
	JMP	GET2

GETL,
IFNZRO CPU-4<	BSW >
IFZERO CPU-4 <
	RTR
	RTR
	RTR
>
	AND	[77
	DCA	CHAR
	STA
	DCA	FLG
GET2,	TAD	CHAR
	JMP I	GET

PAGE
\f
/THE FIRST TASK IS TO FIGURE OUT WHICH NOTE
/WILL BE NEXT TO FINISH ONE CYCLE.
PLAYIT,
IFDEF WOW <DECIMAL
	JMS	DOIT
IFZERO CPU-1 <	T1+1128 >
IFZERO CPU-2 <	T1+1335 >
OCTAL>
	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

/WELL, WE DON'T REALLY KNOW WHICH ONE, BUT
/WE DO KNOW HOW LONG IT IS.  SO WE MOVE UP
/ALL FOUR COUNTERS, RESETTING ANY WHICH
/REACH ZERO, AND REMEMBERING HOW MANY
/SPIKES WE SHOULD DO.
	TAD	RTOT
IFZERO CPU-4	<DCA SAVS>
IFNZRO CPU-4	<MQL>
	TAD	AT
	TAD	SAVE
	SNA
	JMP	DELA
	DCA	AT
IFNZRO CPU-4 <
	MQA
	TAD	AR
	MQL >
IFZERO CPU-4 <
	TAD	SAVS
	TAD	AR
	DCA	SAVS >

RA,	TAD	BT
	TAD	SAVE
	SNA
	JMP	DELB
	DCA	BT
IFNZRO CPU-4 <
	MQA
	TAD	BR
	MQL >
IFZERO CPU-4 <
	TAD	SAVS
	TAD	BR
	DCA	SAVS >

RB,	TAD	CT
	TAD	SAVE
	SNA
	JMP	DELC
	DCA	CT
IFNZRO CPU-4 <
	MQA
	TAD	CR
	MQL >
IFZERO CPU-4 <
	TAD	SAVS
	TAD	CR
	DCA	SAVS>

RC,	TAD	DT
	TAD	SAVE
	SNA
	JMP	DELD
	DCA	DT
IFNZRO CPU-4 <
	MQA
	TAD	DR
	MQL >
IFZERO CPU-4 <
	TAD	SAVS
	TAD	DR
	DCA	SAVS >
RD,	IFNZRO CPU-4 <
	MQA
	DCA	SAVS >

/AND NOW FOR A BUNCH OF FUNNY CALCULATIONS.
/HOLD ON TO YOUR HAT....
	TAD	SAVE	/HOW MANY SPIKES THIS TIME
	CLL
	TAD	LOTIM
	DCA	LOTIM	/UPDATE NOTE LENGTH
	SNL
	AND		/TIMING CORRECTOR
	SZL
	ISZ	HOTIM	/UPDATE HIGH ORDER
	SKP
	JMP I	[NEXT	/FINISHED WITH THIS NOTE
IFDEF WOW <DECIMAL
	NOP
PLAY2,	JMS	DOIT
IFZERO CPU-1 <	T1+216 >
IFZERO CPU-2 <	T1+255 >
OCTAL >
IFNDEF WOW <
	IAC
PLAY2,	>
	TAD	OLDE	/CORRECTION FACTOR FROM LAST TIME
	TAD	FIX	/HOW LONG IT IS THRU "DOIT"
	TAD	SAVS	/AND HOW MANY SPIKES WE HAVE
	SPA
	STL
	SMA		/SET UP LINK FOR +/-
	CLL
	TAD	SAVE
	SZL		/DO WE HAVE TIME?
	JMP	TRYAGN	/NO

IFDEF WOW <
/WE HAVE BEEN DEALING IN UNITS OF 6.4US.
/NOW WE CONVERT IT TO UNITS OF .1US
/BY MULTIPLYING BY 64 (SHIFT 6 PLACES)
	CIA
	TAD	[7700
	DCA	WSA
DECIMAL
	JMS	DOIT
IFZERO CPU-1 <	T1+674 >
IFZERO CPU-2 <	T1+810 >
OCTAL
	TAD	WSA
	BSW
	MQL
	MQA
	AND	[7700	/JUST LOW ORDER BYTE*64
	DCA	WSA
	JMP	SAVIT

/SINCE THERE ISN'T ENOUGH TIME BETWEEN SETS OF
/SPIKES TO GET AROUND DOIT, WE CAN'T DO THEM
/AT THE RIGHT TIME.
TRYAGN,	TAD	(+TIM6
	DCA	OLDE	/SAVE RETRY FUDGE
DECIMAL
	JMS	DOIT
IFZERO CPU-1 <	T1+268 >
IFZERO CPU-2 <	T1+315 >
OCTAL
/NOW PUT THE EXTRA SPIKES ALONG WITH
/THE PREVIOUS BATCH
	TAD	AXB
	DCA	WSA
	TAD	SAVS
	CDF	10
	TAD I	WSA
	DCA I	WSA
	TAD	SAVS
	CDF
	TAD	OLDS
	DCA	OLDS
	JMP	PLAYIT
>
IFNDEF WOW <
	CMA
	DCA	SAVE
IFNZRO CPU-1 <NOP>
IFZERO CPU-1 <AND>
	ISZ	SAVE
	JMP	.-2
TRYAGN,	DCA	OLDE
	SKP
NOISA,	NOISE
IFZERO CPU-1 <NOP>
	ISZ	SAVS
IFNZRO CPU-1 <JMP .-2>
IFZERO CPU-1 <JMP .-3>
	JMP	PLAYIT
>


DELA,	TAD	AC
	DCA	AT
IFZERO CPU-4 <AND>
	JMP	RA
DELB,	TAD	BC
	DCA	BT
IFZERO CPU-4 <AND>
	JMP	RB
DELC,	TAD	CC
	DCA	CT
IFZERO CPU-4 <AND>
	JMP	RC
DELD,	TAD	DC
	DCA	DT
IFZERO CPU-4 <AND>
	JMP	RD

PAGE
\f
SPECIA,	TAD	XJMPT	/JUMP TO SPECIAL ROUTINE
	DCA	AXA
	TAD I	AXA
	DCA	WSA
	JMP I	WSA

SETN,
IFDEF WOW <DECIMAL
	JMS	DOIT	/SET NOTE
IFZERO CPU-1 <	T1+T2+488 >
IFZERO CPU-2 <	T1+T2+570 >
OCTAL>
	STA		/REMEMBER NO MORE NOTES NOW
IFNDEF WOW <SETNM, >
SETN2,	DCA	WSB
	JMS I	[GET	/GET PITCH
	TAD	TRAN
	DCA	WSA
	TAD I	WSA	/PERIOD IN UNITS OF 6.4 US
	DCA I	AXA
	LAS		/CHECK LOUDNESS
	CMA
	AND	[77
	TAD	WSA	/LOWER NOTES NEED EMPHASIS
	CLL RAR
	TAD	XB
	DCA	WSA
	TAD I	WSA	/HOW MANY SPIKES?
	DCA I	AXA
	ISZ	WSB	/CHECK FLAG
	JMP I	XNEXT1
	JMP I	XNEXT2

IFDEF WOW < DECIMAL
SETNM,	JMS	DOIT
IFZERO CPU-1 <	T1+T2+488 >
IFZERO CPU-2 <	T1+T2+570 >
	JMP	SETN2
OCTAL>

IFZERO CORE-100 <DOFLD, >
ERR0,	HLT		/PROGRAM BUG

DOEND,
IFDEF WOW < DECIMAL
	JMS	DOIT	/WE'RE AT THE END!
IFZERO CPU-1 <	T1+114 >
IFZERO CPU-2 <	T1+135 >
OCTAL
	TAD	BUFGET	/WE MUST WAIT FOR THE
	CIA		/END OF THE MUSIC TO PLAY
	TAD	AXB
	AND	X7760
	SZA CLA
	JMP	DOEND
>
	LAS
	SPA CLA		/REPEAT?
	JMP I	[PLAY	/YES
DOEND2,
IFZERO OS8-10 <
IFDEF WOW <
	JMS I	[RESTOR >	/RESTORE TOP PAGE OF FIELD 1
	JMS I	XINNEWF	/IS THERE ANOTHER INPUT FILE?
	SKP
	JMP I	XST1	/YES, PLAY IT
	CDF	10
	TAD I	X7642	/ALT-MODE FLAG?
	CDF
	SPA CLA
	JMP I	[7600	/RETURN TO MONITOR
>
	JMP I	[START	/RETURN TO COMMAND DECODER

IFNZRO CORE-100 <
/CHANGE TO A NEW FIELD FOR INPUT INFO
DOFLD,
IFDEF WOW < DECIMAL
	JMS	DOIT
IFZERO CPU-1 <	T1+168 >
IFZERO CPU-2 <	T1+195 >
OCTAL >
	ISZ	BUFTAB
	TAD I	BUFTAB	/GET NEW FIELD
	DCA I	XGETCDF	/SAVE IT
	DCA	FLG	/RESET PACKING FLAG
	DCA	GETPTR	/START AT ADDRESS 0
	JMP I	[NEXT
XGETCD,	GETCDF
>
XA=BFR1%2
XB,	BFR2-XA
XJMPT,	JMPTB2-1
XNEXT1,	NEXT1
XNEXT2,	NEXT2
IFZERO OS8-10 <
XINNEW,	INNEWF
XST1,	START1
X7642,	7642
>
IFDEF WOW <
X7760,	7760
SAVIT,	TAD	OLDS	/CORRECT: SPIKES TAKE
	TAD	SAVS	/6.2US, NOT 6.4 US, AND
IFZERO CPU-2 <CLL RAL >
	TAD	FUDGE	/DOIT DOESN'T REALLY TAKE
	CLL RAL		/TIM6*6.4US
	TAD	WSA
	CDF	10
	DCA I	AXB	/SAVE LOW ORDER
	TAD	[7700
	MQA		/NOW WE HAVE HIGH ORDER
	SZL		/BYTE ON RIGHT SIDE OF AC
	NOP
	SNL
	IAC		/BORROW FROM LOW ORDER?
	DCA I	AXB	/SAVE AWAY HIGH ORDER
	STA
	TAD	SAVS
	DCA I	AXB	/SAVE NO. OF SPIKES
	CDF
	DCA	OLDS	/RESET RETRY COUNTERS
	DCA	OLDE
WAIT1,	CLL STA RTL
	TAD	BUFGET
	CIA
	TAD	AXB
	SZA CLA		/BUFFER FULL?
	JMP I	[PLAYIT	/NO
	MQL		/ZERO TO MQ FOR SHOW
	NOP
DECIMAL
	JMS	DOIT
IFZERO CPU-1 <	T1+238 >
IFZERO CPU-2 <	T1+285 >
OCTAL
	KRB		/LAST CHARACTER TYPED?
	AND	C1	/MASK PARITY
	TAD	C2	/CTRL/C?
	SNA
	JMP	WAIT2	/YES
	TAD	C4	/CTRL/Q?
	SNA CLA
	JMP I	C5	/YES, NEXT INPUT
	JMP	WAIT1
WAIT2,
IFZERO OS8-10 <
	JMS I	[RESTOR >	/RESTORE TOP OF FIELD 1
	JMP I	C3	/JUMP OUT

C1,	177
C2,	-"C+300
C3,
IFZERO OS8-10 <7600>
IFNZRO OS8-10 <START>
C4,	"C-"Q
C5,
IFZERO OS8-10 <DOEND2>
IFNZRO OS8-10 <START>
IFZERO CPU-1 <
FUDGE,	-2	/HALF OF 4
>
IFZERO CPU-2 <
FUDGE,	-33	/ABOUT HALF OF 55
>>
\f
BRANA,	-"#	;KEYS		/DEFINE SHARP
	-"!	;KEYF		/DEFINE FLATS
	-"V	;DEFV
	-"Y	;DEFY
	-"T	;DEFT
	-215	;START2
	-212	;NEXLIN
	-";	;START2
	-"$	;ENDM		/END MUSIC
BRANB,	-"G	;LENG
	-"D	;LEND
	-"S	;LENS
	-"Q	;LENQ
	-"C	;LENC
	-"M	;LENM
	-"B	;LENB
	-"3	;TRIPLET
	0	;BADLINE

BRANC,	-";	;PROB
	-215	;PROB
	0	;DEFV+1

BRAND,	-"=	;DEFM
	-"(	;DEFCHORD
	-"T	;TIE
	-"-	;MINUS
	-".	;DOT
	0	;BADLINE

BRANE,	-""	;ACCN
	-"#	;ACCS
	-"!	;ACCF
BRANF,	-"+	;OCTUP
	-"-	;OCTDN
	-",	;PRODUCE
	-";	;SPRODUCE
	-215	;SPRODUCE
	-")	;PPRODUCE
	0	;BADLINE

BRANG,	-",	;PRODUCE
	-";	;PRODUCE
	-215	;PRODUCE
	0	;BADLINE


KEYTAB,	ZBLOCK	10

DECO9,	DECIMAL;-1000;-100;-10;-1;0;OCTAL

/TABLE: WHERE ARE THE WHITE KEYS, A THROUGH G?
BASTAB,	36;40;41;43;45;46;50
\f
/TABLE OF BUFFER AREAS
BUFTBL,	MUSBUF
IFZERO OS8-10 < MARGIN-INBUF>
IFZERO OS8-20 < MARGIN-7600  >
IFNZRO CORE-100 <
	CDF 00
IFNDEF WOW<
	MARGIN-7600
	CDF	10>
	MARGIN-7600
	CDF	20
CORTAB=.
	MARGIN-7600
	CDF	30
	MARGIN-7600
	CDF	40
	MARGIN-7600
	CDF	50
	MARGIN-7600
	CDF	60
	MARGIN-7600
	CDF	70
	0
>
*.+1&7776
BFR1,
DECIMAL

IFNZRO T64 <

/PERIOD OF NOTES IN UNITS OF 6.4US
/USING EQUAL TEMPERAMENT
-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++++!!
>
IFZERO T64 <
/PERIOD OF NOTES IN 6.0 MICROSECOND UNITS
/USING EQUAL TEMPERAMENT

-2143;-4045;-3818;-3604;-3401;-3210
/A--
-3030;-2860;-2700;-2548;-2405;-2270
-2143;-2022;-1909;-1802;-1701;-1605
/A-
-1515;-1430;-1350;-1274;-1203;-1135
-1071;-1011;-954;-901;-850;-803
/A
-758;-715;-675;-637;-601;-568
-536;-506;-477;-450;-425;-401
/A+=A440
-379;-358;-337;-319;-301;-284
-268;-253;-239;-225;-213;-201
/A++
-189;-179;-169;-159;-150;-142
-134;-126;-119;-113;-106;-100
/A+++
-95;-89;-84;-80;-75;-71
-67;-63;-60;-56;-53;-50
-47	/A++++!!!
>
/NUMBER OF PULSES GENERATED DETERMINE LOUDNESS
BFR2,
104;97;91;84;79;74;69
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
\f
JMPTAB,	REST
	RESTM
	SETN
	SETNM
	ERR0
	ERR0
	ERR0
	ERR0

JMPTB2,	DOEND
	NEXHOL
	DOMETER
	DOTRANSPOSE
	ERR0;ERR0
	DOFLD
	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
NOPUNCH
LINBUF,	ZBLOCK 100	/SAVE INPUT TO PRINT ERROR MESSAGE
MUSBUF=.		/BEGINNING OF MUSIC BUFFER
IFZERO OS8-10 <
*6600
IFDEF WOW < SAVBUF, >	/SAVE FOR TOP OF FIELD 1
INBUF,	ZBLOCK 400	/OS/8 I/O BUFFER
INDEVH,	ZBLOCK 400	/OS/8 DEVICE HANDLER SPACE
>
ENPUNCH
\f
IFNZRO	CORE-100 <	/INITIALIZATION CODE
*LINBUF+177&7600
INIT,	0
COR0,	CDF	0
	TAD	CORSIZ
	RTL
	RAL
	AND	COR70
	TAD	COREX	/MAKE CDF FOR FIELD
	DCA	.+1	/TO BE TESTED
COR1,	CDF	.-.
	TAD I	CORLOC
COR2,	NOP
	DCA	COR1
	TAD	COR2
	DCA I	CORLOC
COR70,	70
	TAD I	CORLOC
CORX,	7400
	TAD	CORX
	TAD	CORV
	SZA CLA
	JMP	COREX
	TAD	COR1
	DCA I	CORLOC
	ISZ	CORSIZ
	JMP	COR0

CORLOC,	CORX
CORV,	1400
CORSIZ,	1
COREX,	CDF	00

IFZERO OS8-10 <
	TAD I	BATFLG
	AND	COR70	/ARE WE RESTRICTED IN CORE?
	CLL RTR
	SZA
	JMP	.+4>	/YES, IGNORE ACTUAL CORE SIZE
	STA
	TAD	CORSIZ	/TOP FIELD
	CLL RAL
	TAD	CORTBA
	DCA	WSA
IFZERO OS8-10 <
	TAD I	BATFLG	/ARE WE RUNNING UNDER BATCH?
	RTL
	SNL CLA
	JMP	COR3	/NO, OK
	TAD	BATPRO	/YES, DON'T WIPE OUT MONITOR
	DCA I	WSA
>
COR3,	ISZ	WSA
	ISZ	WSA
	DCA I	WSA	/DON'T USE FIRST NONEXISTANT FIELD
	TAD	COR2	/NOP
	DCA I	CORINA	/DON'T RETURN HERE
IFDEF WOW <
	STA
	TAD	CORSIZ
	SPA SNA CLA
	HLT		/NOT ENOUGH CORE!!
>
	JMP I	INIT

CORINA,	CORINI
BATFLG,	7777
CORTBA,	CORTAB-6
BATPRO,	MARGIN-5000
>
$