'---------------------------------
'USING SBO2 WITH SCRIPTBASIC DYC
'---------------------------------
'ScriptBasic
module dyc
declare sub ::dyc alias "dyc" lib "dyc"
end module
'OXYGEN SOURCE CODE
'------------------
send="""
print "Greetings from Embedded Compiled Oxygen Program"
""" & chr$(0)
bufferlength=1000
receive=space(bufferlength)
replylength=dyc::dyc("ms,i,sbo2.dll,run,ZZL",send,receive,bufferlength)
'print replylength
print left(receive,replylength)
line input w
'COMPILING WITH INDEPENDENT RUN TIME LIBRARY
#file "sbo2.dll" 'COMPILING WITH OXYGEN'S RUN TIME LIBRARY
library "oxygen.dll"
declare sub o2_asmo (byval s as string)
declare sub o2_basic (byval s as string)
declare function o2_buf (byval n as long) as long
declare function o2_errno () as long
declare function o2_error () as string
declare function o2_exec (optional byval p as long) as long
declare function o2_get () as string
declare function o2_len () as long
declare function o2_prep (byval srcBSTR as string) as string
declare sub o2_put (byval c as string)
declare function o2_view (byval srcBSTR as string) as string
library ""
'----------------------------------------------------------------------
function message(sys send, sys receive, sys bufferlength) as sys export
'======================================================================
'
zstring * z : &z=send
print z
'
s="Greetings from sbo2 oxygen!"
replylength=len s
if replylength>bufferlength then replylength=bufferlength
copy receive, *s, replylength
return replylength
end function
'------------------------------------------------------------------
function run(sys send, sys receive, sys bufferlength) as sys export
'==================================================================
'
zstring * z : &z=send
string c=z
string s=""
o2_asmo c
if o2_errno then
s=o2_error
else
o2_exec
s="Okay"
end if
'
replylength=len s
if replylength>bufferlength then replylength=bufferlength
copy receive, *s, replylength
return replylength
end function
'---------------------------------
'USING OXYGEN WITH SCRIPTBASIC DYC
'---------------------------------
'ScriptBasic
import dyc.bas
'OXYGEN SOURCE CODE
'------------------
src="""
print "Greetings from OxygenBasic!"
""" & chr$(0)
dyc::dyc("ms,i,OXYGEN.DLL,o2_mode,L",0)
dyc::dyc("ms,i,OXYGEN.DLL,o2_basic,Z",src)
'how do we make dll calls that have no arguments?
'TRY THIS
e=dyc::dyc("ms,i,OXYGEN.DLL,o2_error,C")
'e=0
if e=0 then
dyc::dyc("ms,i,OXYGEN.DLL,o2_exec,L",0)
endif
declare sub dll alias "dyc" lib "dyc"
src="""
def q 10
single v[q]<=(9,8,7,6,5,4,3)
single tot
for i=1 to q
tot+=v[i]
next
print "Number: " q " Total: " v " Average: " str(v/q)
""" & 0x0
dll("ms,i,OXYGEN.DLL,o2_mode,L",0)
dll("ms,i,OXYGEN.DLL,o2_basic,Z",src)
dll("ms,i,OXYGEN.DLL,o2_exec,L",0)
declare sub dll alias "dyc" lib "dyc"
'OXYGEN SOURCE CODE
'------------------
prog="""
tab=chr 9
crlf=chr(13)+chr(10)
single v=(1 2 3 4)*2+1.25
bstring s="result:" tab str(v) crlf
mov eax,s 'direct return (the string will be copied back to SB)
""" & chr$(0)
bufferlength=1000
receive=space(bufferlength)
replylength=dll("ms,i,sbo2.dll,run,ZZL",prog,receive,bufferlength)
v=0
'print left(receive,replylength)
a=instr(receive,"result:")
if (a>0)and(a<replylength) then
v=val(mid(receive,a+8,20))
end if
print v*2
line input w
DECLARE SUB DLL ALIAS "_idll" LIB "gtk-server"
DECLARE SUB REQUIRE ALIAS "_idll_require" LIB "gtk-server"
DECLARE SUB DEFINE ALIAS "_idll_define" LIB "gtk-server"
REQUIRE "libiDLL.so"
DEFINE "sb_new NONE POINTER 0"
DEFINE "scriba_LoadConfiguration NONE INT 2 POINTER STRING"
DEFINE "scriba_SetFileName NONE INT 2 POINTER STRING"
DEFINE "scriba_Run NONE INT 2 POINTER STRING"
DEFINE "scriba_LoadSourceProgram NONE INT 1 POINTER"
DEFINE "scriba_destroy NONE NONE 1 POINTER"
pProgram = DLL("sb_new")
DLL("scriba_LoadConfiguration " & pProgram & " \"/etc/scriba/basic.conf\"")
DLL("scriba_SetFileName " & pProgram & " \"E01.sb\"")
DLL("scriba_LoadSourceProgram " & pProgram)
DLL("scriba_Run " & pProgram & " \"JRS\"")
DLL("scriba_destroy " & pProgram)
cmd = COMMAND()
PRINT "ARG = ",cmd,"\n"
FOR x = 1 TO 10
PRINT x,"\n"
NEXT
' SQLite3 Test Script
DECLARE SUB DLL ALIAS "_idll" LIB "gtk-server"
DECLARE SUB REQUIRE ALIAS "_idll_require" LIB "gtk-server"
DECLARE SUB DEFINE ALIAS "_idll_define" LIB "gtk-server"
DECLARE SUB VARPTR ALIAS "varptr" LIB "gtk-server"
REQUIRE "libsqlite3.so"
DEFINE "sqlite3_open NONE INT 2 STRING LONG"
DEFINE "sqlite3_exec NONE INT 5 LONG STRING INT NULL PTR_STRING"
DEFINE "sqlite3_prepare_v2 NONE INT 5 LONG STRING INT PTR_LONG NULL"
DEFINE "sqlite3_step NONE INT 1 LONG"
DEFINE "sqlite3_column_text NONE STRING 2 LONG INT"
DEFINE "sqlite3_close NONE INT 1 LONG"
CONST SQLITE_ROW = 100
db = 0
dberr = 0
stmt = 0
DLL("sqlite3_open \"testsql\" " & VARPTR(db))
errmsg = DLL("sqlite3_exec " & db & " \"CREATE TABLE demo(someval INTEGER, sometxt TEXT);\" 0 0 " & VARPTR(dberr))
PRINT "DB ERROR: ",errmsg,"\n"
DLL("sqlite3_exec " & db & " \"INSERT INTO demo VALUES (123, 'Hello');\" 0 0 " & VARPTR(dberr))
DLL("sqlite3_exec " & db & " \"INSERT INTO demo VALUES (234, 'cruel');\" 0 0 " & VARPTR(dberr))
DLL("sqlite3_exec " & db & " \"INSERT INTO demo VALUES (345, 'world');\" 0 0 " & VARPTR(dberr))
result = DLL("sqlite3_prepare_v2 " & db & " \"SELECT * FROM demo;\" -1 " & VARPTR(stmt) & " 0")
SPLIT result BY " " TO ok, stmt
WHILE DLL("sqlite3_step " & stmt) = SQLITE_ROW
PRINT DLL("sqlite3_column_text " & stmt & " " & 0) & " - " & DLL("sqlite3_column_text " & stmt & " " & 1),"\n"
WEND
DLL("sqlite3_close " & db)
declare sub dll alias "dyc" lib "dyc"
'OXYGEN SOURCE CODE
'------------------
prog="""
tab=chr 9
single v=(1 2 3 4)*2+1.25
bstring s="result:" tab str(v) tab
mov eax,s 'direct return (the string will be copied back to SB)
""" & 0x0
bufferlength = 1000
receive = space(bufferlength)
dll "ms,i,sbo2.dll,run,ZZL", prog, receive, bufferlength
split receive by "\t" to s1, s2, s3
print trim(receive),"\n"
print format("%6.4f",s2),"\n"
besFUNCTION(varptr)
VARIABLE ptr;
if(besARGNR>1) return EX_ERROR_TOO_MANY_ARGUMENTS;
if(besARGNR<1) return EX_ERROR_TOO_FEW_ARGUMENTS;
besALLOC_RETURN_LONG
ptr = besARGUMENT(1);
besDEREFERENCE(ptr);
LONGVALUE(besRETURNVALUE) = (int)ptr;
besEND
'--------------------------------------
'WORKING WITH A PERSISTENT O2H PROGRAME
'--------------------------------------
declare sub dll alias "dyc" lib "dyc"
'OXYGEN SOURCE CODE
'
prog="""
function main(zstring * SBSends, zstring * SBReceives, sys bufferlength) as sys external
'print SBsends
string tab=chr 9, cr=chr(13)+chr(10)
single v=(1 2 3 4)*2+1.25
SBReceives = SBSends cr "O2H responds" tab str(v) tab chr(0)
end function
map[1]= & main
""" & chr(0)
mainfun=1
send="SB Sends a message" & chr(0)
bufferlength = 1000
receive = space(bufferlength)
'COMPILE --> ERROR CHECK --> STARTUP --> FUNCTION CALLS --> STOP
compilerrl= dll( "ms,i,sbo2.dll,compile,ZZL", prog, receive, bufferlength)
if compilerrl>0 then
print left(receive,compilerrl)
else
dll ("ms,i,sbo2.dll,start,L",0)
dll ("ms,i,sbo2.dll,callfun,LzZL", mainfun, send, receive, bufferlength)
'
split receive by "\t" to s1, s2, s3
print s1,"\n"
print format("%6.4f",s2),"\n"
'
dll ("ms,i,sbo2.dll,stop,L", 0)
end if
line input w
declare sub dll alias "_gtk" lib "gtk-server"
dll("gtk_server_require oxygen.dll")
dll("gtk_server_define o2_mode NONE NONE 1 LONG")
dll("gtk_server_define o2_asmo NONE NONE 1 STRING")
dll("gtk_server_define o2_basic NONE NONE 1 STRING")
dll("gtk_server_define o2_buf NONE LONG 1 LONG")
dll("gtk_server_define o2_errno NONE LONG 0")
dll("gtk_server_define o2_error NONE PTR_STRING 0")
dll("gtk_server_define o2_exec NONE LONG 1 LONG")
dll("gtk_server_define o2_get NONE STRING 0")
dll("gtk_server_define o2_len NONE LONG 0")
dll("gtk_server_define o2_prep NONE STRING 1 STRING")
dll("gtk_server_define o2_put NONE NONE 1 STRING")
dll("gtk_server_define o2_view NONE STRING 1 STRING")
o2src = """
print "Hello from OxygenBasic!"
""" & 0x0
dll("o2_mode 0")
dll("o2_basic " & o2src)
dll("o2_exec 0")
end
o2src = """
a$ = "Hello from OxygenBasic!"
print a$
""" & 0x0
PS: o2_error and o2_errno (and o2_len) do not take parameters, hence the crash!
dll ("ms,i,sbo2.dll,callflex,LLLL", SetPosition,2,x,y)
dll ("ms,i,sbo2.dll,callflex,LLLLZ", SetText,3,x,y,"Hello!")
The Gtk module is large! (250k+)
John, here's the problem:
Those macros (besSub/besFunction/besVERSION_NEGOTIATE) are actually function/sub aliases.
You would be better off in the long run taking the time to translate those manually into BCX function/sub syntax.
The one for besVERSION_NEGOTIATE is an interesting one, because it aliases this when using g++:Code: C
I believe what is causing the error you listed above is the order of int extern "C". I think it should be extern "C" int
Before you say "but SB compiles fine from the makefiles" remember that SB uses gcc under non-windows environments, so the extern "C" decorator is not applied. MBC and BCXU use g++.
Another option is fixing this in the header files themselves. Flip the order of any macro that has <variable-type> DLL_EXPORT to DLL_EXPORT <variable-type> and the errors go away....
For example, with besVERSION_NEGOTIATE:
THISCode: [Select]#define besVERSION_NEGOTIATE int DLL_EXPORT versmodu(int Version, char *pszVariation, void **ppModuleInternal){
BECOMES THIS:Code: [Select]#define besVERSION_NEGOTIATE DLL_EXPORT int versmodu(int Version, char *pszVariation, void **ppModuleInternal){
BTW, besVERSION_NEGOTIATE translated to BCX becomes:Code: Text
So it's not really that difficult. You wouldn't be converting ALL of the macros, just the ones that pertain to function/sub aliases....
$DLL
$EXECON "-I/usr/src/scriptbasic"
#include <basext.h>
'besVERSION_NEGOTIATE
FUNCTION versmodu(Version as integer, pszVariation as string, ppModuleInternal as void ptr ptr) as integer export
FUNCTION = INTERFACE_VERSION
END FUNCTION
'besSUB_START
FUNCTION bootmodu(pSt as pSupportTable, ppModuleInternal as void ptr ptr, pParameters as pFixSizeMemoryObject, pReturnValue as pFixSizeMemoryObject ptr) as integer export
DIM pEo AS pExecuteObject
DIM pL AS long ptr
besMODULEPOINTER = besALLOC(sizeof(long))
IF besMODULEPOINTER = NULL THEN FUNCTION = 0
pL = (long *)besMODULEPOINTER
*pL = 0
FUNCTION = 0
END FUNCTION
'besSUB_FINISH
FUNCTION finimodu(pSt as pSupportTable, ppModuleInternal as void ptr ptr, pParameters as pFixSizeMemoryObject, pReturnValue as pFixSizeMemoryObject ptr) as integer export
DIM pEo AS pExecuteObject
FUNCTION = 0
END FUNCTION
'besFUNCTION
FUNCTION trial(pSt as pSupportTable, ppModuleInternal as void ptr ptr, pParameters as pFixSizeMemoryObject, pReturnValue as pFixSizeMemoryObject ptr) as integer export
DIM pEo AS pExecuteObject
DIM pL AS long ptr
PRINT "Function trial was started..."
pL = (long *)besMODULEPOINTER
(*pL)++
besRETURNVALUE = besNEWMORTALLONG
LONGVALUE(besRETURNVALUE) = *pL
PRINT "Module directory is ";(char*)besCONFIG("module")
PRINT "dll extension is ";(char*)besCONFIG("dll")
PRINT "include directory is ";(char*)besCONFIG("include")
FUNCTION = 0
END FUNCTION
'extension module for ScriptBasic:
'23:02 11/05/2011
'23:31 13/05/2011
'
'Charles Pegge
#file "mdlt.dll"
'----------------------------------------------------------------------------------
function versmodu cdecl (sys Version, pszVariation, ppModuleInternal) as sys export
'==================================================================================
'print "Version: " hex version
return Version
end function
'-------------------------------------------------------------------------------------------
function bootmodu cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
'===========================================================================================
'print "Boot!"
end function
'------------------------------------------------------------------------------------
function finimodu cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
'====================================================================================
'print "Finish!"
end function
'----------------------------------------------------------------------------------------
function trial cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
'========================================================================================
sys p,t,v,w,pm,pn
string s
'
if pParameters=0 then
print "no params"
else
'
'HOW MANY ARGUMENTS GIVEN
'------------------------
'
mov ecx,pparameters
mov eax,[ecx+8] : shr eax,2 : mov w,eax
'mov eax,[ecx+12] : mov t,al
'
'print "No of Arguments given: " w
'
'SELECT PARAM pn
'---------------
'
'pParameters->Value.aValue[(X)-1]
'
pn=1
'
mov ecx,pparameters
mov ecx,[ecx] 'array of param pointers
mov eax,pn : dec eax : shl eax,2
mov ecx,[ecx+eax] 'array offset to get pparam
'
mov pm,ecx
'
'CONVERSION TO STRING
'--------------------
'
'to string f4 / to long f8 / to double fc
'pSt->Convert2String(pSt->pEo,(x),pSt->pEo->pGlobalMortalList)
'
mov ecx,pSt : mov eax,[ecx] : push [eax+0x8c] : push pm : push eax : call [ecx+0xf4]
mov ecx,eax
mov p,ecx
zstring* z : &z=*p
'
'print "As String: " z
'
mov ecx,pSt : mov eax,[ecx] : push [eax+0x8c] : push pm : push eax : call [ecx+0xf8]
mov ecx,[eax]
mov p,ecx
'
'print "As Long: " p
'
mov ecx,pSt : mov eax,[ecx] : push [eax+0x8c] : push pm : push eax : call [ecx+0xfc]
mov ecx,eax
mov p,ecx
double*d : &d=p
'
print "As Double: " d
'
'GET VALUE / STRING POINTER
'--------------------------
'
'mov eax,[ecx] : mov p,eax 'value / pointer
'mov eax,[ecx+8] : mov w,eax 'size
'mov eax,[ecx+12] : and eax,-1 : mov t,eax
'
'type codes 0 undef 1 double 2 long 3 zstring* 4 zchar ff ptr
'
end if
'
'
'============
'RETURN VALUE
'============
'
'
'check stack:
'mov w,esp
'
'
' 00c string 010 long 018 double
'---------------------------------
'
'
'RETURN LONG
'-----------
'
'long v=456
'
'mov ecx,pst : mov eax,[ecx] : push [eax+0x8c] : push [eax+0x94] : call [ecx+0x10]
'mov ecx,pReturnValue : mov [ecx],eax : mov edx,v : mov [eax],edx
'
'
'RETURN DOUBLE
'-------------
'
'double d=1234.5678
'
'mov ecx,pst : mov eax,[ecx] : push [eax+0x8c] : push [eax+0x94] : call [ecx+0x18]
'mov ecx,pReturnValue : mov [ecx],eax : fld qword d : fstp qword [eax]
'
'
'RETURN STRING
'-------------
'
long ls=8 'length excluding null terminators
zstring z at p
'
mov ecx,pst : mov eax,[ecx] : push [eax+0x8c] : push ls : push [eax+0x94] : call [ecx+0x0c]
mov ecx,pReturnValue : mov [ecx],eax : mov eax,[eax] : mov p,eax
z="ABCDEFGH" 'direct input
'
'
'NB: beware cdecl cleanup.
'-------------------------
'
'sub w,esp
'print "check stack: " hex w
'
end function
declare sub trial alias "trial" lib "mdlt"
rtn = trial(1)
PRINT rtn,"\n"
rtn = trial(1.1)
PRINT rtn,"\n"
rtn = trial("One")
PRINT rtn,"\n"
C:\o2h\a33\examples\SBO2>scriba trial.sb
ABCDEFGH
ABCDEFGH
ABCDEFGH
C:\o2h\a33\examples\SBO2>
This module is a general purpose memory allocation module, which can be used in any project that needs heavy and sophisticated memory allocation. Originally the module was developed for the ScriptBasic project. Later we used it for Index.hu Rt AdEgine project and multi-thread features were introduced.
ScriptBasic is fast, it generates a compact internal code, which is interpreted. This internal code occupies a single, continuous memory chunk and is usually saved into a cache file. The cache file is automatically checked by ScriptBasic and thus it compiles the source only when needed.
When compiling for the x64 architecture using Microsoft tools, there is only one calling convention — the one described here, so that stdcall, thiscall, cdecl, fastcall, etc., are now all one and the same.
' ======================================
' WORKING WITH A PERSISTENT O2H PROGRAME
' ======================================
'09:08 13/05/2011
declare sub dll alias "dyc" lib "dyc"
' ==================
' OXYGEN SOURCE CODE
' ==================
'
O2prog="""
'
$ THREADED_WINDOW
'$ PERSISTANT_WINDOW
include "GraphWin1B.inc"
'
'
function Commune(zstring * SBSends, zstring * SBReceives, sys bufferlength) as sys external
'------------------------------------------------------------------------------------------
'print SBsends
string tab=chr 9, cr=chr(13)+chr(10)
single v=(1 2 3 4)*2+1.25
SBReceives= SBSends cr+
"O2H responds" tab str(v) tab +
"Enter x,y coordinates:" cr+
"or empty line to quit" tab chr(0)
end function
'
'
function SetPosition(long x, long y) as long external
'----------------------------------------------------
'print "x: " x " y: " y
while dat
if active then sleep(0) else return -1
wend
dat[11]<=x,y
dat=1 'signal update
return active
end function
'
'
function CloseWindow() as sys external
'-------------------------------------
while dat
if active then sleep(0) else return -1
wend
dat=2 'request shutdown
return active
end function
'
'
function IsActive() as sys external
'----------------------------------
sleep 0
return active
end function
map <= @Commune, @SetPosition, @CloseWindow, @IsActive
""" & chr(0)
' ================
' SCRIPTBASIC CODE
' ================
'INTERFACE
'---------
Commune =1
SetPosition=2
CloseWindow=3
IsActive =4
send="SB Sends a message" & chr(0)
bufferlength = 1000
receive = space(bufferlength)
'---------------------------------------------------------------
'COMPILE --> ERROR CHECK --> STARTUP --> FUNCTION CALLS --> STOP
'---------------------------------------------------------------
'COMPILE
'-------
compilerrl= dll( "ms,i,sbo2.dll,compile,ZZL", O2prog, receive, bufferlength)
'
'ERROR CHECK
'-----------
'
if compilerrl>0 then
print left(receive,compilerrl)
line input w
else
'
'START DEMO
'----------
'
dll ("ms,i,sbo2.dll,start,L",0)
'
'TEST TEXT IO COMMUNICATION
'--------------------------
'
dll ("ms,i,sbo2.dll,callfun,LzZL", Commune, send, receive, bufferlength)
'
split receive by "\t" to s1, s2, s3
print s1,"\n"
print format("%6.4f",s2),"\n"
print s3,"\n"
'
'WAIT TILL WINDOW IS ACTIVE
'--------------------------
'
ra=0
c=0
while ra=0
ra=dll ("ms,i,sbo2.dll,callflex,LL", IsActive,0)
c+=1
if c>100 then
ra=-1
end if
wend
'
if ra>0 then
'
'TEST USER COMMUNICATION WITH WINDOW
'-----------------------------------
'
'enter x and y coords or quit
'
w=" "
re=1
while (asc(w)>=32) and (re>0)
line input w
if len(w)>1 then
split w by "," to x,y
re=dll ("ms,i,sbo2.dll,callflex,LLLL", SetPosition,2,x,y)
end if
wend
'
'CLOSE DOWN WINDOW
'-----------------
'
dll ("ms,i,sbo2.dll,callflex,LL", CloseWindow,0)
'
end if
'
'STOP THE PERSISTANT PROGRAM
'---------------------------
'
dll ("ms,i,sbo2.dll,stop,L", 0)
'
end if
PS: I found my alignment error, so my mapping of the API is now in agreement with the headers.
' #include <sqlite3.h>
extern stdcall lib "sqlite3.dll"
int sqlite3_open(
const char *filename, /* Database filename (UTF-8) */
sqlite3 **ppDb /* OUT: SQLite db handle */
);
int sqlite3_exec(
sqlite3*, /* An open database */
const char *sql, /* SQL to be evaluated */
int (*callback)(void*,int,char**,char**), /* Callback function */
void *, /* 1st argument to callback */
char **errmsg /* Error msg written here */
);
int sqlite3_prepare_v2(
sqlite3 *db, /* Database handle */
const char *zSql, /* SQL statement, UTF-8 encoded */
int nByte, /* Maximum length of zSql in bytes. */
sqlite3_stmt **ppStmt, /* OUT: Statement handle */
const char **pzTail /* OUT: Pointer to unused portion of zSql */
);
int sqlite3_step(sqlite3_stmt*); /* Evaluate the statement */
const unsigned char *sqlite3_column_text(sqlite3_stmt*, int iCol); /* The "result set" interface */
int sqlite3_close(sqlite3 *); /* Destructor for the sqlite3 object */
end extern
typedef struct _tb
{
long (*f1)(long*s)
long (*f2)(long*s)
long (*f3)(long*s)
zstring (*s1)(long*s)
zstring (*s2)(char*s)
long (*s3)(char**s)
} tb,*ptb
DECLARE SUB DLL ALIAS "dyc" LIB "dyc"
dv = DLL("ms,d,libgsl.dll,gsl_sf_bessel_J0,d",5.0)
PRINT dv,"\n"
#include <stdio.h>
#include <gsl/gsl_sf_bessel.h>
int
main (void)
{
double x = 5.0;
double y = gsl_sf_bessel_J0 (x);
printf ("J0(%g) = %.48e\n", x, y);
return 0;
}
case 0: //define the call type
switch( *pszFormat ){
case 'm': case 'M': Flags |= DC_MICROSOFT; break;
case 'b': case 'B': Flags |= DC_BORLAND; break;
case 'c': case 'C': Flags |= DC_CALL_CDECL; break;
case 's': case 'S': Flags |= DC_CALL_STD; break;
case '4': Flags |= DC_RETVAL_MATH4; break;
case '8': Flags |= DC_RETVAL_MATH8; break;
case ',' : iParseState++; break;
}
else if (Flags & DC_RETVAL_MATH8) {
_asm fstp qword ptr [Res]
}
This means the float double result is taken from the FPU stack
Finally you can specify 4 or 8 to specify that the function is returning a four or eight-byte floating point number. Although this is a kind of return value specification, it is stated here, because this affects the calling convention. These values are returned not in a memory place from the function but rather in the co-processor register and function dyc has to know to fetch them from there rather than expection the function to return a four or eight-byte memory chunk.
Backtrace:
=>0 0x7ec95669 MSVCRT_fwrite+0x29() in msvcrt (0x0033ecb4)
1 0x7ec97222 MSVCRT_vfprintf+0x151() in msvcrt (0x0033f524)
2 0x7ec9774b MSVCRT_fprintf+0x2a() in msvcrt (0x0033f544)
3 0x6ef53430 gsl_combination_fprintf+0x2f(stream=(nil), c=0x111c10, format="
u") [d:\gslNew\combination/file.c:73] in libgsl-0 (0x0033f574)
4 0x1000224b in dyc (+0x224a) (0x0033f5c0)
5 0x10001cd2 in dyc (+0x1cd1) (0x0033f868)
6 0x00453915 in scriba (+0x53914) (0x0033f8d8)
7 0x00412e38 in scriba (+0x12e37) (0x0033f8f4)
8 0x004137cd in scriba (+0x137cc) (0x0033f948)
9 0x0044de97 in scriba (+0x4de96) (0x0033f978)
10 0x00412e38 in scriba (+0x12e37) (0x0033f994)
11 0x00403dc3 in scriba (+0x3dc2) (0x0033f9a8)
12 0x00402179 in scriba (+0x2178) (0x0033fe50)
13 0x004557a5 in scriba (+0x557a4) (0x0033fe90)
14 0x7b85899c call_process_entry+0xb() in kernel32 (0x0033fea8)
15 0x7b85963f ExitProcess+0xc9e() in kernel32 (0x0033fee8)
16 0x7bc72e68 call_thread_func+0xb() in ntdll (0x0033fef8)
17 0x7bc75920 call_thread_entry_point+0x6f() in ntdll (0x0033ffc8)
18 0x7bc4aa0a call_dll_entry_point+0x629() in ntdll (0x0033ffe8)
It can't be STDOUT since manages to display something.
library "KERNEL32.DLL"
declare FUNCTION AllocConsole ALIAS "AllocConsole" () AS LONG
declare FUNCTION GetCommandLine ALIAS "GetCommandLineA" () AS DWORD
declare FUNCTION GetStdHandle ALIAS "GetStdHandle" (BYVAL handle AS DWORD) AS DWORD
declare FUNCTION WriteConsole ALIAS "WriteConsoleA" (BYVAL hConsoleOutput AS DWORD, lpBuffer AS ASCIIZ, BYVAL nNumberOfCharsToWrite AS LONG, lpNumberOfCharsWritten AS LONG, BYVAL lpReserved AS LONG) AS LONG
declare FUNCTION ReadConsole ALIAS "ReadConsoleA" (BYVAL hConsoleInput AS DWORD, BYVAL lpBuffer AS DWORD, BYVAL nNumberOfCharsToRead AS LONG, lpNumberOfCharsRead AS LONG, pInputControl AS ANY) AS LONG
declare FUNCTION SetConsoleTitle ALIAS "SetConsoleTitleA" (lpConsoleTitle AS ASCIIZ) AS LONG
library ""
%STD_INPUT_HANDLE = -10
%STD_OUTPUT_HANDLE = -11
%STD_ERROR_HANDLE = -12
AllocConsole
dim as long consIn,consOut,consErr
ConsIn =GetStdHandle (%STD_INPUT_HANDLE)
ConsOut=GetStdHandle (%STD_OUTPUT_HANDLE)
ConsErr=GetStdHandle (%STD_ERROR_HANDLE)
dim as string bufin
dim as long buflen,bufrit
dim as string tab,cr,qu
tab=chr 9
qu=chr 34
cr=chr(13)+chr(10)
bufin=nuls 1000
SetConsoleTitle "Oxygen PE SPY"
'---------------------------
function output(bufout as string)
'===========================
buflen=len bufout
WriteConsole ConsOut,bufout,buflen,bufrit,0
end function
'-------------------------------------
function input(s as string) as string
'=====================================
output s
ReadConsole consin,*bufin,100,bufrit,0
function=left bufin,bufrit
end function
'-------------------------------
function commandline() as string
'===============================
dim byref z as zstring
&z=GetCommandLine
function=z
end function
'------------------------------------------
function stripquotes(s as string) as string
'==========================================
dim as long a
a=asc(s,1)
if a=34 then
a=instr 2,s,qu
s=mid s,2,a-2
end if
function=s
end function
'---------------------------
function output(bufout as string)
'===========================
buflen=len bufout
WriteConsole ConsOut,bufout,buflen,bufrit,0
end function
DECLARE SUB DLL ALIAS "dyc" LIB "dyc"
CONST GSL_SUCCESS = 0
a = DLL("ms,l,kernel32.dll,LoadLibrary,z","kernel32.dll")
p = DLL("ms,l,kernel32.dll,GetProcAddress,lz",a,"WriteConsoleA")
PRINT "All subsets of {0,1,2,3} by size:\n"
FOR i = 0 TO 4
c = DLL("ms,l,libgsl-0.dll,gsl_combination_calloc,ll", 4, i)
DO
PRINT "{"
DLL("ms,i,libgsl-0.dll,gsl_combination_fprintf,llz", p, c, " %u")
PRINT " }\n"
LOOP WHILE DLL("ms,i,libgsl-0.dll,gsl_combination_next,l", c) = GSL_SUCCESS
DLL("ms,i,libgsl-0.dll,gsl_combination_free,l", c)
NEXT
UNIX defines 3 predefined streams (in stdio.h):
stdin, stdout, stderr
/*
GNU Scientific Library
Based on GSL 1.15
Interface By: John Spikowski
*/
#include <stdio.h>
#include "../../basext.h"
#include <gsl/gsl_sf_bessel.h>
besVERSION_NEGOTIATE
return (int)INTERFACE_VERSION;
besEND
besSUB_START
besEND
besSUB_FINISH
besEND
besFUNCTION(sf_bessel_J0)
VARIABLE Argument;
Argument = besARGUMENT(1);
besDEREFERENCE(Argument);
besRETURN_DOUBLE(gsl_sf_bessel_J0 (DOUBLEVALUE(Argument)));
besEND
DECLARE SUB besselJ0 ALIAS "sf_bessel_J0" LIB "gsl"
PRINT FORMAT("J0(%g) = %.48g", 5, besselJ0(5.0)),"\n"
Would an enhanced DYC be worth developing John?
besFUNCTION(_frexp)
VARIABLE Argument;
Argument = besARGUMENT(1);
besDEREFERENCE(Argument);
double x = DOUBLEVALUE(Argument);
Argument = besARGUMENT(2);
besDEREFERENCE(Argument);
int * y = LONGVALUE(Argument);
besRETURN_DOUBLE(gsl_frexp(x, y));
besEND
Function: double gsl_frexp (double x, int * e)
This function splits the number x into its normalized fraction f and exponent e, such that x = f * 2^e and 0.5 <= f < 1. The function returns f and stores the exponent in e. If x is zero, both f and e are set to zero. This function provides an alternative to the standard math function frexp(x, e).
DECLARE SUB frexp ALIAS "_frexp" LIB "gsl"
e = 0
PRINT FORMAT("%g",frexp(12.5,e)),"\n"
PRINT e,"\n"
besFUNCTION(_frexp)
VARIABLE Argument;
LEFTVALUE Lval;
unsigned long __refcount_;
Argument = besARGUMENT(1);
besDEREFERENCE(Argument);
double x = DOUBLEVALUE(Argument);
Argument = besARGUMENT(2);
besLEFTVALUE(Argument,Lval);
besRELEASE(*Lval);
*Lval = besNEWLONG;
besRETURN_DOUBLE(gsl_frexp(x, *Lval));
besEND
DECLARE SUB frexp ALIAS "_frexp" LIB "gsl"
x = 16.4
fraction = frexp(x, e)
PRINT FORMAT("%g",fraction),"\n"
PRINT e,"\n"
A left value is a special expression that a value can be assigned, and therefore they usually stand on the left side of the assignment operator. That is the reason for the name.
The difficulty is that the macros are a new language to learn.
Nice work, John. I just popped in to see what you've been up to.
I'm curious if the following would work using some of the higher-level macros.
For example, originally you had:Code: [Select]besFUNCTION(_hypot3)
VARIABLE Argument;
Argument = besARGUMENT(1);
besDEREFERENCE(Argument);
double x = DOUBLEVALUE(Argument);
Argument = besARGUMENT(2);
besDEREFERENCE(Argument);
double y = DOUBLEVALUE(Argument);
Argument = besARGUMENT(3);
besDEREFERENCE(Argument);
double z = DOUBLEVALUE(Argument);
besRETURN_DOUBLE(gsl_hypot3(x, y, z));
besEND
I'm wondering if this could be re-coded as:Code: [Select]besFUNCTION(_hypot3)
double x,y,z;
besARGUMENTS("rrr")
&x,&y,&z
besARGEND
besRETURN_DOUBLE(gsl_hypot3(x, y, z));
besEND
"rrr" above specifies that the 3 arguments should be Double values (not sure why it isn't "d" for clarity, but that's how it's set up internally. I guess "r" stands for "real" which I suppose is analogous to a Double?).
A.
/*
GNU Scientific Library
Based on GSL 1.15
Interface By: John Spikowski
Refinements By: Armando I. Rivera (AIR)
Version 0.01
*/
#include <stdio.h>
#include "../../basext.h"
#include <gsl/gsl_math.h>
besVERSION_NEGOTIATE
return (int)INTERFACE_VERSION;
besEND
besSUB_START
besEND
besSUB_FINISH
besEND
/* Elementary Functions */
besFUNCTION(_log1p)
double x;
besARGUMENTS("r")
&x
besARGEND
besRETURN_DOUBLE(gsl_log1p(x));
besEND
besFUNCTION(_expm1)
double x;
besARGUMENTS("r")
&x
besARGEND
besRETURN_DOUBLE(gsl_expm1(x));
besEND
besFUNCTION(_hypot)
double x,y;
besARGUMENTS("rr")
&x,&y
besARGEND
besRETURN_DOUBLE(gsl_hypot(x, y));
besEND
besFUNCTION(_hypot3)
double x,y,z;
besARGUMENTS("rrr")
&x,&y,&z
besARGEND
besRETURN_DOUBLE(gsl_hypot3(x, y, z));
besEND
besFUNCTION(_acosh)
double x;
besARGUMENTS("r")
&x
besARGEND
besRETURN_DOUBLE(gsl_acosh(x));
besEND
besFUNCTION(_asinh)
double x;
besARGUMENTS("r")
&x
besARGEND
besRETURN_DOUBLE(gsl_asinh(x));
besEND
besFUNCTION(_atanh)
double x;
besARGUMENTS("r")
&x
besARGEND
besRETURN_DOUBLE(gsl_atanh(x));
besEND
besFUNCTION(_ldexp)
double x;
int y;
besARGUMENTS("ri")
&x,&y
besARGEND
besRETURN_DOUBLE(gsl_ldexp(x, y));
besEND
besFUNCTION(_frexp)
double f;
LEFTVALUE e;
besARGUMENTS("r")
&f
besARGEND
besLEFTVALUE(besARGUMENT(2),e);
besRETURN_DOUBLE(gsl_frexp(f, *e));
besEND
DECLARE SUB log1p ALIAS "_log1p" LIB "gsl"
PRINT FORMAT("%.32g", log1p(34.0)),"\n"
DECLARE SUB frexp ALIAS "_frexp" LIB "gsl"
x = 16.4
e = 0
fraction = frexp(x, e)
PRINT FORMAT("%g",fraction),"\n"
PRINT e,"\n"