MY-BASIC Extension Module

Extension Modules > MY-BASIC

(1/1)

Support:
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

--- Code: 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.sb

--- Code: Script BASIC ---DECLARE 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_initmb_openmb_load_file "setvars.bas"mb_runmb_setint "A", 123mb_setdbl "B", 1.23mb_setstr "C$", "One,Two,Three"PRINT mb_getint("A"),"\n"PRINT FORMAT("%g\n", mb_getdbl("B"))PRINT mb_getstr("C$"),"\n"mb_closemb_dispose
setvars.bas

--- Code: ---a = 0
b = 0.0
c$ = ""

--- End code ---

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>

Navigation

[0] Message Index

Go to full version