This is the error line isolated, it compiles and runs fine.
'Generated with PluriBASIC DEMO version 6.0.6.302279
$ filename "C:\Users\Diam\Documents\PluriBASIC\Clean\ADDR.exe"
uses rtl64
%NoConsole
uses console
DIM STRING ?SYSTEM_UDT_OFFSETS(0)
' dimension offsets.
#DEF ?DIM1 (d1-bnd[1])
#DEF ?DIM2 (d2-bnd[3])
#DEF ?DIM3 (d3-bnd[5])
' dimension sizes (in elements)
#DEF ?DSZ1 dsz[1]
#DEF ?DSZ2 dsz[2]
#DEF ?DSZ3 dsz[3]
#DEF ?ARR_NAME_DEF class ?ARR_%1
STRING ?TMPS = "" ' a temporary string.
LONG ?CNTR = 0 ' a temporary counter.
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
'#if X64
'#DEF ?udt sys
'#else
#DEF ?udt sys ptr
'#endif
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
DECLARE FUNCTION ?WriteConsole LIB "KERNEL32.DLL" ALIAS "WriteFile" (BYVAL hFile AS SYS, lpBuffer AS ANY, BYVAL nNumberOfBytesToWrite AS dword, lpNumberOfBytesWritten AS dword, lpReserved AS long) AS LONG
DECLARE FUNCTION ?AllocConsole LIB "KERNEL32.DLL" ALIAS "AllocConsole" () AS LONG
DECLARE FUNCTION ?FlushFileBuffers LIB "KERNEL32.DLL" ALIAS "FlushFileBuffers" (BYVAL hFile AS SYS) AS LONG
DECLARE FUNCTION ?GetStdHandle LIB "KERNEL32.DLL" Alias "GetStdHandle" (ByVal nStdHandle AS DWORD) AS SYS
DECLARE SUB ?PRINTSTR(char c[], byval int cr)
' STARTS PLURIBASIC_PREPARE.BIN
' This code is executed before anything else, if you want to do something after defining other things, see PLURIBASIC_INIT
int ?i = 0
' STARTS SYSTEM_OPERATORS.BIN
'Initialize QUAD
function ?IQD(dword v1, v2) as quad
quad v = 0
copy(@v+0, @v2, 4)
copy(@v+4, @v1, 4)
return v
end function
FUNCTION ?BytOvf(byte b) AS byte
return b
END FUNCTION
FUNCTION ?NOT(byval quad v1) AS QUAD
dword w1
dword w2
quad r
copy @w1, @v1, 4
copy @w2, @v1+4, 4
w1 = not(w1)
w2 = not(w2)
copy @r, @w1, 4
copy @r+4, @w2, 4
return r
END FUNCTION
FUNCTION ?opAND(byval quad v1, v2) as quad
dword w1
dword w2
quad r
copy @w1, @v1, 4
copy @w2, @v2, 4
w1 = (w1 and w2)
copy @r, @w1, 4
copy @w1, @v1+4, 4
copy @w2, @v2+4, 4
w1 = (w1 and w2)
copy @r+4, @w1, 4
return r
end function
FUNCTION ?opOR(byval quad v1, v2) as quad
addr rcx,v1
addr rdx,v2
mov eax,[rcx]
or eax,[rdx]
mov [rcx],eax
mov eax,[rcx+3]
or eax,[rdx+3]
mov [rcx+3],eax
return v1
end function
FUNCTION ?opIMP(byval quad v1, v2) as quad
if v1 then return -1
if v2 then return -1
end function
FUNCTION ?opMOD(byval quad v1, v2) as quad
return mod((quad)v1, (quad)v2)
end function
FUNCTION ?opEXP(byval quad v1, v2) as extended
return v1 ^ v2
end function
FUNCTION ?opSHL(byval quad v1, v2) as quad
int i = 0
for i = 1 to v2
v1 = (v1 * 2)
next i
return v1
end function
FUNCTION ?opSHR(byval quad v1, v2) as quad
int i = 0
for i = 1 to v2
v1 = (v1 * 2)
next i
return v1
end function
FUNCTION ?opEQV(byval quad v1, v2) as quad
if v1=0 then return 0
if v2=0 then return 0
return -1
end function
macro ?mkcopy
end macro
macro dblcopy double(R,X)
r = x
end macro
' END OF SYSTEM_OPERATORS.BIN
' CONTINUES (20) PLURIBASIC_PREPARE.BIN
#DEF HANDLE SYS
' Tested, OK.
MACRO ?UDT_RESET(s, u)
copy(u, news(s), s)
END MACRO
' Tested, OK.
MACRO ?UDT_COPY(s, u, n)
copy(u, n, s)
END MACRO
' Tested, OK.
macro ?UDT_SETV(vu, ai, of, dt, nv, ln a, c)
sys a = vu.hBuffer + (ai + of)
dt c = nv
copy(a, @c, ln)
end macro
' Tested, OK.
macro ?UDT_SETA(vu, ai, of, nv, ln a, c)
sys a = ai + of
string c = left(nv, ln)
c = (c + news(ln-len(c)))
copy(a, strptr(c), ln)
end macro
'Tested, OK.
macro ?UDT_SETW(vu, ai, of, nv, ln a, c)
sys a = ai + of
wstring c = left(nv, ln)
c = (c + news(ln-len(c)))
copy(a, strptr(c), ln*2)
end macro
' Tested, OK.
macro ?MEM_SETV(vu, of, dt, nv, ln c)
dt c = nv
copy((@vu + of), @c, ln)
end macro
macro ?MEM_RUDV(vu, of, dt, nv, ln c)
dt c
copy((@vu + of), @c, ln)
end macro
' Tested, OK.
macro ?MEM_MODV(vu, of, dt, op, nv, ln c, e)
dt e
copy(@e, (@vu + of), ln)
dt c = e op nv
copy((@vu + of), @c, ln)
end macro
' Tested, OK.
macro ?MEM_SUBV(vu, of, dt, nv, ln c, e)
dt e
copy(@e, @vu + of, ln)
dt c = e - nv
copy(@vu + of, @c, ln)
end macro
' Tested, OK.
macro ?MEM_SETA(vu, of, nv, ln c)
string c = left(nv, ln)
c = (c + news(ln-len(c)))
copy(@vu + of, strptr(c), ln)
end macro
' Tested, OK.
macro ?MEM_SETW(vu, of, nv, ln c)
wstring c = left(nv, ln)
c = (c + news(ln-len(c)))
copy(@vu + of, strptr(c), ln*2)
end macro
' Tested, OK.
macro ?UDT_INCR(vu, ai, of, dt, nv a, c)
sys a = (vu.hBuffer + ai + of)
dt c = 0
copy(@c, a, sizeof(c))
c = (c + nv)
copy(a, @c, sizeof(c))
end macro
' Tested, OK.
macro ?UDT_DECR(vu, ai, of, dt, nv a, c)
sys a = (vu.hBuffer + ai + of)
dt c = 0
copy(@c, a, sizeof(c))
c = (c - nv)
copy(a, @c, sizeof(c))
end macro
' Tested, OK.
macro ?MEM_INCR(vu, of, dt, nv a)
dt a = 0
copy(@a, (@vu + of), sizeof(a))
a = (a + nv)
copy((@vu + of), @a, sizeof(a))
end macro
' Tested, OK.
macro ?MEM_DECR(vu, of, dt, nv a)
dt a = 0
copy(@a, @vu + of, sizeof(a))
a = (a - nv)
copy((@vu + of), @a, sizeof(a))
end macro
' Tested, OK.
macro ?SDT_VAL(nm, dt)
function nm(sys hBuffer, byval sys of) as dt
dt r
copy(@r, (hBuffer + of), sizeof(dt))
return (dt)r
end function
end macro
function ?TRIMNUL(string bb) as string
byte c at strptr(bb)
int i = 0
for i = 1 to len(bb)
if c[i] = 0 then
return left(bb, i-1)
end if
next i
return bb
end function
macro ?SDT_STR(nm)
function nm(sys hBuffer, offset, byval int ln) as string
sys addr = (hBuffer + offset)
if ln = 0 then ln = 255
string bb = space(ln+1)
copy(strptr(bb), addr, ln)
return ?TRIMNUL(bb)
end function
end macro
macro ?SDT_WST(nm)
function nm(sys hBuffer, of, byval int ln) as wstring
sys addr = (hBuffer + of)
if ln = 0 then ln = 255
wstring bb = news(ln)
copy(strptr(bb), addr, ln*2)
return bb
end function
end macro
TYPE ?SYSNMHDR
hwndFrom AS SYS
idFrom AS SYS
Code AS DWORD
END TYPE
class ?SYSF
' Default UDT member bounds...
function m(int d1) as long {return d1}
function m(int d1, d2) as long {return (d1 * d2)}
function m(int d1, d2, d3) as long {return ((d1 * d2) + d3)}
' Custom UDT member bounds...
' UDT member readers.
?SDT_VAL(byt, byte)
?SDT_VAL(wrd, word)
?SDT_VAL(int, int)
?SDT_VAL(lng, long)
?SDT_VAL(sys, sys)
?SDT_VAL(dwd, dword)
?SDT_VAL(qud, quad)
?SDT_VAL(ext, extended)
?SDT_VAL(cur, extended)
?SDT_VAL(cux, extended)
?SDT_VAL(sng, single)
?SDT_VAL(dbl, double)
?SDT_STR(asz)
?SDT_STR(chr)
?SDT_STR(str)
?SDT_WST(wsz)
FUNCTION CONSTRUCTOR()
END FUNCTION
function full() as string
return ""
end function
END CLASS
new ?SYSF EXE()
class IPOWERTIME
sub setInterface(string s)
end sub
sub now()
end sub
function FileTime() as quad
end function
end class
' The following are ASSEMBLY macros required for assembly to seamlesly work
' with basic...
macro asminit?
dword iebx?
dword eax?, ebx?, ecx?, edx?, esi?, edi?, ebp?
dword ?teax, ?tebx, ?tecx, ?tedx, ?tesi, ?tedi, ?tebp
mov iebx?, ebx
mov eax?, eax
mov ebx?, ebx
mov ecx?, ecx
mov edx?, edx
mov esi?, esi
mov edi?, edi
mov ebp?, ebp
end macro
macro push?
mov eax?, eax
mov ebx?, ebx
mov ecx?, ecx
mov edx?, edx
mov esi?, esi
mov edi?, edi
mov ebp?, ebp
mov ebx, iebx?
end macro
macro endasm?
mov ebx, iebx?
end macro
macro pop?(t)
mov eax, eax?
mov ebx, ebx?
mov ecx, ecx?
mov ebx, ebx?
mov esi, esi?
mov edi, edi?
mov ebp, ebp?
end macro
macro mov_n2r?(rg, vv, sr)
sr = 0
mov rg, vv
end macro
macro mov_v2r?(rg, vv, sr t?)
sr = 1
sys t? = (vv)
mov rg, t?
end macro
macro mov_p2r?(rg, vv, sr a)
sr = 1
sys a
a = (vv)
mov rg, a
end macro
macro mov_r2v?(vv, rg, sr a, b, c, d)
sys ptr b, a
cmp sr, 0
je d
cmp rg, 0
je c
mov a, rg
@b = a
vv = b
jmp c
d:
mov vv, rg
c:
end macro
' END OF PLURIBASIC_PREPARE.BIN
' STARTS ARRAY_DIM_UDT.BIN
' STARTS VARIANT_INIT.BIN
' END OF VARIANT_INIT.BIN
' CONTINUES (2) ARRAY_DIM_UDT.BIN
macro ?URFN(nm, dt)
function nm(int addr, of) as dt
sys a = hBuffer + (addr + of)
dt r
copy @r, a, sizeof(r)
return r
end function
end macro
macro ?URFL(nm, dt)
function nm(int addr, of) as dt*
sys a = hBuffer + addr + of
return a
end function
end macro
macro ?URFS(nm)
function nm(sys addr, of, ln) as string
sys a = hBuffer + addr + of
string bb = news(ln)
copy strptr(bb), a, ln
return bb
end function
end macro
macro ?URFW(nm)
function nm(sys addr, of, ln) as wstring
sys a = hBuffer + addr + of
wstring bb = news(ln)
copy strptr(bb), a, ln*2
return bb
end function
end macro
macro ?URFT(nm)
function nm(sys addr, of) as sys
sys a = addr + of
return a
end function
function nm(sys of) as sys
sys a = this.hBuffer + of
return a
end function
end macro
' Class for User-defined types.
macro ?TYPE_UDT_UDT(dtype)
?ARR_NAME_DEF(dtype)
public dtype t ' for use with typeof on this array.
public int u ' for use with some system functions (do not edit).
int dims ' Number of dimensions
int elems ' Number of elements.
int elemsize ' Number of elements.
int slength ' length of strings.
int ispointer ' is pointer flag.
sys hBuffer ' Address of the buffer
sys hCustAddr ' Address provided by the inline code.
int BuffLen ' length of the buffer in bytes
string dtType ' Data type for the array.
int iType ' Data type ID for the array.
int elemsize ' Data type size.
int dimensioned' -1 if dimensioned.
int bnd[10] ' bounds.
int dsz[10] ' dimension size.
int isAt = 0
public sys h
function redim(int sttc, redm, prsrv, int *d, n, isptr, slen, string dtyp, int dtID, dtsize, sys hAddr)
int i
dimensioned = -1
int ne = 1
int dn = 1
for i = 1 to n step 2
bnd[i+0] = d[i+0]
bnd[i+1] = d[i+1]
ne *= ((d[i+1]+1)-d[i+0])
dsz[dn] = (d[i+1]-d[i+0])+1
dn += 1
next
elems = ne
int nBufLen
nBufLen = (elems * elemsize)
if hAddr then
if isAt = 0 then
if hBuffer then
freememory hBuffer
end if
end if
isAt = 1
hBuffer = hAddr
else
sys nBuffer = getmemory(nBufLen + elemsize)
int eBfCopy = BuffLen
if BuffLen then
if BuffLen>nBufLen then
eBfCopy = nBufLen
end if
copy nBuffer, hBuffer, eBfCopy
if isAt = 0 then
freememory hBuffer
end if
end if
hBuffer = nBuffer
isAt = 0
end if
BuffLen = nBufLen
h = hBuffer
end function
method constructor() {}
method constructor(int sttc, redm, prsrv, int * d, n, isptr, slen, string dtyp, int dtID, dtSize, sys hAddr)
if sttc then
if (redm=0) then
if this.dims then return -1
end if
end if
ispointer = isptr
dtType = dtyp
slength = slen
hCustAddr = hAddr
iType = dtID
elemsize = dtSize
dims = n / 2
if n > -1 then
this.redim(sttc, redm, prsrv, d, n, isptr, slen, dtyp, dtID, dtSize, hAddr)
end if
end method
function destructor()
if isAt = 0 then
freememory(hBuffer)
hBuffer = 0
end if
BuffLen = 0
end function
function b() as string
return ""
end function
'======================================================================
function m(int d1) as long
return (?DIM1 * elemsize)
end function
function m(int d1, d2) as long
return ((?DSZ1 * ?DIM2) * elemsize) + (?DIM1 * elemsize)
end function
function m(int d1, d2, d3) as long
return ((?DSZ2 * ?DIM3) * elemsize) + ((?DSZ1 * ?DIM2) * elemsize) + (?DIM1 * elemsize)
end function
'======================================================================
function c(int d1) as dtype*
sys r = (hBuffer + this.m(d1))
return r
end function
function c(int d1, d2) as dtype*
sys r = (hBuffer + this.m(d1, d2))
return r
end function
function c(int d1, d2, d3) as dtype*
sys r = (hBuffer + this.m(d1, d2, d3))
return r
end function
'======================================================================
function p(int d1) as sys
sys r = (hBuffer + this.m(d1))
return r
end function
function p(int d1, d2) as sys
sys r = (hBuffer + this.m(d1, d2))
return r
end function
function p(int d1, d2, d3) as sys
sys r = (hBuffer + this.m(d1, d2, d3))
return r
end function
function ptr(int d1, of) as sys
sys a = (hBuffer + this.m(d1)) + of
return a
end function
'======================================all different data types.
?URFN(byt, byte)
?URFN(wrd, word)
?URFN(int, int)
?URFN(lng, long)
?URFN(dwd, dword)
?URFN(qud, quad)
?URFN(ext, extended)
?URFN(cur, extended)
?URFN(cux, extended)
?URFN(sys, sys)
?URFN(sng, single)
?URFN(dbl, double)
?URFS(asz)
?URFS(str)
?URFW(wst)
?URFT(udt)
'======================================all different data types.
function lbound(int d) as int
return bnd[(d*2)-1]
end function
function ubound(int d) as int
return bnd[d*2]
end function
method reset() ' everything.
string s = news(BuffLen)
copy(hBuffer, s, BuffLen)
end method
' method reset(sys n) ' specific element.
' string s = news(elemsize)
' copy(hBuffer + n, s, elemsize)
' end method
method reset(byval int e) ' specific element.
string s = news(elemsize)
copy(this.p(e), s, elemsize)
end method
method reset(byval int e, f) ' specific element.
string s = news(elemsize)
copy(this.p(e, f), s, elemsize)
end method
method reset(byval int e, f, g) ' specific element.
string s = news(elemsize)
copy(this.p(e, f, g), s, elemsize)
end method
function arrayattr(int d) as int
// not yet implemented.
if d = 0 then return dimensioned
if d = 1 then return iType
if d = 2 then return ispointer
if d = 3 then return dims
if d = 4 then return elems
if d = 5 then return elemsize
return 0
end function
end class
end macro
' END OF ARRAY_DIM_UDT.BIN
' STARTS ARRAY_DIM_NUM.BIN
' class for numeric arrays.
macro ?TYPE_NUM_UDT(dtype)
?ARR_NAME_DEF(dtype)
public dtype t ' for use with typeof on this array.
public string u ' for use with some system functions (do not edit).
dtype ptr dt
int dims ' Number of dimensions
int elems ' Number of elements.
int elemsize ' Number of elements.
int slength ' length of strings.
int ispointer ' is pointer flag.
sys hBuffer ' Address of the buffer
sys hCustAddr ' Address provided by the inline code.
int BuffLen ' length of the buffer in bytes
string dtType ' Data type for the array.
int iType ' Data type ID for the array.
int elemsize ' Data type size.
int dimensioned' -1 if dimensioned.
int bnd[10] ' bounds.
int dsz[10] ' dimension size.
int isAt = 0
int wcode
function redim(int sttc, redm, prsrv, int * d, n, isptr, slen, string dtyp, int dtID, int dtSize, sys hAddr)
int i
dimensioned = -1
int ne = 1
int dn = 1
for i = 1 to n step 2
bnd[i+0] = d[i+0]
bnd[i+1] = d[i+1]
ne *= ((d[i+1]+1)-d[i+0])
dsz[dn] = (d[i+1]-d[i+0])+1
dn += 1
next
if ne < elems then
if dtType = "STR" then
if hBuffer then
dtype dt at hBuffer
for i = ne+1 to elems
frees dt(i)
next
end if
end if
end if
elems = ne
int nBufLen
nBufLen = (elems * elemsize) + 500
if hAddr then
isAt = 1
hBuffer = hAddr
else
isAt = 0
sys nBuffer = getmemory(nBufLen)
int eBfCopy = BuffLen
if BuffLen
if BuffLen>nBufLen then
eBfCopy = nBufLen
end if
copy nBuffer, hBuffer, eBfCopy
freememory hBuffer
endif
hBuffer = nBuffer
endif
BuffLen = nBufLen
end function
method constructor() {}
method constructor(int sttc, redm, prsrv, int * d, n, isptr, slen, string dtyp, int dtID, int dtSize, sys hAddr)
if sttc then
if (redm=0) then
if this.dims then return -1
end if
end if
'start raw
'#if typecodeof(t) = 226
'#endif
'end raw
ispointer = isptr
dtType = dtyp
slength = slen
hCustAddr = hAddr
iType = dtID
elemsize = dtSize
dims = n / 2
if n > -1 then
this.redim(0, redm, prsrv, d, n, isptr, slen, dtyp, dtID, dtSize, hAddr)
end if
end method
function destructor()
int i
if isAt = 0 then
#if typecodeof(t) = 226
dtype dt at hBuffer
for i = 0 to elems
frees dt(i)
next
#elseif typecodeof(t) = 225
dtype dt at hBuffer
for i = 0 to elems
frees dt(i)
next
#endif
freememory(hBuffer)
hBuffer = 0
end if
BuffLen = 0
end function
function b() as string
return ""
end function
'======================================================================
function m(int d1) as long
return (?DIM1 * elemsize)
end function
function m(int d1, d2) as long
return ((?DSZ1 * ?DIM2) * elemsize) + (?DIM1 * elemsize)
end function
function m(int d1, d2, d3) as long
return ((?DSZ2 * ?DIM3) * elemsize) + ((?DSZ1 * ?DIM2) * elemsize) + (?DIM1 * elemsize)
end function
'======================================================================
'======================================================================
function c(int d1) as dtype
@dt = (hBuffer + this.m(d1))
'dtype ptr dt = (hBuffer + this.m(d1))
return dt
end function
function c(int d1, d2) as dtype
@dt = (hBuffer + this.m(d1, d2))
'dtype ptr dt = (hBuffer + this.m(d1, d2))
return dt
end function
function c(int d1, d2, d3) as dtype
@dt = (hBuffer + this.m(d1, d2, d3))
'dtype ptr dt = (hBuffer + this.m(d1, d2, d3))
return dt
end function
'======================================================================
'======================================================================
function s(int d1, dtype v)
@dt = (hBuffer + this.m(d1))
dt = v
end function
function s(int d1, d2, dtype v)
@dt = (hBuffer + this.m(d1, d2))
dt = v
end function
function s(int d1, d2, d3, dtype v)
@dt = (hBuffer + this.m(d1, d2, d3))
dt = v
end function
'======================================================================
'======================================================================
function p(int d1) as sys
return (hBuffer + this.m(d1))
end function
function p(int d1, d2) as sys
return (hBuffer + this.m(d1, d2))
end function
function p(int d1, d2, d3) as sys
return (hBuffer + this.m(d1, d2, d3))
end function
'======================================================================
'======================================================================
function strptr(int d1) as sys
@dt = (hBuffer + this.m(d1))
sys a = strptr(dt)
if a = 0 then dt = ""
'dtype ptr dt = (hBuffer + this.m(d1))
return strptr(dt)
end function
function strptr(int d1, d2) as sys
@dt = (hBuffer + this.m(d1, d2))
sys a = strptr(dt)
if a = 0 then dt = ""
'dtype ptr dt = (hBuffer + this.m(d1, d2))
return strptr(dt)
end function
function strptr(int d1, d2, d3) as sys
@dt = (hBuffer + this.m(d1, d2, d3))
sys a = strptr(dt)
if a = 0 then dt = ""
'dtype ptr dt = (hBuffer + this.m(d1, d2, d3))
return strptr(dt)
end function
'======================================================================
function lbound(int d) as int
return bnd[(d*2)-1]
end function
function ubound(int d) as int
return bnd[d*2]
end function
method clear() ' everything.
int i
int dn = 1
for i = 1 to 9 step 2
bnd[i+0] = -1
bnd[i+1] = -1
dsz[dn] = 0
dn += 1
next
this.reset()
end method
method reset() ' everything.
int i = 0
if dimensioned = 0 then return
#if typecodeof(t) = 226
for i = 0 to elems
@dt = (hBuffer + (i * elemsize))
dt = ""
next
#elseif typecodeof(t) = 225
for i = 0 to elems
@dt = (hBuffer + (i * elemsize))
dt = ""
next
#else
string s = news(BuffLen)
copy(hBuffer, s, elemsize)
#endif
return -1
end method
method reset(byval int e) ' specific element.
#if typecodeof(t) = 226
this.s(e, "")
#elseif typecodeof(t) = 225
this.s(e, "")
#else
this.s(e, 0)
#endif
end method
method reset(byval int e, f) ' specific element.
#if typecodeof(t) = 226
this.s(e, f, "")
#elseif typecodeof(t) = 225
this.s(e, f, "")
#else
this.s(e, f, 0)
#endif
end method
method reset(byval int e, f, g) ' specific element.
#if typecodeof(t) = 226
this.s(e, f, g, "")
#elseif typecodeof(t) = 225
this.s(e, f, g, "")
#else
this.s(e, f, g, 0)
#endif
end method
function arrayattr(int d) as int
// not yet implemented.
if d = 0 then return dimensioned
if d = 1 then return iType
if d = 2 then return ispointer
if d = 3 then return dims
if d = 4 then return elems
if d = 5 then return elemsize
return 0
end function
end class
end macro
' END OF ARRAY_DIM_NUM.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 STR$.BIN
FUNCTION STR$(long v, byref int d) as string
if v < 0 then
return str(v, 0)
else
return " " + str(v, 0)
end if
END FUNCTION
FUNCTION STR$(quad v, byref int d) as string
if v < 0 then
return str(v, 0)
else
return " " + str(v, 0)
end if
END FUNCTION
FUNCTION STR$(byref extended v, byref int d) as string
if v < 0 then
if @d then
return str(v, d)
else
return str(v)
end if
else
if @d then
return " " + str(v, d)
else
return " " + str(v)
end if
end if
END FUNCTION
FUNCTION STR$(long v) as string
if v < 0 then
return str(v, 0)
else
return " " + str(v, 0)
end if
END FUNCTION
FUNCTION STR$(quad v) as string
if v < 0 then
return str(v, 0)
else
return " " + str(v, 0)
end if
END FUNCTION
FUNCTION STR$(byref extended v) as string
if v < 0 then
return str(v)
else
return " " + str(v)
end if
END FUNCTION
' END OF STR$.BIN
' STARTS PRINTR.BIN
SUB ?INITCONSOLE()
STATIC Allc AS LONG
IF Allc=0 THEN
?AllocConsole()
Allc = 1
END IF
END SUB
MACRO ?STDOUT()
INT lWritten = 0
SYS hFile = 0
INT Btc = 0
hFile = ?GetStdHandle(-11)
if cr=1 then s += chr(13, 10)
if cr=2 then s += "</br>"
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), byval Len(TTsnd), lWritten, ByVal 0)
NEXT Btc
END MACRO
SUB ?PRINTASZ(ASCIIZ c[0], byval int cr)
STRING TTsnd = ""
string s = c
?STDOUT()
END SUB
' Note: In 64 bit, using string does not work.
SUB ?PRINTSTR(char c[], int cr)
STRING TTsnd = ""
STRING s = c
?STDOUT()
END SUB
SUB ?PRINTJSN(STRING c, byval int cr)
STRING TTsnd = ""
STRING s = c
?STDOUT()
END SUB
SUB ?PRINTSTZ(ZSTRING c[0], byval int cr)
STRING TTsnd = ""
STRING s = c
?STDOUT()
END SUB
SUB ?PRINTWST(WSTRING c, byval int cr)
STRING TTsnd = ""
STRING s = c
?STDOUT()
END SUB
SUB ?PRINTWSZ(WZSTRING c[0], byval int cr)
WSTRING TTsnd = ""
WSTRING 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 PEEK$.BIN
FUNCTION PEEK$(sys src, int l) as string
STRING b = news(l)
copy(strptr(b), src, l)
return b
END function
MACRO POKE$(d, dest, v b)
d b = v
copy(dest, strptr(b), len(b))
END MACRO
' END OF PEEK$.BIN
' STARTS CALLBACKDATA.BIN
' END OF CALLBACKDATA.BIN
TYPE COMPILATION
CHAR filler[53485]
LONG scope
END TYPE
TYPE MEMORIES
CHAR filler[180]
DWORD gjn
DWORD gjp
END TYPE
TYPE STRINGDATA
LONG a
LONG b
END TYPE
' SYSTEM CLASSES FOR ARRAYS:
?TYPE_UDT_UDT(MEMORIES)
?TYPE_UDT_UDT(STRINGDATA)
DECLARE FUNCTION ADDCACHEINIT(BYVAL P1 AS STRING, BYREF P2() AS ?ARR_STRINGDATA) AS STRING
DECLARE FUNCTION BUILDJS(BYREF P1() AS ?ARR_STRINGDATA, BYREF P2() AS ?ARR_STRINGDATA, BYREF P3 AS LONG) AS STRING
DECLARE FUNCTION PBMAIN() AS LONG
COMPILATION comp
new ?ARR_MEMORIES mems()
' Initializes various things in the program.
FUNCTION PluriBASIC_Initialize() AS LONG
END FUNCTION
FUNCTION ADDCACHEINIT(STRING ?s, ?ARR_STRINGDATA *sd) AS STRING
STRING ?RETVAL = ""
STRING s = ?s
?RETVAL = "HELLO WORLD"
RETURN ?RETVAL
END FUNCTION
FUNCTION BUILDJS(?ARR_STRINGDATA *sd, ?ARR_STRINGDATA *sc, LONG *n) AS STRING
STRING ?RETVAL = ""
STRING gensrvc
?PRINTSTR(STR$(n), 1)
gensrvc = (gensrvc & ADDCACHEINIT(PEEK$(mems.dwd(mems.m(EXE.lng(@comp, 53485)), (180)), (mems.dwd(mems.m(EXE.lng(@comp, 53485)), (184)) - mems.dwd(mems.m(EXE.lng(@comp, 53485)), (180)))), sd))
?RETVAL = gensrvc
RETURN ?RETVAL
END FUNCTION
FUNCTION PBMAIN() AS INT
INT ?RETVAL = 0
NEW ?ARR_STRINGDATA sd()
NEW ?ARR_STRINGDATA sc()
sd.constructor(0, 1, 0, int{0, 100}, countof, 0, 0, "UDT", 8, 8, 0)
sc.constructor(0, 1, 0, int{0, 100}, countof, 0, 0, "UDT", 8, 8, 0)
mems.constructor(0, 0, 0, int{0, 100}, countof, 0, 0, "UDT", 188, 188, 0)
?PRINTSTR(BUILDJS(sd, sc, LONG {1233}), 1)
RETURN ?RETVAL
END FUNCTION
PBMAIN() ' invoke entry point
