SUBROUTINE PARSE  
    
      INTEGER  INPTR
      INTEGER  OUTPTR   
      INTEGER  INMAX
      INTEGER  MAXTAB   
      INTEGER  MAXLIN   
      INTEGER  IFMAX
      INTEGER  MAXLEV   
      INTEGER  LINENO   
      INTEGER  PAGE 
      INTEGER  CLINE
      INTEGER  TLIMIT   
      INTEGER  LN   
      INTEGER  I, J, K  
      INTEGER  II, JJ, KK   
      INTEGER  LEXVAL   
      INTEGER  SLEN 
      INTEGER  LEVEL
      INTEGER  LEN  
      INTEGER  INCHAN   
      INTEGER  OUTCHN   
      INTEGER  LPTCHN   
      INTEGER  TTICHN   
      INTEGER  TTOCHN   
      INTEGER  PROCCN   
      INTEGER  COMCHN   
      INTEGER  TABS (10)
      LOGICAL  SKIPFL   
      LOGICAL  POFF 
      LOGICAL  FIRST
      INTEGER  ISP  
      INTEGER  ICSTK (20)   
      INTEGER  IFSP 
      INTEGER  IFST (20)
      INTEGER  LPSP 
      INTEGER  LPST (100)   
      LOGICAL  TSEEN
      INTEGER  CHAR 
      INTEGER  CTEMP
      LOGICAL  NEWFIL   
      INTEGER  COMPMS (11)  
      INTEGER  LSAVE (5)
      LOGICAL  PSAVE (5)
      INTEGER  FFILE
      INTEGER  EOF  
      INTEGER  LETTER   
      INTEGER  DIGIT
      INTEGER  TAB  
      INTEGER  EOL  
      INTEGER  BLANK
      INTEGER  QUOTE
      INTEGER  GIZZY
      INTEGER  LPAREN   
      INTEGER  RPAREN   
      INTEGER  AST  
      INTEGER  COMMA
      INTEGER  PERIOD   
      INTEGER  SLASH
      INTEGER  CHAR0
      INTEGER  CHAR1
      INTEGER  CHAR9
      INTEGER  SEMI 
      INTEGER  EQUAL
      INTEGER  CHARA
      INTEGER  CHARZ
      INTEGER  BBLANK   
      INTEGER  UPAROW   
      INTEGER  DOOP 
      INTEGER  WHILE
      INTEGER  ENDOP
      INTEGER  FOR  
      INTEGER  DOLOOP   
      INTEGER  BREAK
      INTEGER  NEXT 
      INTEGER  IFOP 
      INTEGER  ELSE 
      INTEGER  ENDIF
      INTEGER  DEFINE   
      INTEGER  HEAD 
      INTEGER  EJECT
      INTEGER  INCLUD   
      INTEGER  OUTFIL   
      INTEGER  IBUF (42)
      INTEGER  PBUF (58)
      INTEGER  HBUF (42)
      INTEGER  OUTBUF (42)  
      INTEGER  BUF (58) 
      INTEGER  NAME (22)
      LOGICAL  QSEEN
      COMMON    /STRN/  INPTR   
      COMMON    /STRN/  OUTPTR  
      COMMON    /STRN/  INMAX   
      COMMON    /STRN/  MAXTAB  
      COMMON    /STRN/  MAXLIN  
      COMMON    /STRN/  IFMAX   
      COMMON    /STRN/  MAXLEV  
      COMMON    /STRN/  LINENO  
      COMMON    /STRN/  PAGE
      COMMON    /STRN/  CLINE   
      COMMON    /STRN/  TLIMIT  
      COMMON    /STRN/  LN  
      COMMON    /STRN/  I, J, K 
      COMMON    /STRN/  II, JJ, KK  
      COMMON    /STRN/  LEXVAL  
      COMMON    /STRN/  SLEN
      COMMON    /STRN/  LEVEL   
      COMMON    /STRN/  LEN 
      COMMON    /STRN/  INCHAN  
      COMMON    /STRN/  OUTCHN  
      COMMON    /STRN/  LPTCHN  
      COMMON    /STRN/  TTICHN  
      COMMON    /STRN/  TTOCHN  
      COMMON    /STRN/  PROCCN  
      COMMON    /STRN/  COMCHN  
      COMMON    /STRN/  TABS
      COMMON    /STRN/  SKIPFL  
      COMMON    /STRN/  POFF
      COMMON    /STRN/  FIRST   
      COMMON    /STRN/  ISP 
      COMMON    /STRN/  ICSTK   
      COMMON    /STRN/  IFSP
      COMMON    /STRN/  IFST
      COMMON    /STRN/  LPSP
      COMMON    /STRN/  LPST
      COMMON    /STRN/  TSEEN   
      COMMON    /STRN/  CHAR
      COMMON    /STRN/  CTEMP   
      COMMON    /STRN/  NEWFIL  
      COMMON    /STRN/  COMPMS  
      COMMON    /STRN/  LSAVE   
      COMMON    /STRN/  PSAVE   
      COMMON    /STRN/  FFILE   
      COMMON    /STRN/  EOF 
      COMMON    /STRN/  LETTER  
      COMMON    /STRN/  DIGIT   
      COMMON    /STRN/  TAB 
      COMMON    /STRN/  EOL 
      COMMON    /STRN/  BLANK   
      COMMON    /STRN/  QUOTE   
      COMMON    /STRN/  GIZZY   
      COMMON    /STRN/  LPAREN  
      COMMON    /STRN/  RPAREN  
      COMMON    /STRN/  AST 
      COMMON    /STRN/  COMMA   
      COMMON    /STRN/  PERIOD  
      COMMON    /STRN/  SLASH   
      COMMON    /STRN/  CHAR0   
      COMMON    /STRN/  CHAR1   
      COMMON    /STRN/  CHAR9   
      COMMON    /STRN/  SEMI
      COMMON    /STRN/  EQUAL   
      COMMON    /STRN/  CHARA   
      COMMON    /STRN/  CHARZ   
      COMMON    /STRN/  BBLANK  
      COMMON    /STRN/  UPAROW  
      COMMON    /STRN/  DOOP
      COMMON    /STRN/  WHILE   
      COMMON    /STRN/  ENDOP   
      COMMON    /STRN/  FOR 
      COMMON    /STRN/  DOLOOP  
      COMMON    /STRN/  BREAK   
      COMMON    /STRN/  NEXT
      COMMON    /STRN/  IFOP
      COMMON    /STRN/  ELSE
      COMMON    /STRN/  ENDIF   
      COMMON    /STRN/  DEFINE  
      COMMON    /STRN/  HEAD
      COMMON    /STRN/  EJECT   
      COMMON    /STRN/  INCLUD  
      COMMON    /STRN/  OUTFIL  
      COMMON    /STRN/  IBUF
      COMMON    /STRN/  PBUF
      COMMON    /STRN/  HBUF
      COMMON    /STRN/  OUTBUF  
      COMMON    /STRN/  BUF 
      COMMON    /STRN/  NAME
      COMMON     /STRN/  QSEEN  
    
      INTEGER SRCEFS(10,4),CMDF(10),LISTF(10),OUTF(10)  
      COMMON /FNAMES/SRCEFS,CMDF,LISTF,OUTF 
      INTEGER LEX, LEXTMP, LABGEN, INLEN
      INTEGER CHARC, CHARD, CHARP, CHARX, CHARN 
      INTEGER CHARY,CHARL,CHARI 
      INTEGER GCHAR, GETC   
      DATA  CHARC /67/, CHARD /68/, CHARP /80/, CHARX /88/  
      DATA  CHARN /78/,CHARI/73/,CHARY/89/,CHARL/76/
      IFSP = 1  
      LPSP = 1  
   10 CONTINUE  
