Index
> Programming Language Design > FTCBASIC (Fast Tiny Compiled BASIC)Goto page 1, 2 Next |
| Author |
|
|
geekbasic@gmx.com 06 Jan 2023, 20:09
Homepage: http://www.lucidapogee.com/index.php?page=ftcbasic 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 "Lucid Apogee 2022" cursor 27, 3 print "http://www.lucidapogee.com" 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
Last edited by geekbasic@gmx.com on 02 Mar 2023, 04:07; edited 12 times in total |
|||||||||||
06 Jan 2023, 20:09 |
|
|
geekbasic@gmx.com 07 Jan 2023, 07:00
Update!
I have added a file access library. |
|||
|
07 Jan 2023, 07:00 |
|
|
al_Fazline 09 Jan 2023, 15:22
Are you going to make it self-hosted and thus remove the dependency on proprietary Microsoft compiler?
|
|||
|
09 Jan 2023, 15:22 |
|
|
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. |
|||
|
09 Jan 2023, 19:09 |
|
|
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.
|
|||
|
09 Jan 2023, 21:31 |
|
|
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. |
|||
|
10 Jan 2023, 18:59 |
|
|
geekbasic@gmx.com 27 Jan 2023, 04:39
The beta version is now released!
This includes defining and using constants and more libraries! |
|||
|
27 Jan 2023, 04:39 |
|
|
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 |
|||
|
29 Jan 2023, 00:30 |
|
|
geekbasic@gmx.com 29 Jan 2023, 21:35
I am interested to see your translation. Please do share it.
|
|||
|
29 Jan 2023, 21:35 |
|
|
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 |
|||
|
29 Jan 2023, 23:01 |
|
|
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? |
|||
|
30 Jan 2023, 02:44 |
|
|
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. 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:
It's a fun and educational experiment. It will take time before this could be self hosting. It's only in beta stage. |
|||
|
30 Jan 2023, 18:28 |
|
|
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 |
|||
|
30 Jan 2023, 19:47 |
|
|
FlierMate11 01 Feb 2023, 05:38
geekbasic@gmx.com wrote:
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) |
|||
|
01 Feb 2023, 05:38 |
|
|
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. 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. |
|||
|
01 Feb 2023, 12:33 |
|
|
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.  |
|||
|
01 Feb 2023, 12:58 |
|
|
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. |
|||
|
01 Feb 2023, 15:33 |
|
|
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? |
|||
|
02 Feb 2023, 09:39 |
|
|
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. |
|||
|
06 Feb 2023, 07:03 |
|
| Goto page 1, 2 Next < Last Thread | Next Thread > |
Forum Rules:
|