' numBA.vbs -- preprocessor / translator
'
' Convert un-numbered, structured basic script to numbered source
' suitable for vintage interpreters
'
' Supports several constructs of modern BASIC such as:
'   No Line Numbers Required
'   LABEL <labelname>
'   GOTO/GOSUB <labelname>
'   WHILE/WEND
'   DO WHILE/LOOP
'   REPEAT/UNTIL
'   DO/LOOP UNTIL
'   LEAVE/CONTINUE/EXIT Loops
'   SELECT/CASE/ENDSELECT
'   Multi-line IF/THEN/ELSEIF/ELSE/ENDIF
'   SUB Name(A1, S$)/ENDSUB
'   EXIT SUB, EXIT FUNC[TION]
'   CALL <SubName> [parameters, ...]
'   Recursion
'   Long Variable Names
'   MACRO definitions
'   DEF FN, CONST simulated as macros
'   INCLUDE files
'   FUNCTION Name(P1, S$)/RETURN Value/END FUNCTION
'   Local variables
'   Escape sequences in strings
'   Conditional Compilation 
'
' TODO:
'   Create Source/Target macro include files
'   Map VBScript Functions/Keywords to M100 Basic (Macro Include File)  (Partial)
'   Language Specific Translation Macros (Rules)
'   Bug: Translator may overwrite users 2 char variable names
'   Setup options for stack limits etc.
'   Rewrite macrosub to handle expansions in parameters
'   Bug certain conditions where assignments and linenumbers not working
'   Bug in Macro Expansions with Custom Function Calls and Nested Macro Calls
'   Compress Spaces Option (partial)
'   bug: compiler attempts to compute label destinations in comments
'   Better Variable Translation
'   String Stack Manipulation may require garbage collection
'   Better output options, specify outfile, save symbols
'   Identify Operations on Constants at compile time
'   Condititinal Compilation: ignore sub/function headers in skipped code
'   Test Bug: CONST and DEF FN may be tested by IFDEF and IFNDEF
'   Bug: control variable in FOR loop should not be translated to an Array var
'   Option to automatically assign $ suffix to string variables
'   Bug: Backslash Escape in code conflicts with integer division operator
'
'   Compile the Compiler
'
' The reference BASIC's were VBScript (src) to TRS-80 Model 100 Basic (dst)
' May work with other BASIC languages, for instance: QBasic to GW-Basic
'
' CHANGES:
'   2010-04-12  Fixed ELSEIF Bug
'   2010-04-13  Fixed "[" in quotes bug
'   2010-04-13  CALL/SUB/ENDSUB with parameters
'   2010-04-14  Fixed WEND Bug
'   2010-04-16  Now handles single-line IF/THEN/ELSE better
'   2010-06-17  Release as v0.600
'   2010-06-20  Fixed END SUB w/ zero parameters v0.601
'   2010-09-04  added MACRO; DEF FN & CONST (simulated as macro)
'   2010-09-08  fixed bug in error display for cmdline args
'   2010-09-09  added REM INCLUDE "filename"
'   2010-09-09  added [+]<num> option to OPT LINE for synching line numbers to an arithmetic pattern
'   2010-09-10  improved handling of nested expresssions
'   2010-09-11  prescan for SUB/FUNC names
'               Smart call checking, no CALL keyword required
'               fixed "On Error GoTo 0" bug: workaround - LABEL 0 always translates to line 0
'   2010-09-17  User Functions (partial)
'               Local Variables
'   2010-09-18  Release as v0.700
'   2010-09-30  Fixed Assignment to Function Name as result
'               Basic function parameter checking
'   2010-10-13  Added Eval for CONST definitions (CONST Height = 5 * 5)
'               Increased default size of tokens() array
'   2011-02-13  MACRO lines can contain ':' as '::'
'   2011-02-14  Shorthand for LABEL, begin line with quoted string: "LabelName"
'               Allow OPTION as keyword (NO REM), selectable by [NO]OPTKEY option
'   2011-02-16  added EVAL() expansions, params evaluated and concatenated at compile time
'               added & as special leading char in MACRO definition, Evaluates macro text after param substitution
'   2011-11-11  fixed SELECT/CASE
'               added LEAVE/CONTINUE and EXIT for loops
'               fixed bug with "&" macro expansions
'               added EXIT SUB, EXIT FUNC[TION]
'               fixed allow multiple Command Line arguments
'   2011-11-12  Release as v0.800
'   2011-11-13  added SPARSE option, removes line numbers for unreferenced lines
'               added TABLES option to output symbol and variable tables to stderr
'   2011-11-14  added "." special character for MACRO definitions to parse object/member references
'               fixed bug EVAL not working
'   2011-11-18  enhanced MACRO definitions to simplify object semantics
'               added error check for no input file
'               fixed bug in optSparse
'               added KEYS FUNCS OPERS options to add additional keywords, functions, operators
'               allow labels at beginning of line without quotes
'               added ERRTHR option to control error stoppage
'   2012-05-18  fixed bug in END with no parameter
'               fixed bug in CASE not translating ctrl var
'               added CASE <expr>
'   2012-05-21  added escapes in strings
'               fixed bug in assign to Function name
'               added ESCDEF option to define named string escapes
'   2012-05-22  fixed bug in RETURN from SUB
'               conditional compilation - REM keywords: IF IFDEF IFNDEF ELSE ENDIF DEFINE UNDEF
'               added DEFINE option to allow macro symbols to be defined on the command line
'               added "#" as additional comment keyword
'               changed: Comments REM/# can include ":" in lines
'               added allow MACRO keyword from within REM/# statements
'   2012-05-24  expanded MACRO system, inline parsing, better param parsing, more robust
'               fixed bug in EVAL
'               fixed bug in label identification
'               improved some error messages
'               tweaked SPARSE and JOIN options
'               added PRESERVE option to attempt to save long variables in a compatible way
'   2012-06-01  tweaked indenting for ELSEIF
'               fixed single line IF/THEN/ELSE handling
'   2012-06-02  fixed long standing bug with stack frame of nested functions
'               fixed ON N GOTO/GOSUB
'               added LINELEN option to prevent JOIN from creating overly long lines
'               added "\" as a way to escape "||" join operator in macros
'               added OPT VAR to specify variable translations
'               tweaked parsing DEFINE, ESCDEF parameter input
'   2012-06-09  added NOCOMPILE option to allow preprocessing only
'   2012-06-20  fixed bug in function calls with mixed parameters
'   2012-07-30  added additional examples
'               Release as v0.900
'

Option Explicit

Randomize

Const Alpha     = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const Digit     = "0123456789"

' Operator Characters in VBScript but not in Model-100 Basic
Dim opsVBS      : opsVBS    = "&."
Dim KeyList     : KeyList   = " LABEL WHILE WEND REPEAT UNTIL DO LOOP LEAVE CONTINUE EXIT GOSUB RETURN GOTO ON IF THEN ELSE ELSEIF ENDIF FOR NEXT REM DATA RESTORE CALL SUB ENDSUB FUNC FUNCTION ENDFUNC END SELECT CASE PRINT INPUT DIM DATA TO STEP SOUND POKE CLS PRINT@ MENU LINE PSET PRESET POKE LINEINPUT BEEP OUT INP SYSCALL CLOSE RESUME OPEN AS DEF FN ON READ CONST LOCATE SCREEN TIMER COLOR USING RANDOMIZE KEY OFF TAB VTAB " 
Dim VBKeyList   : VBKeyList = " SET OPTION "
Dim FunList     : FunList   = " ABS INT SIN COS TAN LOG EXP SQR LEFT$ RIGHT$ MID$ STR$ VAL TIME$ DATE$ DAY$ PEEK INKEY$ ASC CHR$ RND STRING LEN INSTR MAXFILES VARPTR SPACE$ EOF "
Dim VBFunList   : VBFunList = " LEFT RIGHT MID ECHO QUIT BYREF"
Dim OPList      : OpList    = " + - * % / \ ^ MOD < > = <> >= <= => =< AND OR XOR EQV IMP NOT || "
Dim VBOpList    : VBOplist  = " . & "

Dim AlphaNum, ExprSp
AlphaNum        = Alpha & Digit
ExprSp          = " "

Const forReading = 1, forWriting = 2, forAppending = 8

Dim optSource   : optSource    = 1      ' Include original source as comments: 0=None, 1=Partial, 2=Full
Dim optIndent   : optIndent    = 2      ' Indent number of spaces
Dim optComments : optComments  = 1      ' Retain original comments
Dim optVBscript : optVBScript  = 1      ' Translate VBScript keywords and operators, like: & .
Dim optBlankLns : optBlankLns  = 0      ' Preserve Blank Lines
Dim optTranVars : optTranVars  = 1      ' Translate Variables
Dim optLineNums : optLineNums  = 0      ' Convert leading line numbers to labels
Dim optReqSpaces: optReqSpaces = 1      ' Require spaces after keywords
Dim optPass1    : optPass1     = 0      ' Show Compiler Pass1: 0=Hide 1=Show, 2=Stop
Dim optSrcOpts  : optSrcOpts   = 1      ' Allow Opts in source comments
Dim optIntegers : optIntegers  = 0      ' Don't recognize FP numbers
Dim optJoin     : optJoin      = 0      ' Join Lines with colons
Dim optJoinLen  : optJoinLen   = 255    ' Maximum line length when joining lines
Dim optSplitIF  : optSplitIF   = 0      ' By default don't split lines after IF (use builtin ELSE)
Dim optSimDef   : optSimDef    = 1      ' simulate DEF FN with macros (0=use builtin DEF FN)
Dim optErrThr   : optErrThr    = -1     ' Number of errors before stopping (-1 = no stop)
Dim optOptKey   : optOptKey    = -1     ' Allow OPTION Keyword
Dim optSparse   : optSparse    = 0      ' Sparse Line Numbering
Dim optTable    : optTable     = 0      ' Output Symbol Tables 1=Labels,2=Vars,4=Macros,8=Escapes,15=All
Dim optExprSp   : optExprSp    = 1      ' Output Extra Spacing in expressions for visibility
Dim optEscapes  : optEscapes   = 1      ' Parse Escapes in strings: {} and backslash for \{
Dim optSaveVars : optSaveVars  = 0      ' Attempt to preserve variable names in a compatible way
Dim optCompile  : optCompile   = -1     ' if compile = 0 run only the preprocessor

Dim inpFile

Dim linenum, lineinc, linetmp, linelst
linenum = 1000: lineinc = 10: linelst = 0

Dim ctrlstk(20), ctrllin(20), ctrlptr
ctrlptr = 0: ctrlstk(0) = "BOTTOM": ctrllin(0) = 0

Dim ltokens(99), tokens(99), toktyp(99), tkcount
Dim llabel(5000), labdst(5000), labref(5000), labcount
Dim vars(250), vartran(250), vartbl(36), varcount
Dim locals(20), locidx(20), loccount, parScnt, parNcnt, locScnt, locNcnt

' Current Func/Sub Name
Dim curproc, insub

' Current Control Variable for Select
Dim ctrlVar
Dim nfs, nfn    ' tracks function count in expression: string, numeric
Dim fcd         ' function call depth
Dim goffset     ' tab offset for elseif
goffset = 0

' Global var for regex matches
Dim reMatches

' Conditional Compilation, Current State, Nesting Stack
Dim CCond: CCond = ""

' globals for unrolling nested function calls
' number string params, number numeric params, call nesting depth
nfs = 0: nfn = 0: fcd = 0

Dim dMacros
Set dMacros = CreateObject("Scripting.Dictionary")
dMacros.CompareMode = vbTextCompare
' some default macros
dMacros("__LINE__")="[[[0]]]&linenum"
dMacros("__FILE__")="[[[0]]]&""""""""&aFiles(aFiles.Count - 1)&"""""""""
dMacros("__PROC__")="[[[0]]]&""""""""&curproc&"""""""""
dMacros("__CTRL__")="[[[0]]]&""""""""&ctrlstk(ctrlptr)&"" ""&ctrllin(ctrlptr)&"""""""""
dMacros("__SRCL__")="[[[0]]]&iCurLine"

Dim aRules 
Set aRules = CreateObject("System.Collections.ArrayList")

Dim dFuncs
Set dFuncs = CreateObject("Scripting.Dictionary")
dFuncs.CompareMode = vbTextCompare

Dim dSubs
Set dSubs = CreateObject("Scripting.Dictionary")
dSubs.CompareMode = vbTextCompare

Dim dEscapes
Set dEscapes = CreateObject("Scripting.Dictionary")
dEscapes.CompareMode = vbTextCompare

' a few samples
dEscapes("space") = " "
dEscapes("quote") = """+Chr$(34)+"""
dEscapes("underscore") = "_"
dEscapes("join") = "||"
dEscapes("brace") = "{"

Dim aFiles, aFileH

Set aFiles = CreateObject("System.Collections.ArrayList")
Set aFileH = CreateObject("System.Collections.ArrayList")

Dim buffer, buflvl
Dim oFS, oInput, sFName, pass1
Set oFS = CreateObject("Scripting.FileSystemObject")

Dim clArgs, icl