13031 CONTINUE  
    
      LEXVAL = LEX (CHAR)   
      IF (.NOT.(CHAR .NE. EOF))GO TO 13032  
    
      IF (.NOT. (CHAR .EQ. EOL))GO TO 13033 
    
      GO TO 13031   
    
13033 CONTINUE  
    
      IF (.NOT. (LEXVAL .EQ. LETTER))GO TO 13035
    
      IF (.NOT. (INPTR .EQ. 2))GO TO 13037  
    
      IF (.NOT. (CHAR .EQ. CHARX .OR. CHAR .EQ. CHARD))GO TO 13039  
    
      CALL PUTC(CHARC)  
      GO TO 13031   
    
13039 CONTINUE  
    
      IF (.NOT. (CHAR .EQ. CHARN))GO TO 13041   
    
      CALL IGNORE   
      GO TO 13031   
    
13041 CONTINUE  
    
      IF (.NOT. (CHAR .EQ. CHARP))GO TO 13043   
    
      CALL IGNORE   
      GO TO 13031   
    
13043 CONTINUE  
    
      IF (.NOT. (CHAR.EQ.CHARI))GO TO 13045 
    
      GO TO 13031   
    
13045 CONTINUE  
    
13037 CONTINUE  
    
      CALL PUTBAK (CHAR)
      IF (.NOT. (CHAR .NE. CHARC .OR. INPTR .NE. 2))GO TO 13047 
    
      CALL LSTART   
      CALL ENDLIN   
      GO TO 13048   
