Author Topic: Script BASIC Thread Support  (Read 1262 times)

0 Members and 1 Guest are viewing this topic.

John Spikowski

  • Posts: 47
Script BASIC Thread Support
« on: November 06, 2017, 08:45:27 pm »
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
  1. /*  SBT (Script BASIC Thread) - Extension Module */
  2.  
  3. #include <stdio.h>
  4. #include <stdlib.h>
  5. #include <string.h>
  6. #include <ctype.h>
  7. #include <math.h>
  8. #include <time.h>
  9. #include <unistd.h>
  10. #include "../../basext.h"
  11. #include "../../scriba.h"
  12. #include "cbasic.h"
  13.  
  14.  
  15. /****************************
  16.  Extension Module Functions
  17. ****************************/
  18.  
  19. besVERSION_NEGOTIATE
  20.   RETURN_FUNCTION((int)INTERFACE_VERSION);
  21. besEND
  22.  
  23. besSUB_START
  24.   DIM AS long PTR p;
  25.   besMODULEPOINTER = besALLOC(sizeof(long));
  26.   IF (besMODULEPOINTER EQ NULL) THEN_DO RETURN_FUNCTION(0);
  27.   p = (long PTR)besMODULEPOINTER;
  28.   RETURN_FUNCTION(0);
  29. besEND
  30.  
  31. besSUB_FINISH
  32.   DIM AS long PTR p;
  33.   p = (long PTR)besMODULEPOINTER;
  34.   IF (p EQ NULL) THEN_DO RETURN_FUNCTION(0);
  35.   RETURN_FUNCTION(0);
  36. besEND
  37.  
  38.  
  39. /**********************
  40.  Script BASIC Instance
  41. **********************/
  42.  
  43. /******************
  44.  Support Routines
  45. ******************/
  46.  
  47. struct _RunServiceProgram {
  48.   char *pszProgramFileName;
  49.   char *pszCmdLineArgs;
  50.   char *pszConfigFileName;
  51.   pSbProgram pTProgram;
  52.   int iRestart;
  53.   };
  54.  
  55. static void ExecuteProgramThread(void *p){
  56.   pSbProgram pProgram;
  57.   char szInputFile[1024];
  58.   int iErrorCode;
  59.   struct _RunServiceProgram *pRSP;
  60.   pRSP = p;
  61.   strcpy(szInputFile,pRSP->pszProgramFileName);
  62.   pProgram = scriba_new(malloc,free);
  63.   pRSP->pTProgram = pProgram;
  64.   if( pProgram == NULL )return;
  65.   scriba_SetFileName(pProgram,szInputFile);
  66.   if (pRSP->pszConfigFileName != NULL){
  67.         strcpy(szInputFile,pRSP->pszConfigFileName);
  68.         scriba_LoadConfiguration(pProgram, pRSP->pszConfigFileName);
  69.   }else{
  70.         scriba_SetProcessSbObject(pProgram,pProgram);
  71.   }    
  72.   scriba_LoadSourceProgram(pProgram);
  73.   if (pRSP->pszCmdLineArgs != NULL){
  74.         strcpy(szInputFile,pRSP->pszCmdLineArgs);
  75.     iErrorCode = scriba_Run(pProgram,pRSP->pszCmdLineArgs);
  76.   }else{
  77.     iErrorCode = scriba_Run(pProgram,NULL);
  78.   }    
  79. //  scriba_destroy(pProgram);
  80.   return;
  81. }
  82.  
  83. besFUNCTION(SB_New)
  84.   DIM AS pSbProgram sbobj;
  85.   sbobj = scriba_new(malloc,free);
  86.   besRETURN_LONG(sbobj);
  87. besEND
  88.  
  89. besFUNCTION(SB_Configure)
  90.   DIM AS unsigned long sbobj;
  91.   DIM AS char PTR cfgfilename;
  92.   DIM AS int rtnval = -1;
  93.   besARGUMENTS("iz")
  94.     AT sbobj, AT cfgfilename
  95.   besARGEND
  96.   rtnval = scriba_LoadConfiguration(sbobj, cfgfilename);
  97.   besRETURN_LONG(rtnval);
  98. besEND
  99.  
  100. besFUNCTION(SB_Load)
  101.   DIM AS unsigned long sbobj;
  102.   DIM AS char PTR sbfilename;
  103.   DIM AS int rtnval = -1;
  104.   besARGUMENTS("iz")
  105.     AT sbobj, AT sbfilename
  106.   besARGEND
  107.   rtnval = scriba_SetFileName(sbobj, sbfilename);
  108.   scriba_LoadSourceProgram(sbobj);
  109.   besRETURN_LONG(rtnval);
  110. besEND
  111.  
  112. besFUNCTION(SB_LoadStr)
  113.   DIM AS unsigned long sbobj;
  114.   DIM AS char PTR sbpgm;
  115.   DIM AS int rtnval = -1;
  116.   besARGUMENTS("iz")
  117.     AT sbobj, AT sbpgm
  118.   besARGEND
  119.   scriba_SetFileName(sbobj, "fake");
  120.   rtnval = scriba_LoadProgramString(sbobj, sbpgm, strlen(sbpgm));
  121.   besRETURN_LONG(rtnval);
  122. besEND
  123.  
  124. besFUNCTION(SB_Run)
  125.   DIM AS unsigned long sbobj;
  126.   DIM AS int rtnval;
  127.   DIM AS char PTR sbcmdline;
  128.   besARGUMENTS("iz")
  129.     AT sbobj, AT sbcmdline
  130.   besARGEND
  131.   IF (besARGNR < 2) THEN_DO sbcmdline = "";
  132.   rtnval = scriba_Run(sbobj, sbcmdline);
  133.   besRETURN_LONG(rtnval);
  134. besEND
  135.  
  136. besFUNCTION(SB_NoRun)
  137.   DIM AS unsigned long sbobj;
  138.   DIM AS int rtnval;
  139.   besARGUMENTS("i")
  140.     AT sbobj
  141.   besARGEND
  142.   rtnval = scriba_NoRun(sbobj);
  143.   besRETURN_LONG(rtnval);
  144. besEND
  145.  
  146. besFUNCTION(SB_ThreadStart)
  147.   DIM AS struct _RunServiceProgram PTR pRSP;
  148.   DIM AS THREADHANDLE T;
  149.   DIM AS char PTR pszProgramFileName;
  150.   DIM AS char PTR pszCmdLineArgs;
  151.   DIM AS char PTR pszConfigFileName;
  152.   DIM AS unsigned long rtnval;
  153.   besARGUMENTS("z[z][z]")
  154.     AT pszProgramFileName, AT pszCmdLineArgs, AT pszConfigFileName
  155.   besARGEND
  156.   pRSP = (struct _RunServiceProgram PTR)malloc( sizeof(struct _RunServiceProgram) );
  157.   pRSP->pszProgramFileName = (char PTR)malloc(strlen(pszProgramFileName) + 1);  
  158.   strcpy(pRSP->pszProgramFileName,pszProgramFileName);
  159.   IF (pszCmdLineArgs NE NULL) THEN
  160.     pRSP->pszCmdLineArgs = (char PTR)malloc(strlen(pszCmdLineArgs) + 1);  
  161.     strcpy(pRSP->pszCmdLineArgs,pszCmdLineArgs);
  162.   ELSE
  163.         pRSP->pszCmdLineArgs = NULL;
  164.   END_IF
  165.   IF (pszConfigFileName NE NULL) THEN
  166.     pRSP->pszConfigFileName = (char PTR)malloc(strlen(pszConfigFileName) + 1);  
  167.     strcpy(pRSP->pszConfigFileName,pszConfigFileName);
  168.   ELSE
  169.         pRSP->pszConfigFileName = NULL;
  170.   END_IF
  171.   pRSP->iRestart = 0;
  172.   thread_CreateThread(AT T,ExecuteProgramThread,pRSP);
  173.   usleep(500);
  174.   rtnval = pRSP->pTProgram;
  175.   besRETURN_LONG(rtnval);
  176. besEND
  177.  
  178. besFUNCTION(SB_ThreadEnd)
  179.   thread_ExitThread();
  180.   besRETURNVALUE = NULL;
  181. besEND
  182.  
  183. besFUNCTION(SB_Destroy)
  184.   DIM AS unsigned long sbobj;
  185.   besARGUMENTS("i")
  186.     AT sbobj
  187.   besARGEND
  188.   scriba_destroy(sbobj);
  189.   RETURN_FUNCTION(0);
  190. besEND
  191.  
  192. besFUNCTION(SB_CallSub)
  193.   DIM AS unsigned long sbobj;
  194.   DIM AS int funcsernum;
  195.   DIM AS char PTR funcname;
  196.   besARGUMENTS("iz")
  197.     AT sbobj, AT funcname
  198.   besARGEND
  199.   funcsernum = scriba_LookupFunctionByName(sbobj, funcname);
  200.   besRETURN_LONG(scriba_Call(sbobj, funcsernum));
  201. besEND
  202.  
  203. besFUNCTION(SB_CallSubArgs)
  204.   DIM AS VARIABLE Argument;
  205.   DIM AS SbData ArgData[8];
  206.   DIM AS SbData FunctionResult;
  207.   DIM AS unsigned long sbobj;
  208.   DIM AS char PTR funcname;
  209.   DIM AS int i, sbtype, fnsn;
  210.  
  211.   Argument = besARGUMENT(1);
  212.   besDEREFERENCE(Argument);
  213.   sbobj = LONGVALUE(Argument);
  214.  
  215.   Argument = besARGUMENT(2);
  216.   besDEREFERENCE(Argument);
  217.   funcname = STRINGVALUE(Argument);
  218.  
  219.   DEF_FOR (i = 3 TO i <= besARGNR STEP INCR i)
  220.   BEGIN_FOR
  221.     Argument = besARGUMENT(i);
  222.     besDEREFERENCE(Argument);
  223.     SELECT_CASE (sbtype = TYPE(Argument))
  224.     BEGIN_SELECT
  225.       CASE VTYPE_LONG:
  226.         ArgData[i-3] = PTR scriba_NewSbLong(sbobj, LONGVALUE(Argument));
  227.         END_CASE
  228.       CASE VTYPE_DOUBLE:
  229.         ArgData[i-3] = PTR scriba_NewSbDouble(sbobj, DOUBLEVALUE(Argument));
  230.         END_CASE
  231.       CASE VTYPE_STRING:
  232.         ArgData[i-3] = PTR scriba_NewSbString(sbobj, STRINGVALUE(Argument));
  233.         END_CASE
  234.       CASE_ELSE
  235.         ArgData[i-3] = PTR scriba_NewSbUndef(sbobj);
  236.         END_CASE
  237.     END_SELECT
  238.   NEXT
  239.  
  240.   fnsn = scriba_LookupFunctionByName(sbobj, funcname);
  241.   scriba_CallArgEx(sbobj, fnsn, AT FunctionResult, besARGNR - 2, AT ArgData);
  242.  
  243.   SELECT_CASE (FunctionResult.type)
  244.   BEGIN_SELECT
  245.     CASE SBT_LONG:
  246.       besRETURN_LONG(FunctionResult.v.l);
  247.       END_CASE
  248.     CASE SBT_DOUBLE:
  249.       besRETURN_DOUBLE(FunctionResult.v.d);
  250.       END_CASE
  251.     CASE SBT_STRING:
  252.       besRETURN_STRING(FunctionResult.v.s);
  253.       END_CASE
  254.     CASE SBT_UNDEF:
  255.       besRETURNVALUE = NULL;
  256.       END_CASE
  257.   END_SELECT
  258. besEND
  259.  
  260. besFUNCTION(SB_GetVar)
  261.   DIM AS pSbData varobj;
  262.   DIM AS unsigned long sbobj;
  263.   DIM AS int vsn;
  264.   DIM AS char PTR varname;
  265.   besARGUMENTS("iz")
  266.     AT sbobj, AT varname
  267.   besARGEND
  268.   vsn = scriba_LookupVariableByName(sbobj, varname);
  269.   scriba_GetVariable(sbobj, vsn, AT varobj);
  270.   SELECT_CASE (scriba_GetVariableType(sbobj, vsn))
  271.   BEGIN_SELECT
  272.     CASE SBT_LONG   :
  273.       besRETURN_LONG(varobj[0].v.l);
  274.       END_CASE
  275.     CASE SBT_DOUBLE :
  276.       besRETURN_DOUBLE(varobj[0].v.d);
  277.       END_CASE
  278.     CASE SBT_STRING :
  279.       besRETURN_STRING(varobj[0].v.s);
  280.       END_CASE
  281.     CASE SBT_UNDEF  :
  282.       besRETURNVALUE = NULL;;
  283.       END_CASE
  284.   END_SELECT
  285. besEND
  286.  
  287. besFUNCTION(SB_SetUndef)
  288.   DIM AS pSbData varobj;
  289.   DIM AS unsigned long sbobj;
  290.   DIM AS int vsn;
  291.   DIM AS char PTR varname;
  292.   besARGUMENTS("iz")
  293.     AT sbobj, AT varname
  294.   besARGEND
  295.   vsn = scriba_LookupVariableByName(sbobj, varname);
  296.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_UNDEF, NULL, 0, "", 0));
  297. besEND
  298.  
  299. besFUNCTION(SB_SetInt)
  300.   DIM AS VARIABLE Argument;
  301.   DIM AS pSbData varobj;
  302.   DIM AS unsigned long sbobj;
  303.   DIM AS int vsn, usrval, i;
  304.   DIM AS char PTR varname;
  305.   IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  306.   DEF_FOR (i = 1 TO i <= 3 STEP INCR i)
  307.   BEGIN_FOR
  308.     Argument = besARGUMENT(i);
  309.     besDEREFERENCE(Argument);
  310.     IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument);
  311.     IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument);
  312.     IF (i EQ 3) THEN_DO usrval = LONGVALUE(Argument);
  313.   NEXT
  314.   vsn = scriba_LookupVariableByName(sbobj, varname);
  315.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_LONG, usrval, 0, "", 0));
  316. besEND
  317.  
  318. besFUNCTION(SB_SetDbl)
  319.   DIM AS VARIABLE Argument;
  320.   DIM AS pSbData varobj;
  321.   DIM AS unsigned long sbobj;
  322.   DIM AS int vsn, i;
  323.   DIM AS char PTR varname;
  324.   DIM AS double usrval;
  325.   IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  326.   DEF_FOR (i = 1 TO i <= 3 STEP INCR i)
  327.   BEGIN_FOR
  328.     Argument = besARGUMENT(i);
  329.     besDEREFERENCE(Argument);
  330.     IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument);
  331.     IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument);
  332.     IF (i EQ 3) THEN_DO usrval = DOUBLEVALUE(Argument);
  333.   NEXT
  334.   vsn = scriba_LookupVariableByName(sbobj, varname);
  335.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn,  SBT_DOUBLE, 0, usrval, "", 0));
  336. besEND
  337.  
  338. besFUNCTION(SB_SetStr)
  339.   DIM AS VARIABLE Argument;
  340.   DIM AS pSbData varobj;
  341.   DIM AS unsigned long sbobj;
  342.   DIM AS int vsn, i;
  343.   DIM AS char PTR varname;
  344.   DIM AS char PTR usrval;
  345.   IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  346.   DEF_FOR (i = 1 TO i <= 3 STEP INCR i)
  347.   BEGIN_FOR
  348.     Argument = besARGUMENT(i);
  349.     besDEREFERENCE(Argument);
  350.     IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument);
  351.     IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument);
  352.     IF (i EQ 3) THEN_DO usrval = STRINGVALUE(Argument);
  353.   NEXT
  354.   vsn = scriba_LookupVariableByName(sbobj, varname);
  355.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn,  SBT_STRING, 0, 0, usrval, strlen(usrval)));
  356. besEND
  357.  
  358. besFUNCTION(SB_ResetVars)
  359.   DIM AS unsigned long sbobj;
  360.   besARGUMENTS("i")
  361.     AT sbobj
  362.   besARGEND
  363.   scriba_ResetVariables(sbobj);
  364.   besRETURNVALUE = NULL;
  365. besEND
  366.  

