Oxygen Basic
Programming => Problems & Solutions => Topic started by: Brian Alvarez on August 19, 2020, 05:49:08 AM
-
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!
-
Looks okay. Intel notation is highly standardised, but watch out for 64-bit conversion, especially for registers used for addressing.
You will also need to protect the bl/bh/bx/ebx/rbx register in o2, since it is used to reference all static and global vars and library functions.
-
By protecting you mean back up and restore when going in and out of a sub/function or statements?
! PUSH EBX
! PUSH RBX
-
Instead of pushing and popping, which can mess with your stack order, you can save register values to local variables.
(local variables are referenced from the rbp register)
Also, specifically in o2 assembler, 64bit registers downgrade to 32bit in 32bit mode, so rbx converts to ebx. This feature can help with creating compatible assembler.
sys trbx
...
mov trbx, rbx
...
mov rbx,trbx
-
I am by no means an expert in assembly, but I think i get it.... ill give it a try. Thanks! :)
-
specifically in o2 assembler, 64bit registers downgrade to 32bit in 32bit mode, so rbx converts to ebx. This feature can help with creating compatible assembler.
So, i can generate always the same registers to avoid having to output platform specific ones... does it have a speed penalty at compilation?
-
No significant speed penalty.
-
This crashes before i can do anything hader that setting values into registers...
dword a
asciiz ptr b
mov edi, a
mov esi, b
It seems like it doesnt like asciiz pointers on ESI. How can i achieve this?
If i use @b i get this error:
ERROR: Linker found unidentified names:
2228 @ "main source
This works but i rater not use a jumper variable...
dword a
asciiz ptr b
dword bb = @b
mov edi, a
mov esi, bb
mov ebx, esi ' then this crashes my executable :(
-
The best way to pass the address of any variable, other than direct integers, is to use o2's addr pseudo-instruction. This will automatically resolve the strptr.
addr esi, b
Remember to restore the ebx register before doing any more Basic
-
Nothing i have tried is working. It always crashes at:
mov ebx, esi
I want esi to contain the current character i have parsed so far, and i want ebx to contain the address of the starting of the word. esi increases with every character, but ebx should only increase after the word has finished, so that it contains the address of the beggining of the next word.
'push ebx
addr esi, b ' ending address
'pop ebx
mov ebx, esi ' starting address
I have no idea. Can you show me?
-
You must restore ebx to its original value at the end of the assembler sequence, before doing any more Basic.
Also, changing the ebx register is not thread-safe in a multithread environment.
You may be better off using local variables instead of bl/bh/bx/ebx/rbx.
BTW: Low level o2 Basic is at least 90% efficient compared to Assembler.
-
You must restore ebx to its original value at the end of the assembler sequence, before doing any more Basic.
Thanks, I thought you meant after the addr pseudo-instruction.
Also, changing the ebx register is not thread-safe in a multithread environment.
I removed the thread with no change in behaviour.
You may be better off using local variables instead of bl/bh/bx/ebx/rbx.
I will eventually get to the point of also testing variables (if i dont tilt the desk first), but since i am doing this to achieve asm conversions, that is not an option with this code.
BTW: Low level o2 Basic is at least 90% efficient compared to Assembler.
Since i am doing this to achieve asm conversions, using basic is not an option.
The problem remains:
mov ebx, esi
Crash.
-
The crash will only occur when o2 accesses the ebx register containing the wrong value.
What corrections/modifications have you made so far?
-
What corrections/modifications have you made so far?
Not much i can do, i cant get past that line.
Before i thought oxygen was compiling all the assembly but i think it is crashing in the middle of the assembly compilation.
-
I can see a few wonky bits. Try someting simpler, and follow my instructions regarding ebx.
-
Thanks Charles, ill give it another go this afternoon.
-
mods in Tokenize:
at the start:
' ASCIIZ PTR addrptr
' @addrptr = (STRPTR(sourceinput))
sys addrptr=STRPTR(sourceinput)
push ebx
mov edi, w
mov esi, addrptr
at the end:
storekeyword:
inc edi
mov a, esi
mov c, cl
mov l, edx
mov w, edi
mov k, ah
pop ebx
mbox "ok1"
¤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
'can't get here with that jump
mbox "ok2"
RETURN ¤RETVAL
END FUNCTION
-
Ok i think i got the conversions working. I now need to convert the behavior of MOV for BASIC. It makes no sense, i think the guides are oudated...
In some flavors MOV passes the variable byval and in order to pass its address to a register it requires LEA... in such cases INC increases its value and you can move the value back to a variable using MOV back. Makes sense.
In some other codes, using MOV pasess the address of the variable to a register, and using INC increases the address. It requires a special syntax to increase its value (INC with the address directly does nothing) and LEA is not required... This also makes sense but i dont know what guide to follow.
-
Yup. The sample tokenizer now compiles fine for PowerBASIC and Oxygen without tweakings required. Ill try some benchmarks later. :)
-
A typical direct local variable might be [ebp-108] and lea (load effective address) would resolve its absolute address by subtracting 108 from the ebp value, and storing this value in the target register.
lea ecx,[ebp-108]
you could now use [ecx] to access the variable.
mov eax,[ecx]
...
inc ecx 'next byte
-
Thanks Charles, I think I have implemented that and few other tricks. However i have a question. I can do,
mov ebx, dwordvar
I can also do:
mov ch, [esi]
and:
mov ch, 64
But i am having problems doing:
mov ch, bytevar
How can i pass a byte value from a byte variable into the subregister ch and the other 8 bit ones? I imagine i can create a copy into another register, but is there a more direct way without creating a copy?
-
Basically i am doing this (see image attached).
I am backing up and restoring registers correctly between ASM/BASIC code.
s is a byte variable.
mov ch, s
But it doesnt seem to work.
The whole rest works marvelously! :)
-
How have you defined s. Is it a direct integer or byte?
-
It is defined as:
byte s
-
is s local? If not, assign to a local byte.
-
Got it. It worked. :)
-
Watching you guys work together is better than going to the movies. 8)
-
PowerBASIC's TIMER function displays slightly different measurements, but so far Oxygen is leading the benchmarks. :o :o :o :o
Hopefully this keeps like this when i fiish debugging completely the conversions and i test using GetTickCount(). :)
-
It would be interesting to see how FreeBasic compares between PB and O2.
Would BCX be a good reference to use as a C translated BASIC?
-
In FreeBasic, Assembler blocks require asm .. end asm, and the variable names are contained within square brackets.
thus:
dim as long a
asm
mov eax,[a]
inc eax
mov [a],eax
end asm
...
[code]
-
dim as long a
asm
mov eax,[a]
inc eax
mov [a],eax
end asm
I forget that FB is O2's mum. Uncle SB seems to have had an influence.
-
Charles, i am experiencing a weird issue for which (yet again) i have no explanation. This is some output of the sample tokenizer i made:
-----------------------
TOKEN===>INCLUDES
PEEK ADDRESS: 6216514
LENGTH => 8
strptr(contents(12)) => 6212828 ' 12 is the include file #12.
-----------------------
RECALL===>uriBASIC
PEEK ADDRESS: 6216514
LENGTH => 8
strptr(contents(12)) => 6212828 ' 12 is the include file #12.
The top portion is output during the parsing step, it correctly displays the parsed word, its address and its length. It also displays the address of the array's string element that holds the data.
The bottom portion is output after about 430000 words have been parsed. It displays incorrectly the parsed word, but its address and its length are correct. It also displays the address of the array's string element that holds the data using strptr, and apparently the array's string element address is still the same.
The addresses and lengths of the indexed words are retained correctly... but the parsed word differs even if the string is still in the same address...
The parsing and the displaying is performed in a different function, could it be that Oxygen is doing something funny to the string even though it's address (and AFAIK its contents) is the same?
By the way, this is what my PEEK$ function looks like:
FUNCTION PEEK$(sys src, int l) as string
STRING b = news(l)
copy(strptr(b), src, l)
return b
END function
-
Long shot:
How does available memory look like? (leak?)
-
No apparent memory leaks... but i also suspect there could be one. Im still baffled at how the addresses match, i can print the strings... yet, copy brings the text from god knows where...
I will find it.
-
This may be unrelated but O2 would randomly leave cells in the IUP matrix control blank for no reason. When I switch to VB6 my grid problems went away.
-
The original PB tokenizer code looks a bit strange. How does it exit the tokenize function?
Does it work by accident?
-
Does it work by accident?
Dead Code Call (https://youtu.be/QcbR1J_4ICg)
-
The original PB tokenizer code looks a bit strange. How does it exit the tokenize function?
Does it work by accident?
Yes, it was unfinished. I have a more complete one now, i will post it later today.
Edit: I am finding very interesting stuff! Ill upload this in a few days. :D
-
Well, i think i have finally debugged it completely and I am runnning some benchmarks of Oxygen Vs PowerBASIC.
Both perform perfectly fine and VERY fast, but I think there is still space for improvement in the Oxygen conversion.
Here are the preliminar results (before optimization):
Compiled with: PowerBASIC for Windows 32bits
-----
Word Count: 399998
Files Count: 65
Start Time: 919284250
End Time: 919284265
Total Time: 15
-----
Compiled with: OxygenBASIC 32bits
-----
Word Count: 399998
Files Count: 65
Start Time: 919298890
End Time: 919298921
Total Time: 31
-----
Compiled with: OxygenBASIC 64bits
-----
Word Count: 399998
Files Count: 65
Start Time: 919308562
End Time: 919308625
Total Time: 63
-----
-
What are the 64 bit results?
🤔
-
What do you mean? The're on the list, scroll to bottom.
-
Well, the small speed penalty doesnt seem to come from the assebly conversion, it comes from the OPEN/CLOSE functions. My conversions seem to be slightly slower. :)
-
Are you basing your functions on fopen and fclose ? (msvcrt.dll)
-
What do you mean? The're on the list, scroll to bottom.
Oops!
Didn't scroll the window. My bad.
-
Are you basing your functions on fopen and fclose ? (msvcrt.dll)
No, i made my own functions using CreateFileA() and CreateFileW() directly.
-
Another long shot but does your functions enable explicit locks?
-
The OPEN statement does support the syntax for:
OPEN FILENAME fn$/HANDLE hn& FOR [BINARY/INPUT/OUTPUT/APPEND/RANDOM] [ACCESS READ/WRITE] [LOCK SHARED/READ/WRITE] [AS #FN] [LEN=recordsize] [BASE=base] [CHR= ANSI|WIDE]
But i think i have not yet implemented the LEN functionality.
-
Brian,
Can you attach your PluriBASIC benchmark code to a post?
I would like to see what you are testing.
Thanks!
-
I cant. My code is disassebled (pun intended) at the moment. I found some neat tricks i need to implement and i am doing so. Assembly will end up being awesome.
I am at the moment chasing a miscompatibility with Oxygen 2.9, i should retake oxygen soon.
-
Let me know when you have a stable release of PluriBASIC to try.
-
I have one every full moon, but right now asm is dismantled and getting put together in a cool way.
I could make it work for this benchmark but i rather benchmark it with the full set of features.
For example, did you know that in PB you can do...
! mov esi, mylongvar
And...
! mov esi, 2000
And when you do this...
! mov mylongvar, esi
Will act differently depending on what you stored in ESI?
If a literal value was stored in esi, the literal value will be read. if a variable was stored in it, the value stored in the variable whose address is stored in esi will be set to mylongvar.
That is one cool feature! but how can the assembly know if a variable address or a literal value is stored in esi? Well... thats a story for another day!
-
When I look at ASM all I see is Brainfuck code. 🥴
-
https://software.intel.com/content/www/us/en/develop/articles/intel-sdm.html
Volume 2 of the 4-volume set provides an A..Z description of all the x86 instructions and their addressing modes. Very detailed.
'SOME ADDRESSING MODES
mov eax,2000 'immediate
mov eax,esi 'direct addressing
mov eax,[ebp] 'indirect addressing
mov eax,[ebp+4] ' indirect addressing with offset (used as variables)
-
WHat do you think of PowerBASIC's approach Charles?
-
It's based on standard Intel notation, but missing a few instructions, as I recall. I last used it about 14 years ago.
-
I haven't touched PowerBasic in over 20 years.
I felt Zale was a greedy con man.