DECLARE FUNCTION PreAvail87% ()
DECLARE SUB PreDefine (CV AS ANY, DefineTbl$, symbol$)
DECLARE SUB PreElse (CV AS ANY)
DECLARE SUB PreEndIf (CV AS ANY)
DECLARE SUB PreErr (CV AS ANY, S$)
DECLARE FUNCTION PreExist% (FileName$)
DECLARE FUNCTION PreGetDosVer$ ()
DECLARE FUNCTION PreGetEnvDefs$ (Tbl$, Parms AS ANY)
DECLARE SUB PreGetSymbol (L$, C$, S$, O$)
DECLARE SUB PreGetWord (L$, W$())
DECLARE SUB PreIfDefined (CV AS ANY, DefineTbl$, Operand$)
DECLARE SUB PreIfNDefined (CV AS ANY, DefineTbl$, Op$)
DECLARE SUB PreInclude (Op$, DefineTbl$)
DECLARE SUB PreProcessFile (FileIn$, DefineTbl$, IncStatus%)
DECLARE SUB PreProcessLine (CV AS ANY, DefineTbl$)
DECLARE SUB PreSetSysDefs (Tbl$, Parms AS ANY)
DECLARE SUB PreUnDefine (CV AS ANY, DefineTbl$, symbol$)
DECLARE FUNCTION PreValidFile% (FileIn$)
DEFINT A-Z

'BASIC 7.0 Users should change the next line to use
'the QBX.BI include file

'$INCLUDE: 'QB.BI'

'Include the TABLMNGR.BI AND TABLMNGR.BAS files from the
'RAM Tables article

'$INCLUDE: 'TABLMNGR.BI'

	CLS

'Initialize global variables and constants

	CONST True = -1, False = 0

	TYPE PreProcParameters              'Define the parameters
		Sym     AS SymbolTableParameters  '  used for the
		Chr     AS STRING * 2             '  preprocessor
		EnvSym  AS STRING * 7
	END TYPE

	TYPE CurrentLevelValues             'This structure maintains
		FileName      AS STRING * 72      '  the values for the
		FileInNbr     AS INTEGER          '  current level of IF/
		LineNbr       AS INTEGER          '  FILE processing
		PreStatus     AS INTEGER          'Output status before IF
		CurrentStatus AS INTEGER          'Output status inside IF
		IfFound       AS INTEGER          'These three variables
		ElseFound     AS INTEGER          '  track the reading of
		EndIfFound    AS INTEGER          '  these symbols
	END TYPE

	DIM SHARED RegsX AS RegTypeX
	DIM SHARED PreParms AS PreProcParameters
 
	PreParms.Sym.SWidth = 10      'Maximum symbol width
	PreParms.Sym.Delim = "\"     'Delimiter between symbols in tbl
	PreParms.Chr = "'%"          'Prefix to scan for in BASIC prog
	PreParms.EnvSym = "PREPROC"  'Environment keyword

' Initialize the symbol table

	IF NOT SymCreateTbl(DefineTbl$, PreParms.Sym, 1) THEN
		 PRINT "Error - Couldn't allocate symbol table"
		 END
	END IF

' Create automatic symbol definitions

	CALL PreSetSysDefs(DefineTbl$, PreParms)
	InclPath$ = PreGetEnvDefs(DefineTbl$, PreParms)

' Begin to process the file now

	FileCmd$ = COMMAND$
	IF LEN(FileCmd$) <> 0 THEN
		FileOut$ = FileCmd$ + ".PRE"
		FileOutNbr = 1
		OPEN FileOut$ FOR OUTPUT AS #FileOutNbr
		CALL PreProcessFile(FileCmd$ + ".BAS", DefineTbl$, False)
		CLOSE
	ELSE
		PRINT "No input file given on command line"
	END IF
	PRINT "Program terminated."
	END

'----------------------------------------------------------------

