/MUSIC COMPILER /RICH WILSON, 1975 /FOR CCL USE: SAVE SYS MUSIC;201=400 AC7776=CLL STA RAL AC4000=CLA STL RAR AC0002=STL CLA RTL LINBUF=6000 PLAY=2400 DECODE=5 FETCH=1 INBUF=6600 INDEVH=7200 *10 AXA, 0 LINE, LINBUF-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 Y, 0 /# OF Y'S SO FAR L, 0 /# OF LINE FEEDS SINCE Y THIRD, 0 /-1 FOR 1/THIRD TIME PAREN, 0 /-1 WHEN ( FOUND TFLAG, 0 /-1 TO PRINT LINE OCTAVE, 0 /REMEMBER + AND - TRANSP, 0 RTRAN, 0 THISLE, 0 /LENGTH THIS TIME TOTLEN, 0 /LENGTH OF NOTE ACC, 0 /REMEMBER ACCIDENTALS NOTCNT, 0 /COUNT OF NOTES TO PRODUCE ENDF, 0 OUTBUF, -1 OUTFLG, 0 PROTAB, TIMA, ZBLOCK 3 TIMB, ZBLOCK 3 TIMC, ZBLOCK 3 TIMD, ZBLOCK 3 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 *76 BRANCH=JMS I .;BRAN0 RESTA, REST *200 /BEGINNING OF EVERYTHING START, NOP JMS OSDEC /CALL COMMAND DECODER TLS /BRING UP PRINTER FLAG JMS KEYC /DEFAULT TO KEY OF C DCA Y DCA L TAD (LINBUF-1 DCA LINE DCA TRANSPOSE DCA RTRAN DCA TFLAG DCA ENDF STA DCA OUTBUF DCA OUTFLG TAD (-14 /CLEAR OUT ALL THE NOTES DCA WSA TAD (PROTAB-1 DCA AXA DCA I AXA ISZ WSA JMP .-2 /INITIALIZE AFTER ; OR CR START2, DCA NOTCNT /INITIALIZE FOR NEXT NOTE START3, DCA THIRD DCA PAREN DCA TOTLEN /INITIALIZE FOR NEXT NOTE IN CHORD START4, 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 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 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 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 LENQ, IAC /QUAVER LENS, IAC /SEMI-QUAVER LEND, CMA DCA WSA STL RAL ISZ THIRD /THIRD TIME? STL RAL ISZ WSA JMP .-2 ADDLEN, DCA THISLEN TAD THISLEN TAD TOTLEN ADDL2, DCA TOTLEN JMS GETNOTE /IS THERE A NOTE YET? JMP .+3 /NO, SOMETHING ELSE I GUESS NMODS, BRANCH BRANE TAD CHAR BRANCH BRAND 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 PAGE 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 TAD WSB JMS OUT JMP DEFV DOT, TAD THISLEN CLL RAR /DIVIDE BY TWO SZL /VALID? JMS BADSTA /NO JMP ADDLEN 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 "!+= ACCF, CLL STA RTL ACCS, TAD (2 TAD ACC DCA ACC JMP NMODS ACCN, IAC 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 PRO5, SPA JMP PRO6 TAD (117-14 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 ISZ WSA TAD NOTE DCA I WSA /REMEMBER PITCH TAD CHAR PROA, TAD (-", SNA CLA /DO WE EXPECT MORE NOTES? JMP NEXNOT /YES TAD NOTCNT CIA DCA NOTCNT TAD (PROTAB DCA WSA TAD (-4 DCA WSB 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, ISZ WSA ISZ WSB JMP PUT0 /GO FOR MORE TAD (PROTAB /START OVER AGAIN DCA WSA TAD (-4 DCA WSB 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 ISZ WSA TAD I WSA SPA CLA /REST? JMP PUT7 /YES TAD RTRAN /AUTOMATIC TRANSPOSE TAD I WSA /NOTE JMS UPDOWN /CHECK IT OUT... 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 TAD NOTCNT SZA CLA /LAST NOTE? JMP PUT5+1 /NO, GO FOR MORE AC4000 DCA THISLEN 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 TAD THISLEN RTR RTR RTR AND (77 TAD (7700 DCA WSA AC0002 ISZ WSA /WAS IT TOO LONG? JMS OUT /YES--CREATE LONGER NOTE SNA CLA JMP .-4 JMP START2 /GO FOR MORE PAGE SMALL, 0 /FIND SMALLEST SNA JMP I SMALL TAD THISLEN SMA JMP SMALL2 CIA TAD THISLEN DCA THISLEN SMALL2, CLA JMP I SMALL OSDEC, 0 /CALL OS8 COMMAND DECODER CIF 10 JMS I C7700 DECODE "M-300^100+"U-300 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 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 TAD (-600-1 DCA INCHCT TAD INJMPP DCA INJMP TAD INBUFP DCA INPTR JMP INCHAR INERRX, ISZ INEOF C7700, SMA CLA JMP INBREC HLT INJMP, HLT JMP ICHAR1 JMP ICHAR2 ICHAR3, 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 (377 TAD (-232 SNA JMP GETNEW TAD (232 JMP I OSIN INNEWF, 0 TAD (INDEVH+1 DCA INHNDL CDF 10 TAD I INFPTR CDF SNA JMP I INNEWF CIF 10 JMS I C7700 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 MINUS, TAD THISLEN CLL RAL CIA /SUBTRACT IT OFF MINUS2, TAD TOTLEN SMA SZA JMP ADDL2 JMS BADSTA /CAN'T HAVE NEGATIVE TIME JMP MINUS2 PAGE ENDM, JMS OUT /OUTPUT END CODE JMP SAVE 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 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 STA JMP GETN2 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 IN2, TAD CHAR DCA I LINE TAD LINE TAD (-LINBUF-120 SPA CLA JMP .+3 TAD (LINBUF-1 DCA LINE TAD CHAR TAD (-240 SNA CLA JMP IN+1 TAD CHAR JMP I IN BADLIN, JMS BADSTA JMP DEFV 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 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 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 OUTCDF, CDF 10 AND (77 ISZ OUTFLG JMP OUT2 TAD I OUTBUF JMP OUT3 OUT2, ISZ OUTBUF NOP CLL RTL RTL RTL OUT3, DCA I OUTBUF CDF TAD OUTFLG CIA DCA OUTFLG JMP I OUT OCTOUT, 0 CLL RAL DCA OCTO2 TAD (-4 DCA OCTO3 OCTO1, TAD OCTO2 RTL RAL DCA OCTO2 TAD OCTO2 AND (7 TAD ("0 JMS TYPE ISZ OCTO3 JMP OCTO1 JMP I OCTOUT OCTO2, 0 OCTO3, 0 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 DECO9, DECIMAL;-1000;-100;-10;-1;0;OCTAL /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 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 TSF JMP .-1 TLS CLA JMP I TYPE SAVE, TAD (SAVE1-REST1 /SAVE 7600 & ABOVE REST, TAD (REST1 /RESTORE IT DCA WSB TAD (7600-200-3000-1 DCA AXA TAD (7600 SR1, DCA WSA SR2, JMP I WSB /GO SAVE OR RESTORE SAVE1, JMP SAVE10 /SAVE FIELD 1 JMP SAVE20 /SAVE FIELD 2 TAD 7600 /NOW FINISH UP SAVING DCA SAV70 TAD 7605 DCA SAV75 TAD (JMP I RESTA DCA 7600 TAD (JMP I RESTA DCA 7605 TAD (JMP I RESTA DCA 200 JMP PLAY SAVE10, CDF 10 SKP SAVE20, CDF 20 TAD I WSA CDF DCA I AXA SR3, ISZ WSA JMP SR2 ISZ WSB TAD (5000 /SAVE BATCH MONITOR? JMP SR1 REST1, JMP REST10 JMP REST20 TAD SAV70 DCA 7600 TAD SAV75 DCA 7605 TAD (NOP DCA 200 JMP 200 REST10, TAD I AXA CDF 10 JMP .+3 REST20, TAD I AXA CDF 20 DCA I WSA CDF JMP SR3 SAV70, 0 SAV75, 0 UPDOWN, 0 /HANDLE AUTOMATIC TRANSPOSE AND (7700 /IN RANGE? SNA JMP I UPDOWN /NOTHING TO DO UPDN2, 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 JMP I UPDOWN PAGE 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, -"; ;START2 -215 ;START2 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 /TABLE: WHERE ARE THE WHITE KEYS, A THROUGH G? BASTAB, 36;40;41;43;45;46;50 *PLAY;HLT $