'  gBasic.bas alpha version 0.1
'  Project Origination Date:01/24/11
'
' ========== Display Copyright ==========
    PRINT "\n"
    PRINT " Copyright: Generic Basic Translator, gBasic \n"
    PRINT " gBasic.bas (c) s.arbayo, 2011 \n"
    PRINT " alpha version 0.1 (c) s.arbayo \n"
    PRINT " gBasic.bas: Basic to C translator \n"
    PRINT "...display software license information: \n"
    PRINT "...display code contributor information: \n"

' ----------------------------------------------
' ========== Declare Global Constants ==========
' ----------------------------------------------
    Const BUFSIZE = 256
    Const TOKENLEN = 21
    Const VARNAME = 33
    Const LLEN = 33
    Const IOARRAY = 99
    Const PATH = 129
    Const RECLEN = 128
    Const bTRUE = 1
    Const bFALSE = 0

' ========== Declare Global Returns ==========
' ----------------------------------------------
    ireturn = 0
    lreturn = 0
    dreturn = 0
    sreturn$ = ""
    rvarName$ = ""

' ----------------------------------------------
' ========== Declare Global Integers ==========
' ----------------------------------------------
    pii = 0
    ilen = 0
    ix = 0
    nrows = 0
    ncolumns = BUFSIZE
    epos = 0
    spos = 0
    lineNdx = 0
    token = 0
    VarNdxCnt = 0
    ObjNdxCnt = 0

' ========== Declare Global Strings ==========
' ----------------------------------------------
    SourceFile$ = ""
    SourceTmp$ = ""
    pstring$ = ""
    xstring$ = ""
    sHolder$ = ""
    tHolder$ = ""

' ========== Declare Global Arrays ==========
' ----------------------------------------------
    array1$[1] = ""
    labelNam$[1] = ""
    tempProg$[1] = ""
    tempLabel$[1] = ""
    byteArray[1] = 0
    tempByte[1] = 0
    ObjType[1, 2] = 0
    ObjIndx$[1] = ""
    VarIndx$[1] = ""
    ForArray$[1] = ""
    labelEndif$[1] = ""
    labelBlock$[1] = ""
    labelElseif$[1] = ""
    labelElse$[1] = ""
    WhileArray$[1] = ""
    LoopArray$[1] = ""
    BreakArray$[1] = ""

' ========== Declare Dynamic Arrays ==========
' ----------------------------------------------
    ArryNdx$[1] = ""
    ArryParams[1] = 0

' ========== Declare File I/O Structures ==========
' ----------------------------------------------

' ========== Declare Global Flags ==========
' ----------------------------------------------

' ========== Declare File Names ==========
' ----------------------------------------------
    SourceFile$ = ""
    SourceTmp$ = "source.tmp"
    FinalTmp$ = "final.tmp"
    Destin$ = ""

'
' ===========================================
' ===========================================
' Start of Program
    CALL Main()
'                       diagnostic: dump C source file to console.
    CALL DumpIt()
'
' ------------------------------------------
TheEnd:
    END
' ------------------------------------------
' ===========================================
'
' ===========================================
SUB Main
'                               Sub "Main" controls progam execution.
    CALL LineCnt()
    CALL Header()
    CALL pgmParser()
    CALL Epilog()
    CALL clrArrays()
'
    CLOSE 2
'
END SUB
' ------------------------------------------
' ===========================================
'
' ===========================================
SUB pgmParser
    lineNdx = 1
'                               Sub "pgmParser" increments thru each program line.
'                               After each call, the line index is incremented.
    WHILE lineNdx <= nrows
        spos = 1
        epos = 1
        CALL getToken()
        CALL parser()
        lineNdx = lineNdx + 1
    WEND
'
END SUB
' ===========================================
'
' ===========================================
SUB getToken
'                               Sub "getToken" loads pstring$ with the current program line
'                               and integer token holds the current byte-code.
    pstring$ = array1$[lineNdx]
    token = byteArray[lineNdx]
'
END SUB
' ===========================================
'
' ===========================================
SUB parser
    LOCAL y
    LOCAL code
    LOCAL xx
'
    y = -1
    code = 0
    xx = lineNdx
'                               Sub "parser" calls each routine, based on the value of "token".
'                               In the event that a token is not valid, program execution
'                               is terminated.
    IF token <> y THEN
        CALL numLabel()
    END IF
'
    IF token = 1 THEN
        CALL doLet()
    ELSE IF token = 4 THEN
        CALL doPrint()
    ELSE IF token = 8 THEN
        CALL doEnd()
'
'
    ELSE IF token = -1 THEN
        CALL doLabel()
    ELSE
        CALL Abort(code, xx)
    END IF
END SUB
' ===========================================
'
' ===========================================
SUB numLabel
    LOCAL ch$
    LOCAL label$
    LOCAL temp$
    LOCAL isdigit
'                               Sub "numLabel" transforms a line number into a valid label.
'                               This function is not operational at this time.
    temp$ = labelNam$[lineNdx]
    ch$ = MID$(temp$, 1, 1)
    CALL isadigit(ch$)
    isdigit = ireturn
'
    IF isdigit = bTRUE THEN
        label$ = "L"
        label$ = label$ & temp$
        CALL PostLabel(label$)
    END IF
END SUB
' ===========================================
' ===========================================
'
' -------------------------------------------
' =========== INPUT: Sub Routines ==========
'
' ==========================================
'
SUB LineCnt
    LOCAL code
    LOCAL xx
    code = 1
    xx = 0
'                               Sub "LineCnt" begins by determining the size of the source 
'                               file. Then reads the source file into a series of arrays 
'                               for processing. The source file name is arrived at by use 
'                               of function "COMMAND".
    SourceFile$ = COMMAND()
    IF SourceFile$ = "" THEN
        PRINT "\n"
        CALL Abort(code, xx)
    END IF
'                               In the event that no source file name was entered, program
'                               execution is terminated with an error message.
    ON ERROR GOTO BadName
    OPEN SourceFile$ FOR INPUT AS #1
'                --- did file open okay ? ---
    GOTO OkName
'
BadName:
    code = 2
    PRINT "\n"
    CALL Abort(code, xx)
'                               In the event that the source file, as given, was not found,
'                               program execution is terminated with an error message.
OkName:
    CALL LoadSrc()
    CALL Loader1()
    CALL Loader2()
'
'                               --- dump program arrays to file ---
    OPEN FinalTmp$ FOR OUTPUT AS #1
    ii = 0
    FOR ii = 1 TO nrows
        x = byteArray[ii]
        xstring$ = STR$(x)
        xstring$ = xstring$ & CHR$(9) & array1$[ii]
        PRINT #1, xstring$
'        PRINT xstring$
    NEXT ii
    CLOSE 1
'
END SUB
' ==========================================
'
' ==========================================
SUB LoadSrc
'                               SUB "LoadSrc" reads each line of source text, skipping blank 
'                               lines, ' (apostrophe) comment lines and strips all 
'                               indentations. 
    OPEN SourceTmp$ FOR OUTPUT AS #2
Start:
    IF EOF(1) THEN
        GOTO Finish
    END IF
'
    LINE INPUT #1, pstring$
'
    IF pstring$ = "" THEN
        GOTO Start
    END IF
'
    pii = 1
    CALL iswhite()
    ilen = LEN(pstring$)
'                                   Save line of source code to file.
    IF ilen > 2 AND pii < ilen THEN
        CALL SaveTemp()
    END IF
    GOTO Start
Finish:
    CLOSE 2
    CLOSE 1
END SUB
' ==========================================
'
' ==========================================
SUB Loader1
    LOCAL ch$
    LOCAL lnHolder$
    LOCAL ii
    ii = 1
'                               Sub "Loader1" tokenizes source file keywords.
'                               --- open source.tmp for read ---
    OPEN SourceTmp$ FOR INPUT AS #1
Start1:
    IF EOF(1) THEN
        GOTO Finish1
    END IF
    LINE INPUT #1, pstring$
'
    IF pstring$ = "" THEN
        GOTO Start1
    END IF
'                               Store block label addresses to array.
    CALL tmpLabel(ii)
    pii = epos
    ch$ = MID$(pstring$, pii, 1)
'
    IF ch$ = ":" THEN
        tempByte[ii] = -1
        tempProg$[ii] = "\n"
    ELSE
        CALL tmpByte(ii)
        CALL tmpProg(ii)
    END IF
    ii = ii + 1
    GOTO Start1
Finish1:
    CLOSE 1
'
END SUB
' ==========================================
'
' ==========================================
SUB Loader2
    LOCAL ndx
    LOCAL ii
    ndx = 0
    ii = 0
'                                   Sub "Loader2" tokenizes character string functions.
'                                   --- re-count number of lines ---
    FOR ndx = 1 TO nrows STEP 1
'                                   --- LET ---   tokenize string expression
        IF tempByte[ndx] = 1 THEN
            CALL strFunction(ndx)
'                                   --- PRINT --- tokenize string functions
        ELSE IF tempByte[ndx] = 4 THEN
            CALL strFunction2(ndx)
        END IF
    NEXT ndx
