« previous next »
Pages: [1]

Author Topic: MY-BASIC Extension Module  (Read 18127 times)

Support

  • Administrator
  • *****
  • Posts: 22
    • View Profile
MY-BASIC Extension Module
« on: April 24, 2015, 09:35:40 PM »
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
  1. // MY-BASIC - Script BASIC extension module
  2.  
  3. #include <stdio.h>
  4. #include <stdlib.h>
  5. #include <string.h>
  6. #include <stdarg.h>
  7. #include <ctype.h>
  8. #include <math.h>
  9. #include <time.h>
  10. #include "../../basext.h"
  11. #include "cbasic.h"
  12.  
  13. #include "my_basic.h"
  14.  
  15.  
  16. /****************************
  17.  Extension Module Functions
  18. ****************************/
  19.  
  20. besVERSION_NEGOTIATE
  21.   RETURN_FUNCTION((int)INTERFACE_VERSION);
  22. besEND
  23.  
  24. besSUB_START
  25.   DIM AS long PTR p;
  26.   besMODULEPOINTER = besALLOC(sizeof(long));
  27.   IF (besMODULEPOINTER EQ NULL) THEN_DO RETURN_FUNCTION(0);
  28.   p = (long PTR)besMODULEPOINTER;
  29.   RETURN_FUNCTION(0);
  30. besEND
  31.  
  32. besSUB_FINISH
  33.   DIM AS long PTR p;
  34.   p = (long PTR)besMODULEPOINTER;
  35.   IF (p EQ NULL) THEN_DO RETURN_FUNCTION(0);
  36.   RETURN_FUNCTION(0);
  37. besEND
  38.  
  39.  
  40. /********************
  41.  MY-BASIC Functions
  42. ********************/
  43.  
  44. static struct mb_interpreter_t* bas = 0;
  45.  
  46. static int watch(struct mb_interpreter_t* s, void** l) {
  47.   int result = MB_FUNC_OK;
  48.   int_t arg = 0;
  49.   mb_assert(s && l);
  50.   mb_check(mb_attempt_open_bracket(s, l));
  51.   mb_check(mb_pop_int(s, l, &arg)); // That's it!
  52.   mb_check(mb_attempt_close_bracket(s, l));
  53.   // arg is what you want.
  54.   return result;
  55. }
  56.  
  57. besFUNCTION(mbas_init)
  58.   besRETURN_LONG(mb_init());
  59. besEND
  60.  
  61. besFUNCTION(mbas_dispose)
  62.   besRETURN_LONG(mb_dispose());
  63. besEND
  64.  
  65. besFUNCTION(mbas_open)
  66.   besRETURN_LONG(mb_open(AT bas));
  67. besEND
  68.  
  69. besFUNCTION(mbas_close)
  70.   besRETURN_LONG(mb_close(AT bas));
  71. besEND
  72.  
  73. besFUNCTION(mbas_load_str)
  74.   DIM AS const char PTR pgm;
  75.   besARGUMENTS("z")
  76.     AT pgm
  77.   besARGEND
  78.   besRETURN_LONG(mb_load_string(bas, pgm));
  79. besEND
  80.  
  81. besFUNCTION(mbas_load_file)
  82.   DIM AS const char PTR pgm;
  83.   besARGUMENTS("z")
  84.     AT pgm
  85.   besARGEND
  86.   besRETURN_LONG(mb_load_file(bas, pgm));
  87. besEND
  88.  
  89. besFUNCTION(mbas_run)
  90.   besRETURN_LONG(mb_run(bas));
  91. besEND
  92.  
  93. besFUNCTION(mbas_reset)
  94.   besRETURN_LONG(mb_reset(bas, false));
  95. besEND
  96.  
  97. besFUNCTION(mbas_getint)
  98.   DIM AS mb_value_t mbval;
  99.   DIM AS const char PTR varname;
  100.   besARGUMENTS("z")
  101.     AT varname
  102.   besARGEND
  103.   mbval.type = MB_DT_INT;
  104.   mb_debug_get(bas, varname, &mbval);
  105.   besRETURN_LONG(mbval.value.integer);
  106. besEND
  107.  
  108. besFUNCTION(mbas_getdbl)
  109.   DIM AS mb_value_t mbval;
  110.   DIM AS const char PTR varname;
  111.   besARGUMENTS("z")
  112.     AT varname
  113.   besARGEND
  114.   mbval.type = MB_DT_REAL;
  115.   mb_debug_get(bas, varname, &mbval);
  116.   besRETURN_DOUBLE(mbval.value.float_point);
  117. besEND
  118.  
  119. besFUNCTION(mbas_getstr)
  120.   DIM AS mb_value_t mbval;
  121.   DIM AS const char PTR varname;
  122.   besARGUMENTS("z")
  123.     AT varname
  124.   besARGEND
  125.   mbval.type = MB_DT_STRING;
  126.   mb_debug_get(bas, varname, &mbval);
  127.   besRETURN_STRING(mbval.value.string);
  128. besEND
  129.  
  130. besFUNCTION(mbas_setint)
  131.   DIM AS VARIABLE Argument;
  132.   DIM AS mb_value_t mbval;
  133.   DIM AS int usrval, i, rtnval;
  134.   DIM AS const char PTR varname;
  135.   IF (besARGNR < 2) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  136.   DEF_FOR (i = 1 TO i <= 2 STEP INCR i)
  137.   BEGIN_FOR
  138.     Argument = besARGUMENT(i);
  139.     besDEREFERENCE(Argument);
  140.     IF (i EQ 1) THEN_DO varname = STRINGVALUE(Argument);
  141.     IF (i EQ 2) THEN_DO usrval = LONGVALUE(Argument);
  142.   NEXT
  143.   mbval.type = MB_DT_INT;
  144.   mbval.value.integer = usrval;
  145.   rtnval = mb_debug_set(bas, varname, mbval);
  146.   besRETURN_LONG(rtnval);
  147. besEND
  148.  
  149. besFUNCTION(mbas_setdbl)
  150.   DIM AS VARIABLE Argument;
  151.   DIM AS mb_value_t mbval;
  152.   DIM AS int i, rtnval;
  153.   DIM AS double usrval;
  154.   DIM AS const char PTR varname;
  155.   IF (besARGNR < 2) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  156.   DEF_FOR (i = 1 TO i <= 2 STEP INCR i)
  157.   BEGIN_FOR
  158.     Argument = besARGUMENT(i);
  159.     besDEREFERENCE(Argument);
  160.     IF (i EQ 1) THEN_DO varname = STRINGVALUE(Argument);
  161.     IF (i EQ 2) THEN_DO usrval = DOUBLEVALUE(Argument);
  162.   NEXT
  163.   mbval.type = MB_DT_REAL;
  164.   mbval.value.float_point = usrval;
  165.   rtnval = mb_debug_set(bas, varname, mbval);
  166.   besRETURN_LONG(rtnval);
  167. besEND
  168.  
  169. besFUNCTION(mbas_setstr)
  170.   DIM AS VARIABLE Argument;
  171.   DIM AS mb_value_t mbval;
  172.   DIM AS int i, rtnval;
  173.   DIM AS const char PTR varname;
  174.   DIM AS const char PTR usrval;
  175.   IF (besARGNR < 2) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  176.   DEF_FOR (i = 1 TO i <= 2 STEP INCR i)
  177.   BEGIN_FOR
  178.     Argument = besARGUMENT(i);
  179.     besDEREFERENCE(Argument);
  180.     IF (i EQ 1) THEN_DO varname = STRINGVALUE(Argument);
  181.     IF (i EQ 2) THEN_DO usrval = STRINGVALUE(Argument);
  182.   NEXT
  183.   mbval.type = MB_DT_STRING;
  184.   usrval = mb_memdup(usrval, strlen(usrval) + 1);
  185.   mbval.value.string = usrval;
  186.   besRETURN_LONG(mb_debug_set(bas, varname, mbval));
  187. besEND
  188.  

