QB64/QB64-PE
QB64/QB64-PE
1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-07-06 18:40:23 +00:00
Code Issues Releases Wiki Activity

Merge pull request #420 from SteveMcNeill/main

Browse source 
fix for CONST issues
This commit is contained in:
Steve McNeill 2023-12-30 05:47:17 -05:00 committed by GitHub
parent 5447a3258e ef19a046be
commit ff57efa13e
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 65 additions and 124 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

119
source/qb64pe.bas
View file

@ -2283,14 +2283,17 @@ DO
e3$ = e2$
IF LEN(e2$) > 1 THEN
IF ASC(e2$, 1) = 34 THEN
removeComma = _INSTRREV(e2$, ",")
IF ASC(e2$, 1) = 34 THEN
e3$ = LEFT$(e2$, removeComma - 1)
ELSE
IF INSTR(e2$, "&H") OR INSTR(e2$, "&B") OR INSTR(e2$, "&O") THEN
e3$ = LEFT$(e2$, removeComma - 1)
ELSE
removeComma = INSTR(e2$, ",")
e3$ = MID$(e2$, removeComma + 1)
END IF
END IF
END IF
IF LEN(readable_e$) = 0 THEN
readable_e$ = e3$
@ -24366,31 +24369,22 @@ END SUB
FUNCTION Evaluate_Expression$ (e$)
t$ = e$ 'So we preserve our original data, we parse a temp copy of it
PreParse t$
IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
'Deal with brackets first
exp$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
DO
Eval_E = INSTR(exp$, ")")
IF Eval_E > 0 THEN
c = 0
DO UNTIL Eval_E - c <= 0
c = c + 1
IF Eval_E THEN
IF MID$(exp$, Eval_E - c, 1) = "(" THEN EXIT DO
END IF
LOOP
s = Eval_E - c + 1
IF s < 1 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT FUNCTION
eval$ = " " + MID$(exp$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
c = _INSTRREV(Eval_E, exp$, "(")
IF c = 0 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT FUNCTION
eval$ = " " + MID$(exp$, c + 1, Eval_E - c - 1) + " " 'pad with a space before and after so the parser can pick up the values properly.
ParseExpression eval$
eval$ = LTRIM$(RTRIM$(eval$))
IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT FUNCTION
exp$ = DWD(LEFT$(exp$, s - 2) + eval$ + MID$(exp$, Eval_E + 1))
exp$ = LEFT$(exp$, c - 1) + eval$ + MID$(exp$, Eval_E + 1)
IF MID$(exp$, 1, 1) = "N" THEN MID$(exp$, 1) = "-"
END IF
LOOP UNTIL Eval_E = 0
@ -24413,7 +24407,6 @@ SUB ParseExpression (exp$)
'PRINT exp$
exp$ = DWD(exp$)
'We should now have an expression with no () to deal with
FOR J = 1 TO 250
lowest = 0
DO UNTIL lowest = LEN(exp$)
@ -24488,6 +24481,7 @@ SUB ParseExpression (exp$)
END SELECT
LOOP UNTIL op - c <= 0
s = op - c
num(1) = MID$(exp$, s + 1, op - s - 1) 'Get our first number
num(2) = MID$(exp$, op + LEN(OName(OpOn)), E - op - LEN(OName(OpOn)) + 1) 'Get our second number
IF MID$(num(1), 1, 1) = "N" THEN MID$(num(1), 1) = "-"
@ -24497,6 +24491,7 @@ SUB ParseExpression (exp$)
ELSE
num(3) = EvaluateNumbers(OpOn, num())
END IF
IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
IF LEFT$(num(3), 5) = "ERROR" THEN exp$ = num(3): EXIT SUB
exp$ = LTRIM$(N2S(DWD(LEFT$(exp$, s) + RTRIM$(LTRIM$(num(3))) + MID$(exp$, E + 1))))
@ -24640,22 +24635,23 @@ FUNCTION EvaluateNumbers$ (p, num() AS STRING)
SELECT CASE PL(p) 'divide up the work so we want do as much case checking
CASE 5 'Type conversions
'Note, these are special cases and work with the number BEFORE the command and not after
'Since we're not using the 2nd number here, we need to return it back so it can still be processed properly
SELECT CASE OName(p) 'Depending on our operator..
CASE "C_UOF": n1~%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%&)))
CASE "C_ULO": n1%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%&)))
CASE "C_UBY": n1~%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%%)))
CASE "C_UIN": n1~% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%)))
CASE "C_BY": n1%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%%)))
CASE "C_IN": n1% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%)))
CASE "C_UIF": n1~&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&&)))
CASE "C_OF": n1~& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&)))
CASE "C_IF": n1&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&&)))
CASE "C_LO": n1& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&)))
CASE "C_UBI": n1~` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~`)))
CASE "C_BI": n1` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1`)))
CASE "C_FL": n1## = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1##)))
CASE "C_DO": n1# = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1#)))
CASE "C_SI": n1! = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1!)))
CASE "C_UOF": n1~%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%&))) + num(2)
CASE "C_ULO": n1%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%&))) + num(2)
CASE "C_UBY": n1~%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%%))) + num(2)
CASE "C_UIN": n1~% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%))) + num(2)
CASE "C_BY": n1%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%%))) + num(2)
CASE "C_IN": n1% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%))) + num(2)
CASE "C_UIF": n1~&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&&))) + num(2)
CASE "C_OF": n1~& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&))) + num(2)
CASE "C_IF": n1&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&&))) + num(2)
CASE "C_LO": n1& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&))) + num(2)
CASE "C_UBI": n1~` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~`))) + num(2)
CASE "C_BI": n1` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1`))) + num(2)
CASE "C_FL": n1## = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1##))) + num(2)
CASE "C_DO": n1# = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1#))) + num(2)
CASE "C_SI": n1! = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1!))) + num(2)
END SELECT
EXIT FUNCTION
CASE 10 'functions
@ -24669,7 +24665,7 @@ FUNCTION EvaluateNumbers$ (p, num() AS STRING)
IF ABS(VAL(num(2))) < 1 THEN EvaluateNumbers$ = "ERROR - ABS(_ARCSEC) value < 1": EXIT FUNCTION
n1 = _ARCSEC(VAL(num(2)))
CASE "_ARCCSC"
if abs(val(num(2))) < 1 then EvaluateNumbers$ = "ERROR - ABS(_ARCCSC) value < 1": EXIT FUNCTION
IF ABS(VAL(num(2))) < 1 THEN EvaluateNumbers$ = "ERROR - ABS(_ARCCSC) value < 1": EXIT FUNCTION
n1 = _ARCCSC(VAL(num(2)))
CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
CASE "_SECH": n1 = _SECH(VAL(num(2)))
@ -24903,33 +24899,8 @@ FUNCTION DWD$ (exp$) 'Deal With Duplicates
END FUNCTION
SUB PreParse (e$)
DIM f AS _FLOAT
STATIC TotalPrefixedPP_TypeMod AS LONG, TotalPP_TypeMod AS LONG
DO 'convert &H values to decimal values to prevent errors
l = INSTR(l, UCASE$(e$), "&H")
IF l THEN
FOR l1 = l + 2 TO LEN(e$)
SELECT CASE UCASE$(MID$(e$, l1, 1))
CASE "0" TO "9"
CASE "A" TO "F"
CASE ELSE:
'PRINT UCASE$(MID$(e$, l1, 1))
EXIT FOR
END SELECT
NEXT
IF l1 <> l + 2 THEN 'hex number found
IF l1 > l + 18 THEN EXIT DO
l$ = LEFT$(e$, l - 1)
r$ = MID$(e$, l1)
t~&& = VAL(MID$(e$, l, l1 - l))
m$ = _TRIM$(STR$(t~&&))
e$ = l$ + m$ + r$
ELSE
EXIT DO
END IF
END IF
LOOP UNTIL l = 0
t$ = e$ 'preserve the original string
'replace existing CONST values
sep$ = "()+-*/\><=^"
@ -25119,36 +25090,6 @@ SUB PreParse (e$)
END IF
LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
'Turn all &B (binary) numbers into decimal values for the program to process properly
l = 0
DO
l = INSTR(t$, "&B")
IF l THEN
E = l + 1: finished = 0
DO
E = E + 1
comp$ = MID$(t$, E, 1)
SELECT CASE comp$
CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
CASE ELSE
good = 0
FOR i = 1 TO UBOUND(OName)
IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
NEXT
IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
E = E - 1
finished = -1
END SELECT
LOOP UNTIL finished OR E = LEN(t$)
bin$ = MID$(t$, l + 2, E - l - 1)
FOR i = 1 TO LEN(bin$)
IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
NEXT
t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
END IF
LOOP UNTIL l = 0
't$ = N2S(t$)
VerifyString t$
e$ = t$