Raspberry BASIC > Nim
Nim SB
John Spikowski:
I'm working on embedding ScriptBasic into Nim. Basically it's a port of the SBT extension module as Nim extension. This will allow the full functionality of SB and its extensions to be available to Nim dynamically at runtime.
@AIR - I may need some help creating the Nim interface if you have time.
John Spikowski:
I thought I would get the Nim SB project kicked off by showing what already exists and needing a Nim extension interface. SBT is everything needed to make the interface with Nim work. It happens to be using ScriptBasic as its host language. The advantage is that it can also use the MT extension module to communicate with threads.
interface.c
--- Code: C ---/* SBT (ScriptBasic Threads) - Extension ModuleUXLIBS: -lscriba -lpthread -lmBAS: sbt.bas*/ #include <stdio.h>#include <stdlib.h>#include <string.h>#include <ctype.h>#include <math.h>#include <time.h>#include <unistd.h>#include "../../basext.h"#include "../../scriba.h"#include "cbasic.h" /**************************** Extension Module Functions****************************/ besVERSION_NEGOTIATE RETURN_FUNCTION((int)INTERFACE_VERSION);besEND besSUB_START DIM AS long PTR p; besMODULEPOINTER = besALLOC(sizeof(long)); IF (besMODULEPOINTER EQ NULL) THEN_DO RETURN_FUNCTION(0); p = (long PTR)besMODULEPOINTER; RETURN_FUNCTION(0);besEND besSUB_FINISH DIM AS long PTR p; p = (long PTR)besMODULEPOINTER; IF (p EQ NULL) THEN_DO RETURN_FUNCTION(0); RETURN_FUNCTION(0);besEND /********************** Script BASIC Instance**********************/ /****************** Support Routines******************/ struct _RunServiceProgram { char *pszProgramFileName; char *pszCmdLineArgs; char *pszConfigFileName; pSbProgram pTProgram; int iRestart; }; static void ExecuteProgramThread(void *p){ pSbProgram pProgram; char szInputFile[1024]; int iErrorCode; struct _RunServiceProgram *pRSP; pRSP = p; strcpy(szInputFile,pRSP->pszProgramFileName); pProgram = scriba_new(malloc,free); pRSP->pTProgram = pProgram; if( pProgram == NULL )return; scriba_SetFileName(pProgram,szInputFile); if (pRSP->pszConfigFileName != NULL){ strcpy(szInputFile,pRSP->pszConfigFileName); scriba_LoadConfiguration(pProgram, pRSP->pszConfigFileName); }else{ scriba_SetProcessSbObject(pProgram,pProgram); } scriba_LoadSourceProgram(pProgram); if (pRSP->pszCmdLineArgs != NULL){ strcpy(szInputFile,pRSP->pszCmdLineArgs); iErrorCode = scriba_Run(pProgram,pRSP->pszCmdLineArgs); }else{ iErrorCode = scriba_Run(pProgram,NULL); }// scriba_destroy(pProgram); return;} besFUNCTION(SB_New) DIM AS pSbProgram sbobj; sbobj = scriba_new(malloc,free); besRETURN_LONG(sbobj);besEND besFUNCTION(SB_Configure) DIM AS unsigned long sbobj; DIM AS char PTR cfgfilename; DIM AS int rtnval = -1; besARGUMENTS("iz") AT sbobj, AT cfgfilename besARGEND rtnval = scriba_LoadConfiguration(sbobj, cfgfilename); besRETURN_LONG(rtnval);besEND besFUNCTION(SB_Load) DIM AS unsigned long sbobj; DIM AS char PTR sbfilename; DIM AS int rtnval = -1; besARGUMENTS("iz") AT sbobj, AT sbfilename besARGEND rtnval = scriba_SetFileName(sbobj, sbfilename); scriba_LoadSourceProgram(sbobj); besRETURN_LONG(rtnval);besEND besFUNCTION(SB_LoadStr) DIM AS unsigned long sbobj; DIM AS char PTR sbpgm; DIM AS int rtnval = -1; besARGUMENTS("iz") AT sbobj, AT sbpgm besARGEND scriba_SetFileName(sbobj, "fake"); rtnval = scriba_LoadProgramString(sbobj, sbpgm, strlen(sbpgm)); besRETURN_LONG(rtnval);besEND besFUNCTION(SB_Run) DIM AS unsigned long sbobj; DIM AS int rtnval; DIM AS char PTR sbcmdline; besARGUMENTS("iz") AT sbobj, AT sbcmdline besARGEND IF (besARGNR < 2) THEN_DO sbcmdline = ""; rtnval = scriba_Run(sbobj, sbcmdline); besRETURN_LONG(rtnval);besEND besFUNCTION(SB_NoRun) DIM AS unsigned long sbobj; DIM AS int rtnval; besARGUMENTS("i") AT sbobj besARGEND rtnval = scriba_NoRun(sbobj); besRETURN_LONG(rtnval);besEND besFUNCTION(SB_ThreadStart) DIM AS struct _RunServiceProgram PTR pRSP; DIM AS THREADHANDLE T; DIM AS char PTR pszProgramFileName; DIM AS char PTR pszCmdLineArgs; DIM AS char PTR pszConfigFileName; DIM AS unsigned long rtnval; besARGUMENTS("z[z][z]") AT pszProgramFileName, AT pszCmdLineArgs, AT pszConfigFileName besARGEND pRSP = (struct _RunServiceProgram PTR)malloc( sizeof(struct _RunServiceProgram) ); pRSP->pszProgramFileName = (char PTR)malloc(strlen(pszProgramFileName) + 1); strcpy(pRSP->pszProgramFileName,pszProgramFileName); IF (pszCmdLineArgs NE NULL) THEN pRSP->pszCmdLineArgs = (char PTR)malloc(strlen(pszCmdLineArgs) + 1); strcpy(pRSP->pszCmdLineArgs,pszCmdLineArgs); ELSE pRSP->pszCmdLineArgs = NULL; END_IF IF (pszConfigFileName NE NULL) THEN pRSP->pszConfigFileName = (char PTR)malloc(strlen(pszConfigFileName) + 1); strcpy(pRSP->pszConfigFileName,pszConfigFileName); ELSE pRSP->pszConfigFileName = NULL; END_IF pRSP->iRestart = 0; thread_CreateThread(AT T,ExecuteProgramThread,pRSP); usleep(500); rtnval = pRSP->pTProgram; besRETURN_LONG(rtnval);besEND besFUNCTION(SB_ThreadEnd) thread_ExitThread(); besRETURNVALUE = NULL;besEND besFUNCTION(SB_Destroy) DIM AS unsigned long sbobj; besARGUMENTS("i") AT sbobj besARGEND scriba_destroy(sbobj); RETURN_FUNCTION(0);besEND besFUNCTION(SB_CallSub) DIM AS unsigned long sbobj; DIM AS int funcsernum; DIM AS char PTR funcname; besARGUMENTS("iz") AT sbobj, AT funcname besARGEND funcsernum = scriba_LookupFunctionByName(sbobj, funcname); besRETURN_LONG(scriba_Call(sbobj, funcsernum));besEND besFUNCTION(SB_CallSubArgs) DIM AS VARIABLE Argument; DIM AS SbData ArgData[8]; DIM AS SbData FunctionResult; DIM AS unsigned long sbobj; DIM AS char PTR funcname; DIM AS int i, sbtype, fnsn; Argument = besARGUMENT(1); besDEREFERENCE(Argument); sbobj = LONGVALUE(Argument); Argument = besARGUMENT(2); besDEREFERENCE(Argument); funcname = STRINGVALUE(Argument); DEF_FOR (i = 3 TO i <= besARGNR STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); SELECT_CASE (sbtype = TYPE(Argument)) BEGIN_SELECT CASE VTYPE_LONG: ArgData[i-3] = PTR scriba_NewSbLong(sbobj, LONGVALUE(Argument)); END_CASE CASE VTYPE_DOUBLE: ArgData[i-3] = PTR scriba_NewSbDouble(sbobj, DOUBLEVALUE(Argument)); END_CASE CASE VTYPE_STRING: ArgData[i-3] = PTR scriba_NewSbString(sbobj, STRINGVALUE(Argument)); END_CASE CASE_ELSE ArgData[i-3] = PTR scriba_NewSbUndef(sbobj); END_CASE END_SELECT NEXT fnsn = scriba_LookupFunctionByName(sbobj, funcname); scriba_CallArgEx(sbobj, fnsn, AT FunctionResult, besARGNR - 2, AT ArgData); SELECT_CASE (FunctionResult.type) BEGIN_SELECT CASE SBT_LONG: besRETURN_LONG(FunctionResult.v.l); END_CASE CASE SBT_DOUBLE: besRETURN_DOUBLE(FunctionResult.v.d); END_CASE CASE SBT_STRING: besRETURN_STRING(FunctionResult.v.s); END_CASE CASE SBT_UNDEF: besRETURNVALUE = NULL; END_CASE END_SELECTbesEND besFUNCTION(SB_GetVar) DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn; DIM AS char PTR varname; besARGUMENTS("iz") AT sbobj, AT varname besARGEND vsn = scriba_LookupVariableByName(sbobj, varname); scriba_GetVariable(sbobj, vsn, AT varobj); SELECT_CASE (scriba_GetVariableType(sbobj, vsn)) BEGIN_SELECT CASE SBT_LONG : besRETURN_LONG(varobj[0].v.l); END_CASE CASE SBT_DOUBLE : besRETURN_DOUBLE(varobj[0].v.d); END_CASE CASE SBT_STRING : besRETURN_STRING(varobj[0].v.s); END_CASE CASE SBT_UNDEF : besRETURNVALUE = NULL; END_CASE END_SELECTbesEND besFUNCTION(SB_SetUndef) DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn; DIM AS char PTR varname; besARGUMENTS("iz") AT sbobj, AT varname besARGEND vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_UNDEF, NULL, 0, "", 0));besEND besFUNCTION(SB_SetInt) DIM AS VARIABLE Argument; DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn, usrval, i; DIM AS char PTR varname; IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS); DEF_FOR (i = 1 TO i <= 3 STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument); IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument); IF (i EQ 3) THEN_DO usrval = LONGVALUE(Argument); NEXT vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_LONG, usrval, 0, "", 0));besEND besFUNCTION(SB_SetDbl) DIM AS VARIABLE Argument; DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn, i; DIM AS char PTR varname; DIM AS double usrval; IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS); DEF_FOR (i = 1 TO i <= 3 STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument); IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument); IF (i EQ 3) THEN_DO usrval = DOUBLEVALUE(Argument); NEXT vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_DOUBLE, 0, usrval, "", 0));besEND besFUNCTION(SB_SetStr) DIM AS VARIABLE Argument; DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn, i; DIM AS char PTR varname; DIM AS char PTR usrval; IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS); DEF_FOR (i = 1 TO i <= 3 STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument); IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument); IF (i EQ 3) THEN_DO usrval = STRINGVALUE(Argument); NEXT vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_STRING, 0, 0, usrval, strlen(usrval)));besEND besFUNCTION(SB_ResetVars) DIM AS unsigned long sbobj; besARGUMENTS("i") AT sbobj besARGEND scriba_ResetVariables(sbobj); besRETURNVALUE = NULL;besEND besFUNCTION(SB_msSleep) //DIM AS int msval, t; DIM AS long t; besARGUMENTS("i") AT t besARGEND usleep(t); besRETURNVALUE = NULL;besEND
sbt.inc - interpreter extension module include
--- Code: Script BASIC ---DECLARE SUB SB_New ALIAS "SB_New" LIB "sbt"DECLARE SUB SB_Configure ALIAS "SB_Configure" LIB "sbt"DECLARE SUB SB_Load ALIAS "SB_Load" LIB "sbt"DECLARE SUB SB_LoadStr ALIAS "SB_LoadStr" LIB "sbt"DECLARE SUB SB_Run ALIAS "SB_Run" LIB "sbt"DECLARE SUB SB_NoRun ALIAS "SB_NoRun" LIB "sbt"DECLARE SUB SB_ThreadStart ALIAS "SB_ThreadStart" LIB "sbt"DECLARE SUB SB_ThreadEnd ALIAS "SB_ThreadEnd" LIB "sbt"DECLARE SUB SB_GetVar ALIAS "SB_GetVar" LIB "sbt"DECLARE SUB SB_SetUndef ALIAS "SB_SetUndef" LIB "sbt"DECLARE SUB SB_SetInt ALIAS "SB_SetInt" LIB "sbt"DECLARE SUB SB_SetDbl ALIAS "SB_SetDbl" LIB "sbt"DECLARE SUB SB_SetStr ALIAS "SB_SetStr" LIB "sbt"DECLARE SUB SB_ResetVars ALIAS "SB_ResetVars" LIB "sbt"DECLARE SUB SB_CallSub ALIAS "SB_CallSub" LIB "sbt"DECLARE SUB SB_CallSubArgs ALIAS "SB_CallSubArgs" LIB "sbt"DECLARE SUB SB_Destroy ALIAS "SB_Destroy" LIB "sbt"
sbtdemo.sb
--- Code: Script BASIC ---' SBT (ScriptBasic Threads) - Example Script IMPORT sbt.inc sb_code = """FUNCTION prtvars(a, b, c) PRINT a,"\\n" PRINT FORMAT("%g\\n", b) PRINT c,"\\n" prtvars = "Function Return"END FUNCTION a = 0b = 0c = """"" sb = SB_New()SB_Configure sb, "C:/Windows/SCRIBA.INI"SB_LoadStr sb, sb_codeSB_NoRun sbfuncrtn = SB_CallSubArgs(sb,"main::prtvars", 123, 1.23, "One, Two, Three")PRINT funcrtn,"\n"SB_Run sb, ""SB_SetInt sb, "main::a", 321SB_SetDbl sb, "main::b", 32.1SB_SetStr sb, "main::c", "Three,Two,One"SB_CallSubArgs sb, "main::prtvars", _ SB_GetVar(sb, "main::a"), _ SB_GetVar(sb, "main::b"), _ SB_GetVar(sb, "main::c") SB_Destroy sb
Output
123
1.23
One, Two, Three
Function Return
321
32.1
Three,Two,One
The goal is to create a Nim interface with the same function calls as in the ScriptBasic SBT include file. The first step is to convert the SBT shared object interface into a generic call format.
John Spikowski:
Silver lining is once I have the generic call conversion completed, the ScriptBasic shared object can be embedded in any language supporting a FFI interface. (compiled and interpretative)
John Spikowski:
I still have a few functions that need to be broken apart or reworked,
SB_CallSubArgs
SB_GetVar
SB_SetDbl
SB_SetStr
sbobj.c
--- Code: C ---// ScriptBasic Shared Object #include <stdio.h>#include <stdlib.h>#include <string.h>#include <ctype.h>#include <math.h>#include <time.h>#include <unistd.h>#include "/home/ubuntu/sb-dev-master/basext.h"#include "/home/ubuntu/sb-dev-master/scriba.h"#include "cbasic.h" /*********************** Statc Support Routines***********************/ struct _RunServiceProgram { char *pszProgramFileName; char *pszCmdLineArgs; char *pszConfigFileName; pSbProgram pTProgram; int iRestart; }; static void ExecuteProgramThread(void *p){ pSbProgram pProgram; char szInputFile[1024]; int iErrorCode; struct _RunServiceProgram *pRSP; pRSP = p; strcpy(szInputFile,pRSP->pszProgramFileName); pProgram = scriba_new(malloc,free); pRSP->pTProgram = pProgram; if( pProgram == NULL )return; scriba_SetFileName(pProgram,szInputFile); if (pRSP->pszConfigFileName != NULL){ strcpy(szInputFile,pRSP->pszConfigFileName); scriba_LoadConfiguration(pProgram, pRSP->pszConfigFileName); }else{ scriba_SetProcessSbObject(pProgram,pProgram); } scriba_LoadSourceProgram(pProgram); if (pRSP->pszCmdLineArgs != NULL){ strcpy(szInputFile,pRSP->pszCmdLineArgs); iErrorCode = scriba_Run(pProgram,pRSP->pszCmdLineArgs); }else{ iErrorCode = scriba_Run(pProgram,NULL); }// scriba_destroy(pProgram); return;} /***************************** ScriptBasic Object Functions*****************************/ FUNCTION long SB_New()BEGIN_FUNCTION DIM AS pSbProgram sbobj; sbobj = scriba_new(malloc,free); RETURN_FUNCTION(sbobj);END_FUNCTION FUNCTION int SB_Configure(unsigned long sbobj, char PTR cfgfilename)BEGIN_FUNCTION DIM AS int rtnval = -1; rtnval = scriba_LoadConfiguration(sbobj, cfgfilename); RETURN_FUNCTION(rtnval);END_FUNCTION FUNCTION int SB_Load(unsigned long sbobj, char PTR sbfilename)BEGIN_FUNCTION DIM AS int rtnval = -1; rtnval = scriba_SetFileName(sbobj, sbfilename); scriba_LoadSourceProgram(sbobj); RETURN_FUNCTION(rtnval);END_FUNCTION FUNCTION int SB_LoadStr(unsigned long sbobj, char PTR sbpgm)BEGIN_FUNCTION DIM AS int rtnval = -1; scriba_SetFileName(sbobj, "fake"); rtnval = scriba_LoadProgramString(sbobj, sbpgm, strlen(sbpgm)); RETURN_FUNCTION(rtnval);END_FUNCTION FUNCTION int SB_Run(unsigned long sbobj, char PTR sbcmdline)BEGIN_FUNCTION DIM AS int rtnval; IF (besARGNR < 2) THEN_DO sbcmdline = ""; rtnval = scriba_Run(sbobj, sbcmdline); RETURN_FUNCTION(rtnval);END_FUNCTION FUNCTION int SB_NoRun(unsigned long sbobj)BEGIN_FUNCTION DIM AS int rtnval; rtnval = scriba_NoRun(sbobj); RETURN_FUNCTION(rtnval);END_FUNCTION FUNCTION int SB_ThreadStart(char PTR pszProgramFileName, char PTR pszCmdLineArgs, char PTR pszConfigFileName)BEGIN_FUNCTION DIM AS struct _RunServiceProgram PTR pRSP; DIM AS THREADHANDLE T; DIM AS unsigned long rtnval; pRSP = (struct _RunServiceProgram PTR)malloc( sizeof(struct _RunServiceProgram) ); pRSP->pszProgramFileName = (char PTR)malloc(strlen(pszProgramFileName) + 1); strcpy(pRSP->pszProgramFileName,pszProgramFileName); IF (pszCmdLineArgs NE NULL) THEN pRSP->pszCmdLineArgs = (char PTR)malloc(strlen(pszCmdLineArgs) + 1); strcpy(pRSP->pszCmdLineArgs,pszCmdLineArgs); ELSE pRSP->pszCmdLineArgs = NULL; END_IF IF (pszConfigFileName NE NULL) THEN pRSP->pszConfigFileName = (char PTR)malloc(strlen(pszConfigFileName) + 1); strcpy(pRSP->pszConfigFileName,pszConfigFileName); ELSE pRSP->pszConfigFileName = NULL; END_IF pRSP->iRestart = 0; thread_CreateThread(AT T,ExecuteProgramThread,pRSP); usleep(500); rtnval = pRSP->pTProgram; RETURN_FUNCTION(rtnval);END_FUNCTION SUB SB_ThreadEnd()BEGIN_SUB thread_ExitThread();END_SUB SUB SB_Destroy(unsigned long sbobj) scriba_destroy(sbobj);END_SUB FUNCTION int SB_CallSub(unsigned long sbobj, char PTR funcname) DIM AS int funcsernum; funcsernum = scriba_LookupFunctionByName(sbobj, funcname); RETURN_FUNCTION(scriba_Call(sbobj, funcsernum));END_FUNCTION besFUNCTION(SB_CallSubArgs) DIM AS VARIABLE Argument; DIM AS SbData ArgData[8]; DIM AS SbData FunctionResult; DIM AS unsigned long sbobj; DIM AS char PTR funcname; DIM AS int i, sbtype, fnsn; Argument = besARGUMENT(1); besDEREFERENCE(Argument); sbobj = LONGVALUE(Argument); Argument = besARGUMENT(2); besDEREFERENCE(Argument); funcname = STRINGVALUE(Argument); DEF_FOR (i = 3 TO i <= besARGNR STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); SELECT_CASE (sbtype = TYPE(Argument)) BEGIN_SELECT CASE VTYPE_LONG: ArgData[i-3] = PTR scriba_NewSbLong(sbobj, LONGVALUE(Argument)); END_CASE CASE VTYPE_DOUBLE: ArgData[i-3] = PTR scriba_NewSbDouble(sbobj, DOUBLEVALUE(Argument)); END_CASE CASE VTYPE_STRING: ArgData[i-3] = PTR scriba_NewSbString(sbobj, STRINGVALUE(Argument)); END_CASE CASE_ELSE ArgData[i-3] = PTR scriba_NewSbUndef(sbobj); END_CASE END_SELECT NEXT fnsn = scriba_LookupFunctionByName(sbobj, funcname); scriba_CallArgEx(sbobj, fnsn, AT FunctionResult, besARGNR - 2, AT ArgData); SELECT_CASE (FunctionResult.type) BEGIN_SELECT CASE SBT_LONG: besRETURN_LONG(FunctionResult.v.l); END_CASE CASE SBT_DOUBLE: besRETURN_DOUBLE(FunctionResult.v.d); END_CASE CASE SBT_STRING: besRETURN_STRING(FunctionResult.v.s); END_CASE CASE SBT_UNDEF: besRETURNVALUE = NULL; END_CASE END_SELECTbesEND besFUNCTION(SB_GetVar) DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn; DIM AS char PTR varname; besARGUMENTS("iz") AT sbobj, AT varname besARGEND vsn = scriba_LookupVariableByName(sbobj, varname); scriba_GetVariable(sbobj, vsn, AT varobj); SELECT_CASE (scriba_GetVariableType(sbobj, vsn)) BEGIN_SELECT CASE SBT_LONG : besRETURN_LONG(varobj[0].v.l); END_CASE CASE SBT_DOUBLE : besRETURN_DOUBLE(varobj[0].v.d); END_CASE CASE SBT_STRING : besRETURN_STRING(varobj[0].v.s); END_CASE CASE SBT_UNDEF : besRETURNVALUE = NULL; END_CASE END_SELECTbesEND FUNCTION int SB_SetUndef(unsigned long sbobj, char PTR varname)BEGIN_FUNCTION DIM AS pSbData varobj; DIM AS int vsn; vsn = scriba_LookupVariableByName(sbobj, varname); RETURN_FUNCTION(scriba_SetVariable(sbobj, vsn, SBT_UNDEF, NULL, 0, "", 0));END_FUNCTION FUNCTION int SB_SetInt()BEGIN_FUNCTION DIM AS VARIABLE Argument; DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn, usrval, i; DIM AS char PTR varname; IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS); DEF_FOR (i = 1 TO i <= 3 STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument); IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument); IF (i EQ 3) THEN_DO usrval = LONGVALUE(Argument); NEXT vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_LONG, usrval, 0, "", 0));besEND besFUNCTION(SB_SetDbl) DIM AS VARIABLE Argument; DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn, i; DIM AS char PTR varname; DIM AS double usrval; IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS); DEF_FOR (i = 1 TO i <= 3 STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument); IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument); IF (i EQ 3) THEN_DO usrval = DOUBLEVALUE(Argument); NEXT vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_DOUBLE, 0, usrval, "", 0));besEND besFUNCTION(SB_SetStr) DIM AS VARIABLE Argument; DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn, i; DIM AS char PTR varname; DIM AS char PTR usrval; IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS); DEF_FOR (i = 1 TO i <= 3 STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument); IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument); IF (i EQ 3) THEN_DO usrval = STRINGVALUE(Argument); NEXT vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_STRING, 0, 0, usrval, strlen(usrval)));besEND SUB SB_ResetVars(unsigned long sbobj)BEGIN_SUB scriba_ResetVariables(sbobj);END_SUB SUB SB_msSleep(long t)BEGIN_SUB usleep(t);END_SUB
John Spikowski:
AIR,
It looks like I'm going to need a varidac style function to handle the variable number of arguments for the SB_CallSubArgs function, (last function in the code) The various return types is also an issue.
THIS post on AllBASIC may refresh our nmemories.
If you know a better way, I'm all ears.
--- Code: C ---// ScriptBasic Shared Object #include <stdio.h>#include <stdlib.h>#include <string.h>#include <ctype.h>#include <math.h>#include <time.h>#include <unistd.h>#include "/home/ubuntu/sb-dev-master/basext.h"#include "/home/ubuntu/sb-dev-master/scriba.h"#include "cbasic.h" /*********************** Statc Support Routines***********************/ struct _RunServiceProgram { char *pszProgramFileName; char *pszCmdLineArgs; char *pszConfigFileName; pSbProgram pTProgram; int iRestart; }; static void ExecuteProgramThread(void *p){ pSbProgram pProgram; char szInputFile[1024]; int iErrorCode; struct _RunServiceProgram *pRSP; pRSP = p; strcpy(szInputFile,pRSP->pszProgramFileName); pProgram = scriba_new(malloc,free); pRSP->pTProgram = pProgram; if( pProgram == NULL )return; scriba_SetFileName(pProgram,szInputFile); if (pRSP->pszConfigFileName != NULL){ strcpy(szInputFile,pRSP->pszConfigFileName); scriba_LoadConfiguration(pProgram, pRSP->pszConfigFileName); }else{ scriba_SetProcessSbObject(pProgram,pProgram); } scriba_LoadSourceProgram(pProgram); if (pRSP->pszCmdLineArgs != NULL){ strcpy(szInputFile,pRSP->pszCmdLineArgs); iErrorCode = scriba_Run(pProgram,pRSP->pszCmdLineArgs); }else{ iErrorCode = scriba_Run(pProgram,NULL); }// scriba_destroy(pProgram); return;} /***************************** ScriptBasic Object Functions*****************************/ FUNCTION long SB_New()BEGIN_FUNCTION DIM AS pSbProgram sbobj; sbobj = scriba_new(malloc,free); RETURN_FUNCTION(sbobj);END_FUNCTION FUNCTION int SB_Configure(unsigned long sbobj, char PTR cfgfilename)BEGIN_FUNCTION DIM AS int rtnval = -1; rtnval = scriba_LoadConfiguration(sbobj, cfgfilename); RETURN_FUNCTION(rtnval);END_FUNCTION FUNCTION int SB_Load(unsigned long sbobj, char PTR sbfilename)BEGIN_FUNCTION DIM AS int rtnval = -1; rtnval = scriba_SetFileName(sbobj, sbfilename); scriba_LoadSourceProgram(sbobj); RETURN_FUNCTION(rtnval);END_FUNCTION FUNCTION int SB_LoadStr(unsigned long sbobj, char PTR sbpgm)BEGIN_FUNCTION DIM AS int rtnval = -1; scriba_SetFileName(sbobj, "fake"); rtnval = scriba_LoadProgramString(sbobj, sbpgm, strlen(sbpgm)); RETURN_FUNCTION(rtnval);END_FUNCTION FUNCTION int SB_Run(unsigned long sbobj, char PTR sbcmdline)BEGIN_FUNCTION DIM AS int rtnval; IF (besARGNR < 2) THEN_DO sbcmdline = ""; rtnval = scriba_Run(sbobj, sbcmdline); RETURN_FUNCTION(rtnval);END_FUNCTION FUNCTION int SB_NoRun(unsigned long sbobj)BEGIN_FUNCTION DIM AS int rtnval; rtnval = scriba_NoRun(sbobj); RETURN_FUNCTION(rtnval);END_FUNCTION FUNCTION int SB_ThreadStart(char PTR pszProgramFileName, char PTR pszCmdLineArgs, char PTR pszConfigFileName)BEGIN_FUNCTION DIM AS struct _RunServiceProgram PTR pRSP; DIM AS THREADHANDLE T; DIM AS unsigned long rtnval; pRSP = (struct _RunServiceProgram PTR)malloc( sizeof(struct _RunServiceProgram) ); pRSP->pszProgramFileName = (char PTR)malloc(strlen(pszProgramFileName) + 1); strcpy(pRSP->pszProgramFileName,pszProgramFileName); IF (pszCmdLineArgs NE NULL) THEN pRSP->pszCmdLineArgs = (char PTR)malloc(strlen(pszCmdLineArgs) + 1); strcpy(pRSP->pszCmdLineArgs,pszCmdLineArgs); ELSE pRSP->pszCmdLineArgs = NULL; END_IF IF (pszConfigFileName NE NULL) THEN pRSP->pszConfigFileName = (char PTR)malloc(strlen(pszConfigFileName) + 1); strcpy(pRSP->pszConfigFileName,pszConfigFileName); ELSE pRSP->pszConfigFileName = NULL; END_IF pRSP->iRestart = 0; thread_CreateThread(AT T,ExecuteProgramThread,pRSP); usleep(500); rtnval = pRSP->pTProgram; RETURN_FUNCTION(rtnval);END_FUNCTION SUB SB_ThreadEnd()BEGIN_SUB thread_ExitThread();END_SUB SUB SB_Destroy(unsigned long sbobj) scriba_destroy(sbobj);END_SUB FUNCTION long SB_GetLong(unsigned long sbobj, char PTR varname)BEGIN_FUNCTION DIM AS pSbData varobj; DIM AS int vsn; vsn = scriba_LookupVariableByName(sbobj, varname); scriba_GetVariable(sbobj, vsn, AT varobj); RETURN_FUNCTION(varobj[0].v.l);END_FUNCTION FUNCTION double SB_GetDouble(unsigned long sbobj, char PTR varname)BEGIN_FUNCTION DIM AS pSbData varobj; DIM AS int vsn; vsn = scriba_LookupVariableByName(sbobj, varname); scriba_GetVariable(sbobj, vsn, AT varobj); RETURN_FUNCTION(varobj[0].v.d);END_FUNCTION FUNCTION PTR char SB_GetString(unsigned long sbobj, char PTR varname)BEGIN_FUNCTION DIM AS pSbData varobj; DIM AS int vsn; vsn = scriba_LookupVariableByName(sbobj, varname); scriba_GetVariable(sbobj, vsn, AT varobj); RETURN_FUNCTION(varobj[0].v.s);END_FUNCTION FUNCTION int SB_SetUndef(unsigned long sbobj, char PTR varname)BEGIN_FUNCTION DIM AS pSbData varobj; DIM AS int vsn; vsn = scriba_LookupVariableByName(sbobj, varname); RETURN_FUNCTION(scriba_SetVariable(sbobj, vsn, SBT_UNDEF, NULL, 0, "", 0));END_FUNCTION FUNCTION int SB_SetInt(unsigned long sbobj, char PTR varname, int usrval)BEGIN_FUNCTION DIM AS pSbData varobj; DIM AS int vsn; vsn = scriba_LookupVariableByName(sbobj, varname); RETURN_FUNCTION(scriba_SetVariable(sbobj, vsn, SBT_LONG, usrval, 0, "", 0));END_FUNCTION FUNCTION int SB_SetDbl(unsigned long sbobj, char PTR varname, double usrval)BEGIN_FUNCTION DIM AS pSbData varobj; DIM AS int vsn; vsn = scriba_LookupVariableByName(sbobj, varname); RETURN_FUNCTION(scriba_SetVariable(sbobj, vsn, SBT_DOUBLE, 0, usrval, "", 0));END_FUNCTION FUNCTION int SB_SetStr(unsigned long sbobj, char PTR varname, char PTR usrval)BEGIN_FUNCTION DIM AS pSbData varobj; DIM AS int vsn; vsn = scriba_LookupVariableByName(sbobj, varname); RETURN_FUNCTION(scriba_SetVariable(sbobj, vsn, SBT_STRING, 0, 0, usrval, strlen(usrval)));END_FUNCTION SUB SB_ResetVars(unsigned long sbobj)BEGIN_SUB scriba_ResetVariables(sbobj);END_SUB SUB SB_msSleep(long t)BEGIN_SUB usleep(t);END_SUB FUNCTION int SB_CallSub(unsigned long sbobj, char PTR funcname) DIM AS int funcsernum; funcsernum = scriba_LookupFunctionByName(sbobj, funcname); RETURN_FUNCTION(scriba_Call(sbobj, funcsernum));END_FUNCTION besFUNCTION(SB_CallSubArgs) DIM AS VARIABLE Argument; DIM AS SbData ArgData[8]; DIM AS SbData FunctionResult; DIM AS unsigned long sbobj; DIM AS char PTR funcname; DIM AS int i, sbtype, fnsn; Argument = besARGUMENT(1); besDEREFERENCE(Argument); sbobj = LONGVALUE(Argument); Argument = besARGUMENT(2); besDEREFERENCE(Argument); funcname = STRINGVALUE(Argument); DEF_FOR (i = 3 TO i <= besARGNR STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); SELECT_CASE (sbtype = TYPE(Argument)) BEGIN_SELECT CASE VTYPE_LONG: ArgData[i-3] = PTR scriba_NewSbLong(sbobj, LONGVALUE(Argument)); END_CASE CASE VTYPE_DOUBLE: ArgData[i-3] = PTR scriba_NewSbDouble(sbobj, DOUBLEVALUE(Argument)); END_CASE CASE VTYPE_STRING: ArgData[i-3] = PTR scriba_NewSbString(sbobj, STRINGVALUE(Argument)); END_CASE CASE_ELSE ArgData[i-3] = PTR scriba_NewSbUndef(sbobj); END_CASE END_SELECT NEXT fnsn = scriba_LookupFunctionByName(sbobj, funcname); scriba_CallArgEx(sbobj, fnsn, AT FunctionResult, besARGNR - 2, AT ArgData); SELECT_CASE (FunctionResult.type) BEGIN_SELECT CASE SBT_LONG: besRETURN_LONG(FunctionResult.v.l); END_CASE CASE SBT_DOUBLE: besRETURN_DOUBLE(FunctionResult.v.d); END_CASE CASE SBT_STRING: besRETURN_STRING(FunctionResult.v.s); END_CASE CASE SBT_UNDEF: besRETURNVALUE = NULL; END_CASE END_SELECTbesEND
Navigation
[0] Message Index
[#] Next page
Go to full version