flat assembler
Message board for the users of flat assembler.

Index > Programming Language Design > FTCBASIC (Fast Tiny Compiled BASIC)

Author
Thread Post new topic Reply to topic
geekbasic@gmx.com



Joined: 25 Oct 2022
Posts: 65
Location: Arizona
geekbasic@gmx.com 06 Jan 2023, 20:09
Image

Homepage: http://www.basicgames.xyz/index.php?page=article&id=22

FTCBASIC means fast tiny compiled BASIC. It is a BASIC compiler for x86 DOS. The compiler is written in QuickBasic and generates FASM output. Using batch files, you may compile your source to com files instantly.

Generated com files are tiny and fast. They start at less than 50 bytes.

The compiler and language is derived from the Pebble language. Many of the great features of Pebble have been kept in translation. As a result, there's support for inline asm, include files, and more. There's even some basic 1D array and string data type support.

In all, there's integer, integer array, and string data types. Floating point is not supported, but may be implemented with libraries.

** Notice: This Alpha version is fresh off the press and probably has issues. Also, the documentation is incomplete. I will be working on it, but wanted to make an early release to get some feedback. **

Only unsigned integers may be used in expressions. Operator precedence is *, /, +, -, <, >, <=, >=, =, <>, AND, and OR. Parenthesis override operator precedence.

Examples...

Code:
rem periodic table lookup example
rem uses carry command to perform modulus
rem compile with FTCBASIC

define e = 0, i = 0, m = 0, r = 0, c = 0, q = 0

dim a[1, 2, 5, 13, 57, 72, 89, 104]
dim b[-1, 15, 25, 35, 72, 21, 58, 7]

do

        cls
        print "Periodic Table Lookup"
        crlf
        print "0 to continue or 1 to quit: " \
        input q
        cls

        if q = 0 then

                gosub displaytable
                gosub searchtable

                crlf

                print "Press any key to continue..."
                pause


        endif

loop q <> 1

end

sub searchtable

        print "Atomic number: " \
        input e

        let i = 8

        do

                let i = i - 1

        loop @a[i] > e

        let m = e + @b[i]
        let r = ( m / 18 ) + 1
        carry c
        let c = c + 1

        cursor 19,20

        print "Period: " \
        print r \
        print " Group: " \
        print c \
        crlf

return

sub displaytable

        print "      1   2   3   4   5   6   7   8   9   10  11  12  13  14  15  16  17  18"
        crlf
        print "   1  H                                                                   He"
        crlf
        print "   2  Li  Be                                          B   C   N   O   F   Ne"
        crlf
        print "   3  Na  Mg                                          Al  Si  P   S   Cl  Ar"
        crlf
        print "   4  K   Ca  Sc  Ti  V   Cr  Mn  Fe  Co  Ni  Cu  Zn  Ga  Ge  As  Se  Br  Kr"
        crlf
        print "   5  Rb  Sr  Y   Zr  Nb  Mo  Tc  Ru  Rh  Pd  Ag  Cd  In  Sn  Sb  Te  I   Xe"
        crlf
        print "   6  Cs  Ba  *   Hf  Ta  W   Re  Os  Ir  Pt  Au  Hg  Tl  Pb  Bi  Po  At  Rn"
        crlf
        print "   7  Fr  Ra  **  Rf  Db  Sg  Bh  Hs  Mt  Ds  Rg  Cn  Nh  Fl  Mc  Lv  Ts  Og"
        crlf
        print "   8 Lantanoidi*  La  Ce  Pr  Nd  Pm  Sm  Eu  Gd  Tb  Dy  Ho  Er  Tm  Yb  Lu"
        crlf
        print "   9 Aktinoidi**  Ac  Th  Pa  U   Np  Pu  Am  Cm  Bk  Cf  Es  Fm  Md  No  Lr"
        crlf

return    


Code:
rem bubble sort benchmark example
rem compile with FTCBASIC

use time.inc
use random.inc

define const size = 32000

dim list[size]

define sorting = 0, index = 0, elements = 0
define timestamp = 0, sorttime = 0
define temp1 = 0, temp2 = 0

cls

print "Bubble sort benchmark test"

do

        print "How many elements to generate and sort (max " \
        print size \
        print ")? " \

        input elements

loop elements > size

gosub fill
gosub sort

print "done!"
print "sort time: " \
print sorttime
print "Press any key to view sorted data..."

pause

gosub output

pause
end

sub fill

        print "filling..."

        0 index

        do

                gosub generaterand

                let @list[index] = rand

                +1 index

        loop index < elements

return

sub sort

        print "sorting..."

        gosub systemtime
        let timestamp = loworder

        do

                0 sorting

                0 index

                do

                        let temp1 = index + 1

                        if @list[index] > @list[temp1] then

                                let temp2 = @list[index]

                                let @list[index] = @list[temp1]
                                let @list[temp1] = temp2

                                let sorting = 1

                        endif

                        +1 index

                loop index < elements - 1

        loop sorting = 1

        gosub systemtime
        let sorttime = ( loworder - timestamp ) / 18

return

sub output

        print "printing..."

        0 index

        do

                print @list[index]

                +1 index

        loop index < elements

return    


Code:
rem Ball and Paddle example pong game
rem compile with FTCBASIC

use mouse.inc
use time.inc

define paddlex = 0, paddley = 22, speed = 0
define ballx = 2, bally = 2, balldx = 1, balldy = 1
define score = 0, mode = 0, key = 0, timestamp = 0

cls
cls 18, 25, 0, 79, 0, 24
cls 79, 0, 0, 79, 0, 0

cursor 32, 0
print "Ball and Paddle"

cursor 32, 2
print "Geek Basic 2022"

cursor 27, 3
print "http://www.basicgames.xyz"

cursor 26, 5
print "Mouse (1) or keyboard (0) ? "

cursor 54, 5
input mode

cursor 25, 7
print "Game speed (1 to 3) ? "

cursor 48, 7
input speed

if speed = 0 then

        let speed = 2

endif

cls
cls 30, 24, 0, 79, 0, 24
cls 26, 1, 0, 79, 16, 22
cls 79, 0, 0, 79, 0, 0

gosub mouseshow

do

        cursor paddlex, paddley
        print "     "

        if mode = 1 then

                gosub readmouse

        endif

        scankey key

        if key = 75 and paddlex > 1 then

                let paddlex = paddlex - 5

        endif

        if key = 77 and paddlex < 75 then

                let paddlex = paddlex + 5

        endif

        if mode = 1 then

                let paddlex = mousex

                if paddlex > 75 then

                        let paddlex = 75

                endif

        endif

        cursor paddlex, paddley
        print "ÛÛÛÛÛ"

        if mode = 1 then

                gosub hidemouse

        endif

        cursor ballx, bally
        print " "

        if balldx = 1 then

                +1 ballx

                if ballx = 80 then

                        0 balldx

                endif

        endif

        if balldx = 0 then

                -1 ballx

                if ballx = 0 then

                        let balldx = 1

                endif

        endif

        if balldy = 0 then

                -1 bally

                if bally = 0 then

                        let balldy = 1

                endif

        endif

        if balldy = 1 then

                +1 bally

                if bally = paddley - 1 then

                        if ballx < paddlex or ballx > paddlex + 5 then

                                cls
                                cls 18, 25, 0, 79, 0, 24
                                print "Game over!"
                                print "Score: "
                                cursor 7, 1
                                print score
                                crlf
                                print "Press any key to return to DOS..."
                                pause
                                end

                        endif

                        gosub drawball

                        0 balldy
                        +1 score
                        bell

                endif

        endif

        gosub drawball

        cursor 0, 0
        print "Score:"
        cursor 8, 0
        print score

        if mode = 1 then

                cursor 76, 0
                print "[X]"

        endif

        if key = 1 or ( mouseb = 1 and mousex >= 76 and mousex <= 79 and mousey = 0 ) then

                end

        endif

        gosub systemtime
        let timestamp = loworder

        do

                gosub systemtime

        loop loworder < timestamp + speed

loop

sub drawball

        cursor ballx, bally
        chr 2

        gosub mouseshow

return

sub mouseshow

        if mode = 1 then

                gosub showmouse

        endif

return    


