'The idea of this program is to convert QB source code into nasm source code.
'I have spent a long time searching the net for a program that does this, but
'to no avail. So i have decided to write this.
'I am trying to keep as close to the Qbasic / QB syntax as possible, while
'adding what i consider to be usefull additions.
'I eventually hope to create a linux version as well.
'This program is completely free for you to use as you wish,
'(but please acknowlege me).
'The only other thing I ask is that if you modify it please send me a copy of
'the modified source code.
'If you have any questions comments etc. please email me: nrdark92@yahoo.co.uk
'Please send your modifications to the above address as well.
'The B2NASM website can be found at b2nasm.sourceforge.net

DECLARE SUB docls ()
DECLARE SUB alloc (vname AS STRING, valu AS STRING, esc AS INTEGER)
DECLARE SUB abort (text AS STRING)
REM Please send any bugs and comments to nrdark92@dark92.yahoo.co.uk

DECLARE SUB dodeclare ()
DECLARE SUB doinput ()
DECLARE SUB doasm ()
DECLARE SUB docomment ()
DECLARE SUB printf ()
DECLARE SUB varprint ()
DECLARE SUB prolog ()
DECLARE SUB epilog ()
DECLARE SUB fin ()
DECLARE SUB relation ()
DECLARE SUB equals ()
DECLARE SUB nequals ()
DECLARE SUB less ()
DECLARE SUB greater ()
DECLARE FUNCTION isrelop! (c AS STRING)
DECLARE SUB dowhile ()
DECLARE SUB other ()
DECLARE SUB condition ()
DECLARE SUB doif ()
DECLARE SUB postlabel (label AS STRING)
DECLARE FUNCTION newlabel$ ()
DECLARE SUB boolnot ()
DECLARE SUB boolan ()
DECLARE SUB booland ()
DECLARE SUB boolterm ()
DECLARE FUNCTION isorop! (str AS STRING)
DECLARE SUB boolor ()
DECLARE SUB boolxor ()
DECLARE SUB boolexpression ()
DECLARE FUNCTION isboolean! (c AS STRING)
DECLARE FUNCTION getboolean! ()
DECLARE SUB doprog ()
DECLARE SUB block ()
DECLARE SUB skipwhite ()
DECLARE FUNCTION iskey! (str AS STRING)
DECLARE SUB term ()
DECLARE SUB mexp ()
DECLARE FUNCTION ismathop! (char AS STRING)
DECLARE SUB expression ()
DECLARE SUB match (char AS STRING)
DECLARE SUB expected (str AS STRING)
DECLARE SUB assignment ()
DECLARE SUB emitln (str AS STRING)
DECLARE SUB getchar ()
DECLARE FUNCTION scan$ ()
DECLARE SUB init ()
DECLARE FUNCTION isalnum! (char AS STRING)
DECLARE FUNCTION isnum! (char AS STRING)
DECLARE FUNCTION isalpha! (char AS STRING)
'*************************************
'global vars
DIM SHARED buffer AS STRING
DIM SHARED look AS STRING
DIM SHARED linepos AS INTEGER
DIM SHARED ltoken AS STRING
DIM SHARED itype AS INTEGER     'current input type from scan
                                '1 = keyword, 2 = variable
                                '3 = numeric cont. 4 = function
DIM SHARED token AS STRING
DIM SHARED lcount AS INTEGER    'label count.
DIM SHARED lm1 AS STRING        'previous look
DIM SHARED vmax AS INTEGER
'DIM SHARED var(20) AS STRING
DIM SHARED char AS STRING * 1   'get next char from file
DIM SHARED relop AS INTEGER     'did we call >, < etc.  1= '<', 3= '='
                                '                       2= '>'  4= 'not ='
TYPE vartable
        name AS STRING * 8
        value AS STRING * 20
        newline AS INTEGER
END TYPE

DIM SHARED var(20)  AS vartable

'*************************************
'initial var declarations
linepos = 0
'*************************************
CLS
'*************************************
init
prolog
doprog

SUB abort (text AS STRING)
PRINT text
SYSTEM
END SUB

SUB alloc (vname AS STRING, valu AS STRING, newline AS INTEGER)
vmatch = 0

FOR I = 0 TO vmax
        IF var(I).name = vname THEN
                vmatch = 1
                abort ("Variable Redefined: " + vname)
                EXIT FOR
        ELSE
                vmatch = 0
        END IF
NEXT