'                                   --- transfer temp_arrays to program arrays ---
    ndx = 0
    FOR ii = 1 TO nrows STEP 1
        IF tempByte[ii] <> 0 THEN
            ndx = ndx + 1
            labelNam$[ndx] = tempLabel$[ii]
            byteArray[ndx] = tempByte[ii]
            array1$[ndx] = tempProg$[ii]
        END IF
    NEXT ii
    nrows = ndx
'                                   --- free temp array memory ---
    CALL clrtmpArrays()
'
END SUB
' ==========================================
'
' ==========================================
SUB strFunction2(ndx)
    LOCAL ch$
    LOCAL temp$
    LOCAL quote$
    LOCAL xpi
    LOCAL chx
    LOCAL isupper
    LOCAL punct
    LOCAL vars
    LOCAL ops
'
    pstring$ = tempProg$[ndx]
    pii = 1
    ilen = LEN(pstring$)
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
    quote$ = CHR$(34)
'                               --- loop ---
    WHILE pii < ilen AND chx <> 13
        xpi = pii
        CALL isThisUpper()
        isupper = ireturn
'                               --- skip over quoted strings ---
        IF ch$ = quote$ THEN
            CALL getQuote()
            CALL iswhite()
        ELSE IF isupper = bTRUE THEN
'                               This would represent a String or Math Function.
            IF pii < ilen THEN
                epos = pii
                CALL getVarname()
                temp$ = rvarName$
                spos = epos
                ch$ = MID$(pstring$, spos, 1)
'
                IF ch$ = "$" THEN
                    epos = pii
                    CALL getStrFunc(temp$, ndx)
                ELSE
                    epos = pii
                    CALL getMathFunc(temp$, ndx)
                END IF
                ilen = LEN(pstring$)
                pii = epos
                CALL getParen()
                pii = pii + 1
                CALL getParen()
                epos = pii
            END IF
        ELSE
            CALL whileIsAlnum()
        END IF
        IF pii = xpi THEN
            pii = pii + 1
        END IF
'
        ilen = LEN(pstring$)
        ch$ = MID$(pstring$, pii, 1)
        temp$ = ":; ,)("
        CALL inStrChr(temp$, ch$)
        punct = ireturn
'
        temp$ = "$%!#@&"
        CALL inStrChr(temp$, ch$)
        vars = ireturn
'
        temp$ = "+-*/^"
        CALL inStrChr(temp$, ch$)
        ops = ireturn
'
        IF punct <> bFALSE THEN
            CALL getRightExp()
            ch$ = MID$(pstring$, pii, 1)
        ELSE IF vars <> bFALSE THEN
            CALL getRightExp()
            ch$ = MID$(pstring$, pii, 1)
        ELSE IF ops <> bFALSE THEN
            CALL getRightExp()
            ch$ = MID$(pstring$, pii, 1)
        END IF
        chx = ASC(ch$)
    WEND
END SUB
' ==========================================
'
' ==========================================
SUB strFunction(ndx)
    LOCAL ch$
    LOCAL temp$
    LOCAL xpi
'
    pii = 1
    pstring$ = tempProg$[ndx]
    ireturn = 0
'
    WHILE ireturn = 0
        CALL isEqu()
        pii = epos
        pii = pii + 1
    WEND
    pii = epos
    ilen = LEN(pstring$)
'                               --- loop ---
    WHILE pii < ilen
        CALL getUpper()
        pii = ireturn
        xpi = pii
'
        IF pii < ilen THEN
            epos = pii
            CALL getVarname()
            temp$ = rvarName$
            spos = epos
            pii = xpi
            ch$ = MID$(pstring$, spos, 1)
'
            IF ch$ = "$" THEN
                epos = pii
                CALL getStrFunc(temp$, ndx)
            ELSE
                epos = pii
                CALL getMathFunc(temp$, ndx)
            END IF
            pii = epos
            pii = pii + 1
        END IF
    WEND
END SUB
' ==========================================
'
' ==========================================
SUB getMathFunc(name$, ndx)
    LOCAL varname$
    LOCAL temp$
    varname$ = name$
'                               --- now compare to functions ---
    IF varname$ = "ABS" THEN
        temp$ = " ?1"
    ELSE IF varname$ = "ASC" THEN
        temp$ = " ?2"
    ELSE IF varname$ = "ATN" THEN
        temp$ = " ?3"
    ELSE IF varname$ = "COS" THEN
        temp$ = " ?4"
    ELSE IF varname$ = "SIN" THEN
        temp$ = " ?5"
    ELSE IF varname$ = "TAN" THEN
        temp$ = " ?6"
    ELSE IF varname$ = "SQRT" THEN
        temp$ = "  ?7"
    ELSE IF varname$ = "INT" THEN
        temp$ = " ?8"
    ELSE IF varname$ = "LEN" THEN
        temp$ = " ?9"
    ELSE IF varname$ = "LOF" THEN
        temp$ = "?10"
    ELSE IF varname$ = "LOC" THEN
        temp$ = "?11"
    ELSE IF varname$ = "CVD" THEN
        temp$ = "?12"
    ELSE IF varname$ = "CVI" THEN
        temp$ = "?13"
    ELSE IF varname$ = "CVS" THEN
        temp$ = "?14"
    ELSE IF varname$ = "ATN2" THEN
        temp$ = " ?15"
    ELSE IF varname$ = "COSH" THEN
        temp$ = " ?16"
    ELSE IF varname$ = "SINH" THEN
        temp$ = " ?17"
    ELSE IF varname$ = "TANH" THEN
        temp$ = " ?18"
    ELSE IF varname$ = "ACOS" THEN
        temp$ = " ?19"
    ELSE IF varname$ = "ASIN" THEN
        temp$ = " ?20"
    ELSE IF varname$ = "CEIL" THEN
        temp$ = " ?21"
    ELSE IF varname$ = "FLOOR" THEN
        temp$ = "  ?22"
    ELSE IF varname$ = "HYPOT" THEN
        temp$ = "  ?23"
    ELSE IF varname$ = "LOG" THEN
        temp$ = "?24"
    ELSE IF varname$ = "LOG10" THEN
        temp$ = "  ?25"
    ELSE IF varname$ = "RAND" THEN
        temp$ = " ?26"
    ELSE IF varname$ = "CLOCK" THEN
        temp$ = "  ?27"
    ELSE IF varname$ = "VAL" THEN
        temp$ = "?28"
    ELSE IF varname$ = "EOF" THEN
        temp$ = "?29"
    END IF
'
    CALL strCopy(temp$, ndx)
END SUB
' ==========================================
'
' ==========================================
SUB getStrFunc(name$, ndx)
    LOCAL varname$
    LOCAL temp$
    varname$ = name$
'                               --- now compare to functions ---
    IF varname$ = "CHR" THEN
        temp$ = "   1"
    ELSE IF varname$ = "LEFT" THEN
        temp$ = "    2"
    ELSE IF varname$ = "RIGHT" THEN
        temp$ = "     3"
    ELSE IF varname$ = "MID" THEN
        temp$ = "   4"
    ELSE IF varname$ = "SPACE" THEN
        temp$ = "     5"
    ELSE IF varname$ = "STR" THEN
        temp$ = "   6"
    ELSE IF varname$ = "STRING" THEN
        temp$ = "      7"
    ELSE IF varname$ = "INKEY" THEN
        temp$ = "     8"
    ELSE IF varname$ = "INPUT" THEN
        temp$ = "     9"
    ELSE IF varname$ = "MKD" THEN
        temp$ = "  10"
    ELSE IF varname$ = "MKI" THEN
        temp$ = "  11"
    ELSE IF varname$ = "MKS" THEN
        temp$ = "  12"
    ELSE IF varname$ = "DATE" THEN
        temp$ = "   13"
    ELSE IF varname$ = "TIME" THEN
        temp$ = "   14"
    END IF
'
    CALL strCopy(temp$, ndx)
END SUB
' ==========================================
'
' ==========================================
SUB strCopy(tok$, ndx)
    LOCAL ch$
    LOCAL temp$
    LOCAL xpi
    LOCAL si
    LOCAL chx
    si = 1
'
    xpi = epos
    ch$ = MID$(tok$, si, 1)
    chx = ASC(ch$)
    IF chx <> 0 THEN
        temp$ = pstring$
        CALL insertStr(temp$, tok$, xpi)
        tempProg$[ndx] = xstring$
        pstring$ = xstring$
        epos = pii
    ELSE
        epos = spos
    END IF
END SUB
' ==========================================
'
' ==========================================
SUB tmpProg(ii)
    LOCAL ch$
    LOCAL prog$
    LOCAL chx
    prog$ = ""
'
    ilen = LEN(pstring$)
    pii = epos
    CALL iswhite()
'                               --- correct: LINE INPUT ---
    IF tempByte[ii] = 18 THEN
        CALL isThisUpper()
        WHILE ireturn = bTRUE
            pii = pii + 1
            CALL isThisUpper()
        WEND
        CALL iswhite()
        ch$ = MID$(pstring$, pii, 1)
        chx = ASC(ch$)
'                               ** not sure whats happening here with 'undef' ?
'                               should be '0'
        WHILE chx <> undef
            prog$ = prog$ & ch$
            pii = pii + 1
            ch$ = MID$(pstring$, pii, 1)
            chx = ASC(ch$)
        WEND
    ELSE IF pii <= ilen AND tempByte[ii] <> 0 THEN
        ch$ = MID$(pstring$, pii, 1)
        chx = ASC(ch$)