Description: Complete BASIC compiler package.
Download
Filename: ftcbasic.zip
Filesize: 160.3 KB
Downloaded: 47 Time(s)


_________________
http://www.basicgames.xyz


Last edited by geekbasic@gmx.com on 30 Jan 2023, 21:51; edited 9 times in total
Post 06 Jan 2023, 20:09
View user's profile Send private message Visit poster's website Reply with quote
geekbasic@gmx.com



Joined: 25 Oct 2022
Posts: 65
Location: Arizona
geekbasic@gmx.com 07 Jan 2023, 07:00
Update!

I have added a file access library.
Post 07 Jan 2023, 07:00
View user's profile Send private message Visit poster's website Reply with quote
geekbasic@gmx.com



Joined: 25 Oct 2022
Posts: 65
Location: Arizona
geekbasic@gmx.com 08 Jan 2023, 12:21
Update!

I fixed some major problems with the expression evaluation. It was from some new features. I also fixed an optimization error.

If you downloaded it already, delete and download it again!

I have added more libraries and updated the examples.

This is a major update, but I will still keep this as alpha version.

libraries added are time.inc and random.inc
Post 08 Jan 2023, 12:21
View user's profile Send private message Visit poster's website Reply with quote
al_Fazline



Joined: 24 Oct 2018
Posts: 44
al_Fazline 09 Jan 2023, 15:22
Are you going to make it self-hosted and thus remove the dependency on proprietary Microsoft compiler?
Post 09 Jan 2023, 15:22
View user's profile Send private message Reply with quote
geekbasic@gmx.com



Joined: 25 Oct 2022
Posts: 65
Location: Arizona
geekbasic@gmx.com 09 Jan 2023, 19:09
I'd like to. have been working on a C string parsing library ad plan to try compiling with TurboC. There's other languages as well, but I am not sure what the best would be yet.

For now, at least the compiled programs are not based on MS.
Post 09 Jan 2023, 19:09
View user's profile Send private message Visit poster's website Reply with quote
al_Fazline



Joined: 24 Oct 2018
Posts: 44
al_Fazline 09 Jan 2023, 21:31
I thin, you need to make the compiler self-hosted, which means, being able to compile itself. Since it's already written in basic it should not be too hard to port from qbasic to your dialect for bootstrap. You can even have two stage build, first qbasic builds old version of your compiler, then it builds the new version of your compiler.
Post 09 Jan 2023, 21:31
View user's profile Send private message Reply with quote
geekbasic@gmx.com



Joined: 25 Oct 2022
Posts: 65
Location: Arizona
geekbasic@gmx.com 10 Jan 2023, 18:59
That is a wonderful Idea.

I think the main thing my language lacks right now is string arrays.
The other main thing would be exe output instead of com.
As it is, this wouldn't fit in a com program.

I have tried doing this, but probably will need some assistance or a good amount of time.
Post 10 Jan 2023, 18:59
View user's profile Send private message Visit poster's website Reply with quote
geekbasic@gmx.com



Joined: 25 Oct 2022
Posts: 65
Location: Arizona
geekbasic@gmx.com 27 Jan 2023, 04:39
The beta version is now released!
This includes defining and using constants and more libraries!
Post 27 Jan 2023, 04:39
View user's profile Send private message Visit poster's website Reply with quote
jack2



Joined: 06 Jul 2008
Posts: 33
jack2 29 Jan 2023, 00:30
hello geekbasic
I translated your FTCBASIC from QuicBasic to FreeBasic, if you are interested I will post the code
Post 29 Jan 2023, 00:30
View user's profile Send private message Reply with quote
geekbasic@gmx.com



Joined: 25 Oct 2022
Posts: 65
Location: Arizona
geekbasic@gmx.com 29 Jan 2023, 21:35
I am interested to see your translation. Please do share it.
Post 29 Jan 2023, 21:35
View user's profile Send private message Visit poster's website Reply with quote
jack2



Joined: 06 Jul 2008
Posts: 33
jack2 29 Jan 2023, 23:01
OK, this is just a rough translation, your QuickBasic source used Gosubs which FreeBasic allows only in #lang "QB" and maybe also in #lang "fblite" but I don't like to use those variants so I made all subroutines into sub's, but not knowing what variables were shared between subroutines I made all the variables shared, that means global in scope.
about 3 variables had to be renamed because they are keywords in FB, Var, Name and Include
you should be able to simplify the code by using local variables when possible and thereby significantly reduce the number of globals
you can get FreeBasic from https://www.freebasic.net/forum/ in the news section
Code:

' FTCBASIC For X86 DOS
' Geek Basic 2022
' http://www.basicgames.xyz
' ptrworkmails@gmail.com

Declare Sub includecmd
Declare Sub removetabs
Declare Sub usecmd
Declare Sub compile
Declare Sub load
Declare Sub convertsinglequotes
Declare Sub letcmd
Declare Sub docmd
Declare Sub simplelet
Declare Sub loopcmd
Declare Sub ifcmd
Declare Sub simpleif
Declare Sub printcmd
Declare Sub inputcmd
Declare Sub copycmd
Declare Sub concatcmd
Declare Sub comparecmd
Declare Sub lengthcmd
Declare Sub findcmd
Declare Sub trimcmd
Declare Sub cutcmd
Declare Sub intstrcmd
Declare Sub strintcmd
Declare Sub uppercmd
Declare Sub lowercmd
Declare Sub clscmd
Declare Sub cursorcmd
Declare Sub chrcmd
Declare Sub waitcmd
Declare Sub endcmd
Declare Sub tokenize
Declare Sub translate
Declare Sub processoperators
Declare Sub evaluate
Declare Sub calculate
Declare Sub getprecedence
Declare Sub parsevariable
Declare Sub parsearray
Declare Sub pointarray
Declare Sub checkifvar

Const lines = 4500
Const includes = 100
Const nest = 100
Const constants = 100

Dim Shared As String code(lines)
Dim Shared As String incs(includes)
Dim Shared As Single ifstack(nest)
Dim Shared As Single loopstack(nest)
Dim Shared As String constname(constants)
Dim Shared As Single constvalue(constants)

Dim Shared As String crlf
Dim Shared As String filename
Dim Shared As Integer includ, inlineasm

Dim Shared As String title, headerdata, cmd, parameters, section
Dim Shared As String varname, vardata, expression, libdata, vardef
Dim Shared As String char, includefile, letvar, infix, array, operat
Dim Shared As String operand1, operand2, tocheck, jumplabel, period
Dim Shared As String String1, string2, nam3, retvar, strstart, strcount
Dim Shared As String clscolor, scroll, colorx1, colorx2, colory1, colory2
Dim Shared As String regcx, regdx, leftfix, postfix, operatorstack, token
Dim Shared As String newstack, stacktop, Var9, offset, iolib, notabs
Dim Shared As String nosinglequotes
Dim Shared As Integer count, spase, comma, constant, operators, check
Dim Shared As Integer ifpointer, newlineflag, echostringflag, bellflag
Dim Shared As Integer chrflag, cursorflag, pauseflag, scankeyflag
Dim Shared As Integer onkeyflag, copyflag, concatflag, compareflag
Dim Shared As Integer lengthflag, findflag, trimflag, cutflag, intstrflag
Dim Shared As Integer strintflag, upperflag, lowerflag, clsflag, waitflag
Dim Shared As Integer inputflag, nolib, strinputflag, strechoflag
Dim Shared As Integer echovalueflag, icount, docount, looppointer
Dim Shared As Integer endifcount, operatorlength, nobreak, echocount
Dim Shared As Integer copystring, concatstring, comparestring, chars
Dim Shared As Integer replacetoken, tokenpos, tokenprecedence, stackprecedence
Dim Shared As Integer varpos, ucount, include2, tabscan, singlequotescan

crlf = Chr(13) + Chr(10)
filename = Command

If filename = "" Then

        Cls
        Print "  _____   _____    ____   _____    _____    ____   _____    ____"
        Print " / ____| /_   _\  / __ \ /  __ \  /  _  \  / __ \ /_   _\  / __ \"
        Print " | |       | |   / /  \/ | |  \ | | | | | / /  \/   | |   / /  \/"
        Print " | |__     | |   | |     | |__/ / | |_| | \ \__     | |   | |"
        Print " |  __|    | |   | |     |  __ |  |  _  |  \__ \    | |   | |"
        Print " | |       | |   | |     | |  \ \ | | | |     \ \   | |   | |"
        Print " \ |       \ |   \ \__/\ | |__/ | \ | \ | /\__/ /  _| |_  \ \__/\"
        Print "  \|        \|    \____/ \_____/   \|  \| \____/  \_____/  \____/"
        Print

