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 / monolith / ISTDT.MAC.f next >
Encoding:
Text File  |  1989-03-04  |  4.5 KB  |  138 lines
  1.         PROGRAM ISTDT
  2.  
  3.         INTEGER TKNPTH(134),OUTPTH(134),PLOPTH(134),
  4.      +          CIPTH(134),CMTPTH(134),OPTSTR(134),I,STATUS,
  5.      +          IODTKN,IODCMT,IODCI,NERROR,NWARN,DESCI,IODOUT,
  6.      +          PLOPT(134),IODPLO,NOOPTS(2)
  7.  
  8.         INTEGER TMPFIL
  9.  
  10.         INTEGER YPARSE,GETARG,OPEN,CREATE,ZYINCI,ZTKPTI,ZTKGTI,EQUAL
  11.         EXTERNAL YPARSE,ZINIT,ZMESS,REMARK,ZQUIT,GETARG,OPEN,CREATE,
  12.      +           ZCHOUT,ZPTINT,PUTCH,REMOVE,SEEK,ZYINCI,ZTKPTI,ZTKGTI,
  13.      +           EQUAL
  14.  
  15.         DATA (CIPTH(I),I=1,11)/108,121,112,99,109,105,46,
  16.      +116,109,112,129/
  17.         DATA  NOOPTS/45,129/
  18.  
  19.         CALL ZINIT
  20.         CALL INISTR
  21.         CALL INISYM
  22.         CALL INITRE
  23.         NERROR=0
  24.         NWARN=0
  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,OUTPTH,81).EQ.-100) CALL NAMES(3,OUTPTH)
  29.         IF (GETARG(4,OPTSTR,81).EQ.-100) CALL NAMES(4,OPTSTR)
  30.         IF (GETARG(5,PLOPTH,81).EQ.-100) CALL NAMES(5,PLOPTH)
  31.  
  32.         IODTKN=OPEN(TKNPTH,0)
  33.         IF (IODTKN.EQ.-1) CALL ERROR('Token Stream Open Failed')
  34.         IODCMT=OPEN(CMTPTH,0)
  35.         IF (IODCMT.EQ.-1) CALL ERROR('Comment Stream Open Failed')
  36.         IODOUT=CREATE(OUTPTH,1)
  37.         IF (IODOUT.EQ.-1) CALL ERROR('Output File Create Failed')
  38.         IF (PLOPTH(1).NE.129 .AND. EQUAL(PLOPTH,NOOPTS).EQ.-3) THEN
  39.           IODPLO=OPEN(PLOPTH,0)
  40.           IF (IODPLO.EQ.-1) CALL ERROR('Can''t Open option file')
  41.         ELSE
  42.           IODPLO=-1
  43.         END IF
  44.  
  45.  
  46.         IODCI=TMPFIL(CIPTH)
  47.         IF (IODCI.EQ.-1) CALL ERROR('Scratch File Creation Failed')
  48.  
  49.         IF (YPARSE(IODTKN,IODCMT,-1,IODCI,NERROR,NWARN).EQ.0) THEN
  50.             IF (NERROR.GT.0) THEN
  51.                 CALL ZCHOUT('[ISTDT Terminated, ',1)
  52.                 CALL ZPTINT(NERROR,1,1)
  53.                 CALL ZCHOUT(' er'//'ror',1)
  54.                 IF (NERROR.GT.1) CALL PUTCH(115,1)
  55.                 CALL ZMESS(']',1)
  56.                 STATUS=-1
  57.             ELSE
  58.                 CALL SEEK(0,IODCI)
  59.                 CALL SEEK(0,IODCMT)
  60.                 IF (ZYINCI(IODCI).EQ.-1) CALL ERROR(
  61.      +              'Internal Error: Couldn''t reread comment index')
  62.                 IF (IODPLO.NE.-1) CALL PLOPTF(IODPLO)
  63.                 DO 100 I=6,10
  64.                     IF (GETARG(I,PLOPT,134).NE.-100)
  65.      +                  CALL POLOPT(PLOPT,.FALSE.)
  66.  100            CONTINUE
  67.                 DESCI=ZTKGTI(2,0,0)
  68.                 CALL DS(OPTSTR,IODCMT,ZTKPTI(0,IODOUT,DESCI),NERROR,
  69.      +                  NWARN)
  70.                 IF (NERROR+NWARN.EQ.0) THEN
  71.                     CALL ZMESS('[ISTDT Normal Termination]',1)
  72.                     STATUS=-2
  73.                 ELSE IF (NERROR.EQ.0) THEN
  74.                     CALL ZCHOUT('[ISTDT Terminated, ',1)
  75.                     CALL ZPTINT(NWARN,1,1)
  76.                     CALL ZCHOUT(' war'//'ning',1)
  77.                     IF (NWARN.GT.1) CALL PUTCH(115,1)
  78.                     CALL ZMESS(']',1)
  79.                     STATUS=-1002
  80.                 ELSE
  81.                     CALL ZCHOUT('[ISTDT Terminated, ',1)
  82.                     CALL ZPTINT(NERROR,1,1)
  83.                     CALL ZCHOUT(' er'//'ror',1)
  84.                     IF (NERROR.GT.1) CALL PUTCH(115,1)
  85.                     CALL ZMESS(']',1)
  86.                     STATUS=-1
  87.                 END IF
  88.             END IF
  89.         ELSE
  90.             CALL REMARK('[ISTDT Fatal Error -- Terminated]')
  91.             STATUS=-1001
  92.         END IF
  93.  
  94.         CALL CLOSE(IODCI)
  95.         CALL REMOVE(CIPTH)
  96.  
  97.         CALL ZQUIT(STATUS)
  98.  
  99.         END
  100. C ----------------------------------------------------------------------
  101. C
  102. C       N A M E S   -   Input the pathname of a required file from stdin
  103. C
  104.  
  105.         SUBROUTINE NAMES(NUMBER,PATH)
  106.         INTEGER NUMBER,PATH(*)
  107.  
  108.         INTEGER JUNK,PROMPT(21,5)
  109.  
  110.         SAVE PROMPT
  111.  
  112.         INTEGER ZGTCMD
  113.         EXTERNAL ZGTCMD,ZPRMPT
  114.  
  115. C "Input token stream: "
  116. C "Input comment file: "
  117. C "Output file: "
  118. C "DS options: "
  119. C "PL option file: "
  120.  
  121.         DATA (PROMPT(I,1),I=1,21)/73,110,112,117,116,32,116,
  122.      +111,107,101,110,32,115,116,114,101,97,109,58,
  123.      +32,129/,
  124.      +       (PROMPT(I,2),I=1,21)/73,110,112,117,116,32,99,
  125.      +111,109,109,101,110,116,32,102,105,108,101,58,
  126.      +32,129/,
  127.      +       (PROMPT(I,3),I=1,14)/79,117,116,112,117,116,32,
  128.      +102,105,108,101,58,32,129/,
  129.      +       (PROMPT(I,4),I=1,13)/68,83,32,111,112,116,105,
  130.      +111,110,115,58,32,129/,
  131.      +       (PROMPT(I,5),I=1,17)/80,76,32,111,112,116,105,
  132.      +111,110,32,102,105,108,101,58,32,129/
  133.  
  134.         CALL ZPRMPT(PROMPT(1,NUMBER))
  135.         JUNK=ZGTCMD(PATH,0)
  136.  
  137.         END
  138.