home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istal / ALLIB.MAC.f next >
Encoding:
Text File  |  1993-10-04  |  148.9 KB  |  4,460 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.5
  3. C---------------------------------------------------------
  4. C
  5. C  LIBRARY FOR THE TOOL ISTAL
  6. C
  7. C----------------------------------------------------------
  8. C
  9. C  MAIN LOOP. READS IN THE COMMAND FILE ONE LINE AT A TIME
  10. C  AND CHECKS TO SEE IF ISTAL IS REQUESTED TO PERFORM ANY
  11. C  ACTIONS. THE COMMAND FILE IS ASSUMED TO CONTAIN A MIXTURE
  12. C  OF TEXT AND ISTRF FORMAT COMMANDS. THE ISTRF FORMAT COMMAND
  13. C  'CC' IS RECOGNIZED. ISTAL ACTIONS ARE INVOKED BY THE USE OF
  14. C  THE ISTRF FORMAT COMMAND 'AL', EG: '.AL TOTALS=PROGRAM'
  15. C
  16.       SUBROUTINE SPOSTD(CMDFD)
  17.  
  18.       INTEGER CMDFD, I, STATUS, CC, STKPNT
  19.       INTEGER BUFFER(134), PROMPT(5), STACK(10)
  20.       INTEGER ZLOWER, ZGTCMD, OPEN, CTOI
  21. C---------------------------------------------------------
  22. C    TOOLPACK/1    Release: 2.5
  23. C---------------------------------------------------------
  24.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  25.       INTEGER OUTFD,  RMARG, REPRTS
  26.  
  27.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  28.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  29.       SAVE
  30.  
  31.       DATA PROMPT/97, 108, 58, 32, 129/
  32.       DATA CC    /46/
  33.  
  34.       CALL KEYS
  35.       STKPNT = 0
  36.  
  37.    10 CONTINUE
  38.         IF (CMDFD .EQ. 0) THEN
  39.           CALL ZPRMPT(PROMPT)
  40.           BUFFER(1) = CC
  41.           BUFFER(2) = 97
  42.           BUFFER(3) = 108
  43.           STATUS = ZGTCMD(BUFFER(4), CMDFD)
  44.           IF((ZLOWER(BUFFER(4)) .EQ. 101 .AND.
  45.      +        ZLOWER(BUFFER(5)) .EQ. 120).OR.
  46.      +       (ZLOWER(BUFFER(4)) .EQ. 113 .AND.
  47.      +        ZLOWER(BUFFER(5)) .EQ. 117))  THEN
  48.             STATUS = -100
  49.           ELSE IF(ZLOWER(BUFFER(4)) .EQ. 63 .AND.
  50.      +            ZLOWER(BUFFER(5)) .EQ. 63)  THEN
  51.             CALL DOHELP(BUFFER(6))
  52.             GO TO 10
  53.           ENDIF
  54.         ELSE
  55.           STATUS = ZGTCMD(BUFFER, CMDFD)
  56.         ENDIF
  57.         IF(STATUS .EQ. -1) RETURN
  58.         IF(STATUS .EQ. -100) THEN
  59.           CALL CLOSE(CMDFD)
  60.           IF(STKPNT .EQ. 0) RETURN
  61.           CMDFD  = STACK(STKPNT)
  62.           STKPNT = STKPNT - 1
  63.           GO TO 10
  64.         ENDIF
  65.  
  66.         IF(BUFFER(1) .EQ. CC) THEN
  67.           IF((ZLOWER(BUFFER(2)) .NE. 97) .OR.
  68.      +       (ZLOWER(BUFFER(3)) .NE. 108)) THEN
  69.             IF((BUFFER(2) .EQ. 99) .AND.
  70.      +          (BUFFER(3) .EQ. 99)) THEN
  71.               I = 4
  72.               CALL SKIPBL(BUFFER, I)
  73.               CC = 46
  74.               IF(BUFFER(I) .NE. 129) CC = BUFFER(I)
  75.  
  76.             ELSE IF((BUFFER(2) .EQ. 114) .AND.
  77.      +              (BUFFER(3) .EQ. 109)) THEN
  78.               I = 4
  79.               RMARG = CTOI(BUFFER, I)
  80.               IF(RMARG .LE. 0) RMARG = 65
  81.  
  82.             ELSE IF((BUFFER(2) .EQ. 115) .AND.
  83.      +              (BUFFER(3) .EQ. 111)) THEN
  84.               I = 4
  85.               CALL SKIPBL(BUFFER, I)
  86.  
  87.               IF(STKPNT .EQ. 10) THEN
  88.                 CALL REPORT('TOO MANY NESTED INCLUDES.', OUTFD)
  89.               ELSE
  90.                 STKPNT = STKPNT + 1
  91.                 STACK(STKPNT) = CMDFD
  92.                 CMDFD = OPEN(BUFFER(I), 0)
  93.                 IF(CMDFD .EQ. -1) THEN
  94.                   CALL REPORT('UNABLE TO OPEN INCLUDE FILE.', OUTFD)
  95.                   IF(STKPNT .EQ. 0) RETURN
  96.                   CMDFD  = STACK(STKPNT)
  97.                   STKPNT = STKPNT - 1
  98.                 ENDIF
  99.               ENDIF
  100.               GO TO 10
  101.  
  102.             ENDIF
  103.             CALL ZPTMES(BUFFER, OUTFD)
  104.  
  105.           ELSE
  106.             I = 4
  107.             CALL SKIPBL(BUFFER, I)
  108.             IF(OUTFD .NE. 1) THEN
  109.               IF(CC.NE.46) THEN
  110.                 CALL PUTCH(CC, OUTFD)
  111.                 CALL ZMESS('cc ...', OUTFD)
  112.               ENDIF
  113.             ENDIF
  114.             CALL DOCMND(BUFFER(I))
  115.             IF(OUTFD .NE. 1) THEN
  116.               IF(CC.NE.46) THEN
  117.                 CALL ZCHOUT('..cc .', OUTFD)
  118.                 CALL PUTCH(CC, OUTFD)
  119.                 CALL PUTCH(10, OUTFD)
  120.               ENDIF
  121.             ENDIF
  122.  
  123.           ENDIF
  124.  
  125.         ELSE
  126.           CALL ZPTMES(BUFFER, OUTFD)
  127.  
  128.         ENDIF
  129.  
  130.       GO TO 10
  131.  
  132.       END
  133. C---------------------------------------------------------------
  134. C
  135. C  PUT OUT MINIMAL HELP INFORMATION
  136. C
  137.       SUBROUTINE DOHELP(BUFFER)
  138.  
  139.       INTEGER BUFFER(*)
  140.       INTEGER MAXLIN, I
  141.       PARAMETER (MAXLIN = 24)
  142.       CHARACTER*52 L(MAXLIN)
  143. C                 ..../..../..../..../..../..../..../..../..../..../..
  144.       DATA L( 1)/'ANNOtated = <filename>.'/
  145.       DATA L( 2)/'ASsertions [= <expression>].'/
  146.       DATA L( 3)/'CAllgraph [= <filename>|(<filename>)].'/
  147.       DATA L( 4)/'COmmon usage [= <filename>|(<filename>)].'/
  148.       DATA L( 5)/'DEbug [= YES|NO].'/
  149.       DATA L( 6)/'DYnamic [= <expression>].'/
  150.       DATA L( 7)/'EXit.'/
  151.       DATA L( 8)/'FOlding [= YES|NO].'/
  152.       DATA L( 9)/'FUllxreference [= <filename>|(<filename>)].'/
  153.       DATA L(10)/'Intrinsics [= YES|NO].'/
  154.       DATA L(11)/'Listing [= NO|list].'/
  155.       DATA L(12)/'Run time = <filename>.'/
  156.       DATA L(13)/'SEgments [= <expression>].'/
  157.       DATA L(14)/'STatic [= <expression>].'/
  158.       DATA L(15)/'SUmmary = <filename>.'/
  159.       DATA L(16)/'SYmbol info [= <expression>].'/
  160.       DATA L(17)/'TAble load [= <filename>|(<filename>)].'/
  161.       DATA L(18)/'TOtals [= <expression>].'/
  162.       DATA L(19)/'Verbose [= YES|NO].'/
  163.       DATA L(20)/'QUit.'/
  164.       DATA L(21)/'Warnings [= <expression>].'/
  165.       DATA L(22)/'Xreference [= <filename>|(<filename>)].'/
  166.       DATA L(23)/'Zero-segs [= <expression>].'/
  167.       DATA L(24)/'??.'/
  168. C                 ..../..../..../..../..../..../..../..../..../..../..
  169.  
  170.       DO 10 I =  1, MAXLIN
  171.         CALL ZMESS(L(I), 1)
  172.    10 CONTINUE
  173.  
  174.       END
  175. C---------------------------------------------------------------
  176. C
  177. C  PUT A PROBLEM REPORT INTO THE OUTPUT DOCUMENT
  178. C
  179.       SUBROUTINE REPORT(STRING, FD)
  180.  
  181.       INTEGER        FD
  182.       CHARACTER *(*) STRING
  183. C---------------------------------------------------------
  184. C    TOOLPACK/1    Release: 2.5
  185. C---------------------------------------------------------
  186.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  187.       INTEGER OUTFD,  RMARG, REPRTS
  188.  
  189.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  190.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  191.       SAVE
  192.  
  193.       REPRTS = REPRTS + 1
  194.       IF(OUTFD .NE. 1) CALL ZMESS ('..sp.',      FD)
  195.       CALL ZCHOUT('  **ISTAL: .', FD)
  196.       CALL ZMESS (STRING,         FD)
  197.       CALL COMPLT(FD)
  198.  
  199.       END
  200. C---------------------------------------------------------------
  201. C
  202. C  ROUTINE TO IDENTIFY THE USERS REQUEST AND CALL THE APPROPRIATE
  203. C  ROUTINES TO EXECUTE IT.
  204. C
  205.       SUBROUTINE DOCMND(BUFFER)
  206.  
  207.       INTEGER C, C2, STATUS, IJUNK
  208.       INTEGER BUFFER(*), JUNK(134), BODY(134)
  209.       INTEGER ZLOWER, GETXRF, ZSPLIT
  210. C---------------------------------------------------------
  211. C    TOOLPACK/1    Release: 2.5
  212. C---------------------------------------------------------
  213.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  214.       INTEGER OUTFD,  RMARG, REPRTS
  215.  
  216.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  217.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  218. C---------------------------------------------------------
  219. C    TOOLPACK/1    Release: 2.5
  220. C---------------------------------------------------------
  221.       INTEGER ANNFD,  DYNFD,  SUMFD
  222.       INTEGER ANNNAM(81), DYNNAM(81),
  223.      +        SUMNAM(81)
  224.  
  225.       COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
  226.      +                 ANNFD,  DYNFD,  SUMFD
  227.       SAVE
  228.  
  229.       C  = ZLOWER(BUFFER(1))
  230.       C2 = ZLOWER(BUFFER(2))
  231. C
  232. C  CALLGRAPH
  233. C
  234.       IF((C .EQ. 99).AND.(C2 .EQ. 97)) THEN
  235.         IF(GETXRF(BUFFER) .EQ. -2) THEN
  236.           CALL GRAPH
  237.         ELSE
  238.           CALL REPORT('FAILURE IN CALLGRAPH COMMAND.', OUTFD)
  239.         ENDIF
  240. C
  241. C  XREF
  242. C
  243.       ELSE IF(C .EQ. 120) THEN
  244.         IF(GETXRF(BUFFER) .EQ. -2) THEN
  245.           CALL LIST (-3)
  246.         ELSE
  247.           CALL REPORT('FAILURE IN XREFERENCE COMMAND.', OUTFD)
  248.         ENDIF
  249. C
  250. C  FULLXREF
  251. C
  252.       ELSE IF((C .EQ. 102) .AND. (C2 .EQ. 117)) THEN
  253.         IF(GETXRF(BUFFER) .EQ. -2) THEN
  254.           CALL LIST (-2)
  255.         ELSE
  256.           CALL REPORT('FAILURE IN FULLXREFERENCE COMMAND.', OUTFD)
  257.         ENDIF
  258. C
  259. C  TABLE LOAD
  260. C
  261.       ELSE IF((C .EQ. 116) .AND. (C2 .EQ. 97)) THEN
  262.         IF(GETXRF(BUFFER) .NE. -2) THEN
  263.           CALL REPORT('FAILURE IN SYMBOL TABLE LOAD COMMAND.', OUTFD)
  264.         ENDIF
  265. C
  266. C  SYMBOLS AND WARNINGS
  267. C
  268.       ELSE IF((C .EQ. 115) .AND. (C2 .EQ. 121)) THEN
  269.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  270.         CALL VLIST (-2, BODY)
  271.       ELSE IF(C .EQ. 119) THEN
  272.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  273.         CALL VLIST (-3, BODY)
  274. C
  275. C  COMMON USAGE
  276. C
  277.       ELSE IF((C .EQ. 99).AND.(C2 .EQ. 111)) THEN
  278.         IF(GETXRF(BUFFER) .EQ. -2) THEN
  279.           CALL COMOUT
  280.         ELSE
  281.           CALL REPORT('FAILURE IN COMMON USAGE COMMAND.', OUTFD)
  282.         ENDIF
  283. C
  284. C  FILE OPENING: ANNOTATED, HISTORY, SINGLE, SUMMARY AND TRACE
  285. C
  286.       ELSE IF((C .EQ. 97).AND.(C2 .EQ. 110)) THEN
  287.         IJUNK = ZSPLIT(BUFFER, JUNK, ANNNAM)
  288.         ANNFD = -1
  289.       ELSE IF(C .EQ. 114) THEN
  290.         IJUNK = ZSPLIT(BUFFER, JUNK, DYNNAM)
  291.         DYNFD = -1
  292.       ELSE IF((C .EQ. 115).AND.(C2 .EQ. 117)) THEN
  293.         IJUNK = ZSPLIT(BUFFER, JUNK, SUMNAM)
  294.         SUMFD = -1
  295. C
  296. C  ASSERTIONS
  297. C
  298.       ELSE IF((C .EQ. 97).AND.(C2 .EQ. 115)) THEN
  299.         CALL RSTATS(STATUS)
  300.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  301.         IF(STATUS .EQ. -2) THEN
  302.           CALL GETDYN(STATUS)
  303.           IF(STATUS .EQ. -2) THEN
  304.             CALL ASSLST(BODY)
  305.           ELSE
  306.             CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
  307.           ENDIF
  308.         ELSE
  309.           CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
  310.         ENDIF
  311. C
  312. C  DYNAMIC
  313. C
  314.       ELSE IF((C .EQ. 100) .AND. (C2 .EQ. 121)) THEN
  315.         CALL RSTATS(STATUS)
  316.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  317.         IF(STATUS .EQ. -2) THEN
  318.           CALL GETDYN(STATUS)
  319.           IF(STATUS .EQ. -2) THEN
  320.             CALL DYNLST(BODY)
  321.           ELSE
  322.             CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
  323.           ENDIF
  324.         ELSE
  325.           CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
  326.         ENDIF
  327. C
  328. C  SEGMENTS
  329. C
  330.       ELSE IF((C .EQ. 115).AND.(C2 .EQ. 101)) THEN
  331.         CALL RSTATS(STATUS)
  332.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  333.         IF(STATUS .EQ. -2) THEN
  334.           CALL GETDYN(STATUS)
  335.           IF(STATUS .EQ. -2) THEN
  336.             CALL SEGLST(BODY, .TRUE.)
  337.           ELSE
  338.             CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
  339.           ENDIF
  340.         ELSE
  341.           CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
  342.         ENDIF
  343. C
  344. C  ZERO SEGMENTS
  345. C
  346.       ELSE IF(C .EQ. 122) THEN
  347.         CALL RSTATS(STATUS)
  348.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  349.         IF(STATUS .EQ. -2) THEN
  350.           CALL GETDYN(STATUS)
  351.           IF(STATUS .EQ. -2) THEN
  352.             CALL SEGLST(BODY, .FALSE.)
  353.           ELSE
  354.             CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
  355.           ENDIF
  356.         ELSE
  357.           CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
  358.         ENDIF
  359. C
  360. C  LISTING
  361. C
  362.       ELSE IF(C .EQ. 108) THEN
  363.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  364.  
  365.         IF(BODY(1) .EQ. 129) THEN
  366.           CALL RSTATS(STATUS)
  367.           CALL GETDYN(STATUS)
  368.         ELSE
  369.           STATUS = -2
  370.         ENDIF
  371.         IF(STATUS .EQ. -2) THEN
  372.           CALL DOLIST(BODY)
  373.         ELSE
  374.           CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
  375.         ENDIF
  376. C
  377. C  STATIC
  378. C
  379.       ELSE IF((C .EQ. 115).AND.(C2 .EQ. 116)) THEN
  380.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  381.         CALL RSTATS(STATUS)
  382.         IF(STATUS .EQ. -2) THEN
  383.           CALL PROLST(BODY)
  384.         ELSE
  385.           CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
  386.         ENDIF
  387. C
  388. C  TOTALS
  389. C
  390.       ELSE IF((C .EQ. 116) .AND.(C2 .EQ. 111)) THEN
  391.         CALL RSTATS(STATUS)
  392.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  393.         IF(STATUS .EQ. -2) THEN
  394.           CALL GETDYN(STATUS)
  395.           IF(STATUS .EQ. -2) THEN
  396.             CALL TOTLST(BODY)
  397.           ELSE
  398.             CALL REPORT('ERROR IN READING RUNTIME FILE.', OUTFD)
  399.           ENDIF
  400.         ELSE
  401.           CALL REPORT('ERROR IN READING SUMMARY FILE.', OUTFD)
  402.         ENDIF
  403. C
  404. C  VERBOSE SWITCH
  405. C
  406.       ELSE IF(C .EQ. 118) THEN
  407.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  408.         IF(ZLOWER(BODY(1)) .EQ. 110) THEN
  409.           VERBOS = .FALSE.
  410.         ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
  411.           VERBOS = .TRUE.
  412.         ELSE
  413.           VERBOS = .NOT. VERBOS
  414.         ENDIF
  415. C
  416. C  DEBUG SWITCH
  417. C
  418.       ELSE IF((C .EQ. 100) .AND. (C2 .EQ. 101)) THEN
  419.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  420.         IF(ZLOWER(BODY(1)) .EQ. 110) THEN
  421.           DEBUG = .FALSE.
  422.         ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
  423.           DEBUG = .TRUE.
  424.         ELSE
  425.           DEBUG = .NOT. DEBUG
  426.         ENDIF
  427. C
  428. C  PROCEDURE SWITCH
  429. C
  430.       ELSE IF(C .EQ. 112) THEN
  431.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  432.         IF(ZLOWER(BODY(1)) .EQ. 110) THEN
  433.            DECLIE = .FALSE.
  434.         ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
  435.            DECLIE = .TRUE.
  436.         ELSE
  437.            DECLIE = .NOT. DECLIE
  438.         ENDIF
  439.  
  440. C
  441. C  CASE FOLDING SWITCH
  442. C
  443.       ELSE IF((C .EQ. 102) .AND. (C2 .EQ. 111)) THEN
  444.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  445.         IF(ZLOWER(BODY(1)) .EQ. 110) THEN
  446.           CASFOL = .FALSE.
  447.         ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
  448.           CASFOL = .TRUE.
  449.         ELSE
  450.           CASFOL = .NOT. CASFOL
  451.         ENDIF
  452. C
  453. C  INTRINSICS SWITCH
  454. C
  455.       ELSE IF((C .EQ. 105) .AND.(C2 .EQ. 110)) THEN
  456.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  457.         IF(ZLOWER(BODY(1)) .EQ. 110) THEN
  458.           INTRIN = .FALSE.
  459.         ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
  460.           INTRIN = .TRUE.
  461.         ELSE
  462.           INTRIN = .NOT. INTRIN
  463.         ENDIF
  464. C
  465. C  IMPLICIT SWITCH
  466. C
  467.       ELSE IF((C .EQ. 105) .AND.(C2 .EQ. 109)) THEN
  468.         IJUNK = ZSPLIT(BUFFER, JUNK, BODY)
  469.         IF(ZLOWER(BODY(1)) .EQ. 110) THEN
  470.           IMPLI = .FALSE.
  471.         ELSE IF(ZLOWER(BODY(1)) .EQ. 121) THEN
  472.           IMPLI = .TRUE.
  473.         ELSE
  474.           IMPLI = .NOT. IMPLI
  475.         ENDIF
  476. C
  477. C  UNRECOGNIZED COMMAND
  478. C
  479.       ELSE
  480.         CALL REPORT('UNRECOGNIZED COMMAND.', OUTFD)
  481.  
  482.       ENDIF
  483.  
  484.       END
  485. C----------------------------------------------------------------
  486. C
  487. C  PUT EVEYTHING BACK TO THE 'NORMAL' FORM. THIS ROUTINE IS NORMALLY
  488. C  CALLED AT THE END OF EACH OUTPUT SECTION TO RETURN THE OUTPUT
  489. C  STREAM TO A KNOWN STATE (NOT NECESSARILY THE ORIGINAL STATE!).
  490. C
  491.       SUBROUTINE COMPLT(FD)
  492.  
  493.       INTEGER FD
  494.  
  495.       CALL PUTCH(10, FD)
  496.       IF(FD .NE. 1) THEN
  497.         CALL ZMESS('..fi.', FD)
  498.         CALL ZMESS('..ju.', FD)
  499.         CALL ZMESS('..in 0.', FD)
  500.         CALL ZMESS('..ce 0.', FD)
  501.       ENDIF
  502.  
  503.       END
  504. C----------------------------------------------------------------
  505. C
  506. C  PRODUCE A LISTING BY READING THE ANNOTATED LISTING FILE AND
  507. C  REPLACING ALL THE ASSERTION AND SEGMENT NUMBERS WITH THEIR
  508. C  EXECUTION FREQUENCIES.
  509. C
  510.       SUBROUTINE DOLIST(COMAND)
  511.  
  512.       INTEGER I, STATUS, JUNK, START, END
  513.       INTEGER COMAND(*), BUFFER(134), ID(3), BODY(134)
  514.       INTEGER OPEN, GETLIN, ZLOWER, ZSEDID, CTOI, TYPE
  515.       LOGICAL SEGFLG
  516. C---------------------------------------------------------
  517. C    TOOLPACK/1    Release: 2.5
  518. C---------------------------------------------------------
  519. C
  520. C     .. Parameters ..
  521. C
  522. C  MAXSEG     The maximum number of segments that can be held in memory
  523. C  MAXROU     The maximum number of routines that can be held in memory
  524. C
  525.  
  526.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  527.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  528.       PARAMETER(MAXPRO= MAXROU + 1)
  529. C     ..
  530. C---------------------------------------------------------
  531. C    TOOLPACK/1    Release: 2.5
  532. C---------------------------------------------------------
  533.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  534.       INTEGER OUTFD,  RMARG, REPRTS
  535.  
  536.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  537.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  538. C---------------------------------------------------------
  539. C    TOOLPACK/1    Release: 2.5
  540. C---------------------------------------------------------
  541.       INTEGER ANNFD,  DYNFD,  SUMFD
  542.       INTEGER ANNNAM(81), DYNNAM(81),
  543.      +        SUMNAM(81)
  544.  
  545.       COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
  546.      +                 ANNFD,  DYNFD,  SUMFD
  547. C---------------------------------------------------------
  548. C    TOOLPACK/1    Release: 2.5
  549. C---------------------------------------------------------
  550. C
  551. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  552. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  553. C
  554. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  555. C             THE STATIC SUMMARY)
  556. C
  557. C  NAMES      THE NAMES OF THE ROUTINES
  558. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  559. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  560. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  561. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  562. C             IN EACH ROUTINE).
  563. C
  564. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  565. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  566. C             IN EACH ROUTINE).
  567. C
  568.  
  569.       INTEGER NUMROU, NUMSEG, NOASRT
  570.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  571.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  572.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  573.  
  574.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  575.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  576.       SAVE
  577.  
  578.       IF(ZLOWER(COMAND(1)) .EQ. 108) THEN
  579.         CALL DOLST2(COMAND)
  580.         RETURN
  581.       ENDIF
  582.  
  583.       IF(VERBOS) THEN
  584.         CALL PUTCH(10, OUTFD)
  585.         CALL ZMESS('The following listing of the instrumented.',OUTFD)
  586.         CALL ZMESS('program has been annotated with the segment.',OUTFD)
  587.         CALL ZMESS('execution frequencies a'//'nd assertion.',OUTFD)
  588.         CALL ZMESS('failure counts taken from the file:.',OUTFD)
  589.         CALL ZPTMES(DYNNAM,OUTFD)
  590.       ENDIF
  591.  
  592.       CALL PUTCH(10, OUTFD)
  593.       IF(OUTFD .NE. 1) THEN
  594.         CALL ZMESS ('..nf.', OUTFD)
  595.         CALL ZMESS ('..nj.', OUTFD)
  596.         CALL ZMESS ('..in 6.', OUTFD)
  597.       ENDIF
  598.  
  599.       ANNFD = OPEN(ANNNAM, 0)
  600.       IF(ANNFD .EQ. -1) THEN
  601.         CALL REPORT('UNABLE TO OPEN ANNOTATED LISTING FILE.', OUTFD)
  602.         RETURN
  603.       ENDIF
  604. C
  605. C  PROCESS EXECUTION LOOP. READ IN THE FILE LOOKING FOR ERRORS OR THE
  606. C  END OF FILE, WHICH ARE PROCESSED IMMEDIATLY. LINES OF INPUT ARE
  607. C  OUTPUT AGAIN IMMEDIATLY (OFFSET BY A LEFT MARGIN) UNLESS THEY ARE
  608. C  AN 'AN' SOURCE EMBEDDED DIRECTIVE.
  609. C
  610.    10 CONTINUE
  611.  
  612.         STATUS = GETLIN(BUFFER, ANNFD)
  613.         BUFFER(RMARG - 6) = 10
  614.         BUFFER(RMARG - 5)  = 129
  615.  
  616.         IF(STATUS .EQ. -1) THEN
  617.           CALL REPORT('ERROR IN READING ANNOTATED LISTING FILE.', OUTFD)
  618.           RETURN
  619.  
  620.         ELSE IF(STATUS .EQ. -100) THEN
  621.           CALL CLOSE(ANNFD)
  622.           CALL COMPLT(OUTFD)
  623.           RETURN
  624.  
  625.         ELSE
  626.           IF(ZSEDID(BUFFER, JUNK, ID, BODY) .EQ. -2) THEN
  627.             IF((ZLOWER(ID(1)) .EQ. 97) .AND.
  628.      +         (ZLOWER(ID(2)) .EQ. 110)) THEN
  629.               I = 1
  630.               SEGFLG = .TRUE.
  631.               START = CTOI(BODY, I)
  632.               CALL SKIPBL(BODY, I)
  633.               IF(BODY(I) .EQ. 10) THEN
  634.                 END = START
  635.               ELSE IF(ZLOWER(BODY(I)) .EQ. 97) THEN
  636.                 SEGFLG = .FALSE.
  637.                 END    = START
  638.               ELSE
  639.    30           CONTINUE
  640.                 IF(ZLOWER(BODY(I)) .EQ. 116) THEN
  641.                   I = I + 2
  642.                   END = CTOI(BODY, I)
  643.                 ELSE IF(TYPE(BODY(I)) .EQ. 2) THEN
  644.                   END = CTOI(BODY, I)
  645.                 ENDIF
  646.                 CALL SKIPBL(BODY, I)
  647.                 IF(BODY(I) .NE. 10) GO TO 30
  648.               ENDIF
  649.  
  650. C         ....OUTPUT THE COUNT INFORMATION
  651.               IF(END .LT. START) END = START
  652.               DO 20 I = START, END
  653.                 IF(OUTFD .NE. 1) CALL ZMESS('..ti 0.', OUTFD)
  654.                 IF(SEGFLG) THEN
  655.                   CALL ZCHOUT('SEGMENT .', OUTFD)
  656.                   CALL ZPTINT(I, 1, OUTFD)
  657.                   CALL ZCHOUT(': .', OUTFD)
  658.                   IF(COMAND(1) .EQ. 129) CALL ZPTINT(SEGS(I), 1, OUTFD)
  659.                   CALL PUTCH(10, OUTFD)
  660.                 ELSE
  661.                   CALL ZCHOUT('ASSERTION .', OUTFD)
  662.                   CALL ZPTINT(I, 1, OUTFD)
  663.                   CALL ZCHOUT(': .', OUTFD)
  664.                   IF(COMAND(1) .EQ. 129) CALL ZPTINT(ASRTS(I), 1, OUTFD)
  665.                   CALL PUTCH(10, OUTFD)
  666.                 ENDIF
  667.    20         CONTINUE
  668.  
  669.             ELSE
  670.               IF(OUTFD .EQ. 1) CALL ZOBLNK(6, OUTFD)
  671.               CALL PUTLIN(BUFFER, OUTFD)
  672.  
  673.             ENDIF
  674.  
  675.           ELSE
  676.             IF(OUTFD .EQ. 1) CALL ZOBLNK(6, OUTFD)
  677.             CALL PUTLIN(BUFFER, OUTFD)
  678.  
  679.           ENDIF
  680.         ENDIF
  681.  
  682.       GO TO 10
  683.  
  684.       END
  685. C----------------------------------------------------------------
  686. C
  687. C  PRODUCE A LISTING OF THE DOCUMENTATION SECTIONS OF A PROGRAM UNIT
  688. C
  689.       SUBROUTINE DOLST2(COMAND)
  690.  
  691.       INTEGER STATUS, JUNK
  692.       INTEGER COMAND(*), BUFFER(134), ID(3), BODY(134)
  693.       INTEGER OPEN, GETLIN, ZLOWER, ZSEDID, ZSEDTY
  694.       LOGICAL LSTFLG
  695. C---------------------------------------------------------
  696. C    TOOLPACK/1    Release: 2.5
  697. C---------------------------------------------------------
  698. C
  699. C     .. Parameters ..
  700. C
  701. C  MAXSEG     The maximum number of segments that can be held in memory
  702. C  MAXROU     The maximum number of routines that can be held in memory
  703. C
  704.  
  705.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  706.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  707.       PARAMETER(MAXPRO= MAXROU + 1)
  708. C     ..
  709. C---------------------------------------------------------
  710. C    TOOLPACK/1    Release: 2.5
  711. C---------------------------------------------------------
  712.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  713.       INTEGER OUTFD,  RMARG, REPRTS
  714.  
  715.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  716.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  717. C---------------------------------------------------------
  718. C    TOOLPACK/1    Release: 2.5
  719. C---------------------------------------------------------
  720.       INTEGER ANNFD,  DYNFD,  SUMFD
  721.       INTEGER ANNNAM(81), DYNNAM(81),
  722.      +        SUMNAM(81)
  723.  
  724.       COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
  725.      +                 ANNFD,  DYNFD,  SUMFD
  726.       SAVE
  727.  
  728.       IF(VERBOS) THEN
  729.         CALL PUTCH(10, OUTFD)
  730.         CALL ZMESS('The following listing is of the.',OUTFD)
  731.         CALL ZMESS('program unit embedded documentation.',OUTFD)
  732.         CALL ZMESS('found in file (this information can.',OUTFD)
  733.         CALL ZMESS('also be recovered using ISTDX): .',OUTFD)
  734.         CALL ZPTMES(DYNNAM,OUTFD)
  735.       ENDIF
  736.  
  737.       CALL PUTCH(10, OUTFD)
  738.       IF(OUTFD .NE. 1) THEN
  739.         CALL ZMESS ('..nf.', OUTFD)
  740.         CALL ZMESS ('..nj.', OUTFD)
  741.       ENDIF
  742.  
  743.       LSTFLG = .FALSE.
  744.       ANNFD = OPEN(ANNNAM, 0)
  745.       IF(ANNFD .EQ. -1) THEN
  746.         CALL REPORT('UNABLE TO OPEN ANNOTATED LISTING FILE.', OUTFD)
  747.         RETURN
  748.       ENDIF
  749. C
  750. C  PROCESS EXECUTION LOOP. READ IN THE FILE LOOKING FOR ERRORS OR THE
  751. C  END OF FILE, WHICH ARE PROCESSED IMMEDIATLY. LINES OF INPUT ARE
  752. C  OUTPUT AGAIN IMMEDIATLY UNLESS THEY ARE A 'DX' SOURCE EMBEDDED DIRECTIVE.
  753. C
  754.    10 CONTINUE
  755.  
  756.         STATUS = GETLIN(BUFFER, ANNFD)
  757.  
  758.         IF(STATUS .EQ. -1) THEN
  759.           CALL REPORT('ERROR IN READING ANNOTATED LISTING FILE.', OUTFD)
  760.           RETURN
  761.  
  762.         ELSE IF(STATUS .EQ. -100) THEN
  763.           CALL CLOSE(ANNFD)
  764.           CALL COMPLT(OUTFD)
  765.           RETURN
  766.  
  767.         ELSE
  768.           IF(ZSEDID(BUFFER, JUNK, ID, BODY) .EQ. -2) THEN
  769.             IF((ZLOWER(ID(1)) .EQ. 100) .AND.
  770.      +         (ZLOWER(ID(2)) .EQ. 120)) THEN
  771.               IF(ZSEDTY(BODY, STATUS) .NE. 112) THEN
  772.                 IF(STATUS .EQ. -2) THEN
  773.                   LSTFLG = .TRUE.
  774.                   CALL ZMESS('..sp.', OUTFD)
  775.                 ELSE IF(STATUS .EQ. -3 ) THEN
  776.                   LSTFLG = .FALSE.
  777.                 ENDIF
  778.               ENDIF
  779.             ENDIF
  780.           ELSE
  781.             IF(LSTFLG) THEN
  782.              IF(BUFFER(1) .EQ. 99 .OR. BUFFER(1) .EQ. 67 .OR.
  783.      +          BUFFER(1) .EQ. 42) CALL PUTLIN(BUFFER(2), OUTFD)
  784.             ENDIF
  785.           ENDIF
  786.  
  787.         ENDIF
  788.  
  789.       GO TO 10
  790.  
  791.       END
  792. C----------------------------------------------------------------
  793. C
  794. C  PRODUCE SEGMENT EXECUTION INFORMATION
  795. C
  796.       SUBROUTINE SEGLST(COMAND, FLAG)
  797.  
  798.       INTEGER I, JUNK, FIRST
  799.       INTEGER COMAND(*)
  800.       INTEGER ZSETP, ZPFIND
  801.       LOGICAL FLAG
  802. C---------------------------------------------------------
  803. C    TOOLPACK/1    Release: 2.5
  804. C---------------------------------------------------------
  805. C
  806. C     .. Parameters ..
  807. C
  808. C  MAXSEG     The maximum number of segments that can be held in memory
  809. C  MAXROU     The maximum number of routines that can be held in memory
  810. C
  811.  
  812.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  813.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  814.       PARAMETER(MAXPRO= MAXROU + 1)
  815. C     ..
  816. C---------------------------------------------------------
  817. C    TOOLPACK/1    Release: 2.5
  818. C---------------------------------------------------------
  819.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  820.       INTEGER OUTFD,  RMARG, REPRTS
  821.  
  822.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  823.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  824. C---------------------------------------------------------
  825. C    TOOLPACK/1    Release: 2.5
  826. C---------------------------------------------------------
  827.       INTEGER ANNFD,  DYNFD,  SUMFD
  828.       INTEGER ANNNAM(81), DYNNAM(81),
  829.      +        SUMNAM(81)
  830.  
  831.       COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
  832.      +                 ANNFD,  DYNFD,  SUMFD
  833. C---------------------------------------------------------
  834. C    TOOLPACK/1    Release: 2.5
  835. C---------------------------------------------------------
  836. C
  837. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  838. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  839. C
  840. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  841. C             THE STATIC SUMMARY)
  842. C
  843. C  NAMES      THE NAMES OF THE ROUTINES
  844. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  845. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  846. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  847. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  848. C             IN EACH ROUTINE).
  849. C
  850. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  851. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  852. C             IN EACH ROUTINE).
  853. C
  854.  
  855.       INTEGER NUMROU, NUMSEG, NOASRT
  856.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  857.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  858.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  859.  
  860.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  861.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  862.       SAVE
  863.  
  864.       JUNK = ZSETP(COMAND, CASFOL)
  865.  
  866.       IF(FLAG) THEN
  867.         IF(VERBOS) THEN
  868.           CALL PUTCH(10, OUTFD)
  869.           CALL ZMESS('The following table shows the execution.',OUTFD)
  870.           CALL ZMESS('frequencies for the various segments...',OUTFD)
  871.           CALL ZMESS('The first count for each program unit.',OUTFD)
  872.           CALL ZMESS('is also the invocation frequency for.',OUTFD)
  873.           CALL ZMESS('that unit...',OUTFD)
  874.         ENDIF
  875.  
  876.         CALL PUTCH(10, OUTFD)
  877.         IF(OUTFD .NE. 1) THEN
  878.           CALL ZMESS('..nf.', OUTFD)
  879.           CALL ZMESS('..nj.', OUTFD)
  880.           CALL ZMESS('..ce.', OUTFD)
  881.           CALL ZMESS('..ul 3.', OUTFD)
  882.         ENDIF
  883.         CALL ZMESS ('SEGMENT EXECUTION FREQUENCIES.', OUTFD)
  884.         CALL PUTCH(10, OUTFD)
  885.         CALL ZMESS(
  886.      +'NAME  FIRST SEG       EXECUTION FREQUENCIES.', OUTFD)
  887.         IF(OUTFD .EQ. 1) CALL ZMESS(
  888.      +'-------------------------------------------.', OUTFD)
  889.         CALL PUTCH(10, OUTFD)
  890.         IF(OUTFD .NE. 1) THEN
  891.           CALL ZMESS('..in 15.', OUTFD)
  892.           CALL ZMESS('..fi.', OUTFD)
  893.         ENDIF
  894.       ELSE
  895.         IF(VERBOS) THEN
  896.           CALL PUTCH(10, OUTFD)
  897.           CALL ZMESS('The following table shows those segments.',OUTFD)
  898.           CALL ZMESS('which have n'//'ot been executed at all...',OUTFD)
  899.         ENDIF
  900.  
  901.         CALL PUTCH(10, OUTFD)
  902.         IF(OUTFD .NE. 1) THEN
  903.           CALL ZMESS('..nf.', OUTFD)
  904.           CALL ZMESS('..nj.', OUTFD)
  905.           CALL ZMESS('..ce.', OUTFD)
  906.           CALL ZMESS('..ul 3.', OUTFD)
  907.         ENDIF
  908.         CALL ZMESS ('SEGMENTS NOT EXECUTED.', OUTFD)
  909.         CALL PUTCH(10, OUTFD)
  910.         CALL ZMESS(
  911.      +'NAME  FIRST SEG       SEGMENTS NOT EXECUTED.', OUTFD)
  912.         IF(OUTFD .EQ. 1) CALL ZMESS(
  913.      +'-------------------------------------------.', OUTFD)
  914.         CALL PUTCH(10, OUTFD)
  915.         IF(OUTFD .NE. 1) THEN
  916.           CALL ZMESS('..in 15.', OUTFD)
  917.           CALL ZMESS('..fi.', OUTFD)
  918.         ENDIF
  919.       ENDIF
  920.  
  921.       DO 10 I = 1, NUMROU
  922.         IF(ZPFIND(NAMES(1, I), 1, FIRST, JUNK) .EQ. -2) THEN
  923.           IF(FIRST .EQ. 1) THEN
  924.             IF(FLAG) CALL DOSEGS(I)
  925.             IF(.NOT. FLAG) CALL DOSEG0(I)
  926.           ENDIF
  927.         ENDIF
  928.    10 CONTINUE
  929.  
  930.       CALL COMPLT(OUTFD)
  931.  
  932.       END
  933. C----------------------------------------------------------------
  934. C
  935. C  PRODUCE ASSERTION EXECUTION INFORMATION
  936. C
  937.       SUBROUTINE ASSLST(COMAND)
  938.  
  939.       INTEGER I, JUNK, FIRST
  940.       INTEGER COMAND(*)
  941.       INTEGER ZSETP, ZPFIND
  942. C---------------------------------------------------------
  943. C    TOOLPACK/1    Release: 2.5
  944. C---------------------------------------------------------
  945. C
  946. C     .. Parameters ..
  947. C
  948. C  MAXSEG     The maximum number of segments that can be held in memory
  949. C  MAXROU     The maximum number of routines that can be held in memory
  950. C
  951.  
  952.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  953.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  954.       PARAMETER(MAXPRO= MAXROU + 1)
  955. C     ..
  956. C---------------------------------------------------------
  957. C    TOOLPACK/1    Release: 2.5
  958. C---------------------------------------------------------
  959.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  960.       INTEGER OUTFD,  RMARG, REPRTS
  961.  
  962.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  963.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  964. C---------------------------------------------------------
  965. C    TOOLPACK/1    Release: 2.5
  966. C---------------------------------------------------------
  967. C
  968. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  969. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  970. C
  971. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  972. C             THE STATIC SUMMARY)
  973. C
  974. C  NAMES      THE NAMES OF THE ROUTINES
  975. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  976. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  977. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  978. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  979. C             IN EACH ROUTINE).
  980. C
  981. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  982. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  983. C             IN EACH ROUTINE).
  984. C
  985.  
  986.       INTEGER NUMROU, NUMSEG, NOASRT
  987.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  988.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  989.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  990.  
  991.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  992.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  993.       SAVE
  994.  
  995.       JUNK = ZSETP(COMAND, CASFOL)
  996.  
  997.       IF(VERBOS) THEN
  998.         CALL PUTCH(10, OUTFD)
  999.         CALL ZMESS('The following table shows the failure.',OUTFD)
  1000.         CALL ZMESS('frequencies for the various assertions...',OUTFD)
  1001.       ENDIF
  1002.  
  1003.       CALL PUTCH(10, OUTFD)
  1004.       IF(OUTFD .NE. 1) THEN
  1005.         CALL ZMESS('..nf.', OUTFD)
  1006.         CALL ZMESS('..nj.', OUTFD)
  1007.       ENDIF
  1008.       IF(OUTFD .NE. 1) THEN
  1009.         CALL ZMESS('..ce.', OUTFD)
  1010.         CALL ZMESS('..ul 3.', OUTFD)
  1011.       ENDIF
  1012.       CALL ZMESS ('ASSERTION FAILURE FREQUENCIES.', OUTFD)
  1013.       CALL PUTCH(10, OUTFD)
  1014.       CALL ZMESS(
  1015.      +'NAME  FIRST ASS       FAILURE FREQUENCIES.', OUTFD)
  1016.       IF(OUTFD .EQ. 1) CALL ZMESS(
  1017.      +'-----------------------------------------.', OUTFD)
  1018.       CALL PUTCH(10, OUTFD)
  1019.       IF(OUTFD .NE. 1) THEN
  1020.         CALL ZMESS('..in 15.', OUTFD)
  1021.         CALL ZMESS('..fi.', OUTFD)
  1022.       ENDIF
  1023.  
  1024.       DO 10 I = 1, NUMROU
  1025.         IF(ZPFIND(NAMES(1, I), 1, FIRST, JUNK) .EQ. -2) THEN
  1026.           IF(FIRST .EQ. 1) CALL DOASRT(I)
  1027.         ENDIF
  1028.    10 CONTINUE
  1029.  
  1030.       CALL COMPLT(OUTFD)
  1031.  
  1032.       END
  1033. C------------------------------------------------------
  1034. C
  1035. C  OUTPUT THE SEGMENT EXECUTION FREQUENCIES FOR A SINGLE
  1036. C  PROGRAM UNIT.
  1037. C
  1038.       SUBROUTINE DOSEGS(ROUTIN)
  1039.  
  1040.       INTEGER ROUTIN, I, LIMIT, J, FIRST
  1041.       INTEGER GETLIM
  1042.       INTRINSIC MOD
  1043. C---------------------------------------------------------
  1044. C    TOOLPACK/1    Release: 2.5
  1045. C---------------------------------------------------------
  1046. C
  1047. C     .. Parameters ..
  1048. C
  1049. C  MAXSEG     The maximum number of segments that can be held in memory
  1050. C  MAXROU     The maximum number of routines that can be held in memory
  1051. C
  1052.  
  1053.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  1054.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  1055.       PARAMETER(MAXPRO= MAXROU + 1)
  1056. C     ..
  1057. C---------------------------------------------------------
  1058. C    TOOLPACK/1    Release: 2.5
  1059. C---------------------------------------------------------
  1060.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  1061.       INTEGER OUTFD,  RMARG, REPRTS
  1062.  
  1063.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  1064.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  1065. C---------------------------------------------------------
  1066. C    TOOLPACK/1    Release: 2.5
  1067. C---------------------------------------------------------
  1068. C
  1069. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  1070. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  1071. C
  1072. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  1073. C             THE STATIC SUMMARY)
  1074. C
  1075. C  NAMES      THE NAMES OF THE ROUTINES
  1076. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  1077. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  1078. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  1079. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  1080. C             IN EACH ROUTINE).
  1081. C
  1082. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  1083. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  1084. C             IN EACH ROUTINE).
  1085. C
  1086.  
  1087.       INTEGER NUMROU, NUMSEG, NOASRT
  1088.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  1089.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  1090.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  1091.  
  1092.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  1093.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  1094.       SAVE
  1095.  
  1096.       IF(OUTFD .NE. 1) CALL ZMESS('..ti -15.', OUTFD)
  1097.       CALL PUTLIN(NAMES(1, ROUTIN), OUTFD)
  1098.  
  1099.       CALL ZCHOUT(' (.', OUTFD)
  1100.       IF(GETLIM(ROUTIN, FIRST, LIMIT) .EQ. 0) THEN
  1101.         CALL ZMESS('none).', OUTFD)
  1102.         RETURN
  1103.       ENDIF
  1104.       CALL ZPTINT(FIRST, 4, OUTFD)
  1105.       CALL ZCHOUT(') :.', OUTFD)
  1106.       J = 0
  1107.  
  1108.       DO 10 I = FIRST, LIMIT
  1109.         CALL ZPTINT(SEGS(I), 8, OUTFD)
  1110.         J = J + 1
  1111.         IF(I .NE. LIMIT)  CALL ZCHOUT(', .', OUTFD)
  1112.         IF((I .EQ. LIMIT) .OR. (MOD(J, 5) .EQ. 0)) THEN
  1113.           CALL PUTCH(10, OUTFD)
  1114.           IF((I .NE. LIMIT) .AND. (OUTFD .EQ. 1))
  1115.      +       CALL ZOBLNK(15, OUTFD)
  1116.         ENDIF
  1117.    10 CONTINUE
  1118.  
  1119.       END
  1120. C------------------------------------------------------
  1121. C
  1122. C  OUTPUT THE SEGMENTS WHICH HAVE NOT BEEN EXECUTED FOR
  1123. C  A SINGLE PROGRAM UNIT.
  1124. C
  1125.       SUBROUTINE DOSEG0(ROUTIN)
  1126.  
  1127.       INTEGER ROUTIN, I, LIMIT, J, FIRST
  1128.       INTEGER GETLIM
  1129.       INTRINSIC MOD
  1130. C---------------------------------------------------------
  1131. C    TOOLPACK/1    Release: 2.5
  1132. C---------------------------------------------------------
  1133. C
  1134. C     .. Parameters ..
  1135. C
  1136. C  MAXSEG     The maximum number of segments that can be held in memory
  1137. C  MAXROU     The maximum number of routines that can be held in memory
  1138. C
  1139.  
  1140.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  1141.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  1142.       PARAMETER(MAXPRO= MAXROU + 1)
  1143. C     ..
  1144. C---------------------------------------------------------
  1145. C    TOOLPACK/1    Release: 2.5
  1146. C---------------------------------------------------------
  1147.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  1148.       INTEGER OUTFD,  RMARG, REPRTS
  1149.  
  1150.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  1151.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  1152. C---------------------------------------------------------
  1153. C    TOOLPACK/1    Release: 2.5
  1154. C---------------------------------------------------------
  1155. C
  1156. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  1157. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  1158. C
  1159. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  1160. C             THE STATIC SUMMARY)
  1161. C
  1162. C  NAMES      THE NAMES OF THE ROUTINES
  1163. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  1164. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  1165. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  1166. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  1167. C             IN EACH ROUTINE).
  1168. C
  1169. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  1170. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  1171. C             IN EACH ROUTINE).
  1172. C
  1173.  
  1174.       INTEGER NUMROU, NUMSEG, NOASRT
  1175.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  1176.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  1177.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  1178.  
  1179.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  1180.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  1181.       SAVE
  1182.  
  1183.       IF(OUTFD .NE. 1) CALL ZMESS('..ti -15.', OUTFD)
  1184.       CALL PUTLIN(NAMES(1, ROUTIN), OUTFD)
  1185.  
  1186.       CALL ZCHOUT(' (.', OUTFD)
  1187.       IF(GETLIM(ROUTIN, FIRST, LIMIT) .EQ. 0) THEN
  1188.         CALL ZMESS('none).', OUTFD)
  1189.         RETURN
  1190.       ENDIF
  1191.       CALL ZPTINT(FIRST, 4, OUTFD)
  1192.       CALL ZCHOUT(') :.', OUTFD)
  1193.       J = 0
  1194.  
  1195.       DO 10 I = FIRST, LIMIT
  1196.         IF(SEGS(I) .EQ. 0) THEN
  1197.           CALL ZPTINT(I, 8, OUTFD)
  1198.           J = J + 1
  1199.           IF(I .NE. LIMIT)  CALL ZCHOUT(', .', OUTFD)
  1200.         ENDIF
  1201.         IF((I .EQ. LIMIT) .OR. (MOD(J,5).EQ.0.AND.J.NE.0)) THEN
  1202.           CALL PUTCH(10, OUTFD)
  1203.         IF((I .NE. LIMIT) .AND. (OUTFD .EQ. 1))
  1204.      +       CALL ZOBLNK(15, OUTFD)
  1205.         ENDIF
  1206.    10 CONTINUE
  1207.  
  1208.       END
  1209. C------------------------------------------------------
  1210. C
  1211.       SUBROUTINE DOASRT(ROUTIN)
  1212.  
  1213.       INTEGER ROUTIN, I, LIMIT
  1214.       INTRINSIC MOD
  1215. C---------------------------------------------------------
  1216. C    TOOLPACK/1    Release: 2.5
  1217. C---------------------------------------------------------
  1218. C
  1219. C     .. Parameters ..
  1220. C
  1221. C  MAXSEG     The maximum number of segments that can be held in memory
  1222. C  MAXROU     The maximum number of routines that can be held in memory
  1223. C
  1224.  
  1225.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  1226.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  1227.       PARAMETER(MAXPRO= MAXROU + 1)
  1228. C     ..
  1229. C---------------------------------------------------------
  1230. C    TOOLPACK/1    Release: 2.5
  1231. C---------------------------------------------------------
  1232.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  1233.       INTEGER OUTFD,  RMARG, REPRTS
  1234.  
  1235.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  1236.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  1237. C---------------------------------------------------------
  1238. C    TOOLPACK/1    Release: 2.5
  1239. C---------------------------------------------------------
  1240. C
  1241. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  1242. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  1243. C
  1244. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  1245. C             THE STATIC SUMMARY)
  1246. C
  1247. C  NAMES      THE NAMES OF THE ROUTINES
  1248. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  1249. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  1250. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  1251. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  1252. C             IN EACH ROUTINE).
  1253. C
  1254. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  1255. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  1256. C             IN EACH ROUTINE).
  1257. C
  1258.  
  1259.       INTEGER NUMROU, NUMSEG, NOASRT
  1260.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  1261.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  1262.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  1263.  
  1264.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  1265.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  1266.       SAVE
  1267.  
  1268.       IF(ROUTIN .EQ.NUMROU) THEN
  1269.         LIMIT = NOASRT
  1270.       ELSE
  1271.         LIMIT = ISTASG(ROUTIN+1) - 1
  1272.       ENDIF
  1273.  
  1274.       IF(OUTFD .NE. 1) CALL ZMESS('..ti -15.', OUTFD)
  1275.       CALL PUTLIN(NAMES(1, ROUTIN), OUTFD)
  1276.       CALL ZCHOUT(' (.', OUTFD)
  1277.       IF(LIMIT - ISTASG(ROUTIN) .LT. 0) THEN
  1278.         CALL ZMESS('none).', OUTFD)
  1279.         RETURN
  1280.       ENDIF
  1281.       CALL ZPTINT(ISTASG(ROUTIN), 4, OUTFD)
  1282.       CALL ZCHOUT(') :.', OUTFD)
  1283.  
  1284.       DO 10 I = ISTASG(ROUTIN), LIMIT
  1285.         CALL ZPTINT(ASRTS(I), 8, OUTFD)
  1286.         IF(I .NE. LIMIT)  CALL ZCHOUT(', .', OUTFD)
  1287.         IF((I .EQ. LIMIT) .OR. (MOD(I, 5) .EQ. 0)) THEN
  1288.           CALL PUTCH(10, OUTFD)
  1289.           IF((I .NE. LIMIT) .AND. (OUTFD .EQ. 1))
  1290.      +       CALL ZOBLNK(15, OUTFD)
  1291.         ENDIF
  1292.    10 CONTINUE
  1293.  
  1294.       END
  1295. C--------------------------------------------------------------
  1296. C
  1297. C  GET THE INFORMATION REQUIRED TO PRODUCE XREFERENCE LISTING.
  1298. C  THIS CONSISTS OF READING IN THE SYMBOL TABLE(S) AND PLACING
  1299. C  THE INFORMATION IN THE INTERNAL ARRAYS.
  1300. C
  1301.       INTEGER FUNCTION GETXRF(BUFFER)
  1302.  
  1303.       INTEGER REFFD, JUNK, POINT, SYMFD, STATUS
  1304.       LOGICAL REFFLG
  1305.       INTEGER BUFFER(*), RHS(134), LHS(134), NAME(81)
  1306.       INTEGER OPEN, INDEXX, ZTBINT, ZTBTYP, ZGTCMD, ZSPLIT
  1307.  
  1308. C---------------------------------------------------------
  1309. C    TOOLPACK/1    Release: 2.5
  1310. C---------------------------------------------------------
  1311.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  1312.       INTEGER OUTFD,  RMARG, REPRTS
  1313.  
  1314.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  1315.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  1316. C---------------------------------------------------------
  1317. C    TOOLPACK/1    Release: 2.5
  1318. C---------------------------------------------------------
  1319. C
  1320. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  1321. C  AND XREFERENCE GENERATION ROUTINES.
  1322. C
  1323. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  1324. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  1325. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  1326. C
  1327. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  1328. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  1329. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  1330. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  1331. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  1332. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  1333. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  1334. C
  1335. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  1336. C  CALLD(2, X)   THE TABLE ENTRY.
  1337. C
  1338. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  1339. C  CALLR(2, X)   THE TABLE ENTRY.
  1340. C
  1341. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  1342. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  1343. C  COMLST THE LINKED LIST OF USERS.
  1344. C
  1345.       INTEGER MAXSIZ, MAXENT, MAXVAR
  1346.       PARAMETER (MAXVAR = 307200)
  1347.       PARAMETER (MAXSIZ = 2048)
  1348.       PARAMETER (MAXENT = 1024)
  1349.  
  1350.       INTEGER NUMCLD, NUMCLR, NUMCOM
  1351.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  1352.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  1353.  
  1354.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  1355.      +               NUMCLR, NUMCLD, NUMCOM
  1356.       SAVE
  1357.  
  1358.       JUNK = ZSPLIT(BUFFER, LHS, RHS)
  1359. C
  1360. C  IF THE LINE WAS 'XREF = ' THEN USE THE DEFAULT VALUES (IE: THOSE
  1361. C  ALREADY IN THE TABLE).
  1362. C
  1363.       IF(RHS(1) .EQ. 129) THEN
  1364.         GETXRF = ZTBTYP(ARRAY, JUNK, JUNK, JUNK, JUNK)
  1365.         RETURN
  1366.       ENDIF
  1367. C
  1368. C  CHECK THE NAME, A NAME IN THE FORMAT 'NAME' IS THE NAME OF A SYMBOL
  1369. C  TABLE FILE. A NAME IN THE FORMAT '(NAME)' IS A FILE CONTAINING A
  1370. C  LIST OF NAMES OF SYMBOL TABLE FILES.
  1371. C
  1372.       IF(RHS(1) .EQ. 40) THEN
  1373.         POINT  = INDEXX(RHS, 41)
  1374.         IF(POINT .NE. 0) RHS(POINT) = 129
  1375.         REFFLG = .TRUE.
  1376.         REFFD  = OPEN(RHS(2), 0)
  1377.         STATUS = ZGTCMD(NAME, REFFD)
  1378.  
  1379.       ELSE
  1380.         REFFLG = .FALSE.
  1381.         CALL SCOPY(RHS, 1, NAME, 1)
  1382.         STATUS = -2
  1383.  
  1384.       ENDIF
  1385. C
  1386. C  INITIALISE THE TABLE STRUCTURES.
  1387. C
  1388.       IF(ZTBINT(VARARR, MAXVAR, 8) .EQ. -1) CALL
  1389.      +          ERROR('UNABLE TO SET UP VAR TABLE.')
  1390.       NUMCLD = 0
  1391.       NUMCLR = 0
  1392.       IF(ZTBINT(ARRAY, MAXSIZ, 4) .EQ. -1) CALL
  1393.      +          ERROR('UNABLE TO SET UP XREF TABLE.')
  1394.       NUMCOM = 0
  1395.       IF(ZTBINT(COMARR, MAXSIZ, 12) .EQ. -1) CALL
  1396.      +          ERROR('UNABLE TO SET UP COMMON TABLE.')
  1397. C
  1398. C  RECOVER EACH SYMBOL TABLE IN TURN AND PROCESS IT.
  1399. C
  1400.    10 CONTINUE
  1401.         IF(STATUS .EQ. -1) THEN
  1402.           IF(REFFLG) CALL CLOSE(REFFD)
  1403.           GETXRF = -1
  1404.           RETURN
  1405.  
  1406.         ELSE IF(STATUS .EQ. -100) THEN
  1407.           IF(REFFLG) CALL CLOSE(REFFD)
  1408.           GETXRF = -2
  1409.           RETURN
  1410.  
  1411.         ELSE
  1412.           SYMFD = OPEN(NAME, 0)
  1413.           IF(SYMFD .EQ. -1) THEN
  1414.             CALL REPORT('SYMBOL TABLE OPEN FAILURE.', OUTFD)
  1415.             GETXRF = -1
  1416.             RETURN
  1417.           ENDIF
  1418.           CALL ZYINSY(SYMFD)
  1419.           CALL CLOSE (SYMFD)
  1420.           CALL XINFO
  1421.  
  1422.         END IF
  1423.  
  1424.         IF(REFFLG) THEN
  1425.           STATUS = ZGTCMD(NAME, REFFD)
  1426.         ELSE
  1427.           STATUS = -100
  1428.         ENDIF
  1429.  
  1430.       GO TO 10
  1431.  
  1432.       END
  1433. C---------------------------------------------------------------
  1434. C
  1435. C  SUBROUTINE TO PROCESS THE CURRENT SYMBOL TABLE
  1436. C
  1437.       SUBROUTINE XINFO
  1438.  
  1439.       INTEGER I, LENP, PU, NSYMS, SDTYPE
  1440.       INTEGER PUNAME(34), EXNAME(34), SYMIDX(5003),
  1441.      +        SYMBOL(8,5003)
  1442.       INTEGER LENGTH, ZIAND
  1443.       LOGICAL BDFLAG, INTFLG
  1444. C---------------------------------------------------------
  1445. C    TOOLPACK/1    Release: 2.5
  1446. C---------------------------------------------------------
  1447. C
  1448. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  1449. C  AND XREFERENCE GENERATION ROUTINES.
  1450. C
  1451. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  1452. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  1453. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  1454. C
  1455. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  1456. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  1457. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  1458. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  1459. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  1460. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  1461. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  1462. C
  1463. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  1464. C  CALLD(2, X)   THE TABLE ENTRY.
  1465. C
  1466. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  1467. C  CALLR(2, X)   THE TABLE ENTRY.
  1468. C
  1469. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  1470. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  1471. C  COMLST THE LINKED LIST OF USERS.
  1472. C
  1473.       INTEGER MAXSIZ, MAXENT, MAXVAR
  1474.       PARAMETER (MAXVAR = 30720)
  1475.       PARAMETER (MAXSIZ = 2048)
  1476.       PARAMETER (MAXENT = 1024)
  1477.  
  1478.       INTEGER NUMCLD, NUMCLR, NUMCOM
  1479.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  1480.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  1481.  
  1482.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  1483.      +               NUMCLR, NUMCLD, NUMCOM
  1484. C---------------------------------------------------------
  1485. C    TOOLPACK/1    Release: 2.5
  1486. C---------------------------------------------------------
  1487.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  1488.       INTEGER OUTFD,  RMARG, REPRTS
  1489.  
  1490.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  1491.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  1492.       SAVE
  1493.  
  1494.       PU = 1
  1495.  
  1496.    10 CONTINUE
  1497.  
  1498.         CALL ZYGSSI(SYMIDX, NSYMS, PU)
  1499.         BDFLAG = .FALSE.
  1500.  
  1501.         IF (NSYMS .EQ. 0) RETURN
  1502.         DO 20 I =1, NSYMS
  1503.           CALL ZYGTSY(SYMIDX(I), SYMBOL(1,I))
  1504.           SDTYPE = SYMBOL(4, I)
  1505.           IF(SYMBOL(1, I) .EQ. 4) THEN
  1506.             CALL ZYGTST(SYMBOL(2, I), PUNAME)
  1507.             LENP = LENGTH(PUNAME) + 1
  1508.             IF (LENP.GT.34) CALL ERROR('Program-unit name too long')
  1509.             IF(CASFOL) CALL ZTOCAP(PUNAME)
  1510.             IF(SDTYPE .EQ. -2) THEN
  1511.               BDFLAG = .TRUE.
  1512.             ELSE
  1513.               CALL XRADDP(PUNAME, LENP)
  1514.             ENDIF
  1515.           ENDIF
  1516.    20   CONTINUE
  1517.  
  1518.         DO 30 I = 1, NSYMS
  1519.           CALL ZYGTST(SYMBOL(2, I), EXNAME)
  1520.           IF (LENGTH(EXNAME).GE.34)
  1521.      +      CALL ERROR('External reference name too long')
  1522.           IF(CASFOL) CALL ZTOCAP(EXNAME)
  1523.  
  1524.           IF(SYMBOL(1, I) .EQ. 7) THEN
  1525.             IF(BDFLAG) CALL ERROR
  1526.      +        ('ILLEGAL PROCEDURE REFERENCE IN BLOCK DATA.')
  1527.             IF(ZIAND(SYMBOL(6,I), 4096) .NE. 0) THEN
  1528.               INTFLG = .TRUE.
  1529.             ELSE
  1530.               INTFLG = .FALSE.
  1531.             ENDIF
  1532.             IF(.NOT. INTRIN .AND. INTFLG) GO TO 30
  1533.             CALL XRADD(PUNAME, LENP, EXNAME, LENGTH(EXNAME) + 1, INTFLG)
  1534.             CALL XVADD(PUNAME, LENP, EXNAME, LENGTH(EXNAME) + 1, BDFLAG,
  1535.      +                 SYMBOL(1, I))
  1536.  
  1537.           ELSE IF(SYMBOL(1, I) .EQ. 9) THEN
  1538.             IF(BDFLAG) CALL ERROR
  1539.      +        ('ILLEGAL ENTRY POINT IN BLOCK DATA.')
  1540.             CALL XRENT(PUNAME, LENP, EXNAME, LENGTH(EXNAME) + 1)
  1541.  
  1542.           ELSE IF(SYMBOL(1, I) .EQ. 2) THEN
  1543.             CALL XRCOM(PUNAME, LENP, EXNAME, LENGTH(EXNAME) + 1, BDFLAG)
  1544.  
  1545.           ELSE IF(SYMBOL(1, I) .EQ. 4) THEN
  1546.             IF(.NOT. BDFLAG) CALL XVADD(PUNAME, LENP, PUNAME, LENP,
  1547.      +                                  BDFLAG, SYMBOL(1, I))
  1548.           ELSE
  1549.             IF(.NOT. BDFLAG) CALL XVADD(PUNAME, LENP, EXNAME,
  1550.      +                       LENGTH(EXNAME) + 1, BDFLAG, SYMBOL(1, I))
  1551.  
  1552.  
  1553.           ENDIF
  1554.    30   CONTINUE
  1555.  
  1556.         PU = PU + 1
  1557.  
  1558.       GO TO 10
  1559.  
  1560.       END
  1561. C---------------------------------------------------------------
  1562. C
  1563. C  FUNCTION TO ADD A COMMON BLOCK INTO THE CURRENT TABLE.
  1564. C
  1565.       SUBROUTINE XRCOM(PUNAME, LENP, COMNAM, LENC, BDFLAG)
  1566.  
  1567.       INTEGER PPOINT, CPOINT, LENP, LENC, POINT, STATUS
  1568.       INTEGER PUNAME(*), COMNAM(*), CVALS(12), JUNKV(4)
  1569.       INTEGER ZTBUPD, ZTBPUT, ZTBGET
  1570.       LOGICAL BDFLAG
  1571.  
  1572. C---------------------------------------------------------
  1573. C    TOOLPACK/1    Release: 2.5
  1574. C---------------------------------------------------------
  1575. C
  1576. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  1577. C  AND XREFERENCE GENERATION ROUTINES.
  1578. C
  1579. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  1580. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  1581. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  1582. C
  1583. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  1584. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  1585. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  1586. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  1587. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  1588. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  1589. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  1590. C
  1591. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  1592. C  CALLD(2, X)   THE TABLE ENTRY.
  1593. C
  1594. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  1595. C  CALLR(2, X)   THE TABLE ENTRY.
  1596. C
  1597. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  1598. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  1599. C  COMLST THE LINKED LIST OF USERS.
  1600. C
  1601.       INTEGER MAXSIZ, MAXENT, MAXVAR
  1602.       PARAMETER (MAXVAR = 30720)
  1603.       PARAMETER (MAXSIZ = 2048)
  1604.       PARAMETER (MAXENT = 1024)
  1605.  
  1606.       INTEGER NUMCLD, NUMCLR, NUMCOM
  1607.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  1608.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  1609.  
  1610.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  1611.      +               NUMCLR, NUMCLD, NUMCOM
  1612.       SAVE
  1613. C
  1614. C  SEARCH OUT THE ENTRY.
  1615. C
  1616.       CPOINT = ZTBGET(COMNAM, LENC, CVALS, COMARR)
  1617.       PPOINT = ZTBGET(PUNAME, LENP, JUNKV, ARRAY)
  1618. C
  1619. C  IF ENTRY WAS NOT THERE THEN INSERT IT INTO THE TABLE.
  1620. C
  1621.       IF(CPOINT .EQ. -1) THEN
  1622.         CVALS(1) = 0
  1623.         CVALS(2) = 129
  1624.         CPOINT = ZTBPUT(COMNAM, LENC, CVALS, COMARR)
  1625.       ENDIF
  1626.  
  1627.       IF((CPOINT .EQ. -1) .OR. (CPOINT .EQ. -100))
  1628.      +   CALL ERROR('UNABLE TO ENTER COMMON NAME INTO TABLE.')
  1629. C
  1630. C  NOW CHECK TO SEE IF THE LINKED LISTS CONTAIN THE APPROPRIATE
  1631. C  INFORMATION, INSERT IT IF NOT.
  1632. C
  1633.       IF(BDFLAG) THEN
  1634.         IF(CVALS(2) .NE. 129) THEN
  1635.           CALL REMARK('COMMON BLOCK MENTIONED IN TWO BLOCK DATA PUS.')
  1636.         ENDIF
  1637.         CALL SCOPY(PUNAME, 1, CVALS, 2)
  1638.         STATUS = ZTBUPD(CPOINT, CVALS, COMARR)
  1639.         RETURN
  1640.       ENDIF
  1641.  
  1642.       IF(CVALS(1) .EQ. 0) THEN
  1643.         NUMCOM = NUMCOM + 1
  1644.         IF(NUMCOM .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
  1645.         CVALS(1) = NUMCOM
  1646.         COMLST(1, NUMCOM) = 0
  1647.         COMLST(2, NUMCOM) = PPOINT
  1648.         STATUS = ZTBUPD(CPOINT, CVALS, COMARR)
  1649.  
  1650.       ELSE
  1651.         POINT = CVALS(1)
  1652.    10   CONTINUE
  1653.           IF(COMLST(2, POINT) .EQ. PPOINT) RETURN
  1654.           IF(COMLST(1, POINT) .EQ. 0) THEN
  1655.             NUMCOM = NUMCOM + 1
  1656.             IF(NUMCOM .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
  1657.             COMLST(1, POINT)  = NUMCOM
  1658.             COMLST(1, NUMCOM) = 0
  1659.             COMLST(2, NUMCOM) = PPOINT
  1660.             RETURN
  1661.           ENDIF
  1662.  
  1663.           POINT = COMLST(1, POINT)
  1664.  
  1665.         GO TO 10
  1666.  
  1667.       ENDIF
  1668.  
  1669.       END
  1670. C---------------------------------------------------------------
  1671. C
  1672. C  OUTPUT COMMON BLOCK USAGE INFORMATION
  1673. C
  1674.       SUBROUTINE COMOUT
  1675.  
  1676.       INTEGER I, JUNK, STATUS, POINT, ENTRYS, J
  1677.       INTEGER NAME(34), VALS(12)
  1678.       INTEGER ZTBACC, ZTBTYP
  1679. C---------------------------------------------------------
  1680. C    TOOLPACK/1    Release: 2.5
  1681. C---------------------------------------------------------
  1682. C
  1683. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  1684. C  AND XREFERENCE GENERATION ROUTINES.
  1685. C
  1686. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  1687. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  1688. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  1689. C
  1690. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  1691. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  1692. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  1693. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  1694. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  1695. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  1696. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  1697. C
  1698. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  1699. C  CALLD(2, X)   THE TABLE ENTRY.
  1700. C
  1701. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  1702. C  CALLR(2, X)   THE TABLE ENTRY.
  1703. C
  1704. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  1705. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  1706. C  COMLST THE LINKED LIST OF USERS.
  1707. C
  1708.       INTEGER MAXSIZ, MAXENT, MAXVAR
  1709.       PARAMETER (MAXVAR = 30720)
  1710.       PARAMETER (MAXSIZ = 2048)
  1711.       PARAMETER (MAXENT = 1024)
  1712.  
  1713.       INTEGER NUMCLD, NUMCLR, NUMCOM
  1714.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  1715.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  1716.  
  1717.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  1718.      +               NUMCLR, NUMCLD, NUMCOM
  1719. C---------------------------------------------------------
  1720. C    TOOLPACK/1    Release: 2.5
  1721. C---------------------------------------------------------
  1722.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  1723.       INTEGER OUTFD,  RMARG, REPRTS
  1724.  
  1725.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  1726.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  1727.       SAVE
  1728.  
  1729.       IF(ZTBTYP(COMARR, JUNK, ENTRYS, JUNK, JUNK) .NE. -2) CALL
  1730.      +   ERROR('INVALID COMMON NAME TABLE.')
  1731.  
  1732.       IF(VERBOS) THEN
  1733.         CALL PUTCH(10, OUTFD)
  1734.         CALL ZMESS('The following table details the usage.', OUTFD)
  1735.         CALL ZMESS('of common blocks within the specified.', OUTFD)
  1736.         CALL ZMESS('symbol table files...', OUTFD)
  1737.         CALL ZMESS('Each common block is given, followed.', OUTFD)
  1738.         CALL ZMESS('by the name of the block data program.', OUTFD)
  1739.         CALL ZMESS('unit it appears.', OUTFD)
  1740.         CALL ZMESS('in (if relevant).. $COMMON is unnamed.', OUTFD)
  1741.         CALL ZMESS('common, $BLOCKDATA is unnamed block data...', OUTFD)
  1742.       ENDIF
  1743.  
  1744.       CALL PUTCH(10, OUTFD)
  1745.       IF(OUTFD .NE. 1) CALL ZMESS('..in +6.', OUTFD)
  1746.  
  1747.       IF(ENTRYS .EQ. 0) THEN
  1748.         CALL ZMESS('There are n'//'o common blocks used...', OUTFD)
  1749.  
  1750.       ELSE
  1751.         DO 10 I = 1, ENTRYS
  1752.           STATUS = ZTBACC(I, NAME, JUNK, VALS, COMARR)
  1753.           IF(OUTFD .NE. 1) CALL ZMESS('..ti -6.', OUTFD)
  1754.           CALL PUTLIN(NAME, OUTFD)
  1755.           J = 0
  1756.           IF(VALS(2) .EQ. 129) THEN
  1757.             CALL ZMESS (':.', OUTFD)
  1758.           ELSE
  1759.             CALL ZCHOUT(': block data - .', OUTFD)
  1760.             CALL ZPTMES(VALS(2), OUTFD)
  1761.           ENDIF
  1762.           IF(OUTFD .NE. 1) THEN
  1763.             CALL ZMESS('..br.', OUTFD)
  1764.           ELSE
  1765.             CALL ZOBLNK(6, OUTFD)
  1766.           ENDIF
  1767.  
  1768.           POINT = VALS(1)
  1769.    20     CONTINUE
  1770.             IF(POINT .EQ. 0) THEN
  1771.               CALL PUTCH(10, OUTFD)
  1772.               GO TO 10
  1773.             ENDIF
  1774.             STATUS = ZTBACC(COMLST(2, POINT), NAME, JUNK, VALS, ARRAY)
  1775.  
  1776.             IF(OUTFD .EQ. 1) THEN
  1777.               CALL PUTLIN(NAME, OUTFD)
  1778.               J = J + 1
  1779.               POINT  = COMLST(1, POINT)
  1780.               IF(POINT .EQ. 0) THEN
  1781.                 CALL PUTCH(10, OUTFD)
  1782.                 GO TO 20
  1783.               ELSE
  1784.                 CALL PUTCH(44, OUTFD)
  1785.                 IF(MOD(J, 5) .EQ. 0) THEN
  1786.                   CALL PUTCH(10, OUTFD)
  1787.                   CALL ZOBLNK(6, OUTFD)
  1788.                 ENDIF
  1789.                 GO TO 20
  1790.               ENDIF
  1791.  
  1792.             ELSE
  1793.               CALL PUTLIN(NAME, OUTFD)
  1794.               POINT  = COMLST(1, POINT)
  1795.               IF(POINT .NE. 0) THEN
  1796.                 CALL ZMESS(',.', OUTFD)
  1797.                 GO TO 20
  1798.               ELSE
  1799.                 CALL PUTCH(10, OUTFD)
  1800.               ENDIF
  1801.             ENDIF
  1802.  
  1803.    10   CONTINUE
  1804.  
  1805.       ENDIF
  1806.  
  1807.       CALL COMPLT(OUTFD)
  1808.  
  1809.       END
  1810. C---------------------------------------------------------------
  1811. C
  1812. C  FUNCTION TO ADD A CALLER/CALLED PAIR INTO THE CURRENT TABLE.
  1813. C
  1814.       SUBROUTINE XRADD(CALLER, LENR, CALLED, LEND, IFLAG)
  1815.  
  1816.       INTEGER DPOINT, RPOINT, LENR, LEND, POINT, JUNK
  1817.       INTEGER CALLER(*), CALLED(*), DVALS(4), RVALS(4), JUNKV(4),
  1818.      +        JUNKA(34)
  1819.       INTEGER ZTBUPD, ZTBPUT, ZTBGET, ZTBACC
  1820.       LOGICAL DFLAG, RFLAG, IFLAG
  1821.  
  1822. C---------------------------------------------------------
  1823. C    TOOLPACK/1    Release: 2.5
  1824. C---------------------------------------------------------
  1825. C
  1826. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  1827. C  AND XREFERENCE GENERATION ROUTINES.
  1828. C
  1829. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  1830. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  1831. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  1832. C
  1833. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  1834. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  1835. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  1836. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  1837. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  1838. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  1839. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  1840. C
  1841. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  1842. C  CALLD(2, X)   THE TABLE ENTRY.
  1843. C
  1844. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  1845. C  CALLR(2, X)   THE TABLE ENTRY.
  1846. C
  1847. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  1848. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  1849. C  COMLST THE LINKED LIST OF USERS.
  1850. C
  1851.       INTEGER MAXSIZ, MAXENT, MAXVAR
  1852.       PARAMETER (MAXVAR = 30720)
  1853.       PARAMETER (MAXSIZ = 2048)
  1854.       PARAMETER (MAXENT = 1024)
  1855.  
  1856.       INTEGER NUMCLD, NUMCLR, NUMCOM
  1857.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  1858.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  1859.  
  1860.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  1861.      +               NUMCLR, NUMCLD, NUMCOM
  1862.       SAVE
  1863. C
  1864. C  SEARCH OUT THE TWO ENTRIES.
  1865. C
  1866.       DPOINT = ZTBGET(CALLED, LEND, DVALS, ARRAY)
  1867.       RPOINT = ZTBGET(CALLER, LENR, RVALS, ARRAY)
  1868. C
  1869. C  IF EITHER ENTRY WAS NOT THERE THEN INSERT IT INTO THE TABLE.
  1870. C
  1871.       IF(RPOINT .EQ. -1) THEN
  1872.         RVALS(1) = 0
  1873.         RVALS(2) = 0
  1874.         RVALS(3) = 0
  1875.         RVALS(4) = 0
  1876.         RPOINT = ZTBPUT(CALLER, LENR, RVALS, ARRAY)
  1877.       ENDIF
  1878.       IF(DPOINT .EQ. -1) THEN
  1879.         DVALS(1) = 0
  1880.         DVALS(2) = 0
  1881.         DVALS(3) = 0
  1882.         DVALS(4) = 0
  1883.         DPOINT = ZTBPUT(CALLED, LEND, DVALS, ARRAY)
  1884.       ENDIF
  1885.  
  1886.       IF((RPOINT .EQ. -1) .OR. (RPOINT .EQ. -100) .OR.
  1887.      +   (DPOINT .EQ. -1) .OR. (DPOINT .EQ. -100))
  1888.      +   CALL ERROR('UNABLE TO ENTER SYMBOL INTO TABLE.')
  1889. C
  1890. C  NOW CHECK TO SEE IF THE LINKED LISTS CONTAIN THE APPROPRIATE
  1891. C  INFORMATION, INSERT IT IF NOT.
  1892. C
  1893.       DFLAG = .FALSE.
  1894.       RFLAG = .FALSE.
  1895.  
  1896.       IF(IFLAG) THEN
  1897.         IF(DVALS(4) .NE. -1) THEN
  1898.           DFLAG = .TRUE.
  1899.           DVALS(4) = -1
  1900.         ENDIF
  1901.       ENDIF
  1902.  
  1903.       IF(DVALS(1) .EQ. 0) THEN
  1904.         NUMCLR = NUMCLR + 1
  1905.         IF(NUMCLR .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
  1906.         DVALS(1) = NUMCLR
  1907.         CALLR(1, NUMCLR) = 0
  1908.         CALLR(2, NUMCLR) = RPOINT
  1909.         DFLAG = .TRUE.
  1910.  
  1911.       ELSE
  1912.         POINT = DVALS(1)
  1913.    10   CONTINUE
  1914.           IF(CALLR(2, POINT) .EQ. RPOINT) GO TO 15
  1915.           IF(CALLR(1, POINT) .EQ. 0) THEN
  1916.             NUMCLR = NUMCLR + 1
  1917.             IF(NUMCLR .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
  1918.             CALLR(1, POINT)  = NUMCLR
  1919.             CALLR(1, NUMCLR) = 0
  1920.             CALLR(2, NUMCLR) = RPOINT
  1921.             GO TO 15
  1922.           ENDIF
  1923.  
  1924.           POINT = CALLR(1, POINT)
  1925.  
  1926.         GO TO 10
  1927.  
  1928.       ENDIF
  1929.  
  1930.    15 CONTINUE
  1931.       IF(RVALS(2) .EQ. 0) THEN
  1932.         NUMCLD = NUMCLD + 1
  1933.         IF(NUMCLD .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
  1934.         RVALS(2) = NUMCLD
  1935.         CALLD(1, NUMCLD) = 0
  1936.         CALLD(2, NUMCLD) = DPOINT
  1937.         RFLAG = .TRUE.
  1938.  
  1939.       ELSE
  1940. C
  1941. C       CHECK TO SEE IF THIS IS AN ENTRY POINT AND GO TO THE MAIN ROUTINE IF SO
  1942. C
  1943.         IF(RVALS(2) .GT. 0) THEN
  1944.           POINT = RVALS(2)
  1945.         ELSE
  1946.           IF(ZTBACC(-RVALS(2), JUNKA, JUNK, JUNKV, ARRAY) .NE. -2)
  1947.      +       CALL ERROR('INVALID ENTRY POINT.')
  1948.           POINT = JUNKV(2)
  1949.  
  1950.         ENDIF
  1951.  
  1952.    20   CONTINUE
  1953.           IF(CALLD(2, POINT) .EQ. DPOINT) GO TO 25
  1954.           IF(CALLD(1, POINT) .EQ. 0) THEN
  1955.             NUMCLD = NUMCLD + 1
  1956.             IF(NUMCLD .GT. MAXENT) CALL ERROR('TABLE OVERFLOW.')
  1957.             CALLD(1, POINT)  = NUMCLD
  1958.             CALLD(1, NUMCLR) = 0
  1959.             CALLD(2, NUMCLD) = DPOINT
  1960.             GO TO 25
  1961.           ENDIF
  1962.  
  1963.           POINT = CALLD(1, POINT)
  1964.  
  1965.         GO TO 20
  1966.  
  1967.       ENDIF
  1968. C
  1969. C  UPDATE THE ENTRIES
  1970. C
  1971.    25 CONTINUE
  1972.       IF(DFLAG) DPOINT = ZTBUPD(DPOINT, DVALS, ARRAY)
  1973.       IF(RFLAG) RPOINT = ZTBUPD(RPOINT, RVALS, ARRAY)
  1974.  
  1975.       IF((RPOINT .EQ. -1) .OR. (DPOINT .EQ. -1))
  1976.      +   CALL ERROR('AL: UNABLE TO UPDATE SYMBOL IN TABLE.')
  1977.  
  1978.       END
  1979. C---------------------------------------------------------------
  1980. C
  1981. C  FUNCTION TO ADD A PROGRAM UNIT NAME INTO THE CURRENT TABLE.
  1982. C
  1983.       SUBROUTINE XRADDP(CALLER, LENR)
  1984.  
  1985.       INTEGER RPOINT, LENR
  1986.       INTEGER CALLER(*), RVALS(4)
  1987.       INTEGER ZTBPUT, ZTBGET, ZTBUPD
  1988.  
  1989. C---------------------------------------------------------
  1990. C    TOOLPACK/1    Release: 2.5
  1991. C---------------------------------------------------------
  1992. C
  1993. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  1994. C  AND XREFERENCE GENERATION ROUTINES.
  1995. C
  1996. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  1997. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  1998. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  1999. C
  2000. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  2001. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  2002. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  2003. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  2004. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  2005. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  2006. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  2007. C
  2008. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  2009. C  CALLD(2, X)   THE TABLE ENTRY.
  2010. C
  2011. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  2012. C  CALLR(2, X)   THE TABLE ENTRY.
  2013. C
  2014. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  2015. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  2016. C  COMLST THE LINKED LIST OF USERS.
  2017. C
  2018.       INTEGER MAXSIZ, MAXENT, MAXVAR
  2019.       PARAMETER (MAXVAR = 30720)
  2020.       PARAMETER (MAXSIZ = 2048)
  2021.       PARAMETER (MAXENT = 1024)
  2022.  
  2023.       INTEGER NUMCLD, NUMCLR, NUMCOM
  2024.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  2025.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  2026.  
  2027.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  2028.      +               NUMCLR, NUMCLD, NUMCOM
  2029.       SAVE
  2030. C
  2031. C  SEARCH OUT THE ENTRY
  2032. C
  2033.       RPOINT = ZTBGET(CALLER, LENR, RVALS, ARRAY)
  2034. C
  2035. C  IF ENTRY WAS NOT THERE THEN INSERT IT INTO THE TABLE.
  2036. C
  2037.       IF(RPOINT .EQ. -1) THEN
  2038.         RVALS(1) = 0
  2039.         RVALS(2) = 0
  2040.         RVALS(3) = 0
  2041.         RVALS(4) = 1
  2042.         RPOINT = ZTBPUT(CALLER, LENR, RVALS, ARRAY)
  2043.       ELSE
  2044.         IF(RVALS(4) .NE. 0) THEN
  2045.           CALL ERROR('AL: DUPLICATE PROGRAM UNIT NAME.')
  2046.         ELSE
  2047.           RVALS(4) = 1
  2048.           RPOINT = ZTBUPD(RPOINT, RVALS, ARRAY)
  2049.         ENDIF
  2050.       ENDIF
  2051.  
  2052.       IF((RPOINT .EQ. -1) .OR. (RPOINT .EQ. -100))
  2053.      +   CALL ERROR('AL: UNABLE TO ENTER SYMBOL INTO TABLE.')
  2054.  
  2055.       END
  2056. C---------------------------------------------------------------
  2057. C
  2058. C  ADD AN ENTRY POINT TO THE TABLE, AN ENTRY POINT IS A FORM OF
  2059. C  ALIAS TO THE SPECIFIED PU-NAME.
  2060. C
  2061.       SUBROUTINE XRENT(PUNAM, LENP, ENNAM, LENE)
  2062.  
  2063.       INTEGER LENE, LENP, PPOINT, EPOINT
  2064.       INTEGER PUNAM(*), ENNAM(*), PVALS(4), EVALS(4)
  2065.       INTEGER ZTBGET, ZTBUPD, ZTBPUT
  2066.  
  2067. C---------------------------------------------------------
  2068. C    TOOLPACK/1    Release: 2.5
  2069. C---------------------------------------------------------
  2070. C
  2071. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  2072. C  AND XREFERENCE GENERATION ROUTINES.
  2073. C
  2074. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  2075. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  2076. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  2077. C
  2078. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  2079. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  2080. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  2081. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  2082. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  2083. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  2084. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  2085. C
  2086. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  2087. C  CALLD(2, X)   THE TABLE ENTRY.
  2088. C
  2089. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  2090. C  CALLR(2, X)   THE TABLE ENTRY.
  2091. C
  2092. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  2093. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  2094. C  COMLST THE LINKED LIST OF USERS.
  2095. C
  2096.       INTEGER MAXSIZ, MAXENT, MAXVAR
  2097.       PARAMETER (MAXVAR = 30720)
  2098.       PARAMETER (MAXSIZ = 2048)
  2099.       PARAMETER (MAXENT = 1024)
  2100.  
  2101.       INTEGER NUMCLD, NUMCLR, NUMCOM
  2102.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  2103.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  2104.  
  2105.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  2106.      +               NUMCLR, NUMCLD, NUMCOM
  2107.       SAVE
  2108. C
  2109. C  SEARCH OUT THE TWO ENTRIES.
  2110. C
  2111.       PPOINT = ZTBGET(PUNAM, LENP, PVALS, ARRAY)
  2112.       EPOINT = ZTBGET(ENNAM, LENE, EVALS, ARRAY)
  2113. C
  2114. C  IF EITHER ENTRY WAS NOT THERE THEN INSERT IT INTO THE TABLE.
  2115. C
  2116.       IF(PPOINT .EQ. -1) THEN
  2117.         PVALS(1) = 0
  2118.         PVALS(2) = 0
  2119.         PVALS(3) = 0
  2120.         PVALS(4) = 1
  2121.         PPOINT = ZTBPUT(PUNAM, LENP, PVALS, ARRAY)
  2122.       ENDIF
  2123.       IF(EPOINT .EQ. -1) THEN
  2124.         EVALS(1) = 0
  2125.         EVALS(2) = 0
  2126.         EVALS(3) = 0
  2127.         EVALS(4) = 1
  2128.         EPOINT = ZTBPUT(ENNAM, LENE, EVALS, ARRAY)
  2129.       ENDIF
  2130.  
  2131.       IF((PPOINT .EQ. -1) .OR. (PPOINT .EQ. -100) .OR.
  2132.      +   (EPOINT .EQ. -1) .OR. (EPOINT .EQ. -100))
  2133.      +   CALL ERROR('UNABLE TO ENTER SYMBOL INTO TABLE.')
  2134.  
  2135.       EVALS(2) = - PPOINT
  2136.       IF(ZTBUPD(EPOINT, EVALS, ARRAY) .NE. -2) CALL
  2137.      +   ERROR('UNABLE TO UPDATE ENTRY POINT.')
  2138.  
  2139.       END
  2140. C-------------------------------------------------------------
  2141. C
  2142. C  PRODUCE A CROSS REFERENCE LISTING.
  2143. C
  2144.       SUBROUTINE LIST(FLAG)
  2145.  
  2146.       INTEGER I, STATUS, JUNK, ENTRYS, POINT, NEXT, FLAG, J
  2147.       INTEGER NAME(34), VALUES(4), JUNKS(4)
  2148.       INTEGER ZTBTYP, ZTBACC
  2149. C---------------------------------------------------------
  2150. C    TOOLPACK/1    Release: 2.5
  2151. C---------------------------------------------------------
  2152.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  2153.       INTEGER OUTFD,  RMARG, REPRTS
  2154.  
  2155.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  2156.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  2157. C---------------------------------------------------------
  2158. C    TOOLPACK/1    Release: 2.5
  2159. C---------------------------------------------------------
  2160. C
  2161. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  2162. C  AND XREFERENCE GENERATION ROUTINES.
  2163. C
  2164. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  2165. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  2166. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  2167. C
  2168. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  2169. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  2170. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  2171. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  2172. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  2173. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  2174. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  2175. C
  2176. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  2177. C  CALLD(2, X)   THE TABLE ENTRY.
  2178. C
  2179. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  2180. C  CALLR(2, X)   THE TABLE ENTRY.
  2181. C
  2182. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  2183. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  2184. C  COMLST THE LINKED LIST OF USERS.
  2185. C
  2186.       INTEGER MAXSIZ, MAXENT, MAXVAR
  2187.       PARAMETER (MAXVAR = 30720)
  2188.       PARAMETER (MAXSIZ = 2048)
  2189.       PARAMETER (MAXENT = 1024)
  2190.  
  2191.       INTEGER NUMCLD, NUMCLR, NUMCOM
  2192.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  2193.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  2194.  
  2195.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  2196.      +               NUMCLR, NUMCLD, NUMCOM
  2197.       SAVE
  2198.  
  2199.       IF(ZTBTYP(ARRAY, JUNK, ENTRYS, JUNK, JUNK) .NE. -2) CALL
  2200.      +   ERROR('INVALID TABLE.')
  2201.  
  2202.       IF(VERBOS) THEN
  2203.         CALL PUTCH(10, OUTFD)
  2204.         CALL ZMESS('The following sub-sections show the.', OUTFD)
  2205.         CALL ZMESS('routine dependencies of those routines.',OUTFD)
  2206.         CALL ZMESS('a'//'nd entry points detailed within the.', OUTFD)
  2207.         CALL ZMESS('specified symbol table files...', OUTFD)
  2208.       ENDIF
  2209.  
  2210.       CALL PUTCH(10, OUTFD)
  2211.       IF(OUTFD .NE. 1) CALL ZMESS('..in +10.', OUTFD)
  2212.  
  2213.       DO 10 I = 1, ENTRYS
  2214.         STATUS = ZTBACC(I, NAME, JUNK, VALUES, ARRAY)
  2215.         CALL PUTCH(10, OUTFD)
  2216.         IF(OUTFD .NE. 1) CALL ZMESS('..ti -10.', OUTFD)
  2217.         CALL ZPTMES(NAME, OUTFD)
  2218.         J = 0
  2219.  
  2220.         IF(FLAG .EQ. -2) THEN
  2221.           IF(VALUES(2) .EQ. 0) THEN
  2222.             IF(OUTFD .NE. 1) THEN
  2223.               CALL ZMESS('..ti -4.', OUTFD)
  2224.             ELSE
  2225.               CALL ZOBLNK(6, OUTFD)
  2226.             ENDIF
  2227.             IF(VALUES(4) .EQ. 1) THEN
  2228.               CALL ZMESS('CALLS NOTHING:.', OUTFD)
  2229.             ELSE IF(VALUES(4) .EQ. -1) THEN
  2230.               CALL ZMESS('[Standard Intrinsic].', OUTFD)
  2231.             ELSE
  2232.               CALL ZMESS('[No Symbol Table Provided].', OUTFD)
  2233.             ENDIF
  2234.  
  2235.           ELSE
  2236.             IF(VALUES(2) .LT. 0) THEN
  2237.               IF(OUTFD .NE. 1) THEN
  2238.                 CALL ZMESS('..ti -4.', OUTFD)
  2239.               ELSE
  2240.                 CALL ZOBLNK(6, OUTFD)
  2241.               ENDIF
  2242.               CALL ZCHOUT('ENTRY POINT IN: .', OUTFD)
  2243.               STATUS = ZTBACC(-VALUES(2), NAME, JUNK, JUNKS, ARRAY)
  2244.               CALL ZPTMES(NAME, OUTFD)
  2245.               VALUES(2) = JUNKS(2)
  2246.  
  2247.             ELSE
  2248.               IF(OUTFD .NE. 1) THEN
  2249.                 CALL ZMESS('..ti -4.', OUTFD)
  2250.                 CALL ZMESS('CALLS:.', OUTFD)
  2251.               ELSE
  2252.                 CALL ZOBLNK(6, OUTFD)
  2253.                 CALL ZMESS('CALLS:.', OUTFD)
  2254.                 CALL ZOBLNK(10, OUTFD)
  2255.               ENDIF
  2256.  
  2257.               POINT = VALUES(2)
  2258.    15         CONTINUE
  2259.                 NEXT  = CALLD(2, POINT)
  2260.                 STATUS = ZTBACC(NEXT, NAME, JUNK, JUNKS, ARRAY)
  2261.                 CALL PUTLIN(NAME, OUTFD)
  2262.                 J = J + 1
  2263.                 POINT = CALLD(1, POINT)
  2264.                 IF(POINT .NE. 0) THEN
  2265.                   CALL ZCHOUT(', .', OUTFD)
  2266.                   IF(MOD(J, 5) .EQ. 0) THEN
  2267.                     CALL PUTCH(10, OUTFD)
  2268.                     IF(OUTFD .EQ. 1) CALL ZOBLNK(10, OUTFD)
  2269.                   ENDIF
  2270.                   GO TO 15
  2271.                 ENDIF
  2272.                 CALL PUTCH(10, OUTFD)
  2273.             ENDIF
  2274.           ENDIF
  2275.         ENDIF
  2276.  
  2277.         J = 0
  2278.         IF(VALUES(1) .EQ. 0) THEN
  2279.           IF(OUTFD .NE. 1) THEN
  2280.             CALL ZMESS('..ti -4.', OUTFD)
  2281.           ELSE
  2282.             CALL ZOBLNK(6, OUTFD)
  2283.           ENDIF
  2284.           CALL ZMESS('NOT CALLED.', OUTFD)
  2285.         ELSE
  2286.           IF(OUTFD .NE. 1) THEN
  2287.             CALL ZMESS('..ti -4.', OUTFD)
  2288.           ELSE
  2289.             CALL ZOBLNK(6, OUTFD)
  2290.           ENDIF
  2291.           CALL ZMESS('CALLED BY:.', OUTFD)
  2292.           IF(OUTFD .EQ. 1) CALL ZOBLNK(10, OUTFD)
  2293.           POINT = VALUES(1)
  2294.    25     CONTINUE
  2295.             NEXT  = CALLR(2, POINT)
  2296.             STATUS = ZTBACC(NEXT, NAME, JUNK, JUNKS, ARRAY)
  2297.             CALL PUTLIN(NAME, OUTFD)
  2298.             J = J + 1
  2299.             POINT = CALLR(1, POINT)
  2300.             IF(POINT .NE. 0) THEN
  2301.               CALL ZCHOUT(', .', OUTFD)
  2302.               IF(MOD(J, 5) .EQ. 0) THEN
  2303.                 CALL PUTCH(10, OUTFD)
  2304.                 IF(OUTFD .EQ. 1) CALL ZOBLNK(10, OUTFD)
  2305.               ENDIF
  2306.               GO TO 25
  2307.             ENDIF
  2308.             CALL PUTCH(10, OUTFD)
  2309.         ENDIF
  2310.  
  2311.    10 CONTINUE
  2312.  
  2313.       CALL COMPLT(OUTFD)
  2314.  
  2315.       END
  2316. C-----------------------------------------------------------------
  2317. C
  2318. C  FUNCTION TO READ A DYNAMIC EXECUTION FILE (CURRENT OR HISTORY)
  2319. C
  2320.       SUBROUTINE GETDYN(ENDST)
  2321.  
  2322.       INTEGER I, STATUS, POINT, NOSEGS, ENDST
  2323.       INTEGER BUFFER(134)
  2324.       INTEGER GETLIN, CTOI, OPEN
  2325. C---------------------------------------------------------
  2326. C    TOOLPACK/1    Release: 2.5
  2327. C---------------------------------------------------------
  2328. C
  2329. C     .. Parameters ..
  2330. C
  2331. C  MAXSEG     The maximum number of segments that can be held in memory
  2332. C  MAXROU     The maximum number of routines that can be held in memory
  2333. C
  2334.  
  2335.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  2336.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  2337.       PARAMETER(MAXPRO= MAXROU + 1)
  2338. C     ..
  2339. C---------------------------------------------------------
  2340. C    TOOLPACK/1    Release: 2.5
  2341. C---------------------------------------------------------
  2342.       INTEGER ANNFD,  DYNFD,  SUMFD
  2343.       INTEGER ANNNAM(81), DYNNAM(81),
  2344.      +        SUMNAM(81)
  2345.  
  2346.       COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
  2347.      +                 ANNFD,  DYNFD,  SUMFD
  2348. C---------------------------------------------------------
  2349. C    TOOLPACK/1    Release: 2.5
  2350. C---------------------------------------------------------
  2351.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  2352.       INTEGER OUTFD,  RMARG, REPRTS
  2353.  
  2354.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  2355.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  2356. C---------------------------------------------------------
  2357. C    TOOLPACK/1    Release: 2.5
  2358. C---------------------------------------------------------
  2359. C
  2360. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  2361. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  2362. C
  2363. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  2364. C             THE STATIC SUMMARY)
  2365. C
  2366. C  NAMES      THE NAMES OF THE ROUTINES
  2367. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  2368. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  2369. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  2370. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  2371. C             IN EACH ROUTINE).
  2372. C
  2373. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  2374. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  2375. C             IN EACH ROUTINE).
  2376. C
  2377.  
  2378.       INTEGER NUMROU, NUMSEG, NOASRT
  2379.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  2380.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  2381.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  2382.  
  2383.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  2384.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  2385.       SAVE
  2386.  
  2387.       ENDST = -1
  2388.       IF(DYNFD .EQ. -2) THEN
  2389.         ENDST = -2
  2390.         RETURN
  2391.       ENDIF
  2392.  
  2393.       DYNFD = OPEN(DYNNAM, 0)
  2394.       IF(DYNFD .EQ. -1) THEN
  2395.         CALL REPORT('UNABLE TO OPEN RUN TIME FILE.', OUTFD)
  2396.         RETURN
  2397.       ENDIF
  2398.  
  2399.       NOSEGS = 0
  2400.       NOASRT = 0
  2401.  
  2402.       STATUS = GETLIN(BUFFER, DYNFD)
  2403.       IF((STATUS .EQ. -1) .OR. (STATUS .EQ. -100)) THEN
  2404.         CALL CLOSE(DYNFD)
  2405.         DYNFD = -2
  2406.         CALL CALC
  2407.         ENDST = -2
  2408.         RETURN
  2409.       ENDIF
  2410.       I = 1
  2411.       NOSEGS = CTOI(BUFFER, I)
  2412.       IF(NOSEGS .GT. MAXSEG) THEN
  2413.         CALL REPORT('TOO MANY SEGMENTS.', OUTFD)
  2414.         RETURN
  2415.       ENDIF
  2416.       POINT  = 1
  2417.  
  2418.    10 CONTINUE
  2419.         IF(POINT .LE. NOSEGS) THEN
  2420.           STATUS = GETLIN(BUFFER, DYNFD)
  2421.           IF((STATUS .EQ. -1) .OR. (STATUS .EQ. -100)) THEN
  2422.             CALL CLOSE(DYNFD)
  2423.             DYNFD = -2
  2424.             CALL CALC
  2425.             ENDST = -2
  2426.             RETURN
  2427.           ENDIF
  2428.           IF(DEBUG) CALL ZMESS('---IN ROUTINE: GETDYN---.', 1)
  2429.           DO 20 I = 1, 121, 8
  2430.             IF(POINT .GT. NOSEGS) GO TO 10
  2431.             SEGS (POINT) = 10000000 * (BUFFER(I)   - 48)
  2432.      +                   + 1000000  * (BUFFER(I+1) - 48)
  2433.      +                   + 100000   * (BUFFER(I+2) - 48)
  2434.      +                   + 10000    * (BUFFER(I+3) - 48)
  2435.      +                   + 1000     * (BUFFER(I+4) - 48)
  2436.      +                   + 100      * (BUFFER(I+5) - 48)
  2437.      +                   + 10       * (BUFFER(I+6) - 48)
  2438.      +                   +            (BUFFER(I+7) - 48)
  2439.             IF(DEBUG) THEN
  2440.               CALL PUTDEC(SEGS(POINT), 1)
  2441.               CALL SKIP(1)
  2442.             ENDIF
  2443.             POINT = POINT + 1
  2444.    20     CONTINUE
  2445.           GO TO 10
  2446.  
  2447.         ENDIF
  2448.  
  2449.       STATUS = GETLIN(BUFFER, DYNFD)
  2450.       IF((STATUS .EQ. -1) .OR. (STATUS .EQ. -100)) THEN
  2451.         CALL CLOSE(DYNFD)
  2452.         DYNFD = -2
  2453.         CALL CALC
  2454.         ENDST = -2
  2455.         RETURN
  2456.       ENDIF
  2457.       I = 1
  2458.       NOASRT = CTOI(BUFFER, I)
  2459.       IF(NOASRT .GT. MAXASR) THEN
  2460.         CALL REPORT('TOO MANY ASSERTIONS.', OUTFD)
  2461.         RETURN
  2462.       ENDIF
  2463.       POINT  = 1
  2464.  
  2465.    30 CONTINUE
  2466.         IF(POINT .LE. NOASRT) THEN
  2467.           STATUS = GETLIN(BUFFER, DYNFD)
  2468.           IF((STATUS .EQ. -1) .OR. (STATUS .EQ. -100)) THEN
  2469.             CALL CLOSE(DYNFD)
  2470.             DYNFD = -2
  2471.             CALL CALC
  2472.             ENDST = -2
  2473.             RETURN
  2474.           ENDIF
  2475.           DO 40 I = 1, 121, 8
  2476.             IF(POINT .GT. NOASRT) GO TO 30
  2477.             ASRTS(POINT) = 10000000 * (BUFFER(I)   - 48)
  2478.      +                   + 1000000  * (BUFFER(I+1) - 48)
  2479.      +                   + 100000   * (BUFFER(I+2) - 48)
  2480.      +                   + 10000    * (BUFFER(I+3) - 48)
  2481.      +                   + 1000     * (BUFFER(I+4) - 48)
  2482.      +                   + 100      * (BUFFER(I+5) - 48)
  2483.      +                   + 10       * (BUFFER(I+6) - 48)
  2484.      +                   +            (BUFFER(I+7) - 48)
  2485.             POINT = POINT + 1
  2486.    40     CONTINUE
  2487.          GO TO 30
  2488.  
  2489.         ELSE
  2490.           CALL CLOSE(DYNFD)
  2491.           DYNFD = -2
  2492.           CALL CALC
  2493.           ENDST = -2
  2494.         ENDIF
  2495.  
  2496.       END
  2497. C----------------------------------------------------------
  2498. C
  2499.       SUBROUTINE CALC
  2500.  
  2501.       INTEGER I, J, K, START, END, NUMB
  2502.       INTEGER GETLIM
  2503. C---------------------------------------------------------
  2504. C    TOOLPACK/1    Release: 2.5
  2505. C---------------------------------------------------------
  2506. C
  2507. C     .. Parameters ..
  2508. C
  2509. C  MAXSEG     The maximum number of segments that can be held in memory
  2510. C  MAXROU     The maximum number of routines that can be held in memory
  2511. C
  2512.  
  2513.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  2514.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  2515.       PARAMETER(MAXPRO= MAXROU + 1)
  2516. C     ..
  2517. C---------------------------------------------------------
  2518. C    TOOLPACK/1    Release: 2.5
  2519. C---------------------------------------------------------
  2520. C
  2521. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  2522. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  2523. C
  2524. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  2525. C             THE STATIC SUMMARY)
  2526. C
  2527. C  NAMES      THE NAMES OF THE ROUTINES
  2528. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  2529. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  2530. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  2531. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  2532. C             IN EACH ROUTINE).
  2533. C
  2534. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  2535. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  2536. C             IN EACH ROUTINE).
  2537. C
  2538.  
  2539.       INTEGER NUMROU, NUMSEG, NOASRT
  2540.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  2541.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  2542.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  2543.  
  2544.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  2545.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  2546. C---------------------------------------------------------
  2547. C    TOOLPACK/1    Release: 2.5
  2548. C---------------------------------------------------------
  2549.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  2550.       INTEGER OUTFD,  RMARG, REPRTS
  2551.  
  2552.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  2553.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  2554.       SAVE
  2555. C
  2556. C  CALCULATE THE DYNAMIC STATEMENT TYPE FREQUENCIES
  2557. C
  2558.       DO 10 I = 1, NUMROU
  2559.         NUMB = GETLIM(I, START, END)
  2560.         DO 20 J = 1, LMAXG
  2561.           DTOTAL(J, I) = 0
  2562.           DO 25 K = START, END
  2563.             IF(K .NE. 0) DTOTAL(J, I) = DTOTAL(J, I) +
  2564.      +                                  SEGS(K) * COUNTS(J, K)
  2565.    25     CONTINUE
  2566.    20   CONTINUE
  2567.  
  2568.    10 CONTINUE
  2569. C
  2570. C  MAKE UP THE PROGRAM TOTALS
  2571. C
  2572.       IF(DEBUG) CALL ZMESS('---IN ROUTINE: CALC---.', 1)
  2573.       DO 30 I = 1, LMAXG
  2574.         DTOTAL(I, MAXPRO) = 0
  2575.         DO 40 J = 1, NUMROU
  2576.           DTOTAL(I, MAXPRO) = DTOTAL(I, MAXPRO) + DTOTAL(I, J)
  2577.    40   CONTINUE
  2578.         IF(DEBUG) THEN
  2579.           CALL PUTDEC(DTOTAL(I, MAXPRO),1)
  2580.           CALL SKIP(1)
  2581.         ENDIF
  2582.    30 CONTINUE
  2583.  
  2584.       END
  2585. C -----------------------------------------------------------------
  2586. C
  2587. C  READ STATEMENT TYPE SUMMARY FILE AND PROCESS INFORMATION.
  2588. C
  2589.       SUBROUTINE RSTATS(ENDST)
  2590. C
  2591. C---------------------------------------------------------
  2592. C    TOOLPACK/1    Release: 2.5
  2593. C---------------------------------------------------------
  2594. C
  2595. C     .. Parameters ..
  2596. C
  2597. C  MAXSEG     The maximum number of segments that can be held in memory
  2598. C  MAXROU     The maximum number of routines that can be held in memory
  2599. C
  2600.  
  2601.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  2602.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  2603.       PARAMETER(MAXPRO= MAXROU + 1)
  2604. C     ..
  2605.       INTEGER   I, CURSEG, CURENT, NTYSEG, TYPE, POINT, LIMIT, J,
  2606.      +          STATUS, IL, ENDST
  2607.       INTEGER   BUFFER(134)
  2608.       INTEGER   GETLIN, CTOI, OPEN
  2609. C---------------------------------------------------------
  2610. C    TOOLPACK/1    Release: 2.5
  2611. C---------------------------------------------------------
  2612.       INTEGER ANNFD,  DYNFD,  SUMFD
  2613.       INTEGER ANNNAM(81), DYNNAM(81),
  2614.      +        SUMNAM(81)
  2615.  
  2616.       COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
  2617.      +                 ANNFD,  DYNFD,  SUMFD
  2618. C---------------------------------------------------------
  2619. C    TOOLPACK/1    Release: 2.5
  2620. C---------------------------------------------------------
  2621.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  2622.       INTEGER OUTFD,  RMARG, REPRTS
  2623.  
  2624.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  2625.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  2626. C---------------------------------------------------------
  2627. C    TOOLPACK/1    Release: 2.5
  2628. C---------------------------------------------------------
  2629. C
  2630. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  2631. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  2632. C
  2633. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  2634. C             THE STATIC SUMMARY)
  2635. C
  2636. C  NAMES      THE NAMES OF THE ROUTINES
  2637. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  2638. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  2639. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  2640. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  2641. C             IN EACH ROUTINE).
  2642. C
  2643. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  2644. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  2645. C             IN EACH ROUTINE).
  2646. C
  2647.  
  2648.       INTEGER NUMROU, NUMSEG, NOASRT
  2649.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  2650.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  2651.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  2652.  
  2653.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  2654.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  2655.       SAVE
  2656.  
  2657.       ENDST = -1
  2658.       IF(SUMFD .EQ. -2) THEN
  2659.         ENDST = -2
  2660.         RETURN
  2661.       ENDIF
  2662.  
  2663.       SUMFD = OPEN(SUMNAM, 0)
  2664.       IF(SUMFD .EQ. -1) THEN
  2665.         CALL REPORT('UNABLE TO OPEN SUMMARY FILE.', OUTFD)
  2666.         RETURN
  2667.       ENDIF
  2668.  
  2669.       DO 10 I = 1, LMAXG
  2670.         PTOTAL(I) = 0
  2671.    10 CONTINUE
  2672. C
  2673.       CURENT = 1
  2674.  
  2675.    20 CONTINUE
  2676. C
  2677. C  READ CURRENT ROUTINE NAME, STARTING SEGMENT NUMBER,
  2678. C  AND STARTING ASSERTION NUMBER
  2679. C
  2680.       STATUS = GETLIN(BUFFER, SUMFD)
  2681.       IF(STATUS .EQ. -100) THEN
  2682.         CALL CLOSE(SUMFD)
  2683.         SUMFD = -2
  2684.         NUMROU = CURENT - 1
  2685.         NUMSEG = CURSEG - 1
  2686.         ENDST = -2
  2687.         RETURN
  2688.       ENDIF
  2689.       DO 1 I = 1, 6
  2690.         NAMES(I, CURENT) = BUFFER(I)
  2691.     1 CONTINUE
  2692.       NAMES(I, CURENT) = 129
  2693.       ISTSEG(CURENT)  = CTOI(BUFFER, I)
  2694.       ISTASG(CURENT)  = CTOI(BUFFER, I)
  2695.       CURSEG          = ISTSEG(CURENT)
  2696.       IF(CURSEG .NE. 0) THEN
  2697. C
  2698. C  READ A SEGMENT RECORD WHICH CONTAINS:
  2699. C  NO. PAIRS, (STMT TYPE, NO. OCCUR.,IL=1,NO. PAIRS)
  2700. C
  2701.         IF(DEBUG) CALL ZMESS('---IN ROUTINE: RSTATS---.', 1)
  2702.    40   CONTINUE
  2703.         DO 39 I = 1, LMAXG
  2704.           COUNTS(I, CURSEG) = 0
  2705.    39   CONTINUE
  2706.         STATUS = GETLIN(BUFFER, SUMFD)
  2707.         IF(BUFFER(1) .NE. 42) THEN
  2708.           NTYSEG = 10 * (BUFFER(1) - 48) + BUFFER(2) - 48
  2709.           DO 41 IL = 1, NTYSEG
  2710.             POINT = (IL - 1) * 5 + 3
  2711.             TYPE         = 10  * (BUFFER(POINT)   - 48)
  2712.      +                   +        BUFFER(POINT+1) - 48
  2713.             COUNTS(TYPE, CURSEG) = 100 * (BUFFER(POINT+2) - 48)
  2714.      +                           + 10  * (BUFFER(POINT+3) - 48)
  2715.      +                           +        BUFFER(POINT+4) - 48
  2716.             IF(DEBUG) THEN
  2717.               CALL PUTDEC(POINT,  5)
  2718.               CALL PUTDEC(TYPE,   5)
  2719.               CALL PUTDEC(CURSEG, 5)
  2720.               CALL PUTDEC(COUNTS(TYPE, CURSEG), 5)
  2721.               CALL SKIP(1)
  2722.             ENDIF
  2723.    41     CONTINUE
  2724.           CURSEG = CURSEG + 1
  2725.           IF(CURSEG .GT. MAXSEG) CALL ERROR('TOO MANY SEGMENTS.')
  2726.           GO TO 40
  2727.         END IF
  2728.  
  2729.       ELSE
  2730. C  SKIP THE STARS ON A BLOCK DATA ENTRY
  2731.         STATUS = GETLIN(BUFFER, SUMFD)
  2732.       ENDIF
  2733. C
  2734. C  READ ROUTINE SUMMARY RECORD WHICH CONTAINS:
  2735. C    61 ENTRIES IN 4 RECORDS OF 16, 16, 16 AND 13 VALUES EACH.
  2736. C
  2737.       DO 51 I = 1, 4
  2738.         LIMIT = 16
  2739.         IF(I .EQ. 4) LIMIT = 13
  2740.         STATUS = GETLIN(BUFFER, SUMFD)
  2741.         DO 52 J = 1, LIMIT
  2742.           POINT = (I-1) * 16 + J
  2743.           RTOTAL(POINT, CURENT) = 10000 * (BUFFER((J-1)*5+1)-48)
  2744.      +                          + 1000  * (BUFFER((J-1)*5+2)-48)
  2745.      +                          + 100   * (BUFFER((J-1)*5+3)-48)
  2746.      +                          + 10    * (BUFFER((J-1)*5+4)-48)
  2747.      +                          +          BUFFER((J-1)*5+5)-48
  2748.           PTOTAL(POINT) = PTOTAL(POINT) + RTOTAL(POINT, CURENT)
  2749.    52   CONTINUE
  2750.    51 CONTINUE
  2751.  
  2752.       CURENT = CURENT + 1
  2753.       IF(CURENT .LE. MAXROU) GO TO 20
  2754.       CALL ERROR('TOO MANY ROUTINES.')
  2755.  
  2756.       END
  2757. C----------------------------------------------------------------
  2758. C
  2759. C  PRODUCE A STATIC SUMMARY LISTING
  2760. C
  2761.       SUBROUTINE PROLST(COMAND)
  2762.  
  2763.       INTEGER I, JUNK, FIRST
  2764.       INTEGER COMAND(*)
  2765.       INTEGER ZPFIND, ZSETP
  2766. C---------------------------------------------------------
  2767. C    TOOLPACK/1    Release: 2.5
  2768. C---------------------------------------------------------
  2769. C
  2770. C     .. Parameters ..
  2771. C
  2772. C  MAXSEG     The maximum number of segments that can be held in memory
  2773. C  MAXROU     The maximum number of routines that can be held in memory
  2774. C
  2775.  
  2776.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  2777.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  2778.       PARAMETER(MAXPRO= MAXROU + 1)
  2779. C     ..
  2780. C---------------------------------------------------------
  2781. C    TOOLPACK/1    Release: 2.5
  2782. C---------------------------------------------------------
  2783.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  2784.       INTEGER OUTFD,  RMARG, REPRTS
  2785.  
  2786.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  2787.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  2788. C---------------------------------------------------------
  2789. C    TOOLPACK/1    Release: 2.5
  2790. C---------------------------------------------------------
  2791.       INTEGER ANNFD,  DYNFD,  SUMFD
  2792.       INTEGER ANNNAM(81), DYNNAM(81),
  2793.      +        SUMNAM(81)
  2794.  
  2795.       COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
  2796.      +                 ANNFD,  DYNFD,  SUMFD
  2797. C---------------------------------------------------------
  2798. C    TOOLPACK/1    Release: 2.5
  2799. C---------------------------------------------------------
  2800. C
  2801. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  2802. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  2803. C
  2804. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  2805. C             THE STATIC SUMMARY)
  2806. C
  2807. C  NAMES      THE NAMES OF THE ROUTINES
  2808. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  2809. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  2810. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  2811. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  2812. C             IN EACH ROUTINE).
  2813. C
  2814. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  2815. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  2816. C             IN EACH ROUTINE).
  2817. C
  2818.  
  2819.       INTEGER NUMROU, NUMSEG, NOASRT
  2820.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  2821.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  2822.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  2823.  
  2824.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  2825.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  2826.       SAVE
  2827.  
  2828.       JUNK = ZSETP(COMAND, CASFOL)
  2829.  
  2830.       IF(VERBOS) THEN
  2831.         CALL PUTCH(10, OUTFD)
  2832.         CALL ZMESS('This table contains a count of the.', OUTFD)
  2833.         CALL ZMESS('statements in the specified program unit,.', OUTFD)
  2834.         CALL ZMESS('split by statement type...', OUTFD)
  2835.       ENDIF
  2836.       CALL PUTCH(10, OUTFD)
  2837.  
  2838.       IF(COMAND(1) .EQ. 129) THEN
  2839.         CALL PUTCH(10, OUTFD)
  2840.         IF(OUTFD .NE. 1) CALL ZMESS('..ce.', OUTFD)
  2841.         CALL ZCHOUT('STATIC SUMMARY TOTAL FOR FILE: .', OUTFD)
  2842.         CALL ZPTMES(SUMNAM, OUTFD)
  2843.         CALL ZCHOUT(' (.', OUTFD)
  2844.         CALL ZPTINT(NUMROU, 1, OUTFD)
  2845.         CALL ZMESS (' PROGRAM UNITS)...', OUTFD)
  2846.         CALL STREPS(PTOTAL)
  2847.       ELSE IF(COMAND(1) .NE. 32) THEN
  2848.         DO 10 I = 1, NUMROU
  2849.           IF(ZPFIND(NAMES(1, I), 1, FIRST, JUNK) .EQ. -2) THEN
  2850.             IF(FIRST .EQ. 1) THEN
  2851.               CALL PUTCH(10, OUTFD)
  2852.               IF(OUTFD .NE. 1) CALL ZMESS('..ce.', OUTFD)
  2853.               CALL ZCHOUT('STATIC SUMMARY FOR PROGRAM UNIT: .', OUTFD)
  2854.               CALL ZPTMES(NAMES(1, I), OUTFD)
  2855.               CALL STREPS(RTOTAL(1, I))
  2856.             ENDIF
  2857.           ENDIF
  2858.    10   CONTINUE
  2859.       ENDIF
  2860.  
  2861.       END
  2862. C----------------------------------------------------------------
  2863. C
  2864. C  PRODUCE A DYNAMIC SUMMARY LISTING
  2865. C
  2866.       SUBROUTINE DYNLST(COMAND)
  2867.  
  2868.       INTEGER I, JUNK, FIRST
  2869.       INTEGER COMAND(*)
  2870.       INTEGER ZSETP, ZPFIND
  2871. C---------------------------------------------------------
  2872. C    TOOLPACK/1    Release: 2.5
  2873. C---------------------------------------------------------
  2874. C
  2875. C     .. Parameters ..
  2876. C
  2877. C  MAXSEG     The maximum number of segments that can be held in memory
  2878. C  MAXROU     The maximum number of routines that can be held in memory
  2879. C
  2880.  
  2881.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  2882.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  2883.       PARAMETER(MAXPRO= MAXROU + 1)
  2884. C     ..
  2885. C---------------------------------------------------------
  2886. C    TOOLPACK/1    Release: 2.5
  2887. C---------------------------------------------------------
  2888.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  2889.       INTEGER OUTFD,  RMARG, REPRTS
  2890.  
  2891.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  2892.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  2893. C---------------------------------------------------------
  2894. C    TOOLPACK/1    Release: 2.5
  2895. C---------------------------------------------------------
  2896.       INTEGER ANNFD,  DYNFD,  SUMFD
  2897.       INTEGER ANNNAM(81), DYNNAM(81),
  2898.      +        SUMNAM(81)
  2899.  
  2900.       COMMON /CFILES/  ANNNAM, DYNNAM, SUMNAM,
  2901.      +                 ANNFD,  DYNFD,  SUMFD
  2902. C---------------------------------------------------------
  2903. C    TOOLPACK/1    Release: 2.5
  2904. C---------------------------------------------------------
  2905. C
  2906. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  2907. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  2908. C
  2909. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  2910. C             THE STATIC SUMMARY)
  2911. C
  2912. C  NAMES      THE NAMES OF THE ROUTINES
  2913. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  2914. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  2915. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  2916. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  2917. C             IN EACH ROUTINE).
  2918. C
  2919. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  2920. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  2921. C             IN EACH ROUTINE).
  2922. C
  2923.  
  2924.       INTEGER NUMROU, NUMSEG, NOASRT
  2925.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  2926.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  2927.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  2928.  
  2929.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  2930.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  2931.       SAVE
  2932.  
  2933.       JUNK = ZSETP(COMAND, CASFOL)
  2934.  
  2935.       IF(VERBOS) THEN
  2936.         CALL PUTCH(10, OUTFD)
  2937.         CALL ZMESS('This table contains a count of the.', OUTFD)
  2938.         CALL ZMESS('statements actually executed in the.', OUTFD)
  2939.         CALL ZMESS('specified program unit,.', OUTFD)
  2940.         CALL ZMESS('split by statement type...', OUTFD)
  2941.       ENDIF
  2942.       CALL PUTCH(10, OUTFD)
  2943.  
  2944.       IF(OUTFD .NE. 1) THEN
  2945.         CALL ZMESS('..nf.', OUTFD)
  2946.         CALL ZMESS('..nj.', OUTFD)
  2947.       ENDIF
  2948.  
  2949.       IF(COMAND(1) .EQ. 129) THEN
  2950.         CALL PUTCH(10, OUTFD)
  2951.         IF(OUTFD .NE. 1) CALL ZMESS('..ce.', OUTFD)
  2952.         CALL ZCHOUT('DYNAMIC SUMMARY TOTALS FOR FILE: .', OUTFD)
  2953.         CALL ZPTMES(SUMNAM, OUTFD)
  2954.         CALL ZCHOUT(' (.', OUTFD)
  2955.         CALL ZPTINT(NUMROU, 1, OUTFD)
  2956.         CALL ZMESS (' PROGRAM UNITS)...', OUTFD)
  2957.         CALL DYREPS(DTOTAL(1, MAXPRO))
  2958.       ELSE IF(COMAND(1) .NE. 32) THEN
  2959.         DO 10 I = 1, NUMROU
  2960.           IF(ZPFIND(NAMES(1, I), 1, FIRST, JUNK) .EQ. -2) THEN
  2961.             IF(FIRST .EQ. 1) THEN
  2962.               CALL PUTCH(10, OUTFD)
  2963.               IF(OUTFD .NE. 1) CALL ZMESS('..ce.', OUTFD)
  2964.               CALL ZCHOUT('DYNAMIC SUMMARY FOR PROGRAM UNIT: .', OUTFD)
  2965.               CALL ZPTMES(NAMES(1, I), OUTFD)
  2966.               CALL DYREPS(DTOTAL(1, I))
  2967.             ENDIF
  2968.           ENDIF
  2969.    10   CONTINUE
  2970.       ENDIF
  2971.  
  2972.       END
  2973. C -------------------------------------------------------------
  2974. C
  2975. C  OUTPUT DYNAMIC STATEMENT TYPES REPORT
  2976. C
  2977.       SUBROUTINE DYREPS(IOUTA)
  2978. C
  2979.       INTEGER     IOUTA(*)
  2980.       INTEGER     IFL,IGOTOL
  2981. C     ..
  2982. C---------------------------------------------------------
  2983. C    TOOLPACK/1    Release: 2.5
  2984. C---------------------------------------------------------
  2985.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  2986.       INTEGER OUTFD,  RMARG, REPRTS
  2987.  
  2988.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  2989.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  2990. C---------------------------------------------------------
  2991. C    TOOLPACK/1    Release: 2.5
  2992. C---------------------------------------------------------
  2993. C     .. Scalars in Common ..
  2994.       INTEGER     KAGOG,
  2995.      +            KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,KCFUNG,
  2996.      +            KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  2997.      +            KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  2998.      +            KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,
  2999.      +            KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,
  3000.      +            KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,
  3001.      +            KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,KSUBRG,KUFUNG,
  3002.      +            KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,LCMNTG,LERRG,
  3003.      +            LLINEG,LSTMTG
  3004. C     ..
  3005. C     .. Common blocks ..
  3006.       COMMON      /KEYSC/KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,
  3007.      +            KCALLG,KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,
  3008.      +            KCONTG,KDATAG,KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,
  3009.      +            KENDFG,KENDG,KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,
  3010.      +            KIMPLG,KINQRG,KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,
  3011.      +            KNONEG,KNTRYG,KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,
  3012.      +            KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,
  3013.      +            KSUBRG,KUFUNG,KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,
  3014.      +            LCMNTG,LERRG,LLINEG,LSTMTG
  3015. C     ..
  3016.       SAVE
  3017.  
  3018. C     .. Executable Statements ..
  3019.       IFL     = IOUTA(KAIFG) + IOUTA(KBIFG) + IOUTA(KLIFG)
  3020.       IGOTOL  = IOUTA(KAGOG) + IOUTA(KCGOG) + IOUTA(KUGOG)
  3021.  
  3022.       IF(OUTFD .NE. 1) THEN
  3023.         CALL ZMESS('..ce 15.', OUTFD)
  3024.         CALL ZMESS('..in 0.', OUTFD)
  3025.         CALL ZMESS('..nf.', OUTFD)
  3026.         CALL ZMESS('..nj.', OUTFD)
  3027.       ENDIF
  3028.       CALL PUTCH(10, OUTFD)
  3029.       CALL OUTFM1(IOUTA(KASSNG),IFL,'ASSIGN','IF')
  3030.       CALL OUTFM1(IOUTA(KBACKG),IOUTA(KAIFG),'BACKSPACE',
  3031.      +                                                 '--(ARITHMETIC)')
  3032.       CALL OUTFM1(IOUTA(KCALLG),IOUTA(KBIFG),'CALL','--(BLOCK)')
  3033.       CALL OUTFM1(IOUTA(KCLOSG),IOUTA(KLIFG),'CLOSE','--(LOGICAL)')
  3034.       CALL OUTFM1(IOUTA(KCONTG),IOUTA(KINQRG),'CONTINUE','INQUIRE')
  3035.       CALL OUTFM1(IOUTA(KDOG),IOUTA(KOPENG),'DO','OPEN')
  3036.       CALL OUTFM1(IOUTA(KELSFG),IOUTA(KPAUSG),'ELSE IF','PAUSE')
  3037.       CALL OUTFM1(IOUTA(KELSEG),IOUTA(KPRNTG),'ELSE','PRINT')
  3038.       CALL OUTFM1(IOUTA(KENDFG),IOUTA(KREADG),'ENDFILE','READ')
  3039.       CALL OUTFM1(IOUTA(KENDIG),IOUTA(KRETNG),'END IF','RETURN')
  3040.       CALL OUTFM1(IOUTA(KENDG),IOUTA(KWINDG),'END','REWIND')
  3041.       CALL OUTFM1(IGOTOL,IOUTA(KSTOPG),'GO TO','STOP')
  3042.       CALL OUTFM1(IOUTA(KAGOG),IOUTA(KWRITG),'--(ASSIGNED)','WRITE')
  3043.       CALL OUTFM1(IOUTA(KCGOG),IOUTA(KASMTG),'--(COMPUTED)',
  3044.      +                                        '(ASSIGNMENT STATEMENTS)')
  3045.       CALL OUTFM1(IOUTA(KUGOG),IOUTA(KNONEG),'--(UNCONDITIONAL)',
  3046.      +                                      '(UNRECOGNIZED STATEMENTS)')
  3047.       CALL COMPLT(OUTFD)
  3048.  
  3049.       END
  3050. C -----------------------------------------------------------------
  3051. C
  3052. C  OUTPUT STATIC STATEMENT TYPES REPORT
  3053. C
  3054.       SUBROUTINE STREPS(IOUTA)
  3055. C
  3056. C     .. Array Arguments ..
  3057.       INTEGER     IOUTA(*)
  3058. C     ..
  3059. C     .. Local Scalars ..
  3060.       INTEGER     IFL,IFUNCL,IGOTOL
  3061. C     ..
  3062. C---------------------------------------------------------
  3063. C    TOOLPACK/1    Release: 2.5
  3064. C---------------------------------------------------------
  3065.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  3066.       INTEGER OUTFD,  RMARG, REPRTS
  3067.  
  3068.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  3069.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  3070. C---------------------------------------------------------
  3071. C    TOOLPACK/1    Release: 2.5
  3072. C---------------------------------------------------------
  3073. C     .. Scalars in Common ..
  3074.       INTEGER     KAGOG,
  3075.      +            KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,KCFUNG,
  3076.      +            KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  3077.      +            KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  3078.      +            KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,
  3079.      +            KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,
  3080.      +            KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,
  3081.      +            KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,KSUBRG,KUFUNG,
  3082.      +            KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,LCMNTG,LERRG,
  3083.      +            LLINEG,LSTMTG
  3084. C     ..
  3085. C     .. Common blocks ..
  3086.       COMMON      /KEYSC/KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,
  3087.      +            KCALLG,KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,
  3088.      +            KCONTG,KDATAG,KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,
  3089.      +            KENDFG,KENDG,KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,
  3090.      +            KIMPLG,KINQRG,KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,
  3091.      +            KNONEG,KNTRYG,KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,
  3092.      +            KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,
  3093.      +            KSUBRG,KUFUNG,KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,
  3094.      +            LCMNTG,LERRG,LLINEG,LSTMTG
  3095. C     ..
  3096.       SAVE
  3097. C     ..
  3098. C     .. Executable Statements ..
  3099.       IFL     = IOUTA(KAIFG)  + IOUTA(KBIFG)  + IOUTA(KLIFG)
  3100.       IFUNCL  = IOUTA(KCFUNG) + IOUTA(KXFUNG) + IOUTA(KDFUNG) +
  3101.      +          IOUTA(KIFUNG) + IOUTA(KLFUNG) + IOUTA(KRFUNG) +
  3102.      +          IOUTA(KUFUNG)
  3103.       IGOTOL  = IOUTA(KAGOG)  + IOUTA(KCGOG)  + IOUTA(KUGOG)
  3104.  
  3105.       CALL PUTCH(10, OUTFD)
  3106.       IF(OUTFD .NE. 1) THEN
  3107.         CALL ZMESS('..ce 5.', OUTFD)
  3108.         CALL ZMESS('..nf.', OUTFD)
  3109.         CALL ZMESS('..nj.', OUTFD)
  3110.         CALL ZMESS('..in 0.', OUTFD)
  3111.       ENDIF
  3112.       CALL ZCHOUT('ASSERTIONS: .', OUTFD)
  3113.       CALL ZPTINT(IOUTA(LASRTG), 5, OUTFD)
  3114.       CALL PUTCH(10, OUTFD)
  3115.       CALL ZCHOUT('COMMENTS  : .', OUTFD)
  3116.       CALL ZPTINT(IOUTA(LCMNTG), 5, OUTFD)
  3117.       CALL PUTCH(10, OUTFD)
  3118.       CALL ZCHOUT('ERRORS    : .', OUTFD)
  3119.       CALL ZPTINT(IOUTA(LERRG), 5, OUTFD)
  3120.       CALL PUTCH(10, OUTFD)
  3121.       CALL ZCHOUT('TOKENS    : .', OUTFD)
  3122.       CALL ZPTINT(IOUTA(LLINEG), 5, OUTFD)
  3123.       CALL PUTCH(10, OUTFD)
  3124.       CALL ZCHOUT('STATEMENTS: .', OUTFD)
  3125.       CALL ZPTINT(IOUTA(LSTMTG), 5, OUTFD)
  3126.       CALL PUTCH(10, OUTFD)
  3127.       CALL PUTCH(10, OUTFD)
  3128.  
  3129.       IF(OUTFD .NE. 1) CALL ZMESS('..ce 30.', OUTFD)
  3130.       CALL OUTFM1(IOUTA(KASSNG),IGOTOL,'ASSIGN','GO TO')
  3131.       CALL OUTFM1(IOUTA(KBACKG),IOUTA(KAGOG),'BACKSPACE','--(ASSIGNED)')
  3132.       CALL OUTFM1(IOUTA(KBLOKG),IOUTA(KCGOG),'BLOCK DATA',
  3133.      +'  (COMPUTED)')
  3134.       CALL OUTFM1(IOUTA(KCALLG),IOUTA(KUGOG),'CALL','--(UNCONDITIONAL)')
  3135.       CALL OUTFM1(IOUTA(KCHARG),IFL,'CHARACTER','IF')
  3136.       CALL OUTFM1(IOUTA(KCLOSG),IOUTA(KAIFG),'CLOSE','--(ARITHMETIC)')
  3137.       CALL OUTFM1(IOUTA(KCOMNG),IOUTA(KBIFG),'COMMON','--(BLOCK)')
  3138.       CALL OUTFM1(IOUTA(KCMPXG),IOUTA(KLIFG),'COMPLEX','LOGICAL')
  3139.       CALL OUTFM1(IOUTA(KCONTG),IOUTA(KIMPLG),'CONTINUE','IMPLICIT')
  3140.       CALL OUTFM1(IOUTA(KDATAG),IOUTA(KINQRG),'DATA','INQUIRE')
  3141.       CALL OUTFM1(IOUTA(KDIMNG),IOUTA(KINTEG),'DIMENSION','INTEGER')
  3142.       CALL OUTFM1(IOUTA(KDBLEG),IOUTA(KINSCG),'DOUBLE PRECISION',
  3143.      +                                                      'INTRINSIC')
  3144.       CALL OUTFM1(IOUTA(KDOG),IOUTA(KLOGCG),'DO','LOGICAL')
  3145.       CALL OUTFM1(IOUTA(KELSFG),IOUTA(KOPENG),'ELSE IF','OPEN')
  3146.       CALL OUTFM1(IOUTA(KELSEG),IOUTA(KPARAG),'ELSE','PARAMETER')
  3147.       CALL OUTFM1(IOUTA(KENDFG),IOUTA(KPAUSG),'ENDFILE','PAUSE')
  3148.       CALL OUTFM1(IOUTA(KENDIG),IOUTA(KPRNTG),'END IF','PRINT')
  3149.       CALL OUTFM1(IOUTA(KENDG),IOUTA(KPROGG),'END','PROGRAM')
  3150.       CALL OUTFM1(IOUTA(KNTRYG),IOUTA(KREADG),'ENTRY','READ')
  3151.       CALL OUTFM1(IOUTA(KEQIVG),IOUTA(KREALG),'EQUIVALENCE','REAL')
  3152.       CALL OUTFM1(IOUTA(KEXTLG),IOUTA(KRETNG),'EXTERNAL','RETURN')
  3153.       CALL OUTFM1(IOUTA(KFORMG),IOUTA(KWINDG),'FORMAT','REWIND')
  3154.       CALL OUTFM1(IFUNCL,IOUTA(KSAVEG),'FUNCTION','SAVE')
  3155.       CALL OUTFM1(IOUTA(KCFUNG),IOUTA(KSTOPG),'--CHARACTER','STOP')
  3156.       CALL OUTFM1(IOUTA(KXFUNG),IOUTA(KSUBRG),'--COMPLEX','SUBROUTINE')
  3157.       CALL OUTFM1(IOUTA(KDFUNG),IOUTA(KWRITG),'--DOUBLE PRECISION',
  3158.      +                                                          'WRITE')
  3159.       CALL OUTFM1(IOUTA(KIFUNG),IOUTA(KASMTG),'--INTEGER',
  3160.      +                                        '(ASSIGNMENT STATEMENTS)')
  3161.       CALL OUTFM1(IOUTA(KLFUNG),IOUTA(KSFUNG),'--LOGICAL',
  3162.      +                                          '(STATEMENT FUNCTIONS)')
  3163.       CALL OUTFM1(IOUTA(KRFUNG),IOUTA(KNONEG),'--REAL',
  3164.      +                                      '(UNRECOGNIZED STATEMENTS)')
  3165.       CALL OUTFM1(IOUTA(KUFUNG),0,'--UNTYPED','-')
  3166.  
  3167.       CALL COMPLT(OUTFD)
  3168. C
  3169.       END
  3170. C -----------------------------------------------------------------
  3171. C
  3172. C  NEW ROUTINE TO OUTPUT THINGS ACCORDING TO THE FORMATS USED IN
  3173. C  THE ROUTINE STREPS.
  3174. C
  3175.       SUBROUTINE OUTFM1(VAL1, VAL2, STR1, STR2)
  3176.  
  3177.       INTEGER       VAL1, VAL2, CHARS, GUTTER
  3178.       CHARACTER*(*) STR1, STR2
  3179.       INTRINSIC     LEN
  3180. C---------------------------------------------------------
  3181. C    TOOLPACK/1    Release: 2.5
  3182. C---------------------------------------------------------
  3183.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  3184.       INTEGER OUTFD,  RMARG, REPRTS
  3185.  
  3186.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  3187.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  3188.       SAVE
  3189.  
  3190.       GUTTER = RMARG - 68
  3191.       IF(GUTTER .GT. 10) GUTTER = 10
  3192.       IF(GUTTER .LT.  2) GUTTER = 2
  3193.  
  3194.       CHARS = LEN(STR1)
  3195.       CALL ZCHOUT(STR1, OUTFD)
  3196.       CALL ZPTINT(VAL1, 25 - CHARS + 8, OUTFD)
  3197.  
  3198.       CALL ZOBLNK(GUTTER, OUTFD)
  3199.       CHARS = LEN(STR2)
  3200.       CALL ZCHOUT(STR2, OUTFD)
  3201.       CALL ZPTINT(VAL2, 25 - CHARS + 8, OUTFD)
  3202.  
  3203.       CALL PUTCH(10, OUTFD)
  3204.  
  3205.       END
  3206. C-------------------------------------------------------------
  3207. C
  3208. C  OUTPUT A CALLGRAPH
  3209. C
  3210.       SUBROUTINE GRAPH
  3211.  
  3212.       INTEGER    MAXLVL
  3213.       PARAMETER (MAXLVL = 15)
  3214.  
  3215.       INTEGER ENTRYS, JUNK, I, LEVEL, ROOT, STATUS, LINE,
  3216.      +        POINT, INDEX
  3217.       INTEGER VALUES(4), NAME(34), STACK(0:MAXLVL), NEWVAL(4)
  3218.       INTEGER ZTBTYP, ZTBACC, ZTBUPD
  3219.       LOGICAL EMPTY, PUSHED
  3220. C---------------------------------------------------------
  3221. C    TOOLPACK/1    Release: 2.5
  3222. C---------------------------------------------------------
  3223.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  3224.       INTEGER OUTFD,  RMARG, REPRTS
  3225.  
  3226.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  3227.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  3228. C---------------------------------------------------------
  3229. C    TOOLPACK/1    Release: 2.5
  3230. C---------------------------------------------------------
  3231. C
  3232. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  3233. C  AND XREFERENCE GENERATION ROUTINES.
  3234. C
  3235. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  3236. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  3237. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  3238. C
  3239. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  3240. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  3241. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  3242. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  3243. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  3244. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  3245. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  3246. C
  3247. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  3248. C  CALLD(2, X)   THE TABLE ENTRY.
  3249. C
  3250. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  3251. C  CALLR(2, X)   THE TABLE ENTRY.
  3252. C
  3253. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  3254. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  3255. C  COMLST THE LINKED LIST OF USERS.
  3256. C
  3257.       INTEGER MAXSIZ, MAXENT, MAXVAR
  3258.       PARAMETER (MAXVAR = 30720)
  3259.       PARAMETER (MAXSIZ = 2048)
  3260.       PARAMETER (MAXENT = 1024)
  3261.  
  3262.       INTEGER NUMCLD, NUMCLR, NUMCOM
  3263.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  3264.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  3265.  
  3266.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  3267.      +               NUMCLR, NUMCLD, NUMCOM
  3268.       SAVE
  3269.  
  3270.       IF(ZTBTYP(ARRAY, JUNK, ENTRYS, JUNK, JUNK) .NE. -2) CALL
  3271.      +   ERROR('INVALID TABLE.')
  3272.  
  3273.       IF(VERBOS) THEN
  3274.         CALL PUTCH(10, OUTFD)
  3275.         CALL ZMESS('The following callgraph shows the.', OUTFD)
  3276.         CALL ZMESS('routine dependencies of those routines.',OUTFD)
  3277.         CALL ZMESS('an'//'d entry points detailed within the.', OUTFD)
  3278.         CALL ZMESS('specified symbol table files...', OUTFD)
  3279.         CALL ZMESS('Where an entry is followed by a.', OUTFD)
  3280.         CALL ZMESS('nu'//'mber in brackets, the n'//'umber.', OUTFD)
  3281.         CALL ZMESS('refers to the line on which that.', OUTFD)
  3282.         CALL ZMESS('entry''s expansion has already been.', OUTFD)
  3283.         CALL ZMESS('shown.. If a name is followed by a.', OUTFD)
  3284.         CALL ZMESS('question mark, this indicates that.', OUTFD)
  3285.         CALL ZMESS('the routines symbol table was n'//'ot.', OUTFD)
  3286.         CALL ZMESS('provided...', OUTFD)
  3287.         CALL PUTCH(10, OUTFD)
  3288.       ENDIF
  3289. C
  3290. C  CLEAR ALL THE FLAGS (2 CALLGRAPHS MAY BE REQUESTED FROM THE SAME
  3291. C  DATA).
  3292. C
  3293.       DO 100 I = 1, ENTRYS
  3294.         STATUS = ZTBACC(I, NAME, JUNK, VALUES, ARRAY)
  3295.         VALUES(3) = 0
  3296.         STATUS = ZTBUPD(I, VALUES, ARRAY)
  3297.   100 CONTINUE
  3298.  
  3299.       IF(OUTFD .NE. 1) THEN
  3300.         CALL ZMESS('..nf.', OUTFD)
  3301.         CALL ZMESS('..nj.', OUTFD)
  3302.       ENDIF
  3303.  
  3304.       LINE = 1
  3305. C
  3306. C  FIND OUT IF THERE ARE ANY ELEMENTS IN THE TREE WHICH HAVE YET TO
  3307. C  BE OUTPUT. IF THERE ARE THEN FIND A TREE ROOT (IF NONE THEN THERE
  3308. C  IS RECURSION).
  3309. C
  3310.    20 CONTINUE
  3311.       ROOT  = 0
  3312.       EMPTY = .TRUE.
  3313.       DO 10 I = 1, ENTRYS
  3314.         STATUS = ZTBACC(I, NAME, JUNK, VALUES, ARRAY)
  3315.         IF(VALUES(3) .EQ. 0) THEN
  3316.           IF(VALUES(1) .EQ. 0) THEN
  3317.             ROOT = I
  3318.             GO TO 15
  3319.           ENDIF
  3320.           EMPTY = .FALSE.
  3321.         ENDIF
  3322.    10 CONTINUE
  3323.  
  3324.       IF(EMPTY) THEN
  3325.         CALL COMPLT(OUTFD)
  3326.       ELSE
  3327.         CALL REPORT('SUB-TREE CONTAINS NO ROOT (RECURSIVE).', OUTFD)
  3328.       END IF
  3329.       RETURN
  3330. C
  3331. C  PROCESS A SUB-TREE
  3332. C
  3333.    15 CONTINUE
  3334.       LEVEL = 0
  3335.       POINT = ROOT
  3336.       CALL PUTCH(10, OUTFD)
  3337.  
  3338.    30 CONTINUE
  3339.  
  3340.         STATUS = ZTBACC(POINT, NAME, JUNK, VALUES, ARRAY)
  3341.         IF(ROOT .EQ. POINT) THEN
  3342.           IF(VALUES(2).NE.0) THEN
  3343.             INDEX = CALLD(1, VALUES(2))
  3344.           ELSE
  3345.             INDEX=0
  3346.           ENDIF
  3347.         ENDIF
  3348.         PUSHED = .FALSE.
  3349.  
  3350.         CALL ZPTINT(LINE, 4, OUTFD)
  3351.         CALL ZOBLNK(LEVEL * 4 + 2, OUTFD)
  3352.         CALL PUTLIN(NAME, OUTFD)
  3353.         IF(VALUES(4) .EQ. 0) THEN
  3354.           CALL ZCHOUT(' (?).', OUTFD)
  3355.         ELSE IF(VALUES(4) .EQ. -1) THEN
  3356.           CALL ZCHOUT(' (Std.. Intrinsic).', OUTFD)
  3357.         ENDIF
  3358.  
  3359.         IF(VALUES(3) .EQ. 0) THEN
  3360.  
  3361.           VALUES(3) = LINE
  3362.           STATUS    = ZTBUPD(POINT, VALUES, ARRAY)
  3363.  
  3364.           IF(VALUES(2) .EQ. 0) THEN
  3365.             LINE = LINE + 1
  3366.             CALL PUTCH(10, OUTFD)
  3367.  
  3368.           ELSE IF(VALUES(2) .LT. 0) THEN
  3369.             CALL ZCHOUT(' (ENTRY: .', OUTFD)
  3370.             STATUS = ZTBACC(-VALUES(2), NAME, JUNK, NEWVAL, ARRAY)
  3371.             CALL PUTLIN(NAME, OUTFD)
  3372.             CALL ZCHOUT(' @ .', OUTFD)
  3373.             CALL ZPTINT(NEWVAL(3), 1, OUTFD)
  3374.             LINE = LINE + 1
  3375.             CALL ZMESS (').', OUTFD)
  3376.  
  3377.           ELSE
  3378.             IF(LEVEL .GT. MAXLVL) THEN
  3379.               CALL REPORT('TOO COMPLEX.', OUTFD)
  3380.               RETURN
  3381.             ENDIF
  3382.             STACK(LEVEL) = INDEX
  3383.             LEVEL = LEVEL + 1
  3384.             INDEX = VALUES(2)
  3385.             LINE = LINE + 1
  3386.             CALL PUTCH(10, OUTFD)
  3387.  
  3388.           ENDIF
  3389.  
  3390.         ELSE
  3391.           IF(VALUES(2) .NE. 0) THEN
  3392.             CALL ZCHOUT(' (.', OUTFD)
  3393.             CALL ZPTINT(VALUES(3), 1, OUTFD)
  3394.             LINE = LINE + 1
  3395.             CALL ZMESS (').', OUTFD)
  3396.           ELSE
  3397.             LINE = LINE + 1
  3398.             CALL PUTCH(10, OUTFD)
  3399.           ENDIF
  3400.  
  3401.         ENDIF
  3402.  
  3403.    22   CONTINUE
  3404.         IF(INDEX .EQ. 0) THEN
  3405.    23     CONTINUE
  3406.             IF(LEVEL .LE. 1) GO TO 20
  3407.             LEVEL = LEVEL - 1
  3408.             INDEX = STACK(LEVEL)
  3409.           IF(INDEX .EQ. 0) GO TO 23
  3410.         ENDIF
  3411.         POINT = CALLD(2, INDEX)
  3412.         INDEX = CALLD(1, INDEX)
  3413.         IF(POINT .EQ. 0) GO TO 22
  3414.  
  3415.       GO TO 30
  3416.  
  3417.       END
  3418. C--------------------------------------------------------------
  3419. C
  3420. C  PRODUCE A TOTALS SUMMARY LISTING
  3421. C
  3422.       SUBROUTINE TOTLST(COMAND)
  3423.  
  3424.       INTEGER I, JUNK, FIRST
  3425.       INTEGER COMAND(*)
  3426.       INTEGER ZSETP, ZPFIND
  3427.       LOGICAL FLAG
  3428. C---------------------------------------------------------
  3429. C    TOOLPACK/1    Release: 2.5
  3430. C---------------------------------------------------------
  3431. C
  3432. C     .. Parameters ..
  3433. C
  3434. C  MAXSEG     The maximum number of segments that can be held in memory
  3435. C  MAXROU     The maximum number of routines that can be held in memory
  3436. C
  3437.  
  3438.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  3439.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  3440.       PARAMETER(MAXPRO= MAXROU + 1)
  3441. C     ..
  3442. C---------------------------------------------------------
  3443. C    TOOLPACK/1    Release: 2.5
  3444. C---------------------------------------------------------
  3445.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  3446.       INTEGER OUTFD,  RMARG, REPRTS
  3447.  
  3448.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  3449.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  3450. C---------------------------------------------------------
  3451. C    TOOLPACK/1    Release: 2.5
  3452. C---------------------------------------------------------
  3453. C
  3454. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  3455. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  3456. C
  3457. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  3458. C             THE STATIC SUMMARY)
  3459. C
  3460. C  NAMES      THE NAMES OF THE ROUTINES
  3461. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  3462. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  3463. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  3464. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  3465. C             IN EACH ROUTINE).
  3466. C
  3467. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  3468. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  3469. C             IN EACH ROUTINE).
  3470. C
  3471.  
  3472.       INTEGER NUMROU, NUMSEG, NOASRT
  3473.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  3474.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  3475.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  3476.  
  3477.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  3478.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  3479.       SAVE
  3480.  
  3481.       JUNK = ZSETP(COMAND, CASFOL)
  3482.  
  3483.       IF(VERBOS) THEN
  3484.         CALL PUTCH(10, OUTFD)
  3485.         CALL ZMESS('The following table gives information.',OUTFD)
  3486.         CALL ZMESS('derived from the static a'//'nd dynamic.',OUTFD)
  3487.         CALL ZMESS('statistics specified...',OUTFD)
  3488.       ENDIF
  3489.       CALL PUTCH(10, OUTFD)
  3490.       IF(OUTFD .NE. 1) THEN
  3491.         CALL ZMESS ('..nf.', OUTFD)
  3492.         CALL ZMESS ('..nj.', OUTFD)
  3493.         CALL ZMESS ('..ul.', OUTFD)
  3494.         CALL ZMESS ('..ce.', OUTFD)
  3495.       ENDIF
  3496.       CALL ZMESS ('SUMMARY TOTALS.', OUTFD)
  3497.       CALL PUTCH(10, OUTFD)
  3498.       CALL ZMESS(
  3499.      +'---PROGRAM UNIT---  ------STATEMENTS-------   ---SEGMENTS-----'
  3500.      +,OUTFD)
  3501.       CALL ZMESS(
  3502.      +'        INVOCATION  TOTAL  EXEC-    PERCENT   TOTAL   PERCENT '
  3503.      +,OUTFD)
  3504.       CALL ZMESS(
  3505.      +'NAME    FREQUENCY   NUMBER   UTABLE EXECUTED  NUMBER  EXECUTED'
  3506.      +,OUTFD)
  3507.       CALL ZMESS(
  3508.      +'--------------------------------------------------------------'
  3509.      +,OUTFD)
  3510.       DO 10 I = 1, NUMROU
  3511.         IF(ZPFIND(NAMES(1, I), 1, FIRST,  JUNK) .EQ. -2) THEN
  3512.           FLAG = .TRUE.
  3513.           IF(FIRST .NE. 1) FLAG = .FALSE.
  3514.         ELSE
  3515.           FLAG = .FALSE.
  3516.         ENDIF
  3517.         CALL TOREPS(I, FLAG)
  3518.    10 CONTINUE
  3519.  
  3520.       CALL TOREPS(0, .TRUE.)
  3521.       CALL COMPLT(OUTFD)
  3522.  
  3523.       END
  3524. C--------------------------------------------------------------
  3525. C
  3526.       SUBROUTINE TOREPS(I, FLAG)
  3527.  
  3528.       INTEGER I, J, K, COUNT, FIRST, LAST
  3529.       INTEGER VAL(6), TOT(6), CUM(2)
  3530.       LOGICAL FLAG
  3531.       INTEGER GETLIM
  3532. C---------------------------------------------------------
  3533. C    TOOLPACK/1    Release: 2.5
  3534. C---------------------------------------------------------
  3535. C
  3536. C     .. Parameters ..
  3537. C
  3538. C  MAXSEG     The maximum number of segments that can be held in memory
  3539. C  MAXROU     The maximum number of routines that can be held in memory
  3540. C
  3541.  
  3542.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  3543.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  3544.       PARAMETER(MAXPRO= MAXROU + 1)
  3545. C     ..
  3546. C---------------------------------------------------------
  3547. C    TOOLPACK/1    Release: 2.5
  3548. C---------------------------------------------------------
  3549. C     .. Scalars in Common ..
  3550.       INTEGER     KAGOG,
  3551.      +            KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,KCFUNG,
  3552.      +            KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  3553.      +            KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  3554.      +            KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,
  3555.      +            KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,
  3556.      +            KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,
  3557.      +            KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,KSUBRG,KUFUNG,
  3558.      +            KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,LCMNTG,LERRG,
  3559.      +            LLINEG,LSTMTG
  3560. C     ..
  3561. C     .. Common blocks ..
  3562.       COMMON      /KEYSC/KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,
  3563.      +            KCALLG,KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,
  3564.      +            KCONTG,KDATAG,KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,
  3565.      +            KENDFG,KENDG,KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,
  3566.      +            KIMPLG,KINQRG,KINSCG,KINTEG,KLFUNG,KLIFG,KLOGCG,
  3567.      +            KNONEG,KNTRYG,KOPENG,KPARAG,KPAUSG,KPRNTG,KPROGG,
  3568.      +            KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,KSFUNG,KSTOPG,
  3569.      +            KSUBRG,KUFUNG,KUGOG,KWINDG,KWRITG,KXFUNG,LASRTG,
  3570.      +            LCMNTG,LERRG,LLINEG,LSTMTG
  3571. C     ..
  3572. C---------------------------------------------------------
  3573. C    TOOLPACK/1    Release: 2.5
  3574. C---------------------------------------------------------
  3575.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  3576.       INTEGER OUTFD,  RMARG, REPRTS
  3577.  
  3578.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  3579.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  3580. C---------------------------------------------------------
  3581. C    TOOLPACK/1    Release: 2.5
  3582. C---------------------------------------------------------
  3583. C
  3584. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  3585. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  3586. C
  3587. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  3588. C             THE STATIC SUMMARY)
  3589. C
  3590. C  NAMES      THE NAMES OF THE ROUTINES
  3591. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  3592. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  3593. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  3594. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  3595. C             IN EACH ROUTINE).
  3596. C
  3597. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  3598. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  3599. C             IN EACH ROUTINE).
  3600. C
  3601.  
  3602.       INTEGER NUMROU, NUMSEG, NOASRT
  3603.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  3604.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  3605.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  3606.  
  3607.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  3608.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  3609.       SAVE
  3610.  
  3611.       IF(I .EQ. 1) THEN
  3612.         DO 5 J = 1, 6
  3613.           TOT(J) = 0
  3614.     5   CONTINUE
  3615.         CUM(1) = 0
  3616.         CUM(2) = 0
  3617.       ENDIF
  3618.  
  3619.       IF(I .EQ. 0) THEN
  3620.         IF(FLAG) THEN
  3621.           CALL PUTCH(10, OUTFD)
  3622.           CALL ZCHOUT('-TOTAL .', OUTFD)
  3623.           TOT(4) = 0
  3624.           TOT(6) = 0
  3625.           IF(TOT(5) .NE. 0) THEN
  3626.             TOT(6) = (100 * CUM(2)) / TOT(5)
  3627.           ELSE
  3628.             TOT(4) = 0
  3629.           ENDIF
  3630.           IF(TOT(3) .NE. 0) THEN
  3631.             TOT(4) = (100 * CUM(1)) / TOT(3)
  3632.           ELSE
  3633.             TOT(4) = 0
  3634.           ENDIF
  3635.           DO 10 J = 1, 6
  3636.             CALL ZPTINT(TOT(J), 9, OUTFD)
  3637.    10     CONTINUE
  3638.           CALL PUTCH (10, OUTFD)
  3639.         ENDIF
  3640.       ELSE
  3641.         IF(FLAG) CALL PUTLIN(NAMES(1, I), OUTFD)
  3642.         VAL(2) = RTOTAL(LSTMTG, I)
  3643.         VAL(5) = GETLIM(I, FIRST, LAST)
  3644.         IF(VAL(5) .EQ. 0) THEN
  3645.           IF(FLAG) CALL ZOBLNK(10, OUTFD)
  3646.           IF(FLAG) CALL ZPTINT(VAL(2), 9, OUTFD)
  3647.           TOT(2) = TOT(2) + VAL(2)
  3648.           IF(FLAG) CALL ZMESS('  -- block data --.', OUTFD)
  3649.           RETURN
  3650.         ENDIF
  3651.         VAL(1) = SEGS(FIRST)
  3652.         VAL(3) = 0
  3653.         VAL(4) = 0
  3654.         VAL(6) = 0
  3655.         DO 100 J = ISTSEG(I), LAST
  3656.           IF(SEGS(J) .NE. 0) THEN
  3657.             COUNT = 0
  3658.             DO 200 K = 1, 56
  3659.               COUNT = COUNT + COUNTS(K,J)
  3660.   200       CONTINUE
  3661.             VAL(4) = VAL(4) + COUNT
  3662.             VAL(6) = VAL(6) + 1
  3663.           ENDIF
  3664.  
  3665.           VAL(3) = VAL(3)            +COUNTS(KASSNG,J)+COUNTS(KBACKG,J)+
  3666.      +             COUNTS(KCALLG , J)+COUNTS(KCLOSG,J)+COUNTS(KCONTG,J)+
  3667.      +             COUNTS(KDOG,J)+    COUNTS(KELSFG,J)+COUNTS(KELSEG,J)+
  3668.      +             COUNTS(KENDFG,J)+  COUNTS(KENDIG,J)+COUNTS(KENDG,J)+
  3669.      +             COUNTS(KUGOG,J)+   COUNTS(KLIFG,J)+ COUNTS(KINQRG,J)+
  3670.      +             COUNTS(KOPENG,J)+  COUNTS(KPAUSG,J)+COUNTS(KPRNTG,J)+
  3671.      +             COUNTS(KREADG,J)+  COUNTS(KRETNG,J)+COUNTS(KWINDG,J)+
  3672.      +             COUNTS(KSTOPG,J)+  COUNTS(KWRITG,J)+COUNTS(KAGOG,J)+
  3673.      +             COUNTS(KCGOG,J)+   COUNTS(KAIFG,J)+ COUNTS(KBIFG,J)+
  3674.      +             COUNTS(KASMTG,J)
  3675.   100   CONTINUE
  3676.         CUM(1) = CUM(1) + VAL(4)
  3677.         CUM(2) = CUM(2) + VAL(6)
  3678.         IF(VAL(5) .NE. 0) THEN
  3679.           VAL(6) = (100 * VAL(6)) / VAL(5)
  3680.         ELSE
  3681.           VAL(6) = 0
  3682.         ENDIF
  3683.         IF(VAL(3) .NE. 0) THEN
  3684.           VAL(4) = (100 * VAL(4)) / VAL(3)
  3685.         ELSE
  3686.           VAL(4) = 0
  3687.         ENDIF
  3688.         IF(FLAG) CALL ZOBLNK(1, OUTFD)
  3689.           DO 20 J = 1, 6
  3690.             IF(FLAG) THEN
  3691.               CALL ZPTINT(VAL(J), 9, OUTFD)
  3692.             ENDIF
  3693.             TOT(J) = TOT(J) + VAL(J)
  3694.    20     CONTINUE
  3695.         IF(FLAG) CALL PUTCH (10, OUTFD)
  3696.       ENDIF
  3697.  
  3698.       END
  3699. C-----------------------------------------------------------
  3700. C
  3701. C RETURN THE FIRST AND LAST SEGMENT NUMBERS FOR THE SPECIFIED
  3702. C ROUTINE, ALSO THE VALUE OF THE FUNCTION IS THE NUMBER OF SEGMENTS.
  3703. C
  3704.       INTEGER FUNCTION GETLIM(ROUTIN, FIRST, LAST)
  3705.  
  3706.       INTEGER ROUTIN, FIRST, LAST, I
  3707. C---------------------------------------------------------
  3708. C    TOOLPACK/1    Release: 2.5
  3709. C---------------------------------------------------------
  3710. C
  3711. C     .. Parameters ..
  3712. C
  3713. C  MAXSEG     The maximum number of segments that can be held in memory
  3714. C  MAXROU     The maximum number of routines that can be held in memory
  3715. C
  3716.  
  3717.       INTEGER LMAXG, MAXSEG, MAXROU, MAXASR, MAXPRO
  3718.       PARAMETER(LMAXG=61, MAXSEG=2048, MAXROU=512, MAXASR=512)
  3719.       PARAMETER(MAXPRO= MAXROU + 1)
  3720. C     ..
  3721. C---------------------------------------------------------
  3722. C    TOOLPACK/1    Release: 2.5
  3723. C---------------------------------------------------------
  3724. C
  3725. C  NUMSEG     THE ACTUAL NUMBER OF SEGMENTS THAT ARE BEING HELD IN MEMORY
  3726. C  NUMROU     THE ACTUAL NUMBER OF ROUTINES THAT ARE BEING HELD IN MEMORY
  3727. C
  3728. C  COUNTS     THE NUMBER OF EACH STATEMENT TYPE FOUND IN EACH SEGMENT (FROM
  3729. C             THE STATIC SUMMARY)
  3730. C
  3731. C  NAMES      THE NAMES OF THE ROUTINES
  3732. C  ISTSEG     THE FIRST SEGMENT NUMBER OF THE ROUTINES
  3733. C  ISTASG     THE FIRST ASSERTION NUMBER OF THE ROUTINES
  3734. C  RTOTAL     THE TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE (THE
  3735. C             SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  3736. C             IN EACH ROUTINE).
  3737. C
  3738. C  DTOTAL     THE DYNAMIC TOTAL OF EACH STATEMENT TYPE IN EACH ROUTINE
  3739. C             (THE SUMMATION OF THE VALUES IN COUNTS FOR ALL THE SEGMENTS
  3740. C             IN EACH ROUTINE).
  3741. C
  3742.  
  3743.       INTEGER NUMROU, NUMSEG, NOASRT
  3744.       INTEGER COUNTS(LMAXG, MAXSEG), NAMES(7, MAXROU), ISTSEG(MAXROU),
  3745.      +        ISTASG(MAXROU), RTOTAL(LMAXG, MAXROU), ASRTS(MAXASR),
  3746.      +        DTOTAL(LMAXG, MAXPRO), SEGS(MAXSEG), PTOTAL(LMAXG)
  3747.  
  3748.       COMMON /CCOUNT/ COUNTS, NAMES,  ISTSEG, ISTASG, RTOTAL, DTOTAL,
  3749.      +                ASRTS,  SEGS,   PTOTAL, NUMROU, NUMSEG, NOASRT
  3750.       SAVE
  3751.  
  3752.       FIRST = ISTSEG(ROUTIN)
  3753.       IF(FIRST .EQ. 0) THEN
  3754.         LAST   = 0
  3755.         GETLIM = 0
  3756.         RETURN
  3757.       ENDIF
  3758.  
  3759.       IF(ROUTIN .EQ. NUMROU) THEN
  3760.         LAST = NUMSEG
  3761.       ELSE
  3762.         I = 1
  3763.    10   CONTINUE
  3764.           LAST = ISTSEG(ROUTIN + I) - 1
  3765.           IF(LAST .LT. 0) THEN
  3766.             I = I + 1
  3767.             IF(ROUTIN + I .LE. NUMROU) GO TO 10
  3768.             LAST = NUMSEG
  3769.           ENDIF
  3770.  
  3771.       ENDIF
  3772.  
  3773.       GETLIM = LAST - FIRST + 1
  3774.  
  3775.       END
  3776. C---------------------------------------------------------------
  3777. C
  3778. C  FUNCTION TO ADD A NON PU REFERENCE TO THE VARIABLE TABLE
  3779. C
  3780.       SUBROUTINE XVADD(PUNAME, LENP, COMNAM, LENC, BDFLAG, BVALS)
  3781.  
  3782.       INTEGER PPOINT, CPOINT, LENP, LENC, I
  3783.       INTEGER PUNAME(*), COMNAM(*), VVALS(12), JUNKV(4), BVALS(*),
  3784.      +        NAME(34)
  3785.       INTEGER ZTBGET, ZTBPUT
  3786.       LOGICAL BDFLAG
  3787.  
  3788. C---------------------------------------------------------
  3789. C    TOOLPACK/1    Release: 2.5
  3790. C---------------------------------------------------------
  3791. C
  3792. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  3793. C  AND XREFERENCE GENERATION ROUTINES.
  3794. C
  3795. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  3796. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  3797. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  3798. C
  3799. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  3800. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  3801. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  3802. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  3803. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  3804. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  3805. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  3806. C
  3807. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  3808. C  CALLD(2, X)   THE TABLE ENTRY.
  3809. C
  3810. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  3811. C  CALLR(2, X)   THE TABLE ENTRY.
  3812. C
  3813. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  3814. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  3815. C  COMLST THE LINKED LIST OF USERS.
  3816. C
  3817.       INTEGER MAXSIZ, MAXENT, MAXVAR
  3818.       PARAMETER (MAXVAR = 30720)
  3819.       PARAMETER (MAXSIZ = 2048)
  3820.       PARAMETER (MAXENT = 1024)
  3821.  
  3822.       INTEGER NUMCLD, NUMCLR, NUMCOM
  3823.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  3824.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  3825.  
  3826.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  3827.      +               NUMCLR, NUMCLD, NUMCOM
  3828.       SAVE
  3829. C
  3830. C  SEARCH OUT THE PROGRAM UNIT ENTRY.
  3831. C
  3832.       PPOINT = ZTBGET(PUNAME, LENP, JUNKV, ARRAY)
  3833.       IF((PPOINT .EQ. -1) .OR. (PPOINT .EQ. -100))
  3834.      +   CALL ERROR('UNABLE TO FIND PROGRAM UNIT NAME IN TABLE.')
  3835. C
  3836. C  SET UP THE VARIABLE ENTRY, THE NAME IS PRECEDED BY A POINTER TO THE
  3837. C  PROGRAM UNIT (FOR UNIQUENESS) AND THE SYMBOL VALUES (PLUS A MODIFIED BLOCK
  3838. C  DATA FLAG) ARE STORED IN THE TABLE.
  3839. C
  3840.       NAME(1) = PPOINT
  3841.       DO 10 I = 1, 7
  3842.         VVALS(I) = BVALS(I)
  3843.    10 CONTINUE
  3844.       CALL SCOPY(COMNAM,1,NAME,2)
  3845.       VVALS(8) = 0
  3846.       IF(BDFLAG) VVALS(8) = 1
  3847.  
  3848.       CPOINT = ZTBPUT(NAME, LENC+1, VVALS, VARARR)
  3849.       IF((CPOINT .EQ. -1) .OR. (CPOINT .EQ. -100))
  3850.      +   CALL ERROR('UNABLE TO ENTER VARIABLE NAME INTO TABLE.')
  3851.  
  3852.       END
  3853. C-------------------------------------------------------------
  3854. C
  3855. C  PRODUCE A SYMBOL OR WARNING LISTING.
  3856. C
  3857.       SUBROUTINE VLIST(SHOW, BODY)
  3858.  
  3859.       INTEGER JUNK, ENTRYS, SHOW, NAMLEN, FIRST, I, KEYLEN, STATUS
  3860.       INTEGER BODY(*), KEY(34), VALUES(8), JUNKS(10), NAME(34)
  3861.       INTEGER ZTBTYP, ZSETP, ZTBACC, ZPFIND
  3862. C---------------------------------------------------------
  3863. C    TOOLPACK/1    Release: 2.5
  3864. C---------------------------------------------------------
  3865.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  3866.       INTEGER OUTFD,  RMARG, REPRTS
  3867.  
  3868.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  3869.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  3870. C---------------------------------------------------------
  3871. C    TOOLPACK/1    Release: 2.5
  3872. C---------------------------------------------------------
  3873. C
  3874. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  3875. C  AND XREFERENCE GENERATION ROUTINES.
  3876. C
  3877. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  3878. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  3879. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  3880. C
  3881. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  3882. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  3883. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  3884. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  3885. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  3886. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  3887. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  3888. C
  3889. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  3890. C  CALLD(2, X)   THE TABLE ENTRY.
  3891. C
  3892. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  3893. C  CALLR(2, X)   THE TABLE ENTRY.
  3894. C
  3895. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  3896. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  3897. C  COMLST THE LINKED LIST OF USERS.
  3898. C
  3899.       INTEGER MAXSIZ, MAXENT, MAXVAR
  3900.       PARAMETER (MAXVAR = 30720)
  3901.       PARAMETER (MAXSIZ = 2048)
  3902.       PARAMETER (MAXENT = 1024)
  3903.  
  3904.       INTEGER NUMCLD, NUMCLR, NUMCOM
  3905.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  3906.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  3907.  
  3908.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  3909.      +               NUMCLR, NUMCLD, NUMCOM
  3910.       SAVE
  3911.  
  3912.       IF(ZTBTYP(VARARR, JUNK, ENTRYS, JUNK, JUNK) .NE. -2) CALL
  3913.      +   ERROR('INVALID TABLE.')
  3914.  
  3915.       IF(BODY(1) .EQ. 129) RETURN
  3916.       JUNK = ZSETP(BODY, CASFOL)
  3917.  
  3918.       IF(VERBOS) THEN
  3919.         CALL PUTCH(10, OUTFD)
  3920.         IF(SHOW .EQ. -2) THEN
  3921.           CALL ZMESS('The following table shows the symbol.',OUTFD)
  3922.           CALL ZMESS('usage for the specified program units...',OUTFD)
  3923.         ELSE
  3924.           CALL ZMESS('The following table shows warnings.',OUTFD)
  3925.           CALL ZMESS('derived from the symbol tables of the.',OUTFD)
  3926.           CALL ZMESS('specified program units...',OUTFD)
  3927.         ENDIF
  3928.       ENDIF
  3929.  
  3930.       CALL PUTCH(10, OUTFD)
  3931.       IF(OUTFD .NE. 1) THEN
  3932.         CALL ZMESS('..nf.', OUTFD)
  3933.         CALL ZMESS('..nj.', OUTFD)
  3934.       ENDIF
  3935.  
  3936.       I  = 1
  3937.    10 CONTINUE
  3938.         STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
  3939.         STATUS = ZTBACC(KEY(1), NAME, NAMLEN, JUNKS, ARRAY)
  3940.         IF(ZPFIND(NAME, 1, FIRST, JUNK) .EQ. -2) THEN
  3941.           IF(FIRST .EQ. 1) THEN
  3942.             IF(SHOW .EQ. -2) THEN
  3943.              CALL ZCHOUT
  3944.      +       ('Symbol table information for program u'//'nit: .',OUTFD)
  3945.             ELSE
  3946.               CALL ZCHOUT('Warnings for program u'//'nit: .',OUTFD)
  3947.             ENDIF
  3948.             CALL ZPTMES(NAME, OUTFD)
  3949.             CALL DOVARS(I, SHOW, ENTRYS)
  3950.             CALL PUTCH(10, OUTFD)
  3951.           ENDIF
  3952.         ENDIF
  3953.         I = I + 1
  3954.       IF(I .LE. ENTRYS) GO TO 10
  3955.  
  3956.       CALL COMPLT(OUTFD)
  3957.  
  3958.       END
  3959. C---------------------------------------------------------------
  3960. C
  3961.       SUBROUTINE DOVARS(POINT, FLAG, LIMIT)
  3962.  
  3963.       INTEGER POINT, FLAG, FIRST, LAST, KEYLEN, COUNT, STATUS, I, PU,
  3964.      +        LIMIT, MASK
  3965.       INTEGER KEY(34), VALUES(8)
  3966.       INTEGER ZTBACC, ZIAND
  3967. C---------------------------------------------------------
  3968. C    TOOLPACK/1    Release: 2.5
  3969. C---------------------------------------------------------
  3970.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  3971.       INTEGER OUTFD,  RMARG, REPRTS
  3972.  
  3973.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  3974.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  3975. C---------------------------------------------------------
  3976. C    TOOLPACK/1    Release: 2.5
  3977. C---------------------------------------------------------
  3978. C
  3979. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  3980. C  AND XREFERENCE GENERATION ROUTINES.
  3981. C
  3982. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  3983. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  3984. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  3985. C
  3986. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  3987. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  3988. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  3989. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  3990. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  3991. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  3992. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  3993. C
  3994. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  3995. C  CALLD(2, X)   THE TABLE ENTRY.
  3996. C
  3997. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  3998. C  CALLR(2, X)   THE TABLE ENTRY.
  3999. C
  4000. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  4001. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  4002. C  COMLST THE LINKED LIST OF USERS.
  4003. C
  4004.       INTEGER MAXSIZ, MAXENT, MAXVAR
  4005.       PARAMETER (MAXVAR = 30720)
  4006.       PARAMETER (MAXSIZ = 2048)
  4007.       PARAMETER (MAXENT = 1024)
  4008.  
  4009.       INTEGER NUMCLD, NUMCLR, NUMCOM
  4010.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  4011.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  4012.  
  4013.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  4014.      +               NUMCLR, NUMCLD, NUMCOM
  4015.       SAVE
  4016.  
  4017.       FIRST = POINT
  4018.       LAST  = POINT - 1
  4019.       STATUS = ZTBACC(FIRST, KEY, KEYLEN, VALUES, VARARR)
  4020.       PU = KEY(1)
  4021.    10 CONTINUE
  4022.         LAST = LAST + 1
  4023.         IF(LAST .LE. LIMIT) THEN
  4024.           STATUS = ZTBACC(LAST + 1, KEY, KEYLEN, VALUES, VARARR)
  4025.           IF((KEY(1) .EQ. PU) .AND. (STATUS .EQ. -2))GO TO 10
  4026.         ENDIF
  4027. C
  4028. C  WARNING SECTION
  4029. C
  4030.       IF(FLAG .EQ. -3) THEN
  4031.         MASK  = 16 + 32 + 64 + 128 +
  4032.      +          65536 + 4 + 2048
  4033.  
  4034.         COUNT = 0
  4035.         DO 20 I = FIRST, LAST
  4036.           STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
  4037.           IF(VALUES(8) .EQ. 1)  GO TO 20
  4038.           IF(VALUES(1) .EQ. 1) THEN
  4039.             IF(VALUES(5) + VALUES(6) +
  4040.      +         VALUES(7) .EQ. 0) THEN
  4041.               COUNT = COUNT + 1
  4042.               CALL ZCHOUT('  Unused Label: .', OUTFD)
  4043.               CALL WRNAME(KEY, VALUES, .TRUE.)
  4044.             ENDIF
  4045.  
  4046.           ELSE IF(VALUES(1) .EQ. 3) THEN
  4047.               COUNT = COUNT + 1
  4048.               IF(ZIAND(VALUES(6), 4) .NE. 0) THEN
  4049.                 CALL ZCHOUT('  Unused dummy argument: ', OUTFD)
  4050.               ELSE
  4051.                 CALL ZCHOUT('  Unused symbol: ', OUTFD)
  4052.               ENDIF
  4053.               CALL WRNAME(KEY, VALUES, .TRUE.)
  4054.  
  4055.           ELSE IF(VALUES(1) .EQ. 5) THEN
  4056.             IF((ZIAND(VALUES(6), 125936) .EQ. 0) .AND.
  4057.      +         (ZIAND(VALUES(6), 1024) .EQ. 0)) THEN
  4058.               COUNT = COUNT + 1
  4059.               CALL ZCHOUT('  Unused Variable: .', OUTFD)
  4060.               CALL WRNAME(KEY, VALUES, .TRUE.)
  4061.             ELSE IF(ZIAND(VALUES(6), 8) .EQ. 0)THEN
  4062.               IF(IMPLI) THEN
  4063.                 CALL ZCHOUT('  Implicitly typed Variable: .', OUTFD)
  4064.                 COUNT = COUNT + 1
  4065.                 CALL WRNAME(KEY, VALUES, .TRUE.)
  4066.               ENDIF
  4067.             ELSE IF(ZIAND(VALUES(6), MASK) .EQ. 0 .AND.
  4068.      +         (ZIAND(VALUES(6), 1024) .EQ. 0)) THEN
  4069.               CALL ZCHOUT('  Variable n'//'ot explicitly set: .', OUTFD)
  4070.               COUNT = COUNT + 1
  4071.               CALL WRNAME(KEY, VALUES, .TRUE.)
  4072.             ENDIF
  4073.  
  4074.           ELSE IF(VALUES(1) .EQ. 8) THEN
  4075.             IF(ZIAND(VALUES(6), 125936) .EQ. 0) THEN
  4076.               COUNT = COUNT + 1
  4077.               CALL ZCHOUT('  Unused Statement Function: .', OUTFD)
  4078.               CALL WRNAME(KEY, VALUES, .TRUE.)
  4079.             ELSE IF(ZIAND(VALUES(6), 8) .EQ. 0)THEN
  4080.               IF(IMPLI) THEN
  4081.                 COUNT = COUNT + 1
  4082.                 CALL ZCHOUT
  4083.      +               ('  Implicitly typed Statement Function: .', OUTFD)
  4084.                 CALL WRNAME(KEY, VALUES, .TRUE.)
  4085.               ENDIF
  4086.             ENDIF
  4087.  
  4088.           ELSE IF(VALUES(1) .EQ. 6) THEN
  4089.             IF(ZIAND(VALUES(6), 125936) .EQ. 0) THEN
  4090.               CALL ZCHOUT('  Unused Parameter: .', OUTFD)
  4091.               COUNT = COUNT + 1
  4092.               CALL WRNAME(KEY, VALUES, .TRUE.)
  4093.             ELSE IF(ZIAND(VALUES(6), 8) .EQ. 0)THEN
  4094.               IF(IMPLI) THEN
  4095.                 CALL ZCHOUT('  Implicitly typed Parameter: .', OUTFD)
  4096.                 COUNT = COUNT + 1
  4097.                 CALL WRNAME(KEY, VALUES, .TRUE.)
  4098.               ENDIF
  4099.             ENDIF
  4100.  
  4101.           ELSE IF(VALUES(1) .EQ. 7) THEN
  4102.             IF(ZIAND(VALUES(6), 125936) .EQ. 0) THEN
  4103.               CALL ZCHOUT('  Unused Procedure: .', OUTFD)
  4104.               COUNT = COUNT + 1
  4105.               CALL WRNAME(KEY, VALUES, .TRUE.)
  4106.             ELSE
  4107.               IF(ZIAND(VALUES(6), 8) .EQ. 0)THEN
  4108.                 IF(ZIAND(VALUES(6), 4096) .EQ. 0)THEN
  4109.                   IF(ZIAND(VALUES(6), 8192) .NE. 0)THEN
  4110.                     IF(IMPLI) THEN
  4111.                       CALL ZCHOUT
  4112.      +                     ('  Implicitly typed Procedure: .', OUTFD)
  4113.                       COUNT = COUNT + 1
  4114.                       CALL WRNAME(KEY, VALUES, .TRUE.)
  4115.                     ENDIF
  4116.                   ENDIF
  4117.                 ENDIF
  4118.               ELSE
  4119.                 IF(ZIAND(VALUES(6), 4096) .NE. 0)THEN
  4120.                   CALL ZCHOUT('  Typed Standard Intrinsic: .', OUTFD)
  4121.                   COUNT = COUNT + 1
  4122.                   CALL WRNAME(KEY, VALUES, .TRUE.)
  4123.                 ENDIF
  4124.               ENDIF
  4125.               IF(ZIAND(VALUES(6), 4096) .NE. 0) THEN
  4126.                 IF(ZIAND(VALUES(6), 2) .EQ. 0)THEN
  4127.                   CALL ZCHOUT
  4128.      +         ('  Intrinsic procedure n'//'ot in INTRINSIC: .', OUTFD)
  4129.                   COUNT = COUNT + 1
  4130.                   CALL WRNAME(KEY, VALUES, .TRUE.)
  4131.                 ENDIF
  4132.               ELSE IF(ZIAND(VALUES(6), 1).EQ.0)THEN
  4133.                 CALL ZCHOUT
  4134.      +         ('  External procedure n'//'ot in EXTERNAL: .', OUTFD)
  4135.                 COUNT = COUNT + 1
  4136.                 CALL WRNAME(KEY, VALUES, .TRUE.)
  4137.               ENDIF
  4138.             ENDIF
  4139.  
  4140.           ELSE IF(VALUES(1) .EQ. 4) THEN
  4141.             IF(FIRST .GE. LAST) THEN
  4142.               CALL ZCHOUT('  Trivial program unit: .', OUTFD)
  4143.               COUNT = COUNT + 1
  4144.               CALL WRNAME(KEY, VALUES, .TRUE.)
  4145.             ENDIF
  4146.             IF(VALUES(4) .GT. 0) THEN
  4147.               IF(ZIAND(VALUES(6), 125936) .EQ. 0) THEN
  4148.                 CALL ZCHOUT('  Function value n'//'ot set: .', OUTFD)
  4149.                 COUNT = COUNT + 1
  4150.                 CALL WRNAME(KEY, VALUES, .TRUE.)
  4151.               ENDIF
  4152.             ENDIF
  4153.           ENDIF
  4154.    20   CONTINUE
  4155.         IF(COUNT .EQ. 0) CALL ZMESS('  No Warnings Detected...', OUTFD)
  4156.  
  4157.       ELSE
  4158. C
  4159. C  SYMBOL USAGE INFORMATION
  4160. C
  4161.         CALL PRINTS(FIRST, LAST, 1)
  4162.  
  4163.       ENDIF
  4164.  
  4165.       POINT = LAST
  4166.  
  4167.       END
  4168. C-------------------------------------------------
  4169. C
  4170. C       P R I N T S   -   Print Symbols
  4171. C
  4172. C  ORDER = 1   LEAVE THE LABELS IN THE CURRENTLY SORTED ORDER
  4173. C  ORDER = 2   SORT THE LABELS NUMERICALLY
  4174. C  ORDER = 3   OUTPUT THE LABELS IN THE ORDER OF THEIR DEFINITION NODES.
  4175. C
  4176.  
  4177.       SUBROUTINE PRINTS(FIRST, LAST, ORDER)
  4178.  
  4179.       INTEGER FIRST, LAST, KEYLEN, COUNT, STATUS, I, J,
  4180.      +        ORDER, LABELS
  4181.       INTEGER KEY(34), VALUES(8), TABLE(3, 500)
  4182.       INTEGER ZTBACC, CTOI
  4183. C---------------------------------------------------------
  4184. C    TOOLPACK/1    Release: 2.5
  4185. C---------------------------------------------------------
  4186.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  4187.       INTEGER OUTFD,  RMARG, REPRTS
  4188.  
  4189.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  4190.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  4191. C---------------------------------------------------------
  4192. C    TOOLPACK/1    Release: 2.5
  4193. C---------------------------------------------------------
  4194. C
  4195. C  THIS COMMON BLOCK HOLDS INFORMATION FOR THE CALLGRAPH
  4196. C  AND XREFERENCE GENERATION ROUTINES.
  4197. C
  4198. C  THE ARRAY 'ARRAY' IS USED AS A TABLE (USING THE TABLES SUPPLEMENTARY
  4199. C  LIBRARY) TO HOLD THE NAMES OF ROUTINES AND CERTAIN POINTERS AND FLAGS.
  4200. C  EACH ENTRY IN THE TABLE CONTAINS THE FOLLOWING:
  4201. C
  4202. C  NAME   THE NAME OF THE ROUTINE, THIS IS THE KEY OF THE ENTRY.
  4203. C  CALLS  0 IF NO ROUTINE CALLS THIS ONE, OTHERWISE A POINTER TO
  4204. C         THE START OF A LINKED LIST IN ARRAY 'CALLR'.
  4205. C  CALL   0 IF THIS ROUTINE DOESNT CALL ANY OTHER ROUTINES, -VE IF
  4206. C         THIS IS AN ENTRY POINT ( ABS(CALL) GIVES THE TABLE ENTRY
  4207. C         OF THE ROUTINE TO WHICH THIS IS AN ENTRY POINT). OTHERWISE
  4208. C         A POINTER TO THE START OF A LINKED LIST IN ARRAY 'CALLD'.
  4209. C
  4210. C  CALLD(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  4211. C  CALLD(2, X)   THE TABLE ENTRY.
  4212. C
  4213. C  CALLR(1, X)   A POINTER TO THE NEXT ELEMENT IN THE LIST, OR 0.
  4214. C  CALLR(2, X)   THE TABLE ENTRY.
  4215. C
  4216. C  COMARR THE NAMES OF COMMON BLOCKS AND POINTERS TO THE LINKED LIST
  4217. C         OF PROGRAM UNITS THAT REFERENCE THEM.
  4218. C  COMLST THE LINKED LIST OF USERS.
  4219. C
  4220.       INTEGER MAXSIZ, MAXENT, MAXVAR
  4221.       PARAMETER (MAXVAR = 30720)
  4222.       PARAMETER (MAXSIZ = 2048)
  4223.       PARAMETER (MAXENT = 1024)
  4224.  
  4225.       INTEGER NUMCLD, NUMCLR, NUMCOM
  4226.       INTEGER ARRAY(MAXSIZ),  CALLR(2, MAXENT),  CALLD(2, MAXENT),
  4227.      +        COMARR(MAXSIZ), COMLST(2, MAXENT), VARARR(MAXVAR)
  4228.  
  4229.       COMMON /CXREF/ ARRAY, CALLR, CALLD, COMARR, COMLST, VARARR,
  4230.      +               NUMCLR, NUMCLD, NUMCOM
  4231.       SAVE
  4232.  
  4233.       LABELS = 0
  4234.       DO 9 I = FIRST, LAST
  4235.         STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
  4236.         IF (VALUES(1).EQ.1) THEN
  4237.           LABELS = LABELS + 1
  4238.           TABLE(1, LABELS) = VALUES(4)
  4239.           TABLE(2, LABELS) = I
  4240.           J = 1
  4241.           TABLE(3, LABELS) = CTOI(KEY, J)
  4242.         ENDIF
  4243.     9 CONTINUE
  4244. C
  4245. C  A SORTING AGORITHM SHOULD BE PLACED HERE THAT CAN USE EITHER
  4246. C  TABLE(1...) OR TABLE(3...) AS A KEY
  4247. C
  4248. C      IF(ORDER .NE. 1) THEN
  4249. C      ENDIF
  4250.  
  4251.       COUNT = 0
  4252.       DO 10 I = 1, LABELS
  4253.         STATUS = ZTBACC(TABLE(2, I), KEY, KEYLEN, VALUES, VARARR)
  4254.         IF(COUNT .EQ. 0) CALL ZMESS('        Labels:.',OUTFD)
  4255.         COUNT = COUNT + 1
  4256.         CALL ZOBLNK(12, OUTFD)
  4257.         CALL WRNAME(KEY, VALUES, .FALSE.)
  4258.         CALL ZOBLNK(8 - KEYLEN, OUTFD)
  4259.         CALL ZCHOUT('- References (control,do,i/o): .',OUTFD)
  4260.         CALL ZPTINT(VALUES(5),1,OUTFD)
  4261.         CALL PUTCH(44,OUTFD)
  4262.         CALL ZPTINT(VALUES(6),1,OUTFD)
  4263.         CALL PUTCH(44,OUTFD)
  4264.         CALL ZPTINT(VALUES(7),1,OUTFD)
  4265.         CALL PUTCH(10,OUTFD)
  4266.    10 CONTINUE
  4267.  
  4268.       COUNT = 0
  4269.       DO 20 I = FIRST, LAST
  4270.         STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
  4271.         IF (VALUES(1).EQ.3) THEN
  4272.             IF(COUNT .EQ. 0)
  4273.      +         CALL ZMESS('        Names (Usage Unknown):.',OUTFD)
  4274.             COUNT = COUNT + 1
  4275.             CALL ZOBLNK(12,OUTFD)
  4276.             CALL WRNAME(KEY, VALUES, .FALSE.)
  4277.             CALL PUTCH(10,OUTFD)
  4278.             CALL WRBITS(VALUES(6))
  4279.         END IF
  4280.    20 CONTINUE
  4281.  
  4282.       COUNT = 0
  4283.       DO 30 I = FIRST, LAST
  4284.         STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
  4285.         IF (VALUES(1).EQ.5) THEN
  4286.             IF(COUNT .EQ. 0)CALL ZMESS('        Variables:.',OUTFD)
  4287.             COUNT = COUNT + 1
  4288.             CALL ZOBLNK(12,OUTFD)
  4289.             CALL WRNAME(KEY, VALUES, .FALSE.)
  4290.             IF (VALUES(7).NE.0) THEN
  4291.                  CALL ZMESS('(declared as an array).',OUTFD)
  4292.             ELSE
  4293.                 CALL PUTCH(10, OUTFD)
  4294.             END IF
  4295.             CALL WRBITS(VALUES(6))
  4296.         END IF
  4297.    30 CONTINUE
  4298.  
  4299.       COUNT = 0
  4300.       DO 40 I = FIRST, LAST
  4301.         STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
  4302.         IF (VALUES(1).EQ.6) THEN
  4303.             IF(COUNT .EQ. 0) CALL ZMESS('        Parameters:.',OUTFD)
  4304.             COUNT = COUNT + 1
  4305.             CALL ZOBLNK(12,OUTFD)
  4306.             CALL WRNAME(KEY, VALUES, .FALSE.)
  4307.             CALL PUTCH(10, OUTFD)
  4308.             CALL WRBITS(VALUES(6))
  4309.         END IF
  4310.    40 CONTINUE
  4311.  
  4312.       COUNT = 0
  4313.       DO 50 I = FIRST, LAST
  4314.         STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
  4315.         IF (VALUES(1).EQ.7) THEN
  4316.             IF(COUNT .EQ. 0) CALL ZMESS('        Procedures:.',OUTFD)
  4317.             COUNT = COUNT + 1
  4318.             CALL ZOBLNK(12,OUTFD)
  4319.             CALL WRNAME(KEY, VALUES, .FALSE.)
  4320.             CALL PUTCH(10,OUTFD)
  4321.             CALL WRBITS(VALUES(6))
  4322.         END IF
  4323.    50 CONTINUE
  4324.  
  4325.       COUNT = 0
  4326.       DO 60 I = FIRST, LAST
  4327.         STATUS = ZTBACC(I, KEY, KEYLEN, VALUES, VARARR)
  4328.         IF (VALUES(1).EQ.8) THEN
  4329.             IF(COUNT .EQ. 0)
  4330.      +        CALL ZMESS('        Statement Functions:.',OUTFD)
  4331.             COUNT = COUNT + 1
  4332.             CALL ZOBLNK(12,OUTFD)
  4333.             CALL WRNAME(KEY, VALUES, .TRUE.)
  4334.             CALL WRBITS(VALUES(6))
  4335.         END IF
  4336.    60 CONTINUE
  4337.  
  4338.         END
  4339. C ------------------------------------------------
  4340. C
  4341. C       W R N A M E   -   Write symbol name and data type if any
  4342. C
  4343.  
  4344.       SUBROUTINE WRNAME(NAME, SYMBOL, END)
  4345.       INTEGER NAME(*), SYMBOL(*)
  4346.       CHARACTER*17 TYPTXT(-3:15)
  4347.       LOGICAL TEST1, TEST2, END
  4348.  
  4349. C---------------------------------------------------------
  4350. C    TOOLPACK/1    Release: 2.5
  4351. C---------------------------------------------------------
  4352.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  4353.       INTEGER OUTFD,  RMARG, REPRTS
  4354.  
  4355.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  4356.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  4357.       SAVE
  4358.  
  4359.         DATA TYPTXT/
  4360.      +'Main Program.    ',
  4361.      +'Block-data.      ',
  4362.      +'Routine.         ',
  4363.      +'Unknown.         ',
  4364.      +'INTEGER.         ',
  4365.      +'REAL.            ',
  4366.      +'LOGICAL.         ',
  4367.      +'COMPLEX.         ',
  4368.      +'DOUBLE PRECISION.',
  4369.      +'CHARACTER.       ',
  4370.      +'DOUBLE COMPLEX.  ',
  4371.      +'Generic.         ',
  4372.      +'Hollerith.       ',
  4373.      +'Label.           ',
  4374.      +'Substring spec.  ',
  4375.      +'LOGICAL*1.       ',
  4376.      +'LOGICAL*2.       ',
  4377.      +'INTEGER*2.       ',
  4378.      +'REAL*16.         '/
  4379.  
  4380.       CALL PUTLIN(NAME(2),OUTFD)
  4381.       CALL ZLEGAL(NAME(2), TEST1, TEST2)
  4382.  
  4383.       IF (SYMBOL(1).EQ.1) RETURN
  4384.       IF (SYMBOL(1).EQ.2) GO TO 10
  4385.  
  4386.       CALL ZCHOUT(' - .',OUTFD)
  4387.       CALL ZCHOUT(TYPTXT(SYMBOL(4)),OUTFD)
  4388.       IF (SYMBOL(5).NE.0) THEN
  4389.         CALL PUTCH(42,OUTFD)
  4390.         IF (SYMBOL(5).GT.0) THEN
  4391.           CALL ZPTINT(SYMBOL(5),1,OUTFD)
  4392.         END IF
  4393.       END IF
  4394.  
  4395.    10 CONTINUE
  4396.       IF(TEST1) THEN
  4397.         IF(TEST2) CALL PUTCH(32,OUTFD)
  4398.         IF(.NOT.TEST2)CALL ZCHOUT(' (Name illegal on -11) .',OUTFD)
  4399.       ELSE
  4400.         IF(.NOT.TEST2)CALL ZCHOUT(' (Name illegal) .', OUTFD)
  4401.         IF(TEST2)CALL ZCHOUT(' (Name non-standard) .',OUTFD)
  4402.       ENDIF
  4403.  
  4404.       IF(END) CALL PUTCH(10,OUTFD)
  4405.  
  4406.       END
  4407. C ------------------------------------------------
  4408. C
  4409. C       W R B I T S   -   Write meaning of attribute bits
  4410. C
  4411.  
  4412.       SUBROUTINE WRBITS(N)
  4413.  
  4414.       INTEGER      BITS,I, N, NBITS
  4415.       PARAMETER (NBITS=22)
  4416.       CHARACTER*50 BITTXT(NBITS)
  4417.       INTEGER      ZIAND
  4418. C---------------------------------------------------------
  4419. C    TOOLPACK/1    Release: 2.5
  4420. C---------------------------------------------------------
  4421.       LOGICAL VERBOS, CASFOL, DEBUG, INTRIN, IMPLI, DECLIE
  4422.       INTEGER OUTFD,  RMARG, REPRTS
  4423.  
  4424.       COMMON /CINFO/ VERBOS, OUTFD, CASFOL, RMARG,
  4425.      +               DEBUG, REPRTS, INTRIN, IMPLI, DECLIE
  4426.       SAVE
  4427.  
  4428.         DATA (BITTXT(I),I=1,19)/
  4429.      +'                Declared EXTERNAL.                ',
  4430.      +'                Declared INTRINSIC.               ',
  4431.      +'                Formal parameter.                 ',
  4432.      +'                Explicitly typed.                 ',
  4433.      +'                In ASSIGN statement.              ',
  4434.      +'                Assigned to on lhs of "=".        ',
  4435.      +'                In READ input list.               ',
  4436.      +'                In DATA statement.                ',
  4437.      +'                Statement function formal param.  ',
  4438.      +'                In EQUIVALENCE statement.         ',
  4439.      +'                In COMMON block.                  ',
  4440.      +'                Used as an actual argument.       ',
  4441.      +'                Standard intrinsic function.      ',
  4442.      +'                Called as a function.             ',
  4443.      +'                In an expression.                 ',
  4444.      +'                Called as a subroutine.           ',
  4445.      +'                Used as a DO-loop index.          ',
  4446.      +'                Actual argument to external.      ',
  4447.      +'                Parameter value known.            '/
  4448.         DATA (BITTXT(I),I=20,NBITS)/
  4449.      +'                Equivalenced into a common block. ',
  4450.      +'                *** unassigned flag bit ***.      ',
  4451.      +'                In INCLUDE file.                  '/
  4452.  
  4453.       BITS = N
  4454.       DO 100 I = 1, NBITS
  4455.         IF (ZIAND(BITS, 1) .NE. 0) CALL ZMESS(BITTXT(I), OUTFD)
  4456.         BITS = BITS/2
  4457.  100  CONTINUE
  4458.  
  4459.       END
  4460.