13047 CONTINUE  
    
      CALL IGNORE   
13048 CONTINUE  
    
      GO TO 13031   
    
13035 CONTINUE  
    
      IF (.NOT. (LEXVAL .EQ. DIGIT))GO TO 13049 
    
      CALL COPYLN   
      GO TO 13031   
    
13049 CONTINUE  
    
      LEXTMP = LEXVAL - 99  
      IF (.NOT. (LEXTMP .GT. 0 .AND. LEXTMP .LT. 16))GO TO 13051
    
      GOTO (100, 100, 200, 100, 100, 300, 300, 400, 500, 600, 700, 800, 
     1900, 1000, 1100) LEXTMP   
      GO TO 13052   
13051 CONTINUE  
    
  700 CALL IGNORE   
13052 CONTINUE  
    
      GO TO 13031   
13032 CONTINUE  
    
      CALL CLOSF(INCHAN,SRCEFS(1,LEVEL))
      IF (LEVEL .NE. 1) GOTO 1050   
      IF (.NOT. (IFSP .NE. 1))GO TO 13053   
    
      CALL REMARK ('IF STACK NOT CLEARED.') 
13053 CONTINUE  
    
      IF (.NOT. (LPSP .NE. 1))GO TO 13055   
    
      CALL REMARK ('LOOP STACK NOT CLEARED.')   
13055 CONTINUE  
    
      IF (.NOT. (IAND (PAGE, 1) .NE. 0))GO TO 13057 
    
      CALL SET (BBLANK, IBUF, 40)   
      CLINE = MAXLIN + 1
      CALL PRINT
13057 CONTINUE  
    
      RETURN
   30 CALL ENDLIN   
      GOTO 10   
    
  100 IF (.NOT. (LEXVAL .EQ. WHILE))GO TO 13059 
    
      IF (.NOT. (LPST (LPSP) .EQ. DOOP))GO TO 13061 
    
      CONTINUE  
13063 CONTINUE  
    
      CALL LSTART   
      LPST (LPSP) = WHILE   
      LPST (LPSP + 2) = 1   
      CALL PSTR ('IF (.NOT./')  
      CALL CPAREN   
      CALL PSTR (')/')  
      LN = LPST (LPSP + 1) + 1  
      CALL GOLN (LN)
      GOTO 30   
      GO TO 13062   
13061 CONTINUE  
    
      CALL REMARK ('WHILE WITHOUT DO.') 
      CALL LSTART   
      LPSP = LPSP + 3   
      CALL PSTR ('CONTINUE;/')  
      LN = LABGEN (2)   
      CALL LNCONT (LN)  
      LPST (LPSP + 1) = LN  
      GO TO 13063   
    
13062 CONTINUE  
    
