X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fmusic%2Fprog%2FMUSIC.PA;fp=sw%2Fmusic%2Fprog%2FMUSIC.PA;h=543f5ae08e700db27909fa7b3f8c6aa63ec26715;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/music/prog/MUSIC.PA b/sw/music/prog/MUSIC.PA new file mode 100644 index 0000000..543f5ae --- /dev/null +++ b/sw/music/prog/MUSIC.PA @@ -0,0 +1,2108 @@ + + +/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 + /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 + /FILL IN 10 TO RUN UNDER OS/8 + /FILL IN 20 FOR PAPER TAPE INPUT ONLY + +IFNDEF CORE + /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 + /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 +IFNZRO CPU-1>> +IFNZRO OS8-10> +IFNZRO CORE-100>> + +IFZERO CORE-400 < +IFNZRO CPU-4 > + +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 +> + +*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 +> + +/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 +IFZERO CPU-2 +IFZERO CPU-4 > +MDEFAULT=30^74%2 /C=60 +T64=0 +IFDEF WOW +IFZERO CPU-1 + +/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 + +*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 +> + +/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 /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 + +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 + +/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? + +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 + +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 + +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 + +/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 + +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 + +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 + +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 + +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 +>> + +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 + +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 + +/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 + +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 +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 + +/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 +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 +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 +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 +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 +IFZERO CPU-2 < T1+T2+15 > +OCTAL> + JMS I [GET /GET DURATION + SNA CLA + JMP NEXHOL /IT'S A LONG ONE +IFDEF WOW +IFZERO CPU-2 < T1+3135 > +OCTAL> + TAD CHAR /NOW WE WANT TO MULTIPLY DURATION +IFNZRO CPU-4 +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 +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 +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 +IFNDEF WOW + 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 + +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 +IFZERO CPU-2 < T1+T2+T2+270 > +OCTAL > + JMS I [GET +IFNZRO CPU-4 +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 +IFZERO CPU-2 < T1+T3+90 > +OCTAL > + JMS DIV /DIVIDE + DCA HOSAVE + TAD LOFUDG + DCA LOTIM +IFDEF WOW +IFZERO CPU-2 < T1+T3+30 > +OCTAL> + JMS DIV /DIVIDE LO + DCA LOSAVE +IFDEF WOW +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 + 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 +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 + 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 + +/THE FIRST TASK IS TO FIGURE OUT WHICH NOTE +/WILL BE NEXT TO FINISH ONE CYCLE. +PLAYIT, +IFDEF WOW +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 +IFNZRO CPU-4 + 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 +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 +IFZERO CPU-1 + ISZ SAVE + JMP .-2 +TRYAGN, DCA OLDE + SKP +NOISA, NOISE +IFZERO CPU-1 + ISZ SAVS +IFNZRO CPU-1 +IFZERO CPU-1 + JMP PLAYIT +> + + +DELA, TAD AC + DCA AT +IFZERO CPU-4 + JMP RA +DELB, TAD BC + DCA BT +IFZERO CPU-4 + JMP RB +DELC, TAD CC + DCA CT +IFZERO CPU-4 + JMP RC +DELD, TAD DC + DCA DT +IFZERO CPU-4 + JMP RD + +PAGE + +SPECIA, TAD XJMPT /JUMP TO SPECIAL ROUTINE + DCA AXA + TAD I AXA + DCA WSA + JMP I WSA + +SETN, +IFDEF WOW +IFZERO CPU-2 < T1+T2+570 > +OCTAL> + STA /REMEMBER NO MORE NOTES NOW +IFNDEF WOW +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 +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 + 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 +C4, "C-"Q +C5, +IFZERO OS8-10 +IFNZRO OS8-10 +IFZERO CPU-1 < +FUDGE, -2 /HALF OF 4 +> +IFZERO CPU-2 < +FUDGE, -33 /ABOUT HALF OF 55 +>> + +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 + +/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 + +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 + +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 +> +$