End If

Print "FTCBASIC"
Print
Print "by Gemino Smothers 2022"
Print "http://www.basicgames.xyz"
Print

load
compile

'' End

Sub load

        iolib = ""

        If filename = "" Then

                Line Input "*.bas file: ", filename
                filename = filename + ".BAS"

        End If

        title = Left(filename, Len(filename) - 4) + ".asm"

        Print "Loading..."

        Open filename For Input As #1

        For count = 0 To lines

                If Eof(1) Then

                        Exit For

                End If

                If count = lines Then

                        Print "Line count exceeded!"
                        Sleep
                        End

                End If

                Line Input #1, code(count)

                removetabs
                code(count) = Trim(code(count))
                includecmd
                usecmd

        Next count

        count = count + 1

        For ucount = 0 To include2 - 1

                code(count) = incs(ucount)
                includecmd

        Next ucount

        Close #1

End Sub

Sub compile

        Print "Compiling..."

        inlineasm = 0

        Open title For Output As #1

        Open "defs.dat" For Output As #3
        Print #3, ""
        Close #3

        Open "defs.dat" For Append As #3

        Open "header.dat" For Input As #2

        While Not Eof(2)

                Line Input #2, headerdata
                Print #1, headerdata

        Wend

        Close #2

        For count = 0 To lines - 1

                If Len(code(count)) And Left(code(count), 1) <> ";" Then

                        Print #1, ";" + Str(count) + " " + code(count)

                End If

                If inlineasm And Ucase(code(count)) <> "ENDASM" Then

                        Print #1, code(count)
                        cmd = ""

                Else

                        If Ucase(Left(code(count), 4)) <> "STR" And Ucase(Left(code(count), 4)) <> "FIND" And Ucase(Left(code(count), 7)) <> "COMPARE" Then

                                convertsinglequotes

                        End If

                        spase = Instr(code(count), " ")

                        If spase Then

                                cmd = Left(code(count), spase - 1)
                                parameters = Mid(code(count), spase + 1, Len(code(count)) - spase)

                        Else

                                cmd = code(count)
                                parameters = ""

                        End If

                End If

                Select Case Ucase(cmd)

                        Case "DEFINE", "CONST"

                                comma = 1

                                While comma

                                        comma = Instr(parameters, ",")

                                        If comma Then

                                                section = Trim(Left(parameters, comma - 1))
                                                parameters = Trim(Right(parameters, Len(parameters) - comma))

                                        Else

                                                section = parameters

                                        End If

                                        varname = Left(section, Instr(section, "=") - 1)
                                        vardata = Right(section, Len(section) - Len(varname) - 1)
                                        varname = Rtrim(varname)
                                        vardata = Ltrim(vardata)

                                        If Right(varname, 1) = "" Then

                                                varname = Left(varname, Len(varname) - 1)

                                                Print #3, varname + " db " + vardata + ",0"
                                                Print #3, "rb 1023"

                                        Elseif Left(Ucase(varname),6) = "CONST " Then

                                                varname = Right(varname, Len(varname) - 6)

                                                For constant = 0 To constants - 1

                                                        If constname(constant) = "" Then

                                                                constname(constant) = varname
                                                                constvalue(constant) = Val(vardata)
                                                                Exit For

                                                        End If

                                                Next constant

                                        Else

                                                Print #3, varname + " dw " + vardata

                                        End If

                                Wend

                        Case "DIM"

                                varname = Left(parameters, Instr(parameters, "[") - 1)
                                parameters = Left(parameters, Len(parameters) - 1)
                                parameters = Right(parameters, Len(parameters) - Len(varname) - 1)
                                vardata = parameters

                                For constant = 0 To constants - 1

                                        If vardata = constname(constant) Then

                                                vardata = Ltrim(Str(constvalue(constant)))
                                                Exit For

                                        End If

                                Next constant

                                If Instr(vardata, ",") Then

                                        Print #3, varname + " dw " + vardata

                                Else

                                        Print #3, varname + " dw " + vardata + " dup(?)"

                                End If

                        Case "LET"

                                expression = Trim(Mid(parameters, Instr(parameters, "=") + 1, Len(parameters)))

                                If Instr(expression, "(") Or Instr(expression, "&") Or Instr(expression, "|") Or Instr(parameters, "@") Then

                                        letcmd

                                Elseif Instr(Ucase(expression), " AND ") Or Instr(Ucase(expression), " OR ") Then

                                        letcmd

                                Elseif Instr(expression, "=") Or Instr(expression, "<") Or Instr(expression, ">") Then

                                        letcmd

                                Elseif Instr(expression, Chr(128)) Or Instr(expression, Chr(129)) Or Instr(expression, Chr(130)) Then

                                        letcmd

                                Elseif Instr(expression, "/") Or Instr(expression, "*") Or Instr(expression, "+") Or Instr(expression, "-") Then

                                        operators = 0

                                        For check = 1 To Len(expression)

                                                Select Case Mid(expression,check,1)

                                                        Case "/", "*", "+", "-"

                                                                operators = operators + 1

                                                End Select

                                        Next check

                                        If operators > 1 Then

                                                letcmd

                                        Else

                                                simplelet

                                        End If

                                Else

                                        simplelet

                                End If

                        Case "DO"

                                docmd

                        Case "LOOP"

                                loopcmd

                        Case "IF"

                                If Instr(parameters, "(") Or Instr(parameters, "&") Or Instr(parameters, "|") Or Instr(parameters, "@")Then

                                        ifcmd

                                Elseif Instr(Ucase(parameters), " AND ") Or Instr(Ucase(parameters), " OR ") Then

                                        ifcmd

                                Elseif Instr(parameters, "/") Or Instr(parameters, "*") Or Instr(parameters, "+") Or Instr(parameters, "-") Then

                                        ifcmd

                                Else

                                        simpleif

                                End If

                        Case "ENDIF"

                                ifpointer = ifpointer - 1
                                Print #1, ".endif" + Ltrim(Str(ifstack(ifpointer))) + ":"

                        Case "CARRY"

                                Print #1, "mov [" + parameters + "],dx"

                        Case "0"

                                Print #1, "mov [" + parameters + "],0"

                        Case "+1"

                                Print #1, "add [" + parameters + "],1"

                        Case "-1"

                                Print #1, "sub [" + parameters + "],1"

                        Case "GOTO"

                                If Left(parameters, 1) <> "@" Then


                                        Print #1, "jmp ." + parameters

                                Else

                                        Print #1, "jmp " + parameters

                                End If

                        Case "LABEL"

                                If Left(parameters, 1) <> "@" Then

                                        Print #1, "." + parameters + ":"

                                Else

                                        Print #1, "@@:"

                                End If

                        Case "SUB"

                                Print #1, parameters + ":"

                        Case "GOSUB"

                                Print #1, "call " + parameters

                        Case "end sub"

                                Print #1, "ret"

                        Case "PRINT"

                                printcmd

                        Case "INPUT"

                                inputcmd

                        Case "CRLF"

                                newlineflag = 1
                                echostringflag = 1
                                Print #1, "call newline"

                        Case "BELL"

                                bellflag = 1
                                echostringflag = 1
                                Print #1, "call ring"

                        Case "CHR"

                                chrflag = 1
                                echostringflag = 1
                                chrcmd

                        Case "CURSOR"

                                cursorflag = 1
                                cursorcmd

                        Case "PAUSE"

                                pauseflag = 1
                                Print #1, "call pauseprogram"

                        Case "SCANKEY"

                                scankeyflag = 1
                                Print #1, "call scankey"
                                Print #1, "mov [" + parameters + "],ax"

                        Case "ONKEY"

                                onkeyflag = 1
                                Print #1, "call onkey"
                                Print #1, "je ." + parameters

                        Case "COPY"

                                copyflag = 1
                                copycmd

                        Case "CONCAT"

                                concatflag = 1
                                concatcmd

                        Case "COMPARE"

                                compareflag = 1
                                comparecmd

                        Case "LENGTH"

                                lengthflag = 1
                                lengthcmd

                        Case "FIND"

                                findflag = 1
                                findcmd

                        Case "TRIM"

                                lengthflag = 1
                                trimflag = 1
                                trimcmd

                        Case "CUT"

                                cutflag = 1
                                cutcmd

                        Case "INTSTR"

                                intstrflag = 1
                                intstrcmd

                        Case "STRINT"

                                strintflag = 1
                                strintcmd

                        Case "UPPER"

                                upperflag = 1
                                uppercmd

                        Case "LOWER"

                                lowerflag = 1
                                lowercmd

                        Case "CLS"

                                clsflag = 1
                                clscmd

                        Case "WAIT"

                                waitflag = 1
                                waitcmd

                        Case "END"

                                endcmd

                        Case "BEGINASM"

                                inlineasm = 1

                        Case "ENDASM"

                                inlineasm = 0

                        Case "REM"

                                Print #1, ";" + parameters

                        Case Else

                                If cmd <> "" Then

                                        Print "Invalid command on line #" + Str(count + 1) + ": " + code(count)

                                End If

                End Select

        Next count

        Close #3

        Open "io.lib" For Input As #2

        While Not Eof(2)

                Line Input #2, libdata

                count = lines - 1
                code(count) = libdata
                removetabs
                libdata = Trim(code(count))

                Select Case Lcase(libdata)

                        Case "inputvalue:", "getvalue:", "inputstring:"

                                If inputflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strinput:"

                                If strinputflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strecho:"

                                If strechoflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strcharecho:"

                                If strechoflag <> 1 And strinputflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strcopy:"

                                If copyflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strconcat:"

                                If concatflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strcmp:"

                                If compareflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strlen:"

                                If lengthflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strfind:"

                                If findflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strtrim:", "strltrim:", "strrtrim:"

                                If trimflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strcut:"

                                If cutflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strintstr:"

                                If intstrflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strstrint:"

                                If strintflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strupper:"

                                If upperflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "strlower:"

                                If lowerflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "scankey:"

                                If scankeyflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "onkey:"

                                If onkeyflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "pauseprogram:"

                                If pauseflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "echostring:"

                                If echostringflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "echovalue:"

                                If echovalueflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "newline:"

                                If newlineflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "movecursor:"

                                If cursorflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "echochar:"

                                If chrflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "ring:"

                                If bellflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "clearscreen:", "resetcolors:"

                                If clsflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "waitfor:"

                                If waitflag <> 1 Then

                                        nolib = 1

                                Else

                                        Print #1, libdata

                                End If

                        Case "crlf db 13,10,36"

                                If newlineflag = 1 Then

                                        Print #1, libdata

                                End If

                        Case "bell db 7,36"

                                If bellflag = 1 Then

                                        Print #1, libdata

                                End If

                        Case "inputbuffer db 8,0", "digits rb 12"

                                If inputflag = 1 Then

                                        Print #1, libdata

                                End If

                        Case "ret"

                                If nolib <> 1 Then

                                        Print #1, libdata

                                Else

                                        nolib = 0

                                End If

                        Case Else

                                If nolib = 0 Then

                                        Print #1, libdata

                                End If

                End Select

        Wend

        Close #2

        Print "Copying variable definitions..."

        Open "defs.dat" For Input As #3

        While Not Eof(3)

                Line Input #3, vardef
                Print #1, vardef

        Wend

        Close #3

        Shell "del defs.dat"

        Close #1

        Print
        Print "Compilation is finished."
        Print

