--- /dev/null
+\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
+>
+$
projects / pdp8.git / blobdiff