Theo's Forum
IT-Berater: Theo Gottwald (IT-Consultant) => Brians Board => Topic started 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$().
-
The HIXXX and LOXXX functions also support the HI and LO syntax, for example:
HI(BYTE, 9999)
and
LO(BYTE, 9999)
-
REPLACE [ANY] occurence$ WITH replacement$ IN TargetString$
Completed.
-
INSTR([Position&, ] SourceString$, [ANY] TargetString$)
Complete.
-
MID$ (function)
MID$ (statement)
Complete.
-
ITERATE FOR
Complete.
-
ITERATE DO
Complete.
-
REMAIN$(InputString$, [ANY] Target$)
RETAIN$(InputString$, [ANY] Target$)
REMOVE$(InputString$, [ANY] Target$)
Complete.
-
CHR$(CharCode? [TO CharCode?] [, CharCode? [TO CharCode?]])
Complete.
-
DIALOG NEW [PIXELS, | UNITS,] hParent&, Caption$, [x&], [y&], width&, height& [, [style&] [, [extendedstyle&]]] [,] TO hDlg&
DIALOG SHOW [MODAL | MODELESS] hDlg& [[,] CALL CallbackModule[()]] [TO lResult&]
Complete... almost.
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.
-
CONTROL SEND hDlg&, ctlID&, Message&, wParam&, lParam& [TO lResult&]
Complete.
-
CONTROL ADD [CONTROL | CustomControl$], hParent&, ControlID&, Caption$, X&, Y&, Width&, Height&[, Style& [, extStyle&]] [CALL CallbackProc[()]]
Supported controls:
BUTTON
LABEL
TEXTBOX
COMBOBOX
CHECKBOX
OPTION
Working on the rest.
-
Working great...
-
DIALOG END hWnd& [, lResult&]
Complete. ;D
-
DIM Arrayname([lBound& TO] lUpperBound& [, [lBound& TO] lUpperBound&]) [AS DATATYPE] [* Length&] [AT Address???]
Still need to do more tests, but it is mostly complete.
The Following DIM statements are valid:
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:
LBOUND()
UBOUND()
STRPTR()
For Example:
Bound& = UBOUND(MyArray)
Bound& = UBOUND(MyArray())
Bound& = UBOUND(MyArray(1))
Address??? = STRPTR(Array(-10, 9, 11))
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?
-
ARRAY SCAN array([startIndex&]) [FOR NumItems&] [, FROM firstChar& TO lastChar&] [, COLLATE {UCASE | charList$}], [= | < | >] stringExpression$, TO matchIndexNumber&
Complete... 90%
Still need to complete the COLLATE charlist$ feature, but its 2 am and im tired.
-
ARRAY SORT mainArray([firstElement&]) [FOR lastElement&][, FROM startChar& TO endChar&][, COLLATE {UCASE | charList$}][, TAGARRAY taggedArray()], {ASCEND | DESCEND}
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 COLLATE charlist$ is not complete.
-
SPACE$(numChars$)
Complete.
-
BUILD$(s$[, s$][, s$][, s$] [...])
Complete.
-
Thanxx Brian
you are doing very well
-
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. :)
-
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.
-
CHR$$
Complete. It has the same functionality as CHR$, but returns a unicode string.
-
Pointers progressed a lot today... ;D
-
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:
%MYEQUATE = 1
$MYEQUATE = "Hello World"
$$MYEQUATE = "Hello Europe and Asia"
ANSI string equates cannot contain unicode strings, or unicode portions, as follows:
$ANSI_EQUATE = "Some unicode string"$$
But unicode equates can, so, the following syntax is valid:
$$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:
%EquatePrefix.EquateMember
Equates can be used in conditional compilation as follows:
#IF %DEF(%SOMEQUATE)
#IF NOT %DEF(%SOMEQUATE)
#IF %SOMEQUATE = 1
#IF %SOMEQUATE = %ANOTHEREQUATE
#IF %SOMEQUATE => 3.1
Etc.
System equates:
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.
-
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.
-
TYPEOF(object)
TYPECODE(object)
Complete.
These are also available now for PowerBASIC 32 bit compilations.
-
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.
-
Hello Brian
Congratulations to you that you have mastered O2
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
-
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.
-
ARRAYATTR()
Semi complete. I need to make sure everything is absolutely correct.
Example:
DIM ids(10, 2, 2) as long
? STR$(ARRAYATTR(ids(), 3))
' returns 3
-
Behold... complex udt structures! :)
An element of an dimensional udt member of an array of UDT's being assigned a value.
-
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.
-
MIN
MIN%
MIN&
MIN$
MAX
MAX%
MAX&
MAX$
Complete.
Overrideable system UDTs and system equates.
Complete.
-
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.
-
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.
-
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...
-
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:
PluriBASIC 6.0.235861.0 for Windows, Copyright © 2010-2019 PluriBASIC® Inc.
PowerBASIC for Windows, Copyright (c) 1996-2018 PowerBasic Inc.
Primary source: C:\Users\Diamante\Documents\PluriBASIC\Clean\SMALLER.BAS {148 total lines}
Target conversion: SMALLER.exe (32 bits)
Conversion time: 0.0310 seconds, at 286,451 lines/minute.
Compilation time: 0.1200 seconds, at 159,499 lines/minute.
Generated code: 10.22 kb
Embedded objects: 0 bytes
Support code: 767 bytes
Other code: 902 bytes
------------------------------------
Source size: 11.85 kb
Compiled size: 24.00 kb
Component Files:
----------------
C:\Users\Diamante\Documents\PluriBASIC\Clean\SMALLER.BAS
Generated Files:
----------------
Here is one for Oxygen (64 bits compilation):
PluriBASIC6.0.235861.0 for Windows, Copyright © 2010-2019 PluriBASIC® Inc.
Oxygen Basic for Windows, Copyright © 2010-2019, Charles E V Pegge.
Primary source: C:\Users\Diamante\Documents\PluriBASIC\Clean\SMALLER.BAS {148 total lines}
Target conversion: SMALLER.exe (64 bits)
Conversion time: 0.0470 seconds, at 188,936 lines/minute.
Compilation time: 0.8610 seconds, at 56,585 lines/minute.
Generated code: 12.16 kb
Embedded objects: 0 bytes
Support code: 10.73 kb
Other code: 704 bytes
------------------------------------
Source size: 23.58 kb
Compiled size: 53.50 kb
Component Files:
----------------
C:\Users\Diamante\Documents\PluriBASIC\Clean\SMALLER.BAS
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.
Here's what PluriBASIC generates for PowerBASIC:
'Generated with PluriBASIC 6.0.235861.0
#COMPILE EXE
#DIM ALL
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:
'Generated with PluriBASIC 6.0.235861.0
$ filename "C:\Users\Diamante\Documents\PluriBASIC\Clean\SMALLER.exe"
uses rtl32
uses console
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
MACRO ERRCLEAR
Err.err = 0
Err.erl = 0
Err.ers = ""
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
FUNCTION ¤TERMINATE(string sText = "") as long
IF LEN(sText) THEN
MSGBOX(sText, 64)
END IF
sys hProcess = ¤OpenProcess(1, 0, ¤GetCurrentProcessId())
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
double d = dd
string nm = ""
string lpart = ""
string rpart = ""
string bformat = f
string oformat = ""
byte orig at strptr(bformat)
sys i = 0
sys i2 = 0
sys commas = 0
sys percent = 0
sys commaps = 0
sys decimal = 0
sys lzeroes = 0
sys tzeroes = 0
long np = 0
byte asterisc = 0
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
' integer
lpart = parse(nm, 0, ".", 1)
np = len(lpart)
'print nm
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
-
Note: Rolled this back until i find another implementaton.
Added a few more operators:
<< (shift left)
>> (shift right)
Those can also bse used as SHL or SHR. Those operators assume unsigned values for the moment.
These operators also work fine for PowerBASIC compilations. For Example:
? STR$(100 SHL 2)
or:
? STR$(100 << 2)
Oxygen already supports some of these as functions but now, also added support for these as operators in Oxygen compilations:
- IMP
- EQV (needs work for the bitwise part)
- ISTRUE
- ISFALSE
- NOT
- MOD
- AND
- OR
- XOR
Those work fine with QUADs and floating point values. For example:
STDOUT " 71152315544 =" & STR$(34333224234233 and 3033233234430 mod 122343422244)
-
Maybe i am going too far from BASIC... ;D
Both examples are fully compilable with Oxygen and PowerBASIC.
-
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.
-
I wonder what exactly this operator is going to return in case of respective arrays?
-
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.
DIM arr(10) AS STRING
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....
-
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:
MACROVAR a
LOCAL a AS SOMEUDT
It is easy to declare a as a MACROVAR or whatever type, even if the UDT type is not yet declared. But here:
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.