SBT - Script BASIC Tutorial API extension module

[Support]

I have embedded Script BASIC into itself as an easy to use example of the 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.

Current SBT Download Attached


SBT interface.c
/*  SBT (Script BASIC Tutorial) - 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_SELECT
besEND

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_SELECT
besEND

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
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
' SBT (Script BASIC Tutorial) - 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 = 0
b = 0
c = ""
"""

sb = SB_New()
SB_Configure sb, "/etc/scriba/basic.conf"
SB_LoadStr sb, sb_code
SB_NoRun sb
funcrtn = SB_CallSubArgs(sb,"main::prtvars", 123, 1.23, "One, Two, Three")
PRINT funcrtn,"\n"
SB_Run sb, ""
SB_SetInt sb, "main::a", 321
SB_SetDbl sb, "main::b", 32.1
SB_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

jrs@laptop:~/sb/sb22/sbt$ time scriba sbtdemo.sb
123
1.23
One, Two, Three
Function Return
321
32.1
Three,Two,One

real   0m0.007s
user   0m0.007s
sys   0m0.000s
jrs@laptop:~/sb/sb22/sbt$

[Support]

I have added thread support to the SBT extension module. It also supports the MT multi-threaded shared (lockable R/W) variable and session manager.

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 method doesn't provide the paths to the modules & include directory that the configuration file provides. As long as you IMPORT your extension modules in the host script, a simple DECLARE of the function is all that is needed.

ttmain.sb
IMPORT mt.bas
IMPORT sbt.inc

SB_ThreadStart("tt1.sb", "JRS","/etc/scriba/basic.conf")
PRINT "SB Host\n"
LINE INPUT wait
PRINT mt::GetVariable("thread_status"),"\n"
 
tt1.sb
' Test Thread

IMPORT mt.bas
IMPORT 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

jrs@laptop:~/sb/sb22/sbt$ scriba ttmain.sb
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
jrs@laptop:~/sb/sb22/sbt$

[Support]

I made a few improvement to the SBT extension module to allow threads to act more like the embedded API I started off with. A thread will not terminate at the end of its run. The script can be rerun in the thread if you like. You can access thread script variables, call FUNCTIONs and SUBs and use the MT extension module for thread status for the host or other threads.

tcallmain
IMPORT sbt.inc

sb = SB_ThreadStart("tcall.sb",undef,"/etc/scriba/basic.conf")
SB_SetInt sb, "main::a", 123
SB_SetDbl sb, "main::b", 1.23
SB_SetStr sb, "main::c", "One, Two, Three"
funcrtn = SB_CallSubArgs(sb, "main::prtvars", _
          SB_GetVar(sb, "main::a"), _
          SB_GetVar(sb, "main::b"), _
          SB_GetVar(sb, "main::c"))      
PRINT funcrtn,"\n"
SB_Destroy sb
 
tcall.sb
FUNCTION prtvars(a, b, c)    
  PRINT a,"\n"              
  PRINT FORMAT("%g\n", b)  
  PRINT c,"\n"              
  prtvars = "Function Return"
END FUNCTION                
                             
a = 0                        
b = 0                        
c = ""                      
 

jrs@laptop:~/sb/sb22/sbt$ scriba tcallmain.sb
123
1.23
One, Two, Three
Function Return
jrs@laptop:~/sb/sb22/sbt$


Here is an example of rerunning a script in an existing thread.

IMPORT sbt.inc

sb = SB_ThreadStart("tprint.sb")
SB_Run(sb,"")
SB_Destroy(sb)
 
PRINT 123,"\n"
PRINT FORMAT("%g\n",1.23)
PRINT "One,Two,Three\n"
 

jrs@laptop:~/sb/sb22/sbt$ scriba tpmain.sb
123
1.23
One,Two,Three
123
1.23
One,Two,Three
jrs@laptop:~/sb/sb22/sbt$

[Support]

Here is an example of IUP running in a threaded mode with the DLLC extension module for Windows 32 bit.

The DLLC Windows 32 bit extension module can be found in the current OxygenBasic build and maintained by Charles Pegge.







Thread #1 script
' Thread #1 Script

INCLUDE "dllcinc.sb"

iup = dllfile("iup.dll")

IupOpen          = dllproc(iup,"IupOpen          cdecl i = (i argc, i argv)")
IupCreate        = dllproc(iup,"IupCreate        cdecl i = (c *classname)")
IupSetAttributes = dllproc(iup,"IupSetAttributes cdecl i = (i ih, c *attr_str)")
IupAppend        = dllproc(iup,"IupAppend        cdecl i = (i ih, cdecl i new_child)")
IupSetCallback   = dllproc(iup,"IupSetCallback   cdecl i = (i ih, c*cb_name, i funcaddr)")
IupShow          = dllproc(iup,"IupShow          cdecl i = (i ih)")
IupMainLoop      = dllproc(iup,"IupMainLoop      cdecl i = ()")
IupClose         = dllproc(iup,"IupClose         cdecl     ()")

GLOBAL CONST IUP_DEFAULT = -2

FUNCTION Btn1_T1(ih, mbut, pstat)
  PRINT "B1 - T1 ", CHR(mbut), " - ", pstat, "\n"
  Btn1_clicked = IUP_DEFAULT
END FUNCTION

FUNCTION Btn2_T1(ih)
  dllprnt"B2 - T1\n"
  Btn2_clicked = IUP_DEFAULT
END FUNCTION

FUNCTION Btn3_T1(ih)
  dllprnt"B3 - T1\n"
  Btn3_clicked = IUP_DEFAULT
END FUNCTION

FUNCTION main(pProg,idat)
  dllcall(IupOpen, 0, 0)
  win = dllcall(IupCreate, "dialog")
  dllcall(IupSetAttributes, win, "TITLE=\"Thread #1\", SIZE=300x")
  horzbox = dllcall(IupCreate, "hbox")
  dllcall(IupSetAttributes, horzbox, "GAP=5")
  btn1 = dllcall(IupCreate, "button")
  dllcall(IupSetAttributes, btn1, "TITLE=Button1, EXPAND=HORIZONTAL")
  btn2 = dllcall(IupCreate, "button")
  dllcall(IupSetAttributes, btn2, "TITLE=Button2, EXPAND=HORIZONTAL")
  btn3 = dllcall(IupCreate, "button")
  dllcall(IupSetAttributes, btn3, "TITLE=Button3, EXPAND=HORIZONTAL")
  dllcall(IupAppend, horzbox, btn1)
  dllcall(IupAppend, horzbox, btn2)
  dllcall(IupAppend, horzbox, btn3)
  dllcall(IupAppend, win, horzbox)
  dllcall(IupSetCallback, btn1, "BUTTON_CB", dllclbk(1, pProg, "MAIN::Btn1_T1", 3,IUP_DEFAULT,idat))
  dllcall(IupSetCallback, btn2, "ACTION", dllclbk(2, pProg, "MAIN::Btn2_T1", 1,IUP_DEFAULT,idat))
  dllcall(IupSetCallback, btn3, "ACTION", dllclbk(3, pProg, "MAIN::Btn3_T1", 1,IUP_DEFAULT,idat))
  dllcall(IupShow, win)
  Main=IupMainLoop
END FUNCTION
 
Thread #2 script
' Thread #2 Script

INCLUDE "dllcinc.sb"

iup = dllfile("iup.dll")

IupOpen          = dllproc(iup,"IupOpen          cdecl i = (i argc, i argv)")
IupCreate        = dllproc(iup,"IupCreate        cdecl i = (c *classname)")
IupSetAttributes = dllproc(iup,"IupSetAttributes cdecl i = (i ih, c *attr_str)")
IupAppend        = dllproc(iup,"IupAppend        cdecl i = (i ih, cdecl i new_child)")
IupSetCallback   = dllproc(iup,"IupSetCallback   cdecl i = (i ih, c*cb_name, i funcaddr)")
IupShow          = dllproc(iup,"IupShow          cdecl i = (i ih)")
IupMainLoop      = dllproc(iup,"IupMainLoop      cdecl i = ()")
IupClose         = dllproc(iup,"IupClose         cdecl     ()")

GLOBAL CONST IUP_DEFAULT = -2

FUNCTION Btn1_T2(ih)
  dllprnt"B1 - T2\n"
  Btn1_clicked = IUP_DEFAULT
END FUNCTION

FUNCTION Btn2_T2(ih)
  dllprnt"B2 - T2\n"
  Btn2_clicked = IUP_DEFAULT
END FUNCTION

FUNCTION Btn3_T2(ih)
  dllprnt"B3 - T2\n"
  Btn3_clicked = IUP_DEFAULT
END FUNCTION

FUNCTION main(pProg,idat)
  dllcall(IupOpen, 0, 0)
  win = dllcall(IupCreate, "dialog")
  dllcall(IupSetAttributes, win, "TITLE=\"Thread #2\", SIZE=300x")
  horzbox = dllcall(IupCreate, "hbox")
  dllcall(IupSetAttributes, horzbox, "GAP=5")
  btn1 = dllcall(IupCreate, "button")
  dllcall(IupSetAttributes, btn1, "TITLE=Button1, EXPAND=HORIZONTAL")
  btn2 = dllcall(IupCreate, "button")
  dllcall(IupSetAttributes, btn2, "TITLE=Button2, EXPAND=HORIZONTAL")
  btn3 = dllcall(IupCreate, "button")
  dllcall(IupSetAttributes, btn3, "TITLE=Button3, EXPAND=HORIZONTAL")
  dllcall(IupAppend, horzbox, btn1)
  dllcall(IupAppend, horzbox, btn2)
  dllcall(IupAppend, horzbox, btn3)
  dllcall(IupAppend, win, horzbox)
  dllcall(IupSetCallback, btn1, "ACTION", dllclbk(4, pProg, "MAIN::Btn1_T2", 1,IUP_DEFAULT,idat))
  dllcall(IupSetCallback, btn2, "ACTION", dllclbk(5, pProg, "MAIN::Btn2_T2", 1,IUP_DEFAULT,idat))
  dllcall(IupSetCallback, btn3, "ACTION", dllclbk(6, pProg, "MAIN::Btn3_T2", 1,IUP_DEFAULT,idat))
  dllcall(IupShow, win)
  Main=IupMainLoop
END FUNCTION
 
Start script
' Boot (Main / Launcher)

INCLUDE "dllcinc.sb"
bdat=string(8192,chr(0))
idat=dllsptr(bdat)

thrM1 = dlltran("T1.sb","main::main",1,idat)
thrM2 = dlltran("T2.sb","main::main",2,idat)

LINE INPUT wait

dllclos thrM1,thrM2
dllfile
 

[Support]

Done!

I finally got this worked out and didn't have to inform Gtk or IUP that they're being threaded. 

I can click on either thread window's button as fast as I can and it responds with the being pressed message. The only minor issue I still have is the second thread window will open in max size and sometimes without a max/restore window button. At this point I'm happy.

iup.bas - callback handling functions
FUNCTION MainLoop
LOCAL hex_event
  LoopStep()
  this_event = GetEvent()
  hex_event = BB_HTA(this_event)
  IF hex_event = event{hex_event}[0] THEN
    IF event{hex_event}[2] = 1 THEN
      SB_CallSub(main::sb1, event{hex_event}[1])
    ELSEIF event{hex_event}[2] = 2 THEN
      SB_CallSub(main::sb2, event{hex_event}[1])
    END IF
    MainLoop = GetActionName()
  END IF  
END FUNCTION

FUNCTION SetThreadCallback(ih, aname, fname, tnum)
  t_event = mt::GetVariable("Callback_Map")
  IF t_event = undef THEN t_event = ""
  t_event = t_event & BB_HTA(ih) & "|" & fname & "|" & tnum & "\n"
  mt::SetVariable("Callback_Map", t_event)
  SetThreadCallback = __SetCallback(ih, aname)
END FUNCTION

SUB GetThreadCallback
  LOCAL t_event, e_list, e_array, x
  t_event = mt::GetVariable("Callback_Map")
  SPLITA t_event BY "\n" TO e_list
  FOR x = 0 TO UBOUND(e_list)
    SPLITA e_list[x] BY "|" TO e_array
    event{e_array[0]}[0] = e_array[0]
    event{e_array[0]}[1] = e_array[1]
    event{e_array[0]}[2] = e_array[2]
  NEXT
END SUB

FUNCTION BB_HTA(AsciiStr)
  LOCAL AsciiLen,ScanPos,HexStr
  AsciiLen = LEN(AsciiStr)
  HexStr = ""
  IF AsciiLen THEN
    FOR ScanPos = 1 TO AsciiLen
      HexStr &= RIGHT("0" & HEX(ASC(MID(AsciiStr, ScanPos, 1))),2)
    NEXT ScanPos
  ELSE
    HexStr = ""
  END IF
  BB_HTA = HexStr
END FUNCTION
 
iupmain.sb - host SB script (puppet master)
IMPORT mt.bas
IMPORT sbt.inc
IMPORT iup.bas

Iup::Open()

SUB SB_Wait(mtvar)
  WHILE mt::GetVariable(mtvar) <> "OK"
    SB_msSleep(5000)
  WEND
END SUB

sb1 = SB_ThreadStart("rqdemo1.sb",undef,"/etc/scriba/basic.conf")
SB_Wait("sb1_loaded")
sb1_rtn = SB_CallSubArgs(sb1, "main::main", sb1)

sb2 = SB_ThreadStart("rqdemo2.sb",undef,"/etc/scriba/basic.conf")
SB_Wait("sb2_loaded")
sb2_rtn = SB_CallSubArgs(sb2, "main::main", sb2)

threads = 2

Iup::GetThreadCallback()

WHILE threads
  event_class = Iup::MainLoop()
  IF event_class = "CLOSE_CB" THEN
    threads -= 1
    IF Iup::event{Iup::BB_HTA(Iup::this_event)}[2] = 1 THEN
      SB_CallSub(sb1, "iup::exitloop")
    ELSEIF Iup::event{Iup::BB_HTA(Iup::this_event)}[2] = 2 THEN
      SB_CallSub(sb2, "iup::exitloop")
    END IF
  END IF  
  SB_msSleep(250)
WEND

Iup::Close()
SB_Destroy(sb2)
SB_Destroy(sb1)
 
rqdemo1.sb - rqdemo2.sb is identical other than the references to it been the second thread.
' Script BASIC Rapid-Q form conversion

IMPORT mt.bas
IMPORT iup.bas

' CALLBACKS FUNCTIONS

SUB button_quit
  PRINT "Thread 1 Quit Button Pressed\n"
END SUB  

SUB win_exit
  ' Good-Bye  
END SUB

SUB main
 
  ' SBIUP-Q INIT

  Iup::Open()
  Iup::SetGlobal("DEFAULTFONT", "Sans, 7.5")
 
  ' CREATE FORM
 
  Form = Iup::Create("dialog")
         Iup::SetAttributes(Form, "RASTERSIZE=320x240, TITLE=\"Thread 1\"")
 
       Label1  = Iup::Create("label")
                 Iup::SetAttributes(Label1, "TITLE=\"Customer\", RASTERSIZE=55x13, FLOATING=YES, POSITION=\"19,19\"")
 
       Edit1   = Iup::Create("text")
                 Iup::SetAttributes(Edit1, "RASTERSIZE=121x21, FLOATING=YES, POSITION=\"72,16\"")
 
       Button1 = Iup::Create("button")
                 Iup::SetAttributes(Button1, "TITLE=\"&Quit\", RASTERSIZE=75x25, FLOATING=YES, POSITION=\"107,164\"")
 
  vbx = Iup::Vbox(Label1, Edit1, Button1)
  Iup::Append(Form, vbx)
                 
  ' SET CALLBACKS
 
  Iup::SetThreadCallback(Form, "CLOSE_CB", "main::win_exit", 1)
  Iup::SetThreadCallback(Button1, "ACTION", "main::button_quit", 1)
  Iup::Show(Form)
END SUB
mt::SetVariable("sb1_loaded","OK")
 

[Support]

The solution to my unstable IUP start-up issues were resolved with creating an IUP dialog in the parent script before creating threaded children dialogs.  I moved the Iup::MainLoop and Iup::GetThreadCallback routines into the main script from the IUP extension module. At this point everything is working as expected and I couldn't be happier.

Moral: How can you have well behaved children if you don't have a mature parent in charge? 

SBx_Main
' SBT IUP Theaded Example

IMPORT mt.bas
IMPORT sbt.inc
IMPORT iup.bas
IMPORT "SBx"

Iup::Open()

SUB SB_Wait(mtvar)
  WHILE mt::GetVariable(mtvar) <> "OK"
    SB_msSleep(5000)
  WEND
END SUB

SUB btn1_clicked
  PRINT "Main 0 Button 1 Pressed\n"
  PRINT "Which Mouse Button: ",CHR(Iup::GetBtnPressed()),"\n"
  PRINT "Button Up/Dn State: ",Iup::GetBtnState(),"\n"
END SUB

SUB btn2_clicked
  PRINT "Main 0 Button 2 Pressed\n"
END SUB

SUB btn3_clicked
  PRINT "Main 0 Button 3 Pressed\n"
END SUB

SUB win_exit
  ' Good-Bye
END SUB

win = DIALOG()
SETPROPERTIES win, "TITLE=\"SBx Main 0\", SIZE=300x"
horzbox = HBOX()
SETPROPERTIES horzbox, "GAP=5"
btn1 = BUTTON()
SETPROPERTIES btn1, "TITLE=\"Button 1\", EXPAND=HORIZONTAL"
btn2 = BUTTON()
SETPROPERTIES btn2, "TITLE=\"Button 2\", EXPAND=HORIZONTAL"
btn3 = BUTTON()
SETPROPERTIES btn3, "TITLE=\"Button 3\", EXPAND=HORIZONTAL"
APPEND horzbox, btn1
APPEND horzbox, btn2
APPEND horzbox, btn3
APPEND win, horzbox
Iup::SetThreadCallback(win, "CLOSE_CB", ADDRESS(win_exit()), 0)
Iup::SetThreadCallback(btn1, "BUTTON_CB", ADDRESS(btn1_clicked()), 0)
Iup::SetThreadCallback(btn2, "ACTION", ADDRESS(btn2_clicked()), 0)
Iup::SetThreadCallback(btn3, "ACTION", ADDRESS(btn3_clicked()), 0)
SHOW win

' Puppet Show

sb1 = SB_ThreadStart("SBx_T1",undef,"/etc/scriba/basic.conf")
SB_Wait("sb1_loaded")
sb1_rtn = SB_CallSubArgs(sb1, "main::main", sb1)

sb2 = SB_ThreadStart("SBx_T2",undef,"/etc/scriba/basic.conf")
SB_Wait("sb2_loaded")
sb2_rtn = SB_CallSubArgs(sb2, "main::main", sb2)

threads = 3

t_event = mt::GetVariable("Callback_Map")
SPLITA t_event BY "\n" TO e_list
FOR x = 0 TO UBOUND(e_list)
  SPLITA e_list[x] BY "|" TO e_array
  event{e_array[0]}[0] = e_array[0]
  event{e_array[0]}[1] = e_array[1]
  event{e_array[0]}[2] = e_array[2]
NEXT

WHILE threads
  Iup::LoopStep()
  this_event = Iup::GetEvent()
  hex_event = Iup::BB_HTA(this_event)
  IF hex_event = event{hex_event}[0] THEN
    IF event{hex_event}[2] = 0 THEN
      ICALL event{hex_event}[1]
    ELSE IF event{hex_event}[2] = 1 THEN
      SB_CallSub(main::sb1, event{hex_event}[1])
    ELSE IF event{hex_event}[2] = 2 THEN
      SB_CallSub(main::sb2, event{hex_event}[1])
    END IF
    IF Iup::GetActionName() = "CLOSE_CB" THEN threads -= 1
  END IF  
  SB_msSleep(250)
WEND

Iup::Close()
SB_Destroy(sb2)
SB_Destroy(sb1)
 
SBx_T1 - T2 is the same
' SBx_buttons Example (Thread 1)

IMPORT mt.bas
IMPORT iup.bas
IMPORT "SBx"

SUB btn1_clicked
  PRINT "Thread 1 Button 1 Pressed\n"
  PRINT "Which Mouse Button: ",CHR(Iup::GetBtnPressed()),"\n"
  PRINT "Button Up/Dn State: ",Iup::GetBtnState(),"\n"
END SUB

SUB btn2_clicked
  PRINT "Thread 1 Button 2 Pressed\n"
END SUB

SUB btn3_clicked
  PRINT "Thread 1 Button 3 Pressed\n"
END SUB

SUB win_exit
  ' Good-Bye
END SUB

SUB main
  win = DIALOG()
  SETPROPERTIES win, "TITLE=\"SBx Thread 1\", SIZE=300x"
  horzbox = HBOX()
  SETPROPERTIES horzbox, "GAP=5"
  btn1 = BUTTON()
  SETPROPERTIES btn1, "TITLE=\"Button 1\", EXPAND=HORIZONTAL"
  btn2 = BUTTON()
  SETPROPERTIES btn2, "TITLE=\"Button 2\", EXPAND=HORIZONTAL"
  btn3 = BUTTON()
  SETPROPERTIES btn3, "TITLE=\"Button 3\", EXPAND=HORIZONTAL"
  APPEND horzbox, btn1
  APPEND horzbox, btn2
  APPEND horzbox, btn3
  APPEND win, horzbox
  Iup::SetThreadCallback(win, "CLOSE_CB", "main::win_exit", 1)
  Iup::SetThreadCallback(btn1, "BUTTON_CB", "main::btn1_clicked", 1)
   Iup::SetThreadCallback(btn2, "ACTION", "main::btn2_clicked", 1)
  Iup::SetThreadCallback(btn3, "ACTION", "main::btn3_clicked", 1)
  SHOW win
END SUB
mt::SetVariable("sb1_loaded","OK")
 
SBx (Experimental IUP Wrapper)
' ScriptBasic IUP Interface

FUNCTION DIALOG
  DIALOG = Iup::Create("dialog")
END FUNCTION

SUB SETPROPERTIES(ih, propstr)
  Iup::SetAttributes(ih, propstr)
END SUB

SUB SETPROPERTY(ih, typ, value)
  Iup::SetAttribute(ih, typ, value)
END SUB

FUNCTION GETPROPERTY(ih, typ)
  GETPROPERTY = Iup::GetAttribute(ih, typ)
END FUNCTION

FUNCTION VBOX
  VBOX = Iup::Create("vbox")
END FUNCTION

FUNCTION HBOX
  HBOX = Iup::Create("hbox")
END FUNCTION

FUNCTION FRAME
  FRAME = Iup::Create("frame")
END FUNCTION

FUNCTION BUTTON
  BUTTON = Iup::Create("button")
END FUNCTION

FUNCTION LIST
  LIST = Iup::Create("list")
END FUNCTION

FUNCTION TEXT
  TEXT = Iup::Create("text")
END FUNCTION

FUNCTION LABEL
  LABEL = Iup::Create("label")
END FUNCTION

FUNCTION TOGGLE
  TOGGLE = Iup::Create("toggle")
END FUNCTION

SUB MESSAGE(title, body)
  Iup::Message(title, body)
END SUB

FUNCTION GETITEM
  GETITEM = Iup::GetListText()
END FUNCTION
 
SUB APPEND(ih_to, ih_from)
  Iup::Append(ih_to, ih_from)
END SUB

FUNCTION FOCUS(ih)
  FOCUS = Iup::SetFocus(ih)
END FUNCTION

FUNCTION UPDATE(ih)
  UPDATE = Iup::Update(ih)
END FUNCTION

SUB CLEAR(ih)
  Iup::ClearList(ih)
END SUB

' SUB SETEVENT(ih, class, funcaddr)
'   Iup::SetCallback(ih, class,  funcaddr)
' END SUB

SUB SHOW(ih)
  Iup::Show(ih)
END SUB  

' SUB GETEVENT
'   Iup::MainLoop
'   Iup::Close
' END SUB

[Support]

As it turns out, you really don't need threading to achieve multiple window support. As I see it threading of a IUP dialog would be a special use case. It's good to know it can be done.

' SBx_buttons Example (3 Form Version)

IMPORT iup.bas
IMPORT sbt.inc
IMPORT "SBx"

' Form 1 Callback Routines
SUB frm1_btn1_clicked
  PRINT "Form 1 Button 1 Pressed\n"
  PRINT "Which Mouse Button: ",CHR(Iup::GetBtnPressed()),"\n"
  PRINT "Button Up/Dn State: ",Iup::GetBtnState(),"\n"
END SUB

SUB frm1_btn2_clicked
  PRINT "Form 1 Button 2 Pressed\n"
END SUB

SUB frm1_btn3_clicked
  PRINT "Form 1 Button 3 Pressed\n"
END SUB

' Form 2  Callback Routines
SUB frm2_btn1_clicked
  PRINT "Form 2 Button 1 Pressed\n"
  PRINT "Which Mouse Button: ",CHR(Iup::GetBtnPressed()),"\n"
  PRINT "Button Up/Dn State: ",Iup::GetBtnState(),"\n"
END SUB

SUB frm2_btn2_clicked
  PRINT "Form 2 Button 2 Pressed\n"
END SUB

SUB frm2_btn3_clicked
  PRINT "Form 2 Button 3 Pressed\n"
END SUB

' Form 3 Callback Routines
SUB frm3_btn1_clicked
  PRINT "Form 3 Button 1 Pressed\n"
  PRINT "Which Mouse Button: ",CHR(Iup::GetBtnPressed()),"\n"
  PRINT "Button Up/Dn State: ",Iup::GetBtnState(),"\n"
END SUB

SUB frm3_btn2_clicked
  PRINT "Form 3 Button 2 Pressed\n"
END SUB

SUB frm3_btn3_clicked
  PRINT "Form 3 Button 3 Pressed\n"
END SUB

SUB win_exit
  ' Good-Bye
END SUB

Iup::Open()

' Form 1 Dialog
win1 = DIALOG()
SETPROPERTIES(win1, "TITLE=\"SBx Form 1\", SIZE=300x")
horzbox1 = HBOX()
SETPROPERTIES horzbox1, "GAP=5"
btn1_1 = BUTTON()
SETPROPERTIES btn1_1, "TITLE=\"Button 1\", EXPAND=HORIZONTAL"
btn1_2 = BUTTON()
SETPROPERTIES btn1_2, "TITLE=\"Button 2\", EXPAND=HORIZONTAL"
btn1_3 = BUTTON()
SETPROPERTIES btn1_3, "TITLE=\"Button 3\", EXPAND=HORIZONTAL"
APPEND horzbox1, btn1_1
APPEND horzbox1, btn1_2
APPEND horzbox1, btn1_3
APPEND win1, horzbox1
Iup::SetCallback win1, "CLOSE_CB", ADDRESS(win_exit())
Iup::SetCallback btn1_1, "BUTTON_CB", ADDRESS(frm1_btn1_clicked())
Iup::SetCallback btn1_2, "ACTION", ADDRESS(frm1_btn2_clicked())
Iup::SetCallback btn1_3, "ACTION", ADDRESS(frm1_btn3_clicked())
Iup::ShowXY(win1,500,200)



' Form 2 Dialog
win2 = DIALOG()
SETPROPERTIES win2, "TITLE=\"SBx Form 2\", SIZE=300x"
horzbox2 = HBOX()
SETPROPERTIES horzbox2, "GAP=5"
btn2_1 = BUTTON()
SETPROPERTIES btn2_1, "TITLE=\"Button 1\", EXPAND=HORIZONTAL"
btn2_2 = BUTTON()
SETPROPERTIES btn2_2, "TITLE=\"Button 2\", EXPAND=HORIZONTAL"
btn2_3 = BUTTON()
SETPROPERTIES btn2_3, "TITLE=\"Button 3\", EXPAND=HORIZONTAL"
APPEND horzbox2, btn2_1
APPEND horzbox2, btn2_2
APPEND horzbox2, btn2_3
APPEND win2, horzbox2
Iup::SetCallback win2, "CLOSE_CB", ADDRESS(win_exit())
Iup::SetCallback btn2_1, "BUTTON_CB", ADDRESS(frm2_btn1_clicked())
Iup::SetCallback btn2_2, "ACTION", ADDRESS(frm2_btn2_clicked())
Iup::SetCallback btn2_3, "ACTION", ADDRESS(frm2_btn3_clicked())
Iup::ShowXY(win2,500,400)

' Form 3 Dialog
win3 = DIALOG()
SETPROPERTIES win3, "TITLE=\"SBx Form 3\", SIZE=300x"
horzbox3 = HBOX()
SETPROPERTIES horzbox3, "GAP=5"
btn3_1 = BUTTON()
SETPROPERTIES btn3_1, "TITLE=\"Button 1\", EXPAND=HORIZONTAL"
btn3_2 = BUTTON()
SETPROPERTIES btn3_2, "TITLE=\"Button 2\", EXPAND=HORIZONTAL"
btn3_3 = BUTTON()
SETPROPERTIES btn3_3, "TITLE=\"Button 3\", EXPAND=HORIZONTAL"
APPEND horzbox3, btn3_1
APPEND horzbox3, btn3_2
APPEND horzbox3, btn3_3
APPEND win3, horzbox3
Iup::SetCallback win3, "CLOSE_CB", ADDRESS(win_exit())
Iup::SetCallback btn3_1, "BUTTON_CB", ADDRESS(frm3_btn1_clicked())
Iup::SetCallback btn3_2, "ACTION", ADDRESS(frm3_btn2_clicked())
Iup::SetCallback btn3_3, "ACTION", ADDRESS(frm3_btn3_clicked())
Iup::ShowXY(win3,500,600)



' Event Loop
windows = 3

WHILE windows
  Iup::LoopStep()
  this_event = Iup::GetEvent()
  this_event = Iup::BB_HTA(this_event)
  IF this_event = event{this_event}[0] THEN
    ICALL event{this_event}[1]
    IF Iup::GetActionName() = "CLOSE_CB" THEN windows -= 1
  END IF  
  SB_msSleep(250)
WEND

Iup::Close
 
iup.bas - I changed the Iup::SetCallback() to create the event array in the main namespace.
FUNCTION SetCallback(ih, aname, fname)
  main::event{BB_HTA(ih)}[0] = BB_HTA(ih)
  main::event{BB_HTA(ih)}[1] = fname
  SetCallback = __SetCallback(ih, aname)
END FUNCTION