SUBROUTINE F2WRIT IMPLICIT INTEGER (A-Z) COMMON /F2DATA/ F2BLK,F2BYTE,F2BUFF,BUFFER DIMENSION F2BUFF(256),BUFFER(600) WRITE (3'F2BLK,END=20,ERR=20) (F2BUFF(I),I=1,256) DO 10, I=1,256 F2BUFF(I) = 0 10 CONTINUE RETURN 20 STOP 'Instruction File Error' END SUBROUTINE F1WRIT IMPLICIT INTEGER (A-Z) COMMON /F1DATA/ F1BLK,F1BYTE,F1BUFF DIMENSION F1BUFF(256) WRITE (2'F1BLK,ERR=20,END=20) (F1BUFF(I),I=1,256) DO 10, I=1,256 F1BUFF(I) = 0 10 CONTINUE RETURN 20 STOP 'Text File Error' END SUBROUTINE MUNGP1 IMPLICIT INTEGER(A-Z) LOGICAL*1 NAME(14,6),UNREF(6),REFIT(6),LINE(140),LEX(140) COMPLEX COMMAND(17),OPTIONS(56),S DIMENSION CLASS(56),OPTVAL(56),CLASSCT(9),KEYS(5) LOGICAL*1 SEP,TAB,TROUBLE,LIST,LISTED,XREF,REFDEF(9),FID(16) DIMENSION BUFFER(600),F1BUFF(256),F2BUFF(256) DIMENSION HKEY(60),HAUX(60) LOGICAL*1 HNAME(14,60),HREFIT(60),HUNREF(60) EQUIVALENCE (HKEY,BUFFER), (HAUX,BUFFER(61)), (HNAME,BUFFER(121)) EQUIVALENCE (HREFIT,BUFFER(541)), (HUNREF,BUFFER(571)) COMMON /F2DATA/ F2BLK,F2BYTE,F2BUFF,BUFFER COMMON /F1DATA/ F1BLK,F1BYTE,F1BUFF COMMON /FIX1/ OCNT COMMON /STRINGS/ NAME,LEX,COMMAND,OPTIONS,LINE, + NCLASS, SEP, UNREF, TAB, FID COMMON /VALUES/ KEYS, AUXVAL, LINEX, LINEND, KEY, CLASS, + NEXTOBJECT, NEXTPLACE, NEXTTEXT, NEXTVERB, NEXTVAR, + NEXTINIT, NEXTLABEL, NEXTREPEAT, SYMCNT, + CLASSCT, NEXTNULL, TROUBLE, LIST, REFIT, + OPTVAL, NREC, REFDEF, LISTED, XREF COMMON /FIX10/ LINE1 LOGICAL*1 LINE1(20) C IF (.NOT. LIST) GOTO 9006 CALL SCOPY('Symbols (Name, all)',LINE1) CALL STPAGE(LINE1,LIST,0) CALL PRINTTABLE 9006 CONTINUE I = SYMCNT SYMCNT = 0 SAVEC = 0 DO 9002 J=1, I CALL READVIRTUAL(1,J) IF (.NOT. REFIT(1)) GO TO 9002 IF (SAVEC .LT. 60) GOTO 20 CALL OSAVE(SAVEC) CALL READVIRTUAL(1,J) 20 SAVEC = SAVEC + 1 CALL SCOPY(NAME(1,1),HNAME(1,SAVEC),12) HAUX(SAVEC) = AUXVAL HREFIT(SAVEC) = REFIT(1) HKEY(SAVEC) = KEYS(1) HUNREF(SAVEC) = UNREF(1) 9002 CONTINUE IF (SAVEC .GT. 0) CALL OSAVE(SAVEC) IF (.NOT. LIST) GOTO 9007 CALL SCOPY('Symbols (By Name)',LINE1) CALL STPAGE(LINE1,LIST,0) CALL PRINTTABLE 9007 CONTINUE OPEN (UNIT=11, FILE='STABLE.ADV', FORM='UNFORMATTED', TYPE='NEW') WRITE (11,ERR=30,END=30) OCNT,SYMCNT,F2BLK,F1BLK DO 9010, J=1,SYMCNT CALL READVIRTUAL(1,J) WRITE (11,ERR=30,END=30) (NAME(I1,1), I1=1,12), KEYS(1) 9010 CONTINUE I = 0 WRITE (11,ERR=30,END=30) I,I,I,I,I,I,I CLOSE(UNIT=11) RETURN 30 STOP 'Symbol Table File Error' END SUBROUTINE MUNGP2 IMPLICIT INTEGER(A-Z) LOGICAL*1 NAME(14,6),UNREF(6),REFIT(6),LINE(140),LEX(140) COMPLEX COMMAND(17),OPTIONS(56),S DIMENSION OPTVAL(56),CLASS(56),CLASSCT(9),KEYS(5) LOGICAL*1 SEP,TAB,TROUBLE,LIST,LISTED,XREF,REFDEF(9),FID(16) COMMON /STRINGS/ NAME,LEX,COMMAND,OPTIONS,LINE, + NCLASS, SEP, UNREF, TAB, FID COMMON /VALUES/ KEYS, AUXVAL, LINEX, LINEND, KEY, CLASS, + NEXTOBJECT, NEXTPLACE, NEXTTEXT, NEXTVERB, NEXTVAR, + NEXTINIT, NEXTLABEL, NEXTREPEAT, SYMCNT, + CLASSCT, NEXTNULL, TROUBLE, LIST, REFIT, + OPTVAL, NREC, REFDEF, LISTED, XREF COMMON /FIX10/ LINE1 LOGICAL*1 LINE1(20) C CALL SCOPY('Symbols (By Value)', LINE1) IF(.NOT. LIST) GOTO 9112 CALL STPAGE(LINE1,LIST,0) CALL PRINTTABLE 9112 RETURN END SUBROUTINE XOUT(TEXT,FID,RECORD) IMPLICIT INTEGER (A-Z) LOGICAL*1 TEXT(14),FID(16),FID1(16),FID2(16) COMMON /FIX2/ XCNT XCNT = XCNT + 1 CALL SCOPY(FID,FID1,16) CALL SCOPY(FID,FID2,16) CALL TRIM(FID2) IF (ZLEN(FID2) .EQ. 0) CALL SCOPY('.MAIN PROG. ',FID1) WRITE (8'XCNT,ERR=10,END=10) (TEXT(I),I=1,12), + (FID1(I),I=1,14),RECORD RETURN 10 STOP 'Xref File Error' END SUBROUTINE OUTXREF IMPLICIT INTEGER(A-Z) LOGICAL*1 NAME(14,6),UNREF(6),REFIT(6),LINE(140),LEX(140) COMPLEX COMMAND(17),OPTIONS(56),S DIMENSION OPTVAL(56),CLASS(56),CLASSCT(9),KEYS(5) LOGICAL*1 SEP,TAB,TROUBLE,LIST,LISTED,XREF,REFDEF(9),FID(16) COMMON /STRINGS/ NAME,LEX,COMMAND,OPTIONS,LINE, + NCLASS, SEP, UNREF, TAB, FID COMMON /VALUES/ KEYS, AUXVAL, LINEX, LINEND, KEY, CLASS, + NEXTOBJECT, NEXTPLACE, NEXTTEXT, NEXTVERB, NEXTVAR, + NEXTINIT, NEXTLABEL, NEXTREPEAT, SYMCNT, + CLASSCT, NEXTNULL, TROUBLE, LIST, REFIT, + OPTVAL, NREC, REFDEF, LISTED, XREF COMMON /FIX2/ XCNT LOGICAL*1 LINE1(20) COMMON /FIX10/ LINE1 CALL SCOPY('Cross-Reference',LINE1) CALL STPAGE(LINE1,LIST,0) NREC = 0 XREF = .TRUE. SYMCNT = 1 READ (8'1) (LEX(I),I=1,12),(NAME(I,1),I=1,14),KEY 10 READ (8'SYMCNT) (LINE(I),I=1,12),(FID(I),I=1,14),KEY IF (CEQUAL(LINE,LEX,12) .EQ. 0) GOTO 15 CALL OUTLINE XREF = .TRUE. 15 IF (NREC .GE. 4) CALL OUTLINE NREC = NREC + 1 KEYS(NREC) = KEY DO 20,I=1,14 NAME(I,NREC)=FID(I) 20 CONTINUE SYMCNT = SYMCNT + 1 IF (SYMCNT .LE. XCNT) GOTO 10 CALL OUTLINE RETURN 100 STOP 'Listing File Error' END SUBROUTINE OUTLINE IMPLICIT INTEGER(A-Z) LOGICAL*1 NAME(14,6),UNREF(6),REFIT(6),LINE(140),LEX(140) COMPLEX COMMAND(17),OPTIONS(56),S DIMENSION OPTVAL(56),CLASS(56),CLASSCT(9),KEYS(5) LOGICAL*1 SEP,TAB,TROUBLE,LIST,LISTED,XREF,REFDEF(9),FID(16) COMMON /STRINGS/ NAME,LEX,COMMAND,OPTIONS,LINE, + NCLASS, SEP, UNREF, TAB, FID COMMON /VALUES/ KEYS, AUXVAL, LINEX, LINEND, KEY, CLASS, + NEXTOBJECT, NEXTPLACE, NEXTTEXT, NEXTVERB, NEXTVAR, + NEXTINIT, NEXTLABEL, NEXTREPEAT, SYMCNT, + CLASSCT, NEXTNULL, TROUBLE, LIST, REFIT, + OPTVAL, NREC, REFDEF, LISTED, XREF COMMON /LSTFX1/ PAGE,PLINE,CMCODE,OLDBP,WRDLST(50),WRDCNT COMMON /LSTFX2/ LSTBLK,LSTBYT COMMON /FIX10/ LINE1 LOGICAL*1 LINE1(20) PLINE = PLINE + 1 IF (PLINE .LT. 58) GOTO 5 CALL STPAGE(LINE1,LIST,0) 5 IF (XREF) GOTO 10 WRITE(7,2,ERR=100,END=100) ((NAME(I,I1),I=1,14), + KEYS(I1),I1=1,NREC) GOTO 20 10 WRITE(7,1,ERR=100,END=100) (LEX(I),I=1,12),((NAME(I,I1),I=1,14), + KEYS(I1),I1=1,NREC) 20 XREF = .FALSE. NREC = 0 CALL SCOPY(LINE,LEX,12) RETURN 1 FORMAT(1X,12A1,4(4X,14A1,I7)) 2 FORMAT(13X,4(4X,14A1,I7)) 100 STOP 'Listing File Error' END