mbvars.sb
Code: Script BASIC
  1. DECLARE SUB mb_init ALIAS "mbas_init" LIB "mb"
  2. DECLARE SUB mb_dispose ALIAS "mbas_dispose" LIB "mb"
  3. DECLARE SUB mb_open ALIAS "mbas_open" LIB "mb"
  4. DECLARE SUB mb_close ALIAS "mbas_close" LIB "mb"
  5. DECLARE SUB mb_load_str ALIAS "mbas_load_str" LIB "mb"
  6. DECLARE SUB mb_load_file ALIAS "mbas_load_file" LIB "mb"
  7. DECLARE SUB mb_run ALIAS "mbas_run" LIB "mb"
  8. DECLARE SUB mb_getint ALIAS "mbas_getint" LIB "mb"
  9. DECLARE SUB mb_getdbl ALIAS "mbas_getdbl" LIB "mb"
  10. DECLARE SUB mb_getstr ALIAS "mbas_getstr" LIB "mb"
  11. DECLARE SUB mb_setint ALIAS "mbas_setint" LIB "mb"
  12. DECLARE SUB mb_setdbl ALIAS "mbas_setdbl" LIB "mb"
  13. DECLARE SUB mb_setstr ALIAS "mbas_setstr" LIB "mb"
  14. DECLARE SUB mb_reset ALIAS "mbas_reset" LIB "mb"
  15.  
  16. mb_init
  17. mb_open
  18. mb_load_file "setvars.bas"
  19. mb_run
  20. mb_setint "A", 123
  21. mb_setdbl "B", 1.23
  22. mb_setstr "C$", "One,Two,Three"
  23. PRINT mb_getint("A"),"\n"
  24. PRINT FORMAT("%g\n", mb_getdbl("B"))
  25. PRINT mb_getstr("C$"),"\n"
  26. mb_close
  27. mb_dispose
  28.  

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>

Logged
Pages: [1]
« previous next »