'----------------------------------------------------------------
'  Call an interrupt to check on
'  math coprocessor availability
'----------------------------------------------------------------
FUNCTION PreAvail87
	RegsX.ax = 0
	CALL INTERRUPTX(&H11, RegsX, RegsX)
	IF RegsX.ax AND 2 THEN
		PreAvail87 = True
	ELSE
		PreAvail87 = False
	END IF
END FUNCTION

'----------------------------------------------------------------
'Define a symbol for the preprocessor by calling a TABLMNGR Func
'----------------------------------------------------------------
SUB PreDefine (CV AS CurrentLevelValues, DefineTbl$, symbol$)
	IF NOT SymDefine(DefineTbl$, symbol$, PreParms.Sym) THEN
		PRINT CV.FileName; CV.LineNbr;
		PRINT "Warning - " + symbol$ + " duplicate definition"
		PRINT "or symbol contains the table delimiter character ";
		PRINT PreParms.Sym.Delim
	END IF
END SUB

'----------------------------------------------------------------
'Manage the preprocessor ELSE tasks
'  PreElse checks for duplicate ELSE's and ELSE's without IF's
'----------------------------------------------------------------
SUB PreElse (CV AS CurrentLevelValues)
	IF CV.IfFound THEN
		IF CV.ElseFound THEN
			CALL PreErr(CV, "Duplicate Else Found")
		ELSE
			ElseFound = True
			IF CV.PreStatus THEN
				CV.CurrentStatus = NOT CV.CurrentStatus 'Swap ELSE status
			ELSE
				CV.CurrentStatus = False 'Must be outputting outside IF
			END IF                     '  for us to start ouputting now
		END IF
	ELSE
		CALL PreErr(CV, "ELSE found without an IF statement")
	END IF
END SUB

'----------------------------------------------------------------
'Manage the preprocessor ENDIF tasks
'----------------------------------------------------------------
SUB PreEndIf (CV AS CurrentLevelValues)
	IF CV.IfFound THEN
		CV.EndIfFound = True
		IfFound = False     'Set this so you end the current IF level
	ELSE
		PreErr CV, "ENDIF without IF found"
	END IF
END SUB

'----------------------------------------------------------------
'Print error messages to screen
'----------------------------------------------------------------
SUB PreErr (CV AS CurrentLevelValues, S$)
	PRINT "+ "; RTRIM$(CV.FileName); " Line #: "; CV.LineNbr;
	PRINT "Preprocessor ERROR-"; S$
END SUB

'----------------------------------------------------------------
' See if a given file exists using
' DOS "Search for first match" service &H4E
'----------------------------------------------------------------
FUNCTION PreExist% (FileName$)

	RegsX.ax = &H4E00
	RegsX.cx = 63  ' Search for all files

	Spec$ = FileName$ + CHR$(0)

'BASIC 7.0 Users should change all occurences of
'VARSEG to SSEG (there's only one VARSEG in this program)

	RegsX.ds = VARSEG(Spec$) ' Load DS:DX with
	RegsX.dx = SADD(Spec$) ' address of Spec$

	CALL INTERRUPTX(&H21, RegsX, RegsX) ' CALL DOS

' If AX contains a value, then file does not exist

	SELECT CASE RegsX.ax
		CASE 0
			PreExist% = True
		CASE ELSE
			PreExist% = False
	END SELECT

END FUNCTION

'----------------------------------------------------------------
'Calls interrupt &H21, function &H30 to create a symbol for the
'  current DOS version
'----------------------------------------------------------------
FUNCTION PreGetDosVer$
	RegsX.ax = &H3000
	CALL INTERRUPTX(&H21, RegsX, RegsX)
	MajorVersion = RegsX.ax MOD 256
	MinorVersion = RegsX.ax \ 256
	DosV$ = "DOS" + RIGHT$(STR$(MajorVersion), 1)
	PreGetDosVer$ = DosV$ + RIGHT$(STR$(MinorVersion), 2)