End Sub

Sub removetabs

        notabs = ""

        For tabscan = 1 To Len(code(count))

                char = Mid(code(count), tabscan, 1)

                If char <> Chr(9) Then

                        notabs = notabs + char

                End If

        Next tabscan

        code(count) = notabs

End Sub

Sub convertsinglequotes

        nosinglequotes = ""

        For singlequotescan = 1 To Len(code(count))

                char = Mid(code(count), singlequotescan, 1)

                If char <> Chr(39) Then

                        nosinglequotes = nosinglequotes + char

                Else

                        nosinglequotes = nosinglequotes + "',39,'"

                End If

        Next singlequotescan

        code(count) = nosinglequotes

End Sub

Sub includecmd

        If Ucase(Left(code(count), 7)) = "INCLUDE" Then

                includefile = Mid(code(count), 9, Len(code(count)) - 8)

                Print "Including: " + includefile + "..."

                Open includefile For Input As #2

                For icount = count To lines

                        If Eof(2) Then Exit For

                        If icount = lines Then

                                Print "Line count exceeded in " + includefile + "!"
                                Sleep
                                End

                        End If

                        Line Input #2, code(icount)
                        removetabs
                        code(icount) = Trim(code(icount))
                        count = icount

                Next icount

                count = icount + 1

                Close #2

        End If

End Sub

Sub usecmd

        If Ucase(Left(code(count), 3)) = "USE" Then

                incs(include2) = "include " + Mid(code(count), 5, Len(code(count)) - 4)
                code(count) = ""
                include2 = include2 + 1

        End If

End Sub

Sub letcmd

        parameters = Trim(parameters)
        letvar = Rtrim(Left(parameters, Instr(parameters, "=") - 1))
        infix = Trim(Mid(parameters, Instr(parameters, "=") + 1, Len(parameters)))

        evaluate

        If Left(letvar, 1) = "@" Then

                array = letvar

                parsearray
                pointarray

                Print #1, "pop ax"
                Print #1, "mov [si],ax"

        Else

                Print #1, "pop ax"
                Print #1, "mov [" + letvar + "],ax"

        End If

End Sub

Sub simplelet

        operat = ""

        If Instr(parameters, "+") Then

                operat = "+"

        Elseif Instr(parameters, "-") Then

                operat = "-"

        Elseif Instr(parameters, "*") Then

                operat = "*"

        Elseif Instr(parameters, "/") Then

                operat = "/"

        Else

                operat = ""

        End If

        letvar = "[" + Trim(Left(parameters, Instr(parameters, "=") - 1)) + "]"

        If operat = "" Then

                operand1 = Trim(Mid(parameters, Instr(parameters, "=") + 1, Len(parameters)))
                operand2 = ""

        Else

                operand1 = Trim(Mid(parameters, Instr(parameters, "=") + 1, Instr(parameters, operat) - Instr(parameters, "=") - 1))
                operand2 = Trim(Mid(parameters, Instr(parameters, operat) + 1, Len(parameters)))

        End If

        tocheck = operand1
        checkifvar
        operand1 = tocheck

        tocheck = operand2
        checkifvar
        operand2 = tocheck

        Select Case operat

                Case ""

                        Print #1, "mov ax," + operand1
                        Print #1, "mov " + letvar + ",ax"

                Case "+"

                        Print #1, "mov ax," + operand1
                        Print #1, "add ax," + operand2
                        Print #1, "mov " + letvar + ",ax"

                Case "-"

                        Print #1, "mov ax," + operand1
                        Print #1, "sub ax," + operand2
                        Print #1, "mov " + letvar + ",ax"

                Case "*"

                        Print #1, "mov ax," + operand1
                        Print #1, "mov bx," + operand2
                        Print #1, "mul bx"
                        Print #1, "mov " + letvar + ",ax"

                Case "/"

                        Print #1, "mov dx,0"
                        Print #1, "mov ax," + operand1
                        Print #1, "mov bx," + operand2
                        Print #1, "div bx"
                        Print #1, "mov " + letvar + ",ax"

        End Select

End Sub

Sub docmd

        docount = docount + 1
        Print #1, ".do" + Ltrim(Str(docount)) + ":"
        loopstack(looppointer) = docount
        looppointer = looppointer + 1

End Sub

Sub loopcmd

        If parameters = "" Then

                infix = "1"

        Else

                infix = Trim(parameters)

        End If

        looppointer = looppointer - 1
        jumplabel = "do" + Ltrim(Str(loopstack(looppointer)))

        evaluate

        Print #1, "pop ax"
        Print #1, "cmp ax,1"

        Print #1, "je ." + jumplabel