IF vmatch = 0 THEN
        var(vmax).name = vname
        var(vmax).value = valu
        var(vmax).newline = newline
        vmax = vmax + 1
END IF
END SUB

SUB assignment
'variable$ = scan$
skipwhite
variable$ = token
match ("=")

IF look = "+" OR look = "-" THEN emitln ("mov ax,0")
expression
IF itype = 1 THEN EXIT SUB
emitln ("mov word[" + variable$ + "],ax")
'alloc variable$
'PRINT #3, variable$ + " dw 0"
trsh$ = scan
END SUB

SUB block
fin
skipwhite
'strg$ = scan
WHILE NOT token = "end"
'        strg$ = scan$
        SELECT CASE (token)
                CASE "if"
                        doif
                CASE "endif"
                        GOTO nnd
                CASE "else"
                        GOTO nnd
                CASE "while"
                        dowhile
                CASE "wend"
                        GOTO nnd
                CASE "end"
                        GOTO nnd
                CASE "print"
                        printf
                CASE "rem"
                        docomment
                CASE "input"
                        doinput
                CASE "dim"
                        dodeclare
                CASE "cls"
                        docls
                CASE ELSE
                        assignment
        END SELECT
        fin
skipwhite
WEND
nnd:
END SUB

SUB boolan
boolterm
emitln ("pop bx")
emitln ("and bx,ax")
END SUB

SUB booland
boolterm
emitln ("pop bx")
emitln ("and ax,bx")

END SUB

SUB boolexpression
skipwhite
'IF token = "not" THEN
        IF isboolean(token) = 0 THEN
                relation
        ELSE
        boolterm
        skipwhite
        erm$ = scan
        WHILE isorop(erm$) = 1
                emitln ("push ax")
                SELECT CASE erm$
                        CASE "OR"
                                boolor
                        CASE "XOR"
                                boolxor
                        CASE "AND"
                                booland
                        CASE ELSE
                                relation
                END SELECT
                erm$ = scan
        WEND
        
        END IF
END SUB

SUB boolnot
'IF UCASE$(scan) = "NOT" THEN
'        nflag = 1
'ELSE
'        nflag = 0
'END IF
boolexpression
emitln ("not ax")
END SUB

SUB boolor
boolterm
emitln ("pop bx")
emitln ("or ax,bx")
END SUB

SUB boolterm
IF getboolean = 1 THEN
        emitln ("mov ax,-1")
ELSE
        emitln ("mov ax,0")
END IF
END SUB

SUB boolxor
boolterm
emitln ("pop bx")
emitln ("xor ax,bx")
END SUB

SUB condition
emitln ("<condition>")
END SUB

SUB docls
REM clear screen
emitln ("mov cx,4000")
emitln ("push es")
emitln ("mov ax,0xb800")
emitln ("mov es,ax")
lab$ = newlabel

emitln ("mov di,0x0000")
emitln ("mov ax,0x0700")
postlabel (lab$)
emitln ("stosw")
emitln ("sub cx,2")
emitln ("cmp cx,0")
emitln ("jne " + lab$)

REM move curser
emitln ("mov ah,0x02")
emitln ("mov bh,0")
'emitln ("mov al,0x00")
'emitln ("mov cx,0x00")
emitln ("mov dx,0x0000")
emitln ("int 0x10")

trash$ = scan
END SUB

SUB docomment
DO UNTIL look = CHR$(10)
getchar
LOOP
trash$ = scan
END SUB

SUB dodeclare
trash$ = scan
varname$ = token
match ","
trash$ = scan
varval$ = token
'PRINT #3, varname$ + " dw " + varval$
alloc varname$, CHR$(0), 0
trash$ = scan
END SUB

SUB doif
'match ("IF")
DIM l2 AS STRING

label$ = newlabel$
l2 = label$

'condition
boolexpression
'emitln ("cmp ax,0")
'emitln ("jz " + label$)
skiplabel$ = newlabel
IF relop = 1 THEN
        emitln ("jb " + skiplabel$)
ELSEIF relop = 2 THEN
        emitln ("ja " + skiplabel$)
ELSEIF relop = 3 THEN
        emitln ("je " + skiplabel$)
ELSEIF relop = 4 THEN
        emitln ("jne " + skiplabel$)
END IF
emitln ("jmp " + label$)
postlabel (skiplabel$)

trash$ = scan
match ("then")
trash$ = scan

fin
block
        IF token = "else" THEN
                match ("else")
                l2 = newlabel$
                emitln ("jmp " + l2)
                postlabel (label$)
                fin
                trash$ = scan$
                block
        END IF

match ("endif")
postlabel (l2$)
strg$ = scan$
END SUB

SUB doinput
trash$ = scan

variable$ = token$
'alloc variable$
'PRINT #3, variable$ + " dw 0"
emitln ("mov ah,1")
emitln ("int 0x21")
emitln ("mov ah,0")
'********
emitln ("sub ax,0x30")
'********
emitln ("mov word[" + variable$ + "],ax")

trash$ = scan
END SUB

SUB doprog
block
'IF LCASE$(token) <> "end" THEN expected ("End")
epilog
END SUB

SUB dowhile

l1$ = newlabel$
l2$ = newlabel$

postlabel (l1$)
'condition
boolexpression
'emitln ("cmp ax,0")
'emitln ("jz " + l2$)
skiplabel$ = newlabel
IF relop = 1 THEN
        emitln ("jb " + skiplabel$)
ELSEIF relop = 2 THEN
        emitln ("ja " + skiplabel$)
ELSEIF relop = 3 THEN
        emitln ("je " + skiplabel$)
ELSEIF relop = 4 THEN
        emitln ("jne " + skiplabel$)
END IF
emitln ("jmp " + l2$)
postlabel (skiplabel$)
fin
trash$ = scan$
'fin
block
emitln ("jmp " + l1$)
match ("wend")
postlabel (l2$)
trash$ = scan

END SUB

SUB emitln (str AS STRING)
PRINT "         " + str
PRINT #1, str
END SUB

SUB epilog
emitln ("mov ah,0x4c")
emitln ("mov al,0x00")
emitln ("int 0x21")
varprint
CLOSE #1
CLOSE #3
END SUB

SUB equals
match ("=")
expression
emitln ("pop bx")
emitln ("cmp bx,ax")
relop = 3
END SUB

SUB expected (str AS STRING)
PRINT str + " Expected"
PRINT "line: " + STR$(linepos)
SYSTEM
END SUB

SUB expression
IF look = "(" THEN
        match ("(")
        expression
        IF look = (")") THEN match (")")
        mexp
        IF ismathop(look) = 1 THEN expression
ELSE
        IF ismathop(look) = 1 THEN
                mexp
        ELSE
                term
                IF isrelop(look) = 1 THEN lmm1 = 1: EXIT SUB
                
        END IF
        IF ismathop(look) = 1 THEN mexp
        IF itype = 3 THEN EXIT SUB
        IF itype = 1 THEN EXIT SUB
        IF lmm1 = 1 THEN lmm1 = 0: EXIT SUB
        IF NOT look = "" AND NOT look = ")" THEN expression
        IF look = ")" THEN EXIT SUB
END IF
END SUB

SUB fin
DO WHILE look = CHR$(10)
skipwhite
IF token = "end" THEN EXIT SUB
IF look = CHR$(13) THEN getchar
IF look = CHR$(10) THEN
        linepos = linepos + 1
'        INPUT "", buffer
'        buffer = buffer + CHR$(10)
        getchar
END IF
LOOP
END SUB

FUNCTION getboolean
strg$ = scan$
IF UCASE$(strg$) = "NOT" THEN
        strg$ = scan$
        IF NOT isboolean(strg$) = 1 THEN expected ("boolean literal")
        IF UCASE$(strg$) = "T" THEN
                etboolean = 1
        ELSE
                etboolean = 0
        END IF

        IF etboolean = 1 THEN getboolean = 0 ELSE getboolean = 1
ELSE
        IF NOT isboolean(strg$) = 1 THEN expected ("boolean literal")
        IF UCASE$(strg$) = "T" THEN
                getboolean = 1
        ELSE
                getboolean = 0
        END IF
END IF
'getchar
END FUNCTION

SUB getchar
'linepos = linepos + 1
'look = MID$(buffer, linepos, 1)
GET #2, , char
lm1 = look
look = char
END SUB

SUB greater
match (">")
expression
emitln ("pop bx")
emitln ("cmp bx,ax")
relop = 2
END SUB

SUB init

OPEN "output.s" FOR OUTPUT AS #1
OPEN "b2ntest.bas" FOR BINARY AS #2

lcount = 0
linepos = 1
PRINT
getchar
trash$ = scan
END SUB