sbt.inc - interpreter extension module include
Code: Script BASIC
  1. DECLARE SUB SB_New ALIAS "SB_New" LIB "sbt"
  2. DECLARE SUB SB_Configure ALIAS "SB_Configure" LIB "sbt"
  3. DECLARE SUB SB_Load ALIAS "SB_Load" LIB "sbt"
  4. DECLARE SUB SB_LoadStr ALIAS "SB_LoadStr" LIB "sbt"
  5. DECLARE SUB SB_Run ALIAS "SB_Run" LIB "sbt"
  6. DECLARE SUB SB_NoRun ALIAS "SB_NoRun" LIB "sbt"
  7. DECLARE SUB SB_ThreadStart ALIAS "SB_ThreadStart" LIB "sbt"
  8. DECLARE SUB SB_ThreadEnd ALIAS "SB_ThreadEnd" LIB "sbt"
  9. DECLARE SUB SB_GetVar ALIAS "SB_GetVar" LIB "sbt"
  10. DECLARE SUB SB_SetUndef ALIAS "SB_SetUndef" LIB "sbt"
  11. DECLARE SUB SB_SetInt ALIAS "SB_SetInt" LIB "sbt"
  12. DECLARE SUB SB_SetDbl ALIAS "SB_SetDbl" LIB "sbt"
  13. DECLARE SUB SB_SetStr ALIAS "SB_SetStr" LIB "sbt"
  14. DECLARE SUB SB_ResetVars ALIAS "SB_ResetVars" LIB "sbt"
  15. DECLARE SUB SB_CallSub ALIAS "SB_CallSub" LIB "sbt"
  16. DECLARE SUB SB_CallSubArgs ALIAS "SB_CallSubArgs" LIB "sbt"
  17. DECLARE SUB SB_Destroy ALIAS "SB_Destroy" LIB "sbt"
  18.  