'                               ** not sure whats happening here with 'undef' ?
'                               should be '0'
        WHILE chx <> undef
            prog$ = prog$ & ch$
            pii = pii + 1
            ch$ = MID$(pstring$, pii, 1)
            chx = ASC(ch$)
        WEND
    ELSE IF tempByte[ii] = 8 THEN
        prog$ = "\n"
    ELSE
        prog$ = "\n"
    END IF
    tempProg$[ii] = prog$
'
END SUB
' ==========================================
'
' ==========================================
SUB tmpByte(ii)
    LOCAL ch$
    LOCAL sstr$
    LOCAL si
    LOCAL code
    LOCAL xx
    LOCAL isupper
    LOCAL isalpha
    LOCAL byte 
    code = 4
    xx = ii
'                               Sub "tmpByte" ...
'                               --- fill tempByte[] here ---
    pii = 1
    CALL iswhite()
    ch$ = MID$(pstring$, pii, 1)
'
    IF ch$ = "'" THEN
        byte = 0
        tempProg$[ii] = CHR$(13)
    ELSE
        CALL isThisUpper()
        isupper = ireturn
        CALL isThisAlpha()
        isalpha = ireturn
'
        IF isupper = bTRUE THEN
            epos = pii
            CALL getByte(ii)
            byte = lreturn
            pii = epos
        ELSE IF isalpha = bTRUE THEN
            si = pii
            CALL whileIsAlnum()
            CALL iswhite()
            ch$ = MID$(pstring$, pii, 1)
            sstr$ = "=#%!$@&("
            CALL inStrChr(sstr$, ch$)
'
            IF ireturn > 0 THEN
                byte = 1
                CALL getMOD()
                pii = si
            ELSE
                PRINT "tmpByte:return=", ireturn, "\n"
                CALL Abort(code, xx)
            END IF
        ELSE
            PRINT "tmpByte:isupper=", isupper, "    isalpha=", isalpha, "\n"
            PRINT "ch=", ch$, "  pii=", pii, "\n"
            CALL Abort(code, xx)
        END IF
    END IF
    tempByte[ii] = byte
    epos = pii
'
END SUB
' ==========================================
'
' ==========================================
SUB getByte(ii)
    LOCAL ch$
    LOCAL keyword$
    LOCAL sstr$
    LOCAL byte 
    LOCAL xx 
    LOCAL code 
'
    keyword$ = ""
    xx = ii
    code = 4
'
    pii = epos
    ch$ = MID$(pstring$, pii, 1)
    CALL isAlnum(ch$)
'                               collect this keyword
    WHILE ireturn = bTRUE
        keyword$ = keyword$ & ch$
        pii = pii + 1
        ch$ = MID$(pstring$, pii, 1)
        CALL isAlnum(ch$)
    WEND
'                               --- assign byte code ---
    IF keyword$ = "REM" THEN
        byte = 0
    ELSE IF keyword$ = "LET" THEN
        byte = 1
        CALL getMOD()
    ELSE IF keyword$ = "CLEAR" THEN
        byte = 2
    ELSE IF keyword$ = "LOCATE" THEN
        byte = 3
    ELSE IF keyword$ = "PRINT" THEN
        byte = 4
    ELSE IF keyword$ = "GOTO" THEN
        byte = 5
    ELSE IF keyword$ = "BEEP" THEN
        byte = 6
    ELSE IF keyword$ = "CLS" THEN
        byte = 7
    ELSE IF keyword$ = "END" THEN
        byte = 8
    ELSE IF keyword$ = "GOSUB" THEN
        byte = 9
    ELSE IF keyword$ = "RETURN" THEN
        byte = 10
    ELSE IF keyword$ = "FOR" THEN
        byte = 11
    ELSE IF keyword$ = "NEXT" THEN
        byte = 12
    ELSE IF keyword$ = "IF" THEN
        byte = 13
'                               ** need to correct for ELSE IF
    ELSE IF keyword$ = "ELSEIF" THEN
        byte = 14
    ELSE IF keyword$ = "ELSE" THEN
        byte = 15
'                               ** need to correct for END IF
    ELSE IF keyword$ = "ENDIF" THEN
        byte = 16
    ELSE IF keyword$ = "INPUT" THEN
        byte = 17
    ELSE IF keyword$ = "LINE" THEN
        byte = 18
    ELSE IF keyword$ = "OPEN" THEN
        byte = 19
    ELSE IF keyword$ = "CLOSE" THEN
        byte = 20
    ELSE IF keyword$ = "WRITE" THEN
        byte = 21
    ELSE IF keyword$ = "FIELD" THEN
        byte = 22
    ELSE IF keyword$ = "LSET" THEN
        byte = 23
    ELSE IF keyword$ = "RSET" THEN
        byte = 24
    ELSE IF keyword$ = "PUT" THEN
        byte = 25
    ELSE IF keyword$ = "GET" THEN
        byte = 26
    ELSE IF keyword$ = "CHDIR" THEN
        byte = 27
    ELSE IF keyword$ = "MKDIR" THEN
        byte = 28
    ELSE IF keyword$ = "RMDIR" THEN
        byte = 29
    ELSE IF keyword$ = "KILL" THEN
        byte = 30
    ELSE IF keyword$ = "NAME" THEN
        byte = 31
    ELSE IF keyword$ = "RENAME" THEN
        byte = 31
    ELSE IF keyword$ = "FILES" THEN
        byte = 32
    ELSE IF keyword$ = "SHELL" THEN
        byte = 33
    ELSE IF keyword$ = "RANDOM" THEN
        byte = 34
    ELSE IF keyword$ = "READ" THEN
        byte = 35
    ELSE IF keyword$ = "CHDRIVE" THEN
        byte = 36
    ELSE IF keyword$ = "WHILE" THEN
        byte = 37
    ELSE IF keyword$ = "WEND" THEN
        byte = 38
    ELSE IF keyword$ = "LOOP" THEN
        byte = 39
    ELSE IF keyword$ = "ENDLOOP" THEN
        byte = 40
    ELSE IF keyword$ = "BREAK" THEN
        byte = 41
    ELSE IF keyword$ = "DO" THEN
        byte = 42
    ELSE IF keyword$ = "LPRINT" THEN
        byte = 43
    ELSE IF keyword$ = "COLOR" THEN
        byte = 44
    ELSE IF keyword$ = "ASM" THEN
        byte = 45
    ELSE IF keyword$ = "DIM" THEN
        byte = 46
    ELSE IF keyword$ = "ERASE" THEN
        byte = 47
    ELSE IF keyword$ = "FREE" THEN
        byte = 47
    ELSE IF keyword$ = "DECLARE" THEN
        byte = 48
    ELSE IF keyword$ = "CALL" THEN
        byte = 49
    ELSE IF keyword$ = "SUB" THEN
        byte = 50
    ELSE IF keyword$ = "ENDSUB" THEN
        byte = 51
    ELSE IF keyword$ = "SWITCH" THEN
        byte = 52
    ELSE IF keyword$ = "SELECT" THEN
        byte = 52
    ELSE IF keyword$ = "CASE" THEN
        byte = 53
    ELSE IF keyword$ = "DEFAULT" THEN
        byte = 54
    ELSE IF keyword$ = "ENDSWITCH" THEN
        byte = 55
    ELSE IF keyword$ = "ENDSELECT" THEN
        byte = 55
'
    ELSE
        CALL iswhite()
        ch$ = MID$(pstring$, pii, 1)
        sstr$ = "=#%!$@&("
        CALL inStrChr(sstr$, ch$)
'                                   default: assume variable assignment.
        IF ireturn <> bFALSE THEN
            byte = 1
            CALL getMOD()
            pii = epos
        ELSE
            PRINT "getByte:\n"
            CALL Abort(code, xx)
        END IF
    END IF
    epos = pii
    lreturn = byte
'
END SUB
' ==========================================
'
' ==========================================
SUB getMOD
    LOCAL ch$
    LOCAL temp$
    LOCAL si 
    LOCAL xi 
    LOCAL orig
'
    temp$ = ""
    ilen = LEN(pstring$)
'                               --- save pi's value ---
    orig = pii
    xi = pii
    CALL getQuote()
'                               --- is this in a quoted string ? ---
    IF pii >= ilen THEN
        pii = xi
        pii = pii + 1
        CALL iswhite()
        ch$ = MID$(pstring$, pii, 1)
'
        WHILE pii < ilen
            IF ch$ = "M" THEN
                si = pii
                CALL isAlnum(ch$)
                WHILE ireturn = bTRUE
                    temp$ = temp$ & ch$
                    pii = pii + 1
                    ch$ = MID$(pstring$, pii, 1)
                    CALL isAlnum(ch$)
                WEND
                IF temp$ = "MOD" THEN
                    temp$ = MID$(pstring$, 1, pii)
                    temp$ = temp$ & "%"
                    si = si + 1
                    xi = si
                    WHILE pii < ilen
                        ch$ = MID$(pstring$, pii, 1)
                        temp$ = temp$ & ch$
                        pii = pii + 1
                    WEND
                    pii = xi
                    pstring$ = temp$
                    ilen = LEN(pstring$)
                END IF
                pii = pii + 1
            ELSE
                pii = pii + 1
            END IF
            ch$ = MID$(pstring$, pii, 1)
        WEND
    END IF
    pii = orig
