C$ PROGRAM LIBSEE.FTN SYSTEM ROSENBERG 13-AUG-80 C C= C PROGRAM TO EXAMINE A SPECIFIED LIBRARY FILE FOR A MODULE C OR ENTRY POINT NAME C= C+ C This program enables a user to query a specific library C file for a module or global symbol. If either is found, the C program will output the module name, its insertion date, its ident C field, and all of its defined entry points. C C Entering a * at file name time will cause program exit C Entering a * at symbol name will cause prompt for a new library file. C C The extension .OLB is assumed for all files. C- PROGRAM LIBSEE IMPLICIT INTEGER(A-Z) BYTE FILNAM(100), BLOCKB(512) INTEGER BLOCK(256) EQUIVALENCE (BLOCK(1), BLOCKB(1)) INTEGER NAME(3), R5NAME(2), ELEM(4) BYTE INDATE(8), IDENT(6) INTEGER SAVE(2), ASCNAM(3), MODHED(8) LOGICAL FOUND, EOF, MCR PARAMETER LUN=2, ENT=1, MNT=2, NAM=1, PTR=2 PARAMETER TRUE=.TRUE., FALSE=.FALSE. C CALL ERRSET (29, TRUE, FALSE, TRUE, FALSE,) CALL ERRSET (30, TRUE, FALSE, TRUE, FALSE,) CALL GCMLB (1,'LBS',FILNAM,100) C C--- Re-initialize routine LIBTAB with a call to LIBTAI C 100 CONTINUE CALL LIBTAI FOUND = .FALSE. IO = GCML (LEN, EOF, ERROR) IF (EOF) GOTO 900 IF (ERROR .NE. 0) GOTO 100 110 CONTINUE IF (FILNAM(IO) .EQ. '*') GOTO 900 IX = INDEX (FILNAM(IO), 1, LEN, '.', 1) IF (IX .NE. 0) GOTO 150 C C--- Assume extension .OLB C IF (LEN .GT. 96) GOTO 100 CALL COPYB ('.OLB', 1, FILNAM(IO), LEN+1, 4) LEN = LEN + 4 C 150 CONTINUE FILNAM(IO+LEN) = 0 CLOSE (UNIT=LUN) OPEN (UNIT=LUN, NAME=FILNAM(IO), TYPE='OLD', ACCESS='DIRECT', 1 READONLY, ERR=100) 200 CONTINUE CLOSE (UNIT=5) TYPE 210 210 FORMAT('$Enter symbol: ') READ (5,220,END=100,ERR=100) NAME 220 FORMAT(3A2) IF (NAME(1) .EQ. '* ') GOTO 100 CALL IRAD50 (6, NAME, R5NAME) C C--- See if name is in MNT C CALL LIBTAB (LUN, MNT, NAM, R5NAME, ELEM, FOUND) IF (FOUND) GOTO 300 C CALL LIBTAB (LUN, ENT, NAM, R5NAME, ELEM, FOUND) IF (FOUND) GOTO 500 C C--- Name entered is not in library C TYPE 250, NAME 250 FORMAT(' Symbol ',3A2,' not in library.') GOTO 200 C 300 CONTINUE C C--- Name is a module, list info on module C CALL R50ASC (6, ELEM, ASCNAM) IX = ((ELEM(4)+2)/2) + 1 READ (LUN'ELEM(3)) BLOCK DO 310 I=1, 8 MODHED(I) = BLOCK(IX) IX = IX + 1 IF (IX .LE. 256) GOTO 310 READ (LUN'ELEM(3)+1) BLOCK IX = 1 310 CONTINUE C C--- MODHED contains module header block C ENCODE (8, 315, INDATE) MODHED(5),MODHED(6),MODHED(4) 315 FORMAT(I2,2('/',I2)) INDATE(4) = INDATE(4) .OR. "60 CALL R50ASC (6, MODHED(7), IDENT) TYPE 320, ASCNAM, INDATE, IDENT 320 FORMAT(' Module name is "',3A2,'" Inserted:',8A1,' Ident:',6A1) C C--- Get entry points for this module C FOUND = .FALSE. SAVE(1) = ELEM(3) SAVE(2) = ELEM(4) TYPE 340 340 FORMAT(1X) 350 CALL LIBTAB (LUN, ENT, PTR, SAVE, ELEM, FOUND) IF (.NOT. FOUND) GOTO 200 C C--- Display this entry point name to user C CALL R50ASC (6, ELEM, ASCNAM) TYPE 360, ASCNAM 360 FORMAT('+',3A2,2X,$) GOTO 350 C 500 CONTINUE C C-- Entry point found - get module name element and repeat procedure C FOUND = .FALSE. SAVE(1) = ELEM(3) SAVE(2) = ELEM(4) CALL LIBTAB (LUN, MNT, PTR, SAVE, ELEM, FOUND) IF (FOUND) GOTO 300 C C-- Entry not in a module? C TYPE 550 550 FORMAT(' Entry point found but no module!') GOTO 200 900 CLOSE(UNIT=LUN) CALL QUIT(1) END