$typecheck on
$apptype console
$include </usr/include/srapidq.inc>
'*************************************
' $Id: b2nasm.bas,v 1.13 2003/11/03 01:59:40 nick Exp $
'
'B2Nasm - Basic to Nasm compiler
'Copyright (C) 2003  Nicholas Dark
'For more information, see license.txt

'The idea of this program is to convert QB 'like' 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.

'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
'
' Please use the sourceforge bug tracking system to report any bugs thankyou.
' The tracking system can be found at: 
' http://sourceforge.net/tracker/?func=add&group_id=68925&atid=522847
' or follow the link on the web site.
'***************Function decs*********
declare sub init
declare sub block
declare sub token
declare sub assignment(vvar as string)
declare sub match(text as string)
declare sub expected(text as string)
declare sub abort (text as string)
declare sub expression
declare sub emitln(text as string)
declare sub addop
declare sub subop
declare sub mulop
declare sub divop
declare sub term
declare sub prolog
declare sub vardec
declare sub libinc (filename as string)
declare sub libdec
declare sub doprint
declare sub doif
declare sub dofor
declare sub doinput 
declare sub allocvar(text as string,isstr as byte,valu as string)
declare sub postlabel(label as string)
declare sub relop(label as string)
declare sub bssdec
declare sub strexpression
declare function genlabel as string
declare function getchar(,)  as string
declare function isnum(text as string) as byte
declare function isalpha(text as string) as byte
declare function isspecial (text as string)  as byte
'***************Globals*********
dim a as string
dim infile as qfilestream
dim outfile as qfilestream
dim libfile as qfilestream
'dim look as string * 1
dim llook as string
dim lb as string 
dim tchar as string 
const filein="/home/nicky/b2nasm/test.bas"
const fileout="/home/nicky/b2nasm/test.s"
const maxvar=20
const maxinc=5
type var
	name as string * 8
	isstring as byte	'if the var is a string, isstring=1
	val as string * 32	'max size for strings
end type
dim st(maxvar) as var
dim linc(maxinc) as string
dim lab as integer
dim linectr as integer

'***************Main************
const linux=0 ' if 1, we generate Linux elf's, if 0 we gen. DOS .com files
	      ' this will probably be a cmd line option at some point.

init
token
block
if linux=0 then
	emitln "mov ax,0x4c00"
	emitln "int 0x21"
else
	emitln "push dword 0"
	emitln "call _exit"
end if
libdec
vardec
bssdec

infile.close
outfile.close
if linux=0 then
	shell "nasm -t -fbin " + fileout + " -o test.com"
else
	shell "nasm -f elf "+fileout
	shell "gcc -Wall -s -nostartfiles test.o"
end if

'**************Subs / Funcs****
'******************************
sub strexpression
dim var as string
var=""
if not llook="=" then expected "="
token
var=llook

end sub
'******************************
sub doinput
dim var as string

token
var = llook
allocvar var,0,""
libinc "putc.inc"
libinc "getc.inc"
libinc "geti.inc"
emitln "call geti"
emitln "mov ["+var+"], ax"
token
end sub
'******************************
sub dofor
dim l1 as string
dim l2 as string
dim var as string

token
l1=genlabel
l2=genlabel

var =llook
allocvar var,0,""
match ("=")
expression
emitln("mov ["+var+"],ax")
if not llook="to" then expected "TO"
token
if isnum(llook)=1 then
	emitln "mov bx, "+llook
else
	emitln "mov bx, ["+llook+"]"
end if
emitln "push bx"
emitln "push ax"
postlabel l1
emitln "pop ax"
emitln "pop bx"
emitln "cmp ax,bx"
emitln "ja "+l2
emitln "push bx"
emitln "push ax"
token
block
emitln "pop ax"
emitln "inc ax"
emitln "mov ["+var+"],ax"
emitln "push ax"
emitln "jmp "+l1
postlabel l2
if not llook="next" then expected"NEXT"
token
end sub
'******************************
sub dowhile
dim l1 as string
dim l2 as string
dim skip as string