'
END SUB
' ==========================================
'
' ==========================================
SUB tmpLabel(ii)
    LOCAL ch$
    LOCAL lnLabel$
    lnLabel$ = ""
'                               --- fill tempLabel$() here ---
    pii = 1
    CALL isThisAlnum()
    IF ireturn = bTRUE THEN
        WHILE ireturn = bTRUE
            ch$ = MID$(pstring$, pii, 1)
            lnLabel$ = lnLabel$ & ch$
            pii = pii + 1
            CALL isThisAlnum()
        WEND
        tempLabel$[ii] = lnLabel$ & ":" & CHR$(13) & CHR$(10)
        ilen = LEN(pstring$)
        lnLabel$ = ""
'
        WHILE pii <= ilen
            ch$ = MID$(pstring$, pii, 1)
            lnLabel$ = lnLabel$ & ch$
            pii = pii + 1
        WEND
        pstring$ = lnLabel$
        pii = 1
    ELSE
        tempLabel$[ii] = ""
    END IF
    epos = pii
END SUB
' ==========================================
'
' ==========================================
SUB SaveTemp
    LOCAL ch$
    LOCAL ystring$
    LOCAL chx 
    LOCAL isupper 
    LOCAL isdigit 
'                               Sub "SaveTemp" saves code to intermediate file.
    xstring$ = "  "
    xstring$ = xstring$ & pstring$
    pii = 1
    CALL iswhite()
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
'                               --- Test For Label: ---
    CALL isThisUpper()
    isupper = ireturn
    CALL isThisNum()
    isdigit = ireturn
'                               --- Test: is this a block-label ?
    IF isupper = bTRUE THEN
        ilen = LLEN - 2
        CALL whileIsAlnum()
        ch$ = MID$(pstring$, pii, 1)
'                               --- If so..., save label.
        IF ch$ = ":" AND pii < ilen THEN
            pii = pii + 1
            ystring$ = pstring$
            pstring$ = LEFT$(ystring$, pii)
            PRINT #2, pstring$
            nrows = nrows + 1
        ELSE
            PRINT #2, xstring$
            nrows = nrows + 1
        END IF
    ELSE IF isdigit = bTRUE THEN
'                               --- Is this a numbered line ?
        PRINT #2, pstring$
        nrows = nrows + 1
    ELSE
        CALL iswhite()
        ch$ = MID$(pstring$, pii, 1)
'                               --- If line is not a comment, save it.
        IF ch$ <> "'" THEN
            PRINT #2, xstring$
            nrows = nrows + 1
        END IF
    END IF
END SUB
' ==========================================
' ==========================================
'
' ----------------------------------------------
' ============ BASINPUT: Sub Routines ==========
'
' ==========================================
SUB Header
    LOCAL dout$
    LOCAL t$
    LOCAL ret$
'
    t$ = CHR$(9)
    ret$ = "\n"
'                               Sub "Header" generates include header information and
'                               function prototypes.
    CALL OpenDestin()
'
    dout$ = "//" & t$ & "************* gBasic Compiler *************" & ret$
    PRINT #2, dout$
    dout$ = "//" & t$ & "Copyright: s.arbayo (c) 2011" & ret$ & ret$
    PRINT #2, dout$
'
    PRINT #2, "/*--------------------- DECLARE HEADERS ---------------------*/\n"
    PRINT #2, "#include <stdio.h> \n"
    PRINT #2, "#include <stdlib.h> \n\n"
    PRINT #2, "/*------------------- Function Prototypes -------------------*/\n"
    PRINT #2, "\n\n"
    PRINT #2, "/*---------------------- BEGIN PROGRAM ----------------------*/\n"
'
    CALL Prolog()
'
'  PRINT "  Call BuildArrays:\n"
'    CALL BuildArrays()
'
END SUB
' ==========================================
'
' ==========================================
SUB Prolog
'                               Sub "Prolog" builds program variables declaration information
'                               and outputs the start of the main program.
'                                   --- pre-scan for quoted strings ---
    CALL ScanVars()
'
    PRINT #2, "\n"
    PRINT #2, "int main(int argc, char *argv[]) \n"
    PRINT #2, "{ \n"
'
    CALL loadTmpdata()
'
END SUB
' ==========================================
'
' ==========================================
SUB Epilog
'                               Sub "Epilog" outputs the final stages of the program.
'
    PRINT #2, "/*--------- end main ---------*/\n"
    
END SUB
' ==========================================
'
' ==========================================
SUB OpenDestin
    LOCAL ch$
    LOCAL dot$
    LOCAL xfile$
'
    dot$ = "."
    xfile$ = ""
'                                   Sub "OpenDestin" opens the destination file for output.
    pii = 1
    ch$ = MID$(SourceFile$, pii, 1)
'
    WHILE ch$ <> dot$
        xfile$ = xfile$ & ch$
        pii = pii + 1
        ch$ = MID$(SourceFile$, pii, 1)
    WEND
    Destin$ = xfile$ & ".c"
'
    OPEN Destin$ FOR OUTPUT AS #2
'
'   -------------------
'    OPEN "sdatatmp.tmp" FOR OUTPUT AS #3
    OPEN "idatatmp.tmp" FOR OUTPUT AS #4
'    OPEN "fdatatmp.tmp" FOR OUTPUT AS #5
'    OPEN "xdatatmp.tmp" FOR OUTPUT AS #6
'   -------------------
'
END SUB
' ==========================================
'
' ==========================================
SUB ScanVars
    LOCAL ch$
    LOCAL ii 
'                               --- seed starting point
    lineNdx = 1
'                               --- identify and write all variables ---
    WHILE lineNdx <= nrows
        CALL getToken()
        epos = 1
        spos = 1
'
        IF token = 1 THEN
            CALL ScanLet()
        ELSE IF token = 4 THEN
            CALL ScanPrint()
        ELSE 
'            PRINT "    ScanVars:Switch:default\n"
        END IF
        lineNdx = lineNdx + 1
    WEND
'
    IF VarNdxCnt >= 1 THEN
        FOR ii = 1 TO VarNdxCnt
            VarIndx$[ii] = ""
        NEXT ii
        VarIndx$[1] = ""
    END IF
'
END SUB
' ==========================================
'
' ==========================================
SUB ScanLet
    LOCAL ch$
    LOCAL varname$
    LOCAL sstr$
    LOCAL ctype 
    LOCAL code 
    LOCAL xx 
    LOCAL strch 
'
    code = 0
    xx = lineNdx
'
    pii = epos
    CALL getVarname()
    varname$ = rvarName$
    pii = epos
    ch$ = MID$(pstring$, pii, 1)
'                                   --- Does this var have a suffix ?
    sstr$ = "$%!#@&"
    CALL inStrChr(sstr$, ch$)
    strch = ireturn
'                                   --- Get variable's data type
    IF strch = bTRUE THEN
        CALL getvtype()
        ctype = ireturn
'
        IF ctype = 0 THEN
'            CALL ScanString(varname$)
        ELSE IF ctype = 6 THEN
'            CALL ScanStrArray(varname$)
        ELSE IF ctype >= 7 AND ctype <= 10 THEN
'            CALL ScanNumArray(varname$, ctype)
        ELSE
'                               --- Numeric data type
            CALL ScanNumeric(varname$)
        END IF
    ELSE
        CALL getObjectType(varname$)
        ctype = ireturn
'
        IF ctype = 0 THEN
'            CALL ScanString(varname$)
        ELSE IF ctype = 6 THEN
'            CALL ScanStrArray(varname$)
        ELSE IF ctype >= 7 AND ctype <= 10 THEN
'            CALL ScanNumArray(varname$, ctype)
        ELSE
'                               --- Numeric data type
            CALL ScanNumeric(varname$)
        END IF
    END IF
'
END SUB
' ==========================================
'
' ==========================================
SUB ScanString(name$)
'
END SUB
' ==========================================
'
' ==========================================
SUB ScanStrArray(name$)
'
END SUB
' ==========================================
'
' ==========================================
SUB ScanStrfunct
'
END SUB
' ==========================================
'
' ==========================================
SUB ScanPrint
    LOCAL ch$
    LOCAL varname$
    LOCAL quote$ 
    LOCAL stchx$ 
    LOCAL stchy$ 
    LOCAL stchz$ 
    LOCAL ctype 
    LOCAL ival 
    LOCAL chx 
    LOCAL isdigit 
    LOCAL isalpha 
    LOCAL strchx 
    LOCAL strchy 
    LOCAL strchz 
'
    quote$ = CHR$(34)
    ilen = LEN(pstring$)
    pii = epos
'
    CALL iswhite()
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
'                                   File-Print output
    IF ch$ = "#" THEN
        IF token = 4 THEN
             PRINT "   Call:ScanFPrint:\n"
'            CALL ScanFPrint()
        ELSE
             PRINT "   Call:ScanFInput:\n"
'            CALL ScanFInput()
        END IF
    ELSE
        WHILE pii < ilen AND chx <> 13
            epos = pii
            CALL isadigit(ch$)
            isadigit = ireturn
            CALL isanAlpha(ch$)
            isalpha = ireturn
'                               --- Quoted string ---
            IF ch$ = quote$ THEN
'                CALL getNewVar()
                CALL getQuote()
                epos = pii
