PROGRAM MODULE C C This program reads a map file of a task and identifies C modules used C C To use, generate a map of the task with the /MA switch: C C TKB NL:, SY:task/MA = task C C This will create a map file which has the I.D.'s of all C the object modules. Then run this program, and give the C map file as the input file: it will extract all modules, C sort them by name, and eliminate duplicates. C C B. Z. Lederman C IMPLICIT INTEGER (A-Z) BYTE FILNAM(40), OPTNAM(40) BYTE NAME(16, 400) REAL*8 NAM8(2, 400), REC8(2), REC1, REC2, BLANKS, X BYTE RECORD(84) C C Make names easier to move (two moves of 8 bytes each) C EQUIVALENCE (NAM8, NAME) C C Check the record for leading blanks 8 at a time. C EQUIVALENCE (REC8, RECORD), (REC8(1), REC1), (REC8(2), REC2) C DATA BLANKS /' '/ C C Insure the name array is clear. C DO 10 I = 1, 400 NAM8(1, I) = BLANKS 10 NAM8(2, I) = BLANKS C COUNT = 0 C WRITE (5, 100) 100 FORMAT('$ Input file name: ') READ (5, 110, END = 999) J, FILNAM 110 FORMAT (Q, 40A1) IF (J .LT. 40) J = J + 1 FILNAM(J) = 0 C OPEN (UNIT = 1, NAME = FILNAM, TYPE = 'OLD', READONLY) C C Go through the map file one record at a time. C 200 READ (1, 210, END = 300, ERR = 200) MAX, RECORD 210 FORMAT (Q, 84A1) C C The records we want must be at least 61 bytes long. C IF (MAX .LT. 61) GOTO 200 C C We don't want very long records (symbol lists) C IF (MAX .GT. 80) GOTO 200 C C Want only lines which start with 16 spaces C IF (REC1 .NE. BLANKS) GOTO 200 IF (REC2 .NE. BLANKS) GOTO 200 C C Move the module name into the array. C 220 COUNT = COUNT + 1 IF (COUNT .GT. 400) GOTO 300 DO 230 I = 1, 6 NAME( I, COUNT) = RECORD( I + 65) 230 NAME((I + 8), COUNT) = RECORD( I + 51) C C Get next record. C GOTO 200 C C All records have been read. C 300 CLOSE (UNIT = 1) C C If there was no data, finish. C IF (COUNT .LE. 0) GOTO 999 C C Sort the names. C This is a "SHELL" sort, and is quite fast. C C The first "jump" is the largest power of 2 C which is less than the number of elements to be sorted, C minus one. C M = 1 320 IF ((2**M) .GT. COUNT) GO TO 330 M = M + 1 GO TO 320 330 M = M - 1 M = 2**M M = M - 1 C 340 K = COUNT - M DO 350 J = 1, K DO 350 I = J, 1, -(M) C C Test each byte in the name. C DO 370 L = 1, 16 C C If any byte is "LT", names must be exchanged C IF (NAME(L, I + M) .LT. NAME(L, I)) GOTO 380 C C If any byte is "GT", names need not be exhanged. C IF (NAME(L, I + M) .GT. NAME(L, I)) GOTO 350 C 370 CONTINUE C C If all bytes are equal, names are not exhanged. C GOTO 350 C C Exchange the two names. C 380 DO 390 L = 1, 2 X = NAM8(L, I) NAM8(L, I) = NAM8(L, I + M) 390 NAM8(L, I + M) = X C 350 CONTINUE C C Check to see if any more passes are needed, and repeat. C M = M / 2 IF (M .GT. 0) GOTO 340 C C Open the output file. C WRITE (5, 400) 400 FORMAT ('$ Enter output file name: ') READ (5, 110, END = 999) J, OPTNAM IF (J .LT. 40) J = J + 1 OPTNAM(J) = 0 OPEN (UNIT = 1, NAME = OPTNAM, TYPE = 'NEW', 1 CARRIAGECONTROL = 'LIST') C C Go through the data, write out the file names skipping duplicates. C WRITE (1, 410) (FILNAM(K), K = 1, J) 410 FORMAT(' Source modules from ', A1) C C Print out all of the module names. C DO 490 I = 1, COUNT C C If first name, there is no previous name, so don't check for duplicate. C IF (I .EQ. 1) GOTO 420 C C If the name is not the same as the previous name, print it out. C REAL*8 equivalence makes the comparisons easier. C IF (NAM8(2, I) .EQ. NAM8( 2, (I - 1))) GOTO 490 C C Strip trailing blanks off of the module name. C 420 DO 430, K = 16, 9, -1 IF (NAME(J, K) .NE. ' ') GOTO 440 430 CONTINUE C C Correct count to exclude library name. C 440 L = K - 8 C C Write it all out. C WRITE (1, 450) (NAME(J, I), J = 1, K) 450 FORMAT( 8A1, 2X, A1) 490 CONTINUE C C All done. C 500 CLOSE (UNIT = 1) 999 STOP END