Ops! I accdentally deleted my previous post. I have this PluriBASIC code:
#COMPILE EXE
#COMPILER oxygen
#OPTIONS X32 developer
#DIM ALL
%KW_FREEVAR = 1
%KW_INT_VALUE = 2
%KW_FLT_VALUE = 3
%KW_DATA_SIGN = 4
%KW_CRLF = 13
%KW_POUND = 21
%KW_META = 22
%KW_PERCENT = 23
%KW_INT_EQUATE = 24
%KW_DOLLAR = 25
%KW_STR_EQUATE = 26
%KW_MULTIPLY = 27
%KW_ADD = 28
%KW_SUBTRACT = 29
%KW_int_division = 30
%KW_flt_division = 31
Type DictionaryData
address as dword
length as integer
keyword as byte
reserved as integer
end type
Function tokenize(dictionary() as DictionaryData, sourceInput As String) As Long
#REGISTER None
Dim a As dword
Dim c As Long
Dim w As Long
Dim l As Long
Dim k As byte
Local addrPtr As Asciiz Ptr
addrPtr = strPtr(sourceInput)
Beggining:
! PUSH EBX
! MOV Edi, w
! MOV ESI, addrPtr
! MOV CL, 0
! MOV al, 0
CheckNext:
! MOV AL, [ESI]
! CMP AL, 32
! JNE wordStart
! INC ESI
! INC CL
! JMP CheckNext
wordStart:
! MOV edx, 0
' CRLF
! CMP AL, 13 ' Pass $CRLF
! JE foundCRLF13
! CMP AL, 10
! JE foundCRLF10
' A-Z
! CMP AL, 97 ; a .. z
! JL checkUpperALPHA
! CMP AL, 122
! JG checkUpperALPHA
! JMP foundALPHA
checkUpperALPHA:
! CMP AL, 65 ' A .. Z
! JL notALPHA
! CMP AL, 90
! JG notALPHA
! JMP foundALPHA
notALPHA:
' 0-9
! CMP AL, 48 ' 0 .. 9
! JL notNumeric
! CMP AL, 57
! JG notNumeric
! JMP foundNUMERIC
notNumeric:
! CMP AL, 35 ' #
! JE foundPound
! CMP AL, 37 ' %
! JE foundPercent
! CMP AL, 36 ' $
! JE foundDollar
! CMP AL, 42 ' *
! JE foundMultiply
! CMP AL, 43 ' +
! JE foundAdd
! CMP AL, 92 ' \
! JE foundIntDivision
! CMP AL, 47 ' /
! JE foundFltDivision
exit function
! INC esi
! JMP CheckNext
'=============================================================================
foundPound:
' Do not set keyword type yet!
! INC edx
! INC Cl
! INC ESI
! MOV AL, [ESI]
' CHECK IF A-Z
! CMP AL, 97 ; a .. z
! JL checkUpperALPHAPound
! CMP AL, 122
! JG checkUpperALPHAPound
! JMP foundALPHAPound
checkUpperALPHAPound:
! CMP AL, 65 ' A .. Z
! JL notALPHAPound
! CMP AL, 90
! JG notALPHAPound
! JMP foundALPHAPound
notALPHAPound:
! INC edx ; Incr word length
! INC ESI ; incr address
! MOV Ah, 21 ; Set keyword type KW_POUND
! JMP storeKEYWORD
foundALPHAPound:
! MOV Ah, 22 ; Set keyword type KW_META
! JMP continueALPHA
'=============================================================================
foundPercent:
' Do not set keyword type yet!
! INC edx
! INC Cl
! INC ESI
! MOV AL, [ESI]
' CHECK IF A-Z
! CMP AL, 97 ; a .. z
! JL checkUpperALPHAPercent
! CMP AL, 122
! JG checkUpperALPHAPercent
! JMP foundALPHAPercent
checkUpperALPHAPercent:
! CMP AL, 65 ' A .. Z
! JL notALPHAPercent
! CMP AL, 90
! JG notALPHAPercent
! JMP foundALPHAPercent
notALPHAPercent:
! INC edx ; Incr word length
! INC ESI ; incr address
! MOV Ah, 23 ; Set keyword type KW_PERCENT
! JMP storeKEYWORD
foundALPHAPercent:
! MOV Ah, 24 ; Set keyword type KW_INT_EQUATE
! JMP continueALPHA
'=============================================================================
foundDollar:
' Do not set keyword type yet!
! INC edx
! INC Cl
! INC ESI
! MOV AL, [ESI]
' CHECK IF A-Z
! CMP AL, 97 ; a .. z
! JL checkUpperALPHADollar
! CMP AL, 122
! JG checkUpperALPHADollar
! JMP foundALPHADollar
checkUpperALPHADollar:
! CMP AL, 65 ' A .. Z
! JL notALPHADollar
! CMP AL, 90
! JG notALPHADollar
! JMP foundALPHADollar
notALPHADollar:
! INC edx ; Incr word length
! INC ESI ; incr address
! MOV Ah, 25 ; Set keyword type KW_DOLLAR
! JMP storeKEYWORD
foundALPHADollar:
! MOV Ah, 26 ; Set keyword type KW_STR_EQUATE
! JMP continueALPHA
'=============================================================================
foundMultiply:
! MOV Ah, 27
! INC edx
! INC al
! INC ESI
! JMP storeKEYWORD
'=============================================================================
foundAdd:
! MOV Ah, 28
! INC edx
! INC al
! INC ESI
! JMP storeKEYWORD
'=============================================================================
foundSubtract:
! MOV Ah, 29
! INC edx
! INC al
! INC ESI
! JMP storeKEYWORD
'=============================================================================
foundIntDivision:
! MOV Ah, 30
! INC edx
! INC al
! INC ESI
! JMP storeKEYWORD
'=============================================================================
foundFltDivision:
! MOV Ah, 31
! INC edx
! INC al
! INC ESI
! JMP storeKEYWORD
'=============================================================================
foundCRLF13:
! MOV Ah, 13 ; set keyword type
! INC edx
! INC Cl
! INC ESI
! MOV AL, [ESI]
! CMP AL, 10
! JE foundCRLF10
! JMP storeKEYWORD
'=============================================================================
foundCRLF10:
! MOV Ah, 13 ; set keyword type
! INC edx
! INC Cl
! INC ESI
! JMP storeKEYWORD
'=============================================================================
foundNUMERIC:
! MOV Ah, 2 ; KW_INT_VALUE
! MOV bh, 0
continueNUMERIC:
! INC edx
! INC Cl
! INC ESI
! MOV AL, [ESI]
' 0-9
! CMP AL, 48 ' 0 .. 9
! JL checkDecimal
! CMP AL, 57
! JG checkDecimal
! JMP continueNUMERIC
checkDecimal:
! CMP AL, 46 ' .
! JE foundDecimal
! JMP storeKEYWORD
foundDecimal:
! INC bh
! CMP bh, 2 ; IF more than 1 decimal, end number
! JE foundFloatVal
! JMP continueNUMERIC
foundFloatVal:
! MOV Ah, 3 ; KW_FLT_VALUE
! JMP storeKEYWORD
'=============================================================================
foundALPHA:
! MOV Ah, 1 ; SET KW_FREEVAR
continueALPHA:
! INC edx
! INC Cl
! INC ESI
! MOV AL, [ESI]
' _
! CMP AL, 95 ; _
! JE continueALPHA
' a-z
! CMP AL, 97 ; a .. z
! JL checkUpperALPHA2
! CMP AL, 122
! JG checkUpperALPHA2
! JMP continueALPHA
checkUpperALPHA2:
' A-Z
! CMP AL, 65 ' A .. Z
! JL checkNumeric
! CMP AL, 90
! JG checkNumeric
! JMP continueALPHA
checkNumeric:
' 0-9
! CMP AL, 48 ' 0 .. 9
! JL doneWithALPHA
! CMP AL, 57
! JG doneWithALPHA
! JMP continueALPHA
doneWithALPHA:
! JMP storeKEYWORD
'=============================================================================
storeKEYWORD:
! inc edi
! MOV a, esi ; address
! MOV c, cl ; character number
! MOV l, edx ; word length
! MOV w, edi ; word number
! MOV k, ah ; keyword
dictionary(w).address = a
dictionary(w).length = l
dictionary(w).keyword = k
stdout "================="
stdout str$(w)
stdout str$(a)
stdout str$(c)
stdout str$(l)
stdout str$(k)
'exit function
! JMP CheckNext
End Function
FUNCTION PBMAIN() AS LONG
dim dictionary(9000000) as DictionaryData
local i as long
dim sourceCode as string = "this is a one hundred character #chars $tring to" & $crlf & "have a bettter idea of how fast the engine performs" & chr$(0)
stdout "-----"
stdout timer
'for i = 1 to 8390000
'for i = 1 to 320000
'for i = 1 to 1
tokenize(dictionary(), sourceCode)
'next
stdout timer
stdout "----2-"
END FUNCTION
Which gets converted to this:
'Generated with PluriBASIC 6.0.6.300021
$ filename "C:\Users\Diamante\Documents\PluriBASIC\Clean\tokenizer.exe"
uses rtl32
%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
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 PluriBASICGetTickCntTimer lib "kernel32.dll" alias "GetTickCount" () as dword
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(string 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 ¤AND2(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
macro ¤AND quad(r, v1, v2)
r = ¤AND2((quad)v1, (quad)v2)
end macro
FUNCTION ¤OR2(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
macro ¤OR quad(r, v1, v2)
r = ¤OR2((quad)v1, (quad)v2)
end macro
FUNCTION ¤IMP(byval quad v1, v2) as quad
if v1 then return -1
if v2 then return -1
end function
MACRO ¤EXP extended(r, v, e)
r = v ^ e
END MACRO
MACRO ¤MOD quad(r, v, e)
r = mod((quad)v, (quad)e)
END MACRO
FUNCTION ¤EQV(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
' 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.
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(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.
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) + 32
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
#if typecodeof(t) = 226
#endif
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))
return dt
end function
function c(int d1, d2) as dtype
@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))
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))
return strptr(dt)
end function
function strptr(int d1, d2) as sys
@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))
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 reset() ' everything.
int i = 0
#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 TIMER.BIN
// returns the number of seconds since midnight.
FUNCTION TIMER() AS DOUBLE
return (PluriBASICGetTickCntTimer() / 1000)
END FUNCTION
' END OF TIMER.BIN
' STARTS STRPTR.BIN
' no need.
' END OF STRPTR.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
' 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
SUB ¤PRINTSTR(string 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 CHR$.BIN
FUNCTION CHR$(byte ac[], n) AS STRING
int i, c
string oput
for i = 1 to n STEP 2
if ac[i] = 255 THEN
oput += chr(ac[i+1])
ELSE
if ac[i+1] < ac[i] then
for c = ac[i] to ac[i+1] step -1
oput += chr(c)
next c
else
for c = ac[i] to ac[i+1]
oput += chr(c)
next c
end if
END IF
next
return oput
end function
' END OF CHR$.BIN
' STARTS ASCIIZ.BIN
//Assigns a truncated null terminated string.
MACRO ¤ASCZ_SET(v, c, l)
if l < 2 then
copy0(@v, chr(0), 1)
else
copy0(@v, left(c, l-1), l)
end if
END MACRO
' END OF ASCIIZ.BIN
' STARTS CALLBACKDATA.BIN
' END OF CALLBACKDATA.BIN
TYPE DICTIONARYDATA
DWORD address
SHORT length
BYTE keyword
SHORT reserved
END TYPE
' SYSTEM CLASSES FOR ARRAYS:
¤TYPE_UDT_UDT(DICTIONARYDATA)
DECLARE FUNCTION TOKENIZE(P1() AS ¤ARR_DICTIONARYDATA, P2 AS STRING) AS LONG
DECLARE FUNCTION PBMAIN() AS LONG
' Initializes various things in the program.
FUNCTION PluriBASIC_Initialize() AS LONG
END FUNCTION
FUNCTION TOKENIZE(¤ARR_DICTIONARYDATA *dictionary, STRING *sourceinput) AS LONG
LONG ¤RETVAL = 0
¤SYSERR Err
DWORD a
LONG c
LONG w
LONG l
BYTE k
ASCIIZ PTR addrptr
@addrptr = (STRPTR(sourceinput))
push ebx
mov edi, w
mov esi, addrptr
mov cl, 0
mov al, 0
checknext:
mov al, [esi]
cmp al, 32
jne wordstart
inc esi
inc cl
jmp checknext
wordstart:
mov edx, 0
cmp al, 13
je foundcrlf13
cmp al, 10
je foundcrlf10
cmp al, 97
jl checkupperalpha
cmp al, 122
jg checkupperalpha
jmp foundalpha
checkupperalpha:
cmp al, 65
jl notalpha
cmp al, 90
jg notalpha
jmp foundalpha
notalpha:
cmp al, 48
jl notnumeric
cmp al, 57
jg notnumeric
jmp foundnumeric
notnumeric:
cmp al, 35
je foundpound
cmp al, 37
je foundpercent
cmp al, 36
je founddollar
cmp al, 42
je foundmultiply
cmp al, 43
je foundadd
cmp al, 92
je foundintdivision
cmp al, 47
je foundfltdivision
RETURN ¤RETVAL
inc esi
jmp checknext
foundpound:
inc edx
inc cl
inc esi
mov al, [esi]
cmp al, 97
jl checkupperalphapound
cmp al, 122
jg checkupperalphapound
jmp foundalphapound
checkupperalphapound:
cmp al, 65
jl notalphapound
cmp al, 90
jg notalphapound
jmp foundalphapound
notalphapound:
inc edx
inc esi
mov ah, 21
jmp storekeyword
foundalphapound:
mov ah, 22
jmp continuealpha
foundpercent:
inc edx
inc cl
inc esi
mov al, [esi]
cmp al, 97
jl checkupperalphapercent
cmp al, 122
jg checkupperalphapercent
jmp foundalphapercent
checkupperalphapercent:
cmp al, 65
jl notalphapercent
cmp al, 90
jg notalphapercent
jmp foundalphapercent
notalphapercent:
inc edx
inc esi
mov ah, 23
jmp storekeyword
foundalphapercent:
mov ah, 24
jmp continuealpha
founddollar:
inc edx
inc cl
inc esi
mov al, [esi]
cmp al, 97
jl checkupperalphadollar
cmp al, 122
jg checkupperalphadollar
jmp foundalphadollar
checkupperalphadollar:
cmp al, 65
jl notalphadollar
cmp al, 90
jg notalphadollar
jmp foundalphadollar
notalphadollar:
inc edx
inc esi
mov ah, 25
jmp storekeyword
foundalphadollar:
mov ah, 26
jmp continuealpha
foundmultiply:
mov ah, 27
inc edx
inc al
inc esi
jmp storekeyword
foundadd:
mov ah, 28
inc edx
inc al
inc esi
jmp storekeyword
mov ah, 29
inc edx
inc al
inc esi
jmp storekeyword
foundintdivision:
mov ah, 30
inc edx
inc al
inc esi
jmp storekeyword
foundfltdivision:
mov ah, 31
inc edx
inc al
inc esi
jmp storekeyword
foundcrlf13:
mov ah, 13
inc edx
inc cl
inc esi
mov al, [esi]
cmp al, 10
je foundcrlf10
jmp storekeyword
foundcrlf10:
mov ah, 13
inc edx
inc cl
inc esi
jmp storekeyword
foundnumeric:
mov ah, 2
mov bh, 0
continuenumeric:
inc edx
inc cl
inc esi
mov al, [esi]
cmp al, 48
jl checkdecimal
cmp al, 57
jg checkdecimal
jmp continuenumeric
checkdecimal:
cmp al, 46
je founddecimal
jmp storekeyword
founddecimal:
inc bh
cmp bh, 2
je foundfloatval
jmp continuenumeric
foundfloatval:
mov ah, 3
jmp storekeyword
foundalpha:
mov ah, 1
continuealpha:
inc edx
inc cl
inc esi
mov al, [esi]
cmp al, 95
je continuealpha
cmp al, 97
jl checkupperalpha2
cmp al, 122
jg checkupperalpha2
jmp continuealpha
checkupperalpha2:
cmp al, 65
jl checknumeric
cmp al, 90
jg checknumeric
jmp continuealpha
checknumeric:
cmp al, 48
jl donewithalpha
cmp al, 57
jg donewithalpha
jmp continuealpha
donewithalpha:
jmp storekeyword
storekeyword:
inc edi
mov a, esi
mov c, cl
mov l, edx
mov w, edi
mov k, ah
¤UDT_SETV(dictionary, dictionary.m(w), (0), DWORD, (a), 4)
¤UDT_SETV(dictionary, dictionary.m(w), (4), INTEGER, (l), 2)
¤UDT_SETV(dictionary, dictionary.m(w), (6), BYTE, ¤BytOvf(k), 1)
¤PRINTSTR("=================", 1)
¤PRINTSTR(STR$(w, null), 1)
¤PRINTSTR(STR$(a, null), 1)
¤PRINTSTR(STR$(c, null), 1)
¤PRINTSTR(STR$(l, null), 1)
¤PRINTSTR(STR$(k, null), 1)
jmp checknext
RETURN ¤RETVAL
END FUNCTION
FUNCTION PBMAIN() AS INT
INT ¤RETVAL = 0
NEW ¤ARR_DICTIONARYDATA dictionary()
LONG i
STRING sourcecode
dictionary.constructor(0, 1, 0, int{0, 9000000}, countof, 0, 0, "UDT", 9, 9, 0)
sourcecode = "this is a one hundred character #chars $tring to" & chr(13)+chr(10) & "have a bettter idea of how fast the engine performs" & CHR$(byte {-1, 0}, countof)
¤PRINTSTR("-----", 1)
¤PRINTSTR(STR$(TIMER(), null), 1)
TOKENIZE(dictionary, sourcecode)
¤PRINTSTR(STR$(TIMER(), null), 1)
¤PRINTSTR("----2-", 1)
RETURN ¤RETVAL
END FUNCTION
PBMAIN() ' invoke entry point
But i cant get it to run. Im guessing the conversion is wrong, is there some oxygen guide i can follow to correct it?
Thanks!