'                               --- Math function ---
            ELSE IF ch$ = "?" THEN
                epos = pii + 1
'                CALL getavalue()
                ival = dreturn
                IF ival = 10 OR ival = 11 OR ival = 29 THEN
                    pii = ilen
                    epos = pii
                ELSE
                    CALL getParen()
                    pii = pii + 1
'                    CALL ScanMathfunc()
                END IF
'                               --- Variable Name ---
            ELSE IF isalpha = bTRUE THEN
                CALL getVarname()
                varname$ = rvarName$
                spos = pii
                pii = epos
'                CALL getObjectType(varname$)
                ctype = ireturn
                ix = -1
'
                IF ctype = ix THEN
                    CALL getvtype()
                    ctype = ireturn
                END IF
                IF ctype = 0 THEN
'                    CALL FixString(varname$)
                ELSE IF ctype = 6 THEN
'                    CALL FixStrArray(varname$)
                    CALL getParen()
'                    CALL ScanArrayParam()
                ELSE IF ctype >= 7 AND ctype <= 10 THEN
'                    CALL FixVarArray(varname$)
                    CALL getParen()
'                    CALL ScanArrayParam()
                ELSE
                    ilen = LEN(varname$)
                    spos = pii - ilen
                    CALL getNvtype()
                    ctype = ireturn
'                    CALL SavDestin(ctype, varname$)
                END IF
'                               --- String function ---
            ELSE IF isdigit = bTRUE THEN
                CALL getNextOp()
                ch$ = MID$(pstring$, pii, 1)
'
                IF ch$ = "(" THEN
'                    CALL ScanStrfunct()
                    ilen = ireturn
                ELSE
'                    CALL GetNewTmp()
                END IF
            END IF
'
            pii = epos
            ch$ = MID$(pstring$, pii, 1)
            ilen = LEN(pstring$)
'
            stchx$ = ":; ,)("
            CALL inStrChr(stchx$, ch$)
            strchx = ireturn
'
            stchy$ = "$%!#@&"
            CALL inStrChr(stchy$, ch$)
            strchy = ireturn
'
            stchz$ = "+-*/^"
            CALL inStrChr(stchz$, ch$)
            strchz = ireturn
'
            IF strchx <> bFALSE THEN
                CALL getRightExp()
            ELSE IF strchy <> bFALSE THEN
                CALL getRightExp()
            ELSE IF strchz <> bFALSE THEN
                CALL getRightExp()
            END IF
            epos = pii
            ch$ = MID$(pstring$, pii, 1)
            chx = ASC(ch$)
        WEND
    END IF
'
END SUB
' ==========================================
'
' ==========================================
SUB loadTmpdata
'
    pstring$ = ""
'
'    CLOSE 3
    CLOSE 4
'    CLOSE 5
'    CLOSE 6
'
'                        --- char string data ---
'    OPEN "I", #3, "sdatatmp.tmp"
'Start02:
'    IF EOF(3) THEN
'        GOTO Finish02
'    END IF
'    LINE INPUT #3, pstring$
'
'    IF pstring$ = "" THEN
'        GOTO Start02
'    END IF
'    PRINT #2, pstring$
'    pstring$ = ""
'    GOTO Start02
'Finish02:
'    CLOSE 3
'
    OPEN "idatatmp.tmp" FOR INPUT AS #3
Start03:
    IF EOF(3) THEN
        GOTO Finish03
    END IF
    LINE INPUT #3, pstring$
'
    IF pstring$ = "" THEN
        GOTO Start03
    END IF
    PRINT #2, pstring$
    pstring$ = ""
    GOTO Start03
Finish03:
    pstring$ = "\n"
    PRINT #2, pstring$
    CLOSE 3
'
'    OPEN "I", #3, "fdatatmp.tmp"
'Start04:
'    IF EOF(3) THEN
'        GOTO Finish04
'    END IF
'    LINE INPUT #3, pstring$
'
'    IF pstring$ = "" THEN
'        GOTO Start04
'    END IF
'    PRINT #2, pstring$
'    pstring$ = ""
'    GOTO Start04
'Finish04:
'    CLOSE 3
'
'    OPEN "I", #3, "xdatatmp.tmp"
'Start05:
'    IF EOF(3) THEN
'        GOTO Finish05
'    END IF
'    LINE INPUT #3, pstring$
'
'    IF pstring$ = "" THEN
'        GOTO Start05
'    END IF
'    PRINT #2, pstring$
'    pstring$ = ""
'    GOTO Start05
'Finish05:
'    CLOSE 3
'
'   KILL("sdatatmp.tmp")
'   KILL("idatatmp.tmp")
'   KILL("fdatatmp.tmp")
'   KILL("xdatatmp.tmp")
'
END SUB
' ==========================================
' ==========================================
'
' ----------------------------------------------
' ========== BASFUNCT: Sub Routines ========
'
' ===========================================
SUB doLabel
    temp$ = ""
    temp$ = labelNam$[lineNdx]
    CALL PostLabel(temp$)
'
END SUB
' ===========================================
'
' ===========================================
SUB doEnd
    PRINT #2, "\n"
    PRINT #2, "    return 0;\n"
    PRINT #2, "}\n"
'
END SUB
' ===========================================
'
' ===========================================
SUB doPrint
    ch$ = ""
    varname$ = ""
    sstr$ = ""
    test = 0
    quote$ = CHR$(34)
    dout$ = ""
'
    ilen = LEN(pstring$)
    pii = epos
    CALL iswhiter()
    ch$ = MID$(pstring$, pii, 1)
    sstr$ = quote$
    CALL inStrChr(sstr$, ch$)
    test = ireturn
'
    dout$ = "    printf(" & quote$
'                 --- test for a quoted string ---
    IF test = bTRUE THEN
        pii = pii + 1
        ch$ = MID$(pstring$, pii, 1)
'
        WHILE ch$ <> quote$
            varname$ = varname$ & ch$
            pii = pii + 1
            ch$ = MID$(pstring$, pii, 1)
        WEND
        varname$ = varname$ & "\\n" & quote$ & ");"
        dout$ = dout$ & varname$ & "\n"
        PRINT #2, dout$
    END IF
'                --- test for other types of output ---
'
END SUB
' ===========================================
' ===========================================
'
' ----------------------------------------------
' ============ BASVARS: Sub Routines ==========
'
' ===========================================
SUB doLet
    LOCAL varname$
    LOCAL itype 
    LOCAL code 
    LOCAL xx 
'                                   Sub "doLet" parses a variable assignment.
'           ** Need to fix this error type number
    code = 6
    xx = lineNdx
'
    ilen = LEN(pstring$)
    pii = epos
    CALL getAlpha()
'
    IF pii = ilen THEN
        CALL Abort(code, xx)
    END IF
'
    epos = pii
    CALL getVarname()
    varname$ = rvarName$
'
    CALL getObjectType(varname$)
    itype = ireturn
'
    IF itype = 0 THEN
'            CALL parseStr(varname$)
    ELSE IF itype = 1 THEN
            CALL asnInteger(varname$)
    ELSE IF itype = 2 THEN
'            CALL asnInteger(varname$)
    ELSE IF itype = 5 THEN
'            CALL asnInteger(varname$)
    ELSE IF itype = 3 THEN
'            CALL asnFloat(varname$)
    ELSE IF itype = 4 THEN
'            CALL asnFloat(varname$)
    ELSE IF itype = 6 THEN
'            CALL parseStrArry(varname$)
    ELSE IF itype = 8 THEN
'            CALL parseFltArry(varname$, itype)
    ELSE IF itype = 9 THEN
'            CALL parseFltArry(varname$, itype)
    ELSE IF itype = 7 THEN
'            CALL parseIntArry(varname$, itype)
    ELSE IF itype = 10 THEN
'            CALL parseIntArry(varname$, itype)
    ELSE 
            CALL Abort(code, xx)
    END IF
END SUB
' ===========================================
'
' ===========================================
SUB asnInteger(name$)
    LOCAL dout$
    LOCAL temp$
    LOCAL ch$
    LOCAL chx
'
    ilen = LEN(pstring$)
    temp$ = name$
    pii = epos
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
'
    WHILE chx <> 13 AND pii < ilen
        temp$ = temp$ & ch$
        pii = pii + 1
        ch$ = MID$(pstring$, pii, 1)
        chx = ASC(ch$)
    WEND
'                               --- store data ---
    dout$ = "    " &  temp$ & ";\n"
    PRINT #2, dout$
'
END SUB
' ===========================================
' ===========================================
'
' -------------------------------------------
' ========== BASUTILS: Sub Routines ==========
'
' ==========================================
SUB PostLabel(sstring$)
'
    PRINT #2, sstring$
'
END SUB
' ==========================================
'
' ==========================================
SUB getVarname
    ch$ = ""
    varname$ = ""
    sstr$ = ""
    alnum = 0
    dotdash = 0
    chx = 0
'
    pii = epos
    ch$ = MID$(pstring$, pii, 1)
    sstr$ = "._"
'
    CALL isAlnum(ch$)
    alnum = ireturn
    CALL inStrChr(sstr$, ch$)
    dotdash = ireturn
'
    WHILE alnum <> 0 OR dotdash <> 0
        varname$ = varname$ & ch$
        pii = pii + 1
        ch$ = MID$(pstring$, pii, 1)
