RockTheSchock
Anmeldungsdatum: 04.04.2007 Beiträge: 138
|
Verfasst am: 30.10.2014, 22:28 Titel: Eval |
|
|
Ich habe vor Jahren mal angefangen mit QuickBasic ein Programm zum Auswerten von Ausdrücken zu schreiben. Vielleicht kann damit jemand was anfangen.
EDIT: nun kompilierbar mit fbc -lang qb
Code: | Declare FUNCTION TYPEOFS$ (item$)
DECLARE FUNCTION STYPEOF! (item$)
DECLARE FUNCTION typeof% (item$)
DECLARE SUB PUSHD (item$)
DECLARE SUB COMPILE ()
DECLARE SUB PUSHR (item$)
DECLARE FUNCTION BRACKET% (item$)
DECLARE FUNCTION PRIORITY% (operator$)
DECLARE SUB PUSH ()
DECLARE FUNCTION POPD$ ()
DECLARE FUNCTION POPR$ ()
DECLARE SUB EVAL (expr$)
DIM SHARED stackopd(1 TO 32) AS STRING, opd AS INTEGER
DIM SHARED stackopr(1 TO 64) AS STRING, opr AS INTEGER
DIM SHARED nextitem$, operator$
CONST TYPE_INT = 2
CONST TYPE_LONG = 4
CONST TYPE_NUM = 8
CONST TYPE_VAR = 16
CONST TYPE_REG = 32
CLS
expr$ = "232333*3/(a-(2*3))+5*(4-1)AND 6*3"
PRINT expr$
PRINT
EVAL expr$
DEFINT A-Z
FUNCTION BRACKET (item$)
IF item$ = "(" OR item$ = ")" THEN BRACKET = -1
END FUNCTION
SUB COMPILE
IF LEN(operator$) = 0 THEN EXIT SUB
dest$ = "AX"
FOR i = 1 TO opd - 2
IF stackopd(i) = "AX" THEN
dest$ = "DX"
EXIT FOR
ELSEIF stackopd(i) = "EAX" THEN
dest$ = "EDX"
EXIT FOR
END IF
NEXT
op2$ = POPD
op1$ = POPD
PUSHD dest$
result$ = ""
IF operator$ = "+" THEN
op$ = "ADD"
IF typeof(op1$) AND typeof(op2$) AND TYPE_NUM THEN
result$ = STR$(VAL(op1$) + VAL(op2$))
END IF
ELSEIF operator$ = "-" THEN
op$ = "SUB"
IF typeof(op1$) AND typeof(op2$) AND TYPE_NUM THEN
result$ = STR$(VAL(op1$) - VAL(op2$))
END IF
ELSEIF operator$ = "*" THEN
op$ = "IMUL"
IF typeof(op1$) AND typeof(op2$) AND TYPE_NUM THEN
result$ = STR$(VAL(op1$) * VAL(op2$))
END IF
ELSEIF operator$ = "/" THEN
op$ = "IDIV"
IF typeof(op1$) AND typeof(op2$) AND TYPE_NUM THEN
result$ = STR$(VAL(op1$) / VAL(op2$))
END IF
END IF
PRINT dest$; " = "; op1$; " "; operator$; " "; op2$, TYPEOFS(op1$), TYPEOFS(op2$)
IF op2$ = dest$ OR op2$ = "E" + dest$ THEN
'PRINT result$, 1
PRINT op$; " "; dest$; ","; op1$
ELSEIF op1$ = dest$ OR op1$ = "E" + dest$ THEN
'PRINT result$, 2
PRINT op$; " "; dest$; ","; op2$
ELSE
'PRINT result$, 3
IF LEN(result$) = 0 THEN
PRINT "MOV "; dest$; ","; op1$
PRINT op$; " "; dest$; ","; op2$
ELSE
PRINT "MOV "; dest$; ","; result$
END IF
END IF
PRINT
SLEEP
END SUB
SUB EVAL (expr$)
i = 1
exprlen = LEN(expr$)
DO
GOSUB nextitem
IF nextitem$ = "#" THEN EXIT DO
IF nextitem$ = "(" THEN PUSHR nextitem$
IF PRIORITY(nextitem$) > 0 THEN
IF NOT opr = 0 THEN
operator$ = POPR
DO WHILE PRIORITY(operator$) >= PRIORITY(nextitem$)
COMPILE
operator$ = POPR
LOOP
PUSHR operator$
PUSHR nextitem$
ELSE
PUSHR nextitem$
END IF
ELSE
IF NOT (nextitem$ = "(" OR nextitem$ = ")") THEN
PUSHD nextitem$
END IF
END IF
IF nextitem$ = ")" THEN
operator$ = POPR
DO UNTIL operator$ = "("
COMPILE
operator$ = POPR
LOOP
END IF
LOOP
DO UNTIL opr = 0
operator$ = POPR
COMPILE
LOOP
EXIT SUB
nextitem:
nextitem$ = ""
IF i > exprlen THEN nextitem$ = "#"
DO UNTIL i > exprlen
flag = 0
char$ = MID$(expr$, i, 1)
IF i < LEN(expr$) THEN
nextchar$ = MID$(expr$, i + 1, 1)
ELSE
nextchar$ = ""
END IF
IF BRACKET(char$) THEN
nextitem$ = char$
flag = -1
ELSEIF PRIORITY(char$) THEN
nextitem$ = char$
flag = -1
ELSEIF char$ = " " THEN
flag = -1
ELSE
nextitem$ = nextitem$ + char$
IF PRIORITY(nextchar$) OR BRACKET(nextchar$) THEN flag = -1
END IF
i = i + 1
IF flag THEN EXIT DO
LOOP
RETURN
END SUB
DEFSNG A-O, Q-Z
DEFSTR P
FUNCTION POPD
POPD = stackopd(opd)
opd = opd - 1
END FUNCTION
DEFSTR A-O, Q-Z
FUNCTION POPR
IF opr > 0 THEN
POPR = stackopr(opr)
opr = opr - 1
ELSE
POPR = ""
END IF
END FUNCTION
DEFINT A-Z
SUB PRINTSTACK
PRINT
PRINT "Operanden: ";
FOR i = 1 TO opd
PRINT stackopd(i); " ";
NEXT
PRINT
PRINT "Operatoren: ";
FOR i = 1 TO opr
PRINT stackopr(i); " ";
NEXT
PRINT
END SUB
FUNCTION PRIORITY (operator$)
SELECT CASE operator$
CASE "IMP"
p% = 3
CASE "EQV"
p% = 4
CASE "XOR"
p% = 5
CASE "OR"
p% = 6
CASE "AND"
p% = 7
CASE "NOT"
p% = 8
CASE "=", ">", "<", "<>", "<=", ">="
p% = 9
CASE "+", "-"
p% = 10
CASE "MOD"
p% = 11
CASE "\"
p% = 12
CASE "*", "/"
p% = 13
CASE "NEG"
p% = 14
CASE "^"
p% = 15
CASE ELSE
p% = 0
END SELECT
PRIORITY = p%
END FUNCTION
DEFSNG A-Z
SUB PUSHD (item$)
opd = opd + 1
stackopd(opd) = item$
END SUB
SUB PUSHR (item$)
opr = opr + 1
stackopr(opr) = UCASE$(item$)
END SUB
DEFINT A-Z
FUNCTION typeof (item$)
itemlength = LEN(item$)
firstbyte = ASC(LEFT$(item$, 1))
lastbyte = ASC(MID$(item$, itemlength, 1))
IF lastbyte = 37 THEN '%
t = t OR TYPE_INT
item$ = LEFT$(item$, itemlength - 1)
ELSEIF lastbyte = 38 THEN '&
t = t OR TYPE_LONG
item$ = LEFT$(item$, itemlength - 1)
END IF
IF firstbyte >= 48 AND firstbyte <= 57 THEN
v& = VAL(item$)
IF v& < -32768 OR v& > 32767 THEN
t = t OR TYPE_LONG
ELSE
t = t OR TYPE_INT
END IF
t = t OR TYPE_NUM
ELSEIF item$ = "AX" OR item$ = "DX" THEN
t = 0
t = t OR TYPE_REG
t = t OR TYPE_INT
ELSEIF item$ = "EAX" OR item$ = "EDX" THEN
t = 0
t = t OR TYPE_REG
t = t OR TYPE_LONG
ELSE
IF t = 0 THEN
t = t OR TYPE_INT
END IF
t = t OR TYPE_VAR
END IF
typeof = t
END FUNCTION
FUNCTION TYPEOFS$ (item$)
t = typeof(item$)
IF t AND TYPE_INT THEN tmp$ = tmp$ + "INT "
IF t AND TYPE_LONG THEN tmp$ = tmp$ + "LONG "
IF t AND TYPE_REG THEN tmp$ = tmp$ + "REG "
IF t AND TYPE_NUM THEN tmp$ = tmp$ + "NUM "
IF t AND TYPE_VAR THEN tmp$ = tmp$ + "VAR "
TYPEOFS$ = tmp$
END FUNCTION
|
|
|