Here is an example of the new
MY-BASIC extension module for Script BASIC. Attached is the Windows 32 bit and Linux (Ubuntu) 64 bit shared objects. (dll/so)
interface.c// MY-BASIC - Script BASIC extension module#include <stdio.h>#include <stdlib.h>#include <string.h>#include <stdarg.h>#include <ctype.h>#include <math.h>#include <time.h>#include "../../basext.h"#include "cbasic.h"#include "my_basic.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
/********************
MY-BASIC Functions
********************/static struct mb_interpreter_t
* bas
= 0;static int watch
(struct mb_interpreter_t
* s
, void** l
) { int result
= MB_FUNC_OK
; int_t arg
= 0; mb_assert
(s
&& l
); mb_check
(mb_attempt_open_bracket
(s
, l
)); mb_check
(mb_pop_int
(s
, l
, &arg
)); // That's it! mb_check
(mb_attempt_close_bracket
(s
, l
)); // arg is what you want. return result
;}besFUNCTION
(mbas_init
) besRETURN_LONG
(mb_init
());besEND
besFUNCTION
(mbas_dispose
) besRETURN_LONG
(mb_dispose
());besEND
besFUNCTION
(mbas_open
) besRETURN_LONG
(mb_open
(AT bas
));besEND
besFUNCTION
(mbas_close
) besRETURN_LONG
(mb_close
(AT bas
));besEND
besFUNCTION
(mbas_load_str
) DIM AS
const char PTR pgm
; besARGUMENTS
("z") AT pgm
besARGEND
besRETURN_LONG
(mb_load_string
(bas
, pgm
));besEND
besFUNCTION
(mbas_load_file
) DIM AS
const char PTR pgm
; besARGUMENTS
("z") AT pgm
besARGEND
besRETURN_LONG
(mb_load_file
(bas
, pgm
));besEND
besFUNCTION
(mbas_run
) besRETURN_LONG
(mb_run
(bas
));besEND
besFUNCTION
(mbas_reset
) besRETURN_LONG
(mb_reset
(bas
, false));besEND
besFUNCTION
(mbas_getint
) DIM AS mb_value_t mbval
; DIM AS
const char PTR varname
; besARGUMENTS
("z") AT varname
besARGEND
mbval.
type = MB_DT_INT
; mb_debug_get
(bas
, varname
, &mbval
); besRETURN_LONG
(mbval.
value.
integer);besEND
besFUNCTION
(mbas_getdbl
) DIM AS mb_value_t mbval
; DIM AS
const char PTR varname
; besARGUMENTS
("z") AT varname
besARGEND
mbval.
type = MB_DT_REAL
; mb_debug_get
(bas
, varname
, &mbval
); besRETURN_DOUBLE
(mbval.
value.
float_point);besEND
besFUNCTION
(mbas_getstr
) DIM AS mb_value_t mbval
; DIM AS
const char PTR varname
; besARGUMENTS
("z") AT varname
besARGEND
mbval.
type = MB_DT_STRING
; mb_debug_get
(bas
, varname
, &mbval
); besRETURN_STRING
(mbval.
value.
string);besEND
besFUNCTION
(mbas_setint
) DIM AS VARIABLE Argument
; DIM AS mb_value_t mbval
; DIM AS
int usrval
, i
, rtnval
; DIM AS
const char PTR varname
; IF
(besARGNR
< 2) THEN_DO RETURN_FUNCTION
(EX_ERROR_TOO_FEW_ARGUMENTS
); DEF_FOR
(i
= 1 TO i
<= 2 STEP INCR i
) BEGIN_FOR
Argument
= besARGUMENT
(i
); besDEREFERENCE
(Argument
); IF
(i EQ
1) THEN_DO varname
= STRINGVALUE
(Argument
); IF
(i EQ
2) THEN_DO usrval
= LONGVALUE
(Argument
); NEXT
mbval.
type = MB_DT_INT
; mbval.
value.
integer = usrval
; rtnval
= mb_debug_set
(bas
, varname
, mbval
); besRETURN_LONG
(rtnval
);besEND
besFUNCTION
(mbas_setdbl
) DIM AS VARIABLE Argument
; DIM AS mb_value_t mbval
; DIM AS
int i
, rtnval
; DIM AS
double usrval
; DIM AS
const char PTR varname
; IF
(besARGNR
< 2) THEN_DO RETURN_FUNCTION
(EX_ERROR_TOO_FEW_ARGUMENTS
); DEF_FOR
(i
= 1 TO i
<= 2 STEP INCR i
) BEGIN_FOR
Argument
= besARGUMENT
(i
); besDEREFERENCE
(Argument
); IF
(i EQ
1) THEN_DO varname
= STRINGVALUE
(Argument
); IF
(i EQ
2) THEN_DO usrval
= DOUBLEVALUE
(Argument
); NEXT
mbval.
type = MB_DT_REAL
; mbval.
value.
float_point = usrval
; rtnval
= mb_debug_set
(bas
, varname
, mbval
); besRETURN_LONG
(rtnval
);besEND
besFUNCTION
(mbas_setstr
) DIM AS VARIABLE Argument
; DIM AS mb_value_t mbval
; DIM AS
int i
, rtnval
; DIM AS
const char PTR varname
; DIM AS
const char PTR usrval
; IF
(besARGNR
< 2) THEN_DO RETURN_FUNCTION
(EX_ERROR_TOO_FEW_ARGUMENTS
); DEF_FOR
(i
= 1 TO i
<= 2 STEP INCR i
) BEGIN_FOR
Argument
= besARGUMENT
(i
); besDEREFERENCE
(Argument
); IF
(i EQ
1) THEN_DO varname
= STRINGVALUE
(Argument
); IF
(i EQ
2) THEN_DO usrval
= STRINGVALUE
(Argument
); NEXT
mbval.
type = MB_DT_STRING
; usrval
= mb_memdup
(usrval
, strlen(usrval
) + 1); mbval.
value.
string = usrval
; besRETURN_LONG
(mb_debug_set
(bas
, varname
, mbval
));besEND
mbvars.sbDECLARE SUB mb_init
ALIAS "mbas_init" LIB "mb"DECLARE SUB mb_dispose
ALIAS "mbas_dispose" LIB "mb"DECLARE SUB mb_open
ALIAS "mbas_open" LIB "mb"DECLARE SUB mb_close
ALIAS "mbas_close" LIB "mb"DECLARE SUB mb_load_str
ALIAS "mbas_load_str" LIB "mb"DECLARE SUB mb_load_file
ALIAS "mbas_load_file" LIB "mb"DECLARE SUB mb_run
ALIAS "mbas_run" LIB "mb"DECLARE SUB mb_getint
ALIAS "mbas_getint" LIB "mb"DECLARE SUB mb_getdbl
ALIAS "mbas_getdbl" LIB "mb"DECLARE SUB mb_getstr
ALIAS "mbas_getstr" LIB "mb"DECLARE SUB mb_setint
ALIAS "mbas_setint" LIB "mb"DECLARE SUB mb_setdbl
ALIAS "mbas_setdbl" LIB "mb"DECLARE SUB mb_setstr
ALIAS "mbas_setstr" LIB "mb"DECLARE SUB mb_reset
ALIAS "mbas_reset" LIB "mb"mb_init
mb_open
mb_load_file
"setvars.bas"mb_run
mb_setint
"A", 123
mb_setdbl
"B", 1.23
mb_setstr
"C$",
"One,Two,Three"PRINT mb_getint(
"A"),
"\n"PRINT FORMAT(
"%g\n", mb_getdbl(
"B"))
PRINT mb_getstr(
"C$"),
"\n"mb_close
mb_dispose
setvars.basa = 0
b = 0.0
c$ = ""
Output - Linux 64 bit
jrs@laptop:~/sb/sb22/mybasic$ time scriba mbvars.sb
123
1.23
One,Two,Three
real 0m0.006s
user 0m0.005s
sys 0m0.005s
jrs@laptop:~/sb/sb22/mybasic$
Output - Windows 32 bit
C:\sb22\mybasic>scriba mbvars.sb
123
1.23
One,Two,Three
C:\sb22\mybasic>