hello charles, first: best wishes for new year 2026 belated... how are you?
I started again programming with oxygenbasic last day and had a big pause ;)
second: I have found last days these script (old one) and wanted to create a simple
calculation for this parser script, but this example fails..
some help is welcome, thanks
' test parser script o2, frank, 23-01-2026
' how I can add a simple calculation as result?
' part two ProcessScript2 mysrc doesnt work
'
'
string mysrc=quote
--NorwegianParrotScript--
aa = (b+c)*d
b=2:c=5:d=6
' wanted to create a simple calculation with a result for it
--NorwegianParrotScript--
'state variables
'===============
sys ascw, 'ascii code of first word char
ascn, 'ascii code of next word or end of line
lenw, 'length of word
swd, 'start index of word
ewd, 'boundary index of word
dtp, 'dot position
tyw, 'type of word
opr, 'operator code
opn 'operand code
function nword(string s,sys *i)
'==============================
sys pt=strptr(s)
sys b,e,p
dtp=0
tyw=0
p=pt+i-1
byte a at p
'
'skip leading space and lines
'
do
select a
case 0
exit do
case 33 to 255
exit do
end select
p++
end do
b=p-pt+1
ascw=a
swd=b
'
'locate boundary of word
'
'quotes
'
if ascw=34 or ascw=96 then 'or ascw=39 ''
if tyw=0 then tyw=3
do
p++
if a=ascw then goto endnword
end do
end if
do
select a
case 0 to 32
exit do
case 46
if dtp=0 then
dtp=pt-p+1 'DOT position
end if
p++ : continue do
case 48 to 57
if tyw=0 then tyw=1
p++ : continue do 'NUMS
case 65 to 90
if tyw=0 then tyw=2
p++ : continue do 'CAPS
case 96 to 122
if tyw=0 then tyw=2
p++ : continue do 'LOWERS
case 95
if tyw=0 then tyw=2
p++ : continue do 'UNDERSCORE
case 33 to 47
e=p-pt+1
if b=e then
tyw=4 'symbol !%& etc
p++
end if
exit do
case 58 to 64
e=p-pt+1
if b=e then
tyw=5 'symbol ;:<=>?@ etc
p++
end if
exit do
case 91 to 96
e=p-pt+1
if b=e then
tyw=6 'symbol [\] etc
p++
end if
exit do
case 123 to 126
e=p-pt+1
if b=e then
tyw=7 'symbol {|}~ etc
p++
end if
exit do
end select
p++
end do
'
endnword:
'--------
'
e=p-pt+1
ewd=e
'
'skip to next word or end of line
'
do
select a
case 0
exit do
case 10
exit do
case 13
exit do
case 33 to 255
exit do
end select
p++
end do
ascn=a
lenw=e-b
i=p-pt+1
end function
'
function identify(string s,integer i) as string
'==============================================
if lenw=1
if tyw>3
opr=ascw
select case ascw
case "+"
if ascn=43 then
opr+=0x200
elseif ascn=61
opr+=0x100
end if
case "-"
if ascn=45
opr+=0x200
elseif ascn=61
opr+=0x100
end if
case "*"
if ascn=61
opr+=0x100
end if
case "/"
if ascn=61
opr+=0x100
end if
case "<"
if ascn=61
opr+=0x100
end if
case "="
case ">"
if ascn=61
opr+=0x100
end if
case ","
case ";"
case ":"
case "?"
case "@"
case "("
case ")"
case "["
case "]"
case "{"
case "}"
end select
exit function
end if
end if
end function
string cr,tab,pr
cr=chr(13)+chr(10)
tab=chr(9)
pr="WORDS AND WORD-TYPE:" cr cr
''
function ProcessScript(string s)
'===============================
string wr
sys i=1
do
opn=0
opr=0
nword s,i
identify s,i
wr=mid mysrc,swd,lenw
if lenw=0 then exit do
pr+=wr tab tyw cr
end do
print pr
end function
'' -------------------------------- new input
'' new global structures / Arrays
dim as string tokens[21]={"a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t"}
dim int types[11]={1,2,3,4,5,6,7,8,9,10}
dim int token_count = 0
' dont go second part to print token_counts ------------------------- //
function ProcessScript2(string st)
sys i = 1
string wr
do
opn = 0 : opr = 0
nword st, i
identify st, i
if lenw = 0 then exit do
wr = mid mysrc, swd, lenw
if lenw=0 then exit do
' collect tokens
'tokens[token_count] = wr ' don't go
types[token_count] = tyw
'if opr <> 0 then types[token_count] = 100 + opr ' operator marked
'token_count = token_count + 1 ' don't go
pr+=wr tab tyw cr
pr+=wr tab token_count cr
end do
' testing
print "collected token:"
sys j
for j = 0 to token_count-1 ' ' don't go
print tokens[j] tab types[j] ' don't go
next
print pr + j
end function
ProcessScript mysrc ' go :-)
' don't go next line
ProcessScript2 mysrc
Update and nearly good.. have add an evaluator only result for Part two IS 0
' test parser script 2, o2, frank, 24-01-2026
string mysrc=quote
--NorwegianParrotScript--
aa = (b+c)*d
--NorwegianParrotScript--
'print a
'state variables
'===============
sys ascw, 'ascii code of first word char
ascn, 'ascii code of next word or end of line
lenw, 'length of word
swd, 'start index of word
ewd, 'boundary index of word
dtp, 'dot position
tyw, 'type of word
opr, 'operator code
opn 'operand code
function nword(string s,sys *i)
'==============================
sys pt=strptr(s)
sys b,e,p
dtp=0
tyw=0
p=pt+i-1
byte a at p
'
'skip leading space and lines
'
do
select a
case 0
exit do
case 33 to 255
exit do
end select
p++
end do
b=p-pt+1
ascw=a
swd=b
'
'locate boundary of word
'
'quotes
'
if ascw=34 or ascw=96 then 'or ascw=39 ''
if tyw=0 then tyw=3
do
p++
if a=ascw then goto endnword
end do
end if
do
select a
case 0 to 32
exit do
case 46
if dtp=0 then
dtp=pt-p+1 'DOT position
end if
p++ : continue do
case 48 to 57
if tyw=0 then tyw=1
p++ : continue do 'NUMS
case 65 to 90
if tyw=0 then tyw=2
p++ : continue do 'CAPS
case 96 to 122
if tyw=0 then tyw=2
p++ : continue do 'LOWERS
case 95
if tyw=0 then tyw=2
p++ : continue do 'UNDERSCORE
case 33 to 47
e=p-pt+1
if b=e then
tyw=4 'symbol !%& etc
p++
end if
exit do
case 58 to 64
e=p-pt+1
if b=e then
tyw=5 'symbol ;:<=>?@ etc
p++
end if
exit do
case 91 to 96
e=p-pt+1
if b=e then
tyw=6 'symbol [\] etc
p++
end if
exit do
case 123 to 126
e=p-pt+1
if b=e then
tyw=7 'symbol {|}~ etc
p++
end if
exit do
end select
p++
end do
'
endnword:
'--------
'
e=p-pt+1
ewd=e
'
'skip to next word or end of line
'
do
select a
case 0
exit do
case 10
exit do
case 13
exit do
case 33 to 255
exit do
end select
p++
end do
ascn=a
lenw=e-b
i=p-pt+1
end function
'states of tyw
'=============
' 1 numbers
' 2 upper case
' 2 lowercase
' 3 quote
' 4 symbols
' 5 symbols
' 6 symbols
' 7 symbols
function identify(string s,int i)
'================================
if lenw=1
if tyw>3
opr=ascw
select case ascw
case "+"
if ascn=43 then
opr+=0x200
elseif ascn=61
opr+=0x100
end if
case "-"
if ascn=45
opr+=0x200
elseif ascn=61
opr+=0x100
end if
case "*"
if ascn=61
opr+=0x100
end if
case "/"
if ascn=61
opr+=0x100
end if
case "<"
if ascn=61
opr+=0x100
end if
case "="
case ">"
if ascn=61
opr+=0x100
end if
case ","
case ";"
case ":"
case "?"
case "@"
case "("
case ")"
case "["
case "]"
case "{"
case "}"
end select
exit function
end if
end if
end function
string cr,tab,pr
cr=chr(13)+chr(10)
tab=chr(9)
pr="WORDS AND WORD-TYPE:" cr cr
function ProcessScript(string s)
'===============================
string wr
sys i=1
do
opn=0
opr=0
nword s,i
identify s,i
wr=mid mysrc,swd,lenw
if lenw=0 then exit do
pr+=wr tab tyw cr
end do
print pr
end function
ProcessScript mysrc
function EvaluateExpression(string s)
'=====================================
' Evaluiert einen arithmetischen Ausdruck wie "aa = (b+c)*d"
' Unterstützt: +, -, *, /, Klammern
' Gibt das Ergebnis zurück oder 0 bei Fehler
'-------------------------------------
sys b,c,d,aa,i=1
sys stack[100], sp=0
sys opstack[100], osp=0
sys vals, val2, op
sys errors=0
do
opn=0
opr=0
nword s,i
identify s,i
if lenw=0 then exit do
' Token ausgeben (optional)
print "Token: " mid(s,swd,lenw) " (Typ: " tyw ")"
' Wenn Zahl, auf Stack legen
if tyw=1 then
'vals=val(mid(s,swd,lenw)) 'problem
vals=mid(s,swd,lenw) 'problem
stack[sp]=vals
sp++
continue do
end if
' Wenn Variable, Wert auf Stack legen
if tyw=2 then
select case mid(s,swd,lenw)
case "b"
stack[sp]=b
case "c"
stack[sp]=c
case "d"
stack[sp]=d
case "aa"
stack[sp]=aa
'default
print "Fehler: Unbekannte Variable " mid(s,swd,lenw)
errors=1
return 0
end select
sp++
continue do
end if
' Wenn Klammer auf, auf Operator-Stack legen
if ascw=40 then ' (
opstack[osp]=ascw
osp++
continue do
end if
' Wenn Klammer zu, bis zur öffnenden Klammer abarbeiten
if ascw=41 then ' )
while osp>0 and opstack[osp-1]<>40
op=opstack[osp-1]
osp--
if sp<2 then
print "Fehler: Zu wenige Operanden für Operator"
errors=1
return 0
end if
vals=stack[sp-1]
val2=stack[sp-2]
select case op
case 43 ' +
stack[sp-2]=vals+val2
case 45 ' -
stack[sp-2]=val2-vals
case 42 ' *
stack[sp-2]=vals*val2
case 47 ' /
if vals=0 then
print "Fehler: Division durch Null"
errors=1
return 0
end if
stack[sp-2]=val2/vals
end select
sp--
end while
if osp=0 then
print "Fehler: Keine öffnende Klammer gefunden"
errors=1
return 0
end if
osp-- ' öffnende Klammer vom Stack nehmen
continue do
end if
end do
' Restliche Operatoren abarbeiten
while osp>0
op=opstack[osp-1]
osp--
if op=40 then
print "Fehler: Nicht geschlossene Klammer"
errors=1
return 0
end if
if sp<2 then
print "Fehler: Zu wenige Operanden für Operator"
errors=1
return 0
end if
vals=stack[sp-1]
val2=stack[sp-2]
select case op
case 43 ' +
stack[sp-2]=vals+val2
case 45 ' -
stack[sp-2]=val2-vals
case 42 ' *
stack[sp-2]=vals*val2
case 47 ' /
if vals=0 then
print "Fehler: Division durch Null"
errors=1
return 0
end if
stack[sp-2]=val2/vals
end select
sp--
end while
' Ergebnis ist auf dem Stack
if sp=1 and errors=0 then
return stack[0]
else
print "Fehler: Ungültiger Ausdruck"
return 0
end if
end function
' Variablen definieren
int b = 2
int c = 3
int d = 4
int aa
' Ausdruck parsen und auswerten
mysrc = "aa = (b+c)*d"
ProcessScript mysrc
aa = EvaluateExpression(mysrc)
' Ergebnis ausgeben
print "Berechnungsergebnis: " + aa
' ends
Happy New Year, Frank.
There is a simple evaluator. Translated by Mike Lobanovsky. It might be useful to you:
in demos\Evaluation
'****************************************
' EXPRESSION EVALUATOR - PC Magazine 1993
'****************************************
#LOOKAHEAD
$FILENAME "ExprEval.exe"
'INCLUDE "rtl32.inc"
'INCLUDE "rtl64.inc"
INCLUDE "Console.inc"
INDEXBASE 0
DIM AS LONG idx = 0
DIM AS LONG contin = TRUE
DIM AS BYTE NextChar
DIM AS STRING Expr // ML: may come from memory, not only from console
Main
'***********************************************************
' GetNextChar - Reads chars until a non-space char is found
'***********************************************************
SUB GetNextChar()
DIM AS BYTE b AT STRPTR Expr
DO
NextChar = b[idx]
idx++
LOOP WHILE NextChar AND (NextChar = 32 /*Asc("0")*/) // ML: memory overrun check added
END SUB
'**************************************************************
' Expression - A recursive routine that evaluates an expression
' EXPRESSION = <EXPRESSION> + TERM | <EXPRESSION> - <TERM>
'**************************************************************
FUNCTION Expression() AS SINGLE
DIM AS SINGLE value = Term()
DO
SELECT NextChar
CASE 32 // Asc(" ")
GetNextChar
CASE 43 // Asc("+")
GetNextChar
value += Term()
CASE 45 // Asc("-")
GetNextChar
value -= Term()
CASE ELSE
RETURN value
END SELECT
LOOP
END FUNCTION
'************************************************************
' Term - Handles multiplication and division
' <TERM> = <TERM> * <FACTOR> | <TERM> div <FACTOR> | <FACTOR>
'************************************************************
FUNCTION Term() AS SINGLE
DIM AS SINGLE divisor, value = Factor()
DO
SELECT NextChar
CASE 32 // Asc(" ")
GetNextChar
CASE 42 // Asc("*")
GetNextChar
value *= Factor()
CASE 94 // Asc("^")
GetNextChar
value = value ^ Factor() // ML: ^= isn't supported in O2
CASE 47 // Asc("/")
GetNextChar
divisor = Factor()
IF divisor <> 0 THEN // ML: avoid O2-specific INFinities
value /= divisor
ELSE
PRINT "DIVISION BY ZERO" CR CR "Press any key to exit ..."
WAITKEY
TERMINATE
END IF
CASE ELSE
RETURN value
END SELECT
LOOP
END FUNCTION
'**************************************************
' Factor - Handles numbers, minus signs and parens
' <FACTOR> = <EXPRESSION> | <VARIABLE> | <CONSTANT>
'**************************************************
FUNCTION Factor() AS SINGLE
DIM AS SINGLE value = 0
DIM AS LONG i, count = 0, d_point = FALSE
DIM AS BYTE b AT STRPTR Expr
IF (NextChar <= 57 /*Asc("9")*/) AND (NextChar >= 48 /*Asc("0")*/) THEN
WHILE (NextChar <= 57) AND (NextChar >= 48)
value *= 10 + NextChar - 48 // Asc("0")
NextChar = b[idx]
idx++
IF d_point THEN count++
IF NextChar = 46 /*Asc(".")*/ THEN
NextChar = b[idx]
idx++
d_point = TRUE
END IF
WEND
FOR i = 0 TO i < count
value /= 10
NEXT
RETURN value
ELSE
SELECT NextChar
CASE 45 // Asc("-")
GetNextChar
RETURN -1 * Factor()
CASE 40 // Asc("(")
GetNextChar
value = Expression()
IF NextChar <> 41 /*Asc(")")*/ THEN
PRINT "MISMATCHED PARENTHESES" CR CR "Press any key to exit ..."
WAITKEY
TERMINATE
ELSE
NextChar = b[idx]
idx++
END IF
RETURN value
CASE 46 // Asc(".")
d_point = TRUE
CASE ELSE
contin = FALSE
END SELECT
END IF
RETURN 0
END FUNCTION
'***************************
' Main - Program entry point
'***************************
SUB MAIN()
DIM AS SINGLE result
SetConsoleTitle "Aurel's Expression Evaluator"
PRINT "Expression must not contain any other symbol but:" CR
PRINT "'+' addition" CR "'-' subtraction" CR
PRINT "'*' multiplication" CR "'/' division" CR
PRINT "'(' left parenthesis" CR "')' right parenthesis" CR
PRINT "'.' decimal point (must be preceded by digit)" CR
PRINT "'^' x^y means x to the power of y" CR CR
PRINT "ENTER EXPRESSION: "
Expr = INPUT // ML: try e.g. "(1+2)*(6-3)" instead of INPUT
GetNextChar
result = Expression()
IF ((NextChar = 13 /*console*/) OR (NextChar = 0 /*memory*/)) AND contin THEN
PRINT "RESULT IS: " STR(result, 3)
ELSE
PRINT "SYNTAX ERROR"
END IF
PRINT CR CR "Press any key to exit ..."
WAITKEY
END SUB
Thanks you Charles I know already this example..yes a good one..
I have managed to Run my Parser Script that was much Work :-)
' test parser script 6 update, o2, frank, 24-01-2026
' correct calculation update with number values in string type in this form...
'
string mysrc = "(b+3)*4" 'instead of "(b+c)*d"
' I made this experience: "(b+c)*d" doesnt works here in my parser cause "c" and "d"
' couldn't assign correct values and serve false output 0
'
'
sys ascw, ascn, lenw, swd, ewd, dtp, tyw, opr, opn
'
function GeZopptioRiry(sys op)
select case op
case 42, 47 ' *, /
return 2
case 43, 45 ' +, -
return 1
case else
return 0
end select
end function
function nword(string s, sys *i)
sys pt=strptr(s)
sys b,e,p
dtp=0
tyw=0
p=pt+i-1
byte a at p
do
select a
case 0
exit do
case 33 to 255
exit do
end select
p++
end do
b=p-pt+1
ascw=a
swd=b
if ascw=34 or ascw=96 then
if tyw=0 then tyw=3
do
p++
if a=ascw then goto endnword
end do
end if
do
select a
case 0 to 32
exit do
case 46
if dtp=0 then dtp=pt-p+1
p++ : continue do
case 48 to 57
if tyw=0 then tyw=1
p++ : continue do
case 65 to 90
if tyw=0 then tyw=2
p++ : continue do
case 97 to 122
if tyw=0 then tyw=2
p++ : continue do
case 95
if tyw=0 then tyw=2
p++ : continue do
case 33 to 47
e=p-pt+1
if b=e then
tyw=4
p++
end if
exit do
case 58 to 64
e=p-pt+1
if b=e then
tyw=5
p++
end if
exit do
case 91 to 96
e=p-pt+1
if b=e then
tyw=6
p++
end if
exit do
case 123 to 126
e=p-pt+1
if b=e then
tyw=7
p++
end if
exit do
end select
p++
end do
endnword:
e=p-pt+1
ewd=e
do
select a
case 0, 10, 13, 33 to 255
exit do
end select
p++
end do
ascn=a
lenw=e-b
i=p-pt+1
end function
function identify(string s, int i)
if tyw=2 then
' Variable erkannt
opn=1
opr=0
return
end if
if lenw=1
if tyw>3
opr=ascw
opn=1
end if
end if
end function
'
function EvaluateExpression(string s)
sys stack[100], sp=0
sys opstack[100], osp=0
sys i=1, errors=0
sys vals, val2, op
int b=2
int c = 3
int d = 4
print "Debug: Starte Parsing von '" s "'" + chr(13)
do
opn=0
opr=0
nword s,i
identify s,i
if lenw=0 then exit do
print "Token: '" mid(s,swd,lenw) "' (Typ: " tyw ", ASCII: " ascw ")"
if tyw=1 then
stack[sp]=val(mid(s,swd,lenw))
print " number accepted, value: " stack[sp]
sp++
continue do
end if
if tyw=2 then
print " variable detect: '" mid(s,swd,lenw) "'"
select case mid(s,swd,lenw)
case "b": stack[sp]=b
case "c": stack[sp]=c
case "d": stack[sp]=d
default:
print "error: unknown variable"
errors=1
return 0
end select
print " value: " stack[sp]
sp++
continue do
end if
if ascw=40 then
print " Klammer auf" ' paranethis on
opstack[osp]=ascw
osp++
continue do
end if
if ascw=41 then
print " Klammer zu" 'paranethis off
while osp>0 and opstack[osp-1]<>40
op=opstack[osp-1]
osp--
if sp<2 then
print "error: Zu wenige Operanden für Operator" ' too few operands for operator
errors=1
return 0
end if
vals=stack[sp-1]
val2=stack[sp-2]
select case op
case 43: stack[sp-2]=val2+vals: print " calculate " val2 "+" vals "=" stack[sp-2]
case 45: stack[sp-2]=val2-vals: print " calculate " val2 "-" vals "=" stack[sp-2]
case 42: stack[sp-2]=val2*vals: print " calculate " val2 "*" vals "=" stack[sp-2]
case 47:
if vals=0 then
print "Fehler: Division durch Null" ' error: division by zero
errors=1
return 0
end if
stack[sp-2]=val2/vals: print " calculate " val2 "/" vals "=" stack[sp-2]
end select
sp--
end while
if osp=0 then
print "Fehler: Keine öffnende Klammer gefunden" ' error: no open paranthesis found
errors=1
return 0
end if
osp--
continue do
end if
if tyw=4 or tyw=5 then
print " operator accept: " chr(ascw)
while osp>0 and opstack[osp-1]<>40 and GeZopptioRiry(opstack[osp-1]) >= GeZopptioRiry(ascw)
op=opstack[osp-1]
osp--
if sp<2 then
print "error: Zu wenige Operanden für Operator" '' too few operands for operator
errors=1
return 0
end if
vals=stack[sp-1]
val2=stack[sp-2]
select case op
case 43: stack[sp-2]=val2+vals: print " calculate " val2 "+" vals "=" stack[sp-2]
case 45: stack[sp-2]=val2-vals: print " calculate " val2 "-" vals "=" stack[sp-2]
case 42: stack[sp-2]=val2*vals: print " calculate " val2 "*" vals "=" stack[sp-2]
case 47:
if vals=0 then
print "Fehler: Division durch Null" ' error: division by zero
errors=1
return 0
end if
stack[sp-2]=val2/vals: print " calculate " val2 "/" vals "=" stack[sp-2]
end select
sp--
end while
opstack[osp]=ascw
osp++
continue do
end if
end do
while osp>0
op=opstack[osp-1]
osp--
if op=40 then
print "Fehler: Nicht geschlossene Klammer" ' error: not closed paranthesis
errors=1
return 0
end if
if sp<2 then
print "Fehler: Zu wenige Operanden für Operator" '' too few operands for operator
errors=1
return 0
end if
vals=stack[sp-1]
val2=stack[sp-2]
select case op
case 43: stack[sp-2]=val2+vals: print " calculate " val2 "+" vals "=" stack[sp-2]
case 45: stack[sp-2]=val2-vals: print " calculate " val2 "-" vals "=" stack[sp-2]
case 42: stack[sp-2]=val2*vals: print " calculate " val2 "*" vals "=" stack[sp-2]
case 47:
if vals=0 then
print "Fehler: Division durch Null" ' error: division by zero
errors=1
return 0
end if
stack[sp-2]=val2/vals: print " calculate " val2 "/" vals "=" stack[sp-2]
end select
sp--
end while
if sp=1 and errors=0 then
print "result: " stack[0]
return stack[0]
else
print "Fehler: Ungültiger Ausdruck" ' error: invalid expression (not correct)
return 0
end if
end function
' test
print "parsing " + mysrc
' Testaufruf
int aa = EvaluateExpression(mysrc) ' result 20 ok
'int aa = EvaluateExpression("(b+4)*5") ' result 30 ok
print chr(13) + "Final result: " aa
' ends