/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 > $