'
        CALL isAlnum(ch$)
        alnum = ireturn
        CALL inStrChr(sstr$, ch$)
        dotdash = ireturn
    WEND
    epos = pii
    rvarName$ = varname$
'
END SUB
' ==========================================
'
' ==========================================
SUB getObjectType(name$)
    LOCAL varname$
    LOCAL temp$
    LOCAL ndx 
    LOCAL itype 
'
    ndx = 1
    itype = -1
    varname$ = name$
    temp$ = ObjIndx$[ndx]
'
    WHILE ndx <= ObjNdxCnt AND varname$ <> temp$
        ndx = ndx + 1
        temp$ = ObjIndx$[ndx]
    WEND
'
    IF ndx <= ObjNdxCnt THEN
        itype = ObjType[ndx, 1]
    END IF
    ireturn = itype
'
END SUB
' ==========================================
'
' ==========================================
SUB checkVarName(name$)
    LOCAL varname$
    LOCAL temp$
    LOCAL ndx 
    LOCAL bool
'
    ndx = 1
    bool = 0
    varname$ = name$
'
    IF VarNdxCnt = 0 THEN
        CALL initVars()
        ndx = VarNdxCnt - 1
        VarIndx$[ndx] = varname$
    ELSE
        temp$ = VarIndx$[ndx]
'
        WHILE ndx < VarNdxCnt AND varname$ <> temp$
            ndx = ndx + 1
            temp$ = VarIndx$[ndx]
        WEND
'
        IF ndx >= VarNdxCnt THEN
            CALL initVars()
            ndx = VarNdxCnt - 1
            VarIndx$[ndx] = varname$
        ELSE
            bool = 1
        END IF
    END IF
'
    ireturn = bool
'
END SUB
' ==========================================
'
' ==========================================
SUB initVars
    LOCAL ndx
'
    VarNdxCnt = VarNdxCnt + 1
    ndx = VarNdxCnt
'
    VarIndx$[ndx] = ""
'
END SUB
' ==========================================
'
' ==========================================
SUB SavObjName(name$, itype, iparm)
    LOCAL ndx 
'
    CALL initObj()
'
    ndx = ObjNdxCnt
    ObjIndx$[ndx] = name$
    ObjType[ndx, 1] = itype
    ObjType[ndx, 2] = iparm
'
END SUB
' ==========================================
'
' ==========================================
SUB initObj
    LOCAL ndx 
'
    ObjNdxCnt = ObjNdxCnt + 1
    ndx = ObjNdxCnt
'
    IF ndx > 1 THEN
        ObjIndx$[ndx] = ""
        ObjType[ndx, 2] = 0
    END IF
'
END SUB
' ==========================================
'
'
'
' -------------------------------------------
' ========== UTILITY: Sub Routines ==========
'
' ==========================================
SUB iswhite
    LOCAL ch$
    LOCAL chx 
    LOCAL test 
    test = bTRUE
'                               Similar to C's isspace(), affects result in pii
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
    WHILE test = bTRUE
        IF chx > 8 AND chx < 14 THEN
            pii = pii + 1
            ch$ = MID$(pstring$, pii, 1)
            chx = ASC(ch$)
        ELSE IF chx = 32 THEN
            pii = pii + 1
            ch$ = MID$(pstring$, pii, 1)
            chx = ASC(ch$)
        ELSE
            test = bFALSE
        END IF
    WEND
END SUB
' =============================SUB iswhite()
'
' ==========================================
SUB iswhiter
    LOCAL ch$
'                               similar to iswhite, but, only tests for space, ascii(32).
'                               Affects pii.
    ch$ = MID$(pstring$, pii, 1)
    WHILE ch$ = " "
        pii = pii + 1
        ch$ = MID$(pstring$, pii, 1)
    WEND
END SUB
' ==========================================
'
' ==========================================
SUB whileIsAlnum
    LOCAL ch$
    LOCAL chx
    LOCAL test
    test = 1
'                               Advance pii thru alpha-numeric characters, result is in pii.
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
    WHILE test = 1
        IF chx > 47 AND chx < 58 THEN
            pii = pii + 1
            ch$ = MID$(pstring$, pii, 1)
            chx = ASC(ch$)
        ELSE IF chx > 64 AND chx < 91 THEN
            pii = pii + 1
            ch$ = MID$(pstring$, pii, 1)
            chx = ASC(ch$)
        ELSE IF chx > 96 AND chx < 123 THEN
            pii = pii + 1
            ch$ = MID$(pstring$, pii, 1)
            chx = ASC(ch$)
        ELSE
            test = 0
        END IF
    WEND
END SUB
' ==========================================
'
' ==========================================
SUB isThisAlnum
    LOCAL ch$
    LOCAL chx 
'                               Is this character alpha-numeric ?
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
    IF chx > 47 AND chx < 58 THEN
        ireturn = 1
    ELSE IF chx > 64 AND chx < 91 THEN
        ireturn = 1
    ELSE IF chx > 96 AND chx < 123 THEN
        ireturn = 1
    ELSE
        ireturn = 0
    END IF
END SUB
' ==========================================
'
' ==========================================
SUB isThisNum
    LOCAL ch$
    LOCAL chx 
'                               Is this character numeric ?
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
    IF chx > 47 AND chx < 58 THEN
        ireturn = 1
    ELSE
        ireturn = 0
    END IF
END SUB
' ==========================================
'
' ==========================================
SUB isadigit(c$)
    LOCAL ch$
    LOCAL chx 
'                               Is the c$ character a digit ?
    ch$ = c$
    chx = ASC(ch$)
    IF chx > 47 AND chx < 58 THEN
        ireturn = 1
    ELSE
        ireturn = 0
    END IF
END SUB
' ==========================================
'
' ==========================================
SUB isThisAlpha
    LOCAL ch$
    LOCAL chx 
'                               Is this character alpha ?
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
    IF chx > 64 AND chx < 91 THEN
        ireturn = 1
    ELSE IF chx > 96 AND chx < 123 THEN
        ireturn = 1
    ELSE
        ireturn = 0
    END IF
END SUB
' ==========================================
'
' ==========================================
SUB isanAlpha(c$)
    LOCAL ch$
    LOCAL chx 
'                               Is the c$ character an alpha ?
    ch$ = c$
    chx = ASC(ch$)
    IF chx > 64 AND chx < 91 THEN
        ireturn = 1
    ELSE IF chx > 96 AND chx < 123 THEN
        ireturn = 1
    ELSE
        ireturn = 0
    END IF
END SUB
' ==========================================
'
' ==========================================
SUB isThisUpper
    LOCAL ch$
    LOCAL chx 
'                               Is this character upper-case ?
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
    IF chx > 64 AND chx < 91 THEN
        ireturn = 1
    ELSE
        ireturn = 0
    END IF
END SUB
' ==========================================
'
' ==========================================
SUB isThisLower
    LOCAL ch$
    LOCAL chx 
'                               Is this character lower-case ?
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
    IF chx > 96 AND chx < 123 THEN
        ireturn = 1
    ELSE
        ireturn = 0
    END IF
END SUB
' ==========================================
'
' ==========================================
SUB inStrChr(s$, c$)
    LOCAL xpi 
    LOCAL xlen
    LOCAL xch$
    xpi = 1
'                               Similar to BASIC's INSTR($,$), but, more like C's strchr().
    ireturn = bFALSE
    xlen = LEN(s$)
    WHILE ireturn = bFALSE AND xpi <= xlen
        xch$ = MID$(s$, xpi, 1)
        IF xch$ = c$ THEN
            ireturn = xpi
        ELSE
            xpi = xpi + 1
        END IF
    WEND
END SUB
' ==========================================
'
' ==========================================
SUB isAlnum(ch$)
    LOCAL chx 
'                               Is this character alpha-numeric ?
    chx = ASC(ch$)
    IF chx > 47 AND chx < 58 THEN
        ireturn = 1
    ELSE IF chx > 64 AND chx < 91 THEN
        ireturn = 1
    ELSE IF chx > 96 AND chx < 123 THEN
        ireturn = 1
    ELSE
        ireturn = 0
    END IF
END SUB
' ==========================================
'
' ==========================================
SUB getQuote
    LOCAL ch$
    LOCAL chx 
'                               Returns with pii pointing at the first 
'                               character after an ascii char(34).
    pii = pii + 1
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
'
    WHILE chx <> 34 AND pii < ilen
        pii = pii + 1
        ch$ = MID$(pstring$, pii, 1)
        chx = ASC(ch$)
    WEND
'
    IF chx = 34 THEN
        pii = pii + 1
    END IF
'
END SUB
' ==========================================
'
' ==========================================
SUB findString(temp$)
    LOCAL ch$
    LOCAL cx$
    LOCAL quote$
    LOCAL tmp$
    LOCAL xxstring$
    LOCAL mark 
    LOCAL len2 
    LOCAL ii 
'
    pii = spos
    quote$ = CHR$(34)
    xxstring$ = temp$
    ilen = LEN(pstring$)
    len2 = LEN(xxstring$)
    ch$ = MID$(pstring$, pii, 1)
    cx$ = MID$(xxstring$, 1, 1)
