C Music V, Max Mathews C C typed in from old XGP output C file last written 19Jun75 MUSIC5[M5,GM] (I believe GM = George McKee) C SAIL C C Bill Schottstaedt, 26-Apr-08 C C This is the new version that runs (5-May-08) in gfortran in Linux or the Mac. C On the Mac, I got gfortran from http://macresearch.org/xcode_gfortran_plugin_update. C You don't need the xcode plugin stuff, just the gfortran binary -- it gets C installed in /usr/local/bin. On linux, I think Fedora installed fortran for me. C Most of my changes are in lower case. C To use this program, first divide music5.f into 3 passes (cut at the dotted lines) C named, say pass1.f, pass2.f, pass3.f. Then run them through gfortran: C gfortran -o pass1 pass1.f C gfortran -o pass2 pass2.f C gfortran -o pass3 pass3.f C Now get some input, from music5-examples perhaps, run pass1 C and give it the input file name. C It writes pass1.data. Run pass2. It reads pass1.data and writes pass2.data. C Run pass3. It reads pass2.data and writes the raw (headerless) binary sound C file raw.snd. This is a file of little-endian 4-byte floats at 20000Hz, mono. C pass1 required much more serious surgery than the other 2 passes. I had to C embed the READ1 subroutine in the main program. Apparently new Fortrans C do not guarantee that subroutine locals will be saved across calls. The C other choice was an enormous COMMON block, but that became unwieldy and error-prone. C C In all passes, I replaced the arithmetic IFs, changed file IO, used characters C rather than ints, replaced MOVR with ichar(ch)-ichar('0'), and removed the C EQUIVALENCE stuff (not needed here because I'm using characters directly). C [page 1-1] -- these are the original XGP pages to help me find my place C C PASS1 PASS 1 MAIN PROGRAM C PASS1 *** MUSIC V *** THIS VERSION RUNS ON THE PDP10, JULY 14,1971 COMMON P(100),IP(10),D(2000) integer ipdp CHARACTER*32 FLNM CHARACTER*1 IBCD(300) CHARACTER*1 CARD(129) DATA NOPS,NBC,NC/26,3,72/ CHARACTER IDEC, ISTAR, IGAD DATA IDEC,ISTAR/'.','*'/ CHARACTER JSEMI, JBLANK CHARACTER*1 IBC(4) DATA IBC/';',' ',',','-'/ CHARACTER*1 IVT (4) CHARACTER*1 LOP (78) integer IDEF, I100 DATA IVT/'P','F','B','V'/ DATA LOP/'N','O','T','I','N','S','G','E','N','S','V','3', * 'S','E','C','T','E','R','S','V','1','S','V','2','P','L','F', * 'P','L','S','S','I','3','S','I','A','C','O','M','E','N','D', * 'O','U','T','O','S','C','A','D','2','R','A','N','E','N','V', * 'S','T','R','A','D','3','A','D','4','M','L','T','F','L','T', * 'R','A','H','S','E','T'/ EQUIVALENCE (JSEMI,IBC(1)), (JBLANK,IBC(2)) integer inputfile integer outputfile inputfile=1 outputfile=2 ipdp=0 idef=0 i100=1 99 FORMAT(' TYPE FILE NAME') 999 FORMAT(A5) PRINT 99 READ 999,FLNM open(inputfile, FILE=FLNM, STATUS='OLD') open(outputfile, FILE='pass1.data') C CALL IFILE(1,FLNM) C*****ABOVE 5 LINES FOR PDP10 ******** C INITIALIZATION C NOMINAL SAMPLING RATE. D(4) = 20000.0 C ERROR FLAG IP(2)=0 P(2)=0.0 CC NWRITE = 2 c NWRITE=20 C**** PDP DSK0=DEVICE 20 ****** CC REWIND NWRITE CC CALL READ0 c CALL READ1 GO TO 4321 C********PDP ******** C MAIN LOOP c 100 CALL READ1 100 GO TO 4321 4322 I1=P(1) IF (I1.GE.1.AND.I1.LE.12) GO TO 103 IP(2)=1 CC WRITE (6,200) PRINT 200 C********PDP ******** 200 FORMAT(' NON-EXISTENT OPCODE ON DATA STATEMENT') GO TO 100 c 103 GO TO (1,1,1,1,5,6,7,1,9,1,1,12),I1 c 1 CALL WRITE1 (NWRITE) c 1 call write1(outputfile) 103 go to (1010,1010,1010,1010,5,6,7,1010,9,1010,1010,12),I1 1010 call write1(outputfile) GO TO 100 5 PRINT 110 CC 5 WRITE (6, 110) C********PDP ******** 110 FORMAT(' END OF SECTION IN PASS 1') c GO TO 1 go to 1010 c 6 CALL WRITE1 (NWRITE) 6 call write1 (outputfile) C C WRITE (6, 111) PRINT 111 C********PDP ******** 111 FORMAT (' END OF PASS 1') IF(IP(2).EQ.1) CALL HARVEY close(inputfile) close(outputfile) CALL EXIT C SET VARIABLES IN PASS 1 7 I2=P(3) I3=I2+IP(1)-4 DO 104 I4=I2,I3 104 D(14)=P(14-I2+4) GO TO 100 9 I6=P(3) IF (I6.GE.1.AND.I6.LE.5) GO TO 107 IP(2)=1 CC WRITE (6,201) C [page 1-2] PRINT 201 C********PDP ******** 201 FORMAT(' NON-EXISTENT PLF SUBROUTINE CALLED') GO TO 100 c 12 CALL WRITE1 (NWRITE) 12 call write1(outputfile) GO TO 7 107 GO TO 100 c added^ C 107 GO TO (21,22,23,24,25),I6 C 21 CALL PLF1 C GO TO 100 C 22 CALL PLF2 C GO TO 100 C 23 CALL PLF3 C GO TO 100 C 24 CALL PLF4 C GO TO 100 C 25 CALL PLF5 C GO TO 100 c END C [page 2-1] C READ1 INTERPRETATIVE READING ROUTINE C**** MUSIC V **** c SUBROUTINE READ1 c COMMON P(100),IP(10),D(2000),IPDP,inputfile,outputfile,END,SNA8 c COMMON I,IDEF C*****PDP ***** IPDP WAS ADDED TO COMMON LIST IN PLACE OF ENTRY FEATURE c CHARACTER*1 IBCD(300) c CHARACTER*1 CARD(129) c DIMENSION CARD(129),IBCD(300),LOP(3,26) c CHARACTER*1 ICAR c was 30 c DIMENSION BCD(300) c DIMENSION IBC(4),IVT(4) c was 12 c EQUIVALENCE(CARD,ICAR) c EQUIVALENCE(BCD,IBCD) c DATA NOPS,NBC,NC/26,3,72/ c CHARACTER IDEC, ISTAR, IGAD c DATA IDEC,ISTAR/'.','*'/ CCC DATA IBC(1),IBC(2),IBC(3),IBC(4)/'=',' ',',','-'/ c DATA IBC(1),IBC(2),IBC(3),IBC(4)/';',' ',',','-'/ c CHARACTER JSEMI, JBLANK c CHARACTER*1 IBC(4) c DATA IBC/';',' ',',','-'/ C********NO!!!!! THE CHARACTER = HAS BEEN SUBSTITUTED FOR C THE SEMICOLON AS THE END OF STATEMENT DELIMITER c CHARACTER*1 IVT (4) c CHARACTER*1 LOP (78) c c integer IDEF c c DATA IVT/'P','F','B','V'/ c DATA LOP/'N','O','T','I','N','S','G','E','N','S','V','3', c * 'S','E','C','T','E','R','S','V','1','S','V','2','P','L','F', c * 'P','L','S','S','I','3','S','I','A','C','O','M','E','N','D', c * 'O','U','T','O','S','C','A','D','2','R','A','N','E','N','V', c * 'S','T','R','A','D','3','A','D','4','M','L','T','F','L','T', c * 'R','A','H','S','E','T'/ c ,0,0,0,0,0,0,0,0,0,0,0,0/ C********LAST 12 LOCATIONS NOT YET USED. **** PDP ******** c EQUIVALENCE (JSEMI,IBC(1)), (JBLANK,IBC(2)) C TO SCAN INPUT DATA TO #, ORGANIZE FIELDS AND PRINT 4321 CONTINUE IF(IPDP.EQ.0) GO TO 9999 C********PDP ******** IF ((END+SNA8-1.).gt.0.0) go to 90 10 IBK=2 END=0. ERR=0. NUMU=0 ISEMI=1 L=3 J=0 11 I=I+1 IF(I.GT.NC) GO TO 15 IF(J.EQ.299) GO TO 21 DO 13 N=1,NBC IF(CARD(I).NE.IBC(N)) GO TO 13 GO TO (20,16,18),N C ; BLA , 13 CONTINUE J=J+1 IBCD(J)=CARD(I) IBK=1 GO TO 11 14 IBK=N GO TO 11 CC 15 READ (5,1,ERR=95,END=95) (CARD(I),I=1,NC) C********PDP ******** c 15 READ (1,1,ERR=95,END=95) I, (CARD(I),I=1,NC) 15 READ (inputfile,1, ERR=95,END=95) I, (CARD(I),I=1,NC) C*****PDP ***** FIRST 'I' IS FOR PDP LINE NUMBERS! c 1 FORMAT(I,128A1) 1 FORMAT(128A1) PRINT 2121,(CARD(I),I=1,NC) 2121 FORMAT(1H 128A1) I=0 C [page 2-2] GO TO 11 16 GO TO (17,11,11),IBK 17 IBK=N J=J+1 IBCD(J)=JBLANK GO TO (11,21),ISEMI 18 GO TO (17,14,19),IBK 19 J=J+1 IBCD(J)=CHAR(0) GO TO 17 20 ISEMI=2 GO TO (17,21,19),IBK 21 J=J+1 IBCD(J)=JSEMI C TO SCAN FOR OP CODE DO 24 N=1,NOPS M=N DO 23 K=1,3 IX2=ICHAR(IBCD(K)) IF (IBCD(K).NE.LOP(K + ((N-1)*3))) GO TO 24 23 CONTINUE GO TO 26 24 CONTINUE GO TO 40 26 NP=1 27 L=L+1 IF (IBCD(L).NE.JBLANK) GO TO 27 29 GO TO (9100,9200,300,400,500,600,700,800,900,1000,1100,1200,1300, * 217,9201,202,203,204,205,206,207,208,209,210,211,212),M C OP CODE 1 TO PLAY NOTE 9100 P(1)=1. GO TO 30 C OP CODE 2 TO DEFINE INSTRUMENT 9200 P(1)=2. IDEF=1 N1=1 GO TO 70 2000 P(2)=XN N1=2 GO TO 70 2001 P(3)=XN IP(1)=3 GO TO 50 C OUT BOX 9201 P(3)=101. NPW=2 c IF (STER) 220,220,2011 if (STER.LE.0) go to 220 SNA8=1. STER=0 GO TO 220 C OSCILLATOR 202 P(3)=102. NPW=5 GO TO 220 C ADD 2 203 P(3)=103. NPW=3 GO TO 220 C RANDOM AND INTERPOLATE 204 P(3)=104. NPW=6 C [page 2-3] GO TO 220 C LINEAR ENVELOPE GENERATOR 205 P(3)=105. NPW=7 GO TO 220 C STEREO OUT BOX 206 P(3)=106. NPW=3 c IF(STER)220,2061,220 if (STER.NE.0) go to 220 c 2061 SNA8=1. SNA8=1. STER=1. GO TO 220 C THREE INPUT ADDER 207 P(3)=107. NPW=4 GO TO 220 C FOUR INPUT ADDER 208 P(3)=108. NPW=5 GO TO 220 C MULTIPLIER 209 P(3)=109. NPW=3 GO TO 220 C FILTER 210 P(3)=112. NPW=4 GO TO 220 C RANDOM AND HOLD 211 P(3)=111. NPW=5 GO TO 220 C SET NEW FUNCTION 212 P(3)=110. NPW=1 GO TO 220 C END OF INSTRUMENT 217 IP(1)=2 IDEF=0 END=1. GO TO 50 C UNNAMED UNIT - NUMERICAL NAME ASSUMED 218 N1=8 NUMU=1 L=0 GO TO 70 219 M=XN+14. IF(XN.LT.11.)GO TO 29 P(3)=XN C TO INTERPRET VARS IN UNIT DEFS 220 NP=3 221 IF(IBCD(L+1).EQ.JSEMI) GO TO 240 c 222 NP=NP+1 NP=NP+1 L=L+1 DO 223 N=1,4 IF(IBCD(L).EQ.IVT(N)) GO TO 225 223 CONTINUE 224 L=L+1 IF(IBCD(L).EQ.JBLANK)GO TO 46 GO TO 224 C [page 2-4] 225 GO TO (231,232,233,234),N C P TYPE 231 N1=3 GO TO 70 2311 P(NP)=XN GO TO 221 C F TYPE 232 N1=4 GO TO 70 2321 P(NP)=-(XN+100.) GO TO 221 C B TYPE 233 N1=5 GO TO 70 2331 P(NP)=-XN GO TO 221 C V TYPE 234 N1=6 GO TO 70 2341 P(NP)=XN+100. GO TO 221 240 IF(NUMU.EQ.1)GO TO 242 c 241 IF(NPW+3-NP)42,242,42 if (NPW+3-NP.NE.0) go to 42 242 IP(1)=NP GO TO 50 C OP CODE 3 - TO GENERATE FUNCTION 300 P(1)=3. GO TO 30 C OP CODE 4 -- TO SET PARAM 3RD PASS 400 P(1)=4. GO TO 30 C OP CODE 5 TO END SEC 500 P(1)=5. GO TO 30 C OP CODE 6 TO TERMINATE PIECE 600 P(1)=6. GO TO 30 C OP CODE 7 TO SET PARAM 1ST PASS 700 P(1)=7. GO TO 30 C OP CODE 8 TO SET PARAM 2ND PASS 800 P(1)=8. GO TO 30 C OP CODE 9 TO EXECUTE SUB 1ST PASS 900 P(1)=9. GO TO 30 C OP CODE 10 TO EXECUTE SUB 2ND PASS 1000 P(1)=10. GO TO 30 C OP CODE 11 TO SET INTEGER 3RD PASS 1100 P(1)=11. GO TO 30 C OP CODE 12 TO SET INTEGER ALL PASSES 1200 P(1)=12. GO TO 30 C OP CODE 13 FOR COMMENTS 1300 IF(IBCD(L).NE.JSEMI) GO TO 1301 L=L+1 go to 4321 c ? COM causes an infinite loop in the original code 1301 L=L+1 GO TO 1300 C TO STORE PFIELDS C [page 2-5] c 30 IF(IDEF)32,32,43 30 continue if (IDEF.gt.0) go to 43 32 IF(IBCD(L+1).EQ.JSEMI) GO TO 34 NP=NP+1 N1=7 GO TO 70 331 P(NP)=XN GO TO 32 34 IP(1)=NP c IF(NP-1)47,47,50 if (NP-1.gt.0) go to 50 go to 47 C ERRORS c 40 IF(IDEF)41,41,218 40 if (IDEF.gt.0) go to 218 41 L=L+1 IF(IBCD(L).NE.JSEMI)GO TO 41 PRINT 1030 1030 FORMAT(26H OP CODE NOT UNDERSTOOD) GO TO 49 42 PRINT 1040 1040 FORMAT(44H UNIT CONTAINS WRONG NUMBER OF PARAMETERS) GO TO 49 43 PRINT 1050 1050 FORMAT(36H INSTRUMENT DEFINITION INCOMPLETE) ERR=1. IDEF=0 GO TO 32 44 PRINT 1060 1060 FORMAT(25H ERROR IN NUMERIC DATA) ERR=1. IF(NUMU.EQ.1)GO TO 45 GO TO 30 45 PRINT 1070 1070 FORMAT(46H FOR UNIT DESIGNATION) P(3)=0. GO TO 220 46 PRINT 1080 1080 FORMAT(40H IMPROPER VARIABLE IN UNIT DEFINITION) ERR=1. GO TO 221 47 PRINT 1090 1090 FORMAT(24H STATEMENT INCOMPLETE) 49 IP(2)=1 GO TO 10 50 IF(ERR.EQ.1.) GO TO 49 goto 4322 c RETURN C CONVERSION OF NUMERIC FIELD TO FLOATING POINT 70 SGN=1. IF (IBCD(L+1).NE.IBC(4)) GO TO 79 SGN=-1. L=L+1 79 L1=L+1 LD=L1 XN=0. 71 L=L+1 C *** I DON'T UNDERSTAND THIS PART OF THE SCANNER! CC IF(IBCD(L).EQ.JBLANK) GO TO 77 IF (IBCD(L).EQ.JBLANK) GO TO 77 C THIS LOOKS FOR #S, LETTERS, BLANKS, DECI.PTS, & *S. OTHERWISE=ERROR!? C ******** PDP ******** IF(IBCD(L).LT.CHAR(10))GO TO 71 IF(IBCD(L).EQ.IDEC) GO TO 71 IF(IBCD(L).EQ.ISTAR) GO TO 71 C [page 2-6] 76 GO TO 71 C ERROR CHECK IS REMOVED! C** NEXT 2 LINES BY-PASSED*** 76 L=L+1 IF(IBCD(L).EQ.JBLANK) GO TO 44 GO TO 76 77 IF(IBCD(L1).NE.ISTAR) GO TO 80 XN=P(NP) GO TO 89 80 DO 81 LL=L1,L LD=LL IF (IBCD(LL).EQ.IDEC) GO TO 82 81 CONTINUE 82 IEX=0 LA=L1 LB=LD-1 c IF(LD-L1)86,86,83 if((LD-L1).LE.0) go to 86 IEX=LD-LA 84 continue c 84 CALL MOVR (IBCD,LA,LB) DO 85 LL=LA,LB IEX=IEX-1 IGAD=IBCD(LL) IX1=ICHAR(IGAD)-ICHAR('0') XN=XN+IX1*10.**IEX 85 continue c 86 IF(L-LB-2)88,88,87 86 if(L-LB-2.le.0) go to 88 LA=LD+1 LB=L-1 GO TO 84 88 XN=XN*SGN 89 GO TO (2000,2001,2311,2321,2331,2341,331,219),N1 C TO WRITE S1A8 FOR MONO STEREO CONTROL 90 P(1)=12. P(3)=8. P(4)=STER IP(1)=4 END=0. SNA8=0. GO TO 50 C FOR PREMATURE END OF FILE ON INPUT 95 NP=2 IP(2)=1 L=0 IBCD(1)=JSEMI GO TO 600 C TO INITIALIZE CC ENTRY READ0 CC READ (5,1,ERR=95,END=95) (CARD(I),I=1,NC) C********PDP ******** 9999 READ (inputfile,1,ERR=95,END=95) I,(CARD(I),I=1,NC) C*****PDP ***** FIRST 'I' IS FOR PDP LINE NUMBERS! CC WRITE (6,2) (CARD(I),I=1,NC) PRINT 2111,(CARD(I),I=1,NC) 2111 FORMAT(1H 128A1) C********PDP ******** IPDP=1 I=0 IDEF=0 IBK=2 STER=0. END=0. SNA8=0. if (i100.eq.0) go to 4322 i100=0 go to 100 c RETURN END C WRITE1 PASS 1 DATA-WRITING ROUTINE C *** MUSIC V *** SUBROUTINE WRITE1(N) COMMON P(100),IP(10),D(2000) c COMMON P(100),IP(10) K=IP(1) WRITE(N, *)K, (P(J),J=1,K) RETURN END c SUBROUTINE PLF c COMMON P(100),IP(10),D(2000) CC ENTRY PLF1 CC ENTRY PLF2 CC ENTRY PLF3 CC ENTRY PLF4 CC ENTRY PLF5 c END C ERRO1 GENERAL ERROR ROUTINE C ***MUSIC V *** SUBROUTINE ERROR(I) PRINT 8100,I 8100 FORMAT(13HERROR OF TYPEI5) RETURN END SUBROUTINE HARVEY CC WRITE (6,1) PRINT 1011 C********PDP ********* 1011 FORMAT(' WHERE IS HARVEY') CALL EXIT END c SUBROUTINE MOVR(IBCD,LA,LB) c DIMENSION IBCD(300) C DO 1 J=LA,LB C 1 IBCD(J)=IBCD(J)-ICHAR('0') C CC 1 IBCD(J)=I5-(IBCD(J))/16777216 C********PDP ******** C 1 IBCD(J)=IBCD(J)/536870912-48 C 2 DUMMY=0 C TO SET BREAKPOINT. c RETURN c END C ----------------------------------- cut here --------------------------------------------- C pass2 C PASS 2 MAIN PROGRAM C *** MUSIC V *** DIMENSION G(1000),I(1000),T(1000),D(10000),P(100),IP(10) COMMON IP,P,G,I,T,D,IXJQ,TLAST,BLAST integer inputfile integer outputfile C INITIALIZING PROGRAM C NOMINAL SAMPLING RATE, NOTE PARAMETER LENGTH, NUMBER OF CARDS C NO OF OP CODES, PASS 11 REPORT PRINT PARAMETER G(1)=0. G(2)=0. G(4)=10000.0 NPAR=10000 NCAR=1000 NOPC=12 IXJQ=0 IEND=0 C C***** NREAD=2 C C***** NWRITE=3 c NREAD=20 c NWRITE=21 c REWIND NREAD c REWIND NWRITE inputfile=1 outputfile=2 open(inputfile, FILE='pass1.data', STATUS='OLD') open(outputfile, FILE='pass2.data') C INITIALIZE SECTION 150 ID=1 IN=1 TLAST=0. BLAST=0. C READ SECTION OF DATA c 106 CALL READ2 (NREAD) 106 CALL READ2 (inputfile) I1=IP(1) D(ID)=I1 I(IN)=ID T(IN)=P(2) DO 100 I2=1,I1 I3=ID+I2 c 100 D(13)=P(I2) D(I3)=P(I2) 100 continue ID=ID+I1+1 c IF(ID-NPAR)102,102,101 IF((ID-NPAR).le.0) go to 102 101 CALL ERROR(20) STOP 102 IN=IN+1 c IF (IN-NCAR)103,103,101 IF ((IN-NCAR).gt.0) go to 101 c 103 IF (P(1)-5.0)104,110,104 IF ((P(1)-5.0).eq.0.0) go to 110 c 104 IF (P(1)-6.0)106,105,106 IF ((P(1)-6.0).ne.0.0) go to 106 c 105 IEND=1 IEND=1 GO TO 110 C SORT SECTION C*** NOT USED ****** 110 CALL SORTFL 110 IN=IN-1 c CALL SORT(T(1),T(2),IN,I) CALL SORT(T(1),IN,I) C EXECUTE OP CODES M SECTION c 120 DO 1 I4=1,IN DO 1 I4=1,IN I5=I(I4) I6=D(I5+1) c IF(I6)121,121,122 IF(I6.gt.0) go to 122 121 CALL ERROR(21) GO TO 1 c 122 IF (I6-NOPC)123,123,121 122 IF ((I6-NOPC).gt.0) go to 121 c 123 GO TO (2,2,2,2,2,2,7,8,7,10,2,8),I6 GO TO (2,2,2,2,2,2,7,8,7,10,2,8),I6 7 CALL ERROR(22) GO TO 1 C [page 3-2] 8 I7=D(I5) I8=I5+4 I9=I5+I7 I10=IFIX(D(15+3))-I8 DO 124 I11=I8,I9 I12=I10+I11 124 G(I12)=D(I11) c IF(I6-I2)1,2,1 IF((I6-I2).eq.0) go to 2 go to 1 10 I13=D(I5+3) IP(2)=I5 c IF(I13)125,125,126 IF(I13.gt.0) go to 126 125 CALL ERROR(23) GO TO 1 c 126 IF(I13-5)127,127,125 126 IF((I13-5).gt.0) go to 125 c 127 GO TO (21,22,23,24,25),I13 GO TO (21,22,23,24,25),I13 21 CALL PLS1 GO TO 1 22 CALL PLS2 GO TO 1 23 CALL PLS3 GO TO 1 24 CALL PLS4 GO TO 1 25 CALL PLS5 GO TO 1 C WRITE OUT SECTION 2 IP(1)=D(I5) I18=IP(1) DO 133 I19=1,I18 I20=I19+I5 133 P(I19)=D(I20) c CALL WRITE2 (NWRITE) CALL WRITE2 (outputfile) 1 CONTINUE C END OF SECTION OR PASS c 140 IF(IEND)141,141,143 IF(IEND.gt.0) go to 143 c 141 PRINT 142 PRINT 142 142 FORMAT (' END OF SECTION PASS II') GO TO 150 143 PRINT 144 144 FORMAT (' END OF PASS II') close(inputfile) close(outputfile) STOP END C READ2 PASS 2 DATA INPUT ROUTINE C *** MUSIC V *** SUBROUTINE READ2(N) DIMENSION IP(10),P(100) COMMON IP,P c READ(N) K,(P(J),J=1,K) READ(N, *) K,(P(J),J=1,K) IP(1)=K RETURN END C SORT SORTING PROGRAM C *** MUSIC V *** c SUBROUTINE SORT(A,B,N,L) SUBROUTINE SORT(A,N,L) DIMENSION A(N),L(N) C C SORT SORTS THE A ARRAY INTO ASCENDING NUMERICAL ORDER, PERFORMING C THE SAME OPERATIONS ON ARRAY L AS ON A C N1=N-1 C [page 3-3] DO 10 I=1,N1 IN=I+1 DO 20 J=IN,N IF(A(I).LE.A(J))GO TO 20 T=A(I) A(I)=A(J) A(J)=T NT=L(I) L(I)=L(J) L(J)=NT 20 CONTINUE 10 CONTINUE RETURN C C*********** ENTRY SORTFL C C*********** RETURN END C WRIT2 DATA OUTPUTING ROUTINE FOR PASS 2 C *** MUSIC V *** SUBROUTINE WRITE2(N) COMMON IP(10),P(100),G(1000),I(1000),T(1000),D(10000),IXJQ,TLAST, *BLAST IF(G(2).EQ.0.)GO TO 150 X=P(2) Y=P(4) ILOC=G(2) IF(P(1).NE.1.)GO TO 50 c P(4)=P(4)*60./CON(G,ILOC,P(2)) P(4)=P(4)*60./CON(G,P(2)) c 50 P(2)=TLAST+(P(2)-BLAST)*60./CON(G,ILOC,P(2)) 50 P(2)=TLAST+(P(2)-BLAST)*60./CON(G,P(2)) TLAST=P(2) BLAST=X 150 CALL CONVT K=IP(1) WRITE(N, *) K,(P(J),J=1,K) C *** PASS II REPORT IS OPTIONAL *** IF(G(1).NE.0.) RETURN IF(IXJQ.EQ.0) PRINT 100 IXJQ=10 100 FORMAT(15H1PASS II REPORT/11H0(WORD CNT)) PRINT 101,K,(P(J),J=1,K) IF(G(2).NE.0.) PRINT 102,X,Y 101 FORMAT(I8,10(F9.3)) 102 FORMAT(1H+,110X,2HB=,F7.4,2HD=,F7.4) RETURN END C CON2 PASS 2 FUNCTION INTERPOLATOR C *** MUSIC V *** c FUNCTION CON(G,I,T) FUNCTION CON(G,T) DIMENSION G(1) DO 10 J=1,1000,2 c IF (G(J)-T) 10,20,30 if ((G(J)-T).eq.0) go to 20 if ((G(J)-T).lt.0) go to 10 c 30 CON = G(J-1)+((T-G(J-2))/(G(J)-G(J-2)))*(G(J+1)-G(J-1)) CON = G(J-1)+((T-G(J-2))/(G(J)-G(J-2)))*(G(J+1)-G(J-1)) RETURN 10 CONTINUE 20 CON = G(J+1) RETURN END C CONVT FOR UNIT GENERATORS CHECK C C DUMMY NO OPERATION ACTUALLY PERFORMED C******WHEN DUMMY IS REMOVED ANOTHER CONVT MUST!!!! BE LOADED!!!***** C [page 3-4] C*** SUBROUTINE CONVT C*** COMMON IP(10),P(100),G(1000) C*** RETURN C*** END c added back in SUBROUTINE CONVT COMMON IP(10),P(100),G(1000) RETURN END C ERRO1 GENERAL ERROR ROUTINE C *** MUSIC V *** SUBROUTINE ERROR(I) PRINT 100,I 100 FORMAT(' ERROR OF TYPE',I5) RETURN END C C***** SUBROUTINE PLS C C***** ENTRY PLS1 C C***** ENTRY PLS2 C C***** ENTRY PLS3 C C***** ENTRY PLS4 C C***** ENTRY PLS5 SUBROUTINE PLS1 RETURN END SUBROUTINE PLS2 RETURN END SUBROUTINE PLS3 RETURN END SUBROUTINE PLS4 RETURN END SUBROUTINE PLS5 RETURN END C [page 4-1] C ----------------------------------- cut here --------------------------------------------- C pass3 C PASS3 PASS 3 MAIN PROGRAM C *** MUSIC V *** C DATA SPECIFICATION INTEGER PEAK DIMENSION T(50),TI(50),ITI(50) COMMON I(15000),P(100)/PARM/IP(21)/FINOUT/PEAK,NRSOR C C******** DATA IIIRD/Z5EECE66D/ DATA IP/12,512,20000,14500,14400,512,13000,35,40,6657,2048, * 1000000,6657,512,7777777,6*0/ DATA IIIRD/976545367/ C SET I ARRAY =0 (7/10/69) DATA I/15000*0/ c CHARACTER*1 JSTR(5) c CHARACTER*1 FLNM(32) integer inputfile integer outputfile C***************** C INITIALIZATION OF PIECE C ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU inputfile=1 outputfile=2 open(inputfile, FILE='pass2.data', STATUS='OLD') c open(outputfile, FILE='pass3.data') open(outputfile, * FILE='raw.snd', * form='unformatted', * access='direct', * status='replace', * recl=4) I(7)=IIIRD IP9=IP(9) PEAK=0 NRSOR=0 C********NREAD=3 C********NWRITE=2 c NREAD=21 C PDP DSK1=DEV.21 c NWRITE=1 C PDP DSK=DEV.1 c REWIND NREAD c REWIND NWRITE c PRINT 10001 c READ 10002,FLNM,IDSK C PRINT 'PASS2' OR FILENAME + ANY POS.NUMB. TO WRITE SMPLS ON DSK. c IF(FLNM.EQ.' '.OR.FLNM.EQ.'PASS2')FLNM='FOR21' c CALL IFILE(21,FLNM) c IF(IDSK.LE.0) GO TO 10003 c JSTR='MUSAA' c CALL PUTFILE(JSTR) C IF IDSK>=1, SAMPLES WILL BE WRITTEN ON DSK (MUSAA.DMD) c IDSK=0 IDSK=1 c GO TO 10004 c 10003 IDSK=-1 c 10001 FORMAT(' TYPE FILE NAME'/) c 10002 FORMAT(A5) C**** ABOVE FOR PDP 10 ****** c 10004 SCLFT=IP(12) SCLFT=IP(12) I(2)=IP(4) MS1=IP(7) MS3=MS1+(IP(8)*IP(9))-1 MS2=IP(8) I(4)=IP(3) MOUT=IP(10) C INITIALIZATION OF SECTION 5 T(1)=0.0 DO 220 N1=MS1,MS3,MS2 I(N1)=-1 220 CONTINUE DO 221 N1=1,IP9 TI(N1)=1000000.0 221 CONTINUE C MAIN CARD READING LOOP c 204 CALL DATA (NREAD) 204 CALL DATA (inputfile) c IF(P(2)-T(1))200,200,244 IF((P(2)-T(1)).gt.0.0) go to 244 200 IOP=P(1) c IF(IOP)201,201,202 IF(IOP.gt.0) go to 202 201 CALL ERROR(1) GO TO 204 C [page 4-2] c 202 IF(IP(1)-IOP)201,203,203 202 IF((IP(1)-IOP).lt.0) go to 201 c 203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP 11 IVAR=P(3) IVARE=IVAR+I(1)-4 DO 297 N1=IVAR,IVARE IVARP=N1-IVAR+4 297 I(N1)=P(IVARP) GO TO 204 3 IGEN=P(3) GO TO (281,282,283,284,285),IGEN 281 CALL GEN1 GO TO 204 282 CALL GEN2 GO TO 204 283 CALL GEN3 GO TO 204 284 CALL GEN4 GO TO 204 285 CALL GEN5 GO TO 204 4 IVAR=P(3) IVARE=IVAR+I(1)-4 DO 296 N1=IVAR,IVARE IVARP=N1-IVAR+4 296 I(N1+100)=P(IVARP)*SCLFT GO TO 204 c 6 CALL FROUT3(IDSK) 6 continue K=IP(10) L=IP(10)+IP(14)-1 DO 1001 J=K,L I(J)=0 1001 CONTINUE CALL SAMOUT(IDSK,IP(14), outputfile) C REWIND NWRITE C WRITE(6,10) PEAK,NRSOR C PRINT 10,PEAK,NRSOR C 10 FORMAT ('0PEAK AMPLITUDE WAS',I8/'0NUMBER OF SAMPLES OUT OF RANGE WAS',I8) C CALL EXIT IF(IDSK.LT.0)CALL EXIT J=IP(10) L=J+1024 DO 2001 K=J,L I(K)=0 2001 CONTINUE C WILL WRITE 1024 0'S ON DSK. CALL FASTOUT(I(J),1024, outputfile) c CALL FINFILE close(inputfile) close(outputfile) CALL EXIT c END c STOP C ENTER NOTE TO BE PLAYED 1 DO 230 N1=MS1,MS3,MS2 c IF(I(N1)+1)230,231,230 IF((I(N1)+1).eq.0) go to 231 230 CONTINUE CALL ERROR(2) GO TO 204 231 M1=N1 M2=N1+I(1)-1 M3=M2+1 M4=N1+IP(8)-1 DO 232 N1=M1,M2 M5=N1-M1+1 232 I(N1)=P(M5)*SCLFT I(M1)=P(3) DO 233 N1=M3,M4 233 I(N1)=0 DO 235 N1=1,IP9 c IF(TI(N1)-1000000.)235,234,235 IF(TI(N1).ne.1000000.) go to 235 c 234 TI(N1)=P(2)+P(4) TI(N1)=P(2)+P(4) ITI(N1)=M1 GO TO 204 235 CONTINUE CALL ERROR(3) GO TO 204 C DEFINE INSTRUMENT 2 M1=I(2) M2=IP(5)+IFIX(P(3)) I(M2)=M1 c 218 CALL DATA (NREAD) 218 CALL DATA (inputfile) c IF(I(1)-2)210,210,211 IF(I(1).gt.2) go to 211 c 210 I(M1)=0 I(M1)=0 I(2)=M1+1 C [page 4-3] GO TO 204 211 I(M1)=P(3) M3=I(1) I(M1+1)=M1+M3-1 M1=M1+2 DO 217 N1=4,M3 M5=P(N1) c IF(M5)212,213,213 IF(M5.ge.0) go to 213 c 212 IF(M5+100)300,301,301 IF((M5+100).ge.0) go to 301 c 300 I(M1)=-IP(2)+(M5+101)*IP(6) I(M1)=-IP(2)+(M5+101)*IP(6) GO TO 216 301 I(M1)=-IP(13)+(M5+1)*IP(14) GO TO 216 c 213 IF(M5-100)214,214,215 213 IF((M5-100).gt.0) go to 215 c 214 I(M1)=M5 I(M1)=M5 GO TO 216 215 I(M1)=M5+262144 216 M1=M1+1 217 CONTINUE GO TO 218 C PLAY TO ACTION TIME 244 T(2)=P(2) 250 TMIN=1000000. IREST=1 DO 241 N1=1,IP9 c IF(TMIN-TI(N1))241,241,240 IF(TMIN.le.TI(N1)) go to 241 c 240 TMIN=TI(N1) TMIN=TI(N1) MNOTE=N1 241 CONTINUE c IF(1000000.-TMIN)251,251,243 IF(1000000.0.le.TMIN)go to 251 c 243 IF(TMIN-T(2))245,245,246 IF(TMIN.gt.T(2)) go to 246 c 245 T(3)=TMIN T(3)=TMIN GO TO 260 246 T(3)=T(2) GO TO 260 c 247 IF(T(1)-T(2))249,200,200 247 IF(T(1).ge.T(2)) go to 200 c 249 TI(MNOTE)=1000000. TI(MNOTE)=1000000. M2=ITI(MNOTE) I(M2)=-1 GO TO 250 C SETUP REST 251 T(3)=T(2) IREST=2 GO TO 260 C PLAY 260 ISAM=(T(3)-T(1))*FLOAT(I(4))+.5 T(1)=T(3) c IF(ISAM)247,247,266 IF(ISAM.le.0) go to 247 c 266 IF(ISAM-IP(14))262,262,263 266 IF(ISAM.gt.IP(14))go to 263 c 262 I(5)=ISAM I(5)=ISAM ISAM=0 GO TO 264 263 I(5)=IP(14) ISAM=ISAM-IP(14) c 264 IF(I(8))290,290,291 264 IF(I(8).gt.0) go to 291 c 290 M3=MOUT+I(5)-1 M3=MOUT+I(5)-1 MSAMP=I(5) GO TO 292 291 M3=MOUT+(2*I(5))-1 MSAMP=2*I(5) C [page 4-4] 292 DO 267 N1=MOUT,M3 267 I(N1)=0 GO TO (268,265),IREST 268 DO 270 NS1=MS1,MS3,MS2 c IF(I(NS1)+1)271,270,271 IF((I(NS1)+1).eq.0) go to 270 C GO THROUGH UNIT GENERATORS IN INSTRUMENT c 271 I(3)=NS1 I(3)=NS1 IGEN=IP(5)+I(NS1) IGEN=I(IGEN) 272 I(6)=IGEN CC***** IF((IGEN)-101)293,294,294 CC***** 293 CALL SAMGEN(I) CC***** ABOVE FOR MACHINE LANG. UNIT GENERATORS ****** CC***** GO TO 295 c 294 CALL FORSAM CALL FORSAM c 295 IGEN=I(IGEN+1) IGEN=I(IGEN+1) c IF(I(IGEN))270,270,272 IF(I(IGEN).gt.0) go to 272 270 CONTINUE 265 CALL SAMOUT(IDSK,MSAMP, outputfile) c IF(ISAM)247,247,266 IF(ISAM.le.0) go to 247 go to 266 END C [page 5-1] C FORS3 FORTRAN UNIT GENERATOR ROUTINE C *** MUSIC V *** SUBROUTINE FORSAM DIMENSION I(15000),P(100),IP(21),L(8),M(8) COMMON I,P/PARM/IP EQUIVALENCE (M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)) EQUIVALENCE (M6,M(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)) EQUIVALENCE (L3,L(3)),(L4,L(4)),(L5,L(5)),(L6,L(6)),(L7,L(7)) EQUIVALENCE (L8,L(8)),(RN1,IRN1),(RN3,IRN3),(RN,IRN) C C***** DATA IMULT/Z5EECE66D/ DATA IIIRD/976545367/ SFI=1./FLOAT(IP(12)) SFF=1./FLOAT(IP(15)) SFID=FLOAT(IP(12)) SFXX=FLOAT(IP(12))/FLOAT(IP(15)) XNFUN=IP(6)-1 C COMMON INITIALIZATION OF GENERATORS N1=I(6)+2 N2=I(N1-1)-1 DO 204 J1=N1,N2 J2=J1-N1+1 c IF(I(J1))200,201,201 IF(I(J1).ge.0) go to 201 c 200 L(J2)=-I(J1) L(J2)=-I(J1) M(J2)=1 GO TO 204 201 M(J2)=0 c IF(I(J1)-262144)202,202,203 IF((I(J1)-262144).gt.0) go to 203 C*****WHAT DOES THE BIG NUMBER DO????? c 202 L(J2)=I(J1)+I(3)-1 L(J2)=I(J1)+I(3)-1 GO TO 204 203 L(J2)=I(J1)-262144 204 CONTINUE NSAM=I(5) N3=I(N1-2) NGEN=N3-100 GO TO (101,102,103,104,105,106,107,108,109,110,111,112),NGEN 112 RETURN C UNIT GENERATORS C OUTPUT BOX c 101 IF(M1)260,260,261 101 IF(M1.gt.0) go to 261 c 260 IN1=I(L1) IN1=I(L1) 261 CONTINUE DO 270 J3=1,NSAM c IF(M1)265,265,264 IF(M1.le.0) go to 265 c 264 J4=L1+J3-1 J4=L1+J3-1 IN1=I(J4) 265 J5=L2+J3-1 I(J5)=IN1+I(J5) 270 CONTINUE RETURN C OSCILLATOR 102 SUM=FLOAT(I(L5))*SFI c IF(M1)280,280,281 IF(M1.gt.0) go to 281 c 280 AMP=FLOAT(I(L1))*SFI AMP=FLOAT(I(L1))*SFI c 281 IF(M2)282,282,283 281 IF(M2.gt.0) go to 283 c 282 FREQ=FLOAT(I(L2))*SFI FREQ=FLOAT(I(L2))*SFI 283 CONTINUE DO 293 J3=1,NSAM J4=INT(SUM)+L4 F=FLOAT(I(J4)) C [page 5-2] c IF(M2)285,285,286 IF(M2.gt.0) go to 286 c 285 SUM=SUM+FREQ SUM=SUM+FREQ GO TO 290 286 J4=L2+J3-1 SUM=SUM+FLOAT(I(J4))*SFI C C 290 IF(SUM-XNFUN)288,287,287 290 IF(SUM.GE.XNFUN)GO TO 287 C C 287 SUM=SUM-XNFUN IF(SUM.LT.0.0)GO TO 289 288 J5=L3+J3-1 c IF(M1)291,291,292 IF(M1.gt.0) go to 292 c 291 I(J5)=IFIX(AMP*F*SFXX) I(J5)=IFIX(AMP*F*SFXX) GO TO 293 C************ 287 SUM=SUM-XNFUN GO TO 288 289 SUM=SUM+XNFUN GO TO 288 C**********ABOVE FOR FM (NEG. FREQ. TO OSCIL) 292 J6=L1+J3-1 I(J5)=IFIX(FLOAT(I(J6))*F*SFF) 293 CONTINUE I(L5)=IFIX(SUM*SFID) RETURN C ADD TWO BOX c 103 IF(M1)250,250,251 103 IF(M1.gt.0) go to 251 c 250 IN1=I(L1) IN1=I(L1) c 251 IF(M2)252,252,253 251 IF(M2.gt.0) go to 253 c 252 IN2=I(L2) IN2=I(L2) 253 DO 258 J3=1,NSAM c IF(M1)255,255,254 IF(M1.le.0) go to 255 c 254 J4=L1+J3-1 J4=L1+J3-1 IN1=I(J4) c 255 IF(M2)257,257,256 255 IF(M2.le.0) go to 257 c 256 J5=L2+J3-1 J5=L2+J3-1 IN2=I(J5) 257 J6=L3+J3-1 I(J6)=IN1+IN2 258 CONTINUE RETURN C RANDOM INTERPOLATING GENERATOR 104 SUM=FLOAT(I(L4))*SFI c IF(M1)310,310,311 IF(M1.gt.0) go to 311 c 310 XIN1=FLOAT(I(L1))*SFI XIN1=FLOAT(I(L1))*SFI c 311 IF(M2)312,312,313 311 IF(M2.gt.0) go to 313 c 312 XIN2=FLOAT(I(L2))*SFI XIN2=FLOAT(I(L2))*SFI 313 IRN1=I(L5) IRN3=I(L6) DO 340 J3=1,NSAM c IF(M1)316,316,315 IF(M1.le.0) go to 316 c 315 J4=L1+J3-1 J4=L1+J3-1 XIN1=FLOAT(I(J4))*SFI c 316 IF(M2)318,318,317 316 IF(M2.le.0) go to 318 c 317 J5=L2+J3-1 J5=L2+J3-1 XIN2=FLOAT(I(J5))*SFI c 318 IF(SUM-XNFUN)320,319,319 318 IF((SUM-XNFUN).lt.0.0) go to 320 c 319 SUM=SUM-XNFUN SUM=SUM-XNFUN I(7)=IABS(I(7)*IMULT) RN4=(2.*FLOAT(I(7))*SFF-1.) RN2=RN4-RN3 C [page 5-3] RN1=RN3 RN3=RN4 GO TO 321 320 RN2=RN3-RN1 321 J7=L3+J3-1 I(J7)=XIN1*(RN1+(RN2*SUM)/XNFUN)*SFID SUM=SUM+XIN2 340 CONTINUE I(L4)=IFIX(SUM*SFID) I(L5)=IRN1 I(L6)=IRN3 RETURN C ENVELOPE GENERATOR 105 SUM=FLOAT(I(L7))*SFI c IF(M1)380,380,381 IF(M1.gt.0) go to 381 c 380 XIN1=FLOAT(I(L1))*SFI XIN1=FLOAT(I(L1))*SFI c 381 IF(M4)382,382,383 381 IF(M4.gt.0) go to 383 c 382 XIN4=FLOAT(I(L4))*SFI XIN4=FLOAT(I(L4))*SFI c 383 IF(M5)384,384,385 383 IF(M5.gt.0) go to 385 c 384 XIN5=FLOAT(I(L5))*SFI XIN5=FLOAT(I(L5))*SFI c 385 IF(M6)386,386,387 385 IF(M6.gt.0) go to 387 c 386 XIN6=FLOAT(I(L6))*SFI XIN6=FLOAT(I(L6))*SFI 387 X1=XNFUN/4. X2=2.*X1 X3=3.*X1 DO 403 J3=1,NSAM J4=INT(SUM)+L2 F=FLOAT(I(J4)) c IF(M1)405,405,404 IF(M1.le.0) go to 405 c 404 J8=L1+J3-1 J8=L1+J3-1 XIN1=FLOAT(I(J8))*SFI c 405 IF(SUM-XNFUN)389,388,388 405 IF((SUM-XNFUN).lt.0.0) go to 389 c 388 SUM=SUM-XNFUN SUM=SUM-XNFUN c 389 IF(SUM-X1)390,390,393 389 IF((SUM-X1).gt.0.0) go to 393 c 390 IF(M4)392,392,391 IF(M4.le.0) go to 392 c 391 J4=L4+J3-1 J4=L4+J3-1 XIN4=FLOAT(I(J4))*SFI 392 SUM=SUM+XIN4 GO TO 402 c 393 IF(SUM-X2)394,394,397 393 IF((SUM-X2).gt.0.0) go to 397 c 394 IF(M5)396,396,395 IF(M5.le.0) go to 396 c 395 J5=L5+J3-1 J5=L5+J3-1 XIN5=FLOAT(I(J5))*SFI 396 SUM=SUM+XIN5 GO TO 402 c 397 IF(M6)400,400,399 397 IF(M6.le.0) go to 400 c 399 J6=L6+J3-1 J6=L6+J3-1 XIN6=FLOAT(I(J6))*SFI 400 SUM=SUM+XIN6 402 J7=L3+J3-1 I(J7)=IFIX(XIN1*F*SFXX) 403 CONTINUE I(L7)=IFIX(SUM*SFID) RETURN C STEREO OUTPUT BOX c 106 IF(M1)500,500,501 106 IF(M1.gt.0) go to 501 c 500 IN1=I(L1) IN1=I(L1) c 501 IF(M2)502,502,503 501 IF(M2.gt.0) go to 503 c 502 IN2=I(L2) IN2=I(L2) 503 NSSAM=2*NSAM C [page 5-4] C 6/29/70 L.C.SMITH ICT=0 DO 510 J3=1,NSSAM,2 c IF(M1) 505,505,504 IF(M1.le.0) go to 505 C C*** 504 J4=L1+J3-1 c 504 J4=L1+ICT J4=L1+ICT IN1=I(J4) 505 J5=L3+J3-1 I(J5)=IN1+I(J5) c IF(M2)507,507,506 IF(M2.le.0) go to 507 C C*** 506 J4=L2+J3-1 c 506 J4=L2+ICT J4=L2+ICT IN2=I(J4) 507 J5=L3+J3 I(J5)=IN2+I(J5) 510 CONTINUE RETURN C ADD 3 BOX c 107 IF(M1)750,750,751 107 IF(M1.gt.0) go to 751 c 750 IN1=I(L1) IN1=I(L1) c 751 IF(M2)752,752,753 751 IF(M2.gt.0) go to 753 c 752 IN2=I(L2) IN2=I(L2) c 753 IF(M3)754,754,755 753 IF(M3.gt.0) go to 755 c 754 IN3=I(L3) IN3=I(L3) 755 DO 780 J3=1,NSAM c IF(M1)757,757,756 IF(M1.le.0) go to 757 c 756 J4=L1+J3-1 J4=L1+J3-1 IN1=I(J4) c 757 IF(M2)759,759,758 757 IF(M2.le.0) go to 759 c 758 J5=L2+J3-1 J5=L2+J3-1 IN2=I(J5) c 759 IF(M3)761,761,760 759 IF(M3.le.0) go to 761 c 760 J6=L3+J3-1 J6=L3+J3-1 IN3=I(J6) 761 J7=L4+J3-1 I(J7)=IN1+IN2+IN3 780 CONTINUE RETURN C ADD 4 BOX c 108 IF(M1)850,850,851 108 IF(M1.gt.0) go to 851 c 850 IN1=I(L1) IN1=I(L1) c 851 IF(M2)852,852,853 851 IF(M2.gt.0) go to 853 c 852 IN2=I(L2) IN2=I(L2) c 853 IF(M3)854,854,855 853 IF(M3.gt.0) go to 855 c 854 IN3=I(L3) IN3=I(L3) c 855 IF(M4)856,856,857 855 IF(M4.gt.0) go to 857 c 856 IN4=I(L4) IN4=I(L4) 857 DO 880 J3=1,NSAM c IF(M1)859,859,858 IF(M1.le.0) go to 859 c 858 J4=L1+J3-1 J4=L1+J3-1 IN1=I(J4) c 859 IF(M2)861,861,860 859 IF(M2.le.0) go to 861 c 860 J5=L2+J3-1 J5=L2+J3-1 IN2=I(J5) c 861 IF(M3)863,863,862 861 IF(M3.le.0) go to 863 c 862 J6=L3+J3-1 J6=L3+J3-1 IN3=I(J6) c 863 IF(M4)865,865,864 863 IF(M4.le.0) go to 865 c 864 J7=L4+J3-1 J7=L4+J3-1 IN4=I(J7) C [page 5-5] 865 J8=L5+J3-1 I(J8)=IN1+IN2+IN3+IN4 880 CONTINUE RETURN C MULTIPLIER c 109 IF(M1)900,900,901 109 IF(M1.gt.0) go to 901 XIN1=FLOAT(I(L1))*SFI c 901 IF(M2)902,902,903 901 IF(M2.gt.0) go to 903 XIN2=FLOAT(I(L2))*SFI 903 DO 908 J=1,NSAM c IF(M1)905,905,904 IF(M1.le.0) go to 905 J4=L1+J3-1 XIN1=FLOAT(I(J4))*SFI c 905 IF(M2)907,907,906 905 IF(M2.le.0) go to 907 J5=L2+J3-1 XIN2=FLOAT(I(J5))*SFI 907 J6=L3+J3-1 I(J6)=XIN1*XIN2*SFID 908 CONTINUE RETURN C SET NEW FUNCTION IN OSC OR ENV 110 ILOC=N1+6 IF(I(N1+1).EQ.105) ILOC=N1+4 IN1=I(3)+I(N1)-1 IIN1=I(IN1)/IP(12) IF(IIN1.EQ.0) I(ILOC)=-IP(2)-(IIN1-1)*IP(6) c 960 RETURN RETURN C RANDOM AND HOLD GENERATOR 111 SUM=FLOAT(I(L4))*SFI c IF(M1)910,910,911 IF(M1.gt.0) go to 911 c 910 XIN1=FLOAT(I(L1))*SFI XIN1=FLOAT(I(L1))*SFI c 911 IF(M2)912,912,913 911 IF(M2.gt.0) go to 913 c 912 XIN2=FLOAT(I(L2))*SFI XIN2=FLOAT(I(L2))*SFI 913 IRN=I(L5) DO 940 J3=1,NSAM c IF(M1)916,916,915 IF(M1.le.0) go to 916 c 915 J4=L1+J3-1 J4=L1+J3-1 XIN1=FLOAT(I(J4))*SFI c 916 IF(M2)918,918,917 916 IF(M2.le.0) go to 918 c 917 J5=L2+J3-1 J5=L2+J3-1 XIN2=FLOAT(I(J5))*SFI c 918 IF(SUM-XNFUN)920,919,919 918 IF((SUM-XNFUN).lt.0.0) go to 920 c 919 SUM=SUM-XNFUN SUM=SUM-XNFUN I(7)=IABS(I(7)*IMULT) RN=(2.*FLOAT(I(7))*SFF-1.) 920 J7=L3+J3-1 I(J7)=XIN1*RN*SFID SUM=SUM+XIN2 940 CONTINUE I(L4)=IFIX(SUM*SFID) I(L5)=IRN RETURN END C [page 6-1] C GEN1 FUNCTION GENERATOR 1 C *** MUSIC V *** SUBROUTINE GEN1 DIMENSION I(15000),P(100),IP(21) COMMON I,P/PARM/IP N1=IP(2)+(IFIX(P(4))-1)*IP(6) M1=7 SCLFT=IP(15) c 102 IF(P(M1+1))103,103,100 102 IF(P(M1+1).le.0.0) go to 103 c 100 V1=P(M1-2)*SCLFT V1=P(M1-2)*SCLFT V2=(P(M1)-P(M1-2))/(P(M1+1)-P(M1-1))*SCLFT MA=N1+IFIX(P(M1-1)) MB=N1+IFIX(P(M1+1))-1 DO 101 J=MA,MB XJ=J-MA 101 I(J)=V1+V2*XJ IF(IFIX(P(M1+1)).EQ.(IP(6)-1))GO TO 103 M1=M1+2 GO TO 102 103 I(MB+1)=P(M1)*SCLFT RETURN END C GEN2 FUNCTION GENERATOR 2 c *** MUSIC V *** SUBROUTINE GEN2 DIMENSION I(15000),P(100),IP(21),A(7000) COMMON I,P/PARM/IP EQUIVALENCE(I,A) SCLFT=IP(15) N1=IP(2)+(IFIX(P(4))-1)*IP(6) N2=N1+IP(6)-1 DO 101 K1=N1,N2 101 A(K1)=0.0 FAC=6.283185/(FLOAT(IP(6))-1.0) NMAX=I(1) N3=5+INT(ABS(P(NMAX)))-1 c IF(N3-5)104,100,100 IF((N3-5).lt.0) go to 104 c 100 DO 103 J=5,N3 DO 103 J=5,N3 FACK=FAC*FLOAT(J-4) DO 102 K=N1,N2 102 A(K)=A(K)+SIN(FACK*FLOAT(K-N1))*P(J) 103 CONTINUE 104 N4=N3+1 N5=I(1)-1 c IF(N5-N4)114,105,105 IF((N5-N4).le.0) go to 114 c 105 DO 107 J1=N4,N5 DO 107 J1=N4,N5 FACK=FAC*FLOAT(J1-N4) DO 106 K1=N1,N2 106 A(K1)=A(K1)+COS(FACK*FLOAT(K1-N1))*P(J1) 107 CONTINUE 114 CONTINUE c IF(P(NMAX))112,112,108 IF(P(NMAX).le.0.0) go to 112 c 108 FMAX=0.0 FMAX=0.0 DO 110 K2=N1,N2 c IF(ABS(A(K2))-FMAX)110,110,109 IF((ABS(A(K2))-FMAX).le.0.0) go to 110 c 109 FMAX=ABS(A(K2)) FMAX=ABS(A(K2)) 110 CONTINUE 113 DO 111 K3=N1,N2 111 I(K3)=(A(K3)*SCLFT*.99999)/FMAX RETURN C [page 6-2] 112 FMAX=.99999 GO TO 113 END C GEN3 FUNCTION GENERATOR 3 C *** MUSIC V *** C ASSUMPTIONS--P(4) = THE NUMBER OF THE FUNCTION TO BE GENERATED, C I(1) = WORD COUNT FOR CURRENT DATA RECORD C P(5) = THE BEGINNING THE THE LIST OF DESCRIPTION NUMBERS C IP(2) = THE BEGINNING SUBSCRIPT FOR FUNCTIONS IN THE I ARRAY, C IP(6) = THE LENGTH OF THE FUNCTIONS C IP(15) = SCALE FACTOR FOR STORED FUNCTIONS C SUBROUTINE GEN3 COMMON I(15000),P(100) /PARM/ IP(21) N=I(1)-5 NL=5 SCLFT=IP(15) LL=IP(6) RMIN=0 RMAX=0 NR=NL+N DO 10 J=NL,NR IF(P(J).GT.RMAX) RMAX=P(J) 10 IF(P(J).LT.RMIN) RMIN=P(J) DIV=AMAX1(ABS(RMIN),ABS(RMAX)) N1 = IP(2) + (IFIX(P(4))-1)*IP(6) I(N1)=(P(NL)/DIV)*SCLFT LAST=N1 DO 100 J=1,N LL = LL-LL/(N-J+1) IX = N1+IP(6)-LL-1 IX2 = NL+J I(IX)=(P(IX2)/DIV)*SCLFT DELTA=FLOAT(I(IX))-FLOAT(I(LAST)) NR = IX-LAST-1 SEG = NR+1 HNCR=DELTA/SEG DO 50 K=1,NR IX2 = LAST+K 50 I(IX2)=FLOAT(I(IX2-1))+HNCR 100 LAST=IX RETURN END C DATA3 PASS 3 DATA INPUTING ROUTINE C *** MUSIC V *** SUBROUTINE DATA(N) COMMON I(15000),P(100) READ(N, *) K,(P(J),J=1,K) I(1)=K RETURN END C PARM CONTROL DATA SPECIFICATION FOR PASS 3 C *** MUSIC V *** C C IP(1) = NUMBER OF OP CODES C IP(2) = BEGINNING SUBSCRIPT OF FIRST FUNCTION C IP(3) = STANDARD SAMPLING RATE C IP(4) = BEGINNING SUBSCRIPT OF INSTRUMENT DEFINITIONS C IP(5) = BEGINNING OF LOCATION TABLE FOR INSTRUMENT DEFINITIONS C IP(6) = LENGTH OF FUNCTIONS C [page 6-3] C IP(7) = BEGINNING OF NOTE CARD PARAMETERS C IP(8) = LENGTH OF NOTE CARD PARAMETER BLOCKS C IP(9) = NUMBER OF NOTE CARD PARAMETER BLOCKS C IP(10) = BEGINNING OF OUTPUT DATA BLOCK C IP(11) = SOUND ZERO (SILENCE VALUE) C IP(12) = SCALE FACTOR FOR NOTE CARD PARAMETERS C IP(13) = BEGINNING OF GENERATOR INPUT-OUTPUT BLOCKS C IP(14) = LENGTH OF GENERATOR INPUT-OUTPUT BLOCKS C IP(15) = SCALE FACTOR FOR FUNCTIONS C c BLOCK DATA c COMMON /PARM/IP(21) c DATA IP/12,512,20000,14500,14400,512,13000,35,40,6657,2048, c 1 1000000,6657,512,7777777,5*0/ C**** BIG NUMB. IS IBM360'S BIGGEST. 1 65536,6657,512,Z7FFFFFFF/ c END C**** SUBROUTINE DUM C**** ENTRY SAMGEN C**** ENTRY GEN4 C**** ENTRY GEN5 C**** END SUBROUTINE SAMGEN RETURN END SUBROUTINE GEN4 END SUBROUTINE GEN5 END C **** DUMMY SUBROUTINES **** c SUBROUTINE FROUT3(IDSK) C TERMINATE OUTPUT c INTEGER PEAK c COMMON I(15000),P(100)/PARM/IP(21)/FINOUT/PEAK,NRSOR c K=IP(10) c L=IP(10)+IP(14)-1 c DO 1 J=K,L c I(J)=0 c 1 CONTINUE c CALL SAMOUT(IDSK,IP(14)) C REWIND NWRITE C WRITE(6,10) PEAK,NRSOR C PRINT 10,PEAK,NRSOR C 10 FORMAT ('0PEAK AMPLITUDE WAS',I8/'0NUMBER OF SAMPLES OUT OF RANGE WAS',I8) C CALL EXIT c IF(IDSK.LT.0)CALL EXIT c J=IP(10) c L=J+1024 c DO 2 K=J,L c I(K)=0 c 2 CONTINUE cC WILL WRITE 1024 0'S ON DSK. c c CALL FASTOUT(I(J),1024) cc CALL FINFILE c c close(inputfile) c close(outputfile) c c CALL EXIT c END C DSMOUT DEBUG SAMOUT C *** MUSIC V *** C [page 6-4] C DEBUG SAMOUT SUBROUTINE SAMOUT(IDSK,N, nwrite) c DIMENSION IDBUF(2000),MS(3) DIMENSION IDBUF(2000) C*** IDSK IS FLAG TO WRITE SAMPLES ON DSK -- PDP **** C*** IDBUF WILL STORE PACKED SAMPLES. **** DIMENSION I(15000),T(10),P(100),IP(21) COMMON I,P/PARM/IP/FINOUT/PEAK,NRSOR INTEGER PEAK IF(IDSK.GE.0) GO TO 99 N1=N PRINT 100,N1 100 FORMAT(7H OUTPUTI6,8H SAMPLES) N2=IP(10)-1 N3=10 GO TO 104 106 DO 101 L=1,10 J=N2+L 101 T(L)=FLOAT(I(J))/FLOAT(IP(12)) PRINT 102, (T(K),K=1,N3) 102 FORMAT(1H 10F11.4) N2=N2+10 N1=N1-10 c IF(N1)103,103,104 IF(N1.gt.0) go to 104 c 103 RETURN RETURN c 104 IF(N1-10)105,106,106 104 IF(N1.ge.10) go to 106 c 105 N3=N1 N3=N1 GO TO 106 99 J=IDSK+1 M1=IP(10) M2=0 ISC=IP(12) IDSK=IDSK+N C COUNTS SAMPLES TO DATE DO 1 K=J,IDSK N1=I(M1+M2)/ISC IF(N1.GT.PEAK)PEAK=N1 IDBUF(K)=N1 1 M2=M2+1 IF(IDSK.LT.768)RETURN CALL FASTOUT(IDBUF(1), 768, nwrite) c KL=0 c DO 2 K=1,768,3 c KL=KL+1 c KJ=K-1 c MS(1)=IDBUF(K) c IF(MS(1).EQ.2048) MS(1)=2047 cC A 2048 IN THE 12 LEFT HAND BITS CREATES PROBLEMS c DO 3 L=2,3 c MS(L)=IDBUF(KJ+L) c 3 IF(MS(L).LT.0) MS(L)=4096+MS(L) c 2 IDBUF(KL)=MS(3)+MS(2)*4096+MS(1)*16777216 cC PACKS 3 SMPLS TO A 36-BIT WORD. 4096=2**12, 16---=2**24. cC MS(1) HAS LEFT HAND 12 BITS; MS(2), MIDDLE 12 BITS; MS(3), RIGHT 12. cC NEGATIVE NUMBERS RUN FROM 4096(I.E. -1) TO 2049(I.E. -2048). c c CALL FASTOUT(IDBUF(1),256, nwrite) c J=IDSK-768 IF(J.LT.1) GO TO 4 DO 5 K=1,J 5 IDBUF(K)=IDBUF(768+K) C [page 6-5] 4 IDSK=J RETURN END SUBROUTINE FASTOUT(IARR, N, nwrite) DIMENSION I(15000),P(100),IP(21) COMMON I,P/PARM/IP/FINOUT/PEAK,NRSOR DIMENSION IARR(N) ICTR=IP(21) c print *, 'output ', N, ICTR do 55 K=1,N SAMPLE=IARR(k)*0.000488 c 1/2048 ICTR = ICTR+1 55 WRITE(nwrite, rec=ICTR) SAMPLE IP(21)=ICTR c WRITE(nwrite) xarr c (XARR(J), J=1,N) end C ERROR1 GENERAL ERROR ROUTINE C *** MUSIC V *** SUBROUTINE ERROR(I) PRINT 100,I 100 FORMAT(' ERROR OF TYPE',I5) RETURN END