Deprecated: Array and string offset access syntax with curly braces is deprecated in /homepages/21/d38531796/htdocs/jose/smfforum/Sources/Subs.php on line 3825 Print Page - PluriBASIC - Progress of the implementation for Oxygen
Theo's Forum
IT-Berater: Theo Gottwald (IT-Consultant) => Brians Board => Topic started by: Brian Alvarez on November 19, 2018, 07:46:22 PM
Title: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on November 19, 2018, 07:46:22 PM
I had to back off from programming for a while but i am starting to gain speed again, remembering how i did all the stuff. Seems like the work from another person, i dont recall being this organized.
Anyway, right now the supported language is getting richer, Oxygen is doing a nice job at compiling 64bit executables. The list of functions supported is growing every day, in the past days the following functions got ready:
PARSE$() STRREVERSE$() LTRIM$() RTRIM$() TRIM$ UCASE$ LCASE$ HIBYT() HIWRD() HIINT() ' needs a fix HIDWD() LOBYT() LOWRD() LOINT() ' needs a fix LODWD() STR$() FORMAT$() READ$() DATACOUNT DATA A couple of the functions are a direct copy/paste of Charles functions, the rest had to be completely re-made to be fully compatible. The hardest and biggest one was FORMAT$().
Title: Re: PluriBASIC - Progress November 19 2018
Post by: Brian Alvarez on November 19, 2018, 08:02:38 PM
The HIXXX and LOXXX functions also support the HI and LO syntax, for example:
Still need to do the UNITS part, for now it only works with PIXELS. Also the automatic centering of the dialog when no X or Y coordinates are provided needs to be done.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on November 22, 2018, 05:33:33 AM
CONTROL SENDhDlg&, ctlID&, Message&, wParam&, lParam& [TOlResult&]
Complete.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on November 22, 2018, 10:42:26 PM
DIM MyArray(-10 TO 10, 9, 5) AS STRING DIM MyArray(-10 TO 10, 9, 5) AS STRING * 100 DIM MyArray(-10 TO 10, 9, 5) AS STRING AT Address??? The Following already work with these arrays:
At the moment, these arrays have some known limitations:
They cannot be passed to external DLL's unless created with PluriBASIC.
They cannot be used with a different number of dimensions than initially dimensioned (artificial limit that will be removed soon, because in practice, they can)
They cannot have more than 3 dimensions (limit temporarily set because of a system glitch)
More limitations may apply, i will be discovering them as i test them.
REDIM and REDIM PRESERVE are also mostly ready, but still need a couple tweaks and testing.
Not bad for a "lazy BASIC programmer" that works full time ON SUNDAY without even getting paid, huh?
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on November 27, 2018, 10:13:45 AM
Complete. But still requires better code for faster execution. For now it will allow me to tets other areas. It is ussing simple bubble sorting, but the module is open for more sophisticated algorithms.
It supports Arrays dimensioned with DIM. For not it supports the main data types: Strings, Integers and Floating point. The "Other" mode is not yet implemented, but it will allow any array. Probably can be implemented by using typeof in the MACRO.
Again the COLLATEcharlist$ is not complete.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on November 28, 2018, 10:25:01 PM
SPACE$(numChars$)
Complete.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on November 28, 2018, 11:09:26 PM
BUILD$(s$[, s$][, s$][, s$] [...])
Complete.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Chris Chancellor on November 28, 2018, 11:24:39 PM
Thanxx Brian
you are doing very well
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on November 28, 2018, 11:44:14 PM
JOIN$(MyArr$(), {BINARY | ""","""})
Complete... Almost. For now it is only for strings. NUmeric arrays will come later.
Note that it supports only arrays dimensioned with DIM.
@Chris, Thanks! Its coming along very well. :)
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on November 29, 2018, 04:00:14 AM
Expanded CHR$.
Now it also takes string literals, for example:
? CHR$(40, 41, 40 TO 45, 45 TO 40, "Hello")
It does not take string variables, encapsulated string literals or multi-part string literals yet though.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on November 29, 2018, 04:10:22 AM
CHR$$
Complete. It has the same functionality as CHR$, but returns a unicode string.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on November 29, 2018, 10:36:34 AM
Pointers progressed a lot today... ;D
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on December 04, 2018, 03:11:53 AM
Equates (constants):
PluriBASIC supports 5 kinds of equates:
ENUM equates.
Numeric equates.
ANSI String equates.
Duplicate equates (given they use a different data type)
Unicode String equates.
The following 3 equates are acceptable, even when used in the same program:
$$UNICODE_EQUATE = "Some unicode string"$$ With String equates, you cannot use dynamic functions, but as long as you provide literals as parameters, you can use the functions that can be parsed at compilation time:
CHR$
SPACE$
STRING$
GUID$
Equates containing a GUID, are checked at compilation time, and it has to be a valid value. Note that CHR$$ cannot be used for equate creation, only its ANSI counterpart.
With numeric equates, the values are also calculated at compilation time, and they can consist of the following components:
Numeric Expressions (1)
HEXADECIMAL expressions (&h0001)
OCTADECIMAL expressions (&o0001)
BINARY expressions (&b0001)
Another equates
Aritmetic operators
ENUM equates are supported as well, the following syntax is addmitted:
ENUM EquatePrefix [SINGULAR] [BITS] [AS COM] EquateMember [= numeric_expression] EquateMember [= numeric_expression] [...] END ENUM When using the SINGULAR switch, the equates are generated without a prefix, but it still needs to be provided for internal diferentiation.
Currently the AS COM switch is supported, but does nothing. The resulting equates may look as follows:
Currently the following system equates are defined, and require no external declaration.
$NUL
$BEL
$BS
$TAB
$LF
$VT
$FF
$CR
$CRLF
$EOF
$ESC
$SPC
$DQ
$DQ2
$SQ
$SQ2
$QCQ
$WHITESPACE
%MAX_PATH
%FALSE
%TRUE
%NULL
$$NUL
Equates are not included in the final program unless used, just like MACROS, CLASSES, SUB, FUNCTION and UDTs.
Restrictions: Equates defined inside a RAW segment are not taken into consideration for BASIC code outside the RAW sections, and they may conflict with system-generated equates.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on December 05, 2018, 02:02:13 AM
Developing PluriBASIC 6.0 using PluriBASIC 5.0 Message box displaying restored text from a UDT element, after successfully saving it and restoring it from a variant variable declared as a variant ptr.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on December 06, 2018, 02:14:59 AM
TYPEOF(object) TYPECODE(object)
Complete.
These are also available now for PowerBASIC 32 bit compilations.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on December 07, 2018, 07:41:11 AM
Enhanced macros for all platforms. The MACRO blocks now allow child macros as well as parameter dependant code generation. This applies to all available target platforms, including Android, PowerBASIC, PHP and Oxygen. Instead of explaining how it works, i will post a picture.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Chris Chancellor on December 08, 2018, 04:26:53 PM
Hello Brian
Congratulations to you that you have mastered O2
Quote
Almost all the ideas i have had so far have been possible. With very few exceptions, i have achieved most of the tasks i wanted! :)
Can you please provide some sample O2 codes in this forum as i have contributed mine ?
this is to encourage more and more basic programmers to use O2 , we do need to increase the users community here, more brains is better one or two Thanxx a lot
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on December 08, 2018, 05:36:53 PM
Hello Chris, I have been posting the progress exactly for that reason. :)
Hopefully, soon i will try to port some of the existing examples. If everything goes as expected. Right now i am finishing THREAD statements.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on December 08, 2018, 10:34:19 PM
ARRAYATTR()
Semi complete. I need to make sure everything is absolutely correct.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on December 11, 2018, 09:04:19 PM
Behold... complex udt structures! :)
An element of an dimensional udt member of an array of UDT's being assigned a value.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on December 14, 2018, 11:15:56 PM
THREAD CREATE ThreadFunction(Value&) TO hThread# THREAD STATUS hThread# TO nResult&
Complete. Also, the engine now supports all the THREAD statements, but there is no code generated for them yet.
Also, the following features are complete:
BYREF
BYVAL
BYCOPY (Thanks charles!)
Tested for:
Array elements.
Regular variables.
UDT members for Arrays of UDT's.
UDT members for regular UDT's.
Still not tested for class variables.
Also:
Arrays now fully support most data types, including UDT's.
UDT's now support elements of all data types.
UDT's now support dimensional members with multiple dimensions and variable bounds.
There are also hundreds of internal improvements and new features. I am getting closer to be able to port most available examples.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on December 25, 2018, 09:05:44 AM
MIN MIN% MIN& MIN$ MAX MAX% MAX& MAX$
Complete.
Overrideable system UDTs and system equates.
Complete.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on May 08, 2019, 09:42:00 PM
THREAD CREATE ThreadFunc(param) [StackSize&,] [SUSPEND] TO hThread (reworked) THREAD CLOSE hThread TO lResult& THREAD SUSPEND hThread TO lResult& THREAD RESUME hThread TO lResult& THREAD STATUS hThread TO lResult& (reworked) THREADCOUNT
Complete. Those now also work for Wow64 mode, meaning these functions work fine with 64bit compilations.
THREAD FUNCTIONs also were re-worked for 64bit compilations, meaning the parameter passed to a THREAD FUNCTION can be a 64 bit value.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on May 20, 2019, 12:42:18 AM
I Just finished adding this feature to PLuriBASIC. Basically you only need to fill an UDT variable, and then get an encoding for JSON. This is nothing new in the world of PHP, but this feature now works also with PowerBASIC 32 bit and Oxygen 32/64 bit compilations.
By the way, the STRING elements of an UDT with no string length specified, are assuming a fixed length of 255.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on May 20, 2019, 12:52:33 AM
Also take a look at the new macro features. These new macro features also work on all platforms supported by PluriBASIC, including PowerBASIC, PHP, Android and Oxygen compilations. Yeah...
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on May 20, 2019, 01:26:17 AM
The macro expansions are made in a VERY fast and reliable way. The same program can be generated thousands of times in just a few seconds (I benchmarked it). In fact, some times it expands the macros faster than PowerBASIC can compile them. Take a lok at this results:
Generated Files: ---------------- With bigger programs the lines per minute sky rocket though the roof for all engines, rising up to millions per minute. In fact, i think that what takes the longest time during compilation is allocating and cleaning memory for compilations.
DECLARE FUNCTION WriteFile_2 LIB "KERNEL32.DLL" ALIAS "WriteFile" (BYVAL hFile AS DWORD, lpBuffer AS ANY, BYVAL nNumberOfBytesToWrite AS LONG, lpNumberOfBytesWritten AS LONG, lpOverlapped AS ANY) AS LONG DECLARE FUNCTION WriteConsole_2 LIB "KERNEL32.DLL" ALIAS "WriteFile" (BYVAL hFile AS DWORD, lpBuffer AS ANY, BYVAL nNumberOfBytesToWrite AS LONG, lpNumberOfBytesWritten AS LONG, lpOverlapped AS ANY) AS LONG DECLARE FUNCTION AllocConsole_2 LIB "KERNEL32.DLL" ALIAS "AllocConsole" () AS LONG DECLARE FUNCTION FlushFileBuffers_2 LIB "KERNEL32.DLL" ALIAS "FlushFileBuffers" (BYVAL hFile AS DWORD) AS LONG DECLARE FUNCTION GetStdHandle_2 LIB "KERNEL32.DLL" Alias "GetStdHandle" (ByVal nStdHandle AS DWORD) AS DWORD DECLARE SUB QUERYVARIABLESTRING(BYVAL P1 AS STRING, P2 AS STRING) DECLARE SUB TESTVARIABLESTRING() DECLARE SUB QUERYVARIABLELONG(BYVAL P1 AS LONG, P2 AS LONG) DECLARE SUB TESTVARIABLELONG() DECLARE SUB QUERYVARIABLEBYTE(BYVAL P1 AS BYTE, P2 AS BYTE) DECLARE SUB TESTVARIABLEBYTE() DECLARE SUB QUERYVARIABLEDOUBLE(BYVAL P1 AS DOUBLE, P2 AS DOUBLE) DECLARE SUB TESTVARIABLEDOUBLE() DECLARE SUB QUERYVARIABLESINGLE(BYVAL P1 AS SINGLE, P2 AS SINGLE) DECLARE SUB TESTVARIABLESINGLE() DECLARE FUNCTION PBMAIN() AS LONG GLOBAL MV_on16k36 AS STRING GLOBAL MV_mn1ak36 AS STRING GLOBAL MV_on16k41 AS LONG GLOBAL MV_mn1ak41 AS LONG GLOBAL MV_on16k3d AS BYTE GLOBAL MV_mn1ak3d AS BYTE GLOBAL MV_on16k3a AS DOUBLE GLOBAL MV_mn1ak3a AS DOUBLE GLOBAL MV_on16k3b AS SINGLE GLOBAL MV_mn1ak3b AS SINGLE GLOBAL default_form AS STRING
' STARTS PRINTR.BIN
SUB PRINTR(byval s AS STRING)
STATIC Allc AS LONG LOCAL lWritten AS LONG LOCAL hFile AS DWORD LOCAL Btc AS LONG LOCAL TTsnd AS STRING
IF isfalse(Allc) THEN CALL AllocConsole_2() Allc = 1 END IF
SLEEP 0 hFile = GetStdHandle_2(-11) For Btc = 1 to 50 if ((Btc*32000)-31999) > len(s) THEN exit for TTsnd = MID$(s, ((Btc*32000)-31999), 32000) WriteConsole_2(hFile, ByVal StrPtr(TTsnd), Len(TTsnd), lWritten, ByVal 0&) Next Btc
FlushFileBuffers_2(hFile)
END SUB ' END OF PRINTR.BIN ' STARTS PLURIBASIC_INIT.BIN ' FUNCTION PLURIBASIC_INIT( ) AS LONG
END FUNCTION
' END OF PLURIBASIC_INIT.BIN
' Initializes various things in the script. FUNCTION PluriBASIC_Initialize() AS LONG
END FUNCTION
SUB QUERYVARIABLESTRING(BYVAL p1 AS STRING, _ p2 AS STRING) IF (p1=MV_on16k36) THEN PRINTR("*Success " & "Passing byval " & LCASE$("STRING") & " to a module" & $CRLF) ELSE PRINTR("*Failure " & "Passing byval " & LCASE$("STRING") & " to a module" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 1got " & p1 & " but expected " & MV_on16k36 & $CRLF) END IF IF (p2=MV_on16k36) THEN PRINTR("*Success " & "Passing byref " & LCASE$("STRING") & " to a module" & $CRLF) ELSE PRINTR("*Failure " & "Passing byref " & LCASE$("STRING") & " to a module" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 1got " & p2 & " but expected " & MV_on16k36 & $CRLF) END IF p2 = MV_mn1ak36 END SUB
SUB TESTVARIABLESTRING() LOCAL p1 AS STRING LOCAL p2 AS STRING p1 = MV_on16k36 p2 = MV_on16k36 IF (p1=MV_on16k36) THEN PRINTR("*Success " & "Default value assignation for " & LCASE$("STRING") & $CRLF) ELSE PRINTR("*Failure " & "Default value assignation for " & LCASE$("STRING") & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 1got " & p1 & " but expected " & MV_on16k36 & $CRLF) END IF QUERYVARIABLESTRING(p1, p2) IF (p1=MV_on16k36) THEN PRINTR("*Success " & "Retaining original value after passed byval" & $CRLF) ELSE PRINTR("*Failure " & "Retaining original value after passed byval" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 1got " & p1 & " but expected " & MV_on16k36 & $CRLF) END IF IF (p2=MV_mn1ak36) THEN PRINTR("*Success " & "Retaining changes made in module when passed byref" & $CRLF) ELSE PRINTR("*Failure " & "Retaining changes made in module when passed byref" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 1got " & p2 & " but expected " & MV_mn1ak36 & $CRLF) END IF PRINTR("-------") END SUB
SUB QUERYVARIABLELONG(BYVAL p1 AS LONG, _ p2 AS LONG) IF (p1=MV_on16k41) THEN PRINTR("*Success " & "Passing byval " & LCASE$("LONG") & " to a module" & $CRLF) ELSE PRINTR("*Failure " & "Passing byval " & LCASE$("LONG") & " to a module" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k41) & $CRLF) END IF IF (p2=MV_on16k41) THEN PRINTR("*Success " & "Passing byref " & LCASE$("LONG") & " to a module" & $CRLF) ELSE PRINTR("*Failure " & "Passing byref " & LCASE$("LONG") & " to a module" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p2) & " but expected " & FORMAT$(MV_on16k41) & $CRLF) END IF p2 = MV_mn1ak41 END SUB
SUB TESTVARIABLELONG() LOCAL p1 AS LONG LOCAL p2 AS LONG p1 = MV_on16k41 p2 = MV_on16k41 IF (p1=MV_on16k41) THEN PRINTR("*Success " & "Default value assignation for " & LCASE$("LONG") & $CRLF) ELSE PRINTR("*Failure " & "Default value assignation for " & LCASE$("LONG") & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k41) & $CRLF) END IF QUERYVARIABLELONG(p1, p2) IF (p1=MV_on16k41) THEN PRINTR("*Success " & "Retaining original value after passed byval" & $CRLF) ELSE PRINTR("*Failure " & "Retaining original value after passed byval" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k41) & $CRLF) END IF IF (p2=MV_mn1ak41) THEN PRINTR("*Success " & "Retaining changes made in module when passed byref" & $CRLF) ELSE PRINTR("*Failure " & "Retaining changes made in module when passed byref" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p2) & " but expected " & FORMAT$(MV_mn1ak41) & $CRLF) END IF PRINTR("-------") END SUB
SUB QUERYVARIABLEBYTE(BYVAL p1 AS BYTE, _ p2 AS BYTE) IF (p1=MV_on16k3d) THEN PRINTR("*Success " & "Passing byval " & LCASE$("BYTE") & " to a module" & $CRLF) ELSE PRINTR("*Failure " & "Passing byval " & LCASE$("BYTE") & " to a module" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k3d) & $CRLF) END IF IF (p2=MV_on16k3d) THEN PRINTR("*Success " & "Passing byref " & LCASE$("BYTE") & " to a module" & $CRLF) ELSE PRINTR("*Failure " & "Passing byref " & LCASE$("BYTE") & " to a module" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p2) & " but expected " & FORMAT$(MV_on16k3d) & $CRLF) END IF p2 = MV_mn1ak3d END SUB
SUB TESTVARIABLEBYTE() LOCAL p1 AS BYTE LOCAL p2 AS BYTE p1 = MV_on16k3d p2 = MV_on16k3d IF (p1=MV_on16k3d) THEN PRINTR("*Success " & "Default value assignation for " & LCASE$("BYTE") & $CRLF) ELSE PRINTR("*Failure " & "Default value assignation for " & LCASE$("BYTE") & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k3d) & $CRLF) END IF QUERYVARIABLEBYTE(p1, p2) IF (p1=MV_on16k3d) THEN PRINTR("*Success " & "Retaining original value after passed byval" & $CRLF) ELSE PRINTR("*Failure " & "Retaining original value after passed byval" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k3d) & $CRLF) END IF IF (p2=MV_mn1ak3d) THEN PRINTR("*Success " & "Retaining changes made in module when passed byref" & $CRLF) ELSE PRINTR("*Failure " & "Retaining changes made in module when passed byref" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p2) & " but expected " & FORMAT$(MV_mn1ak3d) & $CRLF) END IF PRINTR("-------") END SUB
SUB QUERYVARIABLEDOUBLE(BYVAL p1 AS DOUBLE, _ p2 AS DOUBLE) IF (p1=MV_on16k3a) THEN PRINTR("*Success " & "Passing byval " & LCASE$("DOUBLE") & " to a module" & $CRLF) ELSE PRINTR("*Failure " & "Passing byval " & LCASE$("DOUBLE") & " to a module" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k3a) & $CRLF) END IF IF (p2=MV_on16k3a) THEN PRINTR("*Success " & "Passing byref " & LCASE$("DOUBLE") & " to a module" & $CRLF) ELSE PRINTR("*Failure " & "Passing byref " & LCASE$("DOUBLE") & " to a module" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p2) & " but expected " & FORMAT$(MV_on16k3a) & $CRLF) END IF p2 = MV_mn1ak3a END SUB
SUB TESTVARIABLEDOUBLE() LOCAL p1 AS DOUBLE LOCAL p2 AS DOUBLE p1 = MV_on16k3a p2 = MV_on16k3a IF (p1=MV_on16k3a) THEN PRINTR("*Success " & "Default value assignation for " & LCASE$("DOUBLE") & $CRLF) ELSE PRINTR("*Failure " & "Default value assignation for " & LCASE$("DOUBLE") & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k3a) & $CRLF) END IF QUERYVARIABLEDOUBLE(p1, p2) IF (p1=MV_on16k3a) THEN PRINTR("*Success " & "Retaining original value after passed byval" & $CRLF) ELSE PRINTR("*Failure " & "Retaining original value after passed byval" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k3a) & $CRLF) END IF IF (p2=MV_mn1ak3a) THEN PRINTR("*Success " & "Retaining changes made in module when passed byref" & $CRLF) ELSE PRINTR("*Failure " & "Retaining changes made in module when passed byref" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p2) & " but expected " & FORMAT$(MV_mn1ak3a) & $CRLF) END IF PRINTR("-------") END SUB
SUB QUERYVARIABLESINGLE(BYVAL p1 AS SINGLE, _ p2 AS SINGLE) IF (p1=MV_on16k3b) THEN PRINTR("*Success " & "Passing byval " & LCASE$("SINGLE") & " to a module" & $CRLF) ELSE PRINTR("*Failure " & "Passing byval " & LCASE$("SINGLE") & " to a module" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k3b) & $CRLF) END IF IF (p2=MV_on16k3b) THEN PRINTR("*Success " & "Passing byref " & LCASE$("SINGLE") & " to a module" & $CRLF) ELSE PRINTR("*Failure " & "Passing byref " & LCASE$("SINGLE") & " to a module" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p2) & " but expected " & FORMAT$(MV_on16k3b) & $CRLF) END IF p2 = MV_mn1ak3b END SUB
SUB TESTVARIABLESINGLE() LOCAL p1 AS SINGLE LOCAL p2 AS SINGLE p1 = MV_on16k3b p2 = MV_on16k3b IF (p1=MV_on16k3b) THEN PRINTR("*Success " & "Default value assignation for " & LCASE$("SINGLE") & $CRLF) ELSE PRINTR("*Failure " & "Default value assignation for " & LCASE$("SINGLE") & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k3b) & $CRLF) END IF QUERYVARIABLESINGLE(p1, p2) IF (p1=MV_on16k3b) THEN PRINTR("*Success " & "Retaining original value after passed byval" & $CRLF) ELSE PRINTR("*Failure " & "Retaining original value after passed byval" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p1) & " but expected " & FORMAT$(MV_on16k3b) & $CRLF) END IF IF (p2=MV_mn1ak3b) THEN PRINTR("*Success " & "Retaining changes made in module when passed byref" & $CRLF) ELSE PRINTR("*Failure " & "Retaining changes made in module when passed byref" & " in " & FUNCNAME$ & "*" & $CRLF) PRINTR(" 3got " & FORMAT$(p2) & " but expected " & FORMAT$(MV_mn1ak3b) & $CRLF) END IF PRINTR("-------") END SUB
FUNCTION PBMAIN() AS LONG MV_on16k36 = "ORIG" MV_mn1ak36 = "MODIFIED" TESTVARIABLESTRING() MV_on16k41 = 1 MV_mn1ak41 = 2 TESTVARIABLELONG() MV_on16k3d = 1 MV_mn1ak3d = 2 TESTVARIABLEBYTE() MV_on16k3a = 1.3 MV_mn1ak3a = 2.3 TESTVARIABLEDOUBLE() MV_on16k3b = 1.3 MV_mn1ak3b = 2.3 TESTVARIABLESINGLE() PRINTR("DONE: " & "COMP") END FUNCTION This is what it generates for Oxygen:
DIM STRING ¤SYSTEM_UDT_OFFSETS(0) Declare Function ¤MessageBoxa Lib "user32.dll" Alias "MessageBoxA" Declare Function ¤MessageBoxw Lib "user32.dll" Alias "MessageBoxW" STRING ¤TMPS = "" ' a temporary string. DECLARE FUNCTION ¤GetLastError Lib "Kernel32.dll" Alias "GetLastError" () AS LONG DECLARE FUNCTION ¤GetAsyncKeyState Lib "User32.dll" Alias "GetAsyncKeyState" (ByVal vKey AS LONG) AS short DECLARE SUB ¤Sleep lib "Kernel32.dll" alias "Sleep" (dword mSec)
function ¤INI_QUAD(dword v1, v2) as quad quad v = 0 copy @v+0, @v2, 4 copy @v+4, @v1, 4 return v end function
DECLARE FUNCTION ¤OpenProcess Lib "KERNEL32.DLL" Alias "OpenProcess" (ByVal dwDesiredAccess AS DWORD, ByVal bInheritHandle AS LONG, ByVal dwProcessId AS SYS) AS SYS DECLARE FUNCTION ¤TerminateProcess Lib "KERNEL32.DLL" Alias "TerminateProcess" ( ByVal hProcess AS SYS, ByVal uExitCode AS DWORD) AS LONG DECLARE FUNCTION ¤CloseHandle Lib "KERNEL32.DLL" Alias "CloseHandle" (ByVal hObject AS SYS) AS LONG DECLARE FUNCTION ¤GetCurrentProcessId Lib "KERNEL32.DLL" Alias "GetCurrentProcessId" () AS SYS
MACRO ¤SET_ERR(n) Err.err = n Err.erl = Err.erp END MACRO
MACRO ¤ONERR(l, e) Err.err = e IF (Err.err>0) THEN Err.ers = Err.erp Err.erl = l IF Err.Oe1 THEN JMP Err.Oe1 ELSEIF Err.Oe2 THEN CALL Err.Oe2 END IF else Err.ers = "" Err.erl = 0 END IF END MACRO
CLASS ¤SYSERR public sys Oe1 = 0 public sys Oe2 = 0 public int err = 0 public int erl = 0 public string erp = "" public string ers = "" END CLASS DECLARE FUNCTION ¤WriteConsole LIB "KERNEL32.DLL" ALIAS "WriteFile" (BYVAL hFile AS DWORD, lpBuffer AS ANY, BYVAL nNumberOfBytesToWrite AS LONG, lpNumberOfBytesWritten AS LONG, lpOverlapped AS ANY) AS LONG DECLARE FUNCTION ¤AllocConsole LIB "KERNEL32.DLL" ALIAS "AllocConsole" () AS LONG DECLARE FUNCTION ¤FlushFileBuffers LIB "KERNEL32.DLL" ALIAS "FlushFileBuffers" (BYVAL hFile AS DWORD) AS LONG DECLARE FUNCTION ¤GetStdHandle LIB "KERNEL32.DLL" Alias "GetStdHandle" (ByVal nStdHandle AS DWORD) AS DWORD
TYPE ¤HPROP long elem long dmode sys oldProc sys curProc 'long user1 'long user2 END TYPE
Function ¤DEFAULT_CALLBACK_PROC(sys hwnd, wMsg, wParam, lParam) as sys callback sys retval = 0
return retval
End Function
' STARTS PLURIBASIC_PREPARE.BIN ' This code is executed before anything else, if you want to do something after defining other things, see PLURIBASIC_INIT
' STARTS TERMINATE.BIN ' STARTS MSGBOX.BIN
FUNCTION MSGBOX(wstring wText, int mOptions, string aCaption) AS LONG wstring wCaption = mid(aCaption, 1) FUNCTION = ¤MessageBoxw(0, wText, wCaption, mOptions) end function
FUNCTION MSGBOX(string aText, int mOptions, wstring wCaption) AS LONG wstring wText = mid(aText, 1) FUNCTION = ¤MessageBoxw(0, wText, wCaption, mOptions) end function
FUNCTION MSGBOX(wstring wText, int mOptions, wstring wCaption) AS LONG FUNCTION = ¤MessageBoxw(0, wText, wCaption, mOptions) end function
FUNCTION MSGBOX(string aText, int mOptions, string aCaption) AS LONG FUNCTION = ¤MessageBoxa(0, aText, aCaption, mOptions) END FUNCTION
FUNCTION MSGBOX(string aText) AS LONG string aCaption = "PluriBASIC" int mOptions = 0 FUNCTION = ¤MessageBoxa(0, aText, aCaption, mOptions) END FUNCTION
FUNCTION MSGBOX(wstring wText) AS LONG wString wCaption = "PluriBASIC" int mOptions = 0 FUNCTION = ¤MessageBoxw(0, wText, wCaption, mOptions) END FUNCTION
FUNCTION MSGBOX(string aText, int mOptions) AS LONG string aCaption = "PluriBASIC" FUNCTION = ¤MessageBoxa(0, aText, aCaption, mOptions) END FUNCTION
FUNCTION MSGBOX(wstring wText, int mOptions) AS LONG wString wCaption = "PluriBASIC" FUNCTION = ¤MessageBoxw(0, wText, wCaption, mOptions) END FUNCTION ' END OF MSGBOX.BIN ' CONTINUES (1) TERMINATE.BIN
IF (hProcess<>0) And (hProcess <> 0xFFFFFFFF) Then ¤TerminateProcess(hProcess, 0) ¤CloseHandle(hProcess) End If
END FUNCTION
' END OF TERMINATE.BIN ' CONTINUES (31) PLURIBASIC_PREPARE.BIN
#DEF HANDLE SYS
TYPE ¤SYSNMHDR hwndFrom AS SYS idFrom AS SYS Code AS DWORD END TYPE
class ¤SYSF
FUNCTION CONSTRUCTOR() END FUNCTION
END CLASS
new ¤SYSF EXE()
' END OF PLURIBASIC_PREPARE.BIN ' STARTS STRINGN.BIN //Assigns a truncated null terminated string. MACRO ¤STRN_SET(v, c, l b) string b = c if len(b) > l then b = left(b, l) elseif len(b) < l then b += space(l-len(b)) end if v = b END MACRO
' END OF STRINGN.BIN ' STARTS PRINTR.BIN
SUB ¤INITCONSOLE() STATIC Allc AS LONG IF Allc=0 THEN ¤AllocConsole() Allc = 1 END IF END SUB
MACRO ¤STDOUT() LOCAL lWritten AS LONG LOCAL hFile AS DWORD LOCAL Btc AS LONG LOCAL TTsnd AS STRING
¤INITCONSOLE()
¤Sleep(0)
hFile = ¤GetStdHandle(-11) FOR Btc = 1 TO 50 IF ((Btc*32000)-31999) > len(s) THEN EXIT FOR TTsnd = MID$(s, ((Btc*32000)-31999), 32000) ¤WriteConsole(hFile, ByVal StrPtr(TTsnd), Len(TTsnd), lWritten, ByVal 0&) NEXT Btc
¤FlushFileBuffers(hFile) END MACRO
SUB PRINTR(BYVAL s AS WSTRING, byval b as string) ¤STDOUT() END SUB
SUB PRINTR(BYVAL s AS STRING, byval b as string) ¤STDOUT() END SUB
SUB PRINTR(CHAR *c, byval string b) string s = c ¤STDOUT() END SUB
'SUB PRINTR(WCHAR *c, byval string b) ' string s = c ' ¤STDOUT() 'END SUB
' END OF PRINTR.BIN ' STARTS PLURIBASIC_INIT.BIN ' This code is executed before anything else, if you want to do something before nything else, see PLURIBASIC_PREPARE ' END OF PLURIBASIC_INIT.BIN ' STARTS LCASE$.BIN ' LCASE$ stock code (not required by oxygen) ' END OF LCASE$.BIN ' STARTS FORMAT$.BIN ' STARTS PARSE$.BIN // returns a field of data given a separator. FUNCTION PARSE(string src, long a, string sep, long fldnum) as string
if sep = "" then return src end if
indexbase 1
byte srcchar at strptr(src) byte sepchar at strptr(sep) long p1 = 1 long pos = 1 long curfld = 1 long index long seps
for index = 1 to len(src)
if a then for seps = 1 to len(sep) if srcchar[index] = sepchar[seps] then goto match end if next if index = len(src) then index += 1 else goto nomatch end if elseif index = len(src) then index += 1 else for seps = 1 to len(sep) if srcchar[index+seps-1] <> sepchar[seps] then goto nomatch end if next end if
match:
p1 = pos pos = index
if fldnum = curfld then return mid(src, p1, (pos-p1)) end if
curfld += 1
if a then pos = index + 1 else pos = index + len(sep) end if
nomatch: next
if fldnum = 1 then return src end if
END FUNCTION ' END OF PARSE$.BIN ' CONTINUES (1) FORMAT$.BIN FUNCTION FORMAT(double dd, string f = "") AS STRING
if len(f) then for i = 1 to len(f) select asc(f, i) case "," if i=1 then commas = 1 elseif asc(f, i-1) = 32 then orig[i] = 0 else commas = 1 orig[i] = 0 end if nocommas:
case "\" orig[i] = 0 i += 1
case "*" orig[i] = 6 asterisc = asc(f, i+1) for i2 = i+1 to len(f) if asc(f, i2) = asterisc then orig[i2] = 6 end if next i2
case "." if decimal = 0 then decimal = i end if
case " ", "$", "(", ")", "+", "-" case "%" percent = 1
case "#" orig[i] = 5 if decimal then tzeroes += 1 else lzeroes += 1 end if
case "0" if decimal then if tzeroes then orig[i] = 4 else orig[i] = 3 end if tzeroes += 1 else if lzeroes then orig[i] = 2 else orig[i] = 1 end if lzeroes += 1 end if
case else orig[i] = 0
end select nextiteration: next else decimal = 0 tzeroes = 8 end if
if percent then d = d * 100 end if
if decimal then nm = str(d, tzeroes) else return ltrim(str(d)) end if
for i = decimal to 1 step -1 select case asc(bformat, i) case 6 oformat = chr(asterisc) & oformat
case 0 case 1 : if np < 1 then if commaps = 3 then oformat = "," & oformat commaps = 0 end if oformat = "0" & oformat else for i2 = np to 1 step -1 if commaps = 3 then oformat = "," & oformat commaps = 0 end if oformat = mid(lpart, i2, 1) & oformat if commas then commaps += 1 next i2 end if
case 2 if commaps = 3 then oformat = "," & oformat commaps = 0 end if if np < 1 then oformat = "*0" & oformat else oformat = mid(lpart, np, 1) & oformat np -= 1 end if if commas then commaps += 1
case 5 if np < 1 then oformat = chr(asterisc) & oformat end if
case else oformat = mid(bformat, i, 1) & oformat
end select next i
' decimal. rpart = parse(nm, 0, ".", 2) np = 1
if len(rpart) then for i = decimal+1 to len(bformat) select case asc(bformat, i) case 6 oformat += chr(asterisc) case 0 ' do nothing! case 3 : oformat += mid(rpart, np, 1) np += 1 case 4 oformat += mid(rpart, np) np = tzeroes case 5 if np >= tzeroes then oformat += chr(asterisc) end if case else oformat += mid(bformat, i, 1)
end select next i else for i = decimal+1 to len(bformat) select case asc(bformat, i) case 0 ' do nothing! case 3 : if tzeroes>0 then oformat += string(tzeroes, "0") end if case 4 case 5 oformat += chr(asterisc) case else oformat += mid(bformat, i, 1) end select next i end if
return oformat
END FUNCTION ' END OF FORMAT$.BIN ' STARTS CALLBACKDATA.BIN ' END OF CALLBACKDATA.BIN
DECLARE SUB QUERYVARIABLESTRING(BYVAL P1 AS STRING, P2 AS STRING) DECLARE SUB TESTVARIABLESTRING() DECLARE SUB QUERYVARIABLELONG(BYVAL P1 AS INT, P2 AS INT) DECLARE SUB TESTVARIABLELONG() DECLARE SUB QUERYVARIABLEBYTE(BYVAL P1 AS BYTE, P2 AS BYTE) DECLARE SUB TESTVARIABLEBYTE() DECLARE SUB QUERYVARIABLEDOUBLE(BYVAL P1 AS DOUBLE, P2 AS DOUBLE) DECLARE SUB TESTVARIABLEDOUBLE() DECLARE SUB QUERYVARIABLESINGLE(BYVAL P1 AS SINGLE, P2 AS SINGLE) DECLARE SUB TESTVARIABLESINGLE() DECLARE FUNCTION PBMAIN() AS LONG STRING ¤¤on16k36 STRING ¤¤mn1ak36 INT ¤¤on16k41 INT ¤¤mn1ak41 BYTE ¤¤on16k3d BYTE ¤¤mn1ak3d DOUBLE ¤¤on16k3a DOUBLE ¤¤mn1ak3a SINGLE ¤¤on16k3b SINGLE ¤¤mn1ak3b
' Initializes various things in the script. FUNCTION PluriBASIC_Initialize() AS LONG
END FUNCTION
SUB QUERYVARIABLESTRING(STRING »p1, STRING *p2) ¤SYSERR Err STRING p1 = »p1 IF (p1=¤¤on16k36) THEN PRINTR("*Success " & "Passing byval " & LCASE("STRING") & " to a module" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Passing byval " & LCASE("STRING") & " to a module" & " in " & "QUERYVARIABLESTRING" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 1got " & p1 & " but expected " & ¤¤on16k36 & chr(13,10), chr(13, 10)) END IF IF (p2=¤¤on16k36) THEN PRINTR("*Success " & "Passing byref " & LCASE("STRING") & " to a module" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Passing byref " & LCASE("STRING") & " to a module" & " in " & "QUERYVARIABLESTRING" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 1got " & p2 & " but expected " & ¤¤on16k36 & chr(13,10), chr(13, 10)) END IF p2 = (¤¤mn1ak36) END SUB
SUB TESTVARIABLESTRING() ¤SYSERR Err STRING p1 STRING p2 p1 = ¤¤on16k36 p2 = ¤¤on16k36 IF (p1=¤¤on16k36) THEN PRINTR("*Success " & "Default value assignation for " & LCASE("STRING") & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Default value assignation for " & LCASE("STRING") & " in " & "TESTVARIABLESTRING" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 1got " & p1 & " but expected " & ¤¤on16k36 & chr(13,10), chr(13, 10)) END IF QUERYVARIABLESTRING(p1, p2) IF (p1=¤¤on16k36) THEN PRINTR("*Success " & "Retaining original value after passed byval" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Retaining original value after passed byval" & " in " & "TESTVARIABLESTRING" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 1got " & p1 & " but expected " & ¤¤on16k36 & chr(13,10), chr(13, 10)) END IF IF (p2=¤¤mn1ak36) THEN PRINTR("*Success " & "Retaining changes made in module when passed byref" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Retaining changes made in module when passed byref" & " in " & "TESTVARIABLESTRING" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 1got " & p2 & " but expected " & ¤¤mn1ak36 & chr(13,10), chr(13, 10)) END IF PRINTR("-------", chr(13, 10)) END SUB
SUB QUERYVARIABLELONG(INT »p1, INT *p2) ¤SYSERR Err INT p1 = »p1 IF (p1=¤¤on16k41) THEN PRINTR("*Success " & "Passing byval " & LCASE("LONG") & " to a module" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Passing byval " & LCASE("LONG") & " to a module" & " in " & "QUERYVARIABLELONG" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p1, byval 0) & " but expected " & FORMAT(¤¤on16k41, byval 0) & chr(13,10), chr(13, 10)) END IF IF (p2=¤¤on16k41) THEN PRINTR("*Success " & "Passing byref " & LCASE("LONG") & " to a module" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Passing byref " & LCASE("LONG") & " to a module" & " in " & "QUERYVARIABLELONG" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p2, byval 0) & " but expected " & FORMAT(¤¤on16k41, byval 0) & chr(13,10), chr(13, 10)) END IF p2 = (¤¤mn1ak41) END SUB
SUB TESTVARIABLELONG() ¤SYSERR Err INT p1 INT p2 p1 = ¤¤on16k41 p2 = ¤¤on16k41 IF (p1=¤¤on16k41) THEN PRINTR("*Success " & "Default value assignation for " & LCASE("LONG") & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Default value assignation for " & LCASE("LONG") & " in " & "TESTVARIABLELONG" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p1, byval 0) & " but expected " & FORMAT(¤¤on16k41, byval 0) & chr(13,10), chr(13, 10)) END IF QUERYVARIABLELONG(p1, p2) IF (p1=¤¤on16k41) THEN PRINTR("*Success " & "Retaining original value after passed byval" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Retaining original value after passed byval" & " in " & "TESTVARIABLELONG" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p1, byval 0) & " but expected " & FORMAT(¤¤on16k41, byval 0) & chr(13,10), chr(13, 10)) END IF IF (p2=¤¤mn1ak41) THEN PRINTR("*Success " & "Retaining changes made in module when passed byref" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Retaining changes made in module when passed byref" & " in " & "TESTVARIABLELONG" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p2, byval 0) & " but expected " & FORMAT(¤¤mn1ak41, byval 0) & chr(13,10), chr(13, 10)) END IF PRINTR("-------", chr(13, 10)) END SUB
SUB QUERYVARIABLEBYTE(BYTE »p1, BYTE *p2) ¤SYSERR Err BYTE p1 = »p1 IF (p1=¤¤on16k3d) THEN PRINTR("*Success " & "Passing byval " & LCASE("BYTE") & " to a module" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Passing byval " & LCASE("BYTE") & " to a module" & " in " & "QUERYVARIABLEBYTE" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p1, byval 0) & " but expected " & FORMAT(¤¤on16k3d, byval 0) & chr(13,10), chr(13, 10)) END IF IF (p2=¤¤on16k3d) THEN PRINTR("*Success " & "Passing byref " & LCASE("BYTE") & " to a module" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Passing byref " & LCASE("BYTE") & " to a module" & " in " & "QUERYVARIABLEBYTE" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p2, byval 0) & " but expected " & FORMAT(¤¤on16k3d, byval 0) & chr(13,10), chr(13, 10)) END IF p2 = (¤¤mn1ak3d) END SUB
SUB TESTVARIABLEBYTE() ¤SYSERR Err BYTE p1 BYTE p2 p1 = ¤¤on16k3d p2 = ¤¤on16k3d IF (p1=¤¤on16k3d) THEN PRINTR("*Success " & "Default value assignation for " & LCASE("BYTE") & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Default value assignation for " & LCASE("BYTE") & " in " & "TESTVARIABLEBYTE" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p1, byval 0) & " but expected " & FORMAT(¤¤on16k3d, byval 0) & chr(13,10), chr(13, 10)) END IF QUERYVARIABLEBYTE(p1, p2) IF (p1=¤¤on16k3d) THEN PRINTR("*Success " & "Retaining original value after passed byval" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Retaining original value after passed byval" & " in " & "TESTVARIABLEBYTE" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p1, byval 0) & " but expected " & FORMAT(¤¤on16k3d, byval 0) & chr(13,10), chr(13, 10)) END IF IF (p2=¤¤mn1ak3d) THEN PRINTR("*Success " & "Retaining changes made in module when passed byref" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Retaining changes made in module when passed byref" & " in " & "TESTVARIABLEBYTE" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p2, byval 0) & " but expected " & FORMAT(¤¤mn1ak3d, byval 0) & chr(13,10), chr(13, 10)) END IF PRINTR("-------", chr(13, 10)) END SUB
SUB QUERYVARIABLEDOUBLE(DOUBLE »p1, DOUBLE *p2) ¤SYSERR Err DOUBLE p1 = »p1 IF (p1=¤¤on16k3a) THEN PRINTR("*Success " & "Passing byval " & LCASE("DOUBLE") & " to a module" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Passing byval " & LCASE("DOUBLE") & " to a module" & " in " & "QUERYVARIABLEDOUBLE" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p1, byval 0) & " but expected " & FORMAT(¤¤on16k3a, byval 0) & chr(13,10), chr(13, 10)) END IF IF (p2=¤¤on16k3a) THEN PRINTR("*Success " & "Passing byref " & LCASE("DOUBLE") & " to a module" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Passing byref " & LCASE("DOUBLE") & " to a module" & " in " & "QUERYVARIABLEDOUBLE" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p2, byval 0) & " but expected " & FORMAT(¤¤on16k3a, byval 0) & chr(13,10), chr(13, 10)) END IF p2 = (¤¤mn1ak3a) END SUB
SUB TESTVARIABLEDOUBLE() ¤SYSERR Err DOUBLE p1 DOUBLE p2 p1 = ¤¤on16k3a p2 = ¤¤on16k3a IF (p1=¤¤on16k3a) THEN PRINTR("*Success " & "Default value assignation for " & LCASE("DOUBLE") & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Default value assignation for " & LCASE("DOUBLE") & " in " & "TESTVARIABLEDOUBLE" & "*" & chr(13,10), chr(13, 10)) PRINTR(" 3got " & FORMAT(p1, byval 0) & " but expected " & FORMAT(¤¤on16k3a, byval 0) & chr(13,10), chr(13, 10)) END IF QUERYVARIABLEDOUBLE(p1, p2) IF (p1=¤¤on16k3a) THEN PRINTR("*Success " & "Retaining original value after passed byval" & chr(13,10), chr(13, 10)) ELSE PRINTR("*Failure " & "Retaining original value a
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on May 24, 2019, 08:09:41 AM
Note: Rolled this back until i find another implementaton.
STDOUT " 71152315544 =" & STR$(34333224234233 and 3033233234430 mod 122343422244)
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on June 02, 2019, 07:49:27 AM
Maybe i am going too far from BASIC... ;D
Both examples are fully compilable with Oxygen and PowerBASIC.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on June 03, 2019, 09:19:16 PM
Posting this here just so that i dont forget, but it might change a bit:
TYPESIZE(obj)
When obj is a numeric datatype, like LONG, INT, QUAD, SINGLE, etc. It returns the number of bytes for the data type, for example BYTE returns 1, and QUAD returns 8. When obj is a string datatype like STRING, WSTRING, ASCIIZ, etc. (including JSON), it will always return 0, unless GUID is used, which will always return 16. When obj is a function, the datatype will be it's return data type, and the same rules as in case 1 and 2 will apply. When obj is a variable, the datatype will be the variable data-type, and the same rules as in case 1 and 2 will apply, except that in this case, if the variable is of a string datatype, TYPESIZE will return the length of the string definition. For example, for dynamic strings, it will return 0 (to know the length of the data stored in it, use LEN), and for fixed length strings it will return the fixed size, for example, for strings defined like this:
STRING s AS STRING * 20 TYPESIZE will return 20, even is the data stored in it use less characters. When obj is an user-defined-type, or a variable of an user-defined-type, TYPESIZE will return the size in bytes of the udt structure.
Almost forgot.... TYPESIZE also supports individual UDT members.
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Mike Lobanovsky on June 04, 2019, 08:21:07 PM
I wonder what exactly this operator is going to return in case of respective arrays?
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on June 05, 2019, 01:22:32 AM
I wonder what exactly this operator is going to return in case of respective arrays?
For the elements of an array, it behaves as it would with a variable.
Edit: I hastefully edited my previous post... I am thinking that for arrays TYPESIZE can return two different vallues, one for compilation-time, and another for run-time. This is not yet implemented, but it could return 0 if the array was not prevously (command-order wise, not execution wise) DIMmed, and 1 if the array was previously DIMmed. This would allow TYPESIZE to be used in COMPILE statements.
IF TYPESIZE(arr) COMPILE ' evaluates as true at compilation time ? "Size of array is " + STR$(TYPESIZE(arr)) ' gives exact array size at run time. ELSE ? "Hey you developer! Dimension this array first!" END IF As i said... this is not yet implemented but, it makes sense to me....
Title: Re: PluriBASIC - Progress of the implementation for Oxygen
Post by: Brian Alvarez on June 06, 2019, 01:58:43 AM
Notes about MACROTEMP and c++ style variable definition.
MACROTEMP does not (at the moment) support dimensioning variables using the c++ declariation style.
When using MACROTEMP variables in a macro, its easy to detech wich variables are being declared, and then converting them to temporary variables because the LOCAL, STATIC, GLOBAL, etc. declaration functions make it easy to detech which ones are being declared. But since TYPEs, STRUCTs, CLASSes and UNIONs are not parsed until macros are expanded (UDT's can also be generated dynamically), there is still not a clear idea of what variables are being declared that way. For example, in this code:
SOMEUDT a Is ambiguous... It could be a function or sub being invoked without brackets, using a as a parameter (becuase UDT's or modules are not yet parsed)...
Im sure i can find a way to make it work, but, for now, and until i find a way that pleases me, MACROVAR variables will require BASIC declaration methods and will not work with c++ mode.