C$ PROGRAM OBJRD.FTN SYSTEM ROSENBERG AUGUST,1980 C C= C OBJECT MODULE READER C= C+ C This program will read an object module file produced C by one of the Digital compiler/assemblers. The program will C report global references, global definitions, and program C sections and their attributes. A switch may be specified which C will cause all symbols to be displayed. The default is display C only FORTRAN usable symbols. Specifying /ALL will cause system C symbols to also be displayed (i.e. Names with a '.' or '$' in C the name). C- PROGRAM OBJRD IMPLICIT INTEGER(A-Z) LOGICAL TSTBIT,FCOM BYTE SYMNAM(6), ANS BYTE RECORD(200) INTEGER REC(100) EQUIVALENCE (REC(1), RECORD(1)) INTEGER ERROR LOGICAL EOF, ERR, ALL BYTE FILNAM(100) C INTEGER*4 ATTRIB(3,5) BYTE ATLINE(24) DATA ATTRIB /5, 'RW', 'RO', 1 8, 'I', 'D', 2 7, 'LCL', 'GBL', 3 6, 'ABS', 'REL', 4 3, 'CON', 'OVR'/ C C C--- Turn off FORTRAN error messages C IX = 29 CALL ERRSET (IX, .TRUE., .FALSE., .TRUE., .FALSE., ) IX = 30 CALL ERRSET (IX, .TRUE., .FALSE., .TRUE., .FALSE., ) IX = 43 CALL ERRSET (IX, .TRUE., .FALSE., .FALSE., .FALSE., ) C C--- Set up (get command line) with prompt of OBR> C CALL GCMLB (1,'OBR',FILNAM,100) C C--- Get command line (user input) C 1 IO = GCML (LEN, EOF, ERROR) IF (EOF) GOTO 9000 IF (ERROR .EQ. 0) GOTO 100 10 TYPE 20, ERROR 20 FORMAT(' OBR -- ERROR ',I3) GOTO 1 100 CONTINUE C C--- See if /All switch was included C ALL = .FALSE. IX = INDEX(FILNAM(IO),1,LEN,'/',1) IF (IX .EQ. 0) GOTO 104 C C--- A Switch was specified, see if it is 'ALL' (AL is sufficient) C LEN = IX-1 ALL = (INDEX(FILNAM(IO),IX,IX+2,'AL',2) .NE. 0) IF (ALL) GOTO 104 TYPE *,'OBR -- ILLEGAL SWITCH' GOTO 1 104 CONTINUE C C--- See if .OBJ has been included, if not add it. C IX = INDEX(FILNAM(IO),1,LEN,'.',1) IF (IX .NE. 0) GOTO 105 IX = LEN CALL COPYB ('.OBJ', 1, FILNAM(IO), IX+1, 4) LEN = LEN + 4 105 CONTINUE C FILNAM(IO+LEN) = 0 OPEN (UNIT=2, NAME=FILNAM(IO), TYPE='OLD', READONLY, SHARED, 1 ERR=106) GOTO 200 106 CONTINUE CALL ERRSNS (IX) TYPE 110, (FILNAM(I),I=IO,IO+LEN-1), IX 110 FORMAT(' OBR --- FILE OPEN FAILURE ON "',A1,'" ERROR #',I3) GOTO 1 200 CONTINUE C C--- Specified object file has been opened, begin reading it. C 1000 READ (2,1001,END=1075) LENGTH, (RECORD(I),I=1,LENGTH) 1001 FORMAT(Q,A1) C C--- Determine record type C TYPE = REC(1) C C--- For descriptions of record types, see task builder reference manual C 1050 GOTO (2000,1080,1000,1000,1000,1060) , TYPE 1060 TYPE 1070 1070 FORMAT('0End of module encountered.') GOTO 1000 1075 CLOSE (UNIT=2) GOTO 1 1080 CONTINUE TYPE 1090 1090 FORMAT('0All external references listed.') GOTO 1000 2000 CONTINUE C C--- Global symbol directory record read. C PTR = 2 N = (LENGTH-2)/8 DO 3000 I=1, N CALL R50ASC (6, REC(PTR), SYMNAM) PTR = PTR + 2 CALL SEPWRD (REC(PTR), FLAGS, TYPE) PTR = PTR + 2 IF (TYPE .NE. 0) GOTO 2050 TYPE 2010, SYMNAM 2010 FORMAT('0Module name is: ',6A1/) TYPE 2020 2020 FORMAT('0External Reference',T25,'Defined symbol', 1 T48,'Program sections and attributes') GOTO 3000 2050 CONTINUE IF (.NOT. (TYPE .EQ. 4 .OR. TYPE .EQ. 5)) GOTO 3000 C C--- See if this symbol should be displayed C IF (ALL) GOTO 2090 IF (INDEX(SYMNAM,1,6,'.',1) .NE. 0) GOTO 3000 IF (INDEX(SYMNAM,1,6,'$',1) .NE. 0) GOTO 3000 2090 CONTINUE IF (TYPE .EQ. 5) GOTO 2300 IF (TSTBIT(FLAGS,4)) GOTO 2100 TYPE 2060, SYMNAM 2060 FORMAT(1X,T8,6A1) GOTO 3000 2100 TYPE 2110, SYMNAM 2110 FORMAT(1X,T31,6A1) GOTO 3000 2300 CONTINUE C C--- Program section name C IX = 1 DO 2310 JX=1, 5 BIT ON = 2 L = 3 IF (JX .EQ. 1) L = 2 IF (JX .EQ. 2) L = 1 IF (TSTBIT(FLAGS,ATTRIB(1,JX))) BIT ON = 3 CALL COPYB (ATTRIB(BIT ON,JX), 1, ATLINE, IX, L) IX = IX + L IF (JX .NE. 5) CALL COPYB (', ', 1, ATLINE, IX, 2) IX = IX + 2 2310 CONTINUE WRITE (5,2320) SYMNAM, ATLINE 2320 FORMAT(1X,T49,6A1,3X,24A1) 3000 CONTINUE GOTO 1000 9000 CLOSE (UNIT=2) CALL QUIT (1) END