'
    WHILE pii < ilen
        WHILE ch$ <> cx$ AND pii < ilen
            IF ch$ = quote$ THEN
                pii = pii + 1
                ch$ = MID$(pstring$, pii, 1)
                WHILE ch$ <> quote$
                    pii = pii + 1
                    ch$ = MID$(pstring$, pii, 1)
                WEND
            END IF
            pii = pii + 1
            ch$ = MID$(pstring$, pii, 1)
        WEND
        IF pii >= ilen THEN
            mark = 0
        ELSE
            mark = pii
            tmp$ = ""
            FOR ii = 1 TO len2 STEP 1
                tmp$ = tmp$ & ch$
                pii = pii + 1
                ch$ = MID$(pstring$, pii, 1)
            NEXT ii
            IF tmp$ <> xxstring$ THEN
                pii = mark + 1
                ch$ = MID$(pstring$, pii, 1)
            ELSE
                pii = ilen
            END IF
        END IF
    WEND
    ireturn = mark
END SUB
' ==========================================
'
' ==========================================
SUB isEqu
    LOCAL ch$
    LOCAL bool 
    bool = 0
'
    CALL iswhite()
    epos = pii
    ch$ = MID$(pstring$, pii, 1)
'
    IF ch$ = "=" THEN
        bool = 1
    END IF
    ireturn = bool
'
END SUB
' ==========================================
'
' ==========================================
SUB getUpper
'
    CALL isThisUpper()
    WHILE ireturn = 0 AND pii < ilen
        pii = pii + 1
        CALL isThisUpper()
    WEND
    ireturn = pii
END SUB
' ==========================================
'
' ==========================================
SUB insertStr(orig$, repl$, xpi)
   LOCAL ch$
   LOCAL myarray$
   LOCAL ii 
   myarray$[1] = ""
'                               Since Basic has no function that replaces individual 
'                               string_array characters, like C has, i.e.:
'                                       string_array[n] = char
'                               this function will replace a single character or sub-string
'                               within a character string. Passed parameters are:
'                                       (original$, substring$, position)
'                               The resulting changes are stored in global: xstring$.
   ilen = LEN(orig$)
   myarray$[ilen] = ""
   FOR ii = 1 TO ilen
      ch$ = MID$(orig$, ii, 1)
      myarray$[ii] = ch$
   NEXT ii
   ilen = LEN(repl$)
   FOR ii = 1 TO ilen
      ch$ = MID$(repl$, ii, 1)
      myarray$[xpi] = ch$
      xpi = xpi + 1
   NEXT ii
   xstring$ = ""
   ilen = LEN(orig$)
   FOR ii = 1 TO ilen
      ch$ = myarray$[ii]
      xstring$ = xstring$ & ch$
   NEXT ii
   pii = xpi
'
   UNDEF myarray$
END SUB
' ==========================================
'
' ==========================================
SUB getParen
    LOCAL ch$
    LOCAL xpi
'
    xpi = pii
    ireturn = bFALSE
'
    WHILE ireturn = bFALSE AND xpi <= ilen
        ch$ = MID$(pstring$, xpi, 1)
        IF ch$ = "(" THEN
            ireturn = xpi
        ELSE IF ch$ = ")" THEN
            ireturn = xpi
        ELSE
            xpi = xpi + 1
        END IF
    WEND
END SUB
' ==========================================
'
' ==========================================
SUB getRightExp
   LOCAL ch$
   LOCAL xch 
'
   ch$ = MID$(pstring$, pii, 1)
   xch = ASC(ch$)
   CALL isAlnum(ch$)
   WHILE ireturn = bFALSE AND xch <> 34 AND xch <> 13
        pii = pii + 1
        ch$ = MID$(pstring$, pii, 1)
        xch = ASC(ch$)
        CALL isAlnum(ch$)
    WEND
END SUB
' ==========================================
'
' ==========================================
SUB getAlpha
'
    CALL isThisAlpha()
    WHILE ireturn = bFALSE AND pii < ilen
        pii = pii + 1
        CALL isThisAlpha()
    WEND
END SUB
' ==========================================
'
' ==========================================
SUB getNextOp
'                               Advance pii thru to the next operator.
    CALL whileIsAlnum()
    CALL iswhite()
END SUB
' ==========================================
'
' ==========================================
SUB getvtype
    LOCAL ch$
    LOCAL chx$
    LOCAL sstr$
    LOCAL itype 
    LOCAL pix 
    LOCAL ret 
    LOCAL xch 
    itype = -1
'
    CALL whileIsAlnum()
    ch$ = MID$(pstring$, pii, 1)
    sstr$ = CHR$(13)
    sstr$ = sstr$ & " =<>%!#@&"
    CALL inStrChr(sstr$, ch$)
    ret = ireturn
'
    IF ch$ = "$" THEN
        itype = 0
        pix = pii + 1
        ch$ = MID$(pstring$, pix, 1)
        IF ch$ = "(" THEN
            itype = 6
        END IF
    ELSE IF ret <> bFALSE THEN
        itype = 1
        sstr$ = "%!#@&"
        CALL inStrChr(sstr$, ch$)
        ret = ireturn
        IF ret <> bFALSE THEN
            pix = pii + 1
            chx$ = MID$(pstring$, pix, 1)
            IF chx$ = "(" THEN
                xch = ASC(ch$)
                IF xch = 37 THEN
                    itype = 7
                ELSE IF xch = 33 THEN
                    itype = 8
                ELSE IF xch = 35 THEN
                    itype = 9
                ELSE IF xch = 64 THEN
                    itype = 10
                ELSE IF xch = 38 THEN
                    itype = 10
                ELSE 
                    PRINT "getvtype:Switch:Default \n"
'                       possible error
                END IF
            END IF
        END IF
    ELSE IF ch$ = "(" THEN
        itype = 11
    END IF
    ireturn = itype
END SUB
' ==========================================
'
' ==========================================
SUB getDvtype
    LOCAL ch$
    LOCAL chx$
    LOCAL sstr$
    LOCAL itype
    LOCAL isstr
    LOCAL ii
'
    ch$ = MID$(pstring$, pii, 1)
    sstr$ = "%!#@&"

'  PRINT "ch$=", ch$, "< \n"
'  PRINT "    CALL inStrChr: \n"

    CALL inStrChr(sstr$, ch$)
    isstr = ireturn

'  PRINT "isstr=", isstr, "\n"
    IF ch$ = "$" THEN
        itype = 0
        ii = pii + 1
        ch$ = MID$(pstring$, ii, 1)
        IF ch$ = "(" THEN
            itype = 6
        END IF
    ELSE IF isstr <> bFALSE THEN
        CALL getNvtype()
        itype = ireturn
        ii = pii + 1
        chx$ = MID$(pstring$, ii, 1)
        ii = ASC(ch$)
        IF chx$ = "(" THEN
            IF ii = 37 THEN
                itype = 7
            ELSE IF ii = 33 THEN
                itype = 8
            ELSE IF ii = 35 THEN
                itype = 9
            ELSE IF ii = 64 THEN
                itype = 10
            ELSE IF ii = 38 THEN
                itype = 10
            ELSE 
                PRINT "getDvtype:switch: \n"
            END IF
        END IF
    ELSE IF ch$ = "(" THEN
        itype = 11
    ELSE
'                               --- ch$ = space
        itype = 1
    END IF
    ireturn = itype
' PRINT "    exit:getDvtype: \n"
END SUB
' ==========================================
'
' ==========================================
SUB getDigit
    LOCAL ch$
    LOCAL chx 
'
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
    WHILE chx > 47 AND chx < 58 AND pii < ilen
        pii = pii + 1
        ch$ = MID$(pstring$, pii, 1)
        chx = ASC(ch$)
    WEND
END SUB
' ==========================================
'
' ==========================================
SUB getAlnum
    LOCAL test 
'                               Terminates with pii pointing at the first alpha-numeric 
'                               character.
    CALL isThisAlnum()
    test = ireturn
    WHILE test = bFALSE AND pii < ilen
        pii = pii + 1
        CALL isThisAlnum()
        test = ireturn
    WEND
END SUB
' ==========================================
'
' ==========================================
SUB BuildArrays
    UNDEF ForArray$
    UNDEF labelEndif$
    UNDEF labelBlock$
    UNDEF labelElseif$
    UNDEF labelElse$
    UNDEF WhileArray$
    UNDEF LoopArray$
    UNDEF BreakArray$
'
    ForArray$[128] = ""
    labelEndif$[128] = ""
    labelBlock$[128] = ""
    labelElseif$[128] = ""
    labelElse$[128] = ""
    WhileArray$[128] = ""
    LoopArray$[128] = ""
    BreakArray$[128] = ""
'  PRINT "  exit:BuildArrays:"
END SUB
' ==========================================
'
' ==========================================
SUB clrArrays
    UNDEF tempByte
    UNDEF tempLabel$
    UNDEF tempProg$
'
    UNDEF byteArray
    UNDEF labelNam$
    UNDEF array1$
END SUB
' ==========================================
'
' ==========================================
SUB clrtmpArrays
    UNDEF tempByte
    UNDEF tempLabel$
    UNDEF tempProg$
END SUB
' ==========================================
'
' ==========================================
SUB KillArrays
    UNDEF ForArray$
    UNDEF labelEndif$
    UNDEF labelBlock$
    UNDEF labelElseif$
    UNDEF labelElse$
    UNDEF WhileArray$
    UNDEF LoopArray$
    UNDEF BreakArray$
