Building a compiler (in progress)

[tsh73]

along Let's Build a Compiler, by Jack Crenshaw
justbasiccom.proboards.com/thread/1086/build-compiler-jack-crenshaw

be 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/UnxUtils

Rest 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



[tsh73]

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? ;)) )

[tsh73]

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

[xxgeek]

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

[tsh73]

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.

[tsh73]

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;
}


[tsh73]

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


[tsh73]

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/0
So

?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


[tsh73]

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


[tsh73]

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.)

[tsh73]

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

[tsh73]

I really wonder if I could cludge it and look ahead for 2, 3 characters instead of only one.

*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




[tsh73]

(the only problem is that it will Abort on any error - not really good thing for interactive prompt. Ah well.)

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()" thenis 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.