Initial _CAST support

QB64-Phoenix-Edition · Nov 28, 2024 · 0c105be · 0c105be
1 parent f2fe842
commit 0c105be
Show file tree

Hide file tree

Showing 3 changed files with 67 additions and 2 deletions.
diff --git a/source/qb64pe.bas b/source/qb64pe.bas
@@ -16485,6 +16485,32 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
 
 
 
+                ' CAST support
+                IF n$ = "_CAST" THEN
+                    IF curarg = 1 THEN ' data type
+                        castType$ = type2symbol$(e$)
+                        IF Error_Happened THEN EXIT FUNCTION
+
+                        SELECT CASE castType$
+                            CASE "%%", "~%%", "%", "~%", "&", "~&", "&&", "~&&", "%&", "~%&", "!", "#", "##"
+                                typ& = typname2typ(castType$)
+                                IF Error_Happened THEN EXIT FUNCTION
+
+                                r$ = r$ + "(" + typ2ctyp(typ&, castType$) + ")" ' both args are not really needed. Oh well!
+                                IF Error_Happened THEN EXIT FUNCTION
+
+                            CASE ELSE
+                                Give_Error "_CAST TYPE unsupported"
+                                EXIT FUNCTION
+                        END SELECT
+
+                        e$ = ""
+                        nocomma = 1
+
+                        GOTO dontevaluate
+                    END IF
+                END IF
+
                 '*special case CVI,CVL,CVS,CVD,_CV (part #1)
                 IF n$ = "_CV" THEN
                     IF curarg = 1 THEN
@@ -16670,6 +16696,25 @@ FUNCTION evaluatefunc$ (a2$, args AS LONG, typ AS LONG)
                 IF Error_Happened THEN EXIT FUNCTION
                 '------------------------------------------------------------------------------------------------------------
 
+                ' CAST support
+                IF n$ = "_CAST" THEN
+                    IF curarg = 2 THEN ' numeric value
+                        nocomma = 0
+
+                        IF sourcetyp AND ISSTRING THEN
+                            Give_Error "Expected numeric value"
+                            EXIT FUNCTION
+                        END IF
+
+                        IF sourcetyp AND ISREFERENCE THEN e$ = refer(e$, sourcetyp, 0)
+                        IF Error_Happened THEN EXIT FUNCTION
+
+                        r$ = r$ + "(" + e$ + "))"
+
+                        GOTO evalfuncspecial
+                    END IF
+                END IF
+
                 ' IIF support
                 IF n$ = "_IIF" THEN
                     IF curarg = 1 THEN ' expression

diff --git a/source/subs_functions/subs_functions.bas b/source/subs_functions/subs_functions.bas
@@ -87,6 +87,15 @@ SUB reginternal
     clearid
     id.n = "_Continue": id.subfunc = 2: id.callname = "sub_stub": regid
 
+    clearid
+    id.n = "_Cast"
+    id.subfunc = 1
+    id.args = 2
+    id.arg = MKL$(-1) + MKL$(-1) ' overridden in qb64pe.bas
+    id.ret = -1 ' overridden in qb64pe.bas
+    id.hr_syntax = "_CAST(numericalType, numericalValue)"
+    regid
+
     clearid
     id.n = "_IIf"
     id.subfunc = 1
@@ -2628,6 +2637,7 @@ SUB reginternal
     id.secondargmustbe = "Step"
     id.hr_syntax = "PUT [STEP](column, row), Array([index])[,] [_CLIP]  [{PSET|PRESET|AND|OR|XOR}]][, omitcolor]"
     regid
+
     clearid
     id.n = "Put"
     id.subfunc = 2
@@ -2703,6 +2713,7 @@ SUB reginternal
     id.ret = STRINGTYPE - ISPOINTER
     id.hr_syntax = "MKSMBF$(value!)"
     regid
+
     clearid
     id.n = "MKDMBF"
     id.musthave = "$"
@@ -2724,6 +2735,7 @@ SUB reginternal
     id.ret = STRINGTYPE - ISPOINTER
     id.hr_syntax = "MKI$(integerVariableOrLiteral%)"
     regid
+
     clearid
     id.n = "MKL"
     id.musthave = "$"
@@ -2734,6 +2746,7 @@ SUB reginternal
     id.ret = STRINGTYPE - ISPOINTER
     id.hr_syntax = "MKL$(longVariableOrLiteral&)"
     regid
+
     clearid
     id.n = "MKS"
     id.musthave = "$"
@@ -2744,6 +2757,7 @@ SUB reginternal
     id.ret = STRINGTYPE - ISPOINTER
     id.hr_syntax = "MKS$(singlePrecisionVariableOrLiteral!)"
     regid
+
     clearid
     id.n = "MKD"
     id.musthave = "$"
@@ -2754,6 +2768,7 @@ SUB reginternal
     id.ret = STRINGTYPE - ISPOINTER
     id.hr_syntax = "MKD$(doublePrecisionVariableOrLiteral#)"
     regid
+
     clearid
     id.n = "_MK"
     id.musthave = "$"
@@ -2774,6 +2789,7 @@ SUB reginternal
     id.ret = SINGLETYPE - ISPOINTER
     id.hr_syntax = "CVSMBF(stringData$)"
     regid
+
     clearid
     id.n = "CVDMBF"
     id.subfunc = 1
