IT-Berater: Theo Gottwald (IT-Consultant) > Brians Board
PluriBASIC - Progress of the implementation for Oxygen
Brian Alvarez:
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.
Brian Alvarez:
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...
Brian Alvarez:
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:
--- Code: ---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:
----------------
--- End code ---
Here is one for Oxygen (64 bits compilation):
--- Code: ---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:
----------------
--- End code ---
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:
--- Code: ---'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
--- End code ---
This is what it generates for Oxygen:
--- Code: ---'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
--- End code ---
Brian Alvarez:
Note: Rolled this back until i find another implementaton.
Added a few more operators:
--- Code: ---<< (shift left)
>> (shift right)
--- End code ---
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:
--- Code: ---? STR$(100 SHL 2)
--- End code ---
or:
--- Code: ---? STR$(100 << 2)
--- End code ---
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:
--- Code: ---STDOUT " 71152315544 =" & STR$(34333224234233 and 3033233234430 mod 122343422244)
--- End code ---
Brian Alvarez:
Maybe i am going too far from BASIC... ;D
Both examples are fully compilable with Oxygen and PowerBASIC.
Navigation
[0] Message Index
[#] Next page
[*] Previous page
Go to full version