sbtdemo.sb
Code: Script BASIC
  1. ' SBT (Script BASIC Thread) - Example Script
  2.  
  3. IMPORT sbt.inc
  4.  
  5. sb_code = """
  6. FUNCTION prtvars(a, b, c)
  7.  PRINT a,"\\n"
  8.  PRINT FORMAT("%g\\n", b)
  9.  PRINT c,"\\n"
  10.  prtvars = "Function Return"
  11. END FUNCTION
  12.  
  13. a = 0
  14. b = 0
  15. c = ""
  16. """
  17.  
  18. sb = SB_New()
  19. SB_Configure sb, "C:/Windows/SCRIBA.INI"
  20. SB_LoadStr sb, sb_code
  21. SB_NoRun sb
  22. funcrtn = SB_CallSubArgs(sb,"main::prtvars", 123, 1.23, "One, Two, Three")
  23. PRINT funcrtn,"\n"
  24. SB_Run sb, ""
  25. SB_SetInt sb, "main::a", 321
  26. SB_SetDbl sb, "main::b", 32.1
  27. SB_SetStr sb, "main::c", "Three,Two,One"
  28. SB_CallSubArgs sb, "main::prtvars", _
  29.           SB_GetVar(sb, "main::a"), _
  30.           SB_GetVar(sb, "main::b"), _
  31.           SB_GetVar(sb, "main::c")      
  32. SB_Destroy sb
  33.  

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.


« Last Edit: November 07, 2017, 03:35:27 am by John Spikowski »

John Spikowski

  • Posts: 47
Re: Script BASIC Thread Support
« Reply #1 on: November 06, 2017, 11:00:13 pm »
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
  1. IMPORT mt.bas
  2. IMPORT sbt.inc
  3.  
  4. SB_ThreadStart("tt1.sb", "JRS","C:/Windows/SCRIBA.INI")
  5. PRINT "SB Host\n"
  6. LINE INPUT wait
  7. PRINT mt::GetVariable("thread_status"),"\n"
  8.  

tt1.sb
Code: Script BASIC
  1. ' Test Thread
  2.  
  3. IMPORT mt.bas
  4. IMPORT sbt.inc
  5.  
  6. cmd = COMMAND()
  7. PRINT cmd,"\n"
  8.  
  9. FOR x = 1 TO 10
  10.   PRINT "Thread 1: ",x,"\n"
  11. NEXT
  12.  
  13. mt::SetVariable "thread_status","Completed"
  14.  
  15. SB_ThreadEnd
  16.  

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


« Last Edit: November 07, 2017, 12:15:27 am by John Spikowski »