PluriBASIC - Progress of the implementation for Oxygen

[Brian Alvarez]

ARRAYATTR()

Semi complete. I need to make sure everything is absolutely correct.

Example:

Code Select Expand

DIM ids(10, 2, 2) as long

? STR$(ARRAYATTR(ids(), 3))

' returns 3

[Brian Alvarez]

Behold... complex udt structures! 

An element of an dimensional udt member of an array of UDT's being assigned a value.

[Brian Alvarez]

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.

[Brian Alvarez]

MIN
MIN%
MIN&
MIN$
MAX
MAX%
MAX&
MAX$

Complete.

Overrideable system UDTs and system equates.

Complete.

[Brian Alvarez]

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.

[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 Select Expand

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):

Code Select Expand

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:

Code Select Expand

'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:

Code Select Expand

'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

[Brian Alvarez]

Note: Rolled this back until i find another implementaton.

Added a few more operators:

Code Select Expand

<< (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:

Code Select Expand

? STR$(100 SHL 2)

or:

Code Select Expand

? 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:

Code Select Expand

STDOUT " 71152315544 =" & STR$(34333224234233 and 3033233234430 mod 122343422244)

[Brian Alvarez]

Maybe i am going too far from BASIC...

Both examples are fully compilable with Oxygen and PowerBASIC.

[Brian Alvarez]

 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:

Code Select Expand

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.

[Mike Lobanovsky]

I wonder what exactly this operator is going to return in case of respective arrays?

[Brian Alvarez]

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.

Code Select Expand


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....

[Brian Alvarez]

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:

Code Select Expand


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:

Code Select Expand

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.