   DIM TAB$/9/,MLINE$[100],LINE$[100],TEMP$[100],MACROLINE$[100]
   DIM LABEL$[32],CF$[32],AF$[80],REST$[100]
   DIM IN/1/,OUT/2/,FILE$[50],STACK$[256]
   DIM EMITSTATE/1/,CONDBLOCK/0/

   PRINT "STRIPIFS v2.0    Copyright (C) 1980 Software Dynamics"
   PRINT
   PRINT "Strips conditional IFs from assembly source:"
   PRINT "   copies input file to output file, requiring a response"
   PRINT "   from the user at each appropriate IF or ELSEIF statement."
   PRINT "   (See the assembler manual for a complete discussion"
   PRINT "   of conditional assembly)"
   GOSUB HUH
   INPUT "Input file=" FILE$
   OPEN #IN,FILE$
   INPUT "Output file=" FILE$
   CREATE #OUT,FILE$

   REPEAT
      INPUT #IN,MLINE$
      IF EOF(IN) THEN
         PRINT "EOF encountered before END"
         MLINE$=TAB$ CAT "END" CAT TAB$ CAT "<supplied by STRIPIFS>"
      FI
      LINE$=MLINE$
      GOSUB PREPARSE
      MACROLINE$=MLINE$
      GOSUB MACROOUTPUT
      IF CF$="END" THEN EXIT
   END


                      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                      ! MACRO OUTPUT ROUTINE...FOR NOW !
                      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!



!       Do a cheap expression evaluation

DEF ADJUSTCOND(X1)=CONDBLOCK+X1

DEF SAVING

   IF NOT LEN(STACK$) THEN RETURN FALSE
   RETURN IF CONDBLOCK=STACK$[LEN(STACK$)] THEN TRUE ELSE FALSE FI

END

DEF CONDITIONSMET

   PRINT MLINE$
   REPEAT
      INPUT TEMP$
      TEMP$=IF LEN(TEMP$) THEN UPPERCASE$(TEMP$)[1,1] ELSE "K" FI
      IF TEMP$="T" THEN RETURN TRUE
      IF TEMP$="F" THEN RETURN FALSE
      IF TEMP$="C" THEN
         INPUT "New condition: " AF$
         MLINE$=TAB$ CAT CF$ CAT TAB$ CAT AF$ CAT TAB$ CAT REST$
         TEMP$="K"
      FI
      IF TEMP$="K" THEN 
         SAVING=CONDBLOCK
         PRINT #OUT,MLINE$
         RETURN TRUE
      FI
      GOSUB HUH
      PRINT MLINE$
   END

END

SUBROUTINE SETSAVING(X2)

   LEN(STACK$)=LEN(STACK$)+1
   STACK$[LEN(STACK$)]=X2
   EXIT SUBROUTINE

END

SUBROUTINE DONESAVING

   LEN(STACK$)=LEN(STACK$)-1
   EXIT SUBROUTINE

END

MACROOUTPUT:
   ! Jam useful stuff into the output file.  Flush the rest.

   ON EMITSTATE GOTO EMITALL,EMITCOND,EMITELSE,EMITFIN
   PRINT "gasp!!  choke!!  cough cough!!  thud!!!"
   EXIT

EMITALL:
   ! Not in conditional output:
   ! emit everything, up to "IF".
   ! When found, adjust count for matching "FIN".  If the
   ! the conditions were met, emit until "ELSE", "ELSEIF", or "FIN".

   IF CF$="IF" OR CF$="IFUND" THEN
      CONDBLOCK=ADJUSTCOND(1)
      IF CONDITIONSMET THEN EMITSTATE=2
      ELSE
         EMITSTATE=3
         SAVEBLOCK=CONDBLOCK
      FI
   ELSE PRINT #OUT,MLINE$
   RETURN

EMITCOND:
   ! In conditional output:
   ! emit everything, up to "IF", "ELSE", "ELSEIF", or "FIN".
   ! When found, process an "IF" with EMITALL, a "FIN" with EMITFIN.
   ! An "ELSE" or "ELSEIF" causes further output to be flushed until
   ! a "FIN" is found.

   IF (CF$="ELSE" OR CF$="ELSEIF") AND NOT SAVING THEN
      EMITSTATE=4
      SAVEBLOCK=CONDBLOCK
      RETURN
   FI
   IF CF$="IF" OR CF$="IFUND" THEN
      IF CONDBLOCK>=254 THEN
         PRINT "Nesting error!!"
         PRINT #OUT,"** Nesting error **"
      ELSE
         CONDBLOCK=ADJUSTCOND(1)
         IF NOT(CONDITIONSMET) THEN
            EMITSTATE=3
            SAVEBLOCK=CONDBLOCK
         FI
         RETURN
      FI
   FI
   IF CF$="FIN" THEN
      IF CONDBLOCK THEN
         IF SAVING THEN
            CALL DONESAVING
            PRINT #OUT,MLINE$
         FI
         CONDBLOCK=ADJUSTCOND(-1)
      ELSE
         PRINT "Too many FIN's!!"
         PRINT #OUT,"** Too many FIN's **"
      FI
      RETURN
   FI
   PRINT #OUT,MLINE$
   RETURN