END FUNCTION

'----------------------------------------------------------------
'Retrieve the symbols you define as part of your environment
'  using the value you store Parms.EnvSym.  Also retrieves the
'  INCLUDE environment variable if it exists.
'----------------------------------------------------------------
FUNCTION PreGetEnvDefs$ (Tbl$, Parms AS PreProcParameters)

	LenEnvSym = LEN(Parms.EnvSym)
	EnvLine = 1
	IPath$ = ""                 'Initialize the include paths value

	DO     'Loop until find both values looking for or end of table

		Env$ = ENVIRON$(EnvLine)

		IF LEFT$(Env$, LenEnvSym) = Parms.EnvSym THEN

			BegDefPos = INSTR(Env$, "=") + 1

			DO UNTIL BegDefPos > LEN(Env$)
				EndDefPos = INSTR(BegDefPos, Env$, ";")
				IF EndDefPos = 0 THEN EndDefPos = LEN(Env$) + 1
				EnvSym$ = MID$(Env$, BegDefPos, EndDefPos - BegDefPos)
				IF NOT SymDefine(Tbl$, EnvSym$, Parms.Sym) THEN
					PRINT "Unable to define "; EnvSym$; " from environment"
				END IF
				BegDefPos = EndDefPos + 1
			LOOP

			FoundPP = True                 'Sets one of the found flags

		ELSEIF LEFT$(Env$, 7) = "INCLUDE" THEN

			IPath$ = MID$(Env$, 9)
			FoundInclude = True            'Sets one of the found flags

		END IF

		IF FoundPP AND FoundInclude THEN EXIT DO
		EnvLine = EnvLine + 1
		Env$ = ENVIRON$(EnvLine)

	LOOP WHILE LEN(Env$)

	PreGetEnvDefs$ = IPath$

END FUNCTION

'----------------------------------------------------------------
'Gets the first two symbols from the input line
'  Checks to see if the first one matches the preprocessor prefix
'  symbols.  If it matches, set symbol and operand values
'----------------------------------------------------------------
SUB PreGetSymbol (L$, C$, S$, O$)

	DIM Word$(2)
	L$ = UCASE$(LTRIM$(RTRIM$(L$)))
	C$ = "IGNORE"    'Ignore non-commands
	S$ = ""
	O$ = ""
	IF LEN(L$) <> 0 THEN
		PreGetWord (L$), Word$()
		Prefix$ = LEFT$(Word$(1), 2)
		IF Prefix$ = PreParms.Chr OR Prefix$ = "'$" THEN
			C$ = "PreProc"
			S$ = MID$(Word$(1), 3)
			O$ = Word$(2)
		END IF
	END IF
END SUB

'----------------------------------------------------------------
'Loop through a line to retrieve the individual words delimited
'  by spaces.
'----------------------------------------------------------------
SUB PreGetWord (L$, W$())
	Delim$ = " "
	BegPos = 1
	LenL = LEN(L$)
	FOR I% = 1 TO 2                         'Get only first 2 words
		DelimPos = INSTR(BegPos, L$, Delim$)
		IF DelimPos = 0 THEN DelimPos = LenL + 1
		W$(I%) = MID$(L$, BegPos, DelimPos - BegPos)
		BegPos = DelimPos + 1
		IF BegPos > LenL THEN EXIT FOR
	NEXT I%
END SUB

'----------------------------------------------------------------
'Manage tasks for Preprocessing IfDefined command.
'----------------------------------------------------------------
SUB PreIfDefined (CV AS CurrentLevelValues, DefineTbl$, Operand$)

	DIM NewCV AS CurrentLevelValues    'Create a new copy of record
																		 '  To manage a new IF level
	NewCV.FileName = CV.FileName
	NewCV.FileInNbr = CV.FileInNbr
	NewCV.LineNbr = CV.LineNbr
	NewCV.PreStatus = CV.CurrentStatus
	NewCV.IfFound = True
	NewCV.ElseFound = False
	NewCV.EndIfFound = False