13059 CONTINUE  
    
      LPSP = LPSP + 3   
      IF (.NOT. (LEXVAL .EQ. FOR))GO TO 13065   
    
      KK = 1
      CALL COPYTO (NAME, KK, LPAREN)
      CALL SKIPBL   
      CALL LSTART   
      CALL COPYTO (OUTBUF, OUTPTR, SEMI)
      CALL PUTC (EOL)   
      LN = LABGEN (3) + 2   
      CALL PLN (LN) 
      CALL PSTR ('IF (.NOT.(/') 
      CALL SKIPBL   
      CALL COPYTO (OUTBUF, OUTPTR, SEMI)
      CALL PSTR ('))/') 
      LN = LN - 1   
      CALL GOLN (LN)
      KK = LPSP*4 - 3   
      CALL SKIPBL   
      CALL COPYTO (LPST, KK, RPAREN)
      LPSP = LPSP + (SLEN + 3)/4
      LPST (LPSP) = SLEN
      LPSP = LPSP + 1   
      LN = LN - 1   
      GO TO 13066   
13065 CONTINUE  
    
      IF (.NOT. (LEXVAL .EQ. DOLOOP))GO TO 13067
    
      LN = LABGEN (2)   
      CALL LSTART   
      CALL PSTR ('DO /')
      CALL ESP (LN, OUTBUF, OUTPTR, OUTPTR + 5) 
      OUTPTR = OUTPTR + 6   
      GO TO 13068   
13067 CONTINUE  
    
      IF (.NOT. (LEXVAL .EQ. DOOP))GO TO 13069  
    
      CALL LSTART   
      LN = LABGEN (2)   
      CALL PSTR ('CONTINUE;/')  
      CALL LNCONT (LN)  
13069 CONTINUE  
    
13068 CONTINUE  
    
13066 CONTINUE  
    
      LPST (LPSP) = LEXVAL  
      LPST (LPSP + 1) = LN  
      LPST (LPSP + 2) = 0   
      GOTO 30   
    
  200 IF (.NOT. (LPSP .EQ. 1))GO TO 13071   
    
      CALL REMARK ('MISPLACED END OF LOOP.')
      GOTO 30   
13071 CONTINUE  
    
      IF (.NOT. (LPST (LPSP) .EQ. DOOP .OR. LPST (LPSP) .EQ. WHILE))GO T
     1O 13073   
    
      LN = LPST (LPSP + 1)  
      CALL LSTART   
      CALL GOLN (LN)
      IF (.NOT. (LPST (LPSP + 2) .NE. 0))GO TO 13075
    
      LN = LN + 1   
      CALL LNCONT (LN)  
13075 CONTINUE  
    
      LPSP = LPSP - 3   
      GOTO 30   
13073 CONTINUE  
    
      IF (.NOT. (LPST (LPSP) .EQ. FOR))GO TO 13077  
    
      LN = LPST (LPSP + 1)  
      IF (.NOT. (LPST (LPSP + 2) .EQ. 1))GO TO 13079
    
      CALL PLN (LN) 
13079 CONTINUE  
    
      CALL LSTART   
      SLEN = LPST (LPSP - 1)
      LPSP = LPSP - (SLEN + 3)/4 - 1
      KK = LPSP*4 - 3   
      DO  13081 JJ = 1, SLEN
      II = GCHAR (LPST, KK) 
      CALL PUTC (II)
      KK = KK + 1   
13081 CONTINUE  
    
      CALL PUTC (EOL)   
      CALL LSTART   
      LN = LN + 2   
      CALL GOLN (LN)
      LN = LN - 1   
      CALL LNCONT (LN)  
      GO TO 13078   
13077 CONTINUE  
    
      LN = LPST (LPSP + 1)  
      CALL LNCONT (LN)  
      IF (.NOT. (LPST (LPSP + 2) .EQ. 1))GO TO 13083
    
      LN = LN + 1   
      CALL LNCONT (LN)  
13083 CONTINUE  
    
13078 CONTINUE  
    
      LPSP = LPSP - 3   
      IF (LEXVAL .NE. OUTFIL) GOTO 30   
      GOTO 1100 
    
  300 IF (.NOT. (LPSP .EQ. 1))GO TO 13085   
    
      CALL REMARK ('MISPLACED BREAK OR NEXT.')  
      GOTO 30   