l1=genlabel
l2=genlabel
skip=genlabel

postlabel l1
expression
relop skip
emitln "jmp "+l2
postlabel skip
block
print "llook: "+llook
if not llook="wend" then expected "wend"
emitln "jmp "+l1
postlabel l2
token
end sub
'******************************
sub doif
dim label1 as string
dim label2 as string
label1=genlabel
label2=label1
expression
relop (label1)
if not llook="then" then expected "THEN"
token
Block
if llook = "else" then
	label2 = genLabel
        EmitLn ("jmp " + label2)
        PostLabel(label1)
        token
	print "doif: "+llook
	Block
end if
if not llook="endif" then expected "ENDIF"
PostLabel(label2)
token
end sub
'******************************
sub relop(label as string)
dim operator as string *1
emitln "push ax"
'if not llook=">" or not llook="<" then token
select case llook
	case ">"
	case "<"
	case "="
	case "!"
	case else
		token
end select
operator = llook
expression
select case operator
	case ">"
		emitln "pop bx"
		emitln "cmp  ax,bx"
		emitln "ja "+label
	case "<"
		emitln "pop bx"
		emitln "cmp  ax,bx"
		emitln "jb "+label	
	case "="
		emitln "pop bx"
		emitln "cmp  ax,bx"
		emitln "jne "+label
	case "!"
		emitln "pop bx"
		emitln "cmp  ax,bx"
		emitln "je "+label
end select
end sub
'******************************
sub doprint
dim newv as string
dim temp as string
temp=""
token
if isnum(llook)=1 then
	emitln "mov ax, "+llook
	allocvar llook,0,""
else
	if right$(llook,1)="$" then
		emitln("mov si, "+llook)
		libinc "putc.inc"
		libinc "putstr.inc"
		emitln "call putstr"
		allocvar llook,1,"''"
		goto skipint
	elseif left$(llook,1)=chr$(34) then
		newv=genlabel
		temp="'"+right$(llook,len(llook)-1)+"'"+",0x00"

		allocvar newv,1,temp
		emitln("mov si, "+newv)
		libinc "putc.inc"
		libinc "putstr.inc"
		emitln "call putstr"
		goto skipint
		
	else
		emitln "mov ax, ["+llook+"]"
		allocvar llook,0,""
	end if
end if
libinc "puti.inc"
libinc "putc.inc"
emitln "call puti"

skipint:
token
end sub
'******************************
sub libdec
dim i as integer

for i = 1 to maxinc
	if not linc(i)="" then	
		libfile.open(linc(i),fmopenread)
		
		while not libfile.position=libfile.size
			emitln (libfile.readline)
		wend
		libfile.close
	end if
next
end sub
'******************************
sub block
do
if llook=" " then exit sub
while llook=chr$(9) or llook=chr$(10)
	token
wend
'if asc(llook)=10 then token
'if asc(llook)=9 then token
select case lcase$(llook)
	case "print" 	
		doprint
	case "if"
		doif
	case "else"
		exit sub
	case "endif"
		exit sub
	case "while"
		dowhile
	case "wend"
		exit sub
	case "for"
		dofor
	case "input"
		doinput
	case else
		assignment(llook)
		
end select
if infile.position = infile.size then exit do
loop
end sub
'******************************
sub expression
'token
if llook="(" then expression
if llook="" then Expected "expression"
if llook="+" then 
	token
elseif llook="-" then 
	token
	if isnum(llook) then
		emitln "mov ax, -"+llook
	else
		allocvar llook,0,0
		emitln "mov ax,-["+llook+"]"
	end if
else
	term
end if
token
do 
	select case llook
		case "+"
			addop
		case "-"
			subop
		case "*"
			mulop
		case "/"
			divop
		case ")" exit sub
	end select
