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

fix for CONST issues

Browse source 
Yet again, here's another patch to the patch which patches a patch....  /sigh
This commit is contained in:
SteveMcNeill 2023-12-29 01:12:01 -05:00
parent 5447a3258e
commit ef19a046be
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$ e3$ = e2$
IF LEN(e2$) > 1 THEN IF LEN(e2$) > 1 THEN
IF ASC(e2$, 1) = 34 THEN
removeComma = _INSTRREV(e2$, ",") 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) e3$ = LEFT$(e2$, removeComma - 1)
ELSE ELSE
removeComma = INSTR(e2$, ",")
e3$ = MID$(e2$, removeComma + 1) e3$ = MID$(e2$, removeComma + 1)
END IF END IF
END IF END IF
END IF
IF LEN(readable_e$) = 0 THEN IF LEN(readable_e$) = 0 THEN
readable_e$ = e3$ readable_e$ = e3$
@ -24366,31 +24369,22 @@ END SUB
FUNCTION Evaluate_Expression$ (e$) FUNCTION Evaluate_Expression$ (e$)
t$ = e$ 'So we preserve our original data, we parse a temp copy of it t$ = e$ 'So we preserve our original data, we parse a temp copy of it
PreParse t$ PreParse t$
IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
'Deal with brackets first 'Deal with brackets first
exp$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine. exp$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
DO DO
Eval_E = INSTR(exp$, ")") Eval_E = INSTR(exp$, ")")
IF Eval_E > 0 THEN IF Eval_E > 0 THEN
c = 0 c = _INSTRREV(Eval_E, exp$, "(")
DO UNTIL Eval_E - c <= 0 IF c = 0 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT FUNCTION
c = c + 1 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.
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.
ParseExpression eval$ ParseExpression eval$
eval$ = LTRIM$(RTRIM$(eval$)) eval$ = LTRIM$(RTRIM$(eval$))
IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT FUNCTION 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) = "-" IF MID$(exp$, 1, 1) = "N" THEN MID$(exp$, 1) = "-"
END IF END IF
LOOP UNTIL Eval_E = 0 LOOP UNTIL Eval_E = 0
@ -24413,7 +24407,6 @@ SUB ParseExpression (exp$)
'PRINT exp$ 'PRINT exp$
exp$ = DWD(exp$) exp$ = DWD(exp$)
'We should now have an expression with no () to deal with 'We should now have an expression with no () to deal with
FOR J = 1 TO 250 FOR J = 1 TO 250
lowest = 0 lowest = 0
DO UNTIL lowest = LEN(exp$) DO UNTIL lowest = LEN(exp$)
@ -24488,6 +24481,7 @@ SUB ParseExpression (exp$)
END SELECT END SELECT
LOOP UNTIL op - c <= 0 LOOP UNTIL op - c <= 0
s = op - c s = op - c
num(1) = MID$(exp$, s + 1, op - s - 1) 'Get our first number 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 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) = "-" IF MID$(num(1), 1, 1) = "N" THEN MID$(num(1), 1) = "-"
@ -24497,6 +24491,7 @@ SUB ParseExpression (exp$)
ELSE ELSE
num(3) = EvaluateNumbers(OpOn, num()) num(3) = EvaluateNumbers(OpOn, num())
END IF END IF
IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N" IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
IF LEFT$(num(3), 5) = "ERROR" THEN exp$ = num(3): EXIT SUB 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)))) 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 SELECT CASE PL(p) 'divide up the work so we want do as much case checking
CASE 5 'Type conversions CASE 5 'Type conversions
'Note, these are special cases and work with the number BEFORE the command and not after '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.. SELECT CASE OName(p) 'Depending on our operator..
CASE "C_UOF": 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%&))) 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~%%))) 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~%))) 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%%))) 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%))) 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~&&))) 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~&))) 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&&))) 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&))) 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~`))) 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`))) 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##))) 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#))) 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!))) CASE "C_SI": n1! = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1!))) + num(2)
END SELECT END SELECT
EXIT FUNCTION EXIT FUNCTION
CASE 10 'functions 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 IF ABS(VAL(num(2))) < 1 THEN EvaluateNumbers$ = "ERROR - ABS(_ARCSEC) value < 1": EXIT FUNCTION
n1 = _ARCSEC(VAL(num(2))) n1 = _ARCSEC(VAL(num(2)))
CASE "_ARCCSC" 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))) n1 = _ARCCSC(VAL(num(2)))
CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2))) CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
CASE "_SECH": n1 = _SECH(VAL(num(2))) CASE "_SECH": n1 = _SECH(VAL(num(2)))
@ -24903,33 +24899,8 @@ FUNCTION DWD$ (exp$) 'Deal With Duplicates
END FUNCTION END FUNCTION
SUB PreParse (e$) SUB PreParse (e$)
DIM f AS _FLOAT
STATIC TotalPrefixedPP_TypeMod AS LONG, TotalPP_TypeMod AS LONG STATIC TotalPrefixedPP_TypeMod AS LONG, TotalPP_TypeMod AS LONG
t$ = e$ 'preserve the original string
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
'replace existing CONST values 'replace existing CONST values
sep$ = "()+-*/\><=^" sep$ = "()+-*/\><=^"
@ -25119,36 +25090,6 @@ SUB PreParse (e$)
END IF END IF
LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket 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$) 't$ = N2S(t$)
VerifyString t$ VerifyString t$
e$ = t$ e$ = t$