@@ -2793,6 +2809,7 @@ SUB reginternal
     id.ret = INTEGERTYPE - ISPOINTER
     id.hr_syntax = "CVI(stringData$)"
     regid
+
     clearid
     id.n = "CVL"
     id.subfunc = 1
@@ -2802,6 +2819,7 @@ SUB reginternal
     id.ret = LONGTYPE - ISPOINTER
     id.hr_syntax = "CVL(stringData$)"
     regid
+
     clearid
     id.n = "CVS"
     id.subfunc = 1
@@ -2811,6 +2829,7 @@ SUB reginternal
     id.ret = SINGLETYPE - ISPOINTER
     id.hr_syntax = "CVS(stringData$)"
     regid
+
     clearid
     id.n = "CVD"
     id.subfunc = 1
@@ -2820,6 +2839,7 @@ SUB reginternal
     id.ret = DOUBLETYPE - ISPOINTER
     id.hr_syntax = "CVD(stringData$)"
     regid
+
     clearid
     id.n = "_CV"
     id.subfunc = 1
@@ -4052,8 +4072,8 @@ SUB reginternal
     id.arg = MKL$(STRINGTYPE - ISPOINTER) + MKL$(STRINGTYPE - ISPOINTER) + MKL$(STRINGTYPE - ISPOINTER)
     id.specialformat = "[?][,[?][,?]]"
     id.hr_syntax = "_NOTIFYPOPUP [title$][, message$][, iconType$]"
-
     regid
+
     clearid
     id.n = "_MessageBox"
     id.subfunc = 2 ' 1 = function, 2 = sub

diff --git a/source/subs_functions/syntax_highlighter_list.bas b/source/subs_functions/syntax_highlighter_list.bas
@@ -20,7 +20,7 @@ listOfKeywords$ = listOfKeywords$ +_
 
 ' [C] - Keywords alphabetical (1st line = QB64, 2nd line = QB4.5, 3rd line = OpenGL)
 listOfKeywords$ = listOfKeywords$ +_
-"_CAPSLOCK@_CEIL@_CINP@_CLEAR@_CLEARCOLOR@_CLIP@_CLIPBOARD$@_CLIPBOARDIMAGE@_CLOCKWISE@_COLORCHOOSERDIALOG@_COMMANDCOUNT@_CONNECTED@_CONNECTIONADDRESS@_CONNECTIONADDRESS$@_CONSOLE@_CONSOLECURSOR@_CONSOLEFONT@_CONSOLEINPUT@_CONSOLETITLE@_CONTINUE@_CONTROLCHR@_COPYIMAGE@_COPYPALETTE@_COSH@_COT@_COTH@_CRC32@_CSC@_CSCH@_CV@_CWD$@" +_
+"_CAPSLOCK@_CAST@_CEIL@_CINP@_CLEAR@_CLEARCOLOR@_CLIP@_CLIPBOARD$@_CLIPBOARDIMAGE@_CLOCKWISE@_COLORCHOOSERDIALOG@_COMMANDCOUNT@_CONNECTED@_CONNECTIONADDRESS@_CONNECTIONADDRESS$@_CONSOLE@_CONSOLECURSOR@_CONSOLEFONT@_CONSOLEINPUT@_CONSOLETITLE@_CONTINUE@_CONTROLCHR@_COPYIMAGE@_COPYPALETTE@_COSH@_COT@_COTH@_CRC32@_CSC@_CSCH@_CV@_CWD$@" +_
 "CALL@CALLS@CASE@CDBL@CDECL@CHAIN@CHDIR@CHR$@CINT@CIRCLE@CLEAR@CLNG@CLOSE@CLS@COLOR@COM@COMMAND$@COMMON@CONSOLE@CONST@COS@CSNG@CSRLIN@CUSTOMTYPE@CVD@CVDMBF@CVI@CVL@CVS@CVSMBF@" +_
 "_GLCALLLIST@_GLCALLLISTS@_GLCLEAR@_GLCLEARACCUM@_GLCLEARCOLOR@_GLCLEARDEPTH@_GLCLEARINDEX@_GLCLEARSTENCIL@_GLCLIPPLANE@_GLCOLOR3B@_GLCOLOR3BV@_GLCOLOR3D@_GLCOLOR3DV@_GLCOLOR3F@_GLCOLOR3FV@_GLCOLOR3I@_GLCOLOR3IV@_GLCOLOR3S@_GLCOLOR3SV@_GLCOLOR3UB@_GLCOLOR3UBV@_GLCOLOR3UI@_GLCOLOR3UIV@_GLCOLOR3US@_GLCOLOR3USV@_GLCOLOR4B@_GLCOLOR4BV@_GLCOLOR4D@_GLCOLOR4DV@_GLCOLOR4F@_GLCOLOR4FV@_GLCOLOR4I@_GLCOLOR4IV@_GLCOLOR4S@_GLCOLOR4SV@_GLCOLOR4UB@_GLCOLOR4UBV@_GLCOLOR4UI@_GLCOLOR4UIV@_GLCOLOR4US@_GLCOLOR4USV@_GLCOLORMASK@_GLCOLORMATERIAL@_GLCOLORPOINTER@_GLCOPYPIXELS@_GLCOPYTEXIMAGE1D@_GLCOPYTEXIMAGE2D@_GLCOPYTEXSUBIMAGE1D@_GLCOPYTEXSUBIMAGE2D@_GLCULLFACE@"