loop until not isspecial(llook)=1
end sub
'******************************
sub assignment
dim var as string
dim temp as string
dim lop as string
dim lp as string
dim tvar as string

var=""
temp=""
llook=vvar
var =llook
if not right$(var,1)="$" then
	allocvar var,0,""
	token
	if not llook="=" then expected ("=")
	token
	expression
	emitln("mov ["+var+"],ax")
else
	token
	if not llook="=" then expected("g=")
	allocvar var,2,"30"
	allocvar "$intb2n$",2,"30"
	emitln "mov di, $intb2n$"
	emitln "mov al,0x00"
	emitln "stosb"
	goto into
end if
goto axit
while llook="+"
	into:
	token	
	if left$(llook,1)=chr$(34) then
		temp=""
		tvar=genlabel
		temp="'"+right$(llook,len(llook)-1)+"'"+",0x00"
		allocvar tvar,1,temp
		libinc "strlen.inc"
		emitln "mov si, $intb2n$"
		emitln "call strlen"
		emitln "mov di, $intb2n$"
		emitln "add di,cx"
		emitln "mov si, "+tvar
		lop=genlabel
		lp=genlabel
		postlabel lop
		emitln "lodsb"
		emitln "cmp al, 0x00"
		emitln "je "+lp
		emitln "stosb"
		emitln "jmp "+lop	
		postlabel lp
		emitln "mov al,0x00"
		emitln "stosb"
	'	allocvar var,2,"30"
		token
	else
		temp=llook
		libinc "strlen.inc"
		emitln "mov si, $intb2n$"
		emitln "call strlen"
		emitln "mov di, $intb2n$"
		emitln "add di,cx"
		emitln "mov si, "+temp
		lop=genlabel
		lp=genlabel
		postlabel lop
		emitln "lodsb"
		emitln "cmp al, 0x00"
		emitln "je "+lp
		emitln "stosb"
		emitln "jmp "+lop	
		postlabel lp
		emitln "mov al,0x00"
		emitln "stosb"
	'	allocvar var,2,"30"
		token
	end if
wend
		emitln "mov di, "+var
		emitln "mov si, $intb2n$"
		lop=genlabel
		lp=genlabel
		postlabel lop
		emitln "lodsb"
		emitln "cmp al, 0x00"
		emitln "je "+lp
		emitln "stosb"
		emitln "jmp "+lop	
		postlabel lp
		emitln "mov al,0x00"
		emitln "stosb"
		allocvar var,2,"30"
axit:
end sub
'******************************
function isspecial(text as string) as integer 
select case llook
	case "+"
		isspecial=1
'	case "="
'		isspecial=0
	case "-"
		isspecial=1
	case "*"
		isspecial=1
	case "/"
		isspecial=1
	case ")"
		isspecial=1
	case else
		isspecial=0
end select
end function
'******************************
sub allocvar
dim i as integer
for i =1 to maxvar
	if rtrim$(st(i).name)=text then
		exit sub
	end if
next
for i =1 to maxvar
	if st(i).name="        " then
		st(i).name=text
		st(i).isstring=isstr
		st(i).val=valu
		if st(i).isstring=2 then
			emitln ("mov di, "+st(i).name)
			emitln "mov al, 0x00"
			emitln "stosb"
		end if
		exit sub
	end if
next
	
abort "error: Maximum number of variables: "+str$(maxvar)
end sub
'******************************
sub match(text as string)
token
if not text=llook then expected(text)
end sub
'******************************
sub expected(text as string)
abort("Expected: "+text)
end sub
'******************************
sub abort(text as string)
print "("+str$(linectr)+")"+text
infile.close
outfile.close
do : loop
end sub
'******************************
sub divop
emitln "push ax"
token
if llook="(" then 
	expression
else
	term
end if
emitln "pop bx"
emitln "xor dx,dx"
emitln "xchg ax,bx"
emitln "div bx"
token
end sub
'******************************
sub subop
emitln "push ax"
token
if llook="(" then 
	expression