13085 CONTINUE  
    
      KK = LPSP + 1 
      LN = LPST (KK)
      IF (.NOT. (LEXVAL .EQ. BREAK))GO TO 13087 
    
      LN = LN + 1   
      IF (.NOT. (LPST (LPSP) .NE. FOR))GO TO 13089  
    
      KK = LPSP + 2 
      LPST (KK) = 1 
13089 CONTINUE  
    
      GO TO 13088   
13087 CONTINUE  
    
      IF (.NOT. (LPST (LPSP) .EQ. FOR))GO TO 13091  
    
      KK = LPSP + 2 
      LPST (KK) = 1 
13091 CONTINUE  
    
13088 CONTINUE  
    
      CALL LSTART   
      CALL GOLN (LN)
      GOTO 30   
    
  400 IF (.NOT. (IFSP .GE. IFMAX))GO TO 13093   
    
      CALL REMARK ('IF STACK OVERFLOW.')
      CALL IGNORE   
      GOTO 10   
13093 CONTINUE  
    
      IFSP = IFSP + 1   
      IFST (IFSP) = IFOP
      IFSP = IFSP + 1   
      LN = LABGEN (2)   
      IFST (IFSP) = LN  
      CALL LSTART   
      CALL PSTR ('IF (.NOT. /') 
      CALL CPAREN   
      CALL PSTR (')/')  
      CALL GOLN (LN)
      GOTO 30   
    
  500 IF (.NOT. (IFSP .EQ. 1))GO TO 13095   
    
  510 CALL REMARK ('ELSE WITHOUT IF.')  
      CALL IGNORE   
      GOTO 10   
13095 CONTINUE  
    
      JJ = IFSP 
      CONTINUE  
13097 CONTINUE  
    
      IF (.NOT.(JJ .GT. 1))GO TO 13098  
    
      KK = JJ - 1   
      IF (.NOT. (IFST (KK) .EQ. IFOP))GO TO 13099   
    
      IFST (KK) = ELSE  
      LN = IFST (JJ) + 1
      CALL LSTART   
      CALL GOLN (LN)
      LN = LN - 1   
      CALL LNCONT (LN)  
      GO TO 13100   
13099 CONTINUE  
    
      JJ = JJ - 2   
      GO TO 13097   
13098 CONTINUE  
    
      GOTO 510  
13100 CONTINUE  
    
      GOTO 30   
    
  600 IF (.NOT. (IFSP .EQ. 1))GO TO 13101   
    
      CALL REMARK ('ENDIF WITHOUT IF.') 
      CALL IGNORE   
      GOTO 10   
13101 CONTINUE  
    
      KK = IFSP - 1 
      IF (.NOT. (IFST (KK) .EQ. IFOP))GO TO 13103   
    
      LN = IFST (IFSP)  
      GO TO 13104   
13103 CONTINUE  
    
      LN = IFST (IFSP) + 1  
13104 CONTINUE  
    
      CALL LNCONT (LN)  
      IFSP = IFSP - 2   
      GOTO 30   
    
  800 CALL SKIPBL   
      JJ = 1
      CALL COPYTO (HBUF, JJ, EOL)   
      DO  13105 II = JJ, 80 
      CALL PCHAR (HBUF, II, BLANK)  
13105 CONTINUE  
    
      FIRST = .FALSE.   
      SKIPFL = .TRUE.   
      CALL PUTBAK (EOL) 
      GOTO 30   
    
  900 IF (POFF) GOTO 30 
      SKIPFL = .TRUE.   
      CLINE = 1000  
      GOTO 30   
    
 1000 INCHAN = INCHAN - 1   
      LSAVE (LEVEL) = LINENO
      PSAVE (LEVEL) = POFF  
      LEVEL = LEVEL + 1 
      CALL SKIPBL   
      INLEN = 1 
      CALL SET (0, NAME, 22)
      CALL COPYTO (NAME, INLEN, COMMA)  
      CALL NAMCOM(NAME,INLEN)   
      CALL PCHAR (NAME, INLEN+1, 0) 
      CALL MOVE(NAME,SRCEFS(1,LEVEL),(INLEN+2)/2)   
      CALL PRINT
      CHAR = GETC (CHAR)
      IF (.NOT. (CHAR .EQ. CHARP))GO TO 13107   
    
      SKIPFL = .TRUE.   
      POFF = .FALSE.
      GO TO 13108   