FUNCTION isalnum (char AS STRING)
IF isalpha(char) = 1 THEN isalnum = 1
IF isnum(char) = 1 THEN isalnum = 1
END FUNCTION

FUNCTION isalpha (char AS STRING)

IF char = "" THEN expected ("String or Varible")
IF (ASC(UCASE$(char)) > 64 AND ASC(UCASE$(char)) < 91) OR ASC(char) = 92 OR ASC(char) = 34 THEN
        isalpha = 1
ELSE
        isalpha = 0
        IF UCASE$(char) = "(" OR UCASE$(char) = ")" THEN isalpha = 1
END IF
END FUNCTION

FUNCTION isboolean (c AS STRING)
c = UCASE$(c)
IF c = "T" OR c = "F" THEN
        isboolean = 1
ELSE
        isboolean = 0
END IF
END FUNCTION

FUNCTION iskey (str AS STRING)
iskey = 0
kwmax = 10       'holds number of last keyword
DIM keyword(kwmax) AS STRING

'**********keywords***********
keyword(1) = "IF"
keyword(2) = "WHILE"
keyword(3) = "WEND"
keyword(4) = "END"
keyword(5) = "ELSE"
keyword(6) = "ENDIF"
keyword(7) = "PRINT"
keyword(8) = "REM"
keyword(9) = "INPUT"
keyword(10) = "DIM"
'*****************************

FOR ctr = kwmax TO 0 STEP -1
        IF UCASE$(str) = keyword(ctr) THEN
                iskey = 1
                EXIT FOR
        ELSE
                iskey = 0
        END IF
NEXT
END FUNCTION

FUNCTION ismathop (char AS STRING)
SELECT CASE char
        CASE "+"
                ismathop = 1
        CASE "-"
                ismathop = 1
        CASE "*"
                ismathop = 1
        CASE "/"
                ismathop = 1
        CASE ELSE
                ismathop = 0
END SELECT
END FUNCTION

FUNCTION isnum (char AS STRING)
skipwhite
IF char = "" THEN expected ("Numeric constant")
IF ASC(char) > 47 AND ASC(char) < 58 THEN
        isnum = 1
ELSE
        isnum = 0
END IF
END FUNCTION

FUNCTION isorop (str AS STRING)
str = UCASE$(str)
IF str = "OR" OR str = "XOR" OR str = "AND" THEN
        isorop = 1
ELSE
        IF str = "AND" THEN
                isorop = 1
        ELSE
                isorop = 0
        END IF
END IF
END FUNCTION

FUNCTION isrelop (c AS STRING)
SELECT CASE c
        CASE "="
                isrelop = 1
        CASE "#"
                isrelop = 1
        CASE ">"
                isrelop = 1
        CASE "<"
                isrelop = 1
        CASE ELSE
                isrelop = 0
END SELECT
END FUNCTION

SUB less
match ("<")
expression
emitln ("pop bx")
emitln ("cmp bx,ax")
relop = 1
END SUB

SUB match (char AS STRING)
char = UCASE$(char)
IF LEN(char) = 1 THEN
        IF NOT look = char THEN
                expected (char)
        ELSE
                getchar
        END IF
ELSE
        IF NOT ltoken = char THEN
                expected (char)
        ELSE
                'trash$ = scan$
        END IF

END IF
skipwhite
END SUB

SUB mexp
SELECT CASE look
        CASE "+"
                match ("+")
                IF look = ("(") THEN emitln ("push ax"): expression
                'IF look = "" THEN EXIT SUB
                emitln ("push ax")
                IF NOT look = "" THEN term
                'IF look = "" THEN emitln ("pop ax")
                
                emitln ("pop bx")
                emitln ("add ax,bx")
        CASE "-"
                match ("-")
                IF look = ("(") THEN emitln ("push ax"): expression
                'IF look = "" THEN EXIT SUB
                emitln ("push ax")
                IF NOT look = "" THEN term
                'IF look = "" THEN emitln ("pop ax")
                emitln ("pop bx")
                emitln ("sub ax,bx")
                emitln ("neg ax")
        CASE "*"
                match ("*")
                IF look = ("(") THEN emitln ("push ax"): expression
                'IF look = "" THEN EXIT SUB
                emitln ("push ax")
                IF NOT look = "" THEN term
                'IF look = "" THEN emitln ("pop ax")
                emitln ("pop bx")
                emitln ("mul bx")

        CASE "/"
                match ("/")
                IF look = ("(") THEN emitln ("push ax"): expression
                'IF look = "" THEN EXIT SUB
                emitln ("push ax")
                IF NOT look = "" THEN term
                'IF look = "" THEN emitln ("pop ax")
                emitln ("xchg ax,bx")
                emitln ("pop bx")
                emitln ("div bx")