If Wscript.Arguments.Count > 1 Then
    iCurLine = 0
    clArgs = "REM OPT"
    For icl = 1 to WScript.Arguments.Count - 1
        clargs = clargs & " " & WScript.Arguments(icl)
    Next
    tkcount = tokenize(clArgs, 1, tokens)
    do_opt
End If

Set pass1 = CreateObject("System.Collections.Arraylist")

If WScript.Arguments.Count > 0 Then 
    inpFile = WScript.Arguments(0)
Else
    iCurLine = 0
    ErrMsg "No Input File"
    WScript.Quit
End If

CCond = "1"
IncludeFile inpFile 

Dim sLine, iCurLine, i, sSrcIndent
Dim errcount
errcount = 0

' Pass 1

iCurLine = 0

Do While aFiles.Count > 0
    Do While Not oInput.AtEndOfStream
        i = 1
        sLine = ""
        Do
            iCurLine = iCurLine + 1
            If Right(sLine, 2) = " _" Then
                sLine = Left(sLine, Len(sLine) - 2) & " " & oInput.ReadLine
            Else
                sLine = oInput.ReadLine
            End If
        Loop Until Right(sLine, 2) <> " _" Or oInput.AtEndOfStream
        If optBlankLns And sLine = "" Then
            If optCompile Then Output "'" Else Output " "
        End If
        Do While i <= Len(sLine)
            If Left(CCond,1) = "1" Or (Left(LTrim(UCase(sLine)), 3) = "REM" Or Left(LTrim(sLine), 1)  = "#") Then
                sSrcIndent = ScanChars(sLine, " " + Chr(9), 1 , -1, False)
                tkcount = Tokenize(sLine, i, tokens)
                ProcessTokens
            Else
                sSrcIndent = ""
                Exit Do
            End If
        Loop
    Loop
    oInput.Close

    aFileH.RemoveAt(aFileH.Count - 1)
    aFiles.RemoveAt(aFiles.Count - 1)

    If optSource > 0 And optComments And aFiles.Count > 0 Then OutPut "REM -- ENDFILE """ & sFName & """"
    If aFiles.Count > 0 Then
        sFName = aFiles(aFiles.Count - 1)
        Set oInput = aFileH(aFileH.Count - 1)
    End If
Loop

Do While ctrlptr > 0
    tokerrpos 0
    errmsg "Incomplete " & ctrlstk(ctrlptr)
    ctrlptr = ctrlptr - 1
Loop

If optPass1 Then
    WScript.StdErr.Writeline
    WScript.StdErr.Writeline "--- End of Pass 1 ---"
    WScript.StdErr.Writeline
    If optPass1 > 1 Then WScript.Quit
End If

' Pass 2

Dim lnum, lout, lnam, lidx, lref, lbuf, ltxt, lind

lbuf = ""
For i = 0 to pass1.count - 1
    iCurLine = i + 1
    lout = Pass2Line(pass1(i))
    If (optSparse Or optJoin) And i > 0 And optCompile Then
        lnum = reReplace(lout, "(\d+)(\s.*)", "$1")
        lnam = LabelName(CInt(lnum))
        lidx = LabelIdx(lnam)
        ltxt = reReplace(lout, "(\d+)(\s.*)", "$2")
        lref = 0
        If lidx > -1 Then lref = labref(lidx)
        If optSparse Then lind = String(Len(lnum), " ") Else lind = lnum 
        If (lnam = "" Or lref = 0) And Left(LTrim(ltxt), 3) <> "IF " And Left(LTrim(ltxt), 4) <> "REM " _
            And Len(lbuf) + Len(Trim(ltxt)) + 2 < optJoinLen Then
            If lbuf = "" Then
                If OptSparse Then lbuf = lind & ltxt Else lbuf = lnum & ltxt
            Else 
                lbuf = lbuf & ": " & Trim(ltxt)
            End If
        Else
            If lbuf <> "" Then WScript.Stdout.Writeline lbuf
            lbuf = ""
        End If
    End If
    If lbuf = "" Then WScript.StdOut.Writeline lout
Next
If lbuf <> "" Then WScript.Stdout.Writeline lbuf

' Place holder for branch past end of program
' possible if no code is required for end of control structure

If labcount > 0 Then
    If labdst(labcount - 1) >= linenum Then
        WScript.StdOut.WriteLine linenum & " REM END"
    End If
End If

' Dump Labels
If optTable And 1 Then
    WScript.StdErr.WriteLine ""
    WScript.StdErr.WriteLine "Labels"
    WScript.StdErr.WriteLine "------"
    For i = 0 to labcount - 1
        If Not(labref(i) = 0 And optSparse) Then
            WScript.StdErr.WriteLine llabel(i) & " = " & labdst(i)
        End If
    Next
End If

' Dump Variables
If optTable And 2 Then
    WScript.StdErr.WriteLine ""
    WScript.StdErr.WriteLine "Variables"
    WScript.StdErr.WriteLine "---------"
    For i = 0 to varcount - 1
        WScript.StdErr.WriteLine vars(i) & " = " & vartran(i)
    Next
End If

' Dump Macros
If optTable And 4 Then
    WScript.StdErr.WriteLine ""
    WScript.StdErr.WriteLine "Macros"
    WScript.StdErr.WriteLine "------"
    For each i in dMacros.Keys
        If Left(i, 6) <> "@RULE_" Then
            WScript.StdErr.WriteLine MacroToStr(i)
        End If
    Next
End If

' Dump Escapes
If optTable And 8 Then
    WScript.StdErr.WriteLine ""
    WScript.StdErr.WriteLine "Escapes"
    WScript.StdErr.WriteLine "-------"
    For each i in dEscapes.Keys
        WScript.StdErr.WriteLine i & " = " & dEscapes.Item(i)
    Next
End If

' Dump Rules
If optTable And 16 Then
    WScript.StdErr.WriteLine ""
    WScript.StdErr.WriteLine "Rules"
    WScript.StdErr.WriteLine "-----"
    For each i in dMacros.Keys
        If Left(i, 6) = "@RULE_" Then
            WScript.StdErr.WriteLine MacroToStr(i)
        End If
    Next
End If

' End of Main Routine
WScript.Quit

Function MacroToStr(mname)
    Dim i, n, nparam, params, mparam, mp, mbody, msplit, sStr, p
    
    
    msplit = split(Mid(dMacros.Item(mname), 4),"]]]")
    params = split(msplit(0), " ")
    mbody = msplit(1)
    For i = 1 to CInt(params(0))
        If sStr = "" Then sStr = "(" Else sStr = sStr & ","
        sStr = sStr & "P" & i
        If i = CInt(params(0)) Then sStr = sStr & ")"
        mbody = replace(mbody, "_PARAM_" & i & "_", "P" & i)
    Next
    mparam = "": n = 1 : p = 1
    If Left(mname, 6) = "@RULE_" Then
        p = p + 1
        mname = Mid(mname, 7)
        mparam = "[" & params(1)
    End If
    For i = p to UBound(params)
        If mparam = "" Then mparam = "[" Else mparam = mparam & " "
        If reTest(params(i), "_MB(.)_") Then
            mp = reReplace(params(i), "_MB(.)_", "$1"&n)
            mbody = replace(mbody, "_MBRTOK_" & n & "_", mp)
            n = n + 1
        Else
            mp = params(i)
        End If
        mparam = mparam & mp
        If i = UBound(params) Then mparam = mparam & "]"
    Next
    
    MacroToStr = mname & sStr & mparam & "=" & mbody
End Function

' Pass0 Quick Search for Func/Sub Defs
Sub ScanRoutines(fnam)
    Dim fhdl, src, re, mats, x
  
    Set fhdl = oFS.OpenTextFile(fnam)
    src = fhdl.ReadAll
    fhdl.Close
  
    Set re = New RegExp
  
    re.IgnoreCase = True
    re.Global = True
    re.MultiLine = False
    re.Pattern = "(?:^|\n)\s*\bFunc(?:tion)?\b\s+(\w+\$?)([^\n]*)"
    Set mats = re.Execute(src)
  
    For Each x in mats
        If Not dSubs.Exists(x.SubMatches(0)) Then
            dFuncs.Add x.SubMatches(0), x.SubMatches(1)
        Else
            errmsg "Function redefined: " & x.SubMatches(0)
        End If
    Next
  
    re.Pattern = "(?:^|\n)\s*\bSub?\b\s+(\w+)([^\n]*)"
    Set mats = re.Execute(src)
    For Each x in mats
        If Not dSubs.Exists(x.SubMatches(0)) Then
            dSubs.Add x.SubMatches(0), x.SubMatches(1)
        Else
            errmsg "Subroutine redefined: " & x.SubMatches(0)
        End If
    Next  
End Sub

' Pass2 Line Scan Function

Function Pass2Line(text)
    Dim i, s, lbl, idx, ch
  
    If reTest(text, "^\d+\s+('|REM |#)") Then
        Pass2Line = text
        Exit Function
    End If
    i = 1: s = ""
    Do While i <= Len(text)
        s = s & ScanChars(text, """[", i, -1, True)
        ch = Mid(text, i, 1)
        If ch = """" Then
            i = i + 1
            lbl = scanChars(text, """", i, -1, True)
            i = i + 1
            s = s & """" & lbl & """"
        End If
        If ch = "[" Then
            lbl = scanChars(text, "]", i, -1, True) & "]"
            idx = LabelIdx(lbl)
            If idx <> -1 Then
                s = s & labdst(idx)
                labref(idx) = labref(idx) + 1
            Else
                s = s & lbl
                errpos text, i + 2 - Len(lbl)
                errmsg "Unknown Label: " & lbl
            End If
            i = i + 1
        End If
        If ch <> """" and ch <> "[" Then
            s = s & Mid(text, i, 1)
        End If
    Loop
    Pass2Line = s
End Function

Sub IncludeFile(fnam)
    Dim fhdl
     
    On Error Resume Next
    ScanRoutines fnam
    
    Set fhdl = oFS.OpenTextFile(fnam)
 
    If err <> 0 Then
        errmsg "Could not Include file: """ & fnam & """"
    Else
        aFiles.Add fnam
        aFileH.Add fhdl
        sFName = fnam
        Set oInput = fhdl
    End If
    On Error GoTo 0
 
    Set fhdl = Nothing
End Sub

' Parsing Routines

Sub ProcessTokens()
    Dim s, i, bufout
    If Left(CCond, 1) = "0" Then
        If tkCount > 0 Then
            If tokens(0) = "REM" Then do_REM
            If tokens(0) = "#" Then do_REM
        End If
    Else
        If Not optCompile Then
            If tkcount > 0 Then
                Select Case Tokens(0)
                    Case "OPT"      : If optOptKey Then do_Opt
                    Case "OPTION"   : If optOptKey Then do_Opt
                    Case "CONST"    : do_Macro
                    Case "MACRO"    : do_Macro
                    Case "RULE"     : do_Macro
                    Case "DEF"      : do_DEF
                    Case "REM"      : do_REM
                    Case "#"        : do_REM
                    Case Else
                        Output Dumptokens()
                End Select
            End If
        Else
            If tkcount > 0 Then
                Select Case tokens(0)
                    Case "LABEL"   :    do_LABEL
                    Case "WHILE"   :    do_WHILE
                    Case "WEND"    :    do_WEND
                    Case "REPEAT"  :    do_REPEAT
                    Case "UNTIL"   :    do_UNTIL
                    Case "DO"      :    do_DO
                    Case "LOOP"    :    do_LOOP
                    Case "LEAVE"   :    do_LEAVE
                    Case "CONTINUE":    do_CONTINUE
                    Case "EXIT"    :    do_EXIT
                    Case "GOSUB"   :    do_GOSUB
                    Case "GOTO"    :    do_GOTO
                    Case "ON"      :    do_ON
                    Case "IF"      :    do_IF
                    Case "ELSE"    :    do_ELSE
                    Case "ELSEIF"  :    do_ELSEIF
                    Case "ENDIF"   :    do_ENDIF
                    Case "FOR"     :    do_FOR
                    Case "NEXT"    :    do_NEXT
                    Case "REM"     :    do_REM
                    Case "DIM"     :    do_DIM
                    Case "DATA"    :    do_DATA
                    Case "RESTORE" :    do_RESTORE
                    Case "CALL"    :    do_CALL
                    Case "SUB"     :    do_SUB
                    Case "ENDSUB"  :    do_ENDSUB
                    Case "FUNC"    :    do_FUNC
                    Case "FUNCTION":    do_FUNC
                    Case "ENDFUNC" :    do_ENDFUNC
                    Case "END"     :    do_END
                    Case "SELECT"  :    do_SELECT
                    Case "CASE"    :    do_CASE
                    Case "RETURN"  :    do_RETURN
                    Case "DEF"     :    do_MACRO
                    Case "MACRO"   :    do_MACRO
                    Case "CONST"   :    do_MACRO
                    Case "RULE"    :    do_MACRO
                    Case "OPT"     :
                        If optOptKey Then
                            do_OPT
                        Else
                            ErrMsg "OPT Keyword ignored"
                        End If
                    Case "OPTION"  :   
                        If optOptKey Then
                            do_OPT
                        Else
                            ErrMsg "OPTION Keyword ignored"
                        End If
                Case Else
                    If Left(tokens(0), 1) = """" Then
                        Output Dumptokens()
                    ElseIf tokens(0) = "#" Then
                        Do_REM
                    ElseIf Left(tokens(0), 1) = "'" Then
                        If optComments Then Output Dumptokens()
                    ElseIf dSubs.Exists(tokens(0)) Then
                        do_CALL
                    ElseIf dFuncs.Exists(tokens(0)) Then
                        If tokens(0) <> curproc or insub = 0 Then
                            tokerrpos 1
                            ErrMsg "invalid function value assignment: " & tokens(0)
                        Else
                            ' Assign to Function Name
                            i = 1
                            If Right(tokens(i), 1) = "$" Then
                                ' s = "ZS$(ZQ-" & locScnt + 2 & ")"  ' Changed from locScnt + 1
                                s = "ZS$(ZQ-" & locScnt + parScnt + 1 & ")"
                            Else
                                ' s = "ZS(ZP-" & locNcnt + 2 & ")"   ' Changed from locNcnt + 1
                                s = "ZS(ZP-" & locNcnt + parNcnt + 1 & ")"
                            End If
                            s = s & Expression(i)
                            Output s
                        End If
                    Else
                        bufout = AllExpressions(0, "")
                        If optJoin And Len(buffer & bufout) <= optJoinLen Then
                            If buffer <> "" Then
                                buffer = buffer & ":"
                            Else
                                buflvl = ctrlptr
                            End If
                            buffer = buffer & bufout
                            If labcount > 0 And buffer <> "" Then
                                If labdst(labcount - 1) >= linenum Then
                                    Output ""
                                End If
                            End If
                        Else
                            Output bufout
                        End If
                    End If
                End Select
            Else
                If optBlankLns Then Output "'"
            End If
        End If
    End If
End Sub

' Parse a line of basic
Function Tokenize(itext, byRef i, byRef a)
 
    Dim l, ch, tok, tmp, typ, stk, n, mark
    Dim ltxt, stxt, rtxt, svi, text
    Dim x, pat, p
    Dim tmptok
 
    ' typ = token type: 0 = ???, 1 = ident, 2 = num, 3 = stringlit , 4 = oper, 5 = comment, 6 = label, 7 = function/array, 8 = Other
 
    text = itext
    For each x in aRules
        p = 1
        pat = Replace(Split(Split(Mid(dMacros(x), 4), "]]]", 2)(0), " ", 3)(1), "~", " ")
        If reTest(text, pat) Then
            stxt = macrosub(text, p, x)
            rtxt = Mid(text, p)
            text = stxt & rtxt
        End If
    Next

    n = 0: a(n) = "__NULL__"
    tok = "": typ = 0: stk = "": n = 0: l = Len(text)
    Do While i <= l
        mark = i: ch = Mid(text, i, 1)
        If ch = " " Or ch = Chr(9) Then
            i = i + 1
            ScanChars text, " " + Chr(9), i, -1, False
            mark = i
        ElseIf InStr(Alpha & "_", ch) Then
            ' Build Identifier or Literal
            i = i + 1
            If optReqSpaces Then
                tok = ch & ScanChars(text, AlphaNum & "_", i, -1, False)
            Else
                tok = ScanKeyChars(text, AlphaNum & "_", i, -1, False)
            End If
            tmp = ScanChars(text, "$%#!@", i, 1, False)
            tok = tok & tmp
            typ = 1
       
            If isOperator(UCase(tok)) Then typ = 4
            If isFunction(UCase(tok)) or dFuncs.Exists(tok) Then typ = 7
            ' If Mid(text,i,1) = "(" Then typ = 7
            
            If typ <> 4 and typ <> 7 Then
                If Not isKeyword(tok) And Not dMacros.Exists(tok) Then
                    If n = 0 And Mid(text,i,1) = ":" Then
                        a(0) = "LABEL"
                        ltokens(0) = "LABEL"
                        n = n + 1
                    End If
                End If
            End If
       
        ElseIf InStr(Digit, ch) Then
            ' Build a Number
            If tok = "-" or tok = "+" Then
                ' possibly prefix sign operator
            End If
            i = i + 1
            tok = ch & ScanChars(text, Digit, i, -1, False)    ' digits
            ' Allow Numbered Source
            If n = 0 Then
                If n = 0 And optLineNums = False Then
                    ErrPos text, Len(tok) + 1
                    ErrMsg "Line Numbers not supported without ""OPT LINENUM"""
                Else
                    a(n) = "LABEL"
                    ltokens(n) = "LABEL"
                    a(n + 1) = tok
                    ltokens(n + 1) = tok
                    n = n + 2
                    ' linenum = CInt(tok)
                    ' tok = ""
                    Exit Do
                End If
            End If
  
            If Not optIntegers Then
                tmp = ScanChars(text, ".", i, 1, False)            ' decimal
                If tmp = "." Then tok = tok & "."
                tmp = ScanChars(text, Digit, i, -1, False)         ' fraction
                tok = tok & tmp
     
                tmp = ScanChars(text, "EeDd", i, 1, False)         ' exponent single/double
                If tmp <> "" Then
                    tok = tok + tmp
     
                    tmp = ScanChars(text, "+-", i, 1, False)       ' exponent sign
                    tok = tok & tmp
 
                    tmp = ScanChars(text, Digit, i, -1, False)     ' exponent digits
                    tok = tok & tmp
                End If
            End If
            typ = 2
        ElseIf ch = "#" Then
            If i <> 0 Then 
                ' maybe this should be an operator
                ' scan file handle tokens #1, #10 etc.
                i = i + 1
                tok = ch & ScanChars(text, Digit, i, -1, False)
                typ = 8
            Else
                ' treat as a comment introducer like REM
                i = i + 1
                tok = "#"
                typ = 5
            End If
        ElseIf ch = "(" Then
            i = i + 1
            stk = stk & ch
            tok = ch
            ' if no space between previous identifier then
            ' function call or array
            typ = 8
        ElseIf ch = ")" Then
            i = i + 1
            tok = ch
            If Right(stk, 1) = "(" Then
                stk = Left(stk,Len(stk) - 1)
            Else
                ErrPos text, i
                ErrMsg "Mismatched Parentheses"
            End If
        ElseIf  ch = "," Then
            ' introduce expression list
            i = i + 1
            tok = ch
            typ = 8
        ElseIf  ch = ";" Then
            tok = ch
            i = i + 1
            If stk <> "" Then
                ErrPos text, i
                ErrMsg "Semicolon not valid in expression"
            End If
            typ = 8
        ElseIf InStr("+-*/\^%|" & opsVBS, ch) > 0 Then
            ' Simple Operator
            tok = ch
            typ = 4
            i = i + 1
        ElseIf ch = ">" or ch = "<" Then
            i = i + 1
            tok = ch & ScanChars(text, "=", i, 1, False)
            typ = 4
        ElseIf ch = "=" Then
            i = i + 1
            tok = "="
            tok = ch & ScanChars(text, "<>",i, 1, False) ' Allow "=<" and "=>"
            typ = 4
            ' Assignment or Operator
        ElseIf ch = Chr(34) Then
            ' Double Quote String
            i = i + 1
            tmptok = ScanChars(text, Chr(34), i, -1, True)
            tok = Chr(34) & tmptok & Chr(34) 'accept anything but a quote
            If optEscapes Then tok = parseEscapes(tok)
            If i > l Then
                ErrPos text, i + 1
                ErrMsg "Unterminated Literal String"
            Else
                i = i + 1
            End If
           
            ' Allow quoted label at beginning of line
            If n = 0 And Mid(text,i,1) = ":" Then
                a(0) = "LABEL"
                ltokens(0) = "LABEL"
                n = n + 1
            End If
            typ = 3
        ElseIf ch = "'" Then
            i = i + 1
            tok = "'" & ScanChars(text, "", i, -1, True)  ' accept anything
            typ = 5
        ElseIf ch = ":" Then
            If a(0) <> "REM" and a(0) <> "#" Then
                If stk <> "" Then
                    ErrPos text, i
                    ErrMsg "Expression incomplete. Expected "","" or "")"""
                Else
                    i = i + 1
                    If a(0) = "IF" Then
                        If optSplitIF Then
                            ErrPos text, i + 1
                            ErrMsg "Warning: ':' following IF/THEN"
                            Exit Do
                        Else
                            tok = ":"
                            typ = 8
                        End If
                    ElseIf a(0) = "MACRO" Then
                        If i < Len(Text) Then
                            If Mid(text, i, 1) = ":" Then
                                i = i + 1
                                tok = ":"
                                typ = 8
                            Else
                                Exit Do
                            End If
                        End If
                    Else
                        Exit Do
                    End If
                End If
            Else
                ' Ignore ':' in commented lines
                i = i + 1
                tok = ":"
                typ = 5
            End If
        Else
            i = i + 1
            ErrPos text, i
            ErrMsg "Unexpected Character"
        End If
 
        If tok <> "" Then
      
            ' special treatment for code with labels
            ' This code should probably go to Expressions/AllExpression

            If n > 0 And tok <> "0" Then
                If InStr(" GOTO GOSUB RESUME RESTORE ", " " & tokens(n - 1) & " ") > 0 Then
                    If typ = 1 or typ = 2 Then
                        tok = "[" & tok & "]"
                        typ = 6
                    End If
                ElseIf InStr(" ELSE THEN ", " " & tokens(n - 1) & " ") And i > l Then
                    tok = "[" & tok & "]"
                    typ = 6
                ElseIf tok = "ELSE" Then
                    If n > 2 Then
                        If tokens(n - 2) = "THEN" Then
                            If toktyp(n - 1) = 1 or toktyp(n - 2) = 2 Then
                                tokens(n - 1) = "[" & tokens(n - 1) & "]"
                                toktyp(n - 1) = 6
                            End If
                        End If
                    End If
                End If
            End If
                                    
            ' Identify Macro and perform substitutions
            If (dMacros.Exists(tok) or UCase(tok) = "EVAL") and InStr(" REM ' # ", " " & tokens(0) & " ") = 0 Then
                ' Macro identified: Scan Past Parameters, adjust the "stream" and resume
                
                ltxt = Left(text, mark - 1)
                stxt = MacroSub(text, i, UCase(tok))
                rtxt = Mid(text, i)

                text = ltxt & stxt & rtxt
                
                ' position to process the new text
                i = Len(ltxt) + 1: l = Len(text)
               
                ' Check for recursive substitutions
                If stxt = tok Then
                    i = i + Len(stxt)
                    a(n) = UCase(tok)
                    ltokens(n) = tok
                    toktyp(n) = typ
                    n = n + 1
                End If
           Else
                If InStr("""'", Left(tok, 1)) = 0 Then
                    a(n) = UCase(tok)
                    ltokens(n) = tok
                Else
                    a(n) = tok
                    ltokens(n) = tok
                End If
                toktyp(n) = typ
 
                n = n + 1
            End If
            tok = ""
            typ = 0
        End If

        ' added this check in case MACROS change length of text
        If i > l Then
            i = Len(itext) + 1
            Exit Do
        End If
    Loop
    
    If tok <> "" Then
        a(n) = tok
        ltokens(n) = tok
        toktyp(n) = typ
        n = n + 1
        a(n) = "__NULL__"
        ltokens(n) = "__NULL__"
    End If
 
    If stk <> "" Then
        ErrPos text, i
        ErrMsg "Mismatched Parentheses"
    End If
    Tokenize = n

End Function

Function MacroSub(text, byref i, mname)
    Dim ch, subtxt, stk, param, nparams, n, l, tki, pmi, moper, mdef, msplit, mparams, mi, mz
   
    subtxt = ""
    If mname = "EVAL" Then
        subtxt = "[[[1]]]]"
    Else
        If dMacros.Exists(mname) Then
            subtxt = dMacros(mname)
        Else
            errmsg "MACRO doesn't exist: " & mname
        End If
    End If
    
    nparams = 0: moper = ""
    If Left(subtxt,3) = "[[[" Then
        msplit = split(Mid(subtxt,4), "]]]", 2)
        mparams = split(msplit(0), " ")
        mdef = msplit(1)
        moper = mparams(0)
        If UBound(mparams) > -1 Then nparams = CInt(mparams(0))
        If UBound(mparams) > 0 Then moper = mparams(1)
        subtxt = mdef
    End If
    n = 0
    If Mid(text,i,1) = "(" And (reTest(subtxt, "_PARAM_\d+_") Or mname = "EVAL") Then
        'Handle Parameters
        l = Len(text): i = i + 1: stk = 0: param = ""
        Do While i <= l
            param = param & ScanChars(text, "()," & """", i, -1,True)
            ch = Mid(text, i, 1)
            If i <= l Then
                If ch <> """" Then
                    If stk > 0 Then
                        param = param & ch
                        If ch = ")" Then stk = stk - 1
                        If ch = "(" Then stk = stk + 1
                    Else
                        If ch = "(" Then
                            stk = stk + 1
                            param = param + ch
                        ElseIf ch = "," or ch = ")" Then
                            n = n + 1
                            If mname <> "EVAL" Then
                                subtxt = replace(subtxt, "_PARAM_" & n & "_", param)
                            Else
                                err.clear
                                On Error Resume Next
                                ' param = eval(param)
                                subtxt = eval(param)
                                If err.Number <> 0 Then
                                    ErrPos text, i - Len(param) + 1
                                    errmsg "EVAL - error in expression: " & param & vbCRLF _
                                    & "*** " & err.number & " - " & err.description
                                    subtxt = param
                                End If
                                On Error GoTo 0
                            End If
                            param = ""
                        End If
                        If ch = ")" Then
                            i = i + 1
                            Exit Do
                        End If
                    End If
                    i = i + 1
                Else
                    ScanChars text, """", i, 1, False
                    param = param & """" & ScanChars(text, """", i, -1, True) & """"
                    ScanChars text, """", i, 1, False
                End If
            Else
                errmsg "Mismatched Parentheses" & ":" & ch
            End If
        Loop
    End If
    
    If n <> nparams Then
        If n < nparams Then
            For tki = n + 1 to nparams
                subtxt = replace(subtxt, "_PARAM_" & tki & "_", "")
            Next
        End If
        errpos text, i
        errmsg "Macro parameter mismatch.  Expected " & nparams & ", found " & n
    End If
    
'    If Left(subtxt,3) = "[[[" Then
    If UBound(mparams) > -1 Then
        'header parsed above
        
        For tki = 1 to Ubound(mparams)
            mparams(tki) = Replace(mparams(tki),"~"," ")
        Next
        
        tki = 1 : pmi = 0
        If Left(mname, 6) = "@RULE_" Then tki = 2
        Do While tki <= UBound(mparams) And i <= Len(text)
            param = ""
            moper = mparams(tki)
            If moper = "_MBT_" Then
                ' Scan next token
                ScanChars text, " " & Chr(9), i, -1, False
                pmi = pmi + 1
                ch = Mid(text,i,1)
                If InStr(Alpha&"_", ch) > 1 Then
                    param = ScanChars(text, AlphaNum + "_", i, -1, False)
                ElseIf ch = """" Then
                    ScanChars text, """", i, 1, False
                    param = """" & ScanChars(text, """", i, -1, True) & """"
                    If i <= Len(text) Then ScanChars text, """", i, 1, False
                ElseIf InStr(Digit, ch) > 1 Then
                    param = ScanChars(text, digit, i, -1, False)
                Else
                    param = ScanChars(text, "+-*/,^;=<>().", i, -1, False)
                End If
                subtxt = replace(subtxt, "_MBRTOK_" & pmi & "_", param)
            ElseIf  moper = "_MBX_" Then
                ' Find  pattern
                ScanChars text, " " & Chr(9), i, -1, False
                mz = 0: mi = 0
                If tki < UBound(mparams) - 1 Then
                    moper = mparams(tki + 1)
                    If Left(moper, 1) = "&" Then
                        moper = Mid(moper, 2)
                        If reTest(Mid(text, i), moper) Then
                            mi = reMatches(0).FirstIndex + i
                            mz = reMatches(0).Length
                        End If
                        If mi = 0 Then mi = Len(text) + 1
                    Else
                        mz = Len(moper)
                        mi = InStr(i, UCase(text), UCase(moper))
                        If mi = 0 Then mi = Len(text) + 1
                    End If
                Else
                    mi = Len(text) + 1
                End If
                param = Mid(text, i, mi - i)
                i = mi - mz
                pmi = pmi + 1
                subtxt = replace(subtxt, "_MBRTOK_" & pmi & "_", param)
            ElseIf  moper = "_MBF_" Then
                ' Find  pattern
                ScanChars text, " " & Chr(9), i, -1, False
                mz = 0
                If tki < UBound(mparams) - 1 Then
                    moper = mparams(tki + 1)
                    If Left(moper, 1) = "&" Then
                        moper = Mid(moper, 2)
                        mi = reTest(Mid(text, i), moper)
                        If mi <> 0 Then
                            mi = reMatches(0).FirstIndex + i
                            mz = reMatches(0).Length
                        End If
                        If mi = 0 Then mi = Len(text) + 1
                    Else
                        mz = Len(moper)
                        mi = InStr(i, UCase(text), UCase(moper))
                        If mi = 0 Then mi = Len(text) + 1
                    End If
                Else
                    mi = Len(text) + 1
                End If
                param = Mid(text, mi, mz)
                i = mi - mz
                pmi = pmi + 1
                subtxt = replace(subtxt, "_MBRTOK_" & pmi & "_", param)
            Else
                ScanChars text, " " & Chr(9), i, -1, False
                If Left(moper, 1) <> "&" Then
                    mi = InStr(i, UCase(text), UCase(moper))
                    If mi = 0 Then i = Len(text) + 1 Else i = mi + Len(moper)
                Else
                    moper = Mid(moper, 2)
                    mi = reTest(Mid(text, i), moper)
                    If mi <> 0 Then mi = reMatches(0).FirstIndex + i
                    If mi = 0 Then i = Len(text) + 1 Else i = mi + reMatches(0).Length 
                End If
            End If
            tki = tki + 1
        Loop

        Do While tki <= UBound(mparams)
            If mparams(tki) = "_MBT_" or mparams(tki) = "_MBX_" or mparams(tki) = "_MBF_" Then
                pmi = pmi + 1
                subtxt = replace(subtxt, "_MBRTOK_" & pmi & "_", "")
            End If
            tki = tki + 1
        Loop
    End If
    
    If Left(subtxt,1) = "&" Then
        err.clear
        On Error Resume Next
        subtxt = eval(Mid(subtxt,2))
        If err.Number <> 0 Then
            errmsg "MACRO EVAL - error in expression: " & subtxt & vbCRLF _
            & "    " & err.number & " - " & err.description
        End If
        On Error GoTo 0
    End If

    subtxt = replace(subtxt,"\||", "[EscJoin]")
    subtxt = replace(subtxt,"||", "")
    subtxt = replace(subtxt,"[EscJoin]", "||")
    MacroSub = subtxt

End Function

Function ScanChars(stmt, byRef allow, byRef i, mx, rev)
' Return characters scanned with legal chars in allow
' stmt  = string to scan
' allow = list of legal chars
' i     = start pos (altered)
' mx    = mx chars to return
' rev   = reverses sense of allowed chars to disallowed

    Dim c, l, p, result
 
    result = ""
    l = Len(stmt)
    Do While i <= l And (Len(Result) < mx Or mx < 0)
        c = Mid(stmt, i, 1)
        If c = "\" And optEscapes Then
            i = i + 1
            result = result & "\"
            c = Mid(stmt, i, 1)
        End If
        p = InStr(allow, c)
        If (p = 0) Xor rev Then Exit Do
        i = i + 1
        result = result & c
    Loop
    ScanChars = Result
End Function

Function ScanKeyChars(stmt, byRef allow, byRef i, mx, rev)
    Dim c, l, p, result
 
    result = ""
    i = i - 1 ' back up to include lead char
    l = Len(stmt)
    Do While i <= l And (Len(Result) < mx Or mx < 0)
        c = Mid(stmt, i, 1)
        If c = "\" and optEscapes Then
            i = i + 1
            result = result & "\"
            c = Mid(stmt, i, 1)
        End If
        p = InStr(allow, c)
        If (p = 0) Xor rev Then Exit Do
        i = i + 1
        result = result & c
        If IsKeyWord(result) Then Exit Do
        If IsFunction(result) Then Exit Do
    Loop
    ScanKeyChars = Result
End Function

'Transform Escaped String
Function parseEscapes(str)
    Dim i, c, l, p, seq, result
    result = ""
    i = 1: l = Len(Str)
    Do While i <= l
        c = Mid(str, i, 1)
        If c = "\" Then
            i = i + 1
            If i <= l Then
                c = Mid(str, i , 1)
                If c <> "{" Then c = "\" & c
            End If
        Else 
            If c = "{" Then
                p = InStr(i + 1, str, "}")
                If p = 0 Then p = l
                seq = Mid(str, i, p - i + 1)
                i = i + Len(seq) - 1
                If Right(seq, 1) <> "}" Then seq = seq & "}"
                c = subEscape(seq)
            End If
        End If
        result = result & c
        i = i + 1
    Loop
    parseEscapes = result
End Function

'Substitute Escape sequence to character string
Function subEscape(str)
    Dim a, seq, reps, i, result

    seq = Mid(str, 2, Len(str) - 2) ' strip {}

    a = split(seq, "*", 2)
    If UBound(a) > 0 Then
        On Error Resume Next
        reps = CInt(a(1))
        If Err.Number <> 0 Then
            errmsg "ESCAPE SEQ - error in repeat count: must be integer"
        End If
    Else
        reps = 1
    End If
    On Error GoTo 0

    If reps <= 0 Then reps = 1
    If reps > 256 Then reps = 256
    
    result = ""
    If dEscapes.Exists(a(0)) Then
        For i = 1 to reps
            result = result & dEscapes(a(0))
        Next
    Else
        If UCase(Left(a(0),2)) = "0X" Then
            For i = 1 to reps
                result = result & Chr(CInt("&H" & Mid(a(0), 3)))
            Next
        Else
            result = "{" & a(0)
            If reps > 1 Then result = result & "*" & reps
            result = result & "}"
            errmsg "ESCAPE SEQ - unknown name: " & a(0)
        End If
    End If
    subEscape = result
End Function

' Parse a set of Expressions from token i to term
Function AllExpressions(i, term)
    Dim s, e, t
    s = "": nfn = 0: nfs = 0
    Do While i < tkcount And tokens(i) <> term
        e = Expression(i)
        If e = "" Then
            If i < tkcount Then
                e = tokens(i)
                i = i + 1
            End If
        End If
        If e <> "" Then
            If s <> "" and e <> "," Then s = s & " "
            s = s & e
        End If
    Loop
    AllExpressions = s
End Function

Function Expression(byref i)
    Dim s, stk, tok, tt, nn, ns, nf, params, e, pop, off, cmt
  
    s = "": tt = 0: ns = 0: nn = 0
    stk = 0
    Do While i < tkcount
        tok = tokens(i)
        If IsKeyWord(tok) Then Exit Do
        If tok = "(" Then stk = stk + 1
        If tok = ")" Then
            If stk = 0 Then Exit Do
            stk = stk - 1
        End If
        If tok = "," And stk < 1 Then Exit Do
     
        ' typ = token type: 0 = ???, 1 = ident, 2 = num, 3 = stringlit , 4 = oper, 5 = comment, 6 = label, 7 = function/array, 8 = Other
      
        Select Case toktyp(i)
            Case 1
                ' Identifier
                If optTranVars And Not isFunction(tok) And Not dFuncs.Exists(tok) Then
                    If tt = 1 Then s = s & ExprSp
                    s = s & TransVar(tok)
                Else
                    If tok = "MACRO" Then
                        s = s & tok & " "
                    Else
                        If InStr(Alpha & Digit & """", Right(s, 1)) > 0 And InStr(Alpha & Digit & """", Left(tok, 1)) > 0 Then
                            s = s & " " & tok
                        Else
                            s = s & tok
                        End If
                    End If
                End If
            Case 4
                ' Operator
                If InStr(Alpha, Left(tok,1)) > 0 Then
                    If s <> "" And Right(s, 1) <> " " Then s = s & ExprSp
                    s = s & tok & ExprSp
                Else
                    s = s & tok
                End If
            Case 5
                ' Comment
                s = s & tok
                i = i + 1
                Exit Do
                ' errmsg "Expect expression term - Found: " & tok
            Case 7
                ' Function / Array (allow "," at this stk level)
                If dFuncs.Exists(tok) Then
                  
                    i = i + 1
                    ' If Right(tok, 1) = "$" Then nfs = nfs + 1 Else nfn = nfn + 1
                    params = ""
                    If tokens(i) = "(" Then
                        ns = 0: nn = 0
                        Do
                            i = i + 1
                            If tokens(i) <> ")" Then
                                If params <> "" Then params = params & ":"
                                fcd = fcd + 1
                                e = Expression(i)
                                fcd = fcd - 1
                                If Right(tok, 1) = "$" Then nf = 0 Else nf = -1
                                If InStr(e, """") > 0 Or InStr(e, "$") > 0 Then
                                    ns = ns + 1
                                    params = params & "ZS$(ZQ+" & ns + nf & ")=" & e
                                Else
                                    nn = nn + 1
                                    params = params & "ZS(ZP+" & nn + (not nf) & ")=" & e
                                End If
                                If tokens(i) <> "," And tokens(i) <> ")" Then errmsg "Expected: Parameter List - Found: " & tokens(i)
                            End If
                        Loop Until tokens(i) = ")"
                    End If
                    If Right(tok, 1) = "$" Then nfs = nfs + 1 Else nfn = nfn + 1
                   
                    VerifyFuncArgs tok, nn, ns
                                       
                    If params <> "" Then params = params & ":"
                    If Right(tok, 1) <> "$" Then
                        If ns > 0 Then params = params & "ZQ=ZQ+" & ns & ":"
                        Output params & "ZP=ZP+" & nn + 1 & ":GOSUB [" & tok & "]"
                    Else
                        If nn > 0 Then params = params &  "ZP=ZP+" & nn & ":"
                        Output params &  "ZQ=ZQ+" & ns + 1 & ":GOSUB [" & tok & "]"
                    End If

                    If Right(tok, 1) = "$" Then
                        off = nfs - 1 - fcd 
                        s = s & "ZS$(ZQ+" & off & ")"
                    Else
                        off = nfn - 1 - fcd
                        s = s & "ZS(ZP+" & off & ")"
                    End If

                Else
                    If optTranVars And Not isFunction(tok) Then
                        s = s & TransVar(tok)
                    Else
                        s = s & ExprSp & tok
                    End If
                End If
        Case Else
            s = s & tok
        End Select
        If stk < 0 Then
            errmsg "Expression - Mismatched Parentheses: " & s & " " & stk
            ' stk = stk + 1
        End If
        tt = toktyp(i)
        i = i + 1
    Loop
  
    If nfn + nfs > 0 And (stk < 0 Or i >= tkcount) Then
        pop = ""
        If nfn > 0 Then pop = "ZP=ZP-" & nfn
        If nfs > 0 Then
            If pop <> "" Then pop = pop & ":"
            pop = pop & "ZQ=ZQ-" & nfs
        End If
        If Left(pop,1) = ":" Then pop = Mid(pop,2)
        Output pop
        nfn = 0: nfs = 0
    End If
    Expression = LTrim(s)
End Function


Function isOperator(tk)
    If optVBScript Then
        isOperator = (InStr(" & ." & OpList, " " & tk & " ") > 0)
    Else
        isOperator = (InStr(OpList, " " & tk & " ") > 0)
    End If
End Function

Function isKeyword(tk)
    If optVBScript Then
        isKeyword = (InStr(VBKeylist & " " &KeyList, " " & tk & " ") > 0)
    Else
        isKeyword = (InStr(KeyList, " " & tk & " ") > 0)
    End If
End Function

Function isVBKeyword(tk)
    isVBKeyword = (InStr(VBKeyList, " " & tk & " ") > 0)

End Function

Function isFunction(tk)
    If optVBScript Then
        isFunction = (InStr(FunList & VBFunList, " " & tk & " ") > 0)
    Else
        isFunction = (InStr(FunList, " " & tk & " ") > 0)
    End If
End Function

Sub verifyFuncArgs(sName, cntN, cntS)
    Dim par, parN, parS
    If dFuncs.Exists(sName) Then
        parN = reReplace(dFuncs(sName), "[()\s]", "")
        parN = reReplace(parN, "[^,\$]+", ".")
        parS = reReplace(parN, "[^\$]", "")
        parN = reReplace(parN, "[\$,]" ,"")
        parN = Len(parN) - Len(parS)
        parS = Len(parS)
        If parN <> cntN Or parS <> cntS Then
            WScript.StdErr.WriteLine Dumptokens()
            errmsg "Function Parameter Mismatch: " & sName
        End If
    Else
        WScript.StdErr.WriteLine Dumptokens()
        errmsg "User function not found: " & sname
    End If
End Sub

Sub verifySubArgs(sName, cntN, cntS)
    Dim parN, parS
    If dSubs.Exists(sName) Then
        parN = reReplace(dSubs(sName), "[()\s]", "")
        parN = reReplace(parN, "[^,\$]+", ".")
        parS = reReplace(parN, "[^\$]", "")
        parN = reReplace(parN, "[\$,]", "")
        parN = Len(parN) - Len(parS)
        parS = Len(parS)
        If parN <> cntN Or parS <> cntS Then
            WScript.StdErr.WriteLine Dumptokens()
            errmsg "Subroutine parameter mismatch: " & sName
        End If
    Else
        WScript.StdErr.WriteLine Dumptokens()
        errmsg "User subroutine not found: " & sname
    End If
End Sub

Sub Output(text)
    OutputI text, 0
End Sub

' General Functions / Subroutine
'
Sub OutputI(sText, offset)
    Dim sWork, f, lineout
    Dim level, l 
    
    level = ctrlptr + offset + goffset
    
    f = 0
    Do While f = 0
        If level < 0 Then
            errmsg "Control Stack Underflow - fatal error"
            WScript.Quit
        End If
  
        If buffer <> "" Then
            sWork = buffer
            buffer = ""
            level = buflvl + offset + goffset
        Else
            If sText = "" Then Exit Do
            sWork = sText
            f = 1
        End If

        If optIndent Then
            If optPass1 Then WScript.StdErr.WriteLine linenum & " " & String(level * optIndent, " ") & sWork
            pass1.Add linenum & " " & String(level * optIndent, " ") & sWork
        Else
            If optPass1 Then WScript.StdErr.Writeline linenum, sWork
            pass1.Add linenum & " " & sWork
        End If
        linelst = linenum
        linenum = linenum + lineinc
    Loop
End Sub

Sub Flush
    If buffer <> "" Then Output("")
End Sub

Function oldDumpTokens
    Dim i, s
    s = ""
    For i = 0 to tkcount - 1
        s = s & tokens(i) & " "
    Next
    DumpTokens = s
End Function

Function DumpTokens
    Dim i, s, sp
    s = ""
    For i = 0 to tkcount - 1
        If InStr(Alpha & Digit &  "_""", Right(s, 1)) > 0 And InStr(Alpha & Digit &  "_""", Left(tokens(i), 1)) > 0 Then s = s & " "
        If isKeyWord(tokens(i)) And Right(s, 1) <> " " Then s = s & " "
        s = s & ltokens(i)
        If isKeyWord(tokens(i)) And Right(s, 1) <> " " Then s = s & " "
        If Right(s, 1) = "," Then s = s & " "
    Next
    DumpTokens = Trim(s)
End Function

Function Dump(a, b)
    Dim i, s
    s = ""
    i = a
    Do While i <= tkcount - 1 And tokens(i) <> b
        s = s & tokens(i) & " "
        i = i + 1
    Loop
    Dump = s
End Function

' Do_<Keyword> Subroutines - Code Production

Sub do_OPT
    Dim i, tmp, temp, tmp1, tmp2
    i = 1
    If tokens(0) = "REM" Then 
        i = 2
    Else
        If Not optOptKey Then
            tokerrpos i - 1
            errmsg tokens(i - 1) & " keyword ignored"
            Exit Sub
        End If
    End If
    If optSource > 1 Then Output Dumptokens()
    Do While i < tkcount
        Select Case tokens(i)
            Case "LINE"
                If tokens(i+1) = "+" Then
                    i = i + 1
                    tmp = 0 + ((linenum + tokens(i + 1)) \ tokens(i + 1)) * tokens(i + 1)
                Else
                    tmp = 0 + tokens(i + 1)
                End If
                If tmp <= linelst Then
                    errmsg "Warning - New line number < previous"
                End If
                linenum = tmp
                i = i + 1
            Case "INC"
                lineinc = 0 + tokens(i + 1)
                i = i + 1
            Case "LINELEN"
                optJoinLen = 0 + tokens(i + 1)
                i = i + 1
            Case "SOURCE"
                optSource = 0 + tokens(i + 1)
                i = i + 1
            Case "NOSOURCE"
                optSource = 0
            Case "COMMENTS"
                optComments = True
            Case "NOCOMMENTS"
                optComments = False
            Case "VBSCRIPT"
                optVBScript = True
            Case "NOVBSCRIPT"
                optVBScript = False
            Case "BLANKLINES"
                optBlankLns = True
            Case "NOBLANKLINES"
                optBlankLns = False
            Case "TRANS"
                optTranVars = True
            Case "NOTRANS"
                optTranVars = False
            Case "INDENT"
                optIndent = 0 + tokens(i + 1)
                i = i + 1
            Case "NOINDENT"
                optIndent = 0
            Case "REQSPACES"
                optReqSpaces = True
            Case "NOREQSPACES"
                optReqSpaces = False
            Case "PASS1"
                i = i + 1
                If tokens(i) = "SHOW" Then
                    optpass1 = 1
                ElseIf tokens(i) = "STOP" Then
                    optpass1 = 2
                ElseIf tokens(i) = "HIDE" Then
                    optpass1 = 0
                Else
                    optPass1 = 0 + tokens(i + 1)
                End If
            Case "SRCOPTS"
                optSrcOpts = True
            Case "NOSRCOPTS"
                optSrcOpts = False
            Case "INTEGER"
                optIntegers = True
            Case "FLOAT"
                optIntegers = False
            Case "JOIN"
                optJoin = True
            Case "NOJOIN"
                optJoin = False
            Case "SPLITIF"
                optSplitIF = True
            Case "NOSPLITIF"
                optSplitIF = False
            Case "LINENUM"
                optLineNums = True
            Case "NOLINENUM"
                optLineNums = False
            Case "OPTKEY"
                optOptKey = True
            Case "NOOPTKEY"
                optOptKey = False
            Case "COMPILE"
                optCompile = True
            Case "NOCOMPILE"
                optCompile = False
            Case "SPARSE"
                optSparse = True
            Case "TABLES"
                tmp = 0
                If i + 1 <= tkcount Then
                    If InStr(tokens(i+1), "R") Then tmp = tmp Or 16
                    If InStr(tokens(i+1), "E") Then tmp = tmp Or 8
                    If InStr(tokens(i+1), "M") Then tmp = tmp Or 4
                    If InStr(tokens(i+1), "V") Then tmp = tmp Or 2
                    If InStr(tokens(i+1), "L") Then tmp = tmp Or 1
                End If
                optTable = tmp
                i = i + 1
            Case "KEYS"
                Do While i + 1 < tkcount
                    i = i + 1
                    KeyList = KeyList & tokens(i) & " "
                Loop
            Case "FUNCS"
                Do While i + 1 < tkcount
                    i = i + 1
                    FunList = FunList & tokens(i) & " "
                Loop
            Case "OPERS"
                Do While i + 1 < tkcount
                    i = i + 1
                    OPList = OPList & tokens(i) & " "
                Loop
            Case "ESCDEF"
                i = i + 1
                Do While i < tkcount
                    tmp1 = tokens(i)
                    tmp2 = tmp1
                    i = i + 1
                    If i < tkcount Then
                        If tokens(i) = "=" Then
                            i = i + 1
                            If i < tkcount Then
                                tmp2 = tokens(i)
                                i = i + 1
                            Else
                                tokerrpos i
                                errmsg "OPT ESCDEF - expected definition"
                                Exit Do
                            End If
                        End If
                    End If
                    If dEscapes.Exists(tmp1) Then
                        tokerrpos i
                        errmsg "OPT ESCDEF - Escape Redefined: """ & tmp1 & """"
                    End If
                    If Left(tmp2, 1) = """" Then tmp2 = Mid(tmp2, 2, Len(tmp2) - 2)
                    If UCase(Left(tmp2, 2)) = "0X" Then
                        tmp2 = Chr(CInt("&H" & Mid(tmp2, 3)))
                    End If
                    dEscapes(tmp1) = tmp2
                    If tokens(i) = "," Then
                        i = i + 1 
                    Else
                        i = i - 1
                        Exit Do
                    End If
                Loop

            Case "DEFINE"
                i = i + 1
                Do While i < tkcount
                    tmp1 = tokens(i)
                    tmp2 = 1
                    i = i + 1
                    If i < tkcount Then
                        If tokens(i) = "=" Then
                            i = i + 1
                            If i < tkcount Then
                                tmp2 = tokens(i)
                                i = i + 1
                            Else
                                tokerrpos i
                                errmsg "OPT DEFINE - expected definition"
                                Exit Do
                            End If
                        End If
                    End If
                    If dMacros.Exists(tmp1) Then
                        tokerrpos i
                        errmsg "OPT DEFINE - Macro Redefined: """ & tmp1 & """"
                    End If
                    If Left(tmp2, 1) = """" Then tmp2 = Mid(tmp2, 2, Len(tmp2) - 2)
                    dMacros(tmp1) = tmp2
                    If tokens(i) = "," Then
                        i = i + 1 
                    Else
                        i = i - 1
                        Exit Do
                    End If
                Loop
            Case "VAR"
                i = i + 1
                Do While i + 2 < tkcount
                    tmp1 = tokens(i)
                    tmp2 = tokens(i+2)
                    If tokens(i + 1) <> "=" Then
                        tokerrpos i + 1
                        errmsg "OPT VAR - expected ""="", found: """ & tokens(i + 1) & """"
                        Exit Do
                    End If
                    If VarIdx(tmp1) <> -1 Then
                        tokerrpos i
                        errmsg "OPT VAR - Translation Redefined: """ & tmp1 & """"
                    End If
                    If Left(tmp2, 1) = """" Then tmp2 = Mid(tmp2, 2, Len(tmp2) - 2)
                    VarAdd tmp1, tmp2
                    i = i + 3
                    If tokens(i) = "," Then
                        i = i + 1 
                    Else
                        i = i - 1
                        Exit Do
                    End If
                Loop
            Case "ERRTHR"
                optErrThr = 0 + tokens(i + 1)
                i = i + 1
            Case "EXPRSP"
                ExprSp = tokens(i + 1)
                i = i + 1
            Case "ESCAPES"
                optEscapes = vbTrue
            Case "NOESCAPES"
                optEscapes = vbFalse
            Case "PRESERVE"
                optSaveVars = vbTrue
            Case "NOPRESERVE"
                optSaveVars = vbFalse
        Case Else
            TokErrPos i
            ErrMsg "Unknown OPT: """ & tokens(i) & """"
        End Select
        i = i + 1
    Loop
End Sub

Sub do_LABEL
    Flush
    ' add to symbol table
    If optSource > 0 Then Output "REM LABEL " & Tokens(1)
    LabelSet "[" & tokens(1) & "]", linenum
End Sub

Sub do_DO
    Flush
    If tkcount >= 2 and tokens(1) = "WHILE" Then
        do_WHILE
    ElseIf tkcount = 1 Then
        do_REPEAT
    Else
        errmsg "Unknown DO construct"
    End If
End Sub

Sub do_LOOP
    If tkcount >= 2 and tokens(1) = "UNTIL" Then
        do_UNTIL
    ElseIf tkcount = 1 Then
        do_WEND
    End If
End Sub

Sub do_WHILE
    Flush
    If optSource Then Output "REM " & DumpTokens()
    linetmp = linenum
    If tokens(1) = "WHILE" Then
        output "IF NOT " & Expression(2) & " THEN [_WEND" & linenum & "]"
    Else
        output "IF NOT " & Expression(1) & " THEN [_WEND" & linenum & "]"
    End If
    ctrlPush "WHILE", linetmp
End Sub

Sub do_WEND
    Flush
    If ctrlstk(ctrlptr) <> "WHILE" Then Errmsg "Unexpected " & tokens(0) & " " & dumpCtrlStk()
    ' check ctrl stack and get back ref
    CtrlPop
    If optSource > 1 Then Output "REM " & DumpTokens()
    Output "GOTO " & ctrllin(ctrlptr + 1)
    LabelSet "[_WEND" & ctrllin(ctrlptr + 1) & "]", linenum
    LabelSet "[_LEAVE" & ctrllin(ctrlptr + 1) & "]", linenum
End Sub

Sub do_REPEAT
    Flush
    ' add to symbol table / ctrl stack
    If optSource Then Output "REM " & DumpTokens()
    ctrlPush "REPEAT", linenum
End Sub

Sub do_UNTIL
    Flush
    ' check ctrl stack and get back ref
    If ctrlstk(ctrlptr) <> "REPEAT" Then Errmsg "Unexpected WEND"
    CtrlPop
    If optSource > 1 Then Output "REM " & DumpTokens()
    If tokens(1) = "UNTIL" Then
        Output "IF NOT " & Expression(2) & " THEN " & ctrllin(ctrlptr + 1)
    Else
        Output "IF NOT " & Expression(1) & " THEN " & ctrllin(ctrlptr + 1)
    End If
    LabelSet "[_LEAVE" & ctrllin(ctrlptr+1) & "]", linenum
End Sub

Sub do_LEAVE
    Dim i, f
    i = ctrlptr : f = 0
    Do
        f = InStr(" WHILE REPEAT DO ", ctrlstk(i))
        If f = 0 Then i = i - 1
    Loop Until f > 0 Or i < 0
    If f <> 0 Then
        Output "GOTO [_LEAVE" & ctrllin(i) & "]"
    Else
        Output "REM " & dumptokens()
        errmsg "No loop to LEAVE/EXIT"
    End If
End Sub

Sub do_CONTINUE
    Dim i, f
    i = ctrlptr : f = 0
    Do
        f = InStr(" WHILE REPEAT DO ", ctrlstk(i))
        If f = 0 Then i = i - 1
    Loop Until f > 0 Or i < 0
    If f <> 0 Then
        Output "GOTO " & ctrllin(i)
    Else
        Output "REM " & dumptokens()
        errmsg "No loop to CONTINUE"
    End If   
End Sub

Sub do_EXIT
    If tkcount = 1 Then Output "END"
    If InStr(" WHILE REPEAT DO ", " " & tokens(1) & " ") Then
        do_LEAVE
    End If
    If InStr(" FUNC FUNCTION ", " " & tokens(1) & " ") Then
        do_RETURN
    End If
    If tokens(1) = "SUB" Then
        do_RETURN                                               
    End If
End Sub

Sub do_GOSUB
    If tkcount > 2 Then errmsg "Expected End of Statement - Found: " & tokens(2)
    If optSource > 1 Then Output "REM " & Dumptokens()
    If toktyp(tkcount - 1) <> 6 Then
        Output "GOSUB " & "[" & tokens(tkcount - 1) & "]"
    Else
        Output "GOSUB " & tokens(tkcount - 1)
    End If
End Sub

Sub do_GOTO
    If optSource > 1 Then Output "REM " & Dumptokens()
    If toktyp(1) <> 6 Then
        Output "GOTO " & "[" & tokens(1) & "]"
    Else
        Output "GOTO " & tokens(1)
    End If
End Sub

Sub do_ON
    Dim n, i, s
    ' ON N GOTO/GOSUB
    ' For each symbol in list: lookup
    If optSource > 1 Then Output "REM " & Dumptokens()
    n = 1
    s = "ON " & Expression(n) & " " & tokens(n) & " "
    n = n + 1
    For i = n to tkcount - 1
        If tokens(i) <> "," Then
            If tokens(i - 1) <> "GOTO" and tokens(i - 1) <> "GOSUB" Then s = s & ", "
            If toktyp(i) <> 6 Then
                s = s & "[" & tokens(i) & "]"
            Else
                s = s & tokens(i)
            End If
        Else
        End If
    Next
    Output s
End Sub

Sub do_IF
    Dim n, e, r1, r2
    If tokens(tkcount - 1) = "THEN" Then
        Flush
        If optSource > 1 Then Output "REM " & Dumptokens()
        linetmp = linenum
        ' Output "IF NOT " & Expression(1) & " THEN [_NOTIF" & linenum & "]"
        Output "IF NOT " & AllExpressions(1, "THEN") & " THEN [_NOTIF" & linenum & "]"
        ctrlPush "IF", linetmp
    Else
        n = 1
        e = AllExpressions(n, "THEN")
        r1 = AllExpressions(n, "ELSE")
        r2 = AllExpressions(n, "")
        Output "IF " & e & " " & r1 & " " & r2
        ' Output AllExpressions(0, "")
    End If
End Sub

Sub do_ELSE
    Flush
    If ctrlstk(ctrlptr) <> "IF" And ctrlstk(ctrlptr) <> "ELSEIF" Then
        errmsg "Unexpected " & tokens(0) & ": " & DumpCtrlStk()
    End If
    Output "GOTO [_ENDIF" & ctrllin(ctrlptr) & "]"
    ctrlstk(ctrlptr) = ctrlstk(ctrlptr) & "*ELSE"
    If optSource Then OutputI "REM " & Dumptokens(), -1
    LabelSet "[_NOTIF" & ctrllin(ctrlptr) & "]", linenum
    If ctrlstk(ctrlptr) = "ELSEIF" Then
        CtrlPop
        goffset = goffset + 1
        LabelSet "[_ENDIF" & ctrllin(ctrlptr + 1) & "]", linenum
    End If
End Sub

Sub do_ELSEIF
    Dim tmplin
 
    Flush
    If ctrlstk(ctrlptr) <> "IF" And ctrlstk(ctrlptr) <> "ELSEIF" Then
        errmsg "Unexpected " & tokens(0) & ": " & DumpCtrlStk()
        WScript.WriteLine "*** Can't continue."
        WScript.Quit
    End If
 
    ' do_ELSE
    tmplin = ctrllin(ctrlptr)
 
    If ctrlstk(ctrlptr) = "IF" Then
        ctrlPush "ELSEIF", linenum
        goffset = goffset - 1
    Else
        ctrllin(ctrlptr) = linenum
    End If
 
    Output "GOTO [_ENDIF" & ctrllin(ctrlptr - 1) & "]"
 
    If optSource Then OutputI "REM " & Dumptokens(), -1
 
    ' LabelSet "[_NOTIF" & ctrllin(ctrlptr) & "]", linenum
    LabelSet "[_NOTIF" & tmplin & "]", linenum
    ' do_IF
    ctrllin(ctrlptr) = linenum
 
    OutputI "IF NOT " & Expression(1) & " THEN [_NOTIF" & linenum & "]", -1
End Sub

Sub do_ENDIF
    Flush
    If optSource Then OutputI "REM ENDIF", -1
    If Not InStr(" IF ELSEIF IF*ELSE ELSEIF*ELSE ", " " & ctrlStk(ctrlPtr) & " " ) > 0  Then
        errmsg "Unexpected ENDIF: " & DumpCtrlStk()
    End If
    If Left(ctrlstk(ctrlptr), 6)  = "ELSEIF" Then
        CtrlPop
        goffset = goffset + 1        
        LabelSet "[_ENDIF" & ctrllin(ctrlptr + 1) & "]", linenum
        If Right(ctrlstk(ctrlptr + 1), 5) <> "*ELSE" Then
            LabelSet "[_NOTIF" & ctrllin(ctrlptr + 1) & "]", linenum
        End If
        ctrlstk(ctrlptr) = ctrlstk(ctrlptr) & "*ELSE"
    End If
    CtrlPop
    ' If optSource Then Output "REM ENDIF"
    If Right(ctrlstk(ctrlptr + 1),5) <> "*ELSE" Then
        LabelSet "[_NOTIF" & ctrllin(ctrlptr + 1) & "]", linenum
    End If
    LabelSet "[_ENDIF" & ctrllin(ctrlptr + 1) & "]", linenum
End Sub

Sub do_FOR
    Output "FOR " & AllExpressions(1, "")
    ctrlPush "FOR", linenum
End Sub

Sub do_NEXT
    If ctrlstk(ctrlptr) <> "FOR" Then
        errmsg "Unexpected NEXT"
        ctrlPush "FOR", -1
    End If
    ' test for multiple ctrl variables
    CtrlPop
    Output "NEXT " & AllExpressions(1, "")
End Sub

Sub do_REM
    Dim bCCond, b, e
    Flush
    bCCond = (Left(CCond,1) = "1")

    Select Case tokens(1)
        Case "OPT"
            If optSrcOpts And bCCond  Then do_Opt
        Case "INCLUDE" 
            If bCCond Then
                If toktyp(2) <> 3 Then
                    tokerrpos 2
                    errmsg "Filename must be string literal - Found:" & tokens(2)
                Else
                    IncludeFile Mid(tokens(2), 2, Len(tokens(2)) - 2)
                    If Err.Number <> 0 Then 
                       errmsg "Include Error"
                    End If
                End If
                If optSource > 0 Then Output Dumptokens()
           End If
        Case "MACRO"
            If bCCond Then do_MACRO
        Case "RULE"
            If bCCond Then do_MACRO
        Case "DEFINE" 
            If bCCond Then
                If tkcount > 2 Then
                    dMacros(tokens(2)) = "1"
                    If tkcount > 3 Then
                        If tokens(3) <> "=" Then
                            tokerrpos 3
                            errmsg "DEFINE -- expected ""="", found """ & tokens(3) & """"
                        Else
                            If tkcount > 4 Then
                                dMacros(tokens(2)) = tokens(4)
                            Else
                                dMacros(tokens(2)) = ""
                            End If
                        End If
                    End If
                Else
                    tokerrpos 2
                    errmsg "DEFINE -- expected Name"           
                End If
                If optSource = 2Then Output Dumptokens()
           End If
        Case "UNDEF" 
            If bCCOnd Then
                If dMacros.Exists(tokens(2)) Then
                    dMacros.Remove(tokens(2))
                    If optSource = 2 Then Output Dumptokens()
                Else
                    tokerrpos 2
                    errmsg "UNDEF -- definition does not exist: """ & tokens(2) & """"
                End If
            End If
        Case "IF"
            e = allExpressions(2, "")
            On Error Resume Next
            b = Eval(e)
            If err.number <> 0 Then
                tokerrpos 2
                errmsg "IF -- error in expression"
            End If
            If b = vbTrue Then CCond = "1" & CCond Else CCond = "0" & CCond
            If optSource = 2 Then Output Dumptokens()
        Case "IFDEF"
            If dMacros.Exists(tokens(2)) Then CCond = "1" & CCond Else CCond = "0" & CCond
            If optSource = 2 Then Output Dumptokens()
        Case "IFNDEF"
            If dMacros.Exists(tokens(2)) Then CCond = "0" & CCond Else CCond = "1" & CCond
            If optSource = 2 Then Output Dumptokens()
        Case "ELSE"
            If Not bCCond Then CCond = "1" & Mid(CCond, 2) Else CCond = "0" & Mid(CCond, 2)
            If optSource = 2 Then Output Dumptokens()
        Case "ENDIF"
            CCond = Mid(CCond, 2)
            If optSource = 2 Then Output Dumptokens()
    Case Else
        If optComments And bCCond Then Output Dumptokens()
    End Select
End Sub

Sub do_DIM
    Dim i, s
    If insub > 0 Then
        If ctrlstk(ctrlptr) <> "SUB" And ctrlstk(ctrlptr) <> "FUNC" Then
            errmsg "DIM must appear at start of SUB/FUNCTION"
        End If
        Flush
        If optSource > 0 Then Output "REM " & DumpTokens()  
        AddLocalVars 1, ""
    Else
        For i = 1 to tkcount - 1
            If InStr(",()", tokens(i)) > 0 Or toktyp(i) = 2 Or toktyp(i) = 5 Then
                s = s & tokens(i)
            Else
                If toktyp(i) <> 1 Then
                    tokerrpos i
                    errmsg "Expected Identifier list - found: " & tokens(i)
                Else
                    If not isFunction(tokens(i)) And Not isKeyword(tokens(i)) And Not isVBKeyword(tokens(i)) Then
                        s = s & Transvar(tokens(i))
                    End If
                End If
            End If
        Next
        Output "DIM " & s
    End If
End Sub

Sub do_DATA
    Flush
    Output Dumptokens()
End Sub

Sub do_RESTORE
    If tkcount > 1 Then
        If toktyp(1) <> 6 Then
            Output "RESTORE " & " [" & tokens(1) & "]"
        Else
            Output "RESTORE " & tokens(1)      
        End If
    Else
        Output "RESTORE"
    End If
End Sub

Sub do_RESUME
    If tkcount > 1 Then
        If toktyp(1) <> 6 Then
            Output "RESUME " & "[" & tokens(1) & "]"
        Else
            Output "RESUME " & tokens(1)      
        End If
    Else
        Output "RESTORE"
    End If
End Sub

Sub do_CALL
' Data Stack is ZS() and ZS()$
' with stack pointers ZP and ZQ

    Dim nam, i, e, s, n0, n1, p, s0
    ' handle params
    If (tkcount = 2 And tokens(0) = "CALL") OR (tkcount = 1 AND tokens(0) <> "CALL") Then
        do_GOSUB
    Else
        If UCase(tokens(0)) = "CALL" Then i = 2 Else i = 1
        nam = tokens(i - 1)
        If tokens(i) = "(" Then
            tokerrpos i
            errmsg "do not use parentheses in Subroutine CALL"
        End If
        s = "": n0 = 0: n1 = 0
        Do While i < tkcount
            e = AllExpressions(i, ",")
            p = InStr(e, """") + InStr(e, "$")
            If p = 0 Then s0 = "ZS(ZP+" Else s0 = "ZS$(ZQ+"
            If InStr("(),", e) = 0 Then
                If s <> "" Then s = s & ":"
                If p = 0 Then
                    s = s & s0 & n0 & ")=" & e
                Else
                    s = s & s0 & n1 & ")=" & e
                End If
                If p = 0 Then n0 = n0 + 1 Else n1 = n1 + 1
                i = i + 1
            End If
        Loop
        VerifySubArgs nam, n0, n1
        s = s & ":ZP=ZP+" & n0
        If n1 > 0 Then s = s & ":ZQ=ZQ+" & n1
        Output s & ":GOSUB [" & nam & "]"
    End If
End Sub

Sub do_SUB
    Flush
    If ctrlptr <> 0 Then
        errmsg "SUB cannot be nested: " & DumpCtrlStk()
        ctrlptr = 0
    End If
    If optSource Then Output "REM " & DumpTokens()
    LabelSet "[" & tokens(1) & "]", linenum
    ctrlPush "SUB", linenum
    locNcnt = 0: locScnt = 0: parNcnt = 0: parScnt = 0
    If tkcount > 2 Then
        If tokens(2) = "(" Then
            AddLocalVars 3, ")"
        Else
            errmsg "Expected '('"
        End If
    End If
    insub = 1
    curproc = tokens(1)
End Sub

Sub AddLocalVars(i, tag)
    Dim v, n, b, stk, dv, oldlc, oln, ols
    oldlc = loccount: oln = locNcnt: ols = locScnt
    dv = "": stk = 0
    Do While i < tkcount
        If tokens(i) <> tag Then
            v = tokens(i)
           
            If stk > 0 Then
                dv = dv & v
                If v = ")" Then stk = stk - 1
            Else
                If toktyp(i) <> 1 Then
                    If v <> "," Then
                        If stk = 0 Then
                            errmsg "Expected Identifier - Found: " & v
                        Else
                            dv = dv & tokens(i)
                        End If
                    End If
                Else
                    If IsFunction(v) Or isKeyword(v) Then
                        tokerrpos i
                        errmsg "Warning - reserved word in DIM: " & v
                    Else
                        If i < tkcount - 1 and tokens(i + 1) = "(" Then
                            ' errmsg "Warning - Cannot dimension array as local: " & tokens(i)
                            dv = dv & tokens(i) & "("
                            'dv = dv & transvar(tokens(i)) & "("
                            i = i + 1
                            stk = stk + 1
                        Else
                            If LocalIdx(v) <> -1 Then
                                tokerrpos i
                                errmsg "Local variable redefined: """ & v & """"
                            End If
                            locals(loccount) = v
                            If Right(v, 1) <> "$" Then
                                locidx(loccount) = parNcnt + locNcnt
                                If insub > 0 Then
                                    locNcnt = locNcnt + 1
                                Else
                                    parNcnt = parNcnt + 1
                                End If
                            Else
                                locidx(loccount) = parScnt + locScnt
                                If insub > 0 Then
                                    locScnt = locScnt + 1
                                Else
                                    parScnt = parScnt + 1
                                End If
                            End If
                            loccount = loccount + 1
                        End If
                    End If
                End If
            End If
            i = i + 1
        Else
            Exit Do
        End If
    Loop
    If stk <> 0 Then
        WScript.Stderr.WriteLine Dump(0,"")
        WScript.Stderr.WriteLine String(Len(Dump(0,"")) - Len(Dump(i,"")), " ") & "^"
        errmsg "Mismatched Parentheses - " & stk
    End If
    If dv <> "" Then dv = ":DIM " & dv
    If oldlc <> loccount Then
        If locScnt - ols > 0 Then dv = ":ZQ=ZQ+" & locScnt - ols & dv
        If locNcnt - oln > 0 Then dv = ":ZP=ZP+" & locNcnt - oln & dv
    End If
    If Left(dv,1) = ":" Then dv = Mid(dv,2)
    If dv <> "" Then Output dv

End Sub

Sub do_ENDSUB
    Dim s
 
    If ctrlstk(ctrlptr) <> "SUB" Then errmsg "Unexpected ENDSUB"
    CtrlPop
    If optSource > 1 Then Output "REM ENDSUB"

    LabelSet "[" & "_ENDSUB_" & curproc & "]", linenum
        
    If parNcnt + locNcnt > 0 Then s = "ZP=ZP-" & parNcnt + locNcnt & ":"
    If parScnt + locScnt > 0 Then s = s & "ZQ=ZQ-" & parScnt + locScnt & ":"
    Output s & "RETURN"
    loccount = 0
    insub = 0
    curproc = ""

End Sub

Sub do_FUNC
    If ctrlptr <> 0 Then
        errmsg "FUNC cannot be nested: " & dumpCtrlStk
        ctrlptr = 0
    End If
  
    curproc = tokens(1)
    If optSource Then Output "REM " & Dumptokens()
    LabelSet "[" & tokens(1) & "]", linenum
    ctrlPush "FUNC", linenum
    parNcnt = 0: parScnt = 0: locNcnt = 0: locSCnt = 0
    AddLocalVars 3, ")"
    insub = 2
End Sub

Sub do_ENDFUNC
    Dim s
    If ctrlstk(ctrlptr) <> "FUNC" Then errmsg "Unexpected ENDFUNC"
    CtrlPop
    If optSource > 1 Then Output "REM ENDFUNC"
 
    LabelSet "[" & "_ENDFUNC_" & curproc & "]", linenum
 
    If locNcnt + parNcnt > 0 Then s = "ZP=ZP-" & (locNcnt + parNcnt)
    If s <> "" And parScnt + locScnt <> 0 Then s = s & ":"
    If parScnt + locScnt > 0 Then s = s & "ZQ=ZQ-" & (parScnt + locScnt)
    If s <> "" Then s = s & ":"
    Output s & "RETURN"
    loccount = 0
    insub = 0
    curproc = ""
End Sub

Sub do_END
    If tkcount > 1 Then
        If tokens(1) = "SUB" Then
            do_ENDSUB
        ElseIf tokens(1) = "FUNC" or tokens(1) = "FUNCTION" Then
            do_ENDFUNC
        ElseIf tokens(1) = "IF" Then
            do_ENDIF
        ElseIf tokens(1) = "SELECT" Then
            Do_ENDSELECT
        ElseIf tokens(1) = "WHILE" Then
            Do_WEND
        Else
            Output Dumptokens()
        End If
    Else
        Output Dumptokens()
    End If
End Sub

Sub do_SELECT
    Flush
    If optSource Then Output "REM " & Dumptokens()
    ctrlvar = Trim(tokens(2) & " " & ctrlvar)
    ctrlPush "SELECT", linenum
End Sub

Sub Do_CASE
    If ctrlstk(ctrlptr) <> "SELECT" And ctrlstk(ctrlptr) <> "CASE" Then errmsg "Unexpected CASE"    
    If ctrlstk(ctrlptr) = "CASE" Then
        ' resolve open CASE
        Output "GOTO [_ENDSELECT_" & ctrllin(ctrlptr - 1) & "]"
        LabelSet "[_ENDCASE_" & ctrllin(ctrlptr) & "]", linenum
        CtrlPop
    End If
    CtrlPush "CASE", linenum
    If tokens(1) <> "ELSE" Then
        If tkcount = 2 or toktyp(1) = 7 Then
            If optTranVars Then
                OutputI "IF NOT " & transvar(split(ctrlvar," ",2)(0)) & " = "  & expression(1) & " THEN [_ENDCASE_" & ctrllin(ctrlptr) & "]", -1
            Else
                OutputI "IF NOT " & ctrlvar & " = "  & expression(1) & " THEN [_ENDCASE_" & ctrllin(ctrlptr) & "]", -1
            End If
        Else
            OutputI "IF NOT " & expression(1) & " THEN [_ENDCASE_" & ctrllin(ctrlptr) & "]", -1
        End If
    Else
        If optSource Then OutputI "REM DEFAULT CASE", -1
    End If
End Sub

Sub do_ENDSELECT
    If ctrlstk(ctrlptr) <> "SELECT" And ctrlstk(ctrlptr - 1) <> "SELECT" Then errmsg "Unexpected ENDSELECT"
    If ctrlstk(ctrlptr) = "CASE" Then
        LabelSet "[_ENDCASE_" & ctrllin(ctrlptr) & "]", linenum
        CtrlPop
    End If
    CtrlPop
    If optSource Then Output "REM END SELECT"
    LabelSet "[_ENDSELECT_" & ctrllin(ctrlptr + 1) & "]", linenum
    If Instr(ctrlvar, " ") Then ctrlvar = split(ctrlvar," ",2)(1) Else ctrlvar = ""
End Sub

Sub do_RETURN
    Dim e, i, ptyp
  
    i = 0: ptyp = ""
    Do While ctrlptr - i >= 0
        If ctrlstk(ctrlptr - i) = "SUB" Or ctrlstk(ctrlptr - i) = "FUNC" Then
            ptyp = ctrlstk(ctrlptr - i)
            Exit Do
        End If
        i = i + 1
    Loop
    If ptyp = "" Then
        Output Dumptokens()
    ElseIf ptyp = "FUNC" Then
        i = 1
        e = AllExpressions(i, "")
        If Right(curproc, 1) = "$" Then
            Output "ZS$(ZQ-" & locScnt + parScnt + 1 & ") = " & e & ": GOTO [_ENDFUNC_" & curproc & "]"
        Else
            Output "ZS(ZP-" & locNcnt + parNcnt + 1 & ") = " & e & ": GOTO [_ENDFUNC_" & curproc & "]"
        End If
    ElseIf ptyp = "SUB" Then
        Output "GOTO [_ENDSUB_" & curproc & "]"
    Else
        errmsg "RETURN - Error in control frame"
    End If
End Sub

Sub do_MACRO
    Dim mtype, mname, i, flag, pname, mbody
    Dim params, mparams, moper, mpopers
    Dim tmptr, value

    i = 0
    If tokens(0) = "REM" or tokens(0) = "#" Then i = 1
    If optSource > 1 Then Output "REM " & Dump(i, "")
   
    params = "": mparams = "": mpopers = ""
    mtype = tokens(i)
    i = i + 1
    mname = tokens(i)
    If toktyp(i) <> 1 Then
        tokerrpos i        
        errmsg "MACRO - expected macro name, found " & mname
    End If
    If mtype = "DEF" Then 
        If mname = "FN" Then
            If i < tkcount Then
                If toktyp(i + 1) = 1 Then
                    i = i + 1
                    mname = "FN" & tokens(i)
                Else
                    errmsg "DEF - expected FN name, Found """ & tokens(i) & """"
                End If
            Else
                errmsg "DEF - missing FN name"
            End If
        Else
            If left(mname, 2) <> "FN" Then
                errmsg "DEF - FN name needs to begin with ""FN"""
            End If
        End If
    End If
       
    i = i + 1
    If tokens(i) = "(" And i < tkcount Then
        flag = 0
        Do While tokens(i) <> ")"
            i = i + 1
            If tokens(i) <> "," Then
                If toktyp(i) <> 1 OR isKeyWord(tokens(i)) Or isFunction(tokens(i)) Then
                    tokerrpos i
                    errmsg "Expected parametr name, found """ & Tokens(i) & """"
                    Exit Do
                Else
                    If params <> "" Then params = params & ","
                    params = params & tokens(i)
                End If
                i = i + 1
            End If
        Loop
        i = i + 1
    End If

    Do While Tokens(i) <> "=" And i < tkcount
        If mtype = "RULE" and mpopers = "" Then
            If Left(tokens(i), 1) <> """" Then
                tokerrpos 1
                errmsg "RULE - Expected quoted regular expression, found: """ & tokens(i) & """"
            End If
        End If
        If toktyp(i) = 1 Then
            ' Inline parameter name
            moper = "_MBT_"
            If Not (isKeyWord(tokens(i)) Or isFunction(tokens(i))) Then
                If mparams <> "" Then mparams = mparams & ","
                mparams = mparams & tokens(i)
            Else
                errmsg "MACRO - Expected inline parameter name, Found """ & Tokens(i) & """"
                Exit Do
            End If
            If mpopers <> "" Then mpopers = mpopers & " " & moper Else mpopers = moper
        ElseIf tokens(i) = "^" Then
            ' Null - parses and discards inline param
            moper = "_MBT_"
            If mparams <> "" Then mparams = mparams & ","
            mparams = mparams & "__MBRNUL__"
            If mpopers <> "" Then mpopers = mpopers & " " & moper Else mpopers = moper
        Else
            If Left(tokens(i),1) = """" Then
                ' moper = Mid(tokens(i), 2, Len(tokens(i)) - 2)
                moper = Replace(tokens(i), " ", "~")
            ElseIf tokens(i) = "*" Then
                If Right(mpopers, 5) <> "_MBT_" Then
                    tokerrpos i
                    errmsg "MACRO - ""*"" specifier must follow an identifier"
                    Exit Do
                Else
                    moper = "*"
                    mpopers = Left(mpopers, Len(mpopers) - 5) & "_MBX_"
                End If
            ElseIf tokens(i) = "%" Then
                If Right(mpopers, 5) <> "_MBT_" Then
                    tokerrpos i
                    errmsg "MACRO - ""%"" specifier must follow an identifier"
                    Exit Do
                Else
                    moper = "%"
                    mpopers = Left(mpopers, Len(mpopers) - 5) & "_MBF_"
                End If
            Else
                moper = tokens(i)
            End If
            If moper <> "*" and moper <> "%" Then
                If Left(moper, 1) = """" Then moper = Mid(moper, 2, Len(moper) - 2)
                If mpopers <> "" Then mpopers = mpopers & " "
                mpopers = mpopers & moper
            End If
        End If

        i = i + 1
    Loop

    params = split(params, ",")
    mparams = split(mparams, ",")
    
    If Tokens(i) <> "=" Then
        errmsg mtype & " - expected ""="", found """ & tokens(i) & """"
        tokerrpos i
    Else
        i = i + 1
        tmptr = optTranVars
        optTranVars = False
        mbody = AllExpressions(i, "")
        i = tkcount
        optTranVars = tmptr
    End If
      
    If mtype <> "CONST" Then
        For i = 0 to UBound(params)
            pname = "_PARAM_" & CStr(i + 1) & "_"
            mbody = ReReplace(mbody, "\b" & params(i) & "\b" , pname)
        Next
    Else
        If UBound(mparams) <> -1 Then errmsg "CONST: Parameters ignored"
    End If

    mbody = ReReplace(mbody, "\$0", mname)
    For i = 0 to UBound(mparams)
        pname = "_MBRTOK_" & CStr(i + 1) & "_"
        mbody = ReReplace(mbody, "\b" & mparams(i) & "\b", pname)
    Next

    mBody = "[[[" & Trim(UBound(params) + 1 & " " & mpopers) & "]]]" & mbody
        
    If mtype = "RULE" Then
        ' rules will be tested in order against each line
        mname = "@RULE_" & mname
        aRules.Add mname
    End If

    If mtype = "DEF" And optSimDef = 0 Then
        ' if destination supports DEF FN then pass through
        Output Dumptokens()
    Else
        ' MACRO or simulate DEF FN as macro
        If dMacros.Exists(mname) Then errmsg "Warning - " & mtype & " redefined: " & mname
        ' dMacros(mname) = Replace(Trim(mbody),"||", "")
        dMacros(mname) = Trim(mbody)
        If mtype = "CONST" Then
            err.clear
            On Error Resume Next
            value = eval(dMacros(mname))
            If err.Number <> 0 Then
                tokerrpos 3
                errmsg mtype & " - error in expression: " & mbody & vbCRLF _
                & "*** Error " & err.number & " - " & err.description
            Else
                dMacros(mname) = value
            End If
            On Error GoTo 0
        End If
    End If
End Sub

' Short syntax for using regular expression replace
Function reReplace(sSrc, sPat, sTxt)
    Dim re
 
    Set re = New RegExp
 
    re.Pattern = sPat
    re.IgnoreCase = True
    re.Global = True
 
    On Error Resume Next
    reReplace = re.Replace(sSrc, sTxt)
 
    If Err.Number <> 0 Then
        errmsg "REGEXP - Function ""ReReplace"" - RegExp Format Error: " & sPat
        WScript.StdError.WriteLine "*** Can't Continue"
        WScript.Quit
    End If
 
    On Error GoTo 0
End Function

' Short syntax for using regular expression test
Function reTest(sSrc, sPat)
    Dim re
 
    Set re = New RegExp
 
    re.Pattern = sPat
    re.IgnoreCase = True
    re.Global = True
 
    reTest = vbFalse
    On Error Resume Next
    ' reTest = re.Test(sSrc)
    Set reMatches = re.Execute(sSrc)
 
    If Err.Number <> 0 Then
        errmsg "REGEXP - Function ReTest - RegExp Format Error: " & sPat
        WScript.StdErr.WriteLine "*** Can't Continue"
        WScript.Quit
    End If
    
    reTest = reMatches.Count > 0
    On Error GoTo 0
End Function

' Function for use by MACRO Evaluation
Function IFELSE(expr,Text1,Text2)
    Dim cond
    
    On Error Resume Next
    cond = Eval(expr)
    If err.Number <> 0 Then
        errmsg "IFELSE - error evaluating expression: " & expr & vbCRLF _
        & "    " & err.number & " - " & err.description
    End If
    On Error GoTo 0 
    If cond = vbTrue Then IFELSE = Text1 Else IFELSE = Text2
End Function

' Stacks / Symbol Tables
Sub CtrlPush(tok, lin)
    ctrlptr = ctrlptr + 1
    ctrlstk(ctrlptr) = tok
    ctrllin(ctrlptr) = lin
End Sub

Sub CtrlPop
    ctrlptr = ctrlptr - 1
End Sub

Function DumpCtrlStk
    Dim s, i
    For i = 1 to ctrlptr
        If s <> "" Then s = s & " "
        s = s & ctrlstk(i)
    Next
    DumpCtrlStk = s
End Function

Sub LabelAdd(sName, iDst)
    llabel(labcount) = sName
    labdst(labcount) = iDst
    labcount = labcount + 1
End Sub

Function LabelName(iNum)
    Dim i, idx
    i = 0: idx = -1
    Do While i < labcount
        If labdst(i) = iNum Then
            idx = i
            Exit Do
        End If
        i = i + 1
    Loop
    LabelName = ""
    If idx <> -1 Then LabelName = llabel(idx)
End Function

Function LabelIdx(sName)
    Dim i
    LabelIdx = -1
    i = 0
    Do While i < labcount
        If llabel(i) = sName Then
            LabelIdx = i
            Exit Do
        End If
        i = i + 1
    Loop
End Function

Sub LabelSet(sName, iDst)
    Dim idx
    idx = LabelIdx(sName)
    If idx = -1 Then
        LabelAdd sName, iDst
    Else
        llabel(idx) = sName
        labdst(idx) = iDst
    End If
End Sub

Sub VarAdd(sName, sTran)
    vars(varcount) = sName
    vartran(varcount) = sTran
    varcount = varcount + 1
End Sub

Function VarIdx(sName)
    Dim i
    VarIdx = -1
    i = 0
    Do While i < varcount
        If vars(i) = sName Then
            VarIdx = i
            Exit Do
        End If
        i = i + 1
    Loop
End Function

Function LocalIdx(sName)
    Dim i
    LocalIdx = -1
    i = 0
    Do While i < loccount
        If locals(i) = sName Then
            LocalIdx = i
            Exit Do
        End If
        i = i + 1
    Loop
End Function

Function TransVar(sName)
    Dim sIdent, sType, sCont, f, c1, c2, a, v, lv, idx, sti, fglobal
    sIdent = sName
    sType = ""
    ' Preserve Type Specifier if used
    If InStr("$#%!", Right(sName, 1)) > 0 Then
        sIdent = Left(sName, Len(sName) - 1)
        sType = Right(sName, 1)
    End If
    ' Check for Global variable
    lv = -1
    If insub <> 0 Then lv = LocalIdx(sName)
    If insub <> 0 And lv <> -1 Then
        If Right(sName, 1) =  "$" And sName = curproc And inSub > 1 Then
            idx = parScnt + locScnt + 1
            v = "ZS$(ZQ-" & idx & ")"
            TransVar = v
        ElseIf sName = curproc And inSub > 1 Then
            idx = parNcnt + locNcnt + 1
            v = "ZS(ZP-" & idx & ")"
            TransVar = v
        ElseIf Right(sName, 1) =  "$" Then
            idx = parScnt + locScnt - locidx(lv)
            v = "ZS$(ZQ-" & idx & ")"
            TransVar = v
        Else
            idx = parNcnt + locNcnt - locidx(lv)
            v = "ZS(ZP-" & idx & ")"
            TransVar = v
        End If
    Else
        f = VarIdx(sName)
        If f <> -1 Then
            v = vartran(f)
            TransVar = v
        ElseIf Left(sIdent, 1) = "_" Then
            v = sIdent
            Transvar = v
        Else
            If Len(sIdent) <= 2 Then  ' Changing from <= 2 to <=1 may resolve overwriting on 2 char varnames
                v = sIdent & sType
                TransVar = v
                VarAdd sName, v
            Else
                ' use first letter and then 0-9 and A-Z in sequence
                c1 = Left(sName, 1)
                a = Asc(c1) - 65
                c2 = Chr(48 + vartbl(a) - 7 * (vartbl(a) > 9))
                If c2 <= "Z" And c1 <> "Z" Then
                    v = c1 & c2
                    If isKeyword(v) or VarIdx(v) <> -1 Then
                        ' 2 letter combination is reserved word (DO IF ON etc ...)
                        vartbl(a) = vartbl(a) + 1 'skip
                        a = Asc("Z") - 65
                        v = "ZV" & sType & "(" & 0 + vartbl(a) & ")"
                        vartbl(a) = vartbl(a) + 1
                    Else
                        vartbl(a) = vartbl(a) + 1
                        v = v & sType
                    End If
                Else
                    a = Asc("Z") - 65
                    v = "ZV" & sType & "(" & 0 + vartbl(a) & ")"
                    vartbl(a) = vartbl(a) + 1
                End If
                VarAdd sName, v
                TransVar = v
            End If
        End If
    End If
    If optSaveVars And UCase(Left(sIdent, 2)) <> Left(v, 2) Then
        If Left(v, 1) = "Z" or Left(v, 1) <> Left(sIdent,1) Then
            v = Left(v,2) & sIdent & Mid(v, 3)
        Else
            v = Left(v,2) & Mid(sIdent,2) & Mid(v, 3)
        End If
        Transvar = v
    End If
End Function

' Error Routines
Sub ErrPos(code, p)
    ' Error in code text at position p
    WScript.StdErr.WriteLine ""
    WScript.StdErr.WriteLine code
    WScript.StdErr.WriteLine String(p - 2, " ") & "^"
End Sub

Sub TokErrPos(p)
    ' Error in tokenized line at token p
   
    Dim text
    text = Dump(0, "")
    WScript.StdErr.Writeline
    WScript.StdErr.Writeline text
    WScript.StdErr.Writeline String(Len(text) - Len(Dump(p,"")), " ") & "^"

End Sub

Sub ErrMsg( text )
    WScript.StdErr.WriteLine "*** Error Line " & iCurLine & " - " & text
    errcount = errcount + 1
    If errcount >= optErrThr And optErrThr > -1 Then
        WScript.Quit
    End If
End Sub