Script BASIC Thread Support

Discussion Topics > Script BASIC

(1/1)

John Spikowski:
I have embedded Script BASIC into itself as an easy to use threaded interface using the Script BASIC embedding and extension API's. I used the C BASIC C preprocessor defines to extend Script BASIC's extensive macro and define definitions in the interface.c design for readability. This allows the user to run multiple Script BASIC programs independently or like a RUN that can be re-executed clearing variables (BEGIN) or not. This is unlike ProvideX spawning multiple copies of itself but a true single process with child threads. Best part threads can interact with the main process (access variables, call functions/subs, ...) or other child threads using the MT extension module.

SBT interface.c - extension module interface (C BASIC makes C look like BASIC)

--- Code: C ---/* SBT (Script BASIC Thread) - Extension Module */ #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
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 (Script BASIC Thread) - 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 above example loads a Scipt BASIC program as a multi-line string but not running it at first. This defines the function prtvars() and defines the names for the variables to be used but are still undef at this time. The main SB then calls the thread prtvars() function with argument values printing in main the return function value. Next we run the thread script which assigns the thread script variables from undef to 0./ "". The main program then sets these initialized thread script variables to real values. The main script calls the prtvars() thread script function again but this time using the variables in the thread script for the arguments.

This example has no practtical use other than showing off Script BASIC's interaction with thread processes.

John Spikowski:
Here is an example of using the MT extension module to communicate between threads and the host script. The command line and configuration file are optional arguments. If not passed, The threaded version of the script uses the internal defaults. This example is only showing one thread running. You need to be there to see the multi-thread version run.

ttmain.sb

--- Code: Script BASIC ---IMPORT mt.basIMPORT sbt.inc SB_ThreadStart("tt1.sb", "JRS","C:/Windows/SCRIBA.INI")PRINT "SB Host\n"LINE INPUT waitPRINT mt::GetVariable("thread_status"),"\n"
tt1.sb

--- Code: Script BASIC ---' Test Thread IMPORT mt.basIMPORT sbt.inc cmd = COMMAND()PRINT cmd,"\n" FOR x = 1 TO 10 PRINT "Thread 1: ",x,"\n"NEXT mt::SetVariable "thread_status","Completed" SB_ThreadEnd
Output

SB Host
JRS
Thread 1: 1
Thread 1: 2
Thread 1: 3
Thread 1: 4
Thread 1: 5
Thread 1: 6
Thread 1: 7
Thread 1: 8
Thread 1: 9
Thread 1: 10

Completed

Navigation

[0] Message Index

Go to full version