Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Eval

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu QBasic.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
RockTheSchock



Anmeldungsdatum: 04.04.2007
Beiträge: 131

BeitragVerfasst am: 30.10.2014, 22:28    Titel: Eval Antworten mit Zitat

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
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu QBasic. Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz