|
Post by tsh73 on Jan 29, 2024 21:59:21 GMT
along Let's Build a Compiler, by Jack Crenshaw justbasiccom.proboards.com/thread/1086/build-compiler-jack-crenshawbe warned that 1) it is written in TurboPascal 4 Of cource I think in BASIC so it'll get translated. 2) it produces asembler code for 68000 microprocessor (not Intel'86) I actually remember some Intel 8080, but I just picked bits of Intel 86 to try and make it work on real hardware. I am week in, so have something to say / show. Part 1 explains some why and how, and produces some boilerplate code (TurboPascal 4, rememeber?) It looks pretty similar to BASIC, though With a bit of "replace all" it gets even close... Here's some SED code to do that automatically (after doing that again and again I though of SED, made just for these tasks in mind) s/'/"/g s/{/'{/ s/;// /^begin/d s/procedure/sub/
This to be saved as pas2bas.sed Pascal source to be saved as part.pas And this BAT file uses it sed -f pas2bas.sed part.pas >part.bas start notepad.exe part.bas
Iam not sure if modern Win10 (11?) contains SED.EXE; I got sed from UnxUtils en.wikipedia.org/wiki/UnxUtilsRest differences between Pascal and Just BASIC are fixed by hand ;) So this is "Cradle" program converted to JB (initially I used input$(1) to make sub GetChar so I entered things blindly (it does not echo) and got some output/errors Then I changed it to read whole line and pick letters from it ) it says v4.0 because part 4 again starts from Cradle. But it got some pieces added ib chapers 2 and 3. 'v 4.0 - base, to iterpreter 'base for compiler 'Pascal to BASIC '{--------------------------------------------------------------} 'program Cradle;
'{--------------------------------------------------------------} '{ Constant Declarations }
global TAB$, qq$, src$, inputLine$, inputPos TAB$ = chr$(9) qq$=chr$(34) 'const TAB = ^I;
'{--------------------------------------------------------------} '{ Variable Declarations }
'var Look: char; '{ Lookahead Character } global Look$
'{--------------------------------------------------------------} '{ Main Program }
call Init print "Look$>";Look$ print "Normal END." print "Src was ";src$ input "Press ENTER to quit"; dummy$ end '{--------------------------------------------------------------}
'{--------------------------------------------------------------} '{ Read New Character From Input Stream }
sub GetChar inputPos=inputPos+1 Look$=mid$(inputLine$,inputPos,1) src$=src$+Look$ 'print ">";Look$ end sub
'{--------------------------------------------------------------} '{ Report an Error }
sub ErrorMsg s$ print print "Error: "; s$; "." end sub
'{--------------------------------------------------------------} '{ Report Error and Halt }
sub Abort s$ call ErrorMsg s$ input "Press ENTER to quit"; dummy$ end end sub
'{--------------------------------------------------------------} '{ Report What Was Expected }
sub Expected s$ call Abort s$ + " Expected" end sub
'{--------------------------------------------------------------} '{ Match a Specific Input Character }
sub Match x$ if Look$ = x$ then call GetChar else call Expected qq$ ; x$ ; qq$ end sub
'{--------------------------------------------------------------} '{ Recognize an Alpha Character }
function IsAlpha(c$) IsAlpha = instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", upper$(c$))>0 end function
'{--------------------------------------------------------------}
'{ Recognize a Decimal Digit }
function IsDigit(c$) IsDigit = instr("0123456789", c$)>0 end function
'{--------------------------------------------------------------} '{ Recognize an Alphanumeric }
function IsAlNum(c$) IsAlNum = IsAlpha(c$) or IsDigit(c$) end function
'{--------------------------------------------------------------} '{ Recognize an Addop }
function IsAddop(c$) IsAddop = instr("+-", c$)>0 end function
'{--------------------------------------------------------------} '{ Get an Identifier }
function GetName$() if not(IsAlpha(Look$)) then call Expected "Name" GetName$ = Upper$(Look$) call GetChar end function
'{--------------------------------------------------------------} '{ Get a Number }
function GetNum$() if not(IsDigit(Look$)) then call Expected "Integer" GetNum$ = Look$ call GetChar end function
'{--------------------------------------------------------------} '{ Output a String with Tab }
sub Emit s$ print tab(7); s$; end sub
'{--------------------------------------------------------------} '{ Output a String with Tab and CRLF }
sub EmitLns$ call Emit s$ print end sub
'{--------------------------------------------------------------} '{ Initialize }
sub Init line input ">";inputLine$ inputPos=0 call GetChar end sub
|
|
|
Post by tsh73 on Jan 30, 2024 20:52:00 GMT
On with chapter 2, "EXPRESSION PARSING" It expains how to turn arifmetic expression, from integers, +-*/, () and unary - into assembler code. (restrictions for now is that integers are single-digit only)
After some fiddling, I got
1+2 converted to
MOV EAX,1 PUSH EAX MOV EAX,2 POP EBX ADD EAX, EBX
But how am I to compile/check/test this?
Well, it happens that in Visual C++, in 32-bit program one could include inline assembler into C code. And we could use C variables, which is very handy. So I changed program to make this output (it writes to mainwin, and to main.c in DefaultDir$, and opens it in Notepad - comment it out if you don't need it):
#include <stdio.h>
int main() { int res; __asm { MOV EAX,1 PUSH EAX MOV EAX,2 POP EBX ADD EAX, EBX
MOV res, EAX //save result } printf("src=1+2\n"); printf("res=%d\n", res); return 0; }
I just have Visual C++ express 2010 (yes, free version is good) opened, with created project Win32 console application, started with empty project Add code produced and run it. It prints
src=1+2 res=3 Looks working! it even allow step-by step debugging of assembly code.
Another option is to run "Visual studio command prompt" (command prompt with necessary environment variables set), navigate to wthere you saved main.c and executing command
cl main.c So you just call C compiler - and if there is no errors, it produces main.exe
I have to check if it will work in newer version of VC++ (community edition), will report.
Just checked in VC 2017, under Win 32, calling compiler from command line. Got EXE, got right answer.
I wrote ASM code "from basic principles", ASM code very likely could be made better. But it works, and looks like it produces right numbers! (I actually had interpreter part cludged along ASM generating, kind of MOV EAX,1 -> use global var EAX, execute EAX=1 But since I discovered that Chapter 4 is specifically devoted to interpreter, I cut it off from version I going to post. ) Last thing. Single digit fits everythere But registers is AL (byte) AX (16 bit) EAX (32 bit) (there is a RAX for 64 bit too, but my program is 32 bit) I suppose that my program should work with numbers up to 16 bit Trying to make multiplication and division to work right on negative values added some "expand sign" instructions. Well, it kind of worked then I tested it. (Unit testing for JB, anyone? ;)) )
|
|
|
Post by tsh73 on Jan 30, 2024 20:52:58 GMT
So here is result of Chapter 2, with improved output file (main.c)
'base for compiler 'v0.0 - initial Pascal base 'v1.0 - initial Pascal to BASIC base 'v2.0 - single number 'v2.1 - Add, Sub on 2 numbers ' <term> +/- <term> 'v2.2 - to Intel assembly 'v2.3 - iteration on addops (1..not limited operands) ' <expression> ::= <term> [<addop> <term>]* 'v2.4 - add immediate calc (along asm), print src line 'v2.5 - use stack 'v2.6 - multiplication, division ' <term> ::= <factor> [ <mulop> <factor ]* 'v2.7 - brackets () ' <factor> ::= (<expression>) 'v2.8 - unary minus, by "-x" -> "0-x" 'v2.9 - fixing sign in assembler mul(+), div(??) 'v2.10 - change input: reading whole string, read chars from string 'v2.10_1 - make nice C code 'v2.10_2 - remove interpreter part '{--------------------------------------------------------------} 'program Cradle;
'{--------------------------------------------------------------} '{ Constant Declarations }
global TAB$, CRLF$, qq$, src$, code$, inputLine$, inputPos TAB$ = chr$(9) qq$ = chr$(34) CRLF$ = chr$(13)+chr$(10)
'{--------------------------------------------------------------} '{ Variable Declarations }
'var Look: char; '{ Lookahead Character } global Look$
'{--------------------------------------------------------------} '{ Main Program }
call Init 'print ">>";Look$ call Expression print "Normal END." print "Src was ";src$ call writeCode "" 'to a mainwin call writeCode "main.c" 'to a file input "Press ENTER to quit"; dummy$ end '================================================================
'{---------------------------------------------------------------} '{ Parse and Translate a Math Factor }
sub Factor if Look$ = "(" then call Match "(" call Expression 'now with recursion call Match ")" else call EmitLn "MOV EAX," + GetNum$() end if end sub
'{--------------------------------------------------------------} '{ Recognize and Translate a Multiply }
sub Multiply call Match "*" call Factor call EmitLn "POP EBX" 'restrict to single byte ?? 'IMUL to get signed, like -15 is 65521 (2^16-15)?? call EmitLn "IMUL BL" 'AL*BL->AX, with sign call EmitLn "CWDE" 'extend sign to whole EAX end sub
'{-------------------------------------------------------------} '{ Recognize and Translate a Divide }
sub Divide call Match "/" call Factor call EmitLn "POP EBX" call EmitLn "XCHG AX, BX" call EmitLn "MOV EDX, 0" 'somehow CWD is not enough call EmitLn "CWD" 'expand sign of AX to DX:AX call EmitLn "IDIV BX" 'so it will not overflow (??) call EmitLn "CWDE" 'extend sign to whole EAX 'AX = DX:AX / BX 'DX = reminder (DX:AX MOD BX) - jsut ignore it end sub
'{---------------------------------------------------------------} '{ Parse and Translate a Math Term }
sub Term call Factor while instr("*/", Look$)>0 call EmitLn "PUSH EAX" select case Look$ case "*": call Multiply case "/": call Divide case else: call Expected "Mulop" end select wend end sub
'{--------------------------------------------------------------} '{ Recognize and Translate an Add }
sub Add call Match "+" call Term call EmitLn "POP EBX" call EmitLn "ADD EAX, EBX" end sub
'{-------------------------------------------------------------} '{ Recognize and Translate a Subtract }
sub Subtract call Match "-" call Term call EmitLn "POP EBX" call EmitLn "SUB EAX, EBX" 'subs EBX from EAX, puts to EAX call EmitLn "NEG EAX" 'has to negate end sub
'{---------------------------------------------------------------} '{ Parse and Translate an Expression }
sub Expression if IsAddop(Look$) then call EmitLn "MOV EAX, 0" else call Term end if while IsAddop(Look$) 'call EmitLn "MOV EBX, EAX" 'dest src call EmitLn "PUSH EAX" select case Look$ case "+": call Add case "-": call Subtract case else: call Expected "Addop" 'unreachable? end select wend end sub
'{--------------------------------------------------------------} '{ Read New Character From Input Stream }
sub GetChar inputPos=inputPos+1 Look$=mid$(inputLine$,inputPos,1) src$=src$+Look$ 'print ">";Look$ end sub
'{--------------------------------------------------------------} '{ Report an Error }
sub ErrorMsg s$ print print "Error: "; s$; "." end sub
'{--------------------------------------------------------------} '{ Report Error and Halt }
sub Abort s$ call ErrorMsg s$ print "Src was ";src$ input "Press ENTER to quit"; dummy$ end end sub
'{--------------------------------------------------------------} '{ Report What Was Expected }
sub Expected s$ call Abort s$ + " Expected" end sub
'{--------------------------------------------------------------} '{ Match a Specific Input Character }
sub Match x$ if Look$ = x$ then call GetChar else call Expected qq$ ; x$ ; qq$ end sub
'{--------------------------------------------------------------} '{ Recognize an Alpha Character }
function IsAlpha(c$) IsAlpha = instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", upper$(c$))>0 end function
'{--------------------------------------------------------------}
'{ Recognize a Decimal Digit }
function IsDigit(c$) IsDigit = instr("0123456789", c$)>0 end function
'{--------------------------------------------------------------} '{ Recognize an Addop }
function IsAddop(c$) IsAddop = instr("+-", c$)>0 end function
'{--------------------------------------------------------------} '{ Get an Identifier }
function GetName$() if not(IsAlpha(Look$)) then call Expected "Name" GetName$ = Upper$(Look$) call GetChar end function
'{--------------------------------------------------------------} '{ Get a Number }
function GetNum$() if not(IsDigit(Look$)) then call Expected "Integer" GetNum$ = Look$ call GetChar end function
'{--------------------------------------------------------------} '{ Output a String with Tab }
sub Emit s$ 'print tab(9); s$; code$=code$; space$(8); s$ end sub
'{--------------------------------------------------------------} '{ Output a String with Tab and CRLF }
sub EmitLn s$ call Emit s$ 'print code$=code$;CRLF$ end sub
'{--------------------------------------------------------------} '{ Initialize }
sub Init line input ">";inputLine$ inputPos=0 call GetChar end sub
'==================================================
function CWrapper$(part) select case part case 1 CWrapper$="" _ + "#include <stdio.h>"+CRLF$ _ + ""+CRLF$ _ + "int main()"+CRLF$ _ + "{"+CRLF$ _ + " int res;"+CRLF$ _ + " __asm"+CRLF$ _ + " { " 'sample code ' + " MOV EAX,1"+CRLF$ _ ' + " PUSH EAX"+CRLF$ _ ' + " MOV EAX,2"+CRLF$ _ ' + " POP EBX"+CRLF$ _ ' + " ADD EAX, EBX"+CRLF$ _ case 2 CWrapper$="" _ + " MOV res, EAX //save result"+CRLF$ _ + " }"+CRLF$ _ + " printf("+qq$+"src="+src$+"\n"+qq$+");"+CRLF$ _ + " printf("+qq$+"res=%d\n"+qq$+", res);"+CRLF$ _ + " return 0;"+CRLF$ _ + "}" end select end function
sub writeCode fileName$ if fileName$="" then print print CWrapper$(1) print code$ print CWrapper$(2) print else open fileName$ for output as #1 print #1, CWrapper$(1) print #1, code$ print #1, CWrapper$(2) close #1 run "notepad.exe ";DefaultDir$;"\"; fileName$ end if end sub
|
|
|
Post by xxgeek on Jan 31, 2024 16:34:49 GMT
Nice work for a first attempt tsh73. You sure do choose the hard stuff to work on. Love it. When will you have it complete with ALL the commands for JB? About a week? First let me state this is way beyond my experience. But I hope to follow and help a little if I can. I found that if I keep to using + - * and / with integers of one digit I can run a long string of math that works well, and sticks to convention. eg: >6*6+8/4-4+9*6+9/3 Normal END. Src was 6*6+8/4-4+9*6+9/3
#include <stdio.h>
int main() { int res; __asm { MOV EAX,6 PUSH EAX MOV EAX,6 POP EBX IMUL BL CWDE PUSH EAX MOV EAX,8 PUSH EAX MOV EAX,4 POP EBX XCHG AX, BX MOV EDX, 0 CWD IDIV BX CWDE POP EBX ADD EAX, EBX PUSH EAX MOV EAX,4 POP EBX SUB EAX, EBX NEG EAX PUSH EAX MOV EAX,9 PUSH EAX MOV EAX,6 POP EBX IMUL BL CWDE POP EBX ADD EAX, EBX PUSH EAX MOV EAX,9 PUSH EAX MOV EAX,3 POP EBX XCHG AX, BX MOV EDX, 0 CWD IDIV BX CWDE POP EBX ADD EAX, EBX MOV res, EAX //save result } printf("src=6*6+8/4-4+9*6+9/3\n"); printf("res=%d\n", res); return 0; } Gives res - 91 (as expected) But if math is used that produces a decimal number(or fraction) it is truncated and the 'res' will be an estimate. It doesn't round up, or down, it just dismisses the fraction leaving the whole number before the decimal. I'm sure you know this by now anyway. The best part is the fact that you have it working well with long math statements. It will be a lesson to have it work with negative numbers. eg -2+3-6 works but -2+-3 or 3*-3 doesn't. Looking forward to your lessons
|
|
|
Post by tsh73 on Jan 31, 2024 18:28:26 GMT
Hello xxgeek thanks for a kind words :) But this is long thing. I do read a book and do implement along it - and it makes one think, and it is hard So I am just after one week and past chapter 4 And it'll probably take rest of this week just to show what I end with, somewhat polishing these programs, removing extra stuff It will definitely ends up as some programming language, hardly JB, though. JB is really REALLY big for me (for single me). Will see. Math is nice, yes And as of now, it supports brackets (), so stuff like 9+8*(7-6*(4+3))/2 should work too (just tried it. Yes it does) As for truncating, it is integer thing, really, supposed to work like this. I never tried floating point with assembler. But there is easier way - if one compiles to C instead of assembly, he could easily use floating point numbers ;)
The thing that "-2+-3" really works at all, really surprises me. But I just tested JB/VBA (in Excel)/C/some Pascal/Python - and it works in all of them. I would hardly write this way - just not used to.
Last thing. My codes is resulting code for the chapter. Probably could help if someone wants to read book and run something, but did not want to code all of it. Probably will not be of much use without reading the book.
|
|
|
Post by tsh73 on Feb 1, 2024 16:05:31 GMT
On with chapter 3, "MORE EXPRESSIONS"
It adds variables (variable names are recognized in function Factor) Names just used in ASM code, like this
MOV EAX,X I want it to compile - so I add C declaration
int X; Declarations go ahead of usage, so I keep varList$ (space delimited) and build whole program in the end from pieces. function CWrapper$(part) is program spitting these pieces (C program template) sub writeCode fileName$ writes these pieces, interlaced with changing things (variable declarations, ASM code, etc)
This makes things more complex then in a book - now last 120 lines make final assembling of a program But in return, I get main.c I just could paste into Visual C and run.
Book adds support for calling functions, without parameters. If it sees
y() it emits
CALL Y My guess that returned value is in EAX register For it to compile, I need to create some C function
int Y(){return 1;} - I made it return function number. Seems working. I add funcList$ because functions should be declared ahead of main().
Also there is a check added if our program consumed whole line entered. In the book it is checked upon neext symbol being CR In JB, line input does not read CR. But we could check that nothing left un-processed from current
line input "; ";inputLine$
Next item was actual assignment statement. In this inline assembler we could just use variable name as destination
MOV X, EAX (and I add var name to varList$).
Now author asks to set aside current varsion (I have it, but it is version without printing complete main.c) and shows how to do some nice "bonus" things.
It is: * multicharacter tokens (as in numbers, say 123, and in names, say sum. BTW you can notice that all names are converted to upper$()... so variables are case insencitive) * skipping whitespaces. Prior that, any unrecognised symbol stopped translation (likely with error).
I went a bit further and added "work until empty line". So we can assign variables and use them next lines...
(and while porting "make that main.c" stuff, I changed assembly instruction IMUL BL (single byte) to IMUL BX (two bytes) Without it, I kept getting negative result for 200*2... Now probably next command, CWDE, has no sence. )
Example of what it does: you enter two lines, and press Enter to add empty line (stop sign)
x=1+y() z=10*x+1
It produces this C code:
#include <stdio.h> int Y(){return 1;}
int main() { int X; int Z;
__asm { //x=1+y() MOV EAX,1 PUSH EAX CALL Y POP EBX ADD EAX, EBX MOV X, EAX //z=10*x+1 MOV EAX,10 PUSH EAX MOV EAX,X POP EBX IMUL BX CWDE PUSH EAX MOV EAX,1 POP EBX ADD EAX, EBX MOV Z, EAX
}
printf("X=%d\n", X); printf("Z=%d\n", Z);
return 0; }
|
|
|
Post by tsh73 on Feb 1, 2024 16:11:36 GMT
Here is result of Chapter 3
'base for compiler 'v0.0 - initial Pascal base 'v1.0 - initial Pascal to BASIC base 'v2.0 - single number 'v2.1 - Add, Sub on 2 numbers ' <term> +/- <term> 'v2.2 - to Intel assembly 'v2.3 - iteration on addops (1..not limited operands) ' <expression> ::= <term> [<addop> <term>]* 'v2.4 - add immediate calc (along asm), print src line 'v2.5 - use stack 'v2.6 - multiplication, division ' <term> ::= <factor> [ <mulop> <factor ]* 'v2.7 - brackets () ' + <factor> ::= (<expression>) ' <factor> ::= <number> | (<expression>) 'v2.8 - unary minus, by "-x" -> "0-x" 'v2.9 - fixing sign in assembler mul(+), div(??) 'v2.10 - change input: reading whole string, read chars from string 'v3.1 - add variables ' <factor> ::= <number> | (<expression>) | <variable> 'v3.2 - add functions, like X() 'v3.3 - require CRLF as last symbol ' (actually check that nothing left) ' still breaks on spaces though 'v3.4 - assignment ' <Ident> = <Expression> 'v3.5 - multy char tokens 'v3.6 - skip spaces 'v3.7 - repeat until empty line 'v3.7_1 - port nice C code from 2.10_1, add variables to C 'v3.7_2 - add list functions, add functions to C 'v3.7_3 - remove interpreter part. Also IMUL BX for 16 but 'v3.7_4 - actual removing from code '{--------------------------------------------------------------} 'program Cradle;
'{--------------------------------------------------------------} '{ Constant Declarations }
global TAB$, CRLF$, qq$, src$, code$, inputLine$, inputPos, varList$, varNum, funcList$ TAB$ = chr$(9) qq$ = chr$(34) CRLF$ = chr$(13)+chr$(10)
'{--------------------------------------------------------------} '{ Variable Declarations }
'var Look: char; '{ Lookahead Character } global Look$
'{--------------------------------------------------------------} '{ Main Program }
call Init0 while 1 call Init 'print ">>";Look$ if Look$="" then exit while call EmitLn "//";inputLine$ call Assignment 'if Look <> CR then Expected('Newline'); if Look$ <> "" then call Expected "Newline" wend
print "Normal END." print "Src was :" print src$ print "varList$ = ";varList$ print "funcList$ = ";funcList$ call writeCode "" 'to a mainwin call writeCode "main.c" 'to a file input "Press ENTER to quit"; dummy$ end '================================================================
'{---------------------------------------------------------------} '{ Parse and Translate an Identifier }
sub Ident Name$ = GetName$() if Look$ = "(" then call Match "(" call Match ")" call EmitLn "CALL " + Name$ call addToListUniq funcList$, Name$ else 'call saveName Name$,0 'actually should not create var here call EmitLn "MOV EAX," + Name$ 'die if var Name$ not vound?? if not(inlist(varList$,Name$)) then call Abort "Variable ";Name$;" is not defined" end if end sub
'{---------------------------------------------------------------} '{ Parse and Translate a Math Factor }
sub Factor if Look$ = "(" then call Match "(" call Expression 'recursive call call Match ")" else if IsAlpha(Look$) then call Ident else call EmitLn "MOV EAX," + GetNum$() end if end if end sub
'{--------------------------------------------------------------} '{ Recognize and Translate a Multiply }
sub Multiply call Match "*" call Factor call EmitLn "POP EBX" 'restrict to single byte ?? 'IMUL to get signed, like -15 is 65521 (2^16-15)?? call EmitLn "IMUL BX" 'AL*BL->AX, with sign call EmitLn "CWDE" 'extend sign to whole EAX end sub
'{-------------------------------------------------------------} '{ Recognize and Translate a Divide }
sub Divide call Match "/" call Factor call EmitLn "POP EBX" call EmitLn "XCHG AX, BX" call EmitLn "MOV EDX, 0" 'somehow CWD is not enough call EmitLn "CWD" 'expand sign of AX to DX:AX call EmitLn "IDIV BX" 'so it will not overflow (??) call EmitLn "CWDE" 'extend sign to whole EAX 'AX = DX:AX / BX 'DX = reminder (DX:AX MOD BX) - jsut ignore it end sub
'{---------------------------------------------------------------} '{ Parse and Translate a Math Term }
sub Term call Factor while instr("*/", Look$)>0 call EmitLn "PUSH EAX" select case Look$ case "*": call Multiply case "/": call Divide case else: call Expected "Mulop" end select wend end sub
'{--------------------------------------------------------------} '{ Recognize and Translate an Add }
sub Add call Match "+" call Term call EmitLn "POP EBX" call EmitLn "ADD EAX, EBX" end sub
'{-------------------------------------------------------------} '{ Recognize and Translate a Subtract }
sub Subtract call Match "-" call Term call EmitLn "POP EBX" call EmitLn "SUB EAX, EBX" 'subs EBX from EAX, puts to EAX call EmitLn "NEG EAX" 'has to negate end sub
'{---------------------------------------------------------------} '{ Parse and Translate an Expression }
sub Expression if IsAddop(Look$) then call EmitLn "MOV EAX, 0" else call Term end if while IsAddop(Look$) 'call EmitLn "MOV EBX, EAX" 'dest src call EmitLn "PUSH EAX" select case Look$ case "+": call Add case "-": call Subtract case else: call Expected "Addop" 'unreachable? end select wend end sub
'{--------------------------------------------------------------} '{ Parse and Translate an Assignment Statement }
sub Assignment Name$ = GetName$() call Match "=" call Expression call EmitLn "MOV " + Name$ +", EAX" call addToListUniq varList$, Name$ 'create var end sub
'{--------------------------------------------------------------} '{ Read New Character From Input Stream }
sub GetChar inputPos=inputPos+1 Look$=mid$(inputLine$,inputPos,1) src$=src$+Look$ if Look$="" then src$=src$+CRLF$ 'print ">";Look$ end sub
'{--------------------------------------------------------------} '{ Report an Error }
sub ErrorMsg s$ print print "Error: "; s$; "." end sub
'{--------------------------------------------------------------} '{ Report Error and Halt }
sub Abort s$ call ErrorMsg s$ print "Src was ";src$ input "Press ENTER to quit"; dummy$ end end sub
'{--------------------------------------------------------------} '{ Report What Was Expected }
sub Expected s$ call Abort s$ + " Expected" end sub
'{--------------------------------------------------------------} '{ Match a Specific Input Character }
sub Match x$ if Look$ <> x$ then call Expected qq$ ; x$ ; qq$ else call GetChar call SkipWhite end if end sub
'{--------------------------------------------------------------} '{ Recognize an Alpha Character }
function IsAlpha(c$) IsAlpha = instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", upper$(c$))>0 end function
'{--------------------------------------------------------------}
'{ Recognize a Decimal Digit }
function IsDigit(c$) IsDigit = instr("0123456789", c$)>0 end function
'{--------------------------------------------------------------} '{ Recognize an Alphanumeric }
function IsAlNum(c$) IsAlNum = IsAlpha(c$) or IsDigit(c$) end function
'{--------------------------------------------------------------} '{ Recognize an Addop }
function IsAddop(c$) IsAddop = instr("+-", c$)>0 end function
'{--------------------------------------------------------------} '{ Recognize White Space }
function IsWhite(c$) IsWhite = instr(" "+TAB$, c$)>0 end function
'{--------------------------------------------------------------} '{ Skip Over Leading White Space }
sub SkipWhite while IsWhite(Look$) call GetChar wend end sub
'{--------------------------------------------------------------} '{ Get an Identifier }
function GetName$() Token$="" if not(IsAlpha(Look$)) then call Expected "Name" while IsAlNum(Look$) Token$ = Token$+Upper$(Look$) call GetChar wend GetName$ =Token$ call SkipWhite end function
'{--------------------------------------------------------------} '{ Get a Number }
function GetNum$() Value$="" if not(IsDigit(Look$)) then call Expected "Integer" while IsDigit(Look$) Value$=Value$ + Look$ call GetChar wend GetNum$ =Value$ call SkipWhite LastReadNum$ = GetNum$ end function
'{--------------------------------------------------------------} '{ Output a String with Tab }
sub Emit s$ print tab(9); s$; code$=code$; space$(8); s$ end sub
'{--------------------------------------------------------------} '{ Output a String with Tab and CRLF }
sub EmitLn s$ call Emit s$ print code$=code$;CRLF$ end sub
'{--------------------------------------------------------------} '{ Initialize }
sub Init0 'do things once 'varList$="" 'funcList$="" end sub
sub Init line input "; ";inputLine$ 'ASM comment inputPos=0 call GetChar call SkipWhite end sub
'====================== 'varList$, funcList$
function declVars$() if varList$ = "" then exit function for i = 1 to listLen(varList$) ' " int A;" declVars$ = declVars$;space$(4);"int ";word$(varList$,i);";";CRLF$ next 'declVars$ = declVars$;CRLF$ end function
function printVars$() if varList$ = "" then exit function for i = 1 to listLen(varList$) '+ " printf("+qq$+"A=%d\n"+qq$+", A);"+CRLF$ printVars$ = printVars$+space$(4); _ "printf("+qq$+word$(varList$,i)+"=%d\n"+qq$+", "+word$(varList$,i)+");"+CRLF$ next end function
function declFunc$() if funcList$ = "" then exit function for i = 1 to listLen(funcList$) ' int Y(){return 1;} declFunc$ = declFunc$;"int ";word$(funcList$,i);"(){return ";i;";}";CRLF$ next 'declFunc$ = declFunc$;CRLF$ end function
'================================= function CWrapper$(part) select case part case 1 CWrapper$="" _ + "#include <stdio.h>"+CRLF$ _ + " " 'int Y(){return 1;} case 2 CWrapper$="" _ + "int main()"+CRLF$ _ + "{" '+ " int A;"+CRLF$ _ case 3 CWrapper$="" _ + " __asm"+CRLF$ _ + " { " 'sample code ' + " MOV EAX,1"+CRLF$ _ ' + " PUSH EAX"+CRLF$ _ ' + " MOV EAX,2"+CRLF$ _ ' + " POP EBX"+CRLF$ _ ' + " ADD EAX, EBX"+CRLF$ _ case 4 CWrapper$="" _ + " }"+CRLF$ '+ " printf("+qq$+"A=%d\n"+qq$+", A);"+CRLF$ _ case 5 CWrapper$="" _ + " return 0;"+CRLF$ _ + "}" end select end function
sub writeCode fileName$ if fileName$="" then print print CWrapper$(1) print declFunc$() print CWrapper$(2) print declVars$() print CWrapper$(3) print code$ print CWrapper$(4) print printVars$() print CWrapper$(5) print else open fileName$ for output as #1 print #1, CWrapper$(1) print #1, declFunc$() print #1, CWrapper$(2) print #1, declVars$() print #1, CWrapper$(3) print #1, code$ print #1, CWrapper$(4) print #1, printVars$() print #1, CWrapper$(5) close #1 run "notepad.exe ";DefaultDir$;"\"; fileName$ end if end sub '======================================= sub addToList byRef list$, item$ list$=list$+" "+item$ end sub
function inlist(list$, item$) inlist = (instr(" "+list$+" ", " "+item$+" ")<>0) end function
sub addToListUniq byRef list$, item$ if not(inlist(list$, item$)) then list$=list$+" "+item$ end if end sub
function getNext$(list$, byRef i) if i<1 then i=1 getNext$=word$(list$, i) if getNext$<>"" then i=i+1 end function
function listLen(list$) i=0 while 1 w$=word$(list$,i+1) if w$="" then exit while i=i+1 wend listLen=i end function
|
|
|
Post by tsh73 on Feb 7, 2024 20:34:51 GMT
On with chapter 4: INTERPRETERS Here we start once agin from scratch ("Cradle" framework program). And repeat same expression parsing - but instead of writing assebly code, will inerpret things on the fly. It is promised to be faster then first time. I dunno. I was not able to do it at one session, it's pretty big anyway. Really sounds even more useful in the near run. I hardly imagine using translated pieces of assembler in my JB code. But using an interpreter inside my program - why not? So changes include: * Make functions return number up calling chain. Using JB it will be just a number, not integer like in Pascal. (about the same, character and string of Pascal turns to string in JB. So the higher is level of language we are using, the easier it to code...) So first function down there is GetNum, and now it returns a number. And first version of Expression calls it and return that number. * Adding operators. Now instead of emitting (pretty arcane) asembler code, we just execute these operators. Indeed program is smaller and more clear. * Adding reading multi-digit integers. * Adding parenthesized expressions * Adding varaibles. Doing it simple, Tiny-BASIC way: just create an array with cells corresponding to letters. dim Table(26) 'for A..Z Well, Pascal could just use letter for adressing array. JB way (one of) is Table(ASC(GetName$())-ASC("A"))
(and we just could write contents of array in the end to see results of our program) * Adding assignment statement to fill those variables * Looping the assignment statement allowing several assignments, reusing values we got from previous assignments. Wow! Looks really useful! Author discusses a way to detremine end of a program. He uses Pascal converion of last dot (.). I (for now) choose to consider empty line as end of input. My main loop is call Init0 'single time initialisation while 1 call Init 'read whole line, prime Look$ with first symbol if Look$="" then exit while 'empty line - sign of end call Assignment if Look$ <> "" then call Expected "Newline" 'if there is something of a line left unprocessed, 'that must be an error wend
* Last thing in chapter is to add input/output. In single-character way, author choose "?" for input, "!" for output. BTW you can see same chice for I/O operators in PL/0 language en.wikipedia.org/wiki/PL/0So ?x y=x*x-4 !y
is a valid program. All is nice but... in BASIC "?x" used to be "PRINT x". So I could go and change it... But what symbol to choose for INPUT? "!" jsut not make sence... So I shrug and left it as is (in muly character lokents I likely to swtch to PRINT / INPUT, anyway) Here is an example session of resulting program for this chapter Line prompt is > empty line ends program After end, it prints all variables (actually could be commented off now we have PRINT) >?x ?3 >y=x*x-4 >!y 5 >
X 3 Y 5 Normal END. Src was : ?x y=x*x-4 !y
Press ENTER to quit
|
|
|
Post by tsh73 on Feb 7, 2024 20:43:04 GMT
Here is result of Chapter 4
'v 4.0 - base, to iterpreter 'v 4.1 - make func return a number 'v 4.2 - addops 'v 4.3 - mulops 'v 4.4 - multichar 'v 4.5 - parenthesized expressions 'v 4.6 - variables 'v 4.7 - multiline (differs from book) 'v 4.8 - I/O
'base for compiler 'Pascal to BASIC '{--------------------------------------------------------------} 'program Cradle;
'{--------------------------------------------------------------} '{ Constant Declarations }
global TAB$, qq$, src$, inputLine$, inputPos,CRLF$ TAB$ = chr$(9) qq$=chr$(34) CRLF$=chr$(13)+chr$(10) 'const TAB = ^I;
'{--------------------------------------------------------------} '{ Variable Declarations }
'var Look: char; '{ Lookahead Character } global Look$ dim Table(26) 'for A..Z
'{--------------------------------------------------------------} '{ Main Program }
call Init0 while 1 call Init 'print ">>";Look$ if Look$="" then exit while select case Look$ case "?": call procInput case "!": call procOutput case else: call Assignment end select 'if Look <> CR then Expected('Newline'); if Look$ <> "" then call Expected "Newline" wend
'print "Look$>";Look$ call showVars
print "Normal END." print "Src was :" print src$ input "Press ENTER to quit"; dummy$ end '{--------------------------------------------------------------}
'{--------------------------------------------------------------} '{ Read New Character From Input Stream }
sub GetChar inputPos=inputPos+1 Look$=mid$(inputLine$,inputPos,1) src$=src$+Look$ 'print ">>";src$ if Look$="" then src$=src$+CRLF$ 'print ">";Look$ end sub
'{--------------------------------------------------------------} '{ Report an Error }
sub ErrorMsg s$ print print "Error: "; s$; "." end sub
'{--------------------------------------------------------------} '{ Report Error and Halt }
sub Abort s$ call ErrorMsg s$ input "Press ENTER to quit"; dummy$ end end sub
'{--------------------------------------------------------------} '{ Report What Was Expected }
sub Expected s$ call Abort s$ + " Expected" end sub
'{--------------------------------------------------------------} '{ Match a Specific Input Character }
sub Match x$ if Look$ = x$ then call GetChar else call Expected qq$ ; x$ ; qq$ end sub
'{--------------------------------------------------------------} '{ Recognize an Alpha Character }
function IsAlpha(c$) IsAlpha = instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", upper$(c$))>0 end function
'{--------------------------------------------------------------}
'{ Recognize a Decimal Digit }
function IsDigit(c$) IsDigit = instr("0123456789", c$)>0 end function
'{--------------------------------------------------------------} '{ Recognize an Alphanumeric }
function IsAlNum(c$) IsAlNum = IsAlpha(c$) or IsDigit(c$) end function
'{--------------------------------------------------------------} '{ Recognize an Addop }
function IsAddop(c$) IsAddop = instr("+-", c$)>0 end function
'{--------------------------------------------------------------} '{ Get an Identifier }
function GetName$() if not(IsAlpha(Look$)) then call Expected "Name" GetName$ = Upper$(Look$) call GetChar end function
'{--------------------------------------------------------------} '{ Get a Number }
function GetNum() Value = 0 if not(IsDigit(Look$)) then call Expected "Integer" while IsDigit(Look$) Value = 10 * Value + val(Look$) call GetChar wend GetNum = Value end function
'{--------------------------------------------------------------} '{ Output a String with Tab }
sub Emit s$ print tab(7); s$; end sub
'{--------------------------------------------------------------} '{ Output a String with Tab and CRLF }
sub EmitLns$ call Emit s$ print end sub
'{--------------------------------------------------------------} '{ Input Routine }
sub procInput call Match "?" Name$ = GetName$() input "?";tmp Table(ASC(Name$)-ASC("A")) = tmp end sub
'{--------------------------------------------------------------} '{ Output Routine }
sub procOutput call Match "!" Name$ = GetName$() print Table(ASC(Name$)-ASC("A")) end sub
'{--------------------------------------------------------------} '{ Initialize }
sub Init0 redim Table(26) 'InitTable - clear array end sub
sub Init line input ">";inputLine$ inputPos=0 call GetChar end sub
'{---------------------------------------------------------------} '{ Parse and Translate a Math Factor }
function Factor() if Look$ = "(" then call Match "(" Factor = Expression() call Match ")" else if IsAlpha(Look$) then Factor = Table(ASC(GetName$())-ASC("A")) else Factor = GetNum() end if end if end function
'{---------------------------------------------------------------} '{ Parse and Translate a Math Term }
function Term() Value = Factor() while instr("*/", Look$)>0 select case Look$ case "*" call Match "*" Value = Value * Factor() case "/" call Match "/" Value = int(Value / Factor()) end select wend Term = Value end function
'{---------------------------------------------------------------} '{ Parse and Translate an Expression }
function Expression() if IsAddop(Look$) then Value = 0 else Value = Term() end if while IsAddop(Look$) select case Look$ case "+" call Match "+" Value = Value + Term() case "-" call Match "-" Value = Value - Term() end select wend Expression = Value end function
'{--------------------------------------------------------------} '{ Parse and Translate an Assignment Statement }
sub Assignment Name$ = GetName$() call Match "=" Table(ASC(Name$)-ASC("A")) = Expression() end sub
'===================================== sub showVars print for i = 0 to 25 if Table(i)<>0 then print chr$(i+ASC("A")); tab(5);Table(i) next
end sub
|
|
|
Post by tsh73 on Feb 8, 2024 20:40:05 GMT
Chapter 4 ends with saying that single-character names and skipping white spaces are easy to add (like in previous chapter), so they're "left as an exercise for the student."
So I spent some time improving interpreter we've got so far. (kind of porting these parts from Chapter 3 program)
* Skipping spaces (mostly calling SkipWhite in the end of Match, GetName, GetNum)
* Parsing multi-character names (reading name . while IsAlNum(Look$) )
* Adding things to work with variables. Now simple array with slots for each letter is not enough... so I got arrays
dim varName$(100), varVal(100)
and couple of globals varList$, varNum varList$ is used to quickly check (INSTR) if variable already happened and a few subs/functions: - sub saveName var$, varVal - function getVarVal(var$) (this version does
call Abort "Variable ";var$;" is not defined" ) - sub printVars
* Changing numbers to floating point Come on, we interpreting stuff over BASIC, and it uses *numbers*. So? 1) remove INT() from division result in function Term() 2) we need function GetNum() to read floating point numbers. And this is tricky... I had a function isNumber(n$) from old JB contest, so I pretty sure it works. (it probably too slow but I don't care for now). So now instead of
Value = 10 * Value + val(Look$) I check
(isNumber(Value$+Look$) , that is, read number until it is still a number. And it works. Most of the time. Problem is that 1e is not a number, but 1e3 is 1e- is not a number, but 1e-3 is And all we have for now is single next lookahead character Look$. I really wonder if I could cludge it and look ahead for 2, 3 characters instead of only one. But for now - scientific notation (1e3) just do not work.
* Adding power (^) operator This is nice one, really. So far - We have 1) Factor() (nums, names and things in brackets () ) 2) of then we construct Term with *,/ 3) of then we construct Expression with +,- This is actually nested calls, and it enforces our operator precence. PEMDAS, remember? And new level of precedence needs new level of nesting. Now if you look at Rosetta Code operator precendence (or wikipedia, whatever) you'll see that most languages have really unvieldly number of precedence levels. I just googled - for C, 15 levels. Niklaus Wirth really knew something. He stopped just with 4 levels in Pascal ;) So we bail in and add a nesting level for E of PEMDAS - Exponentiation, ^ Now it is like this: 1) Factor() (nums, names and things in brackets () ) 2) of then we construct PTerm with ^ 3) of then we construct Term with *,/ 4) of then we construct Expression with +,- BTW power operator said to be evaluated from right to left - but it really depends on realisation JB, Excel, VB all counts left-to-right so 2^2^3 is (2^2)^3 is 64 Python goes right to left so 2**2**3 is 2**(2**3) is 256 I choose to implement easy BASIC way ;)
That's all I did. Now it can do stuff like this (solving equation 6x^2+x-2=0)
>a=6 >b=1 >c=-2 >d=b*b-4*a*c >x1=(-b+d^0.5)/(2*a) >x2=(-b-d^0.5)/(2*a) >!x1 0.5 >!x2 -0.66666667 >
(the only problem is that it will Abort on any error - not really good thing for interactive prompt. Ah well.)
|
|
|
Post by tsh73 on Feb 8, 2024 20:52:14 GMT
Here is improved interpreter (chaper 4 + exercises fo the reader)
'v 4.9 - skip spaces, multi char vars - parse 'v 4.10 - multi char vars - storing/using 'v 4.11 - remove some unused functions 'v 4.12 - floating point 'v 4.13 - ^ operator, insert extra level pterm ' <expression> ::= <term> [<addop> <term>]* ' <term> ::= <pterm> [ <mulop> <pterm> ]* ' <pterm> ::= <factor> [ '^' <factor> ]* ' <factor> ::= <number> | (<expression>) | <variable> 'base for compiler 'Pascal to BASIC '{--------------------------------------------------------------} 'program Cradle;
'{--------------------------------------------------------------} '{ Constant Declarations }
global TAB$, qq$, src$, inputLine$, inputPos, CRLF$, varList$, varNum TAB$ = chr$(9) qq$ = chr$(34) CRLF$= chr$(13)+chr$(10) 'const TAB = ^I;
'{--------------------------------------------------------------} '{ Variable Declarations }
'var Look: char; '{ Lookahead Character } global Look$ dim varName$(100), varVal(100)
'{--------------------------------------------------------------} '{ Main Program }
call Init0 while 1 call Init 'print ">>";Look$ if Look$="" then exit while select case Look$ case "?": call procInput case "!": call procOutput case else: call Assignment end select if Look$ <> "" then call Expected "Newline" wend
'print "Look$>";Look$ 'call showVars call printVars
print "Normal END." print "Src was :" print src$ input "Press ENTER to quit"; dummy$ end '{--------------------------------------------------------------}
'{--------------------------------------------------------------} '{ Read New Character From Input Stream }
sub GetChar inputPos=inputPos+1 Look$=mid$(inputLine$,inputPos,1) src$=src$+Look$ 'print ">>";src$ if Look$="" then src$=src$+CRLF$ 'print ">";Look$ end sub
'{--------------------------------------------------------------} '{ Report an Error }
sub ErrorMsg s$ print print "Error: "; s$; "." end sub
'{--------------------------------------------------------------} '{ Report Error and Halt }
sub Abort s$ call ErrorMsg s$ input "Press ENTER to quit"; dummy$ end end sub
'{--------------------------------------------------------------} '{ Report What Was Expected }
sub Expected s$ call Abort s$ + " Expected" end sub
'{--------------------------------------------------------------} '{ Match a Specific Input Character }
sub Match x$ if Look$ <> x$ then call Expected qq$ ; x$ ; qq$ else call GetChar call SkipWhite end if end sub
'{--------------------------------------------------------------} '{ Recognize an Alpha Character }
function IsAlpha(c$) IsAlpha = instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", upper$(c$))>0 end function
'{--------------------------------------------------------------}
'{ Recognize a Decimal Digit }
function IsDigit(c$) IsDigit = instr("0123456789", c$)>0 end function
'{--------------------------------------------------------------} '{ Recognize an Alphanumeric }
function IsAlNum(c$) IsAlNum = IsAlpha(c$) or IsDigit(c$) end function
'{--------------------------------------------------------------} '{ Recognize an Addop }
function IsAddop(c$) IsAddop = instr("+-", c$)>0 end function
'{--------------------------------------------------------------} '{ Recognize White Space }
function IsWhite(c$) IsWhite = instr(" "+TAB$, c$)>0 end function
'{--------------------------------------------------------------} '{ Skip Over Leading White Space }
sub SkipWhite while IsWhite(Look$) call GetChar wend end sub
'{--------------------------------------------------------------} '{ Get an Identifier }
function GetName$() Token$="" if not(IsAlpha(Look$)) then call Expected "Name" while IsAlNum(Look$) Token$ = Token$+Upper$(Look$) call GetChar wend GetName$ =Token$ call SkipWhite end function
'{--------------------------------------------------------------} '{ Get a Number }
function GetNum0() Value = 0 if not(IsDigit(Look$)) then call Expected "Integer" while IsDigit(Look$) Value = 10 * Value + val(Look$) call GetChar wend GetNum = Value call SkipWhite end function
function GetNum() 'problem. 1e3 is a number, but 1e - still not a number. 'and I guess so is 1e-5 and 1e-. if not(IsDigit(Look$)) then call Expected "Integer" while 1 'Value = 10 * Value + val(Look$) if Look$="" then exit while if not(isNumber(Value$+Look$)) then exit while end if Value$=Value$+Look$ call GetChar wend GetNum = val(Value$) call SkipWhite end function
'{--------------------------------------------------------------} '{ Output a String with Tab }
sub Emit s$ print tab(7); s$; end sub
'{--------------------------------------------------------------} '{ Output a String with Tab and CRLF }
sub EmitLns$ call Emit s$ print end sub
'{--------------------------------------------------------------} '{ Input Routine }
sub procInput call Match "?" Name$ = GetName$() input "?";tmp call saveName Name$, tmp end sub
'{--------------------------------------------------------------} '{ Output Routine }
sub procOutput call Match "!" print getVarVal(GetName$()) end sub
'{--------------------------------------------------------------} '{ Initialize }
sub Init0 'redim Table(26) 'InitTable - clear array varList$="," 'do once end sub
sub Init line input ">";inputLine$ inputPos=0 call GetChar call SkipWhite end sub
'{---------------------------------------------------------------} '{ Parse and Translate a Math Factor }
function Factor() if Look$ = "(" then call Match "(" Factor = Expression() call Match ")" else if IsAlpha(Look$) then Factor = getVarVal(GetName$()) else Factor = GetNum() end if end if end function
'{---------------------------------------------------------------} '{ Parse and Translate a Math Power (^) }
function PTerm() Value = Factor() while Look$ = "^" call Match "^" Value = Value ^ Factor() wend PTerm = Value end function
'{---------------------------------------------------------------} '{ Parse and Translate a Math Term }
function Term() Value = PTerm() while instr("*/", Look$)>0 select case Look$ case "*" call Match "*" Value = Value * PTerm() case "/" call Match "/" Value = Value / PTerm() end select wend Term = Value end function
'{---------------------------------------------------------------} '{ Parse and Translate an Expression }
function Expression() if IsAddop(Look$) then Value = 0 else Value = Term() end if while IsAddop(Look$) select case Look$ case "+" call Match "+" Value = Value + Term() case "-" call Match "-" Value = Value - Term() end select wend Expression = Value end function
'{--------------------------------------------------------------} '{ Parse and Translate an Assignment Statement }
sub Assignment Name$ = GetName$() call Match "=" call saveName Name$, Expression() end sub
'====================== 'varList$ sub saveName var$, varVal if instr(varList$, ",";var$;",")=0 then 'create new varList$=varList$;var$;"," varNum=varNum+1 varName$(varNum)=var$ varVal(varNum)=varVal else 'find one for i = 1 to varNum if varName$(i)=var$ then varVal(i)=varVal exit sub end if next end if end sub
sub printVars if varNum = 0 then exit sub print for i = 1 to varNum print varName$(i);tab(7);"=";varVal(i) next print end sub
function getVarVal(var$) 'defaults to 0, probably should error for i = 1 to varNum if varName$(i)=var$ then getVarVal=varVal(i) exit function end if next call Abort "Variable ";var$;" is not defined" end function
'---------------------------------------- 'from old contest function isNumber(input$) res = 0 ns = eatUp(input$, "+-") if ns>1 then [over] n1 = eatUp(input$, "0123456789") nd = eatUp(input$, ".") if nd>1 then [over] n2 = eatUp(input$, "0123456789") if n1+n2<1 then [over] ne = eatUp(input$, "eE") if ne<>0 then if ne>1 then [over] ns = eatUp(input$, "+-") if ns>1 then [over] n1 = eatUp(input$, "0123456789") if n1<1 then [over] end if
if input$="" then res = 1 [over] isNumber = res end function
function eatUp(byRef input$, chars2eat$) count = 0 while len(input$)>0 if instr( chars2eat$, left$( input$,1))<>0 then input$ = mid$(input$,2) count = count +1 else exit while end if wend eatUp = count end function
|
|
|
Post by tsh73 on Feb 9, 2024 13:40:48 GMT
*Kludges R us* (we were supposed to use GetChar and never know about inputLine$ and inputPos) (or I could just add more globals)
But now it supports scientific-form numbers.
function GetNum() 'problem. 1e3 is a number, but 1e - still not a number. 'and I guess so is 1e-5 and 1e-. if not(IsDigit(Look$)) then call Expected "Integer" while 1 if Look$="" then exit while Look1$=mid$(inputLine$,inputPos+1,1) 'lookahead+1 Look2$=mid$(inputLine$,inputPos+2,1) 'lookahead+2 if not(isNumber(Value$+Look$)) _ and not(isNumber(Value$+Look$+Look1$)) _ and not(isNumber(Value$+Look$+Look1$+Look2$)) then ' exit while end if Value$=Value$+Look$ call GetChar wend GetNum = val(Value$) call SkipWhite end function
|
|
|
Post by tsh73 on Feb 10, 2024 19:43:54 GMT
I was talking about this to a collegue, she suggested I use something like Exception in this case.
So I did this:
1) make a global variable
QuitOnError=1 'every error quit QuitOnError=0 'after error, try to go to next line So if interpreter runs on a file, it should quit on first error. But it it provides interactive environment a-la Python, it should recover from errors and just wait for next line.
2) procedure Abort behaves as before (warn and quit) if QuitOnError. Else . it rises error (adresses undimensioned array 'forcedError' with index -1). This provides special error message I could check later on
if Err$<>"Subscript out of range: -1, forcedError()"
(to be distinguished from natural errors like divide by zero etc).
sub Abort s$ call ErrorMsg s$ if QuitOnError then input "Press ENTER to quit"; dummy$ end else forcedError(-1)=0 'instead of End, make Error Handler fire end if end sub
3) main program loop
'{ Main Program }
call Init0 while 1 call Init 'print ">>";Look$ if Look$="" then exit while select case Look$ case "?": call procInput case "!": call procOutput case else: call Assignment end select if Look$ <> "" then call Expected "Newline" wend was rewritten so insides of a loop are in separate sub ProcessLine with error trapping
'{ Main Program }
call Init0 while 1 call Init 'print ">>";Look$ if Look$="" then exit while call ProcessLine wend
and the sub is
sub ProcessLine on error goto [catchLineErr] select case Look$ case "?": call procInput case "!": call procOutput case else: call Assignment end select if Look$ <> "" then call Expected "Newline" exit sub [catchLineErr] Look$="" 'ignore rest of line 'print "*Error caught, continue next line" if Err$<>"Subscript out of range: -1, forcedError()" then print "Error; ";Err$ if QuitOnError then input "Press ENTER to quit"; dummy$ end end if end if end sub
Complication
if Err$<>"Subscript out of range: -1, forcedError()" then is to process runtime errors like 1/0, overflow, etc, and make it actually quit if QuitOnError.
Looks a bit complicated, but works, proves it could be done, and comparing to previos version - that's really all changes needed.
|
|