Code:
'micro(A) Interpreter - with recursive descent token evaluator
' by Aurel - 26.3.2019 - last test 12.5.2020
$ filename "microA_Interpreter.exe" 'compiled to exe
include "RTL32.inc"
include "awinh037.inc" ' awinh GUI api function
include "microAT.inc" ' tokenizer include
#lookahead
int tc=0 , ierror=0 ' token count, interpreting error
string token : int tkTyp ' define token as STRING : tkType as INT
string DQ = chr(34) ' DQ as double quote "
'*********************************************************************
'globals
INT win,x=0,y=0,w=400,h=300,wstyle = WS_MINMAXSIZE
INT button0,b0ID=100
NumberFormat 6,1,0,0,0,0
' global HDC and on screen functions...
INT hdc
'Interpreter Globals .........................................................................
string kwList[32] 'keyword list
kwList[1] = "VARNUM" : kwList[2] = "VARSTR" : kwList[3] = "VARPTR" : kwList[4] = "IF" : kwList[5] = "ELSE" : kwList[6] = "ENDIF"
kwList[7] = "WHILE" : kwList[8] = "WEND" : kwList[9] = "FOR" : kwList[10] = "TO" : kwList[11] = "STEP" : kwList[12] = "NEXT"
kwList[13]="PRINT" : kwList[14]="STR" : kwList[15]="VAL"
'..............................................................................................
int tkSTRING = 32, tkFLOAT = 33 , tkPOINTER = 34 , tkIF = 35 , tkELSE = 36, tkENDIF = 37
int tkWHILE = 38, tkWEND = 39 , tkFOR = 40 , tkTO = 41 , tkSTEP = 42 , tkNEXT = 43
int tkPRINT = 44 , tkSTR = 45, tkVAL = 46
'Global Variable,ID etc array ................................................................
int varID = 0
int varList[1024] : int varType[1024] :string varName[1024]: string varStr[1024] : float varNum[1024] : int varPtr[1024]
int ifCounter=0, elseCounter=0, endifCounter=0, whileCounter=0,wendCounter=0 ,forCounter=0,nextCounter=0
' Open Window with message loop...
win = SetWindow("micro(A):",x,y,w,h,0,wstyle)'
'button0 = SetButton(win,180,4,80,26,"Close (X)",0x50001000,0x200,b0ID)
'*********************************************************************
'test 1 - load source code into (microAT.inc) Tokenizer / PASS1 /'test str expr
string code = "varStr a,b,c : varNum d,e,f" + crlf +
"d=625:e=25: f = d/e: print d,10,f " + crlf +
"a=" + DQ +"aurel" + DQ + crlf +
"b=" + DQ +" micro(A)" + DQ + crlf +
"c=a+b" + crlf
codeLen=len(code)
tn = run_tokenizer(code)
MsgBox str(tn) ,"Tokenizer Out" ' 1 means OK!
'---------------------------------------------------------------
' prescan for variables,commands....
'---------------------------------------------------------------
'if tokenization error=0 then OK!..preScan()/PASS2
int ps
If tokerr = 0 and tn = 1
ps = preScan()
Else
MsgBox "END" ,"Program Exit!"
End if
'if ps = 1 then OK...........................
if ps = 1
MsgBox "PreScan:OK!" ,"Continue..."
tokInterpreter() ' run token-interpreter
Else
MsgBox "END" ,"Program Exit!"
End if
'================================================================
Wait() '/// message loop ///
'===========================================================================================
Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
SELECT hwnd
CASE win
Select wmsg
CASE WM_PAINT
CASE WM_CLOSE
CloseWindow(win)
EndProgram
End Select
END SELECT
RETURN Default
END FUNCTION
'===========================================================================================
Sub preScan() as int
'MsgBox "OK..." ," PASS 2"
int i , numOfTokens = nTokens ,lineNum=0 ,varID=0, vID, n ,vTyp ' numofTokens as local/reset global nTokens
string vName : int match_name
For i = 1 to numOfTokens
IF typList[i]=tkEOL: tokList[i]="EOL": lineNum++ : END IF 'check EndOfLine
IF typList[i] = tkIDENT
If ucase(tokList[i]) = kwList[1]: typList[i] = tkFLOAT 'if varNUM ...........................
if typList[i+1] <> tkIDENT 'check err
MsgBox "Missing variable after VARNUM! line: " + str(lineNum),"ERROR": return 0
else
i=i+1 ' next token
While typList[i] <> tkCOLON And typList[i] <> tkEOL 'store num variable -low case var name-
If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID : varName[varID] = lcase(tokList[i]) : varType[varID] = tkFLOAT :varNum[varID] = 0
' MsgBox "Variable name: " + tokList[i] + " VAR.TYPE: " + str(varType[varID]) , "TYPE"
End if
i++
Wend
end if
End if ' endOf varNUM..........................................................................
If ucase(tokList[i]) = kwList[2]: typList[i] = tkSTRING 'if varSTR ...........................
if typList[i+1] <> tkIDENT 'check err
MsgBox "Missing variable after VARSTR! line: " + str(lineNum),"ERROR": return 0
else
i=i+1 ' next token
While typList[i] <> tkCOLON And typList[i] <> tkEOL 'store str variable
If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID :: varName[varID] = lcase(tokList[i]): varType[varID] = tkSTRING: varStr[varID] = ""
MsgBox "Variable name: " + tokList[i] ,"variable->STR"
End if
i++
Wend
end if
End if ' endOf varSTR.......................................
If ucase(tokList[i]) = kwList[3]: typList[i] = tkPOINTER 'if varPTR ...........................
if typList[i+1] <> tkIDENT 'check err
MsgBox "Missing variable after VARPTR! line: " + str(lineNum),"ERROR": return 0
else
i=i+1 ' next token
While typList[i] <> tkCOLON And typList[i] <> tkEOL 'store ptr variable
If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID :: varName[varID] = lcase(tokList[i]): varType[varID] = tkPOINTER: varPtr[varID] = 0
MsgBox "Variable name: " + tokList[i] ,"variable->PTR"
End if
i++
Wend
end if
End if ' endOf varPTR.......................................
If ucase(tokList[i]) = kwList[4] : typList[i] = tkIF : ifCounter++ : End If 'if token 'IF
If ucase(tokList[i]) = kwList[5] : typList[i] = tkELSE : elseCounter++ : End If 'if token 'ELSE
If ucase(tokList[i]) = kwList[6] : typList[i] = tkENDIF : endifCounter++ : End If 'if token 'ENDIF'
If ucase(tokList[i]) = kwList[7] : typList[i] = tkWHILE : whileCounter++ : End If 'if token 'WHILE
If ucase(tokList[i]) = kwList[8] : typList[i] = tkWEND : wendCounter++ : End If 'if token 'WEND
If ucase(tokList[i]) = kwList[9] : typList[i] = tkFOR : forCounter++ : End If 'if token 'FOR
If ucase(tokList[i]) = kwList[10] : typList[i] = tkTO : End If 'if token 'TO
If ucase(tokList[i]) = kwList[11] : typList[i] = tkSTEP : End If 'if token 'STEP
If ucase(tokList[i]) = kwList[12] : typList[i] = tkNEXT : nextCounter++ : End If 'if token 'NEXT
If ucase(tokList[i]) = kwList[13] : typList[i] = tkPRINT : End If 'if token 'PRINT
ELSE
'error
END IF
' if variable is outside of declaration varNUM,varSTR,varPTR...
' search for varible name and return variable ID
IF typList[i] = tkIDENT
vName = tokList[i] : match_name=0
'loop to find var name,id,typ
For n = 1 to 1024
vID = varList[n] : vTyp = varType[vID] ' check ID and Type
if vName = lcase(varName[n]) ' if var is in list
vID = n ' id is n
vTyp = varType[vID] ' check type
varList[i] = vID ' set var list with ID from varName array-> tokList[i],typList[i],varList[i]=id
exit for
end if
Next n
' if var type is 0 then error
if vTyp=0 : MsgBox "Variable ID not found! -{ " + vName +" }-Line: " + str(lineNum),"ERROR": return 0: end if
END IF
'check PRINT x(+1),(+2)y(+3),(+4)var(+5)
If typList[i] = tkPRINT
'check next token as var/num(arg1)
If typList[i+1] <> tkIDENT and typList[i+1] <> tkNUMBER
MsgBox "Argument Wrong Type! -{ " + tokList[i+1] +" }-Line: " + str(lineNum),"ERROR": return 0
End if
'if typList[i+1] = tkNUMBER: print "tkNUMBER": endif
' if typList[i+1] = tkIDENT: print "tkIDENT": endif
If typList[i+2] <> tkCOMMA '2
MsgBox "Argument Separator Error! -{ " + tokList[i+2] +" }-Line: " + str(lineNum),"ERROR": return 0
End if
If typList[i+3] <> tkIDENT and typList[i+3] <> tkNUMBER '3
MsgBox "Argument Wrong Type! -{ " + tokList[i+3] +" }-Line: " + str(lineNum),"ERROR": return 0
End if
If typList[i+4] <> tkCOMMA '4
MsgBox "Argument Separator Error! -{ " + tokList[i+4] +" }-Line: " + str(lineNum),"ERROR": return 0
End if
If typList[i+5] <> tkIDENT and typList[i+3] <> tkNUMBER '5
MsgBox "Argument Wrong Type! -{ " + tokList[i+5] +" }-Line: " + str(lineNum),"ERROR": return 0
End if
End if
Next i
return 1
End sub
'=================================================================================================================
Sub tokInterpreter()
int tok=0,ntok=0,vID=0 ,vTyp=0
float numRes : string strRes : int ptrRes
tc=0
While tc < nTokens
start:
gettok() : print "TOKEN:" + tokList[tc]
tok = tkTyp : ntok = typList[tc+1]
IF tok = tkFLOAT ' token is def varNUM...'skip tokens to colon/eol
tc++ : While typList[tc] <> tkCOLON And typList[tc] <> tkEOL : tc++ : Wend
END IF
IF tok = tkSTRING ' token is def varSTR...'skip tokens to colon/eol
tc++ : While typList[tc] <> tkCOLON And typList[tc] <> tkEOL : tc++ : Wend
END IF
IF tok = tkIDENT
vID = varList[tc] 'get ID
vTyp = varType[vID]
' vID = varList[tc] : vTyp = varType[vID] : print "varID: " + str(vID) + ":VarType:: " + str(vTyp)
If vTyp = tkFLOAT ' numeric var
if ntok = tkEQUAL
tc++ ' skip "=" is assign
numRes = exec_expr() : varNum[vID] = numRes ' store result in varNum[] list
end if
End if
If vTyp = tkSTRING ' string var
if ntok = tkEQUAL
tc++ ' skip "=" is assign
strRes = exec_strExpr() : varStr[vID] = strRes ' store result in varStr[] list
end if
End if
If vTyp = tkPOINTER ' pointer/int var
if ntok = tkEQUAL
tc++ ' skip "=" is assign
ptrRes = exec_expr() : varPtr[vID] = INT(ptrRes) ' store result in varStr[] list
end if
End if
END IF
Wend
End Sub
'=================================================================================================================
'-----------------------------------------------------
sub gettok()
tc++
token = tokList[tc] : tkTyp = typList[tc]
'test
if tokList[tc+1] <> "" then return
end sub
'----------------------------------------------------
sub expr() as float
float v
If token = "-"
v = -(term())
else
v = term()
end if
while token = "+" or token = "-"
if token = "+": gettok() : v = v + term(): end if
if token = "-": gettok() : v = v - term(): end if
wend
return v
end sub
'---------------------------------------------------
sub term() as float
float v
v = factor()
while token = "*" or token = "/"
if token = "*": gettok() : v = v * factor(): end if
if token = "/": gettok() : v = v / factor(): end if
wend
return v
end sub
'-------------------------------------------------------
sub factor() as float
float v : int vID, vTyp
if asc(token)>47 and asc(token)<58 'nums
v = val(token)
gettok()
end if
if asc(token)=40 and asc(token)<>41 'match (...)
gettok() : v = expr() : gettok()
end if
if tkTyp = tkIDENT
'gettok()
vID = varList[tc] : vTyp = varType[vID] : print "token->"+ token +" var_ID:" + str(vID) + "_varType: " + str(vTyp)
IF vTyp = tkFLOAT : v = varNum[vID] : end if
gettok()
end if
return v
end sub
'execute numeric expression----------------------------------------------
Sub exec_expr() as float
gettok()'start
float res = expr()
MsgBox "RESULT=" + str(res) , "EXEC_EXPR:"
TextOn (win,30,30, str(res))
Return res
End sub
' execute string expression---------------------------------------------
Sub exec_strExpr() as string
gettok()'start
string res
res = strExpr()
MsgBox "STR_RESULT=" + res , "EXEC_STR_EXPR:"
TextOn (win,30,60, res)
Return res
End sub
'----------------------------------------------------------------------
Sub strExpr() as string
string vs
if token <> "+"
vs = strFactor()
end if
while token = "+"
if token = "+": gettok() : vs = vs + strFactor(): end if
wend
return vs
End Sub
'---------------------------------------------------------------------
Sub strFactor() as string
string vs : int vID, vTyp
if tkTyp = tkIDENT
print "IDENT-STR:" + token
vID = varList[tc] : vTyp = varType[vID] : print "token->"+ token +" var_ID:" + str(vID) + "_varType: " + str(vTyp)
IF vTyp = tkSTRING : vs = varStr[vID] : end if
gettok()
end if
if tkTyp = tkQSTRING
print "STR-FACTOR:" + token
vs = token : gettok()
end if
return vs
End Sub
'================================================================
' SHOW EXPRESSION RESULT ON WINDOW
'================================================================
SUB TextOn(wID as INT,tx as INT,ty as INT,txt as string)
hdc = GetDC(wID)
'draw text to screen DC
TextOut hdc,tx,ty,txt,Len(txt)
'blit screen DC to memDC
'BitBlt(hDCmem, 0, 0, ww, wh, hdc, 0, 0, SRCCOPY)
ReleaseDC( wID, hdc)
END SUB
Search
Member List
Calendar
Help
