MY-BASIC Extension Module

[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
// 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
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_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.bas

Code: [Select]

a = 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>