EMITELSE:
   ! Flush output until an "ELSE", "ELSEIF", or "FIN"
   ! is found.

   IF CF$="IF" OR CF$="IFUND" THEN
      IF CONDBLOCK>=254 THEN
         PRINT "Nesting error!!"
         PRINT #OUT,"** Nesting error **"
      ELSE CONDBLOCK=ADJUSTCOND(1)
   RETURN
   FI
   IF CF$="FIN" THEN
      IF CONDBLOCK THEN
         CONDBLOCK=ADJUSTCOND(-1)
         IF CONDBLOCK < SAVEBLOCK THEN
            IF CONDBLOCK THEN EMITSTATE=2
            ELSE EMITSTATE=1
         ELSE RETURN
      ELSE
         PRINT "Too many FIN's!!"
         PRINT #OUT,"** Too many FIN's **"
         RETURN
      FI
   FI
   IF CONDBLOCK <= SAVEBLOCK THEN
      IF CF$="ELSEIF" THEN
         IF CONDITIONSMET THEN EMITSTATE=2
         RETURN
      FI
      IF CF$="ELSE" THEN EMITSTATE=2 FI
   FI
   RETURN

EMITFIN:
   ! Flush output until a "FIN" is found.  Continue flushing until
   ! "FIN"s matching all flushed "IF"s have been flushed.  If, at
   ! this time, not all "FIN"s have been matched, return to the
   ! EMITCOND state.  If all "FIN"s have been matched, return to the
   ! EMITALL state.  

   IF CF$="IF" OR CF$="IFUND" THEN
      IF CONDBLOCK>=254 THEN
         PRINT "Nesting error!!"
         PRINT #OUT,"** Nesting error **"
      ELSE CONDBLOCK=ADJUSTCOND(1)
      RETURN
   FI
   IF CF$="FIN" THEN
      IF CONDBLOCK THEN CONDBLOCK=ADJUSTCOND(-1)
      ELSE
         PRINT "Too many FIN's!!"
         PRINT #OUT,"** Too many FIN's **"
      FI
   FI
   IF CONDBLOCK < SAVEBLOCK THEN
      IF CONDBLOCK THEN EMITSTATE=2
      ELSE EMITSTATE=1 FI
   FI
   RETURN


HUH:
   PRINT "   The proper responses are:"
   PRINT "      <CR>  copies the entire block (up to the matching FIN)"
   PRINT "            verbatim, from input file to output file"
   PRINT
   PRINT "      F     the displayed expression is assigned the value FALSE"
   PRINT
   PRINT "      T     the displayed expression is assigned the value TRUE"
   PRINT
   PRINT "      C     the displayed expression may be changed"
   PRINT
   RETURN

                             !!!!!!!!!!!!!!!!!!!!!
                             ! PRE PARSE ROUTINE !
                             !!!!!!!!!!!!!!!!!!!!!
PREPARSE:
   LABEL$=""
   CF$=""
   AF$=""
   REST$=""

!   a few quick tests...

   IF LEN(LINE$)=0 THEN RETURN
   IF LINE$(1)=ASC "*" OR LINE$(1)=ASC ";" THEN
      REST$=LINE$
      RETURN
   FI

   TEMP$=UPPERCASE$(LINE$)

PREPARSEFORLABEL:
   IF TEMP$(1,1)=' ' OR TEMP$(1,1)=TAB$
   THEN
      GOSUB EATSPACES
      IF FIND(TEMP$,';')=1 THEN
         REST$=LINE$
         RETURN
      FI
      GOTO PREPARSEFORCF
   FI

   I=FIND(TEMP$,TAB$)
   J=FIND(TEMP$,' ')

   IF I=0 THEN I=J
   IF J=0 THEN J=I
   IF I<J THEN
      LABEL$=TEMP$(1,I-1)
      TEMP$=RIGHT$(TEMP$,I+1)
   ELSE
      IF J=0 THEN
         LABEL$=TEMP$
         RETURN
      FI
      LABEL$=TEMP$(1,J-1)
      TEMP$=RIGHT$(TEMP$,J+1)
   FI

   GOSUB EATSPACES

PREPARSEFORCF:
   IF TEMP$=""
   THEN
      LABEL$=""
      REST$=LINE$
      RETURN
   FI

   I=FIND(TEMP$,TAB$)
   J=FIND(TEMP$,' ')
   IF I=0 THEN I=J
   IF J=0 THEN J=I

   IF I<J THEN
      CF$=TEMP$(1,I-1)
      TEMP$=RIGHT$(TEMP$,I+1)
   ELSE
      IF J=0 THEN
         CF$=TEMP$
         RETURN
      FI
      CF$=TEMP$(1,J-1)
      TEMP$=RIGHT$(TEMP$,J+1)
   FI

   GOSUB EATSPACES

PREPARSEFORAF:
   IF TEMP$="" THEN RETURN

   IF FIND(TEMP$,";")=1 THEN PREPARSEREST

   I=FIND(TEMP$,TAB$)
   J=FIND(TEMP$,' ')

   IF I=0 THEN I=J
   IF J=0 THEN J=I
   IF I<J
   THEN
      AF$=TEMP$(1,I-1)
      TEMP$=RIGHT$(TEMP$,I+1)
   ELSE
      IF J=0 THEN
         AF$=TEMP$
         RETURN
      FI
      AF$=TEMP$(1,J-1)
      TEMP$=RIGHT$(TEMP$,J+1)
   FI

   GOSUB EATSPACES

PREPARSEREST:
   REST$=TEMP$
   RETURN

                  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                  ! EAT SPACES AND TABS FROM FRONT OF TEMP$ !
                  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

EATSPACES:
   IF FIND(TEMP$,' ')=1 OR FIND(TEMP$,TAB$)=1 THEN
      TEMP$=RIGHT$(TEMP$,2)
      GOTO EATSPACES
   FI
   RETURN

END