END SUB
' ==========================================
'
' ==========================================
SUB getNvtype
    LOCAL ch$
    LOCAL sstr$
    LOCAL itype 
    LOCAL test 
    itype = 0
'
    CALL whileIsAlnum()
    ch$ = MID$(pstring$, pii, 1)
    sstr$ = CHR$(34) & ",; )=+*-/" & CHR$(13) & CHR$(10)
    CALL inStrChr(sstr$, ch$)
    test = ireturn
'
    IF test <> bFALSE THEN
        itype = 1
    ELSE IF ch$ = "%" THEN
        itype = 2
    ELSE IF ch$ = "!" THEN
        itype = 3
    ELSE IF ch$ = "#" THEN
        itype = 4
    ELSE IF ch$ = "@" THEN
        itype = 5
    ELSE IF ch$ = "&" THEN
        itype = 5
    END IF
'
    ireturn = itype
'
END SUB
' ==========================================
' ==========================================
'
' -------------------------------------------
' ========== BASNINPT: Sub Routines ==========
'
' ==========================================
SUB ScanNumeric(name$)
    LOCAL ch$
    LOCAL varname$
    LOCAL sstr$
    LOCAL itype 
    LOCAL ival 
    LOCAL funcflag 
    LOCAL isalnum 
    LOCAL isdigit 
    LOCAL isalpha 
    LOCAL stch 
'
    varname$ = name$
    pii = epos
    ilen = LEN(pstring$)
    spos = pii - ilen
    CALL getNvtype()
    itype = ireturn
'
    CALL SavDestin(itype, varname$)
    pii = epos
    ilen = LEN(pstring$)

'   save:------------------------------------ parse data types
'
'    WHILE pii < ilen
'        ch$ = MID$(pstring$, pii, 1)
'        sstr$ = "." & CHR$(34)
'        CALL inStrChr(sstr$, ch$)
'        stch = ireturn
'        CALL isAlnum(ch$)
'        isalnum = ireturn
'
'        WHILE isalnum = bFALSE AND pii < ilen AND stch = bFALSE
'            pii = pii + 1
'            ch$ = MID$(pstring$, pii, 1)
'
'            IF ch$ = "?" THEN
'                epos = pii + 1
'                CALL getavalue()
'                ival = dreturn
'
'                IF ival = 10 OR ival = 11 OR ival = 29 THEN
'                    pii = ilen
'                ELSE
'                    CALL getParen()
'                    ch$ = MID$(pstring$, pii, 1)
'                    funcflag = 1
'                END IF
'            END IF
'            CALL inStrChr(sstr$, ch$)
'            stch = ireturn
'            CALL isAlnum(ch$)
'            isalnum = ireturn
'        WEND
'        IF pii < ilen THEN
'            epos = pii
'            CALL isadigit(ch$)
'            isdigit = ireturn
'            CALL isanAlpha(ch$)
'            isalpha = ireturn
'
'            IF funcflag = 1 THEN
'                CALL ScanMathFunc()
'                funcflag = 0
'            ELSE IF isdigit = bTRUE OR ch$ = "." THEN
'                CALL GetNewTmp()
'            ELSE IF isalpha = bTRUE THEN
'                pii = epos
'                CALL getVarname()
'                varname$ = rvarName$
'                CALL getObjectType(varname$)
'                itype = ireturn
'
'                IF itype >= 7 AND itype <= 10 THEN
'                    CALL FixVarArray(varname$)
'                    pii = epos
'                    CALL getParen()
'                    CALL ScanArrayParam()
'                ELSE
'                    epos = pii
'                    CALL AddNewVar()
'                END IF
'            END IF
'            pii = epos
'            ilen = LEN(pstring$)
'        END IF
'    WEND
'
END SUB
' ==========================================
'
' ==========================================
SUB SavDestin(itype, name$)
    LOCAL ch$
    LOCAL varname$
    LOCAL sstr$
    LOCAL dout$
    LOCAL ntype 
    LOCAL stch 
    LOCAL ckVrnam 
    LOCAL code 
    LOCAL xx 
'
    code = 5
    xx = lineNdx
    varname$ = name$
    ntype = itype
'
    pii = epos
    ch$ = MID$(pstring$, pii, 1)
    sstr$ = "%!#@&"
    CALL inStrChr(sstr$, ch$)
    stch = ireturn
'
    IF stch <> bFALSE THEN
        ch$ = " "
        CALL insertStr(pstring$, ch$, pii)
    END IF
'
    IF ntype = 1 OR ntype = 2 THEN
        CALL checkVarName(varname$)
        ckVrnam = ireturn
'
        IF ckVrnam = 0 THEN
            dout$ = "    int " & varname$ & ";\n"
            PRINT #4, dout$
'
            ix = 0
            CALL SavObjName(varname$, ntype, ix)
        END IF
    ELSE IF ntype >= 3 AND ntype <= 5 THEN
        PRINT "\n\nData type not yet supported.\n"
        CALL Abort(code, xx)
'
        CALL checkVarName(varname$)
        ckVrnam = ireturn
        IF ckVrnam = 0 THEN
'            dout$ = "    float " & varname$ & ";\n"
'            PRINT #5, dout$
'
            ix = 0
            CALL SavObjName(varname$, ntype, ix)
        END IF
    ELSE
        CALL Abort(code, xx)
    END IF
'
    CALL StorNVar(varname$)
'
END SUB
' ==========================================
'
' ==========================================
SUB StorNVar(name$)
    LOCAL ch$
    LOCAL varname$
    LOCAL ii 
    LOCAL isalpha 
    LOCAL xx
    LOCAL chx 
'
    sHolder$ = ""
    varname$ = name$
'
    ilen = LEN(varname$)
    ii = spos + ilen
'
    IF spos > 1 THEN
        FOR xx = 1 TO spos
            ch$ = MID$(pstring$, xx, 1)
            sHolder$ = sHolder$ & ch$
        NEXT xx
    END IF
    sHolder$ = sHolder$ & varname$
    spos = ii
    pii = epos
    ch$ = MID$(pstring$, pii, 1)
    chx = ASC(ch$)
'                       --- WHILE chx <> 0
    WHILE chx <> undef
        sHolder$ = sHolder$ & ch$
        pii = pii + 1
        ch$ = MID$(pstring$, pii, 1)
        chx = ASC(ch$)
    WEND
'                      --- save pstring$ to array ---
    pstring$ = sHolder$
    Array1$[lineNdx] = pstring$
    ch$ = MID$(pstring$, spos, 1)
    CALL isanAlpha(ch$)
    isalpha = ireturn
'
    IF isalpha = bTRUE THEN
        ii = pii
        pii = spos
        CALL getNextOP()
        spos = pii
        pii = ii
    END IF
    epos = spos
'
END SUB
' ==========================================
'
' -------------------------------------------
' ========== ERROR: Error Routines ==========
' ===========================================
SUB Abort(code, xx)
    LOCAL t$
    LOCAL ret$
    LOCAL beep$
'
    t$ = CHR$(9)
    ret$ = CHR$(13) & CHR$(10)
    beep$ = CHR$(7)
'
    PRINT "Abort !!! \n"
    PRINT "Code:", code, "\n"
    PRINT pstring$
    PRINT "Byte:", xx, "\n"
'
    PRINT beep$
'
    IF code = 1 THEN
        PRINT "Unspecified Program Name. \n"
        PRINT "Enter: scriba gbasic.bas name.bas \n"
        PRINT "code(", code, ") \n"
    ELSE IF code = 2 THEN
        PRINT "Program file:\t", SourceFile$, " \tnot found. \n"
        PRINT "Enter: scriba gbasic.bas name.bas \n"
        PRINT "Program Terminated. \n"
        PRINT "code(", code, ") \n"
    ELSE IF code = 3 THEN
        PRINT ret$, "Syntax error: in program line:", xx, "\n"
        PRINT pstring$
        PRINT "Keywords must be in UpperCase: \n"
        PRINT "code(", code, ") \n"
    ELSE IF code = 4 THEN
        PRINT ret$, "Syntax error: in program line:", xx, "\n"
        PRINT pstring$
        PRINT "Unknown Command. \n"
        PRINT "code(", code, ") \n"
    ELSE IF code = 5 THEN
        PRINT ret$, "Variable Type error: in program line:", xx, "\n"
        PRINT pstring$
        PRINT "Type must be: Long %.\n"
        PRINT "code(", code, ")\n"
    ELSE 
        PRINT "Program aborted, undefined error. \n"
'
    END IF
'            --- STOP on ALL errors ---
    END
'
END SUB
' ===========================================
' ===========================================
'
' ===========================================
SUB DumpIt
'                               Sub "DumpIt" is for illustration purposes only. It displays 
'                               the final output of the translator. It reads-in the C source 
'                               file and displays to the console.
    PRINT "\n\n"
    OPEN Destin$ FOR INPUT AS #1
Start2:
    IF EOF(1) THEN
        GOTO Finish2
    END IF
    LINE INPUT #1, pstring$
'
    IF pstring$ = "" THEN
        GOTO Start2
    END IF
'
    PRINT pstring$
    GOTO Start2
'    
Finish2:
    CLOSE 1
    PRINT "\n\n"
END SUB
' ===========================================
' ===========================================
'