'Set output status to true if currently outputting and condition
'  is true, otherwise set current output status to false

	IF CV.CurrentStatus THEN
		IF SymDefined(DefineTbl$, Operand$, PreParms.Sym) THEN
			NewCV.CurrentStatus = True
		ELSE
			NewCV.CurrentStatus = False
		END IF
	ELSE
		NewCV.CurrentStatus = False
	END IF

'Recursively call a new copy of the PreProcessLine routine

	DO WHILE NOT EOF(NewCV.FileInNbr) AND (NOT NewCV.EndIfFound)
		CALL PreProcessLine(NewCV, DefineTbl$)
	LOOP
	CV.LineNbr = NewCV.LineNbr
END SUB

'----------------------------------------------------------------
'Manage tasks for Preprocessing IfNDefined command.
'----------------------------------------------------------------
SUB PreIfNDefined (CV AS CurrentLevelValues, DefineTbl$, Op$)

	DIM NewCV AS CurrentLevelValues    'Create a new copy of record
																		 '  to manage a new IF level
	NewCV.FileName = CV.FileName
	NewCV.FileInNbr = CV.FileInNbr
	NewCV.LineNbr = CV.LineNbr
	NewCV.PreStatus = CV.CurrentStatus
	NewCV.IfFound = True
	NewCV.ElseFound = False
	NewCV.EndIfFound = False

'Set output status to true if currently outputting and condition
'  is true, otherwise set current output status to false

	IF CV.CurrentStatus THEN
		IF (NOT SymDefined(DefineTbl$, Op$, PreParms.Sym)) THEN
			NewCV.CurrentStatus = True
		ELSE
			NewCV.CurrentStatus = False
		END IF
	ELSE
		NewCV.CurrentStatus = False
	END IF

	DO WHILE NOT EOF(NewCV.FileInNbr) AND (NOT NewCV.EndIfFound)
		CALL PreProcessLine(NewCV, DefineTbl$)
	LOOP
	CV.LineNbr = NewCV.LineNbr

END SUB

'----------------------------------------------------------------
'Manage tasks for Preprocessing Include command
'  Add lines from Include file into output file so include files
'  can have preprocessing lines also
'----------------------------------------------------------------
SUB PreInclude (Op$, DefineTbl$)
	Op$ = MID$(Op$, 2, LEN(Op$) - 2)
	CALL PreProcessFile(Op$, DefineTbl$, True) 'New copy of routine
END SUB

'----------------------------------------------------------------
'Manage tasks for Preprocessing File command.
'----------------------------------------------------------------
SUB PreProcessFile (FileIn$, DefineTbl$, IncStatus)
	DIM CV AS CurrentLevelValues 'Create a new record for new level
	SELECT CASE PreValidFile(FileIn$)        'Make sure file exists
		CASE 0
			CV.FileName = FileIn$
			CV.FileInNbr = FREEFILE              'Get new valid number
			CV.LineNbr = 0
			CV.CurrentStatus = True
			CV.PreStatus = True
			CV.IfFound = False
			CV.ElseFound = False
			CV.EndIfFound = False
			OPEN CV.FileName FOR INPUT AS #CV.FileInNbr
			DO WHILE NOT EOF(CV.FileInNbr)
				PreProcessLine CV, DefineTbl$      'Invoke new copy
			LOOP
			CLOSE CV.FileInNbr
		CASE 1
			PRINT "Can't find file->"; FileIn$ 'If can't file including
			IF IncStatus THEN                  '  keep line in file
				PRINT #1, "'$INCLUDE: '" + FileIn$ + "'"
			END IF
		CASE 2
			PRINT CV.FileName;
			PRINT "<-Invalid format - may be BASIC fast save format"
	END SELECT
