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

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>