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 / istfp / ISTFP.MAC.f
Encoding:
Text File  |  1989-03-04  |  8.3 KB  |  230 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 3.1
  3. C---------------------------------------------------------
  4. C
  5. C  FAST POLISH
  6. C               CONVERT A TOKEN STREAM/COMMENT STREAM TO SOURCE CODE
  7. C               AS QUICKLY AS POSSIBLE, LEAVE OUT COMMENTS AND PUT NO
  8. C               SPACES BETWEEN TOKENS. PLACE A SPACE AFTER ALL KEYWORDS.
  9. C               TRY NOT TO BREAK TOKENS
  10. C               IF POSSIBLE
  11. C
  12.         PROGRAM ISTFP
  13.  
  14.         INTEGER TKPATH(81),OUTPTH(81),PROMPT(17,3),
  15.      +          BUFFER(1322), CMPATH(81), STRING(1322)
  16.      +
  17.         INTEGER TKNFD, CMTFD, OUTFD, STATUS, TYPE, LENGTH, DESC
  18.  
  19.         INTEGER GETARG, OPEN, CREATE, ZGTCMD, ZTKGTI
  20. C---------------------------------------------------------
  21. C    TOOLPACK/1    Release: 2.4
  22. C---------------------------------------------------------
  23. C
  24. C  TKLAST = LAST TOKEN NUMBER
  25. C
  26.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  27.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  28.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  29.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  30.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  31.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  32.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  33.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  34.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  35.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  36.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  37.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  38.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  39.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  40.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  41.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  42.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  43.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  44.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  45.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  46.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  47.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  48.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  49.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  50.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  51.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  52.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  53.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  54.  
  55.       SAVE
  56.  
  57.       DATA (PROMPT(I,1),I=1,15)/84,111,107,101,110,32,
  58.      +                115,116,114,101,97,109,58,32,129/,
  59.      +     (PROMPT(I,2),I=1,17)/67,111,109,109,101,110,116,32,
  60.      +                115,116,114,101,97,109,58,32,129/,
  61.      +     (PROMPT(I,3),I=1,14)/79,117,116,112,117,116,32,
  62.      +                102,105,108,101,58,32,129/
  63.  
  64.       CALL ZINIT
  65.  
  66.       IF (GETARG(1,TKPATH,81).EQ.-100) THEN
  67.           CALL ZPRMPT(PROMPT(1,1))
  68.           STATUS=ZGTCMD(TKPATH,0)
  69.       END IF
  70.       IF (GETARG(2,CMPATH,81).EQ.-100) THEN
  71.           CALL ZPRMPT(PROMPT(1,2))
  72.           STATUS=ZGTCMD(CMPATH,0)
  73.       END IF
  74.       IF (GETARG(3,OUTPTH,81).EQ.-100) THEN
  75.           CALL ZPRMPT(PROMPT(1,3))
  76.           STATUS=ZGTCMD(OUTPTH,0)
  77.       END IF
  78.  
  79.       TKNFD=OPEN(TKPATH,0)
  80.       IF (TKNFD.EQ.-1) CALL ERROR('Can''t open token stream.')
  81.       CMTFD=OPEN(CMPATH,0)
  82.       IF (CMTFD.EQ.-1) CALL ERROR('Can''t open comment stream.')
  83.       OUTFD=CREATE(OUTPTH,1)
  84.       IF (OUTFD.EQ.-1) CALL ERROR('Can''t create output file.')
  85.       DESC =  ZTKGTI(1, TKNFD, CMTFD)
  86.  
  87.       CALL OUTPUT(0, TYPE, BUFFER, OUTFD)
  88.    20 CONTINUE
  89.         CALL ZGETTK(TYPE, LENGTH, STRING, DESC, STATUS)
  90.         IF(STATUS .EQ. -1) THEN
  91.           CALL ERROR('[ISTFP Token Read Error].')
  92.         ELSE IF(TYPE .EQ. TZEOF) THEN
  93.           CALL OUTPUT(1, TYPE, BUFFER, OUTFD)
  94.           GO TO 30
  95.         ELSE IF(TYPE .EQ. TCMMNT) THEN
  96.           GO TO 20
  97.         ELSE
  98.           CALL ZTOKTX(TYPE, LENGTH, STRING, BUFFER)
  99.           CALL OUTPUT(1, TYPE, BUFFER, OUTFD)
  100.         ENDIF
  101.       GO TO 20
  102.  
  103.    30 CONTINUE
  104.       CALL ZMESS('[ISTFP Normal Termination].',1)
  105.       CALL ZQUIT(-2)
  106.  
  107.       END
  108. C-------------------------------------------
  109. C
  110.       SUBROUTINE OUTPUT(OP, TYPE, BUF, FD)
  111.  
  112.       INTEGER OP, TYPE, FD, I, LENGTH
  113.       INTEGER BUF(*)
  114.       LOGICAL NEW
  115.  
  116.       INTEGER LINE(73), POINT
  117. C---------------------------------------------------------
  118. C    TOOLPACK/1    Release: 2.4
  119. C---------------------------------------------------------
  120. C
  121. C  TKLAST = LAST TOKEN NUMBER
  122. C
  123.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  124.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  125.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  126.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  127.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  128.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  129.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  130.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  131.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  132.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  133.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  134.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  135.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  136.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  137.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  138.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  139.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  140.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  141.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  142.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  143.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  144.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  145.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  146.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  147.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  148.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  149.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  150.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  151.  
  152.       SAVE
  153.  
  154.       IF(OP .EQ. 0) THEN
  155.         NEW   = .TRUE.
  156.         POINT = 1
  157.         RETURN
  158.  
  159.  
  160.       ELSE IF((TYPE .EQ. TZEOS) .OR. (TYPE .EQ. TZEOF)) THEN
  161.         IF(POINT .GT. 1) THEN
  162.           LINE(POINT) = 129
  163.           CALL ZPTMES(LINE, FD)
  164.           POINT = 1
  165.         ENDIF
  166.         NEW = .TRUE.
  167.         RETURN
  168.  
  169.       ELSE
  170.         IF(NEW) THEN
  171.           IF(TYPE .EQ. TDCNST) THEN
  172.             CALL SCOPY(BUF, 1, LINE, 1)
  173.             DO 10 POINT = LENGTH(LINE) + 1, 6
  174.    10       LINE(POINT) = 32
  175.             POINT = 7
  176.             NEW   = .FALSE.
  177.             RETURN
  178.           ELSE
  179.             LINE(1) = 32
  180.             LINE(2) = 32
  181.             LINE(3) = 32
  182.             LINE(4) = 32
  183.             LINE(5) = 32
  184.             LINE(6) = 32
  185.             POINT   = 7
  186.           ENDIF
  187.           NEW = .FALSE.
  188.  
  189.         ELSE
  190.           IF(POINT .EQ. 1) THEN
  191.             LINE(1) = 32
  192.             LINE(2) = 32
  193.             LINE(3) = 32
  194.             LINE(4) = 32
  195.             LINE(5) = 32
  196.             LINE(6) = 43
  197.             POINT   = 7
  198.           ENDIF
  199.  
  200.         ENDIF
  201.         IF((POINT + LENGTH(BUF) .GT. 73) .AND.
  202.      +     (LENGTH(BUF) .LT. 66)) THEN
  203.           LINE(POINT) = 129
  204.           CALL ZPTMES(LINE, FD)
  205.           POINT = 1
  206.         ENDIF
  207.  
  208.         DO 20 I = 1, LENGTH(BUF)
  209.           IF(POINT .EQ. 73) THEN
  210.             POINT = 1
  211.             LINE(73) = 129
  212.             CALL ZPTMES(LINE, FD)
  213.           ENDIF
  214.           IF(POINT .EQ. 1) THEN
  215.             LINE(1) = 32
  216.             LINE(2) = 32
  217.             LINE(3) = 32
  218.             LINE(4) = 32
  219.             LINE(5) = 32
  220.             LINE(6) = 43
  221.             POINT   = 7
  222.           ENDIF
  223.           LINE(POINT) = BUF(I)
  224.           POINT = POINT + 1
  225.    20   CONTINUE
  226.  
  227.       ENDIF
  228.  
  229.       END
  230.