End Sub

Sub ifcmd

        parameters = Trim(parameters)
        infix = Left(parameters, Instr(Ucase(parameters), "THEN") - 1)
        jumplabel = Ltrim(Mid(parameters, Instr(Ucase(parameters), "THEN") + 4, Len(parameters)))

        evaluate

        Print #1, "pop ax"
        Print #1, "cmp ax,1"

        If jumplabel = "" Then

                endifcount = endifcount + 1
                jumplabel = "endif" + Ltrim(Str(endifcount))
                ifstack(ifpointer) = endifcount
                ifpointer = ifpointer + 1

                Print #1, "jne ." + jumplabel

        Else

                If Left(jumplabel, 1) <> "@" Then

                        Print #1, "je ." + jumplabel

                Else

                        Print #1, "je " + jumplabel

                End If

        End If

End Sub

Sub simpleif

        operat = ""

        If Instr(parameters, "<>") Then

                operat = "<>"

        Elseif Instr(parameters, "<=") Then

                operat = "<="

        Elseif Instr(parameters, ">=") Then

                operat = ">="

        Elseif Instr(parameters, "=") Then

                operat = "="

        Elseif Instr(parameters, "<") Then

                operat = "<"

        Elseif Instr(parameters, ">") Then

                operat = ">"

        End If

        operatorlength = Len(operat)

        operand1 = Trim(Left(parameters, Instr(parameters, operat) - 1))
        operand2 = Trim(Mid(parameters, Instr(parameters, operat) + operatorlength, Instr(Ucase(parameters), " THEN") - Instr(parameters, operat) - operatorlength))
        jumplabel = Trim(Mid(parameters, Instr(Ucase(parameters), "THEN") + 5, Len(parameters)))

        tocheck = operand1
        checkifvar
        operand1 = tocheck

        tocheck = operand2
        checkifvar
        operand2 = tocheck

        Print #1, "mov ax," + operand1
        Print #1, "mov bx," + operand2
        Print #1, "cmp ax,bx"

        If jumplabel = "" Then

                endifcount = endifcount + 1
                jumplabel = "endif" + Ltrim(Str(endifcount))
                ifstack(ifpointer) = endifcount
                ifpointer = ifpointer + 1

                Select Case operat

                        Case "="

                                Print #1, "jne ." + jumplabel

                        Case "<"

                                Print #1, "ja ." + jumplabel

                        Case ">"

                                Print #1, "jb ." + jumplabel

                        Case "<>"

                                Print #1, "je ." + jumplabel

                        Case "<="

                                Print #1, "ja ." + jumplabel

                        Case ">="

                                Print #1, "jb ." + jumplabel

                End Select

        Else

                If Left(jumplabel, 1) = "@" Then

                        period = ""

                Else

                        period = "."

                End If

                Select Case operat

                        Case "="

                                Print #1, "je " + period + jumplabel

                        Case "<"

                                Print #1, "jb " + period + jumplabel

                        Case ">"

                                Print #1, "ja " + period + jumplabel

                        Case "<>"

                                Print #1, "jne " + period + jumplabel

                        Case "<="

                                Print #1, "jbe " + period + jumplabel

                        Case ">="

                                Print #1, "jae " + period + jumplabel

                End Select

        End If

End Sub

Sub printcmd

        echostringflag = 1
        newlineflag = 1

        If Right(parameters, 1) = "\" Then

                nobreak = 1
                strechoflag = 1
                parameters = Rtrim(Left(parameters, Len(parameters) - 1))

        Else

                nobreak = 0

        End If

        If Left(parameters, 1) = Chr(34) Then

                vardata = Mid(parameters, 2, Len(parameters) - 2)

                echocount = echocount + 1
                varname = "echodata" + Ltrim(Str(echocount))

                If nobreak = 1 Then

                        Print #3, varname + " db '" + vardata + "',0"
                        Print #1, "mov dx," + varname
                        Print #1, "call strecho"

                Else

                        Print #3, varname + " db '" + vardata + "',13,10,36"
                        Print #1, "mov dx," + varname
                        Print #1, "call echostring"

                End If

        Elseif Left(parameters, 1) = "@" Then

                echovalueflag = 1

                array = parameters

                parsearray
                pointarray

                Print #1, "mov ax,[si]"
                Print #1, "call echovalue"

                If nobreak = 0 Then

                        Print #1, "call newline"

                End If

        Elseif Right(parameters, 1) = "" Then

                strechoflag = 1

                parameters = Left(parameters, Len(parameters) - 1)

                Print #1, "mov dx," + parameters
                Print #1, "call strecho"

        Else

                echovalueflag = 1

                tocheck = parameters
                checkifvar
                parameters = tocheck

                Print #1, "mov ax," + parameters
                Print #1, "call echovalue"

                If nobreak = 0 Then

                        Print #1, "call newline"

                End If

        End If

End Sub

Sub inputcmd

        If Right(parameters, 1) = "" Then

                strinputflag = 1

                parameters = Left(parameters, Len(parameters) - 1)

                Print #1, "mov di," + parameters
                Print #1, "mov dx,1024"
                Print #1, "call strinput"

        Else

                inputflag = 1

                Print #1, "call inputvalue"

                If Left(parameters, 1) = "@" Then

                        array = parameters

                        Print #1, "push ax"

                        parsearray
                        pointarray

                        Print #1, "pop ax"
                        Print #1, "mov [si],ax"


                Else

                        Print #1, "mov [" + parameters + "],ax"

                End If

        End If

End Sub

Sub copycmd

        comma = Instr(parameters, ",")
        String1 = Left(parameters, comma - 1)
        string2 = Mid(parameters, comma + 1, Len(parameters) - comma)
        String1 = Left(String1, Len(String1) - 1)

        If Left(string2, 1) = Chr(34) Then

                string2 = Mid(string2, 2, Len(string2) - 2)
                copystring = copystring + 1
                nam3 = "copystr" + Ltrim(Str(copystring))

                Print #3, nam3 + " db '" + string2 + "',0"
                Print #3, "rb 1023"

                string2 = nam3

        Else

                string2 = Left(string2, Len(string2) - 1)

        End If

        Print #1, "mov di," + String1
        Print #1, "mov si," + string2
        Print #1, "mov dx,1024"
        Print #1, "call strcopy"

End Sub

Sub concatcmd

        comma = Instr(parameters, ",")
        String1 = Left(parameters, comma - 1)
        string2 = Mid(parameters, comma + 1, Len(parameters) - comma)
        String1 = Left(String1, Len(String1) - 1)

        If Left(string2, 1) = Chr(34) Then

                string2 = Mid(string2, 2, Len(string2) - 2)
                concatstring = concatstring + 1
                nam3 = "concatstr" + Ltrim(Str(concatstring))

                Print #3, nam3 + " db '" + string2 + "',0"
                Print #3, "rb 1023"

                string2 = nam3

        Else

                string2 = Left(string2, Len(string2) - 1)

        End If

        Print #1, "mov si," + string2
        Print #1, "mov di," + String1
        Print #1, "mov dx,1024"
        Print #1, "call strconcat"

End Sub

Sub comparecmd

        comma = Instr(parameters, ",")
        retvar = "[" + Left(parameters, comma - 1) + "]"

        parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
        comma = Instr(parameters, ",")
        String1 = Left(parameters, comma - 1)

        parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
        string2 = parameters

        String1 = Left(String1, Len(String1) - 1)

        If Left(string2, 1) = Chr(34) Then

                string2 = Mid(string2, 2, Len(string2) - 2)
                comparestring = comparestring + 1
                nam3 = "cmpstr" + Ltrim(Str(comparestring))

                Print #3, nam3 + " db '" + string2 + "',0"
                Print #3, "rb 1023"

                string2 = nam3

        Else

                string2 = Left(string2, Len(string2) - 1)

        End If

        Print #1, "mov ax," + String1
        Print #1, "mov bx," + string2
        Print #1, "call strcmp"
        Print #1, "mov " + retvar + ",cx"

End Sub

Sub lengthcmd

        comma = Instr(parameters, ",")
        retvar = "[" + Left(parameters, comma - 1) + "]"
        String1 = Mid(parameters, comma + 1, Len(parameters) - comma)
        String1 = Left(String1, Len(String1) - 1)

        Print #1, "mov ax," + String1
        Print #1, "call strlen"
        Print #1, "mov " + retvar + ",cx"