END SELECT
END SUB

SUB nequals
match ("#")
expression
emitln ("pop bx")
emitln ("cmp ax,bx")
relop = 4
END SUB

FUNCTION newlabel$
newlabel$ = "l" + RIGHT$(STR$(lcount), LEN(STR$(lcount)) - 1)
lcount = lcount + 1
END FUNCTION

SUB other
emitln (token)
trash$ = scan$
END SUB

SUB postlabel (label AS STRING)
'PRINT label + ":"
emitln (label + ":")
END SUB

SUB printf
tmp$ = ""
'var$ = scan
IF look = CHR$(34) THEN
        getchar
        DO UNTIL look = CHR$(34)
                tmp$ = tmp$ + look
                getchar
        LOOP
        trash$ = scan

        IF look = ";" THEN
                nl = 0
        ELSE
                nl = 1
        END IF
        vvar$ = newlabel
        IF nl = 0 THEN
                alloc vvar$, tmp$, 0
        ELSEIF nl = 1 THEN
                alloc vvar$, tmp$, 1
        END IF
        emitln ("mov dx, " + vvar$)
        emitln ("mov ah,9")
        emitln ("int 0x21")
        getchar

ELSE
        vvar$ = scan
        emitln ("mov dx, word[" + vvar$ + "]")
        emitln ("add dl,0x30")
        emitln ("mov ah,2")
        emitln ("int 0x21")

        'trash$ = scan
        
        IF look = ";" THEN
        match (";")
        ELSE
                emitln ("mov dl,0x0a")
                emitln ("mov ah,2")
                emitln ("int 0x21")
        END IF
       
END IF

trash$ = scan
END SUB

SUB prolog
emitln ("[bits 16]")
emitln ("org 0x100")
emitln ("[section .text]")

END SUB

SUB relation
expression
IF isrelop(look) THEN
        emitln ("push ax")
        SELECT CASE look
                CASE "="
                        equals
                CASE "#"
                        nequals
                CASE "<"
                        less
                CASE ">"
                        greater
        END SELECT
END IF
END SUB

FUNCTION scan$
skipwhite
fin
skipwhite
token = ""
'IF look = "." THEN SYSTEM
IF token = "end" THEN EXIT FUNCTION
IF isalpha(look) = 1 THEN
        DO WHILE isalnum(look) = 1
                token = token + look
                getchar
                IF look = "" THEN GOTO nd
        LOOP
ELSEIF isnum(look) = 1 THEN
        DO WHILE isnum(look) = 1
                token = token + look
                getchar
                IF look = "" THEN GOTO nd
        LOOP
END IF
nd:
IF isnum(LEFT$(token, 1)) = 1 THEN
        itype = 3
ELSEIF iskey(token) = 1 THEN
                itype = 1
ELSEIF RIGHT$(token, 2) = "()" THEN itype = 4
ELSE
                itype = 2
END IF
ltoken = UCASE$(token)
scan$ = token
skipwhite
'fin
END FUNCTION

SUB skipwhite
'WHILE look = " " OR look = CHR$(9)
'        getchar
'WEND
DO
        IF look = " " THEN
                getchar
        ELSEIF look = CHR$(9) THEN
                getchar
        ELSE
                EXIT DO
        END IF
LOOP
END SUB

SUB term
erm$ = scan$
IF itype = 3 THEN
        emitln ("mov ax, " + erm$)
ELSEIF itype = 2 THEN
        emitln ("mov ax, word[" + erm$ + "]")
       ' alloc erm$
ELSEIF itype = 4 THEN
        emitln ("call " + erm$)
END IF
END SUB

SUB varprint
emitln ("[section .data]")
FOR I = 0 TO vmax - 1
        IF LEFT$(var(I).value, 1) = CHR$(0) THEN
                emitln (var(I).name + " dw 0")
        ELSE
                IF var(I).newline = 0 THEN
                        emitln (var(I).name + " dw '" + var(I).value + "','$'")
                ELSE
                        emitln (var(I).name + " dw '" + var(I).value + "',0x0a,'$'")
                END IF
        END IF
NEXT

END SUB

SUB vartab (var AS STRING)

END SUB