13107 CONTINUE  
    
      POFF = .TRUE. 
13108 CONTINUE  
    
      IF (.NOT. (CHAR .NE. EOL))GO TO 13109 
    
      CALL COPYTO (NAME, INLEN, EOL)
13109 CONTINUE  
    
      CALL PUTBAK (EOL) 
      LINENO = 0
      CALL OPENF(INCHAN,SRCEFS(1,LEVEL),KK) 
      IF (.NOT. (KK .NE. 1))GO TO 13111 
    
      CALL REMARK ('INCLUDE FILE OPEN ERROR.')  
      CALL IGNORE   
      GOTO 1050 
13111 CONTINUE  
    
      GOTO 30   
    
 1100 IF (.NOT. (OUTCHN .EQ. -1))GO TO 13113
    
      OUTCHN = 1
      GO TO 13114   
13113 CONTINUE  
    
      CONTINUE  
13115 CONTINUE  
    
      IF (.NOT.(IFSP .NE. 1))GO TO 13116
    
      CALL REMARK ('MISSING ENDIF.')
      IFSP = IFSP - 2   
      GO TO 13115   
13116 CONTINUE  
    
      CONTINUE  
13117 CONTINUE  
    
      IF (.NOT.(LPSP .NE. 1))GO TO 13118
    
      CALL REMARK ('MISSING LOOP END.') 
      GOTO 200  
      GO TO 13117   
13118 CONTINUE  
    
      CALL CLOSF (OUTCHN, OUTF) 
13114 CONTINUE  
    
      CALL SKIPBL   
      JJ = 1
      CLINE = 1000  
      CALL SET (0, NAME, 22)
      CALL COPYTO (NAME, JJ, EOL)   
      CALL NAMCOM(NAME,SLEN)
      CALL PCHAR (NAME, SLEN + 1, 0)
      CALL MOVE(NAME,OUTF,(SLEN+2)/2)   
      CALL OPENN (OUTCHN, OUTF, KK) 
      IF (.NOT. (KK .NE. 1))GO TO 13119 
    
      CALL REMARK ('FILE PROTECTED OR IN USE.') 
      OUTCHN = -1   
13119 CONTINUE  
    
      IF (.NOT. (PROCCN .NE. -1))GO TO 13121
    
      CALL WRLIN(TTOCHN,NAME,SLEN)  
      CALL SET (BBLANK,BUF,40)  
      CALL EST('FORTE ',BUF,1,6)
      CALL EST(NAME,BUF,7,SLEN+6)   
      KK=6+SLEN 
      CALL PCHAR(BUF,KK+1,COMMA)
      KK=KK+1   
      SLEN=SLEN-2   
      CALL EST(NAME,BUF,KK+1,KK+SLEN)   
      KK=KK+SLEN
      CALL EST('Y,  ',BUF,KK+1,KK+2)
      KK=KK+2   
      CALL EST(NAME,BUF,KK+1,KK+SLEN)   
      KK=KK+SLEN
      CALL PCHAR(BUF,KK+1,CHARL)
      KK=KK+1   
      CALL WRLIN (PROCCN, BUF, KK)  
13121 CONTINUE  
    
      NEWFIL = .TRUE.   
      CALL PUTBAK (EOL) 
      GOTO 30   
    
 1050 CONTINUE  
      LEVEL = LEVEL - 1 
      LINENO = LSAVE (LEVEL)
      POFF = PSAVE (LEVEL)  
      INCHAN = INCHAN + 1   
      SKIPFL = .TRUE.   
      GOTO 10   
      END