End Sub

Sub findcmd

        comma = Instr(parameters, ",")
        retvar = "[" + Left(parameters, comma - 1) + "]"

        parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
        comma = Instr(parameters, ",")
        String1 = Left(parameters, comma - 1)

        parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
        string2 = parameters

        String1 = Left(String1, Len(String1) - 1)

        If Right(string2, 1) = "" Then

                string2 = Left(string2, Len(string2) - 1)

        End If

        Print #1, "mov ax," + String1
        Print #1, "mov bl," + string2
        Print #1, "call strfind"
        Print #1, "mov si," + String1
        Print #1, "sub cx,si"
        Print #1, "mov ax,cx"
        Print #1, "add ax,1"
        Print #1, "cmp ax,1024"
        Print #1, "jb .isfound"
        Print #1, "xor ax,ax"
        Print #1, ".isfound:"
        Print #1, "mov " + retvar + ",ax"

End Sub

Sub trimcmd

        parameters = Left(parameters, Len(parameters) - 1)

        Print #1, "mov ax," + parameters
        Print #1, "call strtrim"

End Sub

Sub cutcmd

        comma = Instr(parameters, ",")
        strstart = Left(parameters, comma - 1)

        parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
        comma = Instr(parameters, ",")
        strcount = Left(parameters, comma - 1)

        parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
        comma = Instr(parameters, ",")
        String1 = Left(parameters, comma - 1)

        parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
        string2 = parameters

        String1 = Left(String1, Len(String1) - 1)
        string2 = Left(string2, Len(string2) - 1)

        tocheck = strstart
        checkifvar
        strstart = tocheck

        tocheck = strcount
        checkifvar
        strcount = tocheck

        Print #1, "mov cx," + strcount
        Print #1, "mov si," + string2
        Print #1, "add si," + strstart
        Print #1, "mov di," + String1
        Print #1, "call strcut"

End Sub

Sub intstrcmd

        comma = Instr(parameters, ",")
        String1 = Left(parameters, comma - 1)
        operand1 = Mid(parameters, comma + 1, Len(parameters) - comma)
        String1 = Left(String1, Len(String1) - 1)

        String1 = Rtrim(String1)
        operand1 = Ltrim(operand1)

        tocheck = operand1
        checkifvar
        operand1 = tocheck

        Print #1, "mov cx,10"
        Print #1, "mov ax," + operand1
        Print #1, "lea si,[" + String1 + "]"
        Print #1, "call strintstr"

End Sub

Sub strintcmd

        comma = Instr(parameters, ",")
        operand1 = Left(parameters, comma - 1)
        String1 = Mid(parameters, comma + 1, Len(parameters) - comma)
        String1 = Left(String1, Len(String1) - 1)

        operand1 = Ltrim(operand1)
        String1 = Rtrim(String1)

        tocheck = operand1
        checkifvar
        operand1 = tocheck

        Print #1, "mov cx,10"
        Print #1, "lea si,[" + String1 + "]"
        Print #1, "call strstrint"
        Print #1, "mov " + operand1 + ",ax"


End Sub

Sub uppercmd

        parameters = Left(parameters, Len(parameters) - 1)

        Print #1, "mov di," + parameters
        Print #1, "mov dx,1024"
        Print #1, "call strupper"

End Sub

Sub lowercmd

        parameters = Left(parameters, Len(parameters) - 1)

        Print #1, "mov di," + parameters
        Print #1, "mov dx,1024"
        Print #1, "call strlower"

End Sub

Sub clscmd

        If parameters = "" Then

                Print #1, "call resetcolors"

        Else

                comma = Instr(parameters, ",")
                clscolor = Left(parameters, comma - 1)

                parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
                comma = Instr(parameters, ",")
                scroll = Left(parameters, comma - 1)

                parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
                comma = Instr(parameters, ",")
                colorx1 = Left(parameters, comma - 1)

                parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
                comma = Instr(parameters, ",")
                colorx2 = Left(parameters, comma - 1)

                parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
                comma = Instr(parameters, ",")
                colory1 = Left(parameters, comma - 1)

                parameters = Mid(parameters, comma + 1, Len(parameters) - 1)
                colory2 = parameters

                tocheck = clscolor
                checkifvar
                clscolor = tocheck

                tocheck = scroll
                checkifvar
                scroll = tocheck

                tocheck = colorx1
                checkifvar
                colorx1 = tocheck

                tocheck = colorx2
                checkifvar
                colorx2 = tocheck

                tocheck = colory1
                checkifvar
                colory1 = tocheck

                tocheck = colory2
                checkifvar
                colory2 = tocheck

                If Left(clscolor, 1) = "[" Then

                        Print #1, "mov bh,byte " + clscolor

                Else

                        Print #1, "mov bh," + clscolor

                End If
 
                If Left(scroll, 1) = "[" Then

                        Print #1, "mov al,byte " + scroll

                Else

                        Print #1, "mov al," + scroll

                End If

                If Left(colorx1, 1) = "[" Then

                        Print #1, "mov cl,byte " + colorx1

                Else

                        Print #1, "mov cl," + colorx1

                End If

                If Left(colorx2, 1) = "[" Then

                        Print #1, "mov dl,byte " + colorx2

                Else

                        Print #1, "mov dl," + colorx2

                End If

                If Left(colory1, 1) = "[" Then

                        Print #1, "mov ch,byte " + colory1

                Else

                        Print #1, "mov ch," + colory1

                End If

                If Left(colory2, 1) = "[" Then

                        Print #1, "mov dh,byte " + colory2

                Else

                        Print #1, "mov dh," + colory2

                End If

        End If

        Print #1, "call clearscreen"

End Sub

Sub cursorcmd

        comma = Instr(parameters, ",")
        operand1 = Left(parameters, comma - 1)
        operand2 = Ltrim(Mid(parameters, comma + 1, Len(parameters) - comma))

        tocheck = operand1
        checkifvar
        operand1 = tocheck

        tocheck = operand2
        checkifvar
        operand2 = tocheck

        If Left(operand2, 1) = "[" Then

                Print #1, "mov dh,byte " + operand2

        Else

                Print #1, "mov dh," + operand2

        End If

        If Left(operand1, 1) = "[" Then

                Print #1, "mov dl,byte " + operand1

        Else

                Print #1, "mov dl," + operand1

        End If

        Print #1, "call movecursor"

End Sub

Sub chrcmd

        Select Case Ucase(Left(parameters, 1))

                Case "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"

                        Print #1, "mov dl,byte [" + parameters + "]"

                Case Else

                        Print #1, "mov dl," + parameters

        End Select
                                
        Print #1, "call echochar"

End Sub

Sub waitcmd

        parameters = Hex(Val(parameters))
        chars = Len(parameters)

        If chars > 4 Then

                regcx = Left(parameters, chars - 4)
                regdx = Right(parameters, 4)

        Else

                regdx = parameters

        End If

        Print #1, "mov cx,0" + regcx + "h"
        Print #1, "mov dx,0" + regdx + "h"
        Print #1, "call waitfor"

End Sub

Sub endcmd

        If parameters = "" Then

                Print #1, "int 32"

        Else

                Select Case Ucase(Left(parameters, 1))

                        Case "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"

                                Print #1, "mov al,byte [" + parameters + "]"

                        Case Else

                                Print #1, "mov al," + parameters

                End Select

                Print #1, "int 76"

        Endif

End Sub