else
	term
end if
emitln "pop bx"
emitln "sub ax,bx"
emitln "neg ax"
token
end sub
'******************************
sub addop
emitln "push ax"
token
if llook="(" then 
	expression
else
	term
end if
emitln "pop bx"
emitln "add ax,bx"
token
end sub
'******************************
sub mulop
emitln "push ax"
token
if llook="(" then 
	expression
else
	term
end if
emitln "pop bx"
emitln "mul bx"
token
end sub
'******************************
sub token
dim tok as string 
tok=""

while tchar=chr$(10)
	tchar=getchar()
wend
while tchar=" "
	tchar=getchar()
wend
if isnum(tchar)=1 then
	while isnum(tchar)=1
		tok=tok+tchar
		tchar=getchar()
	wend
	goto xit
end if

if isalpha(tchar)=1 then
	while isalpha(tchar)=1
		tok=tok+tchar
		tchar=getchar()
	wend
	goto xit
end if

if tchar=chr$(34) then
	do
		tok=tok+tchar
		tchar=getchar()
		if tchar=chr$(34) then exit do
	loop
tchar=getchar()
goto xit
end if

tok=tchar
tchar=getchar()

if tok="" then tok="=" 'this line really really need to go!!!
xit:

llook=tok
end sub
'******************************
function isnum
if asc(text)> 47 and asc(text)< 58 then
	isnum=1
else
	isnum=0
end if
end function
'******************************
function isalpha
if asc(lcase$(text))> 96 and asc(lcase$(text))< 123 or (lcase$(text)) = "$" or asc(text)> 47 and asc(text)< 58 then
	isalpha=1
else
	isalpha=0
end if
end function
'******************************
sub init
'cls
linectr=1
infile.open(filein,fmopenread)
outfile.open(fileout,fmopenwrite)
prolog
tchar=getchar()
end sub
'******************************
function getchar
dim getcha as string
getcha=infile.readstr(1)
if getcha=chr$(10) then inc(linectr)
getchar=getcha
end function
'******************************
sub emitln
print "        "+text
text=text+chr$(10)
outfile.writestr(text,len(text))
end sub
'******************************
sub term
if isnum(llook) then
	emitln "mov ax, "+llook
else
	allocvar llook,0,0
	emitln "mov ax, ["+llook+"]"
end if
end sub
'******************************
sub prolog
if linux=0 then
	emitln "[bits 16]"
	emitln "org 0x100"
	emitln "section .text"
else
	emitln "BITS 32"
	emitln "EXTERN _exit"
	emitln "GLOBAL _start"
	emitln "section .text"
	emitln "_start:"
  
end if
end sub
'******************************
sub vardec
dim i as integer
emitln "[section .data]"
for i = 1 to maxvar
	if not st(i).name="        " and st(i).isstring=0 then emitln rtrim$(st(i).name)+" dw 0"
next

for i = 1 to maxvar
	if not st(i).name="        " and st(i).isstring=1 then emitln rtrim$(st(i).name)+" db " +rtrim$(st(i).val)
next

end sub
'******************************
sub bssdec
emitln "[section .bss]"
dim i as integer

for i = 1 to maxvar
	if not st(i).name="        " and st(i).isstring=2 then emitln rtrim$(st(i).name)+" resb " +rtrim$(st(i).val)
next
end sub
'******************************
sub libinc (filname as string)
dim i as integer
for i =1 to maxinc
	if linc(i)=filename then
		exit sub
	end if
next
for i =1 to maxinc
	if linc(i)="" then
		linc(i)=filename
		exit sub
	end if
next
abort "error: Maximum number of include files: "+str$(maxinc)
end sub
'******************************
function genlabel
lab=lab+1
genlabel="L"+ltrim$(str$(lab))
end function
'******************************
sub postlabel(label as string)
emitln label+":"
end sub
'******************************