END SUB

'----------------------------------------------------------------
'Manage tasks for Preprocessing Line command.
'----------------------------------------------------------------
SUB PreProcessLine (CV AS CurrentLevelValues, DefineTbl$)
	LINE INPUT #CV.FileInNbr, LineIn$

	DO
		CV.LineNbr = CV.LineNbr + 1
		CALL PreGetSymbol((LineIn$), Class$, symbol$, Op$)
		IF Class$ <> "PreProc" THEN
			IF CV.CurrentStatus THEN
				PRINT #1, LineIn$
			END IF
		ELSE
			SELECT CASE symbol$   'Split CASE into cmds that require
				CASE "ELSE"         '  operands and those who don't
					CALL PreElse(CV)
				CASE "ENDIF"
					CALL PreEndIf(CV)
					IF CV.EndIfFound THEN EXIT SUB
				CASE ELSE                'These commands require operands
					IF Op$ <> "" THEN
						SELECT CASE symbol$
							CASE "DEFINE"
								IF CV.CurrentStatus THEN
									CALL PreDefine(CV, DefineTbl$, Op$)
								END IF
							CASE "UNDEFINE"
								IF CV.CurrentStatus THEN
									CALL PreUnDefine(CV, DefineTbl$, Op$)
								END IF
							CASE "IFDEFINED"
								CALL PreIfDefined(CV, DefineTbl$, Op$)
							CASE "IFNDEFINED"
								CALL PreIfNDefined(CV, DefineTbl$, Op$)
							CASE "INCLUDE:"
								IF CV.CurrentStatus THEN
									CALL PreInclude(Op$, DefineTbl$)
								END IF
							CASE ELSE
								PRINT #1, "'Invalid Preprocessing command: ";
								PRINT #1, LineIn$
						END SELECT
					ELSE
						PRINT #1, "'Missing operand for "; symbol$;
						PRINT #1, " preprocessing command"
					END IF
			END SELECT
		END IF
		IF NOT (EOF(CV.FileInNbr)) THEN
			LINE INPUT #CV.FileInNbr, LineIn$
		END IF
	LOOP UNTIL EOF(CV.FileInNbr)
END SUB

'----------------------------------------------------------------
'Set the automatic system symbols
'----------------------------------------------------------------
SUB PreSetSysDefs (Tbl$, Parms AS PreProcParameters)
	IF PreAvail87 THEN   'Add Coprocessor to table if available
		Dummy = SymDefine(Tbl$, "AVAIL87", Parms.Sym)
	END IF
	Dummy = SymDefine(Tbl$, PreGetDosVer$, Parms.Sym)
END SUB

'----------------------------------------------------------------
'Manage tasks for Preprocessing UnDefine command.
'----------------------------------------------------------------
SUB PreUnDefine (CV AS CurrentLevelValues, DefineTbl$, symbol$)
	IF NOT SymUnDefine(DefineTbl$, symbol$, PreParms.Sym) THEN
		PRINT CV.FileName; CV.LineNbr;
		PRINT "Warning - " + symbol$ + " tried to undefine"
		PRINT "non-existent symbol or symbol contains the table"
		PRINT "delimiter character "; PreParms.Sym.Delim
	END IF
END SUB

'----------------------------------------------------------------
'Make sure the file exists and check first byte to see if TXT fmt
'  which seems to be &HFC for BASIC quick save format
'----------------------------------------------------------------
FUNCTION PreValidFile (FileIn$)
	PreValidFile = 0
	IF NOT PreExist(FileIn$) THEN
		PreValidFile = 1
	ELSE
		TestNbr = FREEFILE
		OPEN FileIn$ FOR BINARY AS TestNbr
		TestByte$ = " ": GET TestNbr, 1, TestByte$
		CLOSE TestNbr
		IF TestByte$ = CHR$(&HFC) THEN PreValidFile = 2
	END IF
END FUNCTION