Sub tokenize

        infix = "(" + infix + ")"

        For replacetoken = 1 To Len(infix)

                If Instr(infix, "<=") Then

                        leftfix = Left(infix, Instr(infix, "<=") - 1)
                        infix = Right(infix, Len(infix) - Len(leftfix) - 2)
                        infix = leftfix + Chr(128) + infix
   
                End If

                If Instr(infix, ">=") Then

                        leftfix = Left(infix, Instr(infix, ">=") - 1)
                        infix = Right(infix, Len(infix) - Len(leftfix) - 2)
                        infix = leftfix + Chr(129) + infix
   
                End If

                If Instr(infix, "<>") Then

                        leftfix = Left(infix, Instr(infix, "<>") - 1)
                        infix = Right(infix, Len(infix) - Len(leftfix) - 2)
                        infix = leftfix + Chr(130) + infix
   
                End If

                If Instr(Ucase(infix), " AND ") Then

                        leftfix = Left(infix, Instr(Ucase(infix), " AND ") - 1)
                        infix = Right(infix, Len(infix) - Len(leftfix) - 5)
                        infix = leftfix + "&" + infix

                End If

                If Instr(Ucase(infix), " OR ") Then

                        leftfix = Left(infix, Instr(Ucase(infix), " OR ") - 1)
                        infix = Right(infix, Len(infix) - Len(leftfix) - 4)
                        infix = leftfix + "|" + infix

                End If

        Next replacetoken

End Sub

Sub translate

        postfix = ""
        operatorstack = ""
        token = ""
        operat = ""

        For tokenpos = 1 To Len(infix)

                token = Mid(infix, tokenpos, 1)

                Select Case Ucase(token)

                        Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"

                                postfix = postfix + token

                        Case "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "@"

                                parsevariable

                        Case "("

                                operatorstack = operatorstack + token

                        Case ")"

                                While Right(operatorstack, 1) <> "("

                                        postfix = postfix + " " + Right(operatorstack, 1)
                                        operatorstack = Left(operatorstack, Len(operatorstack) - 1)

                                Wend

                                operatorstack = Left(operatorstack, Len(operatorstack) - 1)

                        Case "*", "/", "+", "-", "<", ">", Chr(128), Chr(129), "=", Chr(130), "&", "|"

                                processoperators

                End Select

        Next

        newstack = ""

        For tokenpos = 1 To Len(operatorstack)

                newstack = newstack + " " + Mid(operatorstack, tokenpos, 1)

        Next

        operatorstack = newstack

        postfix = postfix + operatorstack

End Sub

Sub processoperators

        getprecedence

        While operatorstack <> "" And Right(operatorstack, 1) <> "(" And tokenprecedence <= stackprecedence

                postfix = postfix + " " + Right(operatorstack, 1)
                operatorstack = Left(operatorstack, Len(operatorstack) - 1)

                getprecedence

        Wend

        operatorstack = operatorstack + token
        postfix = postfix + " "

End Sub

Sub evaluate

        tokenize
        translate

        While Len(postfix)

                If Instr(postfix, " ") Then

                        token = Left(postfix, Instr(postfix, " ") - 1)
                        postfix = Right(postfix, Len(postfix) - Len(token) - 1)

                Else

                        token = postfix
                        postfix = ""

                End If

                Select Case Ucase(Left(token, 1))

                        Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"

                                Print #1, "push " + token

                        Case "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"

                                Print #1, "push [" + token + "]"

                        Case "@"

                                array = token

                                parsearray
                                pointarray

                                Print #1, "mov ax,[si]"
                                Print #1, "push ax"

                        Case "*", "/", "+", "-", "<", ">", Chr(128), Chr(129), "=", Chr(130), "&", "|"

                                operat = token
                                calculate

                End Select

        Wend

End Sub

Sub calculate

        Print #1, "pop [operand2]"
        Print #1, "pop [operand1]"

        Select Case operat

                Case "*"

                        Print #1, "mov ax,[operand1]"
                        Print #1, "mov bx,[operand2]"
                        Print #1, "mul bx"

                Case "/"

                        Print #1, "mov dx,0"
                        Print #1, "mov ax,[operand1]"
                        Print #1, "mov bx,[operand2]"
                        Print #1, "div bx"

                Case "+"

                        Print #1, "mov ax,[operand1]"
                        Print #1, "add ax,[operand2]"

                Case "-"

                        Print #1, "mov ax,[operand1]"
                        Print #1, "sub ax,[operand2]"


                Case "<"

                        Print #1, "mov ax,[operand1]"
                        Print #1, "cmp ax,[operand2]"
                        Print #1, "setb al"
                        Print #1, "and ax,255"

                Case ">"

                        Print #1, "mov ax,[operand1]"
                        Print #1, "cmp ax,[operand2]"
                        Print #1, "seta al"
                        Print #1, "and ax,255"

                Case Chr(128) '<=

                        Print #1, "mov ax,[operand1]"
                        Print #1, "cmp ax,[operand2]"
                        Print #1, "setbe al"
                        Print #1, "and ax,255"

                Case Chr(129) '>=

                        Print #1, "mov ax,[operand1]"
                        Print #1, "cmp ax,[operand2]"
                        Print #1, "setae al"
                        Print #1, "and ax,255"

                Case "="

                        Print #1, "mov ax,[operand1]"
                        Print #1, "cmp ax,[operand2]"
                        Print #1, "setz al"
                        Print #1, "and ax,255"

                Case Chr(130) '<>

                        Print #1, "mov ax,[operand1]"
                        Print #1, "cmp ax,[operand2]"
                        Print #1, "setnz al"
                        Print #1, "and ax,255"

                Case "&" 'and

                        Print #1, "mov ax,[operand1]"
                        Print #1, "and ax,[operand2]"
                        
                Case "|" 'or

                        Print #1, "mov ax,[operand1]"
                        Print #1, "or ax,[operand2]"

        End Select

        Print #1, "push ax"

End Sub

Sub getprecedence

        stacktop = Right(operatorstack, 1)

        If stacktop = "|" Then

                stackprecedence = 1

        Elseif stacktop = "&" Then

                stackprecedence = 2

        Elseif stacktop = "=" Or stacktop = Chr(130) Then

                stackprecedence = 3

        Elseif stacktop = "<" Or stacktop = ">" Or stacktop = Chr(128) Or stacktop = Chr(129) Then

                stackprecedence = 4

        Elseif stacktop = "+" Or stacktop = "-" Then

                stackprecedence = 5

        Elseif stacktop = "*" Or stacktop = "/" Then

                stackprecedence = 6

        Else

                stackprecedence = 0

        End If

        If token = "|" Then

                tokenprecedence = 1

        Elseif token = "&" Then

                tokenprecedence = 2

        Elseif token = "=" Or token = Chr(130) Then

                tokenprecedence = 3


        Elseif token = "<" Or token = ">" Or token = Chr(128) Or token = Chr(129) Then

                tokenprecedence = 4

        Elseif token = "+" Or token = "-" Then

                tokenprecedence = 5

        Elseif token = "*" Or token = "/" Then

                tokenprecedence = 6

        Else

                tokenprecedence = 0

        End If

End Sub

Sub parsevariable

        'var = MID(infix, tokenpos, 1)
        Var9 = ""

        For varpos = tokenpos To Len(infix)

                token = Mid(infix, varpos, 1)

                Select Case token

                        Case "*", "/", "+", "-", "<", ">", Chr(128), Chr(129), "=", Chr(130), "&", "|", ")", " "

                                Exit For

                        Case Else

                                Var9 = Var9 + token

                End Select

        Next varpos

        For constant = 0 To constants - 1

                If Var9 = constname(constant) Then

                        Var9 = Ltrim(Str(constvalue(constant)))
                        Exit For

                End If

        Next constant

        tokenpos = varpos - 1

        postfix = postfix + Trim(Var9)

End Sub

Sub parsearray

        array = Right(array, Len(array) - 1)
        offset = Rtrim(Right(array, (Len(array) - Instr(array, "["))))
        offset = Left(offset, Len(offset) - 1)
        array = Left(array, Instr(array, "[") - 1)

        tocheck = offset
        checkifvar
        offset = tocheck

End Sub

Sub pointarray

        Print #1, "mov ax," + offset
        Print #1, "mov bx,2"
        Print #1, "mul bx"
        Print #1, "mov si," + array
        Print #1, "add si,ax"

End Sub

Sub checkifvar

        For constant = 0 To constants - 1

                If parameters = constname(constant) Then

                        tocheck = Ltrim(Str(constvalue(constant)))
                        Exit For

                End If

        Next constant

        If constant = constants Then

                Select Case Ucase(Left(tocheck, 1))

                        Case "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"

                                tocheck = "[" + tocheck + "]"

                End Select

        End If

End Sub
    
Post 29 Jan 2023, 23:01
View user's profile Send private message Reply with quote
al_Fazline



