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 / istan / ANLIB4.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  63.7 KB  |  1,526 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.3
  3. C---------------------------------------------------------
  4. C---------------------------------------------------------
  5. C    TOOLPACK/1    Release: 2.3
  6. C---------------------------------------------------------
  7. C ----------------------------------------------------------------------
  8. C
  9. C       P C A L L S   -   Process CALL statements
  10. C                         (look for alternate returns and external
  11. C                         function references in the argument list)
  12. C
  13.  
  14.         SUBROUTINE PCALLS
  15.  
  16. C---------------------------------------------------------
  17. C    TOOLPACK/1    Release: 2.3
  18. C---------------------------------------------------------
  19. C                  CONTROL VARIABLES
  20.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  21.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  22.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  23.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  24.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  25.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  26.      *         NSTMG,       NTREEG,      NTYPEG
  27.  
  28.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  29.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  30.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  31.      +          NTREEG,NTYPEG
  32.  
  33.         SAVE /CNTRLC/
  34.  
  35. C---------------------------------------------------------
  36. C    TOOLPACK/1    Release: 2.3
  37. C---------------------------------------------------------
  38. C                  LOGICAL VARIABLES
  39.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  40.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  41.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  42.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  43.      *         TREEG
  44.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  45.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  46.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  47.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  48.  
  49.         SAVE /LOGIC/
  50.  
  51. C---------------------------------------------------------
  52. C    TOOLPACK/1    Release: 2.3
  53. C---------------------------------------------------------
  54. C Option Settings
  55.         COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
  56.      +                 MTREQG,TIEG,ITRUNG
  57.  
  58.         INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
  59.      +          ITRUNG
  60.         LOGICAL TIEG
  61.  
  62.         SAVE /OPTSC/
  63.  
  64. C---------------------------------------------------------
  65. C    TOOLPACK/1    Release: 2.3
  66. C---------------------------------------------------------
  67.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  68.      +                MAXICH
  69.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  70.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  71.      +          MAXICH
  72.  
  73.         SAVE /TOKENS/
  74.  
  75. C
  76. C TOKTYP = array of token types for current statement
  77. C TOKLEN = parallel array of lengths of associated text strings
  78. C TXTPTR = parallel array of pointers into ISTMG character array of text
  79. C TOKEN = Current token number within statement being processed
  80. C NTOKSS = Number of tokens in statement
  81. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  82. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  83. C MAXICH = Last character used in ISTTXT array
  84. C
  85. C---------------------------------------------------------
  86. C    TOOLPACK/1    Release: 2.3
  87. C---------------------------------------------------------
  88. C                  MAIN INTEGER STORAGE ARRAYS
  89. C MAXLBG = Maximum number of DO statement labels per routine
  90.         INTEGER MAXLBG
  91.         PARAMETER(MAXLBG=100)
  92.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  93.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  94.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  95.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  96.      +          KEXECG,LABG,KTOKG
  97.         SAVE /WORKC/
  98. C---------------------------------------------------------
  99. C    TOOLPACK/1    Release: 2.4
  100. C---------------------------------------------------------
  101. C
  102. C  TKLAST = LAST TOKEN NUMBER
  103. C
  104.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  105.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  106.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  107.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  108.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  109.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  110.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  111.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  112.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  113.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  114.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  115.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  116.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  117.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  118.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  119.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  120.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  121.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  122.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  123.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  124.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  125.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  126.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  127.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  128.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  129.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  130.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  131.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  132.  
  133.  
  134.         INTEGER LEFTTK,COMMAT,ITOK,I,NUL
  135.         CHARACTER*6 NAMEL
  136.  
  137.         INTEGER SFINDT
  138.         CHARACTER*6 NAME
  139.  
  140. C Output statement
  141.         CALL OUTS
  142. C Find start of argument list
  143.         LEFTTK=NTOKG+1
  144.  50     IF (LEFTTK.LT.NTOKSS .AND. TOKTYP(LEFTTK).NE.TLPARN) THEN
  145.             LEFTTK=LEFTTK+1
  146.             GOTO 50
  147.         END IF
  148. C If argument list exists, check for alternate returns
  149.         IF (TOKTYP(LEFTTK).EQ.TLPARN) THEN
  150.             COMMAT=LEFTTK
  151. C Look for next special token in list
  152.   100       ITOK=SFINDT(COMMAT+1)
  153.             IF (TOKTYP(ITOK).EQ.TSTAR .AND. (TOKTYP(ITOK-1).EQ.TLPARN
  154.      +          .OR. TOKTYP(ITOK-1).EQ.TCOMMA)) THEN
  155. C Alternate return found - request segment.
  156.                 ISCNTG(ITYPEG) = ISCNTG(ITYPEG) + 1
  157.                 SEGMTG = .FALSE.
  158.                 CALL SEGMTS(.TRUE.)
  159.                 ISCNTG(ITYPEG) = ISCNTG(ITYPEG) - 1
  160.             ELSE IF (ITOK.LT.NTOKSS) THEN
  161. C Keep looking.
  162.                 COMMAT=ITOK
  163.                 GOTO 100
  164.             ELSE
  165. C There are no alternate returns.
  166.                 SEGMTG = .FALSE.
  167.             END IF
  168.         ELSE
  169. C There is no argument list.
  170.             SEGMTG = .FALSE.
  171.         END IF
  172.  
  173.         END
  174. C ----------------------------------------------------------------------
  175. C
  176. C       P C G O S   -   Process computed GOTO statements
  177. C
  178.  
  179.         SUBROUTINE PCGOS(ITOKA,NTOKA)
  180.         INTEGER ITOKA,NTOKA
  181.  
  182. C---------------------------------------------------------
  183. C    TOOLPACK/1    Release: 2.3
  184. C---------------------------------------------------------
  185. C                  CONTROL VARIABLES
  186.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  187.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  188.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  189.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  190.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  191.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  192.      *         NSTMG,       NTREEG,      NTYPEG
  193.  
  194.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  195.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  196.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  197.      +          NTREEG,NTYPEG
  198.  
  199.         SAVE /CNTRLC/
  200.  
  201. C---------------------------------------------------------
  202. C    TOOLPACK/1    Release: 2.3
  203. C---------------------------------------------------------
  204. C                  KEYWORD ID VARIABLES
  205.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  206.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  207.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  208.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  209.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  210.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  211.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  212.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  213.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  214.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  215.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  216.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  217.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  218.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  219.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  220.      *         LLINEG,      LSTMTG
  221.  
  222.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  223.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  224.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  225.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  226.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  227.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  228.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  229.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  230.         INTEGER KUFUNG,KSUBRG
  231.  
  232.         SAVE /KEYSC/
  233.  
  234. C---------------------------------------------------------
  235. C    TOOLPACK/1    Release: 2.3
  236. C---------------------------------------------------------
  237. C                  LOGICAL VARIABLES
  238.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  239.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  240.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  241.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  242.      *         TREEG
  243.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  244.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  245.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  246.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  247.  
  248.         SAVE /LOGIC/
  249.  
  250. C---------------------------------------------------------
  251. C    TOOLPACK/1    Release: 2.3
  252. C---------------------------------------------------------
  253.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  254.      +                MAXICH
  255.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  256.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  257.      +          MAXICH
  258.  
  259.         SAVE /TOKENS/
  260.  
  261. C
  262. C TOKTYP = array of token types for current statement
  263. C TOKLEN = parallel array of lengths of associated text strings
  264. C TXTPTR = parallel array of pointers into ISTMG character array of text
  265. C TOKEN = Current token number within statement being processed
  266. C NTOKSS = Number of tokens in statement
  267. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  268. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  269. C MAXICH = Last character used in ISTTXT array
  270. C
  271. C---------------------------------------------------------
  272. C    TOOLPACK/1    Release: 2.3
  273. C---------------------------------------------------------
  274.         COMMON/ANVNAM/VNAMEG
  275.         CHARACTER*5 VNAMEG
  276.         SAVE/ANVNAM/
  277. C---------------------------------------------------------
  278. C    TOOLPACK/1    Release: 2.4
  279. C---------------------------------------------------------
  280. C
  281. C  TKLAST = LAST TOKEN NUMBER
  282. C
  283.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  284.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  285.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  286.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  287.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  288.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  289.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  290.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  291.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  292.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  293.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  294.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  295.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  296.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  297.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  298.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  299.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  300.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  301.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  302.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  303.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  304.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  305.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  306.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  307.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  308.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  309.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  310.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  311.  
  312.  
  313.         INTEGER NTOK2L,NTOK3L,ITOK,JTOK,NARGL,L
  314.  
  315.         INTEGER SFINDT
  316.  
  317. C Balance parentheses and find following comma
  318.         CALL BALPRT(NTOKA,NTOK2L)
  319.         IF (NTOK2L.GT.0) THEN
  320.             NTOK3L=NTOK2L+1
  321.             IF (TOKTYP(NTOK3L).NE.TCOMMA) NTOK3L=NTOK3L-1
  322. C Count arguments
  323.             NARGL = 0
  324.             JTOK = NTOKA
  325.   100       ITOK = JTOK + 1
  326.             JTOK=SFINDT(ITOK)
  327.             IF (TOKTYP(JTOK).EQ.TCOMMA) THEN
  328.                 NARGL = NARGL + 1
  329.             ELSE IF (TOKTYP(JTOK).EQ.TRPARN) THEN
  330.                 NARGL = NARGL + 1
  331.                 GOTO 110
  332.             END IF
  333.             GOTO 100
  334. C Pack first part of original 'GOTO'
  335.   110       IF (LABFLG.EQ.2) THEN
  336.                 IF (SEGMTG .AND. ITYPEG.EQ.KCGOG) THEN
  337. C Computed GOTO at end of active DO-loop: special instrumentation
  338.                     CALL OUTDOS
  339.                 ELSE IF (ITYPEG.EQ.KCGOG) THEN
  340. C Retain original label for other DO-loop ends
  341.                     CALL SENDTK(1,1)
  342.                 END IF
  343.             ELSE IF (ITYPEG.EQ.KCGOG) THEN
  344. C No label for non-do-loops.
  345. C ... Output segmentation now if required
  346.                 IF (SEGMTG) CALL OUTSGS(NMSEG)
  347.                 CALL SENDCH('      ')
  348.             END IF
  349.             CALL SENDTK(ITOKA,NTOK3L)
  350. C Send constants
  351.             CALL SENDCH('K'//VNAMEG//'(')
  352. C Send last part of original 'GOTO'
  353.             CALL SENDTK(NTOK3L+1,NTOKSS)
  354. C Send last set of constants
  355.             CALL SENDCH(',')
  356.             CALL SENDI(NMSEG)
  357.             CALL SENDCH(',')
  358.             CALL SENDI(NARGL)
  359.             CALL SENDCH(')')
  360. C Output statement
  361.             CALL PCGO2S(NARGL)
  362.         ELSE
  363. C Unbalanced parentheses
  364.             CALL ERRORS(12)
  365.             IF (SEGMTG) THEN
  366.                 CALL OUTANS(NMSEG)
  367.             ELSE
  368.                 CALL OUTANS(0)
  369.             END IF
  370.             CALL INSOUT
  371.         END IF
  372.  
  373.         END
  374. C ----------------------------------------------------------------------
  375. C
  376. C       P C G O 2 S   -   Output computed goto statement and
  377. C                         instrumentation.
  378. C
  379.  
  380.         SUBROUTINE PCGO2S(NARGA)
  381.         INTEGER NARGA
  382.  
  383. C---------------------------------------------------------
  384. C    TOOLPACK/1    Release: 2.3
  385. C---------------------------------------------------------
  386. C Character variables and arrays, except for dictionaries & VNAMEG
  387.         INTEGER MAXCMG
  388.         PARAMETER(MAXCMG=30)
  389.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  390.  
  391.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  392.         CHARACTER*6 NAMEG
  393.         CHARACTER*72 ICOMG(MAXCMG)
  394.  
  395.         SAVE /CHARC/
  396. C---------------------------------------------------------
  397. C    TOOLPACK/1    Release: 2.3
  398. C---------------------------------------------------------
  399. C                  LOGICAL VARIABLES
  400.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  401.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  402.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  403.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  404.      *         TREEG
  405.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  406.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  407.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  408.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  409.  
  410.         SAVE /LOGIC/
  411.  
  412. C---------------------------------------------------------
  413. C    TOOLPACK/1    Release: 2.3
  414. C---------------------------------------------------------
  415. C                  CONTROL VARIABLES
  416.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  417.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  418.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  419.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  420.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  421.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  422.      *         NSTMG,       NTREEG,      NTYPEG
  423.  
  424.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  425.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  426.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  427.      +          NTREEG,NTYPEG
  428.  
  429.         SAVE /CNTRLC/
  430.  
  431. C---------------------------------------------------------
  432. C    TOOLPACK/1    Release: 2.3
  433. C---------------------------------------------------------
  434. C                  ROUTINE INSTRUMENTATION FLAGS
  435.       COMMON / INSTC   /    INST1G,      INST2G,      INST3G
  436.  
  437.         INTEGER INST1G,INST2G,INST3G
  438.  
  439.         SAVE /INSTC/
  440.  
  441. C---------------------------------------------------------
  442. C    TOOLPACK/1    Release: 2.3
  443. C---------------------------------------------------------
  444. C                  KEYWORD ID VARIABLES
  445.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  446.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  447.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  448.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  449.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  450.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  451.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  452.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  453.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  454.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  455.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  456.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  457.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  458.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  459.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  460.      *         LLINEG,      LSTMTG
  461.  
  462.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  463.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  464.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  465.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  466.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  467.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  468.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  469.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  470.         INTEGER KUFUNG,KSUBRG
  471.  
  472.         SAVE /KEYSC/
  473.  
  474. C---------------------------------------------------------
  475. C    TOOLPACK/1    Release: 2.3
  476. C---------------------------------------------------------
  477. C                  MAIN INTEGER STORAGE ARRAYS
  478. C MAXLBG = Maximum number of DO statement labels per routine
  479.         INTEGER MAXLBG
  480.         PARAMETER(MAXLBG=100)
  481.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  482.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  483.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  484.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  485.      +          KEXECG,LABG,KTOKG
  486.         SAVE /WORKC/
  487. C---------------------------------------------------------
  488. C    TOOLPACK/1    Release: 2.4
  489. C---------------------------------------------------------
  490. C
  491. C  TKLAST = LAST TOKEN NUMBER
  492. C
  493.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  494.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  495.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  496.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  497.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  498.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  499.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  500.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  501.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  502.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  503.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  504.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  505.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  506.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  507.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  508.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  509.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  510.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  511.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  512.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  513.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  514.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  515.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  516.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  517.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  518.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  519.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  520.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  521.  
  522.  
  523.         INTEGER L
  524.         CHARACTER*5 SEG1,SEG2,NUML
  525.  
  526.         CGOTOG = .TRUE.
  527.         INST2G = 1
  528. C Determine segment number for 'GOTO', if required.
  529.         IF (SEGMTG) THEN
  530.             WRITE(NUML,9000) NMSEG
  531.         ELSE
  532.             NUML=' '
  533.         END IF
  534. C Output instrumented statement
  535.         CALL SEND
  536. C Output annotated statement
  537.         WRITE(SEG1,9000) NMSEG+1
  538.         WRITE(SEG2,9000) NMSEG+NARGA
  539.         CALL WRITOK(TCMMNT,'*$AN$'//NUML//'      '//SEG1//' TO '//SEG2)
  540.         CALL OUTANS(0)
  541. C Output statement file records for segments
  542. C Ensure 'GOTO' counted with initial segment
  543.         ISCNTG(ITYPEG) = ISCNTG(ITYPEG) + 1
  544.         IF (NARGA.GT.0) THEN
  545.             DO 130 L=1,NARGA
  546.                 SEGMTG = .FALSE.
  547.   130           CALL SEGMTS(.TRUE.)
  548.         END IF
  549.         ISCNTG(ITYPEG) = ISCNTG(ITYPEG) - 1
  550.  
  551. 9000    FORMAT(SS,I5)
  552.         END
  553. C ----------------------------------------------------------------------
  554. C
  555. C       P D I M N S   -   Process specifications for dimensioned
  556. C                         variables.
  557. C
  558.  
  559.         SUBROUTINE PDIMNS
  560.  
  561. C---------------------------------------------------------
  562. C    TOOLPACK/1    Release: 2.3
  563. C---------------------------------------------------------
  564. C Character variables and arrays, except for dictionaries & VNAMEG
  565.         INTEGER MAXCMG
  566.         PARAMETER(MAXCMG=30)
  567.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  568.  
  569.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  570.         CHARACTER*6 NAMEG
  571.         CHARACTER*72 ICOMG(MAXCMG)
  572.  
  573.         SAVE /CHARC/
  574. C---------------------------------------------------------
  575. C    TOOLPACK/1    Release: 2.3
  576. C---------------------------------------------------------
  577. C                  CONTROL VARIABLES
  578.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  579.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  580.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  581.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  582.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  583.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  584.      *         NSTMG,       NTREEG,      NTYPEG
  585.  
  586.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  587.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  588.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  589.      +          NTREEG,NTYPEG
  590.  
  591.         SAVE /CNTRLC/
  592.  
  593. C---------------------------------------------------------
  594. C    TOOLPACK/1    Release: 2.3
  595. C---------------------------------------------------------
  596. C Dictionary
  597. C   MAXDDG = Maximum number of dimension names in dictionary
  598. C   MAXRDG = Maximum number of routine names in dictionary
  599.         INTEGER MAXDDG,MAXRDG
  600.         PARAMETER(MAXDDG=150,MAXRDG=250)
  601.         COMMON /ANDICT/ DDICTG,RDICTG
  602.         CHARACTER*6 DDICTG(MAXDDG),RDICTG(MAXRDG)
  603.         SAVE /ANDICT/
  604. C---------------------------------------------------------
  605. C    TOOLPACK/1    Release: 2.3
  606. C---------------------------------------------------------
  607.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  608.      +                MAXICH
  609.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  610.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  611.      +          MAXICH
  612.  
  613.         SAVE /TOKENS/
  614.  
  615. C
  616. C TOKTYP = array of token types for current statement
  617. C TOKLEN = parallel array of lengths of associated text strings
  618. C TXTPTR = parallel array of pointers into ISTMG character array of text
  619. C TOKEN = Current token number within statement being processed
  620. C NTOKSS = Number of tokens in statement
  621. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  622. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  623. C MAXICH = Last character used in ISTTXT array
  624. C
  625. C---------------------------------------------------------
  626. C    TOOLPACK/1    Release: 2.4
  627. C---------------------------------------------------------
  628. C
  629. C  TKLAST = LAST TOKEN NUMBER
  630. C
  631.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  632.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  633.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  634.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  635.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  636.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  637.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  638.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  639.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  640.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  641.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  642.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  643.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  644.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  645.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  646.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  647.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  648.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  649.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  650.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  651.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  652.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  653.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  654.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  655.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  656.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  657.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  658.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  659.  
  660.  
  661.         INTEGER JTOK,LOCL
  662.         CHARACTER*6 NAMEL
  663.  
  664.         LOCL=1
  665. C Find a left parenthesis
  666. C (This relies on the last token in the stmt not being a TLPARN token;
  667. C  this is true even in illegal Fortran because the last token is always
  668. C  a TZEOS token).
  669.         JTOK = NTOKG
  670.  100    JTOK = JTOK + 1
  671.         IF (TOKTYP(JTOK).NE.TLPARN .AND. JTOK.LT.NTOKSS) GOTO 100
  672.         IF (TOKTYP(JTOK).EQ.TLPARN) THEN
  673.             NAMEL=' '
  674.             IF (TOKTYP(JTOK-1).EQ.TNAME)
  675.      +          CALL ZITOF(ISTTXT(ISTPTR(JTOK-1)),1,6,NAMEL,.FALSE.)
  676.             IF (NAMEL.NE.' ')
  677.      +          CALL NSAVES(NAMEL,DDICTG,NDDICG,MAXDDG,LOCL)
  678.             IF (LOCL.GT.0) THEN
  679. C Name saved, keep going.
  680.                 GOTO 100
  681.             ELSE
  682. C Dictionary overflow.
  683.                 CALL ERRORS(13)
  684.             END IF
  685.         END IF
  686. C Output statement
  687.         CALL OUTS
  688.  
  689.         END
  690. C ----------------------------------------------------------------------
  691. C
  692. C       P D O S   -   Process do statements
  693. C
  694.  
  695.         SUBROUTINE PDOS
  696.  
  697. C---------------------------------------------------------
  698. C    TOOLPACK/1    Release: 2.3
  699. C---------------------------------------------------------
  700. C                  CONTROL VARIABLES
  701.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  702.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  703.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  704.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  705.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  706.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  707.      *         NSTMG,       NTREEG,      NTYPEG
  708.  
  709.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  710.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  711.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  712.      +          NTREEG,NTYPEG
  713.  
  714.         SAVE /CNTRLC/
  715.  
  716. C---------------------------------------------------------
  717. C    TOOLPACK/1    Release: 2.3
  718. C---------------------------------------------------------
  719.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  720.      +                MAXICH
  721.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  722.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  723.      +          MAXICH
  724.  
  725.         SAVE /TOKENS/
  726.  
  727. C
  728. C TOKTYP = array of token types for current statement
  729. C TOKLEN = parallel array of lengths of associated text strings
  730. C TXTPTR = parallel array of pointers into ISTMG character array of text
  731. C TOKEN = Current token number within statement being processed
  732. C NTOKSS = Number of tokens in statement
  733. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  734. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  735. C MAXICH = Last character used in ISTTXT array
  736. C
  737. C---------------------------------------------------------
  738. C    TOOLPACK/1    Release: 2.3
  739. C---------------------------------------------------------
  740. C                  MAIN INTEGER STORAGE ARRAYS
  741. C MAXLBG = Maximum number of DO statement labels per routine
  742.         INTEGER MAXLBG
  743.         PARAMETER(MAXLBG=100)
  744.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  745.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  746.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  747.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  748.      +          KEXECG,LABG,KTOKG
  749.         SAVE /WORKC/
  750. C---------------------------------------------------------
  751. C    TOOLPACK/1    Release: 2.4
  752. C---------------------------------------------------------
  753. C
  754. C  TKLAST = LAST TOKEN NUMBER
  755. C
  756.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  757.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  758.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  759.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  760.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  761.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  762.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  763.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  764.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  765.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  766.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  767.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  768.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  769.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  770.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  771.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  772.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  773.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  774.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  775.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  776.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  777.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  778.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  779.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  780.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  781.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  782.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  783.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  784.  
  785.  
  786.         INTEGER POINT,LABEL,L
  787.  
  788.         INTEGER CTOI
  789.         EXTERNAL CTOI
  790.  
  791. C If room left in storage, get DO-end label
  792.         IF (NLABG.LT.MAXLBG) THEN
  793.             IF (TOKTYP(NTOKG).NE.TDCNST) CALL ERROR('PDOS WRONG')
  794.             POINT=1
  795.             LABEL=CTOI(ISTTXT(ISTPTR(NTOKG)),POINT)
  796. C Ensure DO-end label has not been seen before
  797.             IF (NLABG.GT.0) THEN
  798.                 DO 100 L=1,NLABG
  799.   100               IF (LABG(1,L).EQ.LABEL) GOTO 200
  800.             END IF
  801. C Save DO-end label and current segment number
  802.             NLABG = NLABG + 1
  803.             LABG(1,NLABG) = LABEL
  804.             LABG(2,NLABG) = NMSEG + 1
  805.         ELSE
  806. C Too many nested DO-loops
  807.             CALL ERRORS(17)
  808.         END IF
  809. C Output statement
  810.   200   CALL OUTS
  811.  
  812.         END
  813. C ----------------------------------------------------------------------
  814. C
  815. C       P E L S F S   -   Process ELSEIF statements
  816. C
  817.  
  818.         SUBROUTINE PELSFS
  819.  
  820. C---------------------------------------------------------
  821. C    TOOLPACK/1    Release: 2.3
  822. C---------------------------------------------------------
  823. C                  CONTROL VARIABLES
  824.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  825.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  826.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  827.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  828.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  829.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  830.      *         NSTMG,       NTREEG,      NTYPEG
  831.  
  832.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  833.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  834.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  835.      +          NTREEG,NTYPEG
  836.  
  837.         SAVE /CNTRLC/
  838.  
  839. C---------------------------------------------------------
  840. C    TOOLPACK/1    Release: 2.3
  841. C---------------------------------------------------------
  842. C                  ROUTINE INSTRUMENTATION FLAGS
  843.       COMMON / INSTC   /    INST1G,      INST2G,      INST3G
  844.  
  845.         INTEGER INST1G,INST2G,INST3G
  846.  
  847.         SAVE /INSTC/
  848.  
  849. C---------------------------------------------------------
  850. C    TOOLPACK/1    Release: 2.3
  851. C---------------------------------------------------------
  852. C                  LOGICAL VARIABLES
  853.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  854.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  855.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  856.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  857.      *         TREEG
  858.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  859.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  860.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  861.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  862.  
  863.         SAVE /LOGIC/
  864.  
  865. C---------------------------------------------------------
  866. C    TOOLPACK/1    Release: 2.3
  867. C---------------------------------------------------------
  868.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  869.      +                MAXICH
  870.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  871.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  872.      +          MAXICH
  873.  
  874.         SAVE /TOKENS/
  875.  
  876. C
  877. C TOKTYP = array of token types for current statement
  878. C TOKLEN = parallel array of lengths of associated text strings
  879. C TXTPTR = parallel array of pointers into ISTMG character array of text
  880. C TOKEN = Current token number within statement being processed
  881. C NTOKSS = Number of tokens in statement
  882. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  883. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  884. C MAXICH = Last character used in ISTTXT array
  885. C
  886. C---------------------------------------------------------
  887. C    TOOLPACK/1    Release: 2.3
  888. C---------------------------------------------------------
  889.         COMMON/ANVNAM/VNAMEG
  890.         CHARACTER*5 VNAMEG
  891.         SAVE/ANVNAM/
  892. C---------------------------------------------------------
  893. C    TOOLPACK/1    Release: 2.3
  894. C---------------------------------------------------------
  895. C                  MAIN INTEGER STORAGE ARRAYS
  896. C MAXLBG = Maximum number of DO statement labels per routine
  897.         INTEGER MAXLBG
  898.         PARAMETER(MAXLBG=100)
  899.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  900.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  901.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  902.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  903.      +          KEXECG,LABG,KTOKG
  904.         SAVE /WORKC/
  905.  
  906. C Balance parentheses
  907.         CALL BALPRT(NTOKG,NTOK2G)
  908.         IF (NTOK2G.GT.0) THEN
  909.             IF (.NOT.SEGMTG) CALL SEGMTS(.TRUE.)
  910. C Send initial section of statement
  911.             CALL SENDCH('      ELSEIF(L'//VNAMEG//'(')
  912. C Pack conditional portion of 'ELSEIF'
  913.             CALL SENDTK(NTOKG,NTOK2G)
  914. C Pack constants
  915.             CALL SENDCH(',')
  916.             CALL SENDI(NMSEG)
  917. C And finish it off
  918.             CALL SENDCH(',0))THEN')
  919. C Output instrumented statement
  920.             IFDOG = .TRUE.
  921.             INST3G = 1
  922.             CALL SEND
  923. C Output annotated statement
  924.             CALL OUTANS(NMSEG)
  925.         ELSE
  926. C Unbalanced parentheses
  927.             CALL ERRORS(12)
  928.             CALL OUTANS(0)
  929.             CALL INSOUT
  930.         END IF
  931.  
  932.         END
  933. C ----------------------------------------------------------------------
  934. C
  935. C       P E N D S   -   Process 'END' statements
  936. C
  937.  
  938.         SUBROUTINE PENDS
  939.  
  940. C---------------------------------------------------------
  941. C    TOOLPACK/1    Release: 2.3
  942. C---------------------------------------------------------
  943. C                  CONTROL VARIABLES
  944.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  945.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  946.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  947.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  948.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  949.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  950.      *         NSTMG,       NTREEG,      NTYPEG
  951.  
  952.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  953.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  954.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  955.      +          NTREEG,NTYPEG
  956.  
  957.         SAVE /CNTRLC/
  958.  
  959. C---------------------------------------------------------
  960. C    TOOLPACK/1    Release: 2.3
  961. C---------------------------------------------------------
  962. C                  KEYWORD ID VARIABLES
  963.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  964.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  965.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  966.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  967.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  968.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  969.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  970.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  971.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  972.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  973.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  974.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  975.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  976.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  977.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  978.      *         LLINEG,      LSTMTG
  979.  
  980.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  981.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  982.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  983.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  984.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  985.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  986.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  987.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  988.         INTEGER KUFUNG,KSUBRG
  989.  
  990.         SAVE /KEYSC/
  991.  
  992. C---------------------------------------------------------
  993. C    TOOLPACK/1    Release: 2.3
  994. C---------------------------------------------------------
  995. C                  LOGICAL VARIABLES
  996.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  997.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  998.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  999.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  1000.      *         TREEG
  1001.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  1002.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  1003.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  1004.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  1005.  
  1006.         SAVE /LOGIC/
  1007.  
  1008. C---------------------------------------------------------
  1009. C    TOOLPACK/1    Release: 2.3
  1010. C---------------------------------------------------------
  1011.         COMMON/ANVNAM/VNAMEG
  1012.         CHARACTER*5 VNAMEG
  1013.         SAVE/ANVNAM/
  1014.  
  1015.         IF (SEGMTG) THEN
  1016. C 'END' starts segment. Output segment and annotated statement.
  1017.             CALL OUTSGS(NMSEG)
  1018.             CALL OUTANS(NMSEG)
  1019.         ELSE
  1020. C Output un-annotated statement
  1021.             CALL OUTANS(0)
  1022.         END IF
  1023. C If 'END' may be executed in main routine, add call to wrapup routine,
  1024. C ... and say we have found a stopping point (prevents error message)
  1025.         IF (MAING) THEN
  1026.             IF ((LTYPEG.NE.KUGOG .AND. LTYPEG.NE.KAGOG .AND.
  1027.      +          LTYPEG.NE.KAIFG .AND. LTYPEG.NE.KSTOPG) .OR.
  1028.      +          LABFLG.GT.0) THEN
  1029.                 CALL SENDCH('      CALL R'//VNAMEG)
  1030.                 CALL SEND
  1031.                 STOPG=.TRUE.
  1032.             END IF
  1033.         END IF
  1034. C Output instrumented statement
  1035.         CALL UNLABL
  1036.         CALL INSOUT
  1037. C Output last segment record to summary file
  1038.         CALL RDONES
  1039.         SEGMTG = .FALSE.
  1040.  
  1041.         END
  1042. C ----------------------------------------------------------------------
  1043. C
  1044. C       P I O S   -   Process input/output statements
  1045. C
  1046.  
  1047.         SUBROUTINE PIOS
  1048.  
  1049. C---------------------------------------------------------
  1050. C    TOOLPACK/1    Release: 2.3
  1051. C---------------------------------------------------------
  1052. C Character variables and arrays, except for dictionaries & VNAMEG
  1053.         INTEGER MAXCMG
  1054.         PARAMETER(MAXCMG=30)
  1055.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  1056.  
  1057.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  1058.         CHARACTER*6 NAMEG
  1059.         CHARACTER*72 ICOMG(MAXCMG)
  1060.  
  1061.         SAVE /CHARC/
  1062. C---------------------------------------------------------
  1063. C    TOOLPACK/1    Release: 2.3
  1064. C---------------------------------------------------------
  1065. C                  CONTROL VARIABLES
  1066.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  1067.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  1068.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  1069.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  1070.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  1071.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  1072.      *         NSTMG,       NTREEG,      NTYPEG
  1073.  
  1074.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  1075.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  1076.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  1077.      +          NTREEG,NTYPEG
  1078.  
  1079.         SAVE /CNTRLC/
  1080.  
  1081. C---------------------------------------------------------
  1082. C    TOOLPACK/1    Release: 2.3
  1083. C---------------------------------------------------------
  1084. C                  KEYWORD ID VARIABLES
  1085.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  1086.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  1087.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  1088.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  1089.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  1090.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  1091.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  1092.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  1093.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  1094.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  1095.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  1096.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  1097.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  1098.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  1099.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  1100.      *         LLINEG,      LSTMTG
  1101.  
  1102.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  1103.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  1104.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  1105.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  1106.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  1107.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  1108.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  1109.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  1110.         INTEGER KUFUNG,KSUBRG
  1111.  
  1112.         SAVE /KEYSC/
  1113.  
  1114. C---------------------------------------------------------
  1115. C    TOOLPACK/1    Release: 2.3
  1116. C---------------------------------------------------------
  1117. C                  LOGICAL VARIABLES
  1118.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  1119.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  1120.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  1121.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  1122.      *         TREEG
  1123.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  1124.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  1125.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  1126.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  1127.  
  1128.         SAVE /LOGIC/
  1129.  
  1130. C---------------------------------------------------------
  1131. C    TOOLPACK/1    Release: 2.3
  1132. C---------------------------------------------------------
  1133.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  1134.      +                MAXICH
  1135.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  1136.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  1137.      +          MAXICH
  1138.  
  1139.         SAVE /TOKENS/
  1140.  
  1141. C
  1142. C TOKTYP = array of token types for current statement
  1143. C TOKLEN = parallel array of lengths of associated text strings
  1144. C TXTPTR = parallel array of pointers into ISTMG character array of text
  1145. C TOKEN = Current token number within statement being processed
  1146. C NTOKSS = Number of tokens in statement
  1147. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  1148. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  1149. C MAXICH = Last character used in ISTTXT array
  1150. C
  1151. C---------------------------------------------------------
  1152. C    TOOLPACK/1    Release: 2.3
  1153. C---------------------------------------------------------
  1154. C                  MAIN INTEGER STORAGE ARRAYS
  1155. C MAXLBG = Maximum number of DO statement labels per routine
  1156.         INTEGER MAXLBG
  1157.         PARAMETER(MAXLBG=100)
  1158.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  1159.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  1160.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  1161.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  1162.      +          KEXECG,LABG,KTOKG
  1163.         SAVE /WORKC/
  1164. C---------------------------------------------------------
  1165. C    TOOLPACK/1    Release: 2.4
  1166. C---------------------------------------------------------
  1167. C
  1168. C  TKLAST = LAST TOKEN NUMBER
  1169. C
  1170.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1171.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1172.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1173.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1174.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1175.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1176.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1177.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1178.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1179.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1180.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1181.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1182.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1183.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1184.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1185.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1186.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1187.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1188.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1189.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1190.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1191.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1192.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1193.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1194.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1195.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1196.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1197.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1198.  
  1199.  
  1200.         INTEGER I
  1201.  
  1202. C Output statement
  1203.         CALL OUTS
  1204.         SEGMTG = .FALSE.
  1205.         DO 100 I=NTOKG,NTOKSS
  1206.             IF (TOKTYP(I).EQ.TENDKD .OR. TOKTYP(I).EQ.TERRKD) THEN
  1207. C END= or ERR= found
  1208. C Start segment after current statement.
  1209.                 ISCNTG(ITYPEG) = ISCNTG(ITYPEG) + 1
  1210.                 CALL SEGMTS(.TRUE.)
  1211.                 ISCNTG(ITYPEG) = ISCNTG(ITYPEG) - 1
  1212.             END IF
  1213.  100    CONTINUE
  1214.  
  1215.         END
  1216. C ----------------------------------------------------------------------
  1217. C
  1218. C       P L I F S   -   Process logical if statements
  1219. C
  1220.  
  1221.         SUBROUTINE PLIFS
  1222.  
  1223. C---------------------------------------------------------
  1224. C    TOOLPACK/1    Release: 2.3
  1225. C---------------------------------------------------------
  1226. C Character variables and arrays, except for dictionaries & VNAMEG
  1227.         INTEGER MAXCMG
  1228.         PARAMETER(MAXCMG=30)
  1229.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  1230.  
  1231.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  1232.         CHARACTER*6 NAMEG
  1233.         CHARACTER*72 ICOMG(MAXCMG)
  1234.  
  1235.         SAVE /CHARC/
  1236. C---------------------------------------------------------
  1237. C    TOOLPACK/1    Release: 2.3
  1238. C---------------------------------------------------------
  1239. C                  LOGICAL VARIABLES
  1240.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  1241.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  1242.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  1243.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  1244.      *         TREEG
  1245.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  1246.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  1247.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  1248.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  1249.  
  1250.         SAVE /LOGIC/
  1251.  
  1252. C---------------------------------------------------------
  1253. C    TOOLPACK/1    Release: 2.3
  1254. C---------------------------------------------------------
  1255. C                  CONTROL VARIABLES
  1256.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  1257.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  1258.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  1259.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  1260.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  1261.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  1262.      *         NSTMG,       NTREEG,      NTYPEG
  1263.  
  1264.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  1265.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  1266.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  1267.      +          NTREEG,NTYPEG
  1268.  
  1269.         SAVE /CNTRLC/
  1270.  
  1271. C---------------------------------------------------------
  1272. C    TOOLPACK/1    Release: 2.3
  1273. C---------------------------------------------------------
  1274. C                  KEYWORD ID VARIABLES
  1275.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  1276.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  1277.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  1278.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  1279.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  1280.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  1281.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  1282.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  1283.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  1284.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  1285.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  1286.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  1287.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  1288.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  1289.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  1290.      *         LLINEG,      LSTMTG
  1291.  
  1292.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  1293.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  1294.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  1295.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  1296.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  1297.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  1298.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  1299.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  1300.         INTEGER KUFUNG,KSUBRG
  1301.  
  1302.         SAVE /KEYSC/
  1303.  
  1304. C---------------------------------------------------------
  1305. C    TOOLPACK/1    Release: 2.3
  1306. C---------------------------------------------------------
  1307. C                  MAIN INTEGER STORAGE ARRAYS
  1308. C MAXLBG = Maximum number of DO statement labels per routine
  1309.         INTEGER MAXLBG
  1310.         PARAMETER(MAXLBG=100)
  1311.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  1312.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  1313.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  1314.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  1315.      +          KEXECG,LABG,KTOKG
  1316.         SAVE /WORKC/
  1317.  
  1318.         INTEGER NUL
  1319.         CHARACTER*6 NAMEL
  1320.  
  1321.         CHARACTER*6 NAME
  1322.  
  1323.         IF (IFTYPG.EQ.KCGOG .OR. IFTYPG.EQ.KAIFG) THEN
  1324. C Arithmetic IF or computed GOTO consequence
  1325.             NBUFFG=0
  1326.             CALL SENDCH('      ')
  1327.             IF (LABFLG.EQ.2 .AND. SEGMTG) THEN
  1328. C End of active DO-loop
  1329.                 CALL IFDOS(NMSEG,0)
  1330.             ELSE
  1331. C Other. Logical function insertion not required.
  1332.                 CALL SENDTK(NTOKG-1,NTOK2G)
  1333.             END IF
  1334.             IF (IFTYPG .EQ. KCGOG) THEN
  1335.                 CALL PCGOS(NTOK2G+1,NTOK3G)
  1336.             ELSE
  1337.                 CALL PAIFS(NTOK3G,NTOK4G)
  1338.             END IF
  1339.         ELSE IF (LABFLG .EQ. 2) THEN
  1340. C 'IF' at end of DO-loop
  1341.             ISCNTG(ITYPEG) = ISCNTG(ITYPEG) + 1
  1342.             IF (SEGMTG) THEN
  1343. C Active DO-loop. 'IF' test is segment.
  1344.                 CALL IFENDS(NMSEG,NMSEG+1)
  1345.             ELSE
  1346. C Inactive DO-loop. 'IF' test is not segment.
  1347.                 CALL IFENDS(0,NMSEG+1)
  1348.             END IF
  1349.             SEGMTG = .FALSE.
  1350.             CALL SEGMTS(.TRUE.)
  1351.             ISCNTG(ITYPEG) = ISCNTG(ITYPEG) - 1
  1352.         ELSE
  1353. C Other IF consequence -  use block instrumentation of 'IF'
  1354.             CALL IFBLKS
  1355.         END IF
  1356.  
  1357.         END
  1358. C ----------------------------------------------------------------------
  1359. C
  1360. C       P N T R Y S   -   Process ENTRY statements
  1361. C
  1362.  
  1363.         SUBROUTINE PNTRYS
  1364.  
  1365. C---------------------------------------------------------
  1366. C    TOOLPACK/1    Release: 2.3
  1367. C---------------------------------------------------------
  1368. C                  CONTROL VARIABLES
  1369.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  1370.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  1371.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  1372.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  1373.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  1374.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  1375.      *         NSTMG,       NTREEG,      NTYPEG
  1376.  
  1377.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  1378.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  1379.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  1380.      +          NTREEG,NTYPEG
  1381.  
  1382.         SAVE /CNTRLC/
  1383.  
  1384. C---------------------------------------------------------
  1385. C    TOOLPACK/1    Release: 2.3
  1386. C---------------------------------------------------------
  1387. C Dictionary
  1388. C   MAXDDG = Maximum number of dimension names in dictionary
  1389. C   MAXRDG = Maximum number of routine names in dictionary
  1390.         INTEGER MAXDDG,MAXRDG
  1391.         PARAMETER(MAXDDG=150,MAXRDG=250)
  1392.         COMMON /ANDICT/ DDICTG,RDICTG
  1393.         CHARACTER*6 DDICTG(MAXDDG),RDICTG(MAXRDG)
  1394.         SAVE /ANDICT/
  1395. C---------------------------------------------------------
  1396. C    TOOLPACK/1    Release: 2.3
  1397. C---------------------------------------------------------
  1398.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1399.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1400.  
  1401.         SAVE /IO/
  1402.  
  1403. C---------------------------------------------------------
  1404. C    TOOLPACK/1    Release: 2.3
  1405. C---------------------------------------------------------
  1406. C                  KEYWORD ID VARIABLES
  1407.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  1408.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  1409.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  1410.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  1411.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  1412.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  1413.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  1414.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  1415.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  1416.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  1417.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  1418.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  1419.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  1420.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  1421.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  1422.      *         LLINEG,      LSTMTG
  1423.  
  1424.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  1425.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  1426.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  1427.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  1428.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  1429.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  1430.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  1431.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  1432.         INTEGER KUFUNG,KSUBRG
  1433.  
  1434.         SAVE /KEYSC/
  1435.  
  1436. C---------------------------------------------------------
  1437. C    TOOLPACK/1    Release: 2.3
  1438. C---------------------------------------------------------
  1439. C                  LOGICAL VARIABLES
  1440.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  1441.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  1442.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  1443.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  1444.      *         TREEG
  1445.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  1446.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  1447.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  1448.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  1449.  
  1450.         SAVE /LOGIC/
  1451.  
  1452. C---------------------------------------------------------
  1453. C    TOOLPACK/1    Release: 2.3
  1454. C---------------------------------------------------------
  1455. C                  MAIN INTEGER STORAGE ARRAYS
  1456. C MAXLBG = Maximum number of DO statement labels per routine
  1457.         INTEGER MAXLBG
  1458.         PARAMETER(MAXLBG=100)
  1459.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  1460.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  1461.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  1462.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  1463.      +          KEXECG,LABG,KTOKG
  1464.         SAVE /WORKC/
  1465. C---------------------------------------------------------
  1466. C    TOOLPACK/1    Release: 2.3
  1467. C---------------------------------------------------------
  1468.         COMMON/ANVNAM/VNAMEG
  1469.         CHARACTER*5 VNAMEG
  1470.         SAVE/ANVNAM/
  1471.  
  1472.         INTEGER NUL,NTRYL
  1473.         CHARACTER*5 SEGNUM
  1474.         CHARACTER*6 NAMEL
  1475.  
  1476.         CHARACTER*6 NAME
  1477.  
  1478. C Pick up and save ENTRY name
  1479.         NAMEL=NAME(NTOKG)
  1480.         IF (NAMEL.NE.' ') THEN
  1481.             CALL NSAVES(NAMEL,RDICTG,NRDICG,MAXRDG,NTRYL)
  1482.             IF (NTRYL.GT.0) THEN
  1483. C ENTRY name in dictionary. Remember it is an ENTRY.
  1484.                 INSTG(NTRYL) = -1
  1485.             ELSE
  1486. C Routine name dictionary overflow - stop now
  1487.                 CALL ERRORS(14)
  1488.             END IF
  1489. C Pick up arguments as possible dummy routine names
  1490.             CALL DARGS
  1491. C Instrument ENTRY only if in executable code
  1492.             IF (EXECG) THEN
  1493.                 IF (LTYPEG.EQ.KAGOG .OR. LTYPEG.EQ.KUGOG .OR.
  1494.      +              LTYPEG.EQ.KAIFG .OR. LTYPEG.EQ.KRETNG .OR.
  1495.      +              LTYPEG .EQ. KSTOPG) THEN
  1496. C ENTRY follows unconditional branch - add main routine entry segment.
  1497.                     CALL OUTS
  1498.                     CALL OUTSGS(ISBEG(NRTNG))
  1499.                 ELSE
  1500. C ENTRY follows possible fall through. Instrument to conditionally
  1501. C increment main routine segment.
  1502.                     ENTRYG = .TRUE.
  1503.                     CALL OUTMSG('      N'//VNAMEG//'=1',IODSCR)
  1504.                     CALL OUTS
  1505.                     WRITE(SEGNUM,9000) ISBEG(NRTNG)
  1506.                     CALL OUTTXT('      IF(N'//VNAMEG//'.EQ.0) ',IODSCR)
  1507.                     IF (TRACEG) THEN
  1508.                         CALL OUTMSG('CALL T'//VNAMEG//'('//SEGNUM//')',
  1509.      +                              IODSCR)
  1510.                     ELSE
  1511.                         CALL OUTMSG('I'//VNAMEG//'('//SEGNUM//')=I'//
  1512.      +                              VNAMEG//'('//SEGNUM//')+1',IODSCR)
  1513.                     END IF
  1514.                     CALL OUTMSG('      N'//VNAMEG//'=0',IODSCR)
  1515.                 END IF
  1516. C Next statement starts segment
  1517.                 CALL SEGMTS(.TRUE.)
  1518.             ELSE
  1519. C ENTRY precedes executable code
  1520.                 CALL OUTS
  1521.             END IF
  1522.         END IF
  1523.  
  1524. 9000    FORMAT(SS,I5)
  1525.         END
  1526.