// 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