Joined: 24 Oct 2018
Posts: 44
al_Fazline 30 Jan 2023, 02:44
I think if you write a basic compiler, it should probably be written in itself, or better yet in a common subset between itself and some other basic interpreter or compiler, which in turn allows the basic to be bootstrapped from the source and become self-hosted.

What is the point in having a basic compiler if you can't use it without another basic compiler?
Post 30 Jan 2023, 02:44
View user's profile Send private message Reply with quote
geekbasic@gmx.com



Joined: 25 Oct 2022
Posts: 65
Location: Arizona
geekbasic@gmx.com 30 Jan 2023, 18:28
I have found an error with constants and with the bubble sort example. I was tired and made a few typos... I am fixing this now and will release an update later today.

jack2 wrote:
OK, this is just a rough translation, your QuickBasic source used Gosubs which FreeBasic allows only in #lang "QB" and maybe also in #lang "fblite" but I don't like to use those variants so I made all subroutines into sub's, but not knowing what variables were shared between subroutines I made all the variables shared, that means global in scope.
about 3 variables had to be renamed because they are keywords in FB, Var, Name and Include
you should be able to simplify the code by using local variables when possible and thereby significantly reduce the number of globals
you can get FreeBasic from https://www.freebasic.net/forum/ in the news section


Thank you for sharing. I will test it to make sure everything still works. It's a good idea to compile it with Free Basic because that removes Microsoft from the picture. I must caution that I wrote the subs in a manner that would be initially difficult to convert them to functions. The design is ad hoc as they say. I was stumbling around in the dark trying to make this thing work.

Quote:

I think if you write a basic compiler, it should probably be written in itself, or better yet in a common subset between itself and some other basic interpreter or compiler, which in turn allows the basic to be bootstrapped from the source and become self-hosted.

What is the point in having a basic compiler if you can't use it without another basic compiler?


It's a fun and educational experiment. It will take time before this could be self hosting. It's only in beta stage.

_________________
http://www.basicgames.xyz
Post 30 Jan 2023, 18:28
View user's profile Send private message Visit poster's website Reply with quote
geekbasic@gmx.com



Joined: 25 Oct 2022
Posts: 65
Location: Arizona
geekbasic@gmx.com 30 Jan 2023, 19:47
Update! Available in the download. It fixes a problem with using constants in expressions. It was a typo. Also, I had made a mistake with the bubble sort example, so I fixed that. The one mistake lead me to the other. (I modified the checkifvar sub)

Also, I have included a new example program:
Code:
rem Alarm Clock timer example
rem demonstrates command line parameters and system time
rem accepts input directly or from command line parameters
rem compile with FTCBASIC

use time.inc
use command.inc

define timeset = 0, timestamp = 0, bells = 0

print "Alarm Clock"
crlf

gosub cmdline
strint timeset, params$

if timeset = 0 then

        print "Seconds? " \
        input timeset

endif

gosub systemtime
let timestamp = loworder

do

        gosub systemtime

loop ( loworder - timestamp ) / 18 < timeset

print "Time up!"

do

        bell
        +1 bells

loop bells < 10

pause

end
    
Post 30 Jan 2023, 19:47
View user's profile Send private message Visit poster's website Reply with quote
FlierMate11



Joined: 13 Oct 2022
Posts: 56
FlierMate11 01 Feb 2023, 05:38
geekbasic@gmx.com wrote:

It's a fun and educational experiment. It will take time before this could be self hosting. It's only in beta stage.


True, it is fun doing a compiler, and can serve as educational purpose for other interested people.
I myself did a few simple back-end compilers, but they are not capable of self-compiling. Of course it is exciting to make our compilers self-host / self-compile, but on the other hand, it is already a satisfaction like you to be able to write compiler that generate binary executable directly. (Okay, or through FASM)
Keep up the good work! (I also help advertised your previous Pebble compiler on local forum)
Post 01 Feb 2023, 05:38
View user's profile Send private message Visit poster's website Reply with quote
Tomasz Grysztar



Joined: 16 Jun 2003
Posts: 8106
Location: Kraków, Poland
Tomasz Grysztar 01 Feb 2023, 12:33
FlierMate11 wrote:
Of course it is exciting to make our compilers self-host / self-compile, but on the other hand, it is already a satisfaction like you to be able to write compiler that generate binary executable directly.
Yes, I think it healthier to not see self-hosting as a necessary goal. Not every language must be good for writing compilers. If you design a language that is great for making 3D games, it may not necessarily be a good language for writing lexical parsers.

Perhaps the expectation of self-hosting reflects an opinion that it would prove that the compiler is matured and well-capable. But I don't think it proves much. My assembler had been self-hosting from the very beginning, but these first versions were still very rough, with very small set of features. The majority of fasm's development came later. And the main reason why self-hosting was important to me was that I did not own a personal license for the assembler I liked (TASM), so I wanted to make something that would allow me to code in a similar way, but with an independent and self-sufficient toolchain.
Post 01 Feb 2023, 12:33
View user's profile Send private message Visit poster's website Reply with quote
FlierMate11



Joined: 13 Oct 2022
Posts: 56
FlierMate11 01 Feb 2023, 12:58
Well said Tomasz, actually I am grateful that FASM self-host, or else it wouldn't be a choice of a cyberpal of mine (who introduced FASM to me), and I wouldn't be coding in FASM starting from 2021.

Quote:
And the main reason why self-hosting was important to me was that I did not own a personal license for the assembler I liked (TASM), so I wanted to make something that would allow me to code in a similar way, but with an independent and self-sufficient toolchain


It is encouraging to hear that, luckily you didn't own license of TASM at the time. Very Happy
Post 01 Feb 2023, 12:58
View user's profile Send private message Visit poster's website Reply with quote
DimonSoft



Joined: 03 Mar 2010
Posts: 1155
Location: Belarus
DimonSoft 01 Feb 2023, 15:33
Tomasz Grysztar wrote:
Perhaps the expectation of self-hosting reflects an opinion that it would prove that the compiler is matured and well-capable. But I don't think it proves much.

I guess, it’s not about proving something but about walking through the whole pipeline a compiler is expected to be: from lexical analysis through syntactic and semantic analysis, to optimization and code generation. And while code generation is not required to be to real hardware machine code, generating source code for another compiler somehow makes such implementation more like yet another preprocessor. I’d say that is why people demand self-hosting from compiler projects.
Post 01 Feb 2023, 15:33
View user's profile Send private message Visit poster's website Reply with quote
al_Fazline



Joined: 24 Oct 2018
Posts: 44
al_Fazline 02 Feb 2023, 09:39
I thought that self-hosting in FTCBASIC would be a relatively trivial matter, because it's already written in Basic of different dialect, that's why I suggested to try rewriting into itself.

So, was I wrong, and FTCBASIC is less powerful then even QBasic? What features does it lack?
Post 02 Feb 2023, 09:39
View user's profile Send private message Reply with quote
geekbasic@gmx.com



Joined: 25 Oct 2022
Posts: 65
Location: Arizona
geekbasic@gmx.com 06 Feb 2023, 07:03
FTCBASIC is essentially a Tiny/Minimal BASIC compiler. It's syntax aims to have just the bare minimum of the very original BASIC syntax with a few fancy features peppered on. To my knowledge, there's not too may Tiny Basic compilers rather than interpreters.

To be honest, making this thing self hosting is way out of the scope of what I originally intended. A Tiny Basic language just doesn't have the features.

It is possible to make FTCBASIC self hosting. I just need help or a lot more time. What it needs is to be able to manage memory to create exes and not be limited by com file size. It needs string arrays. Right now it just has very primitive strings and 1d arrays. It does have a complete set of string parsing functions.

I am actively working on FTCBASIC and another language called Craft Basic which is an interpreter. An interpreter and a compiler. Both projects are very important to me.

FASM is without a doubt the best option for a project like mine. I am thankful for it.
Post 06 Feb 2023, 07:03
View user's profile Send private message Visit poster's website Reply with quote
Display posts from previous:
Post new topic Reply to topic

Jump to:  


< Last Thread | Next Thread >
Forum Rules:
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum


Copyright © 1999-2023, Tomasz Grysztar. Also on GitHub, YouTube, Twitter.

Website powered by rwasa.