C XR8008.FOR C C PROCESS THE CREF FILE GENERATED BY THE C MPS CROSS-ASSEMBLER (AS8008.FOR). C LIST THE SYMBOLS (NOT OPCODE SYMBOLS) IN C ALPHABETICAL ORDER AND THE LINE NUMBER C OF EACH OCCURANCE OF THAT SYMBOL C C THE FORMAT OF THE ENTRIES IN THE CREF FILE C IS AS FOLLOWS: C BYTE 1 MS ASCII C 2 C 3 SYMBOL NAME C 4 C 5 C 6 LS ASCII C 7 SYMBOL DEFINED INDICATOR C INTEGER-LINE NUMBER ON LISTING C C C THE FIRST LINE NUMBER PRINTED AFTER THE C SYMBOL NAME IS THE LINE NUMBER OF THE C LINE WHERE THE SYMBOL WAS DEFINED. C INTEGER ILINE(3500),ILIST(12),IFLAG(12) LOGICAL*1 ISYM(3500,7),FIL(11),INPS(7),ISRCH(6) LOGICAL*1 TODAY(9) IMASK=255 IEND="332.AND.IMASK C C ASK FOR THE INPUT FILE C 50 WRITE (5,9000) 9000 FORMAT('1',/,' XR8008-001D') WRITE(5,9001) 9001 FORMAT('$ INPUT: ') READ(5,8000)(FIL(J),J=1,10) 8000 FORMAT(10A1) FIL(11)=0 WRITE(5,9002) 9002 FORMAT('$OUTPUT: ') CALL ASSIGN(6,'TT:',-3,'NEW') 1 CALL ASSIGN(1,FIL,10,'RDO') ICHR="301 ICHR=ICHR.AND.IMASK C C CLEAR MEMORY C 2 DO 3 I=1,3500 ILINE(I)=0 DO 3 J=1,7 ISYM(I,J)=0 3 CONTINUE C C NOW INPUT ALL SYMBOLS AND STORE THOSE BEGINNING C WITH THE LETTER (ICHR) C J=1 4 READ(1,9010,END=6)(INPS(I),I=1,7),INPL 9010 FORMAT(7A1,I4) DO 5 K=1,7 ISYM(J,K)=INPS(K) 5 CONTINUE ILINE(J)=INPL J=J+1 GOTO 4 C C ALL THE SYMBOLS ARE NOW STORED C CLOSE THE FILE AND SAVE THE NUMBER OF SYMBOLS C 6 CALL CLOSE(1) NSYM=J-1 NSYML=NSYM IF(NSYM.EQ.0) GOTO 50 CALL DATE(TODAY) IPAGE=1 ILC=55 7 DO 8 I=1,6 ISRCH(I)=140 8 CONTINUE C C NOW FIND THE NEXT SYMBOL IN ALPHABETICAL ORDER C 9 DO 11 I=1,NSYM DO 10 J=1,6 IF((ISRCH(J).AND.IMASK).LT.(ISYM(I,J).AND.IMASK)) GOTO 11 IF((ISRCH(J).AND.IMASK).EQ.(ISYM(I,J).AND.IMASK)) GOTO 10 DO 10 K=1,6 ISRCH(K)=(ISYM(I,K).AND.IMASK) 10 CONTINUE 11 CONTINUE C C NOW PRINT ALL THE LINES WHERE THE SYMBOL C WAS REFERENCED IN THE SOURCE. THE SYMBOL C NAME WILL BE PRINTED ON ONLY THE FIRST C LINE. THE NUMBERS PRINTED REFER TO THE C LINE NUMBERS AS APPEAR ON THE LISTING. C DO 230 I=1,12 ILIST(I)=0 230 CONTINUE ISP=0 L=0 DO 13 I=1,NSYM DO 12 J=1,6 IF(ISYM(I,J).NE.ISRCH(J)) GOTO 13 12 CONTINUE C C FOUND A SYMBOL C IF(ILC.LT.55) GOTO 191 WRITE(6,9020)(FIL(K),K=1,10),TODAY,IPAGE 9020 FORMAT('1XR8008-001D: ',10A1,5X,9A1,5X,'PAGE',I4// 1 ' SYMBOL REFERENCES'//) IPAGE=IPAGE+1 ILC=0 191 L=L+1 ILIST(L)=ILINE(I) IFLAG(L)="40 IF(ISYM(I,7).EQ."104) IFLAG(L)="52 IF(L.LT.12) GOTO 203 IF(ISP.NE.0) GOTO 200 WRITE(6,9030)(ISRCH(K),K=1,6),(ILIST(M),IFLAG(M),M=1,L) 9030 FORMAT(2X,6A1,12(I6,A1)) ILC=ILC+1 ISP=1 GOTO 201 200 WRITE(6,9031)(ILIST(M),IFLAG(M),M=1,L) 9031 FORMAT(8X,12(I6,A1)) ILC=ILC+1 201 L=0 DO 220 K=1,12 ILIST(K)=0 220 CONTINUE 203 DO 15 K=1,6 ISYM(I,K)=140 15 CONTINUE NSYML=NSYML-1 13 CONTINUE IF(L.EQ.0) GOTO 210 IF(ISP.NE.0) GOTO 204 WRITE(6,9030)(ISRCH(K),K=1,6),(ILIST(M),IFLAG(M),M=1,L) ILC=ILC+1 GOTO 210 204 WRITE(6,9031)(ILIST(M),IFLAG(M),M=1,L) ILC=ILC+1 210 IF(NSYML.GT.0) GOTO 7 CALL CLOSE(6) GOTO 50 END