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 / namechange / ISTCN.MAC.f next >
Encoding:
Text File  |  1989-03-04  |  12.8 KB  |  385 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 3.1
  3. C---------------------------------------------------------
  4. C
  5. C  TOKEN STREAM BASED NAME CHANGER
  6. C
  7.       PROGRAM ISTCN
  8.  
  9.       INTEGER SRCIN, SRCOUT, CMDFIL, OPTFIL, STATUS, NEXT
  10.       INTEGER TKNIN, TKNOUT, CMTIN, CMTOUT
  11.       INTEGER TKNINM(81), TKNONM(81),
  12.      +        CMTINM(81), CMTONM(81)
  13.       INTEGER SRCINM(81), SRCONM(81), CMDNAM(81),
  14.      +        OPTNAM(81)
  15.       LOGICAL INSRC, OUTSRC
  16.       INTEGER OPEN, CREATE, GETARG, READCF
  17.  
  18. C  Read paths from command file
  19.  
  20.       CALL ZINIT
  21.  
  22.       IF (GETARG(1,CMDNAM,81).EQ.-100) CALL NAMES(1,CMDNAM)
  23.       CMDFIL=OPEN(CMDNAM,0)
  24.       IF (CMDFIL.EQ.-1)
  25.      +          CALL ERROR('[ISTCN unable to open command file].')
  26.       STATUS = READCF(CMDFIL, INSRC, OUTSRC)
  27.       CALL CLOSE(CMDFIL)
  28.       IF(STATUS .NE. -2) THEN
  29.         CALL ZMESS('[ISTCN - Terminated in Error].', 1)
  30.         CALL ZQUIT(STATUS)
  31.       ENDIF
  32.  
  33.       IF(INSRC) THEN
  34.         IF (GETARG(2,SRCINM,81).EQ.-100) CALL NAMES(2, SRCINM)
  35.         SRCIN =OPEN(SRCINM,0)
  36.         IF (SRCIN .EQ.-1)
  37.      +        CALL ERROR('[ISTCN unable to open input file].')
  38.         NEXT = 3
  39.       ELSE
  40.         IF (GETARG(2,TKNINM,81).EQ.-100) CALL NAMES(3,TKNINM)
  41.         IF (GETARG(3,CMTINM,81).EQ.-100) CALL NAMES(4,CMTINM)
  42.         TKNIN =OPEN(TKNINM,0)
  43.         IF (TKNIN .EQ.-1)
  44.      +      CALL ERROR('[ISTCN unable to open input token file].')
  45.         CMTIN =OPEN(CMTINM,0)
  46.         IF (CMTIN .EQ.-1)
  47.      +      CALL ERROR('[ISTCN unable to open input comment file].')
  48.         NEXT = 4
  49.       ENDIF
  50.  
  51.       IF(OUTSRC) THEN
  52.         IF (GETARG(NEXT,SRCONM,81).EQ.-100) CALL NAMES(5, SRCONM)
  53.         IF (GETARG(NEXT+1,OPTNAM,81).EQ.-100) CALL NAMES(6, OPTNAM)
  54.         SRCOUT=CREATE(SRCONM,1)
  55.         IF (SRCOUT.EQ.-1)
  56.      +      CALL ERROR('[ISTCN unable to open output file].')
  57.         IF(OPTNAM(1) .NE. 45) THEN
  58.           OPTFIL=OPEN(OPTNAM,0)
  59.           IF (OPTFIL.EQ.-1)
  60.      +          CALL ERROR('[ISTCN unable to open option file].')
  61.           CALL PLOPTF(OPTFIL)
  62.           CALL CLOSE(OPTFIL)
  63.         ENDIF
  64.       ELSE
  65.         IF (GETARG(NEXT,TKNONM,81).EQ.-100) CALL NAMES(7,TKNONM)
  66.         IF (GETARG(NEXT+1,CMTONM,81).EQ.-100) CALL NAMES(8,CMTONM)
  67.         TKNOUT=CREATE(TKNONM,1)
  68.         IF (TKNOUT.EQ.-1)
  69.      +      CALL ERROR('[ISTCN unable to open output token file].')
  70.         CMTOUT=CREATE(CMTONM,1)
  71.         IF (CMTOUT.EQ.-1)
  72.      +      CALL ERROR('[ISTCN unable to open output comment file].')
  73.       ENDIF
  74.  
  75.       CALL TRNSFR(INSRC, OUTSRC, SRCIN,  TKNIN,  CMTIN,
  76.      +                           SRCOUT, TKNOUT, CMTOUT, STATUS)
  77.  
  78.       IF(STATUS .EQ. -2) THEN
  79.         CALL ZMESS('[ISTCN - Normal Termination].', 1)
  80.       ELSE IF (STATUS .EQ. -1002) THEN
  81.         CALL ZMESS('[ISTCN - Warnings Notified].', 1)
  82.       ELSE
  83.         CALL ZMESS('[ISTCN - Errors Notified].', 1)
  84.       ENDIF
  85.       CALL ZQUIT(STATUS)
  86.  
  87.       END
  88. C-----------------------------------------------------------
  89. C
  90. C  PROMPT THE USER FOR NAMES THAT HAVE NOT BEEN SUPPLIED.......
  91. C
  92. C  1 = COMMAND FILE
  93. C  2 = INPUT SOURCE
  94. C  3 = INPUT TOKEN STREAM
  95. C  4 = INPUT COMMENT STREAM
  96. C  5 = OUTPUT SOURCE
  97. C  6 = POLISH OPTION FILE
  98. C  7 = OUTPUT TOKEN STREAM
  99. C  8 = OUTPUT COMMENT STREAM
  100. C
  101.       SUBROUTINE NAMES (NUMB,PATH)
  102.  
  103.       INTEGER NUMB,PATH(*)
  104.  
  105.       INTEGER ZGTCMD
  106.       INTEGER JUNK,PROMPT(22,8)
  107.  
  108.       DATA (PROMPT(I,1),I=1,15)/67,111,109,109,97,110,
  109.      +100,32,102,105,108,101,58,32,129/
  110.  
  111.       DATA (PROMPT(I,2),I=1,13)/73,110,112,117,116,32,
  112.      +102,105,108,101,58,32,129/
  113.      +(PROMPT(I,3),I=1,19)/73,110,112,117,116,32,
  114.      +116,111,107,101,110,32,102,105,108,101,58,32,129/
  115.      +(PROMPT(I,4),I=1,21)/73,110,112,117,116,32,99,
  116.      +111,109,109,101,110,116,32,102,105,108,101,58,32,129/
  117.  
  118.       DATA (PROMPT(I,5),I=1,14)/79,117,116,112,117,116,32,
  119.      +102,105,108,101,58,32,129/
  120.      +(PROMPT(I,6),I=1,14)/79,112,116,105,111,110,
  121.      +32,102,105,108,101,58,32,129/
  122.      +(PROMPT(I,7),I=1,20)/79,117,116,112,117,116,32,
  123.      +116,111,107,101,110,32,102,105,108,101,58,32,129/
  124.      +(PROMPT(I,8),I=1,22)/79,117,116,112,117,116,32,
  125.      +99,111,109,109,101,110,116,32,102,105,
  126.      +108,101,58,32,129/
  127.  
  128.       CALL ZPRMPT(PROMPT(1,NUMB))
  129.       JUNK=ZGTCMD(PATH,0)
  130.  
  131.       RETURN
  132.       END
  133. C-----------------------------------------------------------
  134. C
  135. C  READ THE COMMAND FILE, THIS MAY BE INTERACTIVE SO HAVE A PROMPT
  136. C  READY. EACH LINE MAY BE EITHER A COMMENT OR A CHANGE REQUEST, THE
  137. C  FIRST IS EASY, THE SECOND LESS SO....
  138. C
  139.       INTEGER FUNCTION READCF(FD, INSRC, OUTSRC)
  140.  
  141.       INTEGER FD, STATUS, I, J
  142.       INTEGER BUFFER(134), PROMPT(10), TMPST1(134), TMPST2(134)
  143.       INTEGER ZGTCMD, ZLOWER, ZSPLIT, ZCOMPP, ZREPLS
  144.       LOGICAL INSRC, OUTSRC
  145.       INTEGER PATSTR(256, 2, 256), REPSTR(256, 256)
  146.       INTEGER LIMIT
  147.       LOGICAL WHICH(5, 256)
  148.       COMMON /PATS/ PATSTR, REPSTR, LIMIT, WHICH
  149.  
  150.       SAVE /PATS/
  151.  
  152.       DATA PROMPT/67,111,109,109,97,110,100,58,32,129/
  153.  
  154.       READCF = -1
  155.       LIMIT  = 0
  156.       INSRC = .FALSE.
  157.       OUTSRC = .FALSE.
  158.  
  159.    10 CONTINUE
  160.         IF(FD .EQ. 0) CALL ZPRMPT(PROMPT)
  161.         STATUS = ZGTCMD(BUFFER, FD)
  162.         IF(STATUS .EQ. -100) THEN
  163.           IF(LIMIT .GT. 0) READCF = -2
  164.  
  165.         ELSE IF(STATUS .NE. -1) THEN
  166.           IF(BUFFER(1) .EQ. 60) THEN
  167.             IF(ZLOWER(BUFFER(2)) .NE. 115) THEN
  168.               INSRC = .FALSE.
  169.             ELSE
  170.               INSRC = .TRUE.
  171.             ENDIF
  172.             GO TO 10
  173.           ELSE IF(BUFFER(1) .EQ. 62) THEN
  174.             IF(ZLOWER(BUFFER(2)) .NE. 115) THEN
  175.               OUTSRC = .FALSE.
  176.             ELSE
  177.               OUTSRC = .TRUE.
  178.             ENDIF
  179.             GO TO 10
  180.  
  181.           ELSE IF(BUFFER(1) .NE. 35 .AND. STATUS .GT. 7) THEN
  182.             LIMIT = LIMIT + 1
  183.             IF(LIMIT .GT. 256) CALL ERROR('[ISTCN: Too many changes].')
  184. C
  185. C  CHECK TO SEE IF THE CHANGE IS TO BE APPLIED TO TNAME TOKENS
  186. C
  187.             I = 1
  188.             CALL SKIPBL(BUFFER, I)
  189.             IF(ZLOWER(BUFFER(I)) .EQ. 116) THEN
  190.               WHICH(1, LIMIT) = .TRUE.
  191.             ELSE
  192.               WHICH(1, LIMIT) = .FALSE.
  193.             ENDIF
  194. C
  195. C  CHECK TO SEE IF THE CHANGE IS TO BE APPLIED TO TCMMNT TOKENS
  196. C
  197.             I = I + 1
  198.             CALL SKIPBL(BUFFER, I)
  199.             IF(ZLOWER(BUFFER(I)) .EQ. 116) THEN
  200.               WHICH(2, LIMIT) = .TRUE.
  201.             ELSE
  202.               WHICH(2, LIMIT) = .FALSE.
  203.             ENDIF
  204. C
  205. C  CHECK TO SEE IF THE CHANGE IS TO BE APPLIED TO TCCNST TOKENS
  206. C
  207.             I = I + 1
  208.             CALL SKIPBL(BUFFER, I)
  209.             IF(ZLOWER(BUFFER(I)) .EQ. 116) THEN
  210.               WHICH(3, LIMIT) = .TRUE.
  211.             ELSE
  212.               WHICH(3, LIMIT) = .FALSE.
  213.             ENDIF
  214. C
  215. C  CHECK TO SEE IF THE CHANGE IS TO BE APPLIED TO THCNST TOKENS
  216. C
  217.             I = I + 1
  218.             CALL SKIPBL(BUFFER, I)
  219.             IF(ZLOWER(BUFFER(I)) .EQ. 116) THEN
  220.               WHICH(4, LIMIT) = .TRUE.
  221.             ELSE
  222.               WHICH(4, LIMIT) = .FALSE.
  223.             ENDIF
  224. C
  225. C  CHECK TO SEE IF CASE FOLDING IS REQUIRED
  226. C
  227.             I = I + 1
  228.             CALL SKIPBL(BUFFER, I)
  229.             IF(ZLOWER(BUFFER(I)) .EQ. 116) THEN
  230.               WHICH(5, LIMIT) = .TRUE.
  231.             ELSE
  232.               WHICH(5, LIMIT) = .FALSE.
  233.             ENDIF
  234. C
  235. C  SEPARATE OUT THE REGULAR EXPRESSION AND REPLACEMENT PATTERN.....
  236. C
  237.             I = I + 1
  238.             CALL SKIPBL(BUFFER, I)
  239.             IF(ZSPLIT(BUFFER(I), TMPST1, TMPST2) .NE. -1) THEN
  240.               IF(ZCOMPP(TMPST1,WHICH(5,LIMIT),PATSTR(1,1,LIMIT))
  241.      +           .EQ.-1) CALL ERROR('[ISTCN: Pattern Error 2].')
  242.               IF(ZREPLS(TMPST2, REPSTR(1, LIMIT)) .EQ. -1)
  243.      +           CALL ERROR('[ISTCN: Pattern Error 3].')
  244.               TMPST2(1) = 37
  245.               CALL SCOPY(TMPST1, 1, TMPST2, 2)
  246.               J = LENGTH(TMPST2)
  247.               TMPST2(J+1) = 36
  248.               TMPST2(J+2) = 129
  249.               IF(ZCOMPP(TMPST2,WHICH(5,LIMIT),PATSTR(1,2,LIMIT))
  250.      +           .EQ.-1) CALL ERROR('[ISTCN: Replacement Error].')
  251.               GO TO 10
  252.             ELSE
  253.               CALL ERROR('[ISTCN: Pattern Error 1].')
  254.             ENDIF
  255.           ELSE
  256.             GO TO 10
  257.           ENDIF
  258.         ELSE
  259.           CALL ERROR('[ISTCN: Command Input Error].')
  260.  
  261.         ENDIF
  262.  
  263.       END
  264. C-----------------------------------------------------------
  265. C
  266. C  TOKEN STREAM EDITOR, COPIES THE INPUT TOKEN STREAM TO THE
  267. C  OUTPUT TOKEN STREAM APPLYING ALL THE REQUESTED CHANGES EN ROUTE.
  268. C
  269.       SUBROUTINE TRNSFR(INSRC, OUTSRC, SRCIN,  TKNIN,  CMTIN,
  270.      +                         SRCOUT, TKNOUT, CMTOUT, STATE)
  271.  
  272.       LOGICAL INSRC, OUTSRC, TEST1, TEST2
  273.       INTEGER SRCIN,  TKNIN,  CMTIN, SRCOUT, TKNOUT, CMTOUT
  274.       INTEGER STATE, CHOICE
  275.       INTEGER TKNTYP, TKNLEN, STATUS, I, J, DESCI, DESCO
  276.       INTEGER TKNSTR(1322), BUFFER(1322), TEMP(134)
  277.       INTEGER LENGTH, ZSTRRP, ZTKGTI, ZTKPTI
  278.  
  279.       INTEGER PATSTR(256, 2, 256), REPSTR(256, 256)
  280.       INTEGER LIMIT
  281.       LOGICAL WHICH(5, 256)
  282.       COMMON /PATS/ PATSTR, REPSTR, LIMIT, WHICH
  283.  
  284. C---------------------------------------------------------
  285. C    TOOLPACK/1    Release: 2.4
  286. C---------------------------------------------------------
  287. C
  288. C  TKLAST = LAST TOKEN NUMBER
  289. C
  290.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  291.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  292.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  293.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  294.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  295.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  296.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  297.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  298.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  299.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  300.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  301.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  302.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  303.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  304.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  305.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  306.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  307.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  308.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  309.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  310.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  311.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  312.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  313.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  314.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  315.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  316.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  317.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  318.  
  319.  
  320.       SAVE /PATS/
  321.  
  322.       STATE = -2
  323.       IF(INSRC) THEN
  324.         DESCI = ZTKGTI(0, SRCIN,  -1)
  325.       ELSE
  326.         DESCI = ZTKGTI(1, TKNIN, CMTIN)
  327.       ENDIF
  328.       IF(OUTSRC) THEN
  329.         I=ZTKGTI(2,J,DESCO)
  330.         DESCO = ZTKPTI(0, SRCOUT, I)
  331.       ELSE
  332.         DESCO = ZTKPTI(1, TKNOUT, CMTOUT)
  333.       ENDIF
  334.       IF(DESCI .LE. 0 .OR. DESCO .LE. 0) RETURN
  335.  
  336.    10 CONTINUE
  337.         IF(INSRC) THEN
  338.           CALL ZSCAN(TKNTYP,TKNLEN,TKNSTR,DESCI,STATUS)
  339.         ELSE
  340.           CALL ZGETTK(TKNTYP,TKNLEN,TKNSTR,DESCI,STATUS)
  341.         ENDIF
  342.         IF(TKNTYP .EQ. TNAME .OR. TKNTYP .EQ. TCMMNT .OR.
  343.      +     TKNTYP .EQ. TCCNST.OR. TKNTYP .EQ. THCNST) THEN
  344.           DO 20 I = 1, LIMIT
  345.             IF((TKNTYP .EQ. TNAME  .AND. WHICH(1, I)) .OR.
  346.      +         (TKNTYP .EQ. TCMMNT .AND. WHICH(2, I)) .OR.
  347.      +         (TKNTYP .EQ. TCCNST .AND. WHICH(3, I)) .OR.
  348.      +         (TKNTYP .EQ. THCNST .AND. WHICH(4, I))) THEN
  349.               IF(TKNTYP .NE. TNAME) THEN
  350.                 CHOICE = 1
  351.               ELSE
  352.                 CHOICE = 2
  353.               ENDIF
  354.               STATUS = ZSTRRP(TKNSTR, BUFFER, .TRUE.,
  355.      +                 PATSTR(1, CHOICE, I), REPSTR(1, I))
  356.               IF(STATUS .EQ. -2) CALL SCOPY(BUFFER, 1, TKNSTR, 1)
  357.             ENDIF
  358.    20     CONTINUE
  359.           TKNLEN = LENGTH(TKNSTR)
  360.         ENDIF
  361.         IF(TKNTYP .EQ. TNAME) THEN
  362.           CALL ZLEGAL(TKNSTR, TEST1, TEST2)
  363.           IF(.NOT. TEST1) THEN
  364.             IF(TEST2)THEN
  365.               CALL ZCHOUT
  366.      +              ('CN: Warning, name is non-standard: .', 1)
  367.               CALL ZPTMES(TKNSTR, 1)
  368.               IF(STATE .EQ. -2) STATE = -1002
  369.             ELSE
  370.               CALL ZCHOUT
  371.      +              ('CN: Error, name is illegal: .', 1)
  372.               CALL ZPTMES(TKNSTR, 1)
  373.               STATE = -1
  374.             ENDIF
  375.           ENDIF
  376.         ENDIF
  377.         IF(OUTSRC) THEN
  378.           CALL ZUSCAN(TKNTYP, TKNLEN, TKNSTR, DESCO)
  379.         ELSE
  380.           CALL ZPUTTK(TKNTYP, TKNLEN, TKNSTR, DESCO)
  381.         ENDIF
  382.       IF(TKNTYP .NE. TZEOF) GO TO 10
  383.  
  384.       END
  385.