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 / istpl / ISTPL.MAC.f next >
Encoding:
Text File  |  1989-03-04  |  3.0 KB  |  106 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.5
  3. C---------------------------------------------------------
  4.         PROGRAM ISTPL
  5.  
  6.         INTEGER POLPTH(81),TKNPTH(81),CMTPTH(81),I,
  7.      +          OPTPTH(81),IODOPT,NOOPTS(2),IODTKN,IODCMT,IODPOL,
  8.      +          NERROR,OPT(134)
  9.         LOGICAL NOTDON
  10.  
  11.         INTEGER TMPFIL
  12.  
  13.         INTEGER GETARG,OPEN,CREATE,EQUAL,ZTKGTI,ZPLERR
  14.         EXTERNAL ZINIT,GETARG,OPEN,CREATE,ERROR,EQUAL,ZTKGTI,ZPLERR
  15.  
  16.         SAVE
  17.  
  18.         DATA NOOPTS/45,129/
  19.  
  20. C Initialise TIE
  21.  
  22.         CALL ZINIT
  23.  
  24. C Read paths from command file
  25.  
  26.         IF (GETARG(1,TKNPTH,81).EQ.-100) CALL NAMES(1,TKNPTH)
  27.         IF (GETARG(2,CMTPTH,81).EQ.-100) CALL NAMES(2,CMTPTH)
  28.         IF (GETARG(3,POLPTH,81).EQ.-100) CALL NAMES(3,POLPTH)
  29.         IF (GETARG(4,OPTPTH,81).EQ.-100) CALL NAMES(4,OPTPTH)
  30.  
  31. C Open required files
  32.  
  33.         IODTKN=OPEN(TKNPTH,0)
  34.         IF (IODTKN.EQ.-1) CALL ERROR('Can''t Open token path')
  35.         IODCMT=OPEN(CMTPTH,0)
  36.         IF (IODCMT.EQ.-1) CALL ERROR('Can''t Open comment path')
  37.         IODPOL=CREATE(POLPTH,1)
  38.         IF (IODPOL.EQ.-1) CALL ERROR('Can''t Open output file')
  39.         IODOPT=OPEN(OPTPTH,0)
  40.         IF (IODOPT.EQ.-1 .AND. OPTPTH(1).NE.129 .AND.
  41.      +      EQUAL(OPTPTH,NOOPTS).NE.-2)
  42.      +      CALL ERROR('Can''t Open option file')
  43.  
  44. C Default parameters are set up in block data POLBLK
  45.  
  46. C Setup user-specified option values
  47.  
  48.         CALL PLOPTF(IODOPT)
  49.         DO 100 I=5,10
  50.  100        IF (GETARG(I,OPT,134).NE.-100) CALL POLOPT(OPT,.FALSE.)
  51.  
  52. C Initialise internal variables
  53.  
  54.         CALL INIPOL(ZTKGTI(1,IODTKN,IODCMT),IODPOL)
  55.  
  56. C Now process the input, one statement at a time
  57.  
  58.  200    CALL POLISH(NOTDON)
  59.         IF (NOTDON) GOTO 200
  60.  
  61. C Finish up
  62.  
  63.         NERROR=ZPLERR()
  64.         IF (NERROR.EQ.0) THEN
  65.             CALL ZMESS('[ISTPL Normal Termination]',1)
  66.             CALL ZQUIT(-2)
  67.         ELSE
  68.             CALL ZCHOUT('[ISTPL Termination, ',1)
  69.             CALL PUTDEC(NERROR,1)
  70.             CALL ZCHOUT(' Error',1)
  71.             IF (NERROR.GT.1) CALL PUTC(115)
  72.             CALL ZMESS(' Found]',1)
  73.             CALL ZQUIT(-1002)
  74.         END IF
  75.  
  76.         END
  77. C ----------------------------------------------------------------------
  78. C
  79. C       N A M E S  -  Input a pathname after prompting
  80. C
  81.  
  82.         SUBROUTINE NAMES(NUMB,PATH)
  83.         INTEGER NUMB,PATH(*)
  84.  
  85.         INTEGER JUNK,PROMPT(22,4)
  86.  
  87.         INTEGER ZGTCMD
  88.         EXTERNAL ZGTCMD,ZPRMPT
  89.  
  90.         DATA (PROMPT(I,1),I=1,21)/73,110,112,117,116,32,
  91.      +        116,111,107,101,110,32,115,116,114,101,
  92.      +        97,109,58,32,129/,
  93.      +       (PROMPT(I,2),I=1,21)/73,110,112,117,116,32,
  94.      +        99,111,109,109,101,110,116,32,102,105,
  95.      +        108,101,58,32,129/,
  96.      +       (PROMPT(I,3),I=1,18)/80,111,108,105,115,104,
  97.      +        101,100,32,111,117,116,112,117,116,58,
  98.      +        32,129/,
  99.      +       (PROMPT(I,4),I=1,14)/79,112,116,105,111,110,
  100.      +        32,102,105,108,101,58,32,129/
  101.  
  102.         CALL ZPRMPT(PROMPT(1,NUMB))
  103.         JUNK=ZGTCMD(PATH,0)
  104.  
  105.         END
  106.