1 /*
2 ** This source file is part of MY-BASIC
3 **
4 ** For the latest info, see http://code.google.com/p/my-basic/
5 **
6 ** Copyright (c) 2011 - 2014 paladin_t
7 **
8 ** Permission is hereby granted, free of charge, to any person obtaining a copy of
9 ** this software and associated documentation files (the "Software"), to deal in
10 ** the Software without restriction, including without limitation the rights to
11 ** use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
12 ** the Software, and to permit persons to whom the Software is furnished to do so,
13 ** subject to the following conditions:
14 **
15 ** The above copyright notice and this permission notice shall be included in all
16 ** copies or substantial portions of the Software.
17 **
18 ** THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
19 ** IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
20 ** FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
21 ** COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
22 ** IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
23 ** CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
24 */
25
26 #ifdef _MSC_VER
27 # ifndef _CRT_SECURE_NO_WARNINGS
28 # define _CRT_SECURE_NO_WARNINGS
29 # endif /* _CRT_SECURE_NO_WARNINGS */
30 #endif /* _MSC_VER */
31
32 #ifdef _MSC_VER
33 # include <conio.h>
34 # include <malloc.h>
35 #else /* _MSC_VER */
36 # include <stdint.h>
37 #endif /* _MSC_VER */
38 #include <memory.h>
39 #include <assert.h>
40 #include <ctype.h>
41 #include <math.h>
42 #include <stdio.h>
43 #include <stdlib.h>
44 #include <string.h>
45 #include "my_basic.h"
46
47 #ifdef __cplusplus
48 extern "C" {
49 #endif /* __cplusplus */
50
51 #ifdef _MSC_VER
52 # pragma warning(push)
53 # pragma warning(disable : 4127)
54 # pragma warning(disable : 4996)
55 #endif /* _MSC_VER */
56
57 #ifdef MB_COMPACT_MODE
58 # pragma pack(1)
59 #endif /* MB_COMPACT_MODE */
60
61 /*
62 ** {========================================================
63 ** Data type declarations
64 */
65
66 /** Macros */
67 #define _VER_MAJOR 1
68 #define _VER_MINOR 0
69 #define _VER_REVISION 40
70 #define _MB_VERSION ((_VER_MAJOR * 0x01000000) + (_VER_MINOR * 0x00010000) + (_VER_REVISION))
71 #define _MB_VERSION_STRING "1.0.0040"
72
73 /* Uncomment this line to treat warnings as error */
74 /*#define _WARING_AS_ERROR*/
75
76 /* Uncomment this line to use a comma to PRINT a new line as compatibility */
77 /*#define _COMMA_AS_NEWLINE*/
78
79 #define _NO_EAT_COMMA 2
80
81 #if (defined _DEBUG && !defined NDEBUG)
82 # define _MB_ENABLE_ALLOC_STAT
83 #endif /* (defined _DEBUG && !defined NDEBUG) */
84
85 /* Helper */
86 #ifndef sgn
87 # define sgn(__v) ((__v) ? ((__v) > 0 ? 1 : -1) : (0))
88 #endif /* sgn */
89
90 #ifndef _countof
91 # define _countof(__a) (sizeof(__a) / sizeof(*(__a)))
92 #endif /* _countof */
93
94 #ifndef islower
95 # define islower(__c) ((__c) >= 'a' && (__c) <= 'z')
96 #endif /* islower */
97
98 #ifndef toupper
99 # define toupper(__c) ((islower(__c)) ? ((__c) - 'a' + 'A') : (__c))
100 #endif /* toupper */
101
102 #ifndef _MSC_VER
103 # ifndef _strupr
_strupr(char * __s)104 static char* _strupr(char* __s) {
105 char* t = __s;
106
107 while(*__s) {
108 *__s = toupper(*__s);
109 ++__s;
110 }
111
112 return t;
113 }
114 # endif /* _strupr */
115 #endif /* _MSC_VER */
116
117 #define DON(__o) ((__o) ? ((_object_t*)((__o)->data)) : 0)
118
119 /* Hash table size */
120 #define _HT_ARRAY_SIZE_SMALL 193
121 #define _HT_ARRAY_SIZE_MID 1543
122 #define _HT_ARRAY_SIZE_BIG 12289
123 #define _HT_ARRAY_SIZE_DEFAULT _HT_ARRAY_SIZE_SMALL
124
125 /* Max length of a single symbol */
126 #define _SINGLE_SYMBOL_MAX_LENGTH 128
127 /* Max dimension of an array */
128 #define _MAX_DIMENSION_COUNT 4
129
130 typedef int (* _common_compare)(void*, void*);
131
132 /* Container operation */
133 #define _OP_RESULT_NORMAL 0
134 #define _OP_RESULT_DEL_NODE -1
135 typedef int (* _common_operation)(void*, void*);
136
137 /** List */
138 typedef _common_compare _ls_compare;
139 typedef _common_operation _ls_operation;
140
141 typedef struct _ls_node_t {
142 void* data;
143 struct _ls_node_t* prev;
144 struct _ls_node_t* next;
145 void* extra;
146 } _ls_node_t;
147
148 /** Dictionary */
149 typedef unsigned int (* _ht_hash)(void*, void*);
150 typedef _common_compare _ht_compare;
151 typedef _common_operation _ht_operation;
152
153 typedef struct _ht_node_t {
154 _ls_operation free_extra;
155 _ht_compare compare;
156 _ht_hash hash;
157 unsigned int array_size;
158 unsigned int count;
159 _ls_node_t** array;
160 } _ht_node_t;
161
162 /** enum / struct / union / const */
163 /* Error description text */
164 static const char* _ERR_DESC[] = {
165 "No error",
166 /** Common */
167 "Open MY-BASIC failed",
168 "A function with the same name already exists",
169 "A function with the name does not exists",
170 /** Parsing */
171 "Open file failed",
172 "Symbol too long",
173 "Invalid character",
174 /** Running */
175 "Not supported",
176 "Empty program",
177 "Syntax error",
178 "Invalid data type",
179 "Type does not match",
180 "Illegal bound",
181 "Too much dimensions",
182 "Operation failed",
183 "Dimension count out of bound",
184 "Out of bound",
185 "Label does not exist",
186 "No return point",
187 "Colon expected",
188 "Comma or semicolon expected",
189 "Array identifier expected",
190 "Open bracket expected",
191 "Close bracket expected",
192 "Array subscript expected",
193 "Structure not completed",
194 "Function expected",
195 "String expected",
196 "Variable or array identifier expected",
197 "Assign operator expected",
198 "Integer expected",
199 "ELSE statement expected",
200 "TO statement expected",
201 "NEXT statement expected",
202 "UNTIL statement expected",
203 "Loop variable expected",
204 "Jump label expected",
205 "Variable expected",
206 "Invalid identifier usage",
207 "Calculation error",
208 "Divide by zero",
209 "MOD by zero",
210 "Invalid expression",
211 "Out of memory",
212 /** Extended abort */
213 "Extended abort",
214 };
215
216 /* Data type */
217 #define _EOS '\n'
218 #define _NULL_STRING "(empty)"
219
220 #define _FNAN 0xffc00000
221 #define _FINF 0x7f800000
222
223 typedef enum _data_e {
224 _DT_NIL = -1,
225 _DT_ANY = 0,
226 _DT_INT,
227 _DT_REAL,
228 _DT_STRING,
229 _DT_USERTYPE,
230 _DT_FUNC,
231 _DT_VAR,
232 _DT_ARRAY,
233 _DT_LABEL, /* Label type, used for GOTO, GOSUB statement */
234 _DT_SEP, /* Separator */
235 _DT_EOS, /* End of statement */
236 } _data_e;
237
238 typedef struct _func_t {
239 char* name;
240 mb_func_t pointer;
241 } _func_t;
242
243 typedef struct _var_t {
244 char* name;
245 struct _object_t* data;
246 } _var_t;
247
248 typedef struct _array_t {
249 char* name;
250 _data_e type;
251 unsigned int count;
252 void* raw;
253 int dimension_count;
254 int dimensions[_MAX_DIMENSION_COUNT];
255 } _array_t;
256
257 typedef struct _label_t {
258 char* name;
259 _ls_node_t* node;
260 } _label_t;
261
262 typedef struct _object_t {
263 _data_e type;
264 union {
265 int_t integer;
266 real_t float_point;
267 char* string;
268 void* usertype;
269 _func_t* func;
270 _var_t* variable;
271 _array_t* array;
272 _label_t* label;
273 char separator;
274 } data;
275 bool_t ref;
276 int source_pos;
277 unsigned short source_row;
278 unsigned short source_col;
279 } _object_t;
280
281 static const _object_t _OBJ_INT_UNIT = { _DT_INT, {1}, false, 0 };
282 static const _object_t _OBJ_INT_ZERO = { _DT_INT, {0}, false, 0 };
283
284 static _object_t* _OBJ_BOOL_TRUE = 0;
285 static _object_t* _OBJ_BOOL_FALSE = 0;
286
287 /* Parsing context */
288 typedef enum _parsing_state_e {
289 _PS_NORMAL = 0,
290 _PS_STRING,
291 _PS_COMMENT,
292 } _parsing_state_e;
293
294 typedef enum _symbol_state_e {
295 _SS_IDENTIFIER = 0,
296 _SS_OPERATOR,
297 } _symbol_state_e;
298
299 typedef struct _parsing_context_t {
300 char current_char;
301 char current_symbol[_SINGLE_SYMBOL_MAX_LENGTH + 1];
302 int current_symbol_nonius;
303 _object_t* last_symbol;
304 _parsing_state_e parsing_state;
305 _symbol_state_e symbol_state;
306 } _parsing_context_t;
307
308 /* Running context */
309 typedef struct _running_context_t {
310 _ls_node_t* temp_values;
311 _ls_node_t* suspent_point;
312 _ls_node_t* sub_stack;
313 _var_t* next_loop_var;
314 mb_value_t intermediate_value;
315 int_t no_eat_comma_mark;
316 _ls_node_t* skip_to_eoi;
317 } _running_context_t;
318
319 /* Expression processing */
320 typedef struct _tuple3_t {
321 void* e1;
322 void* e2;
323 void* e3;
324 } _tuple3_t;
325
326 static const char _PRECEDE_TABLE[19][19] = {
327 /* + - * / MOD ^ ( ) = > < >= <= == <> AND OR NOT NEG */
328 { '>', '>', '<', '<', '<', '<', '<', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>' }, /* + */
329 { '>', '>', '<', '<', '<', '<', '<', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>' }, /* - */
330 { '>', '>', '>', '>', '>', '<', '<', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>' }, /* * */
331 { '>', '>', '>', '>', '>', '<', '<', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>' }, /* / */
332 { '>', '>', '<', '<', '>', '<', '<', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>' }, /* MOD */
333 { '>', '>', '>', '>', '>', '>', '<', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>' }, /* ^ */
334 { '<', '<', '<', '<', '<', '<', '<', '=', ' ', '<', '<', '<', '<', '<', '<', '<', '<', '<', '<' }, /* ( */
335 { '>', '>', '>', '>', '>', '>', ' ', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>', '>' }, /* ) */
336 { '<', '<', '<', '<', '<', '<', '<', ' ', '=', '<', '<', '<', '<', '<', '<', '<', '<', '<', '<' }, /* = */
337 { '<', '<', '<', '<', '<', '<', '<', '>', '>', ' ', ' ', ' ', ' ', ' ', ' ', '>', '>', '>', '>' }, /* > */
338 { '<', '<', '<', '<', '<', '<', '<', '>', '>', ' ', ' ', ' ', ' ', ' ', ' ', '>', '>', '>', '>' }, /* < */
339 { '<', '<', '<', '<', '<', '<', '<', '>', '>', ' ', ' ', ' ', ' ', ' ', ' ', '>', '>', '>', '>' }, /* >= */
340 { '<', '<', '<', '<', '<', '<', '<', '>', '>', ' ', ' ', ' ', ' ', ' ', ' ', '>', '>', '>', '>' }, /* <= */
341 { '<', '<', '<', '<', '<', '<', '<', '>', '>', ' ', ' ', ' ', ' ', ' ', ' ', '>', '>', '>', '>' }, /* == */
342 { '<', '<', '<', '<', '<', '<', '<', '>', '>', ' ', ' ', ' ', ' ', ' ', ' ', '>', '>', '>', '>' }, /* <> */
343 { '<', '<', '<', '<', '<', '<', '<', '>', '>', '<', '<', '<', '<', '<', '<', '>', '>', '<', '>' }, /* AND */
344 { '<', '<', '<', '<', '<', '<', '<', '>', '>', '<', '<', '<', '<', '<', '<', '>', '>', '<', '>' }, /* OR */
345 { '<', '<', '<', '<', '<', '<', '<', '>', '>', '<', '<', '<', '<', '<', '<', '>', '>', '>', '>' }, /* NOT */
346 { '<', '<', '<', '<', '<', '<', '<', '>', '>', '<', '<', '<', '<', '<', '<', '<', '<', '<', '=' } /* NEG */
347 };
348
349 static _object_t* _exp_assign = 0;
350
351 #define _instruct_fun_num_num(__optr, __tuple) \
352 do { \
353 _object_t opndv1; \
354 _object_t opndv2; \
355 _tuple3_t* tpptr = (_tuple3_t*)(*__tuple); \
356 _object_t* opnd1 = (_object_t*)(tpptr->e1); \
357 _object_t* opnd2 = (_object_t*)(tpptr->e2); \
358 _object_t* val = (_object_t*)(tpptr->e3); \
359 opndv1.type = \
360 (opnd1->type == _DT_INT || (opnd1->type == _DT_VAR && opnd1->data.variable->data->type == _DT_INT)) ? \
361 _DT_INT : _DT_REAL; \
362 opndv1.data = opnd1->type == _DT_VAR ? opnd1->data.variable->data->data : opnd1->data; \
363 opndv2.type = \
364 (opnd2->type == _DT_INT || (opnd2->type == _DT_VAR && opnd2->data.variable->data->type == _DT_INT)) ? \
365 _DT_INT : _DT_REAL; \
366 opndv2.data = opnd2->type == _DT_VAR ? opnd2->data.variable->data->data : opnd2->data; \
367 if(opndv1.type == _DT_INT && opndv2.type == _DT_INT) { \
368 val->type = _DT_REAL; \
369 val->data.float_point = (real_t)__optr((real_t)opndv1.data.integer, (real_t)opndv2.data.integer); \
370 } else { \
371 val->type = _DT_REAL; \
372 val->data.float_point = (real_t)__optr( \
373 opndv1.type == _DT_INT ? opndv1.data.integer : opndv1.data.float_point, \
374 opndv2.type == _DT_INT ? opndv2.data.integer : opndv2.data.float_point); \
375 } \
376 if(val->type == _DT_REAL && (real_t)(int_t)val->data.float_point == val->data.float_point) { \
377 val->type = _DT_INT; \
378 val->data.integer = (int_t)val->data.float_point; \
379 } \
380 } while(0)
381 #define _instruct_num_op_num(__optr, __tuple) \
382 do { \
383 _object_t opndv1; \
384 _object_t opndv2; \
385 _tuple3_t* tpptr = (_tuple3_t*)(*__tuple); \
386 _object_t* opnd1 = (_object_t*)(tpptr->e1); \
387 _object_t* opnd2 = (_object_t*)(tpptr->e2); \
388 _object_t* val = (_object_t*)(tpptr->e3); \
389 opndv1.type = \
390 (opnd1->type == _DT_INT || (opnd1->type == _DT_VAR && opnd1->data.variable->data->type == _DT_INT)) ? \
391 _DT_INT : _DT_REAL; \
392 opndv1.data = opnd1->type == _DT_VAR ? opnd1->data.variable->data->data : opnd1->data; \
393 opndv2.type = \
394 (opnd2->type == _DT_INT || (opnd2->type == _DT_VAR && opnd2->data.variable->data->type == _DT_INT)) ? \
395 _DT_INT : _DT_REAL; \
396 opndv2.data = opnd2->type == _DT_VAR ? opnd2->data.variable->data->data : opnd2->data; \
397 if(opndv1.type == _DT_INT && opndv2.type == _DT_INT) { \
398 if((real_t)(opndv1.data.integer __optr opndv2.data.integer) == ((real_t)opndv1.data.integer __optr (real_t)opndv2.data.integer)) { \
399 val->type = _DT_INT; \
400 val->data.integer = opndv1.data.integer __optr opndv2.data.integer; \
401 } else { \
402 val->type = _DT_REAL; \
403 val->data.float_point = (real_t)((real_t)opndv1.data.integer __optr (real_t)opndv2.data.integer); \
404 } \
405 } else { \
406 val->type = _DT_REAL; \
407 val->data.float_point = (real_t) \
408 ((opndv1.type == _DT_INT ? opndv1.data.integer : opndv1.data.float_point) __optr \
409 (opndv2.type == _DT_INT ? opndv2.data.integer : opndv2.data.float_point)); \
410 } \
411 if(val->type == _DT_REAL && (real_t)(int_t)val->data.float_point == val->data.float_point) { \
412 val->type = _DT_INT; \
413 val->data.integer = (int_t)val->data.float_point; \
414 } \
415 } while(0)
416 #define _instruct_int_op_int(__optr, __tuple) \
417 do { \
418 _object_t opndv1; \
419 _object_t opndv2; \
420 _tuple3_t* tpptr = (_tuple3_t*)(*__tuple); \
421 _object_t* opnd1 = (_object_t*)(tpptr->e1); \
422 _object_t* opnd2 = (_object_t*)(tpptr->e2); \
423 _object_t* val = (_object_t*)(tpptr->e3); \
424 opndv1.type = \
425 (opnd1->type == _DT_INT || (opnd1->type == _DT_VAR && opnd1->data.variable->data->type == _DT_INT)) ? \
426 _DT_INT : _DT_REAL; \
427 opndv1.data = opnd1->type == _DT_VAR ? opnd1->data.variable->data->data : opnd1->data; \
428 opndv2.type = \
429 (opnd2->type == _DT_INT || (opnd2->type == _DT_VAR && opnd2->data.variable->data->type == _DT_INT)) ? \
430 _DT_INT : _DT_REAL; \
431 opndv2.data = opnd2->type == _DT_VAR ? opnd2->data.variable->data->data : opnd2->data; \
432 if(opndv1.type == _DT_INT && opndv2.type == _DT_INT) { \
433 val->type = _DT_INT; \
434 val->data.integer = opndv1.data.integer __optr opndv2.data.integer; \
435 } else { \
436 val->type = _DT_INT; \
437 val->data.integer = \
438 ((opndv1.type == _DT_INT ? opndv1.data.integer : (int_t)(opndv1.data.float_point)) __optr \
439 (opndv2.type == _DT_INT ? opndv2.data.integer : (int_t)(opndv2.data.float_point))); \
440 } \
441 } while(0)
442 #define _instruct_connect_strings(__tuple) \
443 do { \
444 char* _str1 = 0; \
445 char* _str2 = 0; \
446 _tuple3_t* tpptr = (_tuple3_t*)(*__tuple); \
447 _object_t* opnd1 = (_object_t*)(tpptr->e1); \
448 _object_t* opnd2 = (_object_t*)(tpptr->e2); \
449 _object_t* val = (_object_t*)(tpptr->e3); \
450 val->type = _DT_STRING; \
451 if(val->data.string) { \
452 safe_free(val->data.string); \
453 } \
454 _str1 = _extract_string(opnd1); \
455 _str2 = _extract_string(opnd2); \
456 val->data.string = (char*)mb_malloc(strlen(_str1) + strlen(_str2) + 1); \
457 memset(val->data.string, 0, strlen(_str1) + strlen(_str2) + 1); \
458 strcat(val->data.string, _str1); \
459 strcat(val->data.string, _str2); \
460 } while(0)
461 #define _instruct_compare_strings(__optr, __tuple) \
462 do { \
463 char* _str1 = 0; \
464 char* _str2 = 0; \
465 _tuple3_t* tpptr = (_tuple3_t*)(*__tuple); \
466 _object_t* opnd1 = (_object_t*)(tpptr->e1); \
467 _object_t* opnd2 = (_object_t*)(tpptr->e2); \
468 _object_t* val = (_object_t*)(tpptr->e3); \
469 val->type = _DT_INT; \
470 _str1 = _extract_string(opnd1); \
471 _str2 = _extract_string(opnd2); \
472 val->data.integer = strcmp(_str1, _str2) __optr 0; \
473 } while(0)
474
475 #define _proc_div_by_zero(__s, __tuple, __exit, __result, __kind) \
476 do { \
477 _object_t opndv1; \
478 _object_t opndv2; \
479 _tuple3_t* tpptr = (_tuple3_t*)(*__tuple); \
480 _object_t* opnd1 = (_object_t*)(tpptr->e1); \
481 _object_t* opnd2 = (_object_t*)(tpptr->e2); \
482 _object_t* val = (_object_t*)(tpptr->e3); \
483 opndv1.type = \
484 (opnd1->type == _DT_INT || (opnd1->type == _DT_VAR && opnd1->data.variable->data->type == _DT_INT)) ? \
485 _DT_INT : _DT_REAL; \
486 opndv1.data = opnd1->type == _DT_VAR ? opnd1->data.variable->data->data : opnd1->data; \
487 opndv2.type = \
488 (opnd2->type == _DT_INT || (opnd2->type == _DT_VAR && opnd2->data.variable->data->type == _DT_INT)) ? \
489 _DT_INT : _DT_REAL; \
490 opndv2.data = opnd2->type == _DT_VAR ? opnd2->data.variable->data->data : opnd2->data; \
491 if((opndv2.type == _DT_INT && opndv2.data.integer == 0) || (opndv2.type == _DT_REAL && opndv2.data.float_point == 0.0f)) { \
492 if((opndv1.type == _DT_INT && opndv1.data.integer == 0) || (opndv1.type == _DT_REAL && opndv1.data.float_point == 0.0f)) { \
493 val->type = _DT_REAL; \
494 val->data.integer = _FNAN; \
495 } else { \
496 val->type = _DT_REAL; \
497 val->data.integer = _FINF; \
498 } \
499 _handle_error_on_obj((__s), __kind, ((__tuple) && *(__tuple)) ? ((_object_t*)(((_tuple3_t*)(*(__tuple)))->e1)) : 0, MB_FUNC_WARNING, __exit, __result); \
500 } \
501 } while(0)
502
503 #define _set_tuple3_result(__l, __r) \
504 do { \
505 _object_t* val = (_object_t*)(((_tuple3_t*)(*(__l)))->e3); \
506 val->type = _DT_INT; \
507 val->data.integer = __r; \
508 } while(0)
509
510 /* ========================================================} */
511
512 /*
513 ** {========================================================
514 ** Private function declarations
515 */
516
517 /** List */
518 static int _ls_cmp_data(void* node, void* info);
519 static int _ls_cmp_extra(void* node, void* info);
520
521 static _ls_node_t* _ls_create_node(void* data);
522 static _ls_node_t* _ls_create(void);
523 static _ls_node_t* _ls_front(_ls_node_t* node);
524 static _ls_node_t* _ls_back(_ls_node_t* node);
525 static _ls_node_t* _ls_at(_ls_node_t* list, int pos);
526 static _ls_node_t* _ls_pushback(_ls_node_t* list, void* data);
527 _ls_node_t* _ls_pushfront(_ls_node_t* list, void* data);
528 _ls_node_t* _ls_insert(_ls_node_t* list, int pos, void* data);
529 static void* _ls_popback(_ls_node_t* list);
530 void* _ls_popfront(_ls_node_t* list);
531 unsigned int _ls_remove(_ls_node_t* list, int pos);
532 static unsigned int _ls_try_remove(_ls_node_t* list, void* info, _ls_compare cmp);
533 unsigned int _ls_count(_ls_node_t* list);
534 static unsigned int _ls_foreach(_ls_node_t* list, _ls_operation op);
535 bool_t _ls_empty(_ls_node_t* list);
536 static void _ls_clear(_ls_node_t* list);
537 static void _ls_destroy(_ls_node_t* list);
538 static int _ls_free_extra(void* data, void* extra);
539
540 /** Dictionary */
541 static unsigned int _ht_hash_string(void* ht, void* d);
542 static unsigned int _ht_hash_int(void* ht, void* d);
543 unsigned int _ht_hash_real(void* ht, void* d);
544 unsigned int _ht_hash_ptr(void* ht, void* d);
545
546 static int _ht_cmp_string(void* d1, void* d2);
547 static int _ht_cmp_int(void* d1, void* d2);
548 int _ht_cmp_real(void* d1, void* d2);
549 int _ht_cmp_ptr(void* d1, void* d2);
550
551 static _ht_node_t* _ht_create(unsigned int size, _ht_compare cmp, _ht_hash hs, _ls_operation freeextra);
552 static _ls_node_t* _ht_find(_ht_node_t* ht, void* key);
553 static unsigned int _ht_count(_ht_node_t* ht);
554 unsigned int _ht_get(_ht_node_t* ht, void* key, void** value);
555 unsigned int _ht_set(_ht_node_t* ht, void* key, void* value);
556 unsigned int _ht_set_or_insert(_ht_node_t* ht, void* key, void* value);
557 static unsigned int _ht_remove(_ht_node_t* ht, void* key);
558 static unsigned int _ht_foreach(_ht_node_t* ht, _ht_operation op);
559 bool_t _ht_empty(_ht_node_t* ht);
560 static void _ht_clear(_ht_node_t* ht);
561 static void _ht_destroy(_ht_node_t* ht);
562
563 /** Memory operations */
564 #define _MB_POINTER_SIZE (sizeof(intptr_t))
565 #define _MB_WRITE_CHUNK_SIZE(t, s) (*((size_t*)((char*)(t) - _MB_POINTER_SIZE)) = s)
566 #define _MB_READ_CHUNK_SIZE(t) (*((size_t*)((char*)(t) - _MB_POINTER_SIZE)))
567
568 #ifdef _MB_ENABLE_ALLOC_STAT
569 static volatile size_t _mb_allocated = 0;
570 #else /* _MB_ENABLE_ALLOC_STAT */
571 //static volatile size_t _mb_allocated = (size_t)(~0);
572 #endif /* _MB_ENABLE_ALLOC_STAT */
573
574 static void* mb_malloc(size_t s);
575 void* mb_realloc(void** p, size_t s);
576 static void mb_free(void* p);
577
578 #define safe_free(__p) do { if(__p) { mb_free(__p); __p = 0; } else { mb_assert(0 && "Memory already released"); } } while(0)
579
580 /** Expression processing */
581 static bool_t _is_operator(mb_func_t op);
582 static char _get_priority(mb_func_t op1, mb_func_t op2);
583 static int _get_priority_index(mb_func_t op);
584 static _object_t* _operate_operand(mb_interpreter_t* s, _object_t* optr, _object_t* opnd1, _object_t* opnd2, int* status);
585 static bool_t _is_expression_terminal(mb_interpreter_t* s, _object_t* obj);
586 static int _calc_expression(mb_interpreter_t* s, _ls_node_t** l, _object_t** val);
587 static bool_t _is_print_terminal(mb_interpreter_t* s, _object_t* obj);
588
589 /** Others */
590 #ifdef _WARING_AS_ERROR
591 # define _handle_error(__s, __err, __pos, __row, __col, __ret, __exit, __result) \
592 do { \
593 _set_current_error(__s, __err); \
594 _set_error_pos(__s, __pos, __row, __col); \
595 __result = __ret; \
596 goto __exit; \
597 } while(0)
598 #else /* _WARING_AS_ERROR */
599 # define _handle_error(__s, __err, __pos, __row, __col, __ret, __exit, __result) \
600 do { \
601 _set_current_error(__s, __err); \
602 _set_error_pos(__s, __pos, __row, __col); \
603 if(__ret != MB_FUNC_WARNING) { \
604 __result = __ret; \
605 } \
606 goto __exit; \
607 } while(0)
608 #endif /* _WARING_AS_ERROR */
609 #define _handle_error_on_obj(__s, __err, __obj, __ret, __exit, __result) \
610 do { \
611 if(__obj) { \
612 _handle_error(__s, __err, (__obj)->source_pos, (__obj)->source_row, (__obj)->source_col, __ret, __exit, __result); \
613 } else { \
614 _handle_error(__s, __err, 0, 0, 0, __ret, __exit, __result); \
615 } \
616 } while(0)
617
618 static void _set_current_error(mb_interpreter_t* s, mb_error_e err);
619 static const char* _get_error_desc(mb_error_e err);
620
621 static mb_print_func_t _get_printer(mb_interpreter_t* s);
622
623 static bool_t _is_blank(char c);
624 static bool_t _is_newline(char c);
625 static bool_t _is_separator(char c);
626 static bool_t _is_bracket(char c);
627 static bool_t _is_quotation_mark(char c);
628 static bool_t _is_comment(char c);
629 static bool_t _is_identifier_char(char c);
630 static bool_t _is_operator_char(char c);
631
632 static int _append_char_to_symbol(mb_interpreter_t* s, char c);
633 static int _cut_symbol(mb_interpreter_t* s, int pos, unsigned short row, unsigned short col);
634 static int _append_symbol(mb_interpreter_t* s, char* sym, bool_t* delsym, int pos, unsigned short row, unsigned short col);
635 static int _create_symbol(mb_interpreter_t* s, _ls_node_t* l, char* sym, _object_t** obj, _ls_node_t*** asgn, bool_t* delsym);
636 static _data_e _get_symbol_type(mb_interpreter_t* s, char* sym, void** value);
637
638 static int _parse_char(mb_interpreter_t* s, char c, int pos, unsigned short row, unsigned short col);
639 static void _set_error_pos(mb_interpreter_t* s, int pos, unsigned short row, unsigned short col);
640
641 static int_t _get_size_of(_data_e type);
642 static bool_t _try_get_value(_object_t* obj, mb_value_u* val, _data_e expected);
643
644 static int _get_array_index(mb_interpreter_t* s, _ls_node_t** l, unsigned int* index);
645 static bool_t _get_array_elem(mb_interpreter_t* s, _array_t* arr, unsigned int index, mb_value_u* val, _data_e* type);
646 static bool_t _set_array_elem(mb_interpreter_t* s, _array_t* arr, unsigned int index, mb_value_u* val, _data_e* type);
647
648 static void _init_array(_array_t* arr);
649 static void _clear_array(_array_t* arr);
650 static void _destroy_array(_array_t* arr);
651 static bool_t _is_string(void* obj);
652 static char* _extract_string(_object_t* obj);
653 static bool_t _is_internal_object(_object_t* obj);
654 static int _dispose_object(_object_t* obj);
655 static int _destroy_object(void* data, void* extra);
656 static int _compare_numbers(const _object_t* first, const _object_t* second);
657 static int _public_value_to_internal_object(mb_value_t* pbl, _object_t* itn);
658 static int _internal_object_to_public_value(_object_t* itn, mb_value_t* pbl);
659
660 static int _execute_statement(mb_interpreter_t* s, _ls_node_t** l);
661 static int _skip_to(mb_interpreter_t* s, _ls_node_t** l, mb_func_t f, _data_e t);
662 static int _skip_struct(mb_interpreter_t* s, _ls_node_t** l, mb_func_t open_func, mb_func_t close_func);
663
664 static int _register_func(mb_interpreter_t* s, const char* n, mb_func_t f, bool_t local);
665 static int _remove_func(mb_interpreter_t* s, const char* n, bool_t local);
666
667 static int _open_constant(mb_interpreter_t* s);
668 static int _close_constant(mb_interpreter_t* s);
669 static int _open_core_lib(mb_interpreter_t* s);
670 static int _close_core_lib(mb_interpreter_t* s);
671 static int _open_std_lib(mb_interpreter_t* s);
672 static int _close_std_lib(mb_interpreter_t* s);
673
674 /* ========================================================} */
675
676 /*
677 ** {========================================================
678 ** Lib declarations
679 */
680
681 /** Macro */
682 #ifdef _MSC_VER
683 # if _MSC_VER < 1300
684 # define _do_nothing do { static int i = 0; ++i; printf("Unaccessable function called %d times\n", i); } while(0)
685 # else /* _MSC_VER < 1300 */
686 # define _do_nothing do { printf("Unaccessable function: %s\n", __FUNCTION__); } while(0)
687 # endif /* _MSC_VER < 1300 */
688 #else /* _MSC_VER */
689 # define _do_nothing do { printf("Unaccessable function: %s\n", (const char *)__func__); } while(0)
690 #endif /* _MSC_VER */
691
692 /** Core lib */
693 static int _core_dummy_assign(mb_interpreter_t* s, void** l);
694 static int _core_add(mb_interpreter_t* s, void** l);
695 static int _core_min(mb_interpreter_t* s, void** l);
696 static int _core_mul(mb_interpreter_t* s, void** l);
697 static int _core_div(mb_interpreter_t* s, void** l);
698 static int _core_mod(mb_interpreter_t* s, void** l);
699 static int _core_pow(mb_interpreter_t* s, void** l);
700 static int _core_open_bracket(mb_interpreter_t* s, void** l);
701 static int _core_close_bracket(mb_interpreter_t* s, void** l);
702 static int _core_neg(mb_interpreter_t* s, void** l);
703 static int _core_equal(mb_interpreter_t* s, void** l);
704 static int _core_less(mb_interpreter_t* s, void** l);
705 static int _core_greater(mb_interpreter_t* s, void** l);
706 static int _core_less_equal(mb_interpreter_t* s, void** l);
707 static int _core_greater_equal(mb_interpreter_t* s, void** l);
708 static int _core_not_equal(mb_interpreter_t* s, void** l);
709 static int _core_and(mb_interpreter_t* s, void** l);
710 static int _core_or(mb_interpreter_t* s, void** l);
711 static int _core_not(mb_interpreter_t* s, void** l);
712 static int _core_let(mb_interpreter_t* s, void** l);
713 static int _core_dim(mb_interpreter_t* s, void** l);
714 static int _core_if(mb_interpreter_t* s, void** l);
715 static int _core_then(mb_interpreter_t* s, void** l);
716 static int _core_else(mb_interpreter_t* s, void** l);
717 static int _core_for(mb_interpreter_t* s, void** l);
718 static int _core_to(mb_interpreter_t* s, void** l);
719 static int _core_step(mb_interpreter_t* s, void** l);
720 static int _core_next(mb_interpreter_t* s, void** l);
721 static int _core_while(mb_interpreter_t* s, void** l);
722 static int _core_wend(mb_interpreter_t* s, void** l);
723 static int _core_do(mb_interpreter_t* s, void** l);
724 static int _core_until(mb_interpreter_t* s, void** l);
725 static int _core_exit(mb_interpreter_t* s, void** l);
726 static int _core_goto(mb_interpreter_t* s, void** l);
727 static int _core_gosub(mb_interpreter_t* s, void** l);
728 static int _core_return(mb_interpreter_t* s, void** l);
729 static int _core_end(mb_interpreter_t* s, void** l);
730 #ifdef _MB_ENABLE_ALLOC_STAT
731 static int _core_mem(mb_interpreter_t* s, void** l);
732 #endif /* _MB_ENABLE_ALLOC_STAT */
733
734 /** Std lib */
735 static int _std_abs(mb_interpreter_t* s, void** l);
736 static int _std_sgn(mb_interpreter_t* s, void** l);
737 static int _std_sqr(mb_interpreter_t* s, void** l);
738 static int _std_floor(mb_interpreter_t* s, void** l);
739 static int _std_ceil(mb_interpreter_t* s, void** l);
740 static int _std_fix(mb_interpreter_t* s, void** l);
741 static int _std_round(mb_interpreter_t* s, void** l);
742 static int _std_rnd(mb_interpreter_t* s, void** l);
743 static int _std_sin(mb_interpreter_t* s, void** l);
744 static int _std_cos(mb_interpreter_t* s, void** l);
745 static int _std_tan(mb_interpreter_t* s, void** l);
746 static int _std_asin(mb_interpreter_t* s, void** l);
747 static int _std_acos(mb_interpreter_t* s, void** l);
748 static int _std_atan(mb_interpreter_t* s, void** l);
749 static int _std_exp(mb_interpreter_t* s, void** l);
750 static int _std_log(mb_interpreter_t* s, void** l);
751 static int _std_asc(mb_interpreter_t* s, void** l);
752 static int _std_chr(mb_interpreter_t* s, void** l);
753 static int _std_left(mb_interpreter_t* s, void** l);
754 static int _std_len(mb_interpreter_t* s, void** l);
755 static int _std_mid(mb_interpreter_t* s, void** l);
756 static int _std_right(mb_interpreter_t* s, void** l);
757 static int _std_str(mb_interpreter_t* s, void** l);
758 static int _std_val(mb_interpreter_t* s, void** l);
759 static int _std_print(mb_interpreter_t* s, void** l);
760 static int _std_input(mb_interpreter_t* s, void** l);
761
762 /** Lib information */
763 static const _func_t _core_libs[] = {
764 { "#", _core_dummy_assign },
765 { "+", _core_add },
766 { "-", _core_min },
767 { "*", _core_mul },
768 { "/", _core_div },
769 { "MOD", _core_mod },
770 { "^", _core_pow },
771 { "(", _core_open_bracket },
772 { ")", _core_close_bracket },
773 { 0, _core_neg },
774
775 { "=", _core_equal },
776 { "<", _core_less },
777 { ">", _core_greater },
778 { "<=", _core_less_equal },
779 { ">=", _core_greater_equal },
780 { "<>", _core_not_equal },
781
782 { "AND", _core_and },
783 { "OR", _core_or },
784 { "NOT", _core_not },
785
786 { "LET", _core_let },
787 { "DIM", _core_dim },
788
789 { "IF", _core_if },
790 { "THEN", _core_then },
791 { "ELSE", _core_else },
792
793 { "FOR", _core_for },
794 { "TO", _core_to },
795 { "STEP", _core_step },
796 { "NEXT", _core_next },
797 { "WHILE", _core_while },
798 { "WEND", _core_wend },
799 { "DO", _core_do },
800 { "UNTIL", _core_until },
801
802 { "EXIT", _core_exit },
803 { "GOTO", _core_goto },
804 { "GOSUB", _core_gosub },
805 { "RETURN", _core_return },
806
807 { "END", _core_end },
808
809 #ifdef _MB_ENABLE_ALLOC_STAT
810 { "MEM", _core_mem },
811 #endif /* _MB_ENABLE_ALLOC_STAT */
812 };
813
814 static const _func_t _std_libs[] = {
815 { "ABS", _std_abs },
816 { "SGN", _std_sgn },
817 { "SQR", _std_sqr },
818 { "FLOOR", _std_floor },
819 { "CEIL", _std_ceil },
820 { "FIX", _std_fix },
821 { "ROUND", _std_round },
822 { "RND", _std_rnd },
823 { "SIN", _std_sin },
824 { "COS", _std_cos },
825 { "TAN", _std_tan },
826 { "ASIN", _std_asin },
827 { "ACOS", _std_acos },
828 { "ATAN", _std_atan },
829 { "EXP", _std_exp },
830 { "LOG", _std_log },
831
832 { "ASC", _std_asc },
833 { "CHR", _std_chr },
834 { "LEFT", _std_left },
835 { "LEN", _std_len },
836 { "MID", _std_mid },
837 { "RIGHT", _std_right },
838 { "STR", _std_str },
839 { "VAL", _std_val },
840
841 { "PRINT", _std_print },
842 { "INPUT", _std_input },
843 };
844
845 /* ========================================================} */
846
847 /*
848 ** {========================================================
849 ** Private function definitions
850 */
851
852 /** List */
_ls_cmp_data(void * node,void * info)853 int _ls_cmp_data(void* node, void* info) {
854 _ls_node_t* n = (_ls_node_t*)node;
855
856 return (n->data == info) ? 0 : 1;
857 }
858
_ls_cmp_extra(void * node,void * info)859 int _ls_cmp_extra(void* node, void* info) {
860 _ls_node_t* n = (_ls_node_t*)node;
861
862 return (n->extra == info) ? 0 : 1;
863 }
864
_ls_create_node(void * data)865 _ls_node_t* _ls_create_node(void* data) {
866 _ls_node_t* result = 0;
867
868 result = (_ls_node_t*)mb_malloc(sizeof(_ls_node_t));
869 mb_assert(result);
870 memset(result, 0, sizeof(_ls_node_t));
871 result->data = data;
872
873 return result;
874 }
875
_ls_create(void)876 _ls_node_t* _ls_create(void) {
877 _ls_node_t* result = 0;
878
879 result = _ls_create_node(0);
880
881 return result;
882 }
883
_ls_front(_ls_node_t * node)884 _ls_node_t* _ls_front(_ls_node_t* node) {
885 _ls_node_t* result = node;
886
887 result = result->next;
888
889 return result;
890 }
891
_ls_back(_ls_node_t * node)892 _ls_node_t* _ls_back(_ls_node_t* node) {
893 _ls_node_t* result = node;
894
895 result = result->prev;
896
897 return result;
898 }
899
_ls_at(_ls_node_t * list,int pos)900 _ls_node_t* _ls_at(_ls_node_t* list, int pos) {
901 _ls_node_t* result = list;
902 int i = 0;
903
904 mb_assert(result && pos >= 0);
905
906 for(i = 0; i <= pos; ++i) {
907 if(!result->next) {
908 result = 0;
909 break;
910 } else {
911 result = result->next;
912 }
913 }
914
915 return result;
916 }
917
_ls_pushback(_ls_node_t * list,void * data)918 _ls_node_t* _ls_pushback(_ls_node_t* list, void* data) {
919 _ls_node_t* result = 0;
920 _ls_node_t* tmp = 0;
921
922 mb_assert(list);
923
924 result = _ls_create_node(data);
925
926 tmp = _ls_back(list);
927 if(!tmp) {
928 tmp = list;
929 }
930 tmp->next = result;
931 result->prev = tmp;
932 list->prev = result;
933
934 return result;
935 }
936
_ls_pushfront(_ls_node_t * list,void * data)937 _ls_node_t* _ls_pushfront(_ls_node_t* list, void* data) {
938 _ls_node_t* result = 0;
939 _ls_node_t* head = 0;
940
941 mb_assert(list);
942
943 result = _ls_create_node(data);
944
945 head = list;
946 list = _ls_front(list);
947 head->next = result;
948 result->prev = head;
949 if(list) {
950 result->next = list;
951 list->prev = result;
952 }
953
954 return result;
955 }
956
_ls_insert(_ls_node_t * list,int pos,void * data)957 _ls_node_t* _ls_insert(_ls_node_t* list, int pos, void* data) {
958 _ls_node_t* result = 0;
959 _ls_node_t* tmp = 0;
960
961 mb_assert(list && pos >= 0);
962
963 list = _ls_at(list, pos);
964 mb_assert(list);
965 if(list) {
966 result = _ls_create_node(data);
967 tmp = list->prev;
968
969 tmp->next = result;
970 result->prev = tmp;
971
972 result->next = list;
973 list->prev = result;
974 }
975
976 return result;
977 }
978
_ls_popback(_ls_node_t * list)979 void* _ls_popback(_ls_node_t* list) {
980 void* result = 0;
981 _ls_node_t* tmp = 0;
982
983 mb_assert(list);
984
985 tmp = _ls_back(list);
986 if(tmp) {
987 result = tmp->data;
988
989 if(list != tmp->prev) {
990 list->prev = tmp->prev;
991 } else {
992 list->prev = 0;
993 }
994
995 tmp->prev->next = 0;
996 safe_free(tmp);
997 }
998
999 return result;
1000 }
1001
_ls_popfront(_ls_node_t * list)1002 void* _ls_popfront(_ls_node_t* list) {
1003 void* result = 0;
1004 _ls_node_t* tmp = 0;
1005
1006 mb_assert(list);
1007
1008 tmp = _ls_front(list);
1009 if(tmp) {
1010 result = tmp->data;
1011
1012 if(!tmp->next) {
1013 list->prev = 0;
1014 }
1015
1016 tmp->prev->next = tmp->next;
1017 if(tmp->next) {
1018 tmp->next->prev = tmp->prev;
1019 }
1020 safe_free(tmp);
1021 }
1022
1023 return result;
1024 }
1025
_ls_remove(_ls_node_t * list,int pos)1026 unsigned int _ls_remove(_ls_node_t* list, int pos) {
1027 unsigned int result = 0;
1028 _ls_node_t* tmp = 0;
1029
1030 mb_assert(list && pos >= 0);
1031
1032 tmp = _ls_at(list, pos);
1033 if(tmp) {
1034 if(tmp->prev) {
1035 tmp->prev->next = tmp->next;
1036 }
1037 if(tmp->next) {
1038 tmp->next->prev = tmp->prev;
1039 } else {
1040 list->prev = tmp->prev;
1041 }
1042
1043 safe_free(tmp);
1044
1045 ++result;
1046 }
1047
1048 return result;
1049 }
1050
_ls_try_remove(_ls_node_t * list,void * info,_ls_compare cmp)1051 unsigned int _ls_try_remove(_ls_node_t* list, void* info, _ls_compare cmp) {
1052 unsigned int result = 0;
1053 _ls_node_t* tmp = 0;
1054
1055 mb_assert(list && cmp);
1056
1057 tmp = list->next;
1058 while(tmp) {
1059 if(cmp(tmp, info) == 0) {
1060 if(tmp->prev) {
1061 tmp->prev->next = tmp->next;
1062 }
1063 if(tmp->next) {
1064 tmp->next->prev = tmp->prev;
1065 }
1066 if(list->prev == tmp) {
1067 list->prev = 0;
1068 }
1069 safe_free(tmp);
1070 ++result;
1071 break;
1072 }
1073 tmp = tmp->next;
1074 }
1075
1076 return result;
1077 }
1078
_ls_count(_ls_node_t * list)1079 unsigned int _ls_count(_ls_node_t* list) {
1080 unsigned int result = 0;
1081
1082 mb_assert(list);
1083
1084 while(list->next) {
1085 ++result;
1086 list = list->next;
1087 }
1088
1089 return result;
1090 }
1091
_ls_foreach(_ls_node_t * list,_ls_operation op)1092 unsigned int _ls_foreach(_ls_node_t* list, _ls_operation op) {
1093 unsigned int idx = 0;
1094 int opresult = _OP_RESULT_NORMAL;
1095 _ls_node_t* tmp = 0;
1096
1097 mb_assert(list && op);
1098
1099 list = list->next;
1100 while(list) {
1101 opresult = (*op)(list->data, list->extra);
1102 ++idx;
1103 tmp = list;
1104 list = list->next;
1105
1106 if(_OP_RESULT_NORMAL == opresult) {
1107 /* Do nothing */
1108 } else if(_OP_RESULT_DEL_NODE == opresult) {
1109 tmp->prev->next = list;
1110 if(list) {
1111 list->prev = tmp->prev;
1112 }
1113 safe_free(tmp);
1114 } else {
1115 /* Do nothing */
1116 }
1117 }
1118
1119 return idx;
1120 }
1121
_ls_empty(_ls_node_t * list)1122 bool_t _ls_empty(_ls_node_t* list) {
1123 bool_t result = false;
1124
1125 mb_assert(list);
1126
1127 result = 0 == list->next;
1128
1129 return result;
1130 }
1131
_ls_clear(_ls_node_t * list)1132 void _ls_clear(_ls_node_t* list) {
1133 _ls_node_t* tmp = 0;
1134
1135 mb_assert(list);
1136
1137 tmp = list;
1138 list = list->next;
1139 tmp->next = 0;
1140 tmp->prev = 0;
1141
1142 while(list) {
1143 tmp = list;
1144 list = list->next;
1145 safe_free(tmp);
1146 }
1147 }
1148
_ls_destroy(_ls_node_t * list)1149 void _ls_destroy(_ls_node_t* list) {
1150 _ls_clear(list);
1151
1152 safe_free(list);
1153 }
1154
_ls_free_extra(void * data,void * extra)1155 int _ls_free_extra(void* data, void* extra) {
1156 int result = _OP_RESULT_NORMAL;
1157 mb_unrefvar(data);
1158
1159 mb_assert(extra);
1160
1161 safe_free(extra);
1162
1163 result = _OP_RESULT_DEL_NODE;
1164
1165 return result;
1166 }
1167
1168 /** Dictionary */
_ht_hash_string(void * ht,void * d)1169 unsigned int _ht_hash_string(void* ht, void* d) {
1170 unsigned int result = 0;
1171 _ht_node_t* self = (_ht_node_t*)ht;
1172 char* s = (char*)d;
1173 unsigned int h = 0;
1174
1175 mb_assert(ht);
1176
1177 for( ; *s; ++s) {
1178 h = 5 * h + *s;
1179 }
1180
1181 result = h % self->array_size;
1182
1183 return result;
1184 }
1185
_ht_hash_int(void * ht,void * d)1186 unsigned int _ht_hash_int(void* ht, void* d) {
1187 unsigned int result = 0;
1188 _ht_node_t* self = (_ht_node_t*)ht;
1189 int_t i = *(int_t*)d;
1190
1191 mb_assert(ht);
1192
1193 result = (unsigned int)i;
1194 result %= self->array_size;
1195
1196 return result;
1197 }
1198
_ht_hash_real(void * ht,void * d)1199 unsigned int _ht_hash_real(void* ht, void* d) {
1200 real_t r = *(real_t*)d;
1201 union {
1202 real_t r;
1203 int_t i;
1204 } u;
1205 u.r = r;
1206
1207 return _ht_hash_int(ht, &u.i);
1208 }
1209
_ht_hash_ptr(void * ht,void * d)1210 unsigned int _ht_hash_ptr(void* ht, void* d) {
1211 union {
1212 int_t i;
1213 void* p;
1214 } u;
1215 u.p = d;
1216
1217 return _ht_hash_int(ht, &u.i);
1218 }
1219
_ht_cmp_string(void * d1,void * d2)1220 int _ht_cmp_string(void* d1, void* d2) {
1221 char* s1 = (char*)d1;
1222 char* s2 = (char*)d2;
1223
1224 return strcmp(s1, s2);
1225 }
1226
_ht_cmp_int(void * d1,void * d2)1227 int _ht_cmp_int(void* d1, void* d2) {
1228 int_t i1 = *(int_t*)d1;
1229 int_t i2 = *(int_t*)d2;
1230 int_t i = i1 - i2;
1231 int result = 0;
1232 if(i < 0) {
1233 result = -1;
1234 } else if(i > 0) {
1235 result = 1;
1236 }
1237
1238 return result;
1239 }
1240
_ht_cmp_real(void * d1,void * d2)1241 int _ht_cmp_real(void* d1, void* d2) {
1242 real_t r1 = *(real_t*)d1;
1243 real_t r2 = *(real_t*)d2;
1244 real_t r = r1 - r2;
1245 int result = 0;
1246 if(r < 0.0f) {
1247 result = -1;
1248 } else if(r > 0.0f) {
1249 result = 1;
1250 }
1251
1252 return result;
1253 }
1254
_ht_cmp_ptr(void * d1,void * d2)1255 int _ht_cmp_ptr(void* d1, void* d2) {
1256 int_t i1 = *(int_t*)d1;
1257 int_t i2 = *(int_t*)d2;
1258 int_t i = i1 - i2;
1259 int result = 0;
1260 if(i < 0) {
1261 result = -1;
1262 } else if(i > 0) {
1263 result = 1;
1264 }
1265
1266 return result;
1267 }
1268
_ht_create(unsigned int size,_ht_compare cmp,_ht_hash hs,_ls_operation freeextra)1269 _ht_node_t* _ht_create(unsigned int size, _ht_compare cmp, _ht_hash hs, _ls_operation freeextra) {
1270 const unsigned int array_size = size ? size : _HT_ARRAY_SIZE_DEFAULT;
1271 _ht_node_t* result = 0;
1272 unsigned int ul = 0;
1273
1274 if(!cmp) {
1275 cmp = _ht_cmp_int;
1276 }
1277 if(!hs) {
1278 hs = _ht_hash_int;
1279 }
1280
1281 result = (_ht_node_t*)mb_malloc(sizeof(_ht_node_t));
1282 result->free_extra = freeextra;
1283 result->compare = cmp;
1284 result->hash = hs;
1285 result->array_size = array_size;
1286 result->count = 0;
1287 result->array = (_ls_node_t**)mb_malloc(sizeof(_ls_node_t*) * result->array_size);
1288 for(ul = 0; ul < result->array_size; ++ul) {
1289 result->array[ul] = _ls_create();
1290 }
1291
1292 return result;
1293 }
1294
_ht_find(_ht_node_t * ht,void * key)1295 _ls_node_t* _ht_find(_ht_node_t* ht, void* key) {
1296 _ls_node_t* result = 0;
1297 _ls_node_t* bucket = 0;
1298 unsigned int hash_code = 0;
1299
1300 mb_assert(ht && key);
1301
1302 hash_code = ht->hash(ht, key);
1303 bucket = ht->array[hash_code];
1304 bucket = bucket->next;
1305 while(bucket) {
1306 if(ht->compare(bucket->extra, key) == 0) {
1307 result = bucket;
1308 break;
1309 }
1310 bucket = bucket->next;
1311 }
1312
1313 return result;
1314 }
1315
_ht_count(_ht_node_t * ht)1316 unsigned int _ht_count(_ht_node_t* ht) {
1317 unsigned int result = 0;
1318
1319 mb_assert(ht);
1320
1321 result = ht->count;
1322
1323 return result;
1324 }
1325
_ht_get(_ht_node_t * ht,void * key,void ** value)1326 unsigned int _ht_get(_ht_node_t* ht, void* key, void** value) {
1327 unsigned int result = 0;
1328 _ls_node_t* bucket = 0;
1329
1330 mb_assert(ht && key && value);
1331
1332 bucket = _ht_find(ht, key);
1333 if(bucket) {
1334 *value = bucket->data;
1335 ++result;
1336 }
1337
1338 return result;
1339 }
1340
_ht_set(_ht_node_t * ht,void * key,void * value)1341 unsigned int _ht_set(_ht_node_t* ht, void* key, void* value) {
1342 unsigned int result = 0;
1343 _ls_node_t* bucket = 0;
1344
1345 mb_assert(ht && key);
1346
1347 bucket = _ht_find(ht, key);
1348 if(bucket) {
1349 bucket->data = value;
1350 ++result;
1351 }
1352
1353 return result;
1354 }
1355
_ht_set_or_insert(_ht_node_t * ht,void * key,void * value)1356 unsigned int _ht_set_or_insert(_ht_node_t* ht, void* key, void* value) {
1357 unsigned int result = 0;
1358 _ls_node_t* bucket = 0;
1359 unsigned int hash_code = 0;
1360
1361 mb_assert(ht && key);
1362
1363 bucket = _ht_find(ht, key);
1364 if(bucket) { /* Update */
1365 bucket->data = value;
1366 ++result;
1367 } else { /* Insert */
1368 hash_code = ht->hash(ht, key);
1369 bucket = ht->array[hash_code];
1370 bucket = _ls_pushback(bucket, value);
1371 mb_assert(bucket);
1372 bucket->extra = key;
1373 ++ht->count;
1374 ++result;
1375 }
1376
1377 return result;
1378 }
1379
_ht_remove(_ht_node_t * ht,void * key)1380 unsigned int _ht_remove(_ht_node_t* ht, void* key) {
1381 unsigned int result = 0;
1382 unsigned int hash_code = 0;
1383 _ls_node_t* bucket = 0;
1384
1385 mb_assert(ht && key);
1386
1387 hash_code = ht->hash(ht, key);
1388 bucket = ht->array[hash_code];
1389 result = _ls_try_remove(bucket, key, _ls_cmp_extra);
1390 ht->count -= result;
1391
1392 return result;
1393 }
1394
_ht_foreach(_ht_node_t * ht,_ht_operation op)1395 unsigned int _ht_foreach(_ht_node_t* ht, _ht_operation op) {
1396 unsigned int result = 0;
1397 _ls_node_t* bucket = 0;
1398 unsigned int ul = 0;
1399
1400 for(ul = 0; ul < ht->array_size; ++ul) {
1401 bucket = ht->array[ul];
1402 if(bucket) {
1403 result += _ls_foreach(bucket, op);
1404 }
1405 }
1406
1407 return result;
1408 }
1409
_ht_empty(_ht_node_t * ht)1410 bool_t _ht_empty(_ht_node_t* ht) {
1411 return 0 == _ht_count(ht);
1412 }
1413
_ht_clear(_ht_node_t * ht)1414 void _ht_clear(_ht_node_t* ht) {
1415 unsigned int ul = 0;
1416
1417 mb_assert(ht && ht->array);
1418
1419 for(ul = 0; ul < ht->array_size; ++ul) {
1420 _ls_clear(ht->array[ul]);
1421 }
1422 ht->count = 0;
1423 }
1424
_ht_destroy(_ht_node_t * ht)1425 void _ht_destroy(_ht_node_t* ht) {
1426 unsigned int ul = 0;
1427
1428 mb_assert(ht && ht->array);
1429
1430 if(ht->free_extra) {
1431 _ht_foreach(ht, ht->free_extra);
1432 }
1433
1434 for(ul = 0; ul < ht->array_size; ++ul) {
1435 _ls_destroy(ht->array[ul]);
1436 }
1437 safe_free(ht->array);
1438 safe_free(ht);
1439 }
1440
1441 /** Memory operations */
mb_malloc(size_t s)1442 void* mb_malloc(size_t s) {
1443 char* ret = NULL;
1444 size_t rs = s;
1445 #ifdef _MB_ENABLE_ALLOC_STAT
1446 rs += _MB_POINTER_SIZE;
1447 #endif /* _MB_ENABLE_ALLOC_STAT */
1448 ret = (char*)malloc(rs);
1449 mb_assert(ret);
1450 #ifdef _MB_ENABLE_ALLOC_STAT
1451 _mb_allocated += s;
1452 ret += _MB_POINTER_SIZE;
1453 _MB_WRITE_CHUNK_SIZE(ret, s);
1454 #endif /* _MB_ENABLE_ALLOC_STAT */
1455
1456 return (void*)ret;
1457 }
1458
mb_realloc(void ** p,size_t s)1459 void* mb_realloc(void** p, size_t s) {
1460 char* ret = NULL;
1461 size_t rs = s;
1462 size_t os = 0; (void)os;
1463 mb_assert(p);
1464 #ifdef _MB_ENABLE_ALLOC_STAT
1465 if(*p) {
1466 os = _MB_READ_CHUNK_SIZE(*p);
1467 *p = (char*)(*p) - _MB_POINTER_SIZE;
1468 }
1469 rs += _MB_POINTER_SIZE;
1470 #endif /* _MB_ENABLE_ALLOC_STAT */
1471 ret = (char*)realloc(*p, rs);
1472 mb_assert(ret);
1473 #ifdef _MB_ENABLE_ALLOC_STAT
1474 _mb_allocated -= os;
1475 _mb_allocated += s;
1476 ret += _MB_POINTER_SIZE;
1477 _MB_WRITE_CHUNK_SIZE(ret, s);
1478 *p = (void*)ret;
1479 #endif /* _MB_ENABLE_ALLOC_STAT */
1480
1481 return (void*)ret;
1482 }
1483
mb_free(void * p)1484 void mb_free(void* p) {
1485 mb_assert(p);
1486
1487 #ifdef _MB_ENABLE_ALLOC_STAT
1488 do {
1489 size_t os = _MB_READ_CHUNK_SIZE(p);
1490 _mb_allocated -= os;
1491 p = (char*)p - _MB_POINTER_SIZE;
1492 } while(0);
1493 #endif /* _MB_ENABLE_ALLOC_STAT */
1494
1495 free(p);
1496 }
1497
1498 /** Expression processing */
_is_operator(mb_func_t op)1499 bool_t _is_operator(mb_func_t op) {
1500 /* Determine whether a function is an operator */
1501 bool_t result = false;
1502
1503 result =
1504 (op == _core_dummy_assign) ||
1505 (op == _core_add) ||
1506 (op == _core_min) ||
1507 (op == _core_mul) ||
1508 (op == _core_div) ||
1509 (op == _core_mod) ||
1510 (op == _core_pow) ||
1511 (op == _core_open_bracket) ||
1512 (op == _core_close_bracket) ||
1513 (op == _core_equal) ||
1514 (op == _core_greater) ||
1515 (op == _core_less) ||
1516 (op == _core_greater_equal) ||
1517 (op == _core_less_equal) ||
1518 (op == _core_not_equal) ||
1519 (op == _core_and) ||
1520 (op == _core_or);
1521
1522 return result;
1523 }
1524
_get_priority(mb_func_t op1,mb_func_t op2)1525 char _get_priority(mb_func_t op1, mb_func_t op2) {
1526 /* Get the priority of two operators */
1527 char result = '\0';
1528 int idx1 = 0;
1529 int idx2 = 0;
1530
1531 mb_assert(op1 && op2);
1532
1533 idx1 = _get_priority_index(op1);
1534 idx2 = _get_priority_index(op2);
1535 mb_assert(idx1 < _countof(_PRECEDE_TABLE) && idx2 < _countof(_PRECEDE_TABLE[0]));
1536 result = _PRECEDE_TABLE[idx1][idx2];
1537
1538 return result;
1539 }
1540
_get_priority_index(mb_func_t op)1541 int _get_priority_index(mb_func_t op) {
1542 /* Get the index of an operator in the priority table */
1543 int result = 0;
1544
1545 mb_assert(op);
1546
1547 if(op == _core_dummy_assign) {
1548 result = 8;
1549 } else if(op == _core_add) {
1550 result = 0;
1551 } else if(op == _core_min) {
1552 result = 1;
1553 } else if(op == _core_mul) {
1554 result = 2;
1555 } else if(op == _core_div) {
1556 result = 3;
1557 } else if(op == _core_mod) {
1558 result = 4;
1559 } else if(op == _core_pow) {
1560 result = 5;
1561 } else if(op == _core_open_bracket) {
1562 result = 6;
1563 } else if(op == _core_close_bracket) {
1564 result = 7;
1565 } else if(op == _core_equal) {
1566 result = 13;
1567 } else if(op == _core_greater) {
1568 result = 9;
1569 } else if(op == _core_less) {
1570 result = 10;
1571 } else if(op == _core_greater_equal) {
1572 result = 11;
1573 } else if(op == _core_less_equal) {
1574 result = 12;
1575 } else if(op == _core_not_equal) {
1576 result = 14;
1577 } else if(op == _core_and) {
1578 result = 15;
1579 } else if(op == _core_or) {
1580 result = 16;
1581 } else if(op == _core_not) {
1582 result = 17;
1583 } else if(op == _core_neg) {
1584 result = 18;
1585 } else {
1586 mb_assert(0 && "Unknown operator");
1587 }
1588
1589 return result;
1590 }
1591
_operate_operand(mb_interpreter_t * s,_object_t * optr,_object_t * opnd1,_object_t * opnd2,int * status)1592 _object_t* _operate_operand(mb_interpreter_t* s, _object_t* optr, _object_t* opnd1, _object_t* opnd2, int* status) {
1593 /* Operate two operands */
1594 _object_t* result = 0;
1595 _tuple3_t tp;
1596 _tuple3_t* tpptr = 0;
1597 int _status = 0;
1598
1599 mb_assert(s && optr);
1600 mb_assert(optr->type == _DT_FUNC);
1601
1602 if(!opnd1) {
1603 return result;
1604 }
1605
1606 result = (_object_t*)mb_malloc(sizeof(_object_t));
1607 memset(result, 0, sizeof(_object_t));
1608
1609 memset(&tp, 0, sizeof(_tuple3_t));
1610 tp.e1 = opnd1;
1611 tp.e2 = opnd2;
1612 tp.e3 = result;
1613 tpptr = &tp;
1614
1615 _status = (optr->data.func->pointer)(s, (void**)(&tpptr));
1616 if(status) {
1617 *status = _status;
1618 }
1619 if(_status != MB_FUNC_OK) {
1620 if(_status != MB_FUNC_WARNING) {
1621 safe_free(result);
1622 result = 0;
1623 }
1624 _set_current_error(s, SE_RN_OPERATION_FAILED);
1625 _set_error_pos(s, optr->source_pos, optr->source_row, optr->source_col);
1626 }
1627
1628 return result;
1629 }
1630
_is_expression_terminal(mb_interpreter_t * s,_object_t * obj)1631 bool_t _is_expression_terminal(mb_interpreter_t* s, _object_t* obj) {
1632 /* Determine whether an object is an expression termination */
1633 bool_t result = false;
1634
1635 mb_assert(s && obj);
1636
1637 result =
1638 (obj->type == _DT_EOS) ||
1639 (obj->type == _DT_SEP) ||
1640 (obj->type == _DT_FUNC &&
1641 (obj->data.func->pointer == _core_then ||
1642 obj->data.func->pointer == _core_else ||
1643 obj->data.func->pointer == _core_to ||
1644 obj->data.func->pointer == _core_step)
1645 );
1646
1647 return result;
1648 }
1649
_calc_expression(mb_interpreter_t * s,_ls_node_t ** l,_object_t ** val)1650 int _calc_expression(mb_interpreter_t* s, _ls_node_t** l, _object_t** val) {
1651 /* Calculate an expression */
1652 int result = 0;
1653 _ls_node_t* ast = 0;
1654 _running_context_t* running = 0;
1655 _ls_node_t* garbage = 0;
1656 _ls_node_t* optr = 0;
1657 _ls_node_t* opnd = 0;
1658 _object_t* c = 0;
1659 //_object_t* x = 0;
1660 _object_t* a = 0;
1661 _object_t* b = 0;
1662 _object_t* r = 0;
1663 _object_t* theta = 0;
1664 char pri = '\0';
1665
1666 unsigned int arr_idx = 0;
1667 mb_value_u arr_val;
1668 _data_e arr_type;
1669 _object_t* arr_elem = 0;
1670
1671 _object_t* guard_val = 0;
1672 int bracket_count = 0;
1673 bool_t hack = false;
1674 _ls_node_t* errn = 0;
1675
1676 mb_assert(s && l);
1677
1678 running = (_running_context_t*)(s->running_context);
1679 ast = *l;
1680 garbage = _ls_create();
1681 optr = _ls_create();
1682 opnd = _ls_create();
1683
1684 c = (_object_t*)(ast->data);
1685 do {
1686 if(c->type == _DT_STRING) {
1687 if(ast->next) {
1688 _object_t* _fsn = (_object_t*)ast->next->data;
1689 if(_fsn->type == _DT_FUNC && _fsn->data.func->pointer == _core_add) {
1690 break;
1691 }
1692 }
1693
1694 (*val)->type = _DT_STRING;
1695 (*val)->data.string = c->data.string;
1696 (*val)->ref = true;
1697 ast = ast->next;
1698 goto _exit;
1699 }
1700 } while(0);
1701 guard_val = c;
1702 ast = ast->next;
1703 _ls_pushback(optr, _exp_assign);
1704 while(
1705 !(c->type == _DT_FUNC &&
1706 strcmp(c->data.func->name, "#") == 0) ||
1707 !(((_object_t*)(_ls_back(optr)->data))->type == _DT_FUNC &&
1708 strcmp(((_object_t*)(_ls_back(optr)->data))->data.func->name, "#") == 0)) {
1709 if(!hack) {
1710 if(c->type == _DT_FUNC && c->data.func->pointer == _core_open_bracket) {
1711 ++bracket_count;
1712 } else if(c->type == _DT_FUNC && c->data.func->pointer == _core_close_bracket) {
1713 --bracket_count;
1714 if(bracket_count < 0) {
1715 c = _exp_assign;
1716 ast = ast->prev;
1717 continue;
1718 }
1719 }
1720 }
1721 hack = false;
1722 if(!(c->type == _DT_FUNC && _is_operator(c->data.func->pointer))) {
1723 if(_is_expression_terminal(s, c)) {
1724 c = _exp_assign;
1725 if(ast) {
1726 ast = ast->prev;
1727 }
1728 if(bracket_count) {
1729 _object_t _cb;
1730 _func_t _cbf;
1731 memset(&_cb, 0, sizeof(_object_t));
1732 _cb.type = _DT_FUNC;
1733 _cb.data.func = &_cbf;
1734 _cb.data.func->name = ")";
1735 _cb.data.func->pointer = _core_close_bracket;
1736 while(bracket_count) {
1737 _ls_pushback(optr, &_cb);
1738 bracket_count--;
1739 }
1740 errn = ast;
1741 }
1742 } else {
1743 if(c->type == _DT_ARRAY) {
1744 ast = ast->prev;
1745 result = _get_array_index(s, &ast, &arr_idx);
1746 if(result != MB_FUNC_OK) {
1747 _handle_error_on_obj(s, SE_RN_CALCULATION_ERROR, DON(ast), MB_FUNC_ERR, _exit, result);
1748 }
1749 ast = ast->next;
1750 _get_array_elem(s, c->data.array, arr_idx, &arr_val, &arr_type);
1751 arr_elem = (_object_t*)mb_malloc(sizeof(_object_t));
1752 memset(arr_elem, 0, sizeof(_object_t));
1753 _ls_pushback(garbage, arr_elem);
1754 arr_elem->type = arr_type;
1755 if(arr_type == _DT_REAL) {
1756 arr_elem->data.float_point = arr_val.float_point;
1757 } else if(arr_type == _DT_STRING) {
1758 arr_elem->data.string = arr_val.string;
1759 } else {
1760 mb_assert(0 && "Unsupported");
1761 }
1762 _ls_pushback(opnd, arr_elem);
1763 } else if(c->type == _DT_FUNC) {
1764 ast = ast->prev;
1765 result = (c->data.func->pointer)(s, (void**)(&ast));
1766 if(result != MB_FUNC_OK) {
1767 _handle_error_on_obj(s, SE_RN_CALCULATION_ERROR, DON(ast), MB_FUNC_ERR, _exit, result);
1768 }
1769 c = (_object_t*)mb_malloc(sizeof(_object_t));
1770 memset(c, 0, sizeof(_object_t));
1771 _ls_pushback(garbage, c);
1772 result = _public_value_to_internal_object(&running->intermediate_value, c);
1773 if(result != MB_FUNC_OK) {
1774 goto _exit;
1775 }
1776 _ls_pushback(opnd, c);
1777 } else {
1778 if(c->type == _DT_VAR && ast) {
1779 _object_t* _err_var = (_object_t*)(ast->data);
1780 if(_err_var->type == _DT_FUNC && _err_var->data.func->pointer == _core_open_bracket) {
1781 _handle_error_on_obj(s, SE_RN_INVALID_ID_USAGE, DON(ast), MB_FUNC_ERR, _exit, result);
1782 }
1783 }
1784 _ls_pushback(opnd, c);
1785 }
1786 if(ast) {
1787 c = (_object_t*)(ast->data);
1788 ast = ast->next;
1789 } else {
1790 c = _exp_assign;
1791 }
1792 }
1793 } else {
1794 pri = _get_priority(((_object_t*)(_ls_back(optr)->data))->data.func->pointer, c->data.func->pointer);
1795 switch(pri) {
1796 case '<':
1797 _ls_pushback(optr, c);
1798 c = (_object_t*)(ast->data);
1799 ast = ast->next;
1800 break;
1801 case '=':
1802 //x = (_object_t*)_ls_popback(optr);
1803 _ls_popback(optr);
1804 c = (_object_t*)(ast->data);
1805 ast = ast->next;
1806 break;
1807 case '>':
1808 theta = (_object_t*)_ls_popback(optr);
1809 b = (_object_t*)_ls_popback(opnd);
1810 a = (_object_t*)_ls_popback(opnd);
1811 r = _operate_operand(s, theta, a, b, &result);
1812 if(!r) {
1813 _ls_clear(optr);
1814 _handle_error_on_obj(s, SE_RN_OPERATION_FAILED, DON(errn), MB_FUNC_ERR, _exit, result);
1815 }
1816 _ls_pushback(opnd, r);
1817 _ls_pushback(garbage, r);
1818 if(c->type == _DT_FUNC && c->data.func->pointer == _core_close_bracket) {
1819 hack = true;
1820 }
1821 break;
1822 }
1823 }
1824 }
1825
1826 if(errn) {
1827 _handle_error_on_obj(s, SE_RN_CLOSE_BRACKET_EXPECTED, DON(errn), MB_FUNC_ERR, _exit, result);
1828 }
1829
1830 c = (_object_t*)(_ls_popback(opnd));
1831 if(!c || !(c->type == _DT_INT || c->type == _DT_REAL || c->type == _DT_STRING || c->type == _DT_VAR)) {
1832 _set_current_error(s, SE_RN_INVALID_DATA_TYPE);
1833 result = MB_FUNC_ERR;
1834 goto _exit;
1835 }
1836 if(c->type == _DT_VAR) {
1837 (*val)->type = c->data.variable->data->type;
1838 (*val)->data = c->data.variable->data->data;
1839 if(_is_string(c)) {
1840 (*val)->ref = true;
1841 }
1842 } else {
1843 (*val)->type = c->type;
1844 if(_is_string(c)) {
1845 size_t _sl = strlen(_extract_string(c));
1846 (*val)->data.string = (char*)mb_malloc(_sl + 1);
1847 (*val)->data.string[_sl] = '\0';
1848 memcpy((*val)->data.string, c->data.string, _sl + 1);
1849 } else {
1850 (*val)->data = c->data;
1851 }
1852 }
1853 if(guard_val != c && _ls_try_remove(garbage, c, _ls_cmp_data)) {
1854 _destroy_object(c, 0);
1855 }
1856
1857 _exit:
1858 _ls_foreach(garbage, _destroy_object);
1859 _ls_destroy(garbage);
1860 _ls_foreach(optr, _destroy_object);
1861 _ls_foreach(opnd, _destroy_object);
1862 _ls_destroy(optr);
1863 _ls_destroy(opnd);
1864 *l = ast;
1865
1866 return result;
1867 }
1868
_is_print_terminal(mb_interpreter_t * s,_object_t * obj)1869 bool_t _is_print_terminal(mb_interpreter_t* s, _object_t* obj) {
1870 /* Determine whether an object is a PRINT termination */
1871 bool_t result = false;
1872
1873 mb_assert(s && obj);
1874
1875 result =
1876 (obj->type == _DT_EOS) ||
1877 (obj->type == _DT_SEP && obj->data.separator == ':') ||
1878 (obj->type == _DT_FUNC &&
1879 (obj->data.func->pointer == _core_else)
1880 );
1881
1882 return result;
1883 }
1884
1885 /** Others */
_set_current_error(mb_interpreter_t * s,mb_error_e err)1886 void _set_current_error(mb_interpreter_t* s, mb_error_e err) {
1887 /* Set current error information */
1888 mb_assert(s && err >= 0 && err < _countof(_ERR_DESC));
1889
1890 if(s->last_error == SE_NO_ERR) {
1891 s->last_error = err;
1892 }
1893 }
1894
_get_error_desc(mb_error_e err)1895 const char* _get_error_desc(mb_error_e err) {
1896 /* Get the description text of an error information */
1897 mb_assert(err >= 0 && err < _countof(_ERR_DESC));
1898
1899 return _ERR_DESC[err];
1900 }
1901
_get_printer(mb_interpreter_t * s)1902 mb_print_func_t _get_printer(mb_interpreter_t* s) {
1903 /* Get a print functor according to an interpreter */
1904 mb_assert(s);
1905
1906 if(s->printer) {
1907 return s->printer;
1908 }
1909
1910 return printf;
1911 }
1912
_is_blank(char c)1913 bool_t _is_blank(char c) {
1914 /* Determine whether a char is a blank */
1915 return (' ' == c) || ('\t' == c);
1916 }
1917
_is_newline(char c)1918 bool_t _is_newline(char c) {
1919 /* Determine whether a char is a newline */
1920 return ('\r' == c) || ('\n' == c) || (EOF == c);
1921 }
1922
_is_separator(char c)1923 bool_t _is_separator(char c) {
1924 /* Determine whether a char is a separator */
1925 return (',' == c) || (';' == c) || (':' == c);
1926 }
1927
_is_bracket(char c)1928 bool_t _is_bracket(char c) {
1929 /* Determine whether a char is a bracket */
1930 return ('(' == c) || (')' == c);
1931 }
1932
_is_quotation_mark(char c)1933 bool_t _is_quotation_mark(char c) {
1934 /* Determine whether a char is a quotation mark */
1935 return ('"' == c);
1936 }
1937
_is_comment(char c)1938 bool_t _is_comment(char c) {
1939 /* Determine whether a char is a comment mark */
1940 return ('\'' == c);
1941 }
1942
_is_identifier_char(char c)1943 bool_t _is_identifier_char(char c) {
1944 /* Determine whether a char is an identifier char */
1945 return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
1946 (c == '_') ||
1947 (c >= '0' && c <= '9') ||
1948 (c == '$') ||
1949 (c == '.');
1950 }
1951
_is_operator_char(char c)1952 bool_t _is_operator_char(char c) {
1953 /* Determine whether a char is an operator char */
1954 return (c == '+') || (c == '-') || (c == '*') || (c == '/') ||
1955 (c == '^') ||
1956 (c == '(') || (c == ')') ||
1957 (c == '=') ||
1958 (c == '>') || (c == '<');
1959 }
1960
_append_char_to_symbol(mb_interpreter_t * s,char c)1961 int _append_char_to_symbol(mb_interpreter_t* s, char c) {
1962 /* Parse a char and append it to current parsing symbol */
1963 int result = MB_FUNC_OK;
1964 _parsing_context_t* context = 0;
1965
1966 mb_assert(s);
1967
1968 context = (_parsing_context_t*)(s->parsing_context);
1969
1970 if(context->current_symbol_nonius + 1 >= _SINGLE_SYMBOL_MAX_LENGTH) {
1971 _set_current_error(s, SE_PS_SYMBOL_TOO_LONG);
1972
1973 ++result;
1974 } else {
1975 context->current_symbol[context->current_symbol_nonius] = c;
1976 ++context->current_symbol_nonius;
1977 }
1978
1979 return result;
1980 }
1981
_cut_symbol(mb_interpreter_t * s,int pos,unsigned short row,unsigned short col)1982 int _cut_symbol(mb_interpreter_t* s, int pos, unsigned short row, unsigned short col) {
1983 /* Current symbol parsing done and cut it */
1984 int result = MB_FUNC_OK;
1985 _parsing_context_t* context = 0;
1986 char* sym = 0;
1987 int status = 0;
1988 bool_t delsym = false;
1989
1990 mb_assert(s);
1991
1992 context = (_parsing_context_t*)(s->parsing_context);
1993 if(context->current_symbol_nonius && context->current_symbol[0] != '\0') {
1994 sym = (char*)mb_malloc(context->current_symbol_nonius + 1);
1995 memcpy(sym, context->current_symbol, context->current_symbol_nonius + 1);
1996
1997 status = _append_symbol(s, sym, &delsym, pos, row, col);
1998 if(status || delsym) {
1999 safe_free(sym);
2000 }
2001 result = status;
2002 }
2003 memset(context->current_symbol, 0, sizeof(context->current_symbol));
2004 context->current_symbol_nonius = 0;
2005
2006 return result;
2007 }
2008
_append_symbol(mb_interpreter_t * s,char * sym,bool_t * delsym,int pos,unsigned short row,unsigned short col)2009 int _append_symbol(mb_interpreter_t* s, char* sym, bool_t* delsym, int pos, unsigned short row, unsigned short col) {
2010 /* Append cut current symbol to AST list */
2011 int result = MB_FUNC_OK;
2012 _ls_node_t* ast = 0;
2013 _object_t* obj = 0;
2014 _ls_node_t** assign = 0;
2015 _ls_node_t* node = 0;
2016 _parsing_context_t* context = 0;
2017
2018 mb_assert(s && sym);
2019
2020 ast = (_ls_node_t*)(s->ast);
2021 result = _create_symbol(s, ast, sym, &obj, &assign, delsym);
2022 if(obj) {
2023 obj->source_pos = pos;
2024 obj->source_row = row;
2025 obj->source_col = col;
2026
2027 node = _ls_pushback(ast, obj);
2028 if(assign) {
2029 *assign = node;
2030 }
2031
2032 context = (_parsing_context_t*)s->parsing_context;
2033 context->last_symbol = obj;
2034 }
2035
2036 return result;
2037 }
2038
_create_symbol(mb_interpreter_t * s,_ls_node_t * l,char * sym,_object_t ** obj,_ls_node_t *** asgn,bool_t * delsym)2039 int _create_symbol(mb_interpreter_t* s, _ls_node_t* l, char* sym, _object_t** obj, _ls_node_t*** asgn, bool_t* delsym) {
2040 /* Create a syntax symbol */
2041 int result = MB_FUNC_OK;
2042 _data_e type;
2043 union { _func_t* func; _array_t* array; _var_t* var; _label_t* label; real_t float_point; int_t integer; void* any; } tmp;
2044 void* value = 0;
2045 unsigned int ul = 0;
2046 _parsing_context_t* context = 0;
2047 _ls_node_t* glbsyminscope = 0;
2048 mb_unrefvar(l);
2049
2050 mb_assert(s && sym && obj);
2051
2052 context = (_parsing_context_t*)s->parsing_context;
2053
2054 *obj = (_object_t*)mb_malloc(sizeof(_object_t));
2055 memset(*obj, 0, sizeof(_object_t));
2056
2057 type = _get_symbol_type(s, sym, &value);
2058 (*obj)->type = type;
2059 switch(type) {
2060 case _DT_INT:
2061 tmp.any = value;
2062 (*obj)->data.integer = tmp.integer;
2063 safe_free(sym);
2064 break;
2065 case _DT_REAL:
2066 tmp.any = value;
2067 (*obj)->data.float_point = tmp.float_point;
2068 safe_free(sym);
2069 break;
2070 case _DT_STRING: {
2071 size_t _sl = strlen(sym);
2072 (*obj)->data.string = (char*)mb_malloc(_sl - 2 + 1);
2073 memcpy((*obj)->data.string, sym + sizeof(char), _sl - 2);
2074 (*obj)->data.string[_sl - 2] = '\0';
2075 *delsym = true;
2076 }
2077 break;
2078 case _DT_FUNC:
2079 tmp.func = (_func_t*)mb_malloc(sizeof(_func_t));
2080 memset(tmp.func, 0, sizeof(_func_t));
2081 tmp.func->name = sym;
2082 tmp.func->pointer = (mb_func_t)(intptr_t)value;
2083 (*obj)->data.func = tmp.func;
2084 break;
2085 case _DT_ARRAY:
2086 glbsyminscope = _ht_find((_ht_node_t*)s->global_var_dict, sym);
2087 if(glbsyminscope && ((_object_t*)(glbsyminscope->data))->type == _DT_ARRAY) {
2088 (*obj)->data.array = ((_object_t*)(glbsyminscope->data))->data.array;
2089 (*obj)->ref = true;
2090 *delsym = true;
2091 } else {
2092 tmp.array = (_array_t*)mb_malloc(sizeof(_array_t));
2093 memset(tmp.array, 0, sizeof(_array_t));
2094 tmp.array->name = sym;
2095 tmp.array->type = (_data_e)(int)(long)(intptr_t)value;
2096 (*obj)->data.array = tmp.array;
2097
2098 ul = _ht_set_or_insert((_ht_node_t*)s->global_var_dict, sym, *obj);
2099 mb_assert(ul);
2100
2101 *obj = (_object_t*)mb_malloc(sizeof(_object_t));
2102 memset(*obj, 0, sizeof(_object_t));
2103 (*obj)->type = type;
2104 (*obj)->data.array = tmp.array;
2105 (*obj)->ref = true;
2106 }
2107 break;
2108 case _DT_VAR:
2109 glbsyminscope = _ht_find((_ht_node_t*)s->global_var_dict, sym);
2110 if(glbsyminscope && ((_object_t*)(glbsyminscope->data))->type == _DT_VAR) {
2111 (*obj)->data.variable = ((_object_t*)(glbsyminscope->data))->data.variable;
2112 (*obj)->ref = true;
2113 *delsym = true;
2114 } else {
2115 tmp.var = (_var_t*)mb_malloc(sizeof(_var_t));
2116 memset(tmp.var, 0, sizeof(_var_t));
2117 tmp.var->name = sym;
2118 tmp.var->data = (_object_t*)mb_malloc(sizeof(_object_t));
2119 memset(tmp.var->data, 0, sizeof(_object_t));
2120 tmp.var->data->type = (sym[strlen(sym) - 1] == '$') ? _DT_STRING : _DT_INT;
2121 tmp.var->data->data.integer = 0;
2122 (*obj)->data.variable = tmp.var;
2123
2124 ul = _ht_set_or_insert((_ht_node_t*)s->global_var_dict, sym, *obj);
2125 mb_assert(ul);
2126
2127 *obj = (_object_t*)mb_malloc(sizeof(_object_t));
2128 memset(*obj, 0, sizeof(_object_t));
2129 (*obj)->type = type;
2130 (*obj)->data.variable = tmp.var;
2131 (*obj)->ref = true;
2132 }
2133 break;
2134 case _DT_LABEL:
2135 if(context->current_char == ':') {
2136 if(value) {
2137 (*obj)->data.label = value;
2138 (*obj)->ref = true;
2139 *delsym = true;
2140 } else {
2141 tmp.label = (_label_t*)mb_malloc(sizeof(_label_t));
2142 memset(tmp.label, 0, sizeof(_label_t));
2143 tmp.label->name = sym;
2144 *asgn = &(tmp.label->node);
2145 (*obj)->data.label = tmp.label;
2146
2147 ul = _ht_set_or_insert((_ht_node_t*)s->global_var_dict, sym, *obj);
2148 mb_assert(ul);
2149
2150 *obj = (_object_t*)mb_malloc(sizeof(_object_t));
2151 memset(*obj, 0, sizeof(_object_t));
2152 (*obj)->type = type;
2153 (*obj)->data.label = tmp.label;
2154 (*obj)->ref = true;
2155 }
2156 } else {
2157 (*obj)->data.label = (_label_t*)mb_malloc(sizeof(_label_t));
2158 memset((*obj)->data.label, 0, sizeof(_label_t));
2159 (*obj)->data.label->name = sym;
2160 }
2161 break;
2162 case _DT_SEP:
2163 (*obj)->data.separator = sym[0];
2164 safe_free(sym);
2165 break;
2166 case _DT_EOS:
2167 safe_free(sym);
2168 break;
2169 default:
2170 break;
2171 }
2172
2173 return result;
2174 }
2175
_get_symbol_type(mb_interpreter_t * s,char * sym,void ** value)2176 _data_e _get_symbol_type(mb_interpreter_t* s, char* sym, void** value) {
2177 /* Get the type of a syntax symbol */
2178 _data_e result = _DT_NIL;
2179 union { real_t float_point; int_t integer; _object_t* obj; void* any; } tmp;
2180 char* conv_suc = 0;
2181 _parsing_context_t* context = 0;
2182 _ls_node_t* lclsyminscope = 0;
2183 _ls_node_t* glbsyminscope = 0;
2184 size_t _sl = 0;
2185
2186 mb_assert(s && sym);
2187 _sl = strlen(sym);
2188 mb_assert(_sl > 0);
2189
2190 context = (_parsing_context_t*)s->parsing_context;
2191
2192 /* int_t */
2193 tmp.integer = (int_t)strtol(sym, &conv_suc, 0);
2194 if(*conv_suc == '\0') {
2195 *value = tmp.any;
2196
2197 result = _DT_INT;
2198 goto _exit;
2199 }
2200 /* real_t */
2201 tmp.float_point = (real_t)strtod(sym, &conv_suc);
2202 if(*conv_suc == '\0') {
2203 *value = tmp.any;
2204
2205 result = _DT_REAL;
2206 goto _exit;
2207 }
2208 /* string */
2209 if(sym[0] == '"' && sym[_sl - 1] == '"' && _sl >= 2) {
2210 result = _DT_STRING;
2211 goto _exit;
2212 }
2213 /* _array_t */
2214 glbsyminscope = _ht_find((_ht_node_t*)s->global_var_dict, sym);
2215 if(glbsyminscope && ((_object_t*)(glbsyminscope->data))->type == _DT_ARRAY) {
2216 tmp.obj = (_object_t*)(glbsyminscope->data);
2217 *value = (void*)(intptr_t)(tmp.obj->data.array->type);
2218
2219 result = _DT_ARRAY;
2220 goto _exit;
2221 }
2222 if(context->last_symbol && context->last_symbol->type == _DT_FUNC) {
2223 if(strcmp("DIM", context->last_symbol->data.func->name) == 0) {
2224 *value = (void*)(intptr_t)(sym[_sl - 1] == '$' ? _DT_STRING : _DT_REAL);
2225
2226 result = _DT_ARRAY;
2227 goto _exit;
2228 }
2229 }
2230 /* _func_t */
2231 if(context->last_symbol && ((context->last_symbol->type == _DT_FUNC && context->last_symbol->data.func->pointer != _core_close_bracket)||
2232 context->last_symbol->type == _DT_SEP)) {
2233 if(strcmp("-", sym) == 0) {
2234 *value = (void*)(intptr_t)(_core_neg);
2235
2236 result = _DT_FUNC;
2237 goto _exit;
2238 }
2239 }
2240 lclsyminscope = _ht_find((_ht_node_t*)s->local_func_dict, sym);
2241 glbsyminscope = _ht_find((_ht_node_t*)s->global_func_dict, sym);
2242 if(lclsyminscope || glbsyminscope) {
2243 *value = lclsyminscope ? lclsyminscope->data : glbsyminscope->data;
2244
2245 result = _DT_FUNC;
2246 goto _exit;
2247 }
2248 /* _EOS */
2249 if(_sl == 1 && sym[0] == _EOS) {
2250 result = _DT_EOS;
2251 goto _exit;
2252 }
2253 /* separator */
2254 if(_sl == 1 && _is_separator(sym[0])) {
2255 result = _DT_SEP;
2256 goto _exit;
2257 }
2258 /* _var_t */
2259 glbsyminscope = _ht_find((_ht_node_t*)s->global_var_dict, sym);
2260 if(glbsyminscope) {
2261 if(((_object_t*)glbsyminscope->data)->type != _DT_LABEL) {
2262 *value = glbsyminscope->data;
2263
2264 result = _DT_VAR;
2265 goto _exit;
2266 }
2267 }
2268 /* _label_t */
2269 if(context->current_char == ':') {
2270 if(!context->last_symbol || context->last_symbol->type == _DT_EOS) {
2271 glbsyminscope = _ht_find((_ht_node_t*)s->global_var_dict, sym);
2272 if(glbsyminscope) {
2273 *value = glbsyminscope->data;
2274 }
2275
2276 result = _DT_LABEL;
2277 goto _exit;
2278 }
2279 }
2280 if(context->last_symbol && context->last_symbol->type == _DT_FUNC) {
2281 if(context->last_symbol->data.func->pointer == _core_goto || context->last_symbol->data.func->pointer == _core_gosub) {
2282 result = _DT_LABEL;
2283 goto _exit;
2284 }
2285 }
2286 /* else */
2287 result = _DT_VAR;
2288
2289 _exit:
2290 return result;
2291 }
2292
_parse_char(mb_interpreter_t * s,char c,int pos,unsigned short row,unsigned short col)2293 int _parse_char(mb_interpreter_t* s, char c, int pos, unsigned short row, unsigned short col) {
2294 /* Parse a char */
2295 int result = MB_FUNC_OK;
2296 _parsing_context_t* context = 0;
2297
2298 mb_assert(s && s->parsing_context);
2299
2300 context = (_parsing_context_t*)(s->parsing_context);
2301
2302 context->current_char = c;
2303
2304 if(context->parsing_state == _PS_NORMAL) {
2305 if(c >= 'a' && c <= 'z') {
2306 c += 'A' - 'a';
2307 }
2308
2309 if(_is_blank(c)) { /* \t ' ' */
2310 result += _cut_symbol(s, pos, row, col);
2311 } else if(_is_newline(c)) { /* \r \n EOF */
2312 result += _cut_symbol(s, pos, row, col);
2313 result += _append_char_to_symbol(s, _EOS);
2314 result += _cut_symbol(s, pos, row, col);
2315 } else if(_is_separator(c) || _is_bracket(c)) { /* , ; : ( ) */
2316 result += _cut_symbol(s, pos, row, col);
2317 result += _append_char_to_symbol(s, c);
2318 result += _cut_symbol(s, pos, row, col);
2319 } else if(_is_quotation_mark(c)) { /* " */
2320 result += _cut_symbol(s, pos, row, col);
2321 result += _append_char_to_symbol(s, c);
2322 context->parsing_state = _PS_STRING;
2323 } else if(_is_comment(c)) { /* ' */
2324 result += _cut_symbol(s, pos, row, col);
2325 result += _append_char_to_symbol(s, _EOS);
2326 result += _cut_symbol(s, pos, row, col);
2327 context->parsing_state = _PS_COMMENT;
2328 } else {
2329 if(context->symbol_state == _SS_IDENTIFIER) {
2330 if(_is_identifier_char(c)) {
2331 result += _append_char_to_symbol(s, c);
2332 } else if(_is_operator_char(c)) {
2333 context->symbol_state = _SS_OPERATOR;
2334 result += _cut_symbol(s, pos, row, col);
2335 result += _append_char_to_symbol(s, c);
2336 } else {
2337 _handle_error(s, SE_PS_INVALID_CHAR, pos, row, col, MB_FUNC_ERR, _exit, result);
2338 }
2339 } else if(context->symbol_state == _SS_OPERATOR) {
2340 if(_is_identifier_char(c)) {
2341 context->symbol_state = _SS_IDENTIFIER;
2342 result += _cut_symbol(s, pos, row, col);
2343 result += _append_char_to_symbol(s, c);
2344 } else if(_is_operator_char(c)) {
2345 if(c == '-') {
2346 result += _cut_symbol(s, pos, row, col);
2347 }
2348 result += _append_char_to_symbol(s, c);
2349 } else {
2350 _handle_error(s, SE_PS_INVALID_CHAR, pos, row, col, MB_FUNC_ERR, _exit, result);
2351 }
2352 } else {
2353 mb_assert(0 && "Impossible here");
2354 }
2355 }
2356 } else if(context->parsing_state == _PS_STRING) {
2357 if(_is_quotation_mark(c)) { /* " */
2358 result += _append_char_to_symbol(s, c);
2359 result += _cut_symbol(s, pos, row, col);
2360 context->parsing_state = _PS_NORMAL;
2361 } else {
2362 result += _append_char_to_symbol(s, c);
2363 }
2364 } else if(context->parsing_state == _PS_COMMENT) {
2365 if(_is_newline(c)) { /* \r \n EOF */
2366 context->parsing_state = _PS_NORMAL;
2367 } else {
2368 /* Do nothing */
2369 }
2370 } else {
2371 mb_assert(0 && "Unknown parsing state");
2372 }
2373
2374 _exit:
2375 return result;
2376 }
2377
_set_error_pos(mb_interpreter_t * s,int pos,unsigned short row,unsigned short col)2378 void _set_error_pos(mb_interpreter_t* s, int pos, unsigned short row, unsigned short col) {
2379 /* Set the position of a parsing error */
2380 mb_assert(s);
2381
2382 s->last_error_pos = pos;
2383 s->last_error_row = row;
2384 s->last_error_col = col;
2385 }
2386
_get_size_of(_data_e type)2387 int_t _get_size_of(_data_e type) {
2388 /* Get the size of a data type */
2389 int_t result = 0;
2390
2391 if(type == _DT_INT) {
2392 result = sizeof(int_t);
2393 } else if(type == _DT_REAL) {
2394 result = sizeof(real_t);
2395 } else if(type == _DT_STRING) {
2396 result = sizeof(char*);
2397 } else {
2398 mb_assert(0 && "Unsupported");
2399 }
2400
2401 return result;
2402 }
2403
_try_get_value(_object_t * obj,mb_value_u * val,_data_e expected)2404 bool_t _try_get_value(_object_t* obj, mb_value_u* val, _data_e expected) {
2405 /* Try to get a value(typed as int_t, real_t or char*) */
2406 bool_t result = false;
2407
2408 mb_assert(obj && val);
2409 if(obj->type == _DT_INT && (expected == _DT_ANY || expected == _DT_INT)) {
2410 val->integer = obj->data.integer;
2411 result = true;
2412 } else if(obj->type == _DT_REAL && (expected == _DT_ANY || expected == _DT_REAL)) {
2413 val->float_point = obj->data.float_point;
2414 result = true;
2415 } else if(obj->type == _DT_VAR) {
2416 result = _try_get_value(obj->data.variable->data, val, expected);
2417 }
2418
2419 return result;
2420 }
2421
_get_array_index(mb_interpreter_t * s,_ls_node_t ** l,unsigned int * index)2422 int _get_array_index(mb_interpreter_t* s, _ls_node_t** l, unsigned int* index) {
2423 /* Calculate the index */
2424 int result = MB_FUNC_OK;
2425 _ls_node_t* ast = 0;
2426 _object_t* arr = 0;
2427 _object_t* len = 0;
2428 _object_t subscript;
2429 _object_t* subscript_ptr = 0;
2430 mb_value_u val;
2431 int dcount = 0;
2432 unsigned int idx = 0;
2433
2434 mb_assert(s && l && index);
2435
2436 subscript_ptr = &subscript;
2437
2438 /* Array name */
2439 ast = (_ls_node_t*)(*l);
2440 if(!ast || ((_object_t*)(ast->data))->type != _DT_ARRAY) {
2441 _handle_error_on_obj(s, SE_RN_ARRAY_IDENTIFIER_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
2442 }
2443 arr = (_object_t*)(ast->data);
2444 /* ( */
2445 if(!ast->next || ((_object_t*)(ast->next->data))->type != _DT_FUNC || ((_object_t*)(ast->next->data))->data.func->pointer != _core_open_bracket) {
2446 _handle_error_on_obj(s, SE_RN_OPEN_BRACKET_EXPECTED,
2447 (ast && ast->next) ? ((_object_t*)(ast->next->data)) : 0,
2448 MB_FUNC_ERR, _exit, result);
2449 }
2450 ast = ast->next;
2451 /* Array subscript */
2452 if(!ast->next) {
2453 _handle_error_on_obj(s, SE_RN_ARRAY_SUBSCRIPT_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
2454 }
2455 ast = ast->next;
2456 while(((_object_t*)(ast->data))->type != _DT_FUNC || ((_object_t*)(ast->data))->data.func->pointer != _core_close_bracket) {
2457 /* Calculate an integer value */
2458 result = _calc_expression(s, &ast, &subscript_ptr);
2459 if(result != MB_FUNC_OK) {
2460 goto _exit;
2461 }
2462 len = subscript_ptr;
2463 if(!_try_get_value(len, &val, _DT_INT)) {
2464 _handle_error_on_obj(s, SE_RN_TYPE_NOT_MATCH, DON(ast), MB_FUNC_ERR, _exit, result);
2465 }
2466 if(val.integer < 0) {
2467 _handle_error_on_obj(s, SE_RN_ILLEGAL_BOUND, DON(ast), MB_FUNC_ERR, _exit, result);
2468 }
2469 if(dcount + 1 > arr->data.array->dimension_count) {
2470 _handle_error_on_obj(s, SE_RN_DIMENSION_OUT_OF_BOUND, DON(ast), MB_FUNC_ERR, _exit, result);
2471 }
2472 if(val.integer > arr->data.array->dimensions[dcount]) {
2473 _handle_error_on_obj(s, SE_RN_ARRAY_OUT_OF_BOUND, DON(ast), MB_FUNC_ERR, _exit, result);
2474 }
2475 if(idx) {
2476 idx *= (unsigned int)val.integer;
2477 } else {
2478 idx += (unsigned int)val.integer;
2479 }
2480 /* Comma? */
2481 if(((_object_t*)(ast->data))->type == _DT_SEP && ((_object_t*)(ast->data))->data.separator == ',') {
2482 ast = ast->next;
2483 }
2484
2485 ++dcount;
2486 }
2487 *index = idx;
2488
2489 _exit:
2490 *l = ast;
2491
2492 return result;
2493 }
2494
_get_array_elem(mb_interpreter_t * s,_array_t * arr,unsigned int index,mb_value_u * val,_data_e * type)2495 bool_t _get_array_elem(mb_interpreter_t* s, _array_t* arr, unsigned int index, mb_value_u* val, _data_e* type) {
2496 /* Get the value of an element in an array */
2497 bool_t result = true;
2498 int_t elemsize = 0;
2499 unsigned int pos = 0;
2500 void* rawptr = 0;
2501
2502 mb_assert(s && arr && val && type);
2503
2504 mb_assert(index < arr->count);
2505 elemsize = _get_size_of(arr->type);
2506 pos = (unsigned int)(elemsize * index);
2507 rawptr = (void*)((intptr_t)arr->raw + pos);
2508 if(arr->type == _DT_REAL) {
2509 val->float_point = *((real_t*)rawptr);
2510 *type = _DT_REAL;
2511 } else if(arr->type == _DT_STRING) {
2512 val->string = *((char**)rawptr);
2513 *type = _DT_STRING;
2514 } else {
2515 mb_assert(0 && "Unsupported");
2516 }
2517
2518 return result;
2519 }
2520
_set_array_elem(mb_interpreter_t * s,_array_t * arr,unsigned int index,mb_value_u * val,_data_e * type)2521 bool_t _set_array_elem(mb_interpreter_t* s, _array_t* arr, unsigned int index, mb_value_u* val, _data_e* type) {
2522 /* Set the value of an element in an array */
2523 bool_t result = true;
2524 int_t elemsize = 0;
2525 unsigned int pos = 0;
2526 void* rawptr = 0;
2527
2528 mb_assert(s && arr && val);
2529
2530 mb_assert(index < arr->count);
2531 elemsize = _get_size_of(arr->type);
2532 pos = (unsigned int)(elemsize * index);
2533 rawptr = (void*)((intptr_t)arr->raw + pos);
2534 if(*type == _DT_INT) {
2535 *((real_t*)rawptr) = (real_t)val->integer;
2536 } else if(*type == _DT_REAL) {
2537 *((real_t*)rawptr) = val->float_point;
2538 } else if(*type == _DT_STRING) {
2539 size_t _sl = strlen(val->string);
2540 *((char**)rawptr) = (char*)mb_malloc(_sl + 1);
2541 memcpy(*((char**)rawptr), val->string, _sl + 1);
2542 } else {
2543 mb_assert(0 && "Unsupported");
2544 }
2545
2546 return result;
2547 }
2548
_init_array(_array_t * arr)2549 void _init_array(_array_t* arr) {
2550 /* Initialize an array */
2551 int elemsize = 0;
2552
2553 mb_assert(arr);
2554
2555 elemsize = (int)_get_size_of(arr->type);
2556 mb_assert(arr->count > 0);
2557 mb_assert(!arr->raw);
2558 arr->raw = (void*)mb_malloc(elemsize * arr->count);
2559 if(arr->raw) {
2560 memset(arr->raw, 0, elemsize * arr->count);
2561 }
2562 }
2563
_clear_array(_array_t * arr)2564 void _clear_array(_array_t* arr) {
2565 /* Clear an array */
2566 char** strs = 0;
2567 unsigned int ul = 0;
2568
2569 mb_assert(arr);
2570
2571 if(arr->raw) {
2572 switch(arr->type) {
2573 case _DT_INT: /* Fall through */
2574 case _DT_REAL:
2575 safe_free(arr->raw);
2576 break;
2577 case _DT_STRING:
2578 strs = (char**)arr->raw;
2579 for(ul = 0; ul < arr->count; ++ul) {
2580 if(strs[ul]) {
2581 safe_free(strs[ul]);
2582 }
2583 }
2584 safe_free(arr->raw);
2585 break;
2586 default:
2587 mb_assert(0 && "Unsupported");
2588 break;
2589 }
2590 arr->raw = 0;
2591 }
2592 }
2593
_destroy_array(_array_t * arr)2594 void _destroy_array(_array_t* arr) {
2595 /* Destroy an array */
2596 mb_assert(arr);
2597
2598 _clear_array(arr);
2599 safe_free(arr->name);
2600 safe_free(arr);
2601 }
2602
_is_string(void * obj)2603 bool_t _is_string(void* obj) {
2604 /* Determine whether an object is a string value or a string variable */
2605 bool_t result = false;
2606 _object_t* o = 0;
2607
2608 mb_assert(obj);
2609
2610 o = (_object_t*)obj;
2611 if(o->type == _DT_STRING) {
2612 result = true;
2613 } else if(o->type == _DT_VAR) {
2614 result = o->data.variable->data->type == _DT_STRING;
2615 }
2616
2617 return result;
2618 }
2619
_extract_string(_object_t * obj)2620 char* _extract_string(_object_t* obj) {
2621 /* Extract a string inside an object */
2622 char* result = 0;
2623
2624 mb_assert(obj);
2625
2626 if(obj->type == _DT_STRING) {
2627 result = obj->data.string;
2628 } else if(obj->type == _DT_VAR && obj->data.variable->data->type == _DT_STRING) {
2629 result = obj->data.variable->data->data.string;
2630 }
2631
2632 return result;
2633 }
2634
_is_internal_object(_object_t * obj)2635 bool_t _is_internal_object(_object_t* obj) {
2636 /* Determine whether an object is an internal one */
2637 bool_t result = false;
2638
2639 mb_assert(obj);
2640
2641 result = (_exp_assign == obj) ||
2642 (_OBJ_BOOL_TRUE == obj) || (_OBJ_BOOL_FALSE == obj);
2643
2644 return result;
2645 }
2646
_dispose_object(_object_t * obj)2647 int _dispose_object(_object_t* obj) {
2648 /* Dispose a syntax object */
2649 int result = 0;
2650 _var_t* var = 0;
2651
2652 mb_assert(obj);
2653
2654 if(_is_internal_object(obj)) {
2655 goto _exit;
2656 }
2657 switch(obj->type) {
2658 case _DT_VAR:
2659 if(!obj->ref) {
2660 var = (_var_t*)(obj->data.variable);
2661 safe_free(var->name);
2662 mb_assert(var->data->type != _DT_VAR);
2663 _destroy_object(var->data, 0);
2664 safe_free(var);
2665 }
2666 break;
2667 case _DT_STRING:
2668 if(!obj->ref) {
2669 if(obj->data.string) {
2670 safe_free(obj->data.string);
2671 }
2672 }
2673 break;
2674 case _DT_FUNC:
2675 safe_free(obj->data.func->name);
2676 safe_free(obj->data.func);
2677 break;
2678 case _DT_ARRAY:
2679 if(!obj->ref) {
2680 _destroy_array(obj->data.array);
2681 }
2682 break;
2683 case _DT_LABEL:
2684 if(!obj->ref) {
2685 safe_free(obj->data.label->name);
2686 safe_free(obj->data.label);
2687 }
2688 break;
2689 case _DT_NIL: /* Fall through */
2690 case _DT_INT: /* Fall through */
2691 case _DT_REAL: /* Fall through */
2692 case _DT_SEP: /* Fall through */
2693 case _DT_EOS: /* Fall through */
2694 case _DT_USERTYPE: /* Do nothing */
2695 break;
2696 default:
2697 mb_assert(0 && "Invalid type");
2698 break;
2699 }
2700 obj->ref = false;
2701 obj->type = _DT_NIL;
2702 memset(&obj->data, 0, sizeof(obj->data));
2703 obj->source_pos = 0;
2704 obj->source_row = 0;
2705 obj->source_col = 0;
2706 ++result;
2707
2708 _exit:
2709
2710 return result;
2711 }
2712
_destroy_object(void * data,void * extra)2713 int _destroy_object(void* data, void* extra) {
2714 /* Destroy a syntax object */
2715 int result = _OP_RESULT_NORMAL;
2716 _object_t* obj = 0;
2717 mb_unrefvar(extra);
2718
2719 mb_assert(data);
2720
2721 obj = (_object_t*)data;
2722 if(!_dispose_object(obj)) {
2723 goto _exit;
2724 }
2725 safe_free(obj);
2726
2727 _exit:
2728 result = _OP_RESULT_DEL_NODE;
2729
2730 return result;
2731 }
2732
_compare_numbers(const _object_t * first,const _object_t * second)2733 int _compare_numbers(const _object_t* first, const _object_t* second) {
2734 /* Compare two numbers inside two _object_t */
2735 int result = 0;
2736
2737 mb_assert(first && second);
2738 mb_assert((first->type == _DT_INT || first->type == _DT_REAL) && (second->type == _DT_INT || second->type == _DT_REAL));
2739
2740 if(first->type == _DT_INT && second->type == _DT_INT) {
2741 if(first->data.integer > second->data.integer) {
2742 result = 1;
2743 } else if(first->data.integer < second->data.integer) {
2744 result = -1;
2745 }
2746 } else if(first->type == _DT_REAL && second->type == _DT_REAL) {
2747 if(first->data.float_point > second->data.float_point) {
2748 result = 1;
2749 } else if(first->data.float_point < second->data.float_point) {
2750 result = -1;
2751 }
2752 } else {
2753 if((first->type == _DT_INT ? (real_t)first->data.integer : first->data.float_point) > (second->type == _DT_INT ? (real_t)second->data.integer : second->data.float_point)) {
2754 result = 1;
2755 } else if((first->type == _DT_INT ? (real_t)first->data.integer : first->data.float_point) > (second->type == _DT_INT ? (real_t)second->data.integer : second->data.float_point)) {
2756 result = -1;
2757 }
2758 }
2759
2760 return result;
2761 }
2762
_public_value_to_internal_object(mb_value_t * pbl,_object_t * itn)2763 int _public_value_to_internal_object(mb_value_t* pbl, _object_t* itn) {
2764 /* Assign a public mb_value_t to an internal _object_t */
2765 int result = MB_FUNC_OK;
2766
2767 mb_assert(pbl && itn);
2768
2769 switch(pbl->type) {
2770 case MB_DT_INT:
2771 itn->type = _DT_INT;
2772 itn->data.integer = pbl->value.integer;
2773 break;
2774 case MB_DT_REAL:
2775 itn->type = _DT_REAL;
2776 itn->data.float_point = pbl->value.float_point;
2777 break;
2778 case MB_DT_STRING:
2779 itn->type = _DT_STRING;
2780 itn->data.string = pbl->value.string;
2781 break;
2782 default:
2783 result = MB_FUNC_ERR;
2784 break;
2785 }
2786
2787 return result;
2788 }
2789
_internal_object_to_public_value(_object_t * itn,mb_value_t * pbl)2790 int _internal_object_to_public_value(_object_t* itn, mb_value_t* pbl) {
2791 /* Assign an internal _object_t to a public mb_value_t */
2792 int result = MB_FUNC_OK;
2793
2794 mb_assert(pbl && itn);
2795
2796 switch(itn->type) {
2797 case _DT_INT:
2798 pbl->type = MB_DT_INT;
2799 pbl->value.integer = itn->data.integer;
2800 break;
2801 case _DT_REAL:
2802 pbl->type = MB_DT_REAL;
2803 pbl->value.float_point = itn->data.float_point;
2804 break;
2805 case _DT_STRING:
2806 pbl->type = MB_DT_STRING;
2807 pbl->value.string = itn->data.string;
2808 break;
2809 default:
2810 result = MB_FUNC_ERR;
2811 break;
2812 }
2813
2814 return result;
2815 }
2816
_execute_statement(mb_interpreter_t * s,_ls_node_t ** l)2817 int _execute_statement(mb_interpreter_t* s, _ls_node_t** l) {
2818 /* Execute the ast, core execution function */
2819 int result = MB_FUNC_OK;
2820 _ls_node_t* ast = 0;
2821 _object_t* obj = 0;
2822 _running_context_t* running = 0;
2823 bool_t skip_to_eoi = true;
2824
2825 mb_assert(s && l);
2826
2827 running = (_running_context_t*)(s->running_context);
2828
2829 ast = *l;
2830
2831 obj = (_object_t*)(ast->data);
2832 switch(obj->type) {
2833 case _DT_FUNC:
2834 result = (obj->data.func->pointer)(s, (void**)(&ast));
2835 break;
2836 case _DT_VAR: /* Fall through */
2837 case _DT_ARRAY:
2838 result = _core_let(s, (void**)(&ast));
2839 break;
2840 case _DT_INT: /* Fall through */
2841 case _DT_REAL: /* Fall through */
2842 case _DT_STRING:
2843 _handle_error_on_obj(s, SE_RN_INVALID_EXPRESSION, DON(ast), MB_FUNC_ERR, _exit, result);
2844 break;
2845 default:
2846 break;
2847 }
2848 if(result != MB_FUNC_OK && result != MB_FUNC_SUSPEND && result != MB_SUB_RETURN) {
2849 goto _exit;
2850 }
2851 if(ast) {
2852 obj = (_object_t*)(ast->data);
2853 if(obj && obj->type == _DT_SEP && obj->data.separator == ':') {
2854 skip_to_eoi = false;
2855 }
2856 ast = ast->next;
2857 }
2858 if(skip_to_eoi && running->skip_to_eoi && running->skip_to_eoi == _ls_back(running->sub_stack)) {
2859 running->skip_to_eoi = 0;
2860 obj = (_object_t*)(ast->data);
2861 if(obj->type != _DT_EOS) {
2862 result = _skip_to(s, &ast, 0, _DT_EOS);
2863 if(result != MB_FUNC_OK) {
2864 goto _exit;
2865 }
2866 }
2867 }
2868
2869 _exit:
2870 *l = ast;
2871
2872 return result;
2873 }
2874
_skip_to(mb_interpreter_t * s,_ls_node_t ** l,mb_func_t f,_data_e t)2875 int _skip_to(mb_interpreter_t* s, _ls_node_t** l, mb_func_t f, _data_e t) {
2876 /* Skip current execution flow to a specific function */
2877 int result = MB_FUNC_OK;
2878 _ls_node_t* ast = 0;
2879 _ls_node_t* tmp = 0;
2880 _object_t* obj = 0;
2881
2882 mb_assert(s && l);
2883
2884 ast = *l;
2885 mb_assert(ast && ast->prev);
2886 do {
2887 if(!ast) {
2888 _handle_error_on_obj(s, SE_RN_SYNTAX, DON(tmp), MB_FUNC_ERR, _exit, result);
2889 }
2890 tmp = ast;
2891 obj = (_object_t*)(ast->data);
2892 *l = ast;
2893 ast = ast->next;
2894 } while(!(obj->type == _DT_FUNC && obj->data.func->pointer == f) && obj->type != t);
2895
2896 _exit:
2897 return result;
2898 }
2899
_skip_struct(mb_interpreter_t * s,_ls_node_t ** l,mb_func_t open_func,mb_func_t close_func)2900 int _skip_struct(mb_interpreter_t* s, _ls_node_t** l, mb_func_t open_func, mb_func_t close_func) {
2901 /* Skip current structure */
2902 int result = MB_FUNC_OK;
2903 int count = 0;
2904 _ls_node_t* ast = 0;
2905 _object_t* obj = 0;
2906 _object_t* obj_prev = 0;
2907
2908 mb_assert(s && l && open_func && close_func);
2909
2910 ast = (_ls_node_t*)(*l);
2911
2912 count = 1;
2913 do {
2914 if(!ast->next) {
2915 _handle_error_on_obj(s, SE_RN_STRUCTURE_NOT_COMPLETED, DON(ast), MB_FUNC_ERR, _exit, result);
2916 }
2917 obj_prev = (_object_t*)(ast->data);
2918 ast = ast->next;
2919 obj = (_object_t*)(ast->data);
2920 if(obj->type == _DT_FUNC && obj->data.func->pointer == open_func) {
2921 ++count;
2922 } else if(obj->type == _DT_FUNC && obj->data.func->pointer == close_func &&
2923 (obj_prev && obj_prev->type == _DT_EOS)) {
2924 --count;
2925 }
2926 } while(count);
2927
2928 _exit:
2929 *l = ast;
2930
2931 return result;
2932 }
2933
_register_func(mb_interpreter_t * s,const char * n,mb_func_t f,bool_t local)2934 int _register_func(mb_interpreter_t* s, const char* n, mb_func_t f, bool_t local) {
2935 /* Register a function to a MY-BASIC environment */
2936 int result = 0;
2937 _ht_node_t* scope = 0;
2938 _ls_node_t* exists = 0;
2939 char* name = 0;
2940
2941 mb_assert(s);
2942
2943 if(!n) {
2944 return result;
2945 }
2946
2947 scope = (_ht_node_t*)(local ? s->local_func_dict : s->global_func_dict);
2948 exists = _ht_find(scope, (void*)n);
2949 if(!exists) {
2950 size_t _sl = strlen(n);
2951 name = (char*)mb_malloc(_sl + 1);
2952 memcpy(name, n, _sl + 1);
2953 _strupr(name);
2954 result += _ht_set_or_insert(scope, (void*)name, (void*)(intptr_t)f);
2955 } else {
2956 _set_current_error(s, SE_CM_FUNC_EXISTS);
2957 }
2958
2959 return result;
2960 }
2961
_remove_func(mb_interpreter_t * s,const char * n,bool_t local)2962 int _remove_func(mb_interpreter_t* s, const char* n, bool_t local) {
2963 /* Remove a function from a MY-BASIC environment */
2964 int result = 0;
2965 _ht_node_t* scope = 0;
2966 _ls_node_t* exists = 0;
2967 char* name = 0;
2968
2969 mb_assert(s);
2970
2971 if(!n) {
2972 return result;
2973 }
2974
2975 scope = (_ht_node_t*)(local ? s->local_func_dict : s->global_func_dict);
2976 exists = _ht_find(scope, (void*)n);
2977 if(exists) {
2978 size_t _sl = strlen(n);
2979 name = (char*)mb_malloc(_sl + 1);
2980 memcpy(name, n, _sl + 1);
2981 _strupr(name);
2982 result += _ht_remove(scope, (void*)name);
2983 safe_free(name);
2984 } else {
2985 _set_current_error(s, SE_CM_FUNC_NOT_EXISTS);
2986 }
2987
2988 return result;
2989 }
2990
_open_constant(mb_interpreter_t * s)2991 int _open_constant(mb_interpreter_t* s) {
2992 /* Open global constant */
2993 int result = MB_FUNC_OK;
2994 unsigned long ul = 0;
2995
2996 mb_assert(s);
2997
2998 ul = _ht_set_or_insert((_ht_node_t*)(s->global_var_dict), "TRUE", (_OBJ_BOOL_TRUE));
2999 mb_assert(ul);
3000 ul = _ht_set_or_insert((_ht_node_t*)(s->global_var_dict), "FALSE", (_OBJ_BOOL_FALSE));
3001 mb_assert(ul);
3002
3003 return result;
3004 }
3005
_close_constant(mb_interpreter_t * s)3006 int _close_constant(mb_interpreter_t* s) {
3007 /* Close global constant */
3008 int result = MB_FUNC_OK;
3009
3010 mb_assert(s);
3011
3012 return result;
3013 }
3014
_open_core_lib(mb_interpreter_t * s)3015 int _open_core_lib(mb_interpreter_t* s) {
3016 /* Open the core functional libraries */
3017 int result = 0;
3018 int i = 0;
3019
3020 mb_assert(s);
3021
3022 for(i = 0; i < _countof(_core_libs); ++i) {
3023 result += _register_func(s, _core_libs[i].name, _core_libs[i].pointer, true);
3024 }
3025
3026 return result;
3027 }
3028
_close_core_lib(mb_interpreter_t * s)3029 int _close_core_lib(mb_interpreter_t* s) {
3030 /* Close the core functional libraries */
3031 int result = 0;
3032 int i = 0;
3033
3034 mb_assert(s);
3035
3036 for(i = 0; i < _countof(_core_libs); ++i) {
3037 result += _remove_func(s, _core_libs[i].name, true);
3038 }
3039
3040 return result;
3041 }
3042
_open_std_lib(mb_interpreter_t * s)3043 int _open_std_lib(mb_interpreter_t* s) {
3044 /* Open the standard functional libraries */
3045 int result = 0;
3046 int i = 0;
3047
3048 mb_assert(s);
3049
3050 for(i = 0; i < _countof(_std_libs); ++i) {
3051 result += _register_func(s, _std_libs[i].name, _std_libs[i].pointer, true);
3052 }
3053
3054 return result;
3055 }
3056
_close_std_lib(mb_interpreter_t * s)3057 int _close_std_lib(mb_interpreter_t* s) {
3058 /* Close the standard functional libraries */
3059 int result = 0;
3060 int i = 0;
3061
3062 mb_assert(s);
3063
3064 for(i = 0; i < _countof(_std_libs); ++i) {
3065 result += _remove_func(s, _std_libs[i].name, true);
3066 }
3067
3068 return result;
3069 }
3070
3071 /* ========================================================} */
3072
3073 /*
3074 ** {========================================================
3075 ** Public functions definitions
3076 */
3077
mb_ver(void)3078 unsigned int mb_ver(void) {
3079 /* Get the version number of this MY-BASIC system */
3080 return _MB_VERSION;
3081 }
3082
mb_ver_string(void)3083 const char* mb_ver_string(void) {
3084 /* Get the version text of this MY-BASIC system */
3085 return _MB_VERSION_STRING;
3086 }
3087
mb_init(void)3088 int mb_init(void) {
3089 /* Initialize the MY-BASIC system */
3090 int result = MB_FUNC_OK;
3091
3092 mb_assert(!_exp_assign);
3093 _exp_assign = (_object_t*)mb_malloc(sizeof(_object_t));
3094 memset(_exp_assign, 0, sizeof(_object_t));
3095 _exp_assign->type = _DT_FUNC;
3096 _exp_assign->data.func = (_func_t*)mb_malloc(sizeof(_func_t));
3097 memset(_exp_assign->data.func, 0, sizeof(_func_t));
3098 _exp_assign->data.func->name = (char*)mb_malloc(strlen("#") + 1);
3099 memcpy(_exp_assign->data.func->name, "#\0", strlen("#") + 1);
3100 _exp_assign->data.func->pointer = _core_dummy_assign;
3101
3102 mb_assert(!_OBJ_BOOL_TRUE);
3103 if(!_OBJ_BOOL_TRUE) {
3104 _OBJ_BOOL_TRUE = (_object_t*)mb_malloc(sizeof(_object_t));
3105 memset(_OBJ_BOOL_TRUE, 0, sizeof(_object_t));
3106
3107 _OBJ_BOOL_TRUE->type = _DT_VAR;
3108 _OBJ_BOOL_TRUE->data.variable = (_var_t*)mb_malloc(sizeof(_var_t));
3109 memset(_OBJ_BOOL_TRUE->data.variable, 0, sizeof(_var_t));
3110 _OBJ_BOOL_TRUE->data.variable->name = (char*)mb_malloc(strlen("TRUE") + 1);
3111 memset(_OBJ_BOOL_TRUE->data.variable->name, 0, strlen("TRUE") + 1);
3112 strcpy(_OBJ_BOOL_TRUE->data.variable->name, "TRUE");
3113
3114 _OBJ_BOOL_TRUE->data.variable->data = (_object_t*)mb_malloc(sizeof(_object_t));
3115 memset(_OBJ_BOOL_TRUE->data.variable->data, 0, sizeof(_object_t));
3116 _OBJ_BOOL_TRUE->data.variable->data->type = _DT_INT;
3117 _OBJ_BOOL_TRUE->data.variable->data->data.integer = 1;
3118 }
3119 mb_assert(!_OBJ_BOOL_FALSE);
3120 if(!_OBJ_BOOL_FALSE) {
3121 _OBJ_BOOL_FALSE = (_object_t*)mb_malloc(sizeof(_object_t));
3122 memset(_OBJ_BOOL_FALSE, 0, sizeof(_object_t));
3123
3124 _OBJ_BOOL_FALSE->type = _DT_VAR;
3125 _OBJ_BOOL_FALSE->data.variable = (_var_t*)mb_malloc(sizeof(_var_t));
3126 memset(_OBJ_BOOL_FALSE->data.variable, 0, sizeof(_var_t));
3127 _OBJ_BOOL_FALSE->data.variable->name = (char*)mb_malloc(strlen("FALSE") + 1);
3128 memset(_OBJ_BOOL_FALSE->data.variable->name, 0, strlen("FALSE") + 1);
3129 strcpy(_OBJ_BOOL_FALSE->data.variable->name, "FALSE");
3130
3131 _OBJ_BOOL_FALSE->data.variable->data = (_object_t*)mb_malloc(sizeof(_object_t));
3132 memset(_OBJ_BOOL_FALSE->data.variable->data, 0, sizeof(_object_t));
3133 _OBJ_BOOL_FALSE->data.variable->data->type = _DT_INT;
3134 _OBJ_BOOL_FALSE->data.variable->data->data.integer = 0;
3135 }
3136
3137 return result;
3138 }
3139
mb_dispose(void)3140 int mb_dispose(void) {
3141 /* Close the MY-BASIC system */
3142 int result = MB_FUNC_OK;
3143
3144 mb_assert(_exp_assign);
3145 safe_free(_exp_assign->data.func->name);
3146 safe_free(_exp_assign->data.func);
3147 safe_free(_exp_assign);
3148 _exp_assign = 0;
3149
3150 mb_assert(_OBJ_BOOL_TRUE);
3151 if(_OBJ_BOOL_TRUE) {
3152 safe_free(_OBJ_BOOL_TRUE->data.variable->data);
3153 safe_free(_OBJ_BOOL_TRUE->data.variable->name);
3154 safe_free(_OBJ_BOOL_TRUE->data.variable);
3155 safe_free(_OBJ_BOOL_TRUE);
3156 _OBJ_BOOL_TRUE = 0;
3157 }
3158 mb_assert(_OBJ_BOOL_FALSE);
3159 if(_OBJ_BOOL_FALSE) {
3160 safe_free(_OBJ_BOOL_FALSE->data.variable->data);
3161 safe_free(_OBJ_BOOL_FALSE->data.variable->name);
3162 safe_free(_OBJ_BOOL_FALSE->data.variable);
3163 safe_free(_OBJ_BOOL_FALSE);
3164 _OBJ_BOOL_FALSE = 0;
3165 }
3166
3167 return result;
3168 }
3169
mb_open(mb_interpreter_t ** s)3170 int mb_open(mb_interpreter_t** s) {
3171 /* Initialize a MY-BASIC environment */
3172 int result = MB_FUNC_OK;
3173 _ht_node_t* local_scope = 0;
3174 _ht_node_t* global_scope = 0;
3175 _ls_node_t* ast = 0;
3176 _parsing_context_t* context = 0;
3177 _running_context_t* running = 0;
3178
3179 *s = (mb_interpreter_t*)mb_malloc(sizeof(mb_interpreter_t));
3180 memset(*s, 0, sizeof(mb_interpreter_t));
3181
3182 local_scope = _ht_create(0, _ht_cmp_string, _ht_hash_string, _ls_free_extra);
3183 (*s)->local_func_dict = local_scope;
3184
3185 global_scope = _ht_create(0, _ht_cmp_string, _ht_hash_string, _ls_free_extra);
3186 (*s)->global_func_dict = global_scope;
3187
3188 global_scope = _ht_create(0, _ht_cmp_string, _ht_hash_string, 0);
3189 (*s)->global_var_dict = global_scope;
3190
3191 ast = _ls_create();
3192 (*s)->ast = ast;
3193
3194 context = (_parsing_context_t*)mb_malloc(sizeof(_parsing_context_t));
3195 memset(context, 0, sizeof(_parsing_context_t));
3196 (*s)->parsing_context = context;
3197
3198 running = (_running_context_t*)mb_malloc(sizeof(_running_context_t));
3199 memset(running, 0, sizeof(_running_context_t));
3200
3201 running->temp_values = _ls_create();
3202
3203 running->sub_stack = _ls_create();
3204 (*s)->running_context = running;
3205
3206 _open_core_lib(*s);
3207 _open_std_lib(*s);
3208
3209 result = _open_constant(*s);
3210 mb_assert(MB_FUNC_OK == result);
3211
3212 return result;
3213 }
3214
mb_close(mb_interpreter_t ** s)3215 int mb_close(mb_interpreter_t** s) {
3216 /* Close a MY-BASIC environment */
3217 int result = MB_FUNC_OK;
3218 _ht_node_t* local_scope = 0;
3219 _ht_node_t* global_scope = 0;
3220 _ls_node_t* ast;
3221 _parsing_context_t* context = 0;
3222 _running_context_t* running = 0;
3223
3224 mb_assert(s);
3225
3226 _close_std_lib(*s);
3227 _close_core_lib(*s);
3228
3229 running = (_running_context_t*)((*s)->running_context);
3230
3231 _ls_foreach(running->temp_values, _destroy_object);
3232 _ls_destroy(running->temp_values);
3233
3234 _ls_destroy(running->sub_stack);
3235 safe_free(running);
3236
3237 context = (_parsing_context_t*)((*s)->parsing_context);
3238 safe_free(context);
3239
3240 ast = (_ls_node_t*)((*s)->ast);
3241 _ls_foreach(ast, _destroy_object);
3242 _ls_destroy(ast);
3243
3244 global_scope = (_ht_node_t*)((*s)->global_var_dict);
3245 _ht_foreach(global_scope, _destroy_object);
3246 _ht_destroy(global_scope);
3247
3248 global_scope = (_ht_node_t*)((*s)->global_func_dict);
3249 _ht_foreach(global_scope, _ls_free_extra);
3250 _ht_destroy(global_scope);
3251
3252 local_scope = (_ht_node_t*)((*s)->local_func_dict);
3253 _ht_foreach(local_scope, _ls_free_extra);
3254 _ht_destroy(local_scope);
3255
3256 _close_constant(*s);
3257
3258 safe_free(*s);
3259 *s = 0;
3260
3261 return result;
3262 }
3263
mb_reset(mb_interpreter_t ** s,bool_t clrf)3264 int mb_reset(mb_interpreter_t** s, bool_t clrf/* = false*/) {
3265 /* Reset a MY-BASIC environment */
3266 int result = MB_FUNC_OK;
3267 _ht_node_t* global_scope = 0;
3268 _ls_node_t* ast;
3269 _parsing_context_t* context = 0;
3270 _running_context_t* running = 0;
3271
3272 mb_assert(s);
3273
3274 (*s)->last_error = SE_NO_ERR;
3275
3276 running = (_running_context_t*)((*s)->running_context);
3277 _ls_clear(running->sub_stack);
3278 running->suspent_point = 0;
3279 running->next_loop_var = 0;
3280 running->no_eat_comma_mark = 0;
3281 memset(&(running->intermediate_value), 0, sizeof(mb_value_t));
3282
3283 context = (_parsing_context_t*)((*s)->parsing_context);
3284 memset(context, 0, sizeof(_parsing_context_t));
3285
3286 ast = (_ls_node_t*)((*s)->ast);
3287 _ls_foreach(ast, _destroy_object);
3288 _ls_clear(ast);
3289
3290 global_scope = (_ht_node_t*)((*s)->global_var_dict);
3291 _ht_foreach(global_scope, _destroy_object);
3292 _ht_clear(global_scope);
3293
3294 if(clrf) {
3295 global_scope = (_ht_node_t*)((*s)->global_func_dict);
3296 _ht_foreach(global_scope, _ls_free_extra);
3297 _ht_clear(global_scope);
3298 }
3299
3300 result = _open_constant(*s);
3301 mb_assert(MB_FUNC_OK == result);
3302
3303 return result;
3304 }
3305
mb_register_func(mb_interpreter_t * s,const char * n,mb_func_t f)3306 int mb_register_func(mb_interpreter_t* s, const char* n, mb_func_t f) {
3307 /* Register a remote function to a MY-BASIC environment */
3308 return _register_func(s, n, f, false);
3309 }
3310
mb_remove_func(mb_interpreter_t * s,const char * n)3311 int mb_remove_func(mb_interpreter_t* s, const char* n) {
3312 /* Remove a remote function from a MY-BASIC environment */
3313 return _remove_func(s, n, false);
3314 }
3315
mb_attempt_func_begin(mb_interpreter_t * s,void ** l)3316 int mb_attempt_func_begin(mb_interpreter_t* s, void** l) {
3317 /* Try attempting to begin a function */
3318 int result = MB_FUNC_OK;
3319 _ls_node_t* ast = 0;
3320 _object_t* obj = 0;
3321 _running_context_t* running = 0;
3322
3323 mb_assert(s && l);
3324
3325 ast = (_ls_node_t*)(*l);
3326 obj = (_object_t*)(ast->data);
3327 if(!(obj->type == _DT_FUNC)) {
3328 _handle_error_on_obj(s, SE_RN_STRUCTURE_NOT_COMPLETED, DON(ast), MB_FUNC_ERR, _exit, result);
3329 }
3330 ast = ast->next;
3331
3332 running = (_running_context_t*)(s->running_context);
3333 ++running->no_eat_comma_mark;
3334
3335 _exit:
3336 *l = ast;
3337
3338 return result;
3339 }
3340
mb_attempt_func_end(mb_interpreter_t * s,void ** l)3341 int mb_attempt_func_end(mb_interpreter_t* s, void** l) {
3342 /* Try attempting to end a function */
3343 int result = MB_FUNC_OK;
3344 _running_context_t* running = 0;
3345
3346 mb_assert(s && l);
3347
3348 running = (_running_context_t*)(s->running_context);
3349 --running->no_eat_comma_mark;
3350
3351 return result;
3352 }
3353
mb_attempt_open_bracket(mb_interpreter_t * s,void ** l)3354 int mb_attempt_open_bracket(mb_interpreter_t* s, void** l) {
3355 /* Try attempting an open bracket */
3356 int result = MB_FUNC_OK;
3357 _ls_node_t* ast = 0;
3358 _object_t* obj = 0;
3359
3360 mb_assert(s && l);
3361
3362 ast = (_ls_node_t*)(*l);
3363 ast = ast->next;
3364 obj = (_object_t*)(ast->data);
3365 if(!(obj->type == _DT_FUNC && obj->data.func->pointer == _core_open_bracket)) {
3366 _handle_error_on_obj(s, SE_RN_OPEN_BRACKET_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
3367 }
3368 ast = ast->next;
3369
3370 _exit:
3371 *l = ast;
3372
3373 return result;
3374 }
3375
mb_attempt_close_bracket(mb_interpreter_t * s,void ** l)3376 int mb_attempt_close_bracket(mb_interpreter_t* s, void** l) {
3377 /* Try attempting a close bracket */
3378 int result = MB_FUNC_OK;
3379 _ls_node_t* ast = 0;
3380 _object_t* obj = 0;
3381
3382 mb_assert(s && l);
3383
3384 ast = (_ls_node_t*)(*l);
3385 obj = (_object_t*)(ast->data);
3386 if(!(obj->type == _DT_FUNC && obj->data.func->pointer == _core_close_bracket)) {
3387 _handle_error_on_obj(s, SE_RN_CLOSE_BRACKET_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
3388 }
3389 ast = ast->next;
3390
3391 _exit:
3392 *l = ast;
3393
3394 return result;
3395 }
3396
mb_pop_int(mb_interpreter_t * s,void ** l,int_t * val)3397 int mb_pop_int(mb_interpreter_t* s, void** l, int_t* val) {
3398 /* Pop an integer argument */
3399 int result = MB_FUNC_OK;
3400 mb_value_t arg;
3401 int_t tmp = 0;
3402
3403 mb_assert(s && l && val);
3404
3405 mb_check(mb_pop_value(s, l, &arg));
3406
3407 switch(arg.type) {
3408 case MB_DT_INT:
3409 tmp = arg.value.integer;
3410 break;
3411 case MB_DT_REAL:
3412 tmp = (int_t)(arg.value.float_point);
3413 break;
3414 default:
3415 result = MB_FUNC_ERR;
3416 goto _exit;
3417 break;
3418 }
3419
3420 *val = tmp;
3421
3422 _exit:
3423 return result;
3424 }
3425
mb_pop_real(mb_interpreter_t * s,void ** l,real_t * val)3426 int mb_pop_real(mb_interpreter_t* s, void** l, real_t* val) {
3427 /* Pop a float point argument */
3428 int result = MB_FUNC_OK;
3429 mb_value_t arg;
3430 real_t tmp = 0;
3431
3432 mb_assert(s && l && val);
3433
3434 mb_check(mb_pop_value(s, l, &arg));
3435
3436 switch(arg.type) {
3437 case MB_DT_INT:
3438 tmp = (real_t)(arg.value.integer);
3439 break;
3440 case MB_DT_REAL:
3441 tmp = arg.value.float_point;
3442 break;
3443 default:
3444 result = MB_FUNC_ERR;
3445 goto _exit;
3446 break;
3447 }
3448
3449 *val = tmp;
3450
3451 _exit:
3452 return result;
3453 }
3454
mb_pop_string(mb_interpreter_t * s,void ** l,char ** val)3455 int mb_pop_string(mb_interpreter_t* s, void** l, char** val) {
3456 /* Pop a string argument */
3457 int result = MB_FUNC_OK;
3458 mb_value_t arg;
3459 char* tmp = 0;
3460
3461 mb_assert(s && l && val);
3462
3463 mb_check(mb_pop_value(s, l, &arg));
3464
3465 switch(arg.type) {
3466 case MB_DT_STRING:
3467 tmp = arg.value.string;
3468 break;
3469 default:
3470 result = MB_FUNC_ERR;
3471 goto _exit;
3472 break;
3473 }
3474
3475 *val = tmp;
3476
3477 _exit:
3478 return result;
3479 }
3480
mb_pop_value(mb_interpreter_t * s,void ** l,mb_value_t * val)3481 int mb_pop_value(mb_interpreter_t* s, void** l, mb_value_t* val) {
3482 /* Pop an argument */
3483 int result = MB_FUNC_OK;
3484 _ls_node_t* ast = 0;
3485 _object_t val_obj;
3486 _object_t* val_ptr = 0;
3487 _running_context_t* running = 0;
3488
3489 mb_assert(s && l && val);
3490
3491 running = (_running_context_t*)(s->running_context);
3492
3493 val_ptr = &val_obj;
3494 memset(val_ptr, 0, sizeof(_object_t));
3495
3496 ast = (_ls_node_t*)(*l);
3497 result = _calc_expression(s, &ast, &val_ptr);
3498 if(result != MB_FUNC_OK) {
3499 goto _exit;
3500 }
3501
3502 if(val_ptr->type == _DT_STRING && !val_ptr->ref) {
3503 val_ptr = (_object_t*)mb_malloc(sizeof(_object_t));
3504 memcpy(val_ptr, &val_obj, sizeof(_object_t));
3505 _ls_pushback(running->temp_values, val_ptr);
3506 }
3507
3508 if(running->no_eat_comma_mark < _NO_EAT_COMMA) {
3509 if(ast && ((_object_t*)(ast->data))->type == _DT_SEP && ((_object_t*)(ast->data))->data.separator == ',') {
3510 ast = ast->next;
3511 }
3512 }
3513
3514 result = _internal_object_to_public_value(val_ptr, val);
3515 if(result != MB_FUNC_OK) {
3516 goto _exit;
3517 }
3518
3519 _exit:
3520 *l = ast;
3521
3522 return result;
3523 }
3524
mb_push_int(mb_interpreter_t * s,void ** l,int_t val)3525 int mb_push_int(mb_interpreter_t* s, void** l, int_t val) {
3526 /* Push an integer argument */
3527 int result = MB_FUNC_OK;
3528 mb_value_t arg;
3529
3530 mb_assert(s && l);
3531
3532 arg.type = MB_DT_INT;
3533 arg.value.integer = val;
3534 mb_check(mb_push_value(s, l, arg));
3535
3536 return result;
3537 }
3538
mb_push_real(mb_interpreter_t * s,void ** l,real_t val)3539 int mb_push_real(mb_interpreter_t* s, void** l, real_t val) {
3540 /* Push a float point argument */
3541 int result = MB_FUNC_OK;
3542 mb_value_t arg;
3543
3544 mb_assert(s && l);
3545
3546 arg.type = MB_DT_REAL;
3547 arg.value.float_point = val;
3548 mb_check(mb_push_value(s, l, arg));
3549
3550 return result;
3551 }
3552
mb_push_string(mb_interpreter_t * s,void ** l,char * val)3553 int mb_push_string(mb_interpreter_t* s, void** l, char* val) {
3554 /* Push a string argument */
3555 int result = MB_FUNC_OK;
3556 mb_value_t arg;
3557
3558 mb_assert(s && l);
3559
3560 arg.type = MB_DT_STRING;
3561 arg.value.string = val;
3562 mb_check(mb_push_value(s, l, arg));
3563
3564 return result;
3565 }
3566
mb_push_value(mb_interpreter_t * s,void ** l,mb_value_t val)3567 int mb_push_value(mb_interpreter_t* s, void** l, mb_value_t val) {
3568 /* Push an argument */
3569 int result = MB_FUNC_OK;
3570 _running_context_t* running = 0;
3571
3572 mb_assert(s && l);
3573
3574 running = (_running_context_t*)(s->running_context);
3575 running->intermediate_value = val;
3576
3577 return result;
3578 }
3579
mb_load_string(mb_interpreter_t * s,const char * l)3580 int mb_load_string(mb_interpreter_t* s, const char* l) {
3581 /* Load a script string */
3582 int result = MB_FUNC_OK;
3583 char ch = 0;
3584 int status = 0;
3585 int i = 0;
3586 unsigned short row = 1;
3587 unsigned short col = 0;
3588 unsigned short _row = 0;
3589 unsigned short _col = 0;
3590 char wrapped = '\0';
3591 _parsing_context_t* context = 0;
3592
3593 mb_assert(s && s->parsing_context);
3594
3595 context = (_parsing_context_t*)(s->parsing_context);
3596
3597 while(l[i]) {
3598 ch = l[i];
3599 if((ch == '\n' || ch == '\r') && (!wrapped || wrapped == ch)) {
3600 wrapped = ch;
3601 ++row;
3602 col = 0;
3603 } else {
3604 wrapped = '\0';
3605 ++col;
3606 }
3607 status = _parse_char(s, ch, i, _row, _col);
3608 result = status;
3609 if(status) {
3610 _set_error_pos(s, i, _row, _col);
3611 if(s->error_handler) {
3612 (s->error_handler)(s, s->last_error, (char*)mb_get_error_desc(s->last_error),
3613 s->last_error_pos,
3614 s->last_error_row,
3615 s->last_error_col,
3616 result);
3617 }
3618 goto _exit;
3619 }
3620 _row = row;
3621 _col = col;
3622 ++i;
3623 };
3624 status = _parse_char(s, _EOS, i, row, col);
3625
3626 _exit:
3627 context->parsing_state = _PS_NORMAL;
3628
3629 return result;
3630 }
3631
mb_load_file(mb_interpreter_t * s,const char * f)3632 int mb_load_file(mb_interpreter_t* s, const char* f) {
3633 /* Load a script file */
3634 int result = MB_FUNC_OK;
3635 FILE* fp = 0;
3636 char* buf = 0;
3637 long curpos = 0;
3638 long l = 0;
3639 _parsing_context_t* context = 0;
3640
3641 mb_assert(s && s->parsing_context);
3642
3643 context = (_parsing_context_t*)(s->parsing_context);
3644
3645 fp = fopen(f, "rb");
3646 if(fp) {
3647 curpos = ftell(fp);
3648 fseek(fp, 0L, SEEK_END);
3649 l = ftell(fp);
3650 fseek(fp, curpos, SEEK_SET);
3651 buf = (char*)mb_malloc((size_t)(l + 1));
3652 mb_assert(buf);
3653 if(fread(buf, 1, l, fp) == l ) {
3654 buf[l] = '\0';
3655 result = mb_load_string(s, buf);
3656 } else {
3657 _set_current_error(s, SE_PS_FILE_OPEN_FAILED);
3658 ++result;
3659 }
3660 fclose(fp);
3661 mb_free(buf);
3662 if(result) {
3663 goto _exit;
3664 }
3665 } else {
3666 _set_current_error(s, SE_PS_FILE_OPEN_FAILED);
3667
3668 ++result;
3669 }
3670
3671 _exit:
3672 context->parsing_state = _PS_NORMAL;
3673
3674 return result;
3675 }
3676
mb_run(mb_interpreter_t * s)3677 int mb_run(mb_interpreter_t* s) {
3678 /* Run loaded and parsed script */
3679 int result = MB_FUNC_OK;
3680 _ls_node_t* ast = 0;
3681 _running_context_t* running = 0;
3682
3683 running = (_running_context_t*)(s->running_context);
3684
3685 if(running->suspent_point) {
3686 ast = running->suspent_point;
3687 ast = ast->next;
3688 running->suspent_point = 0;
3689 } else {
3690 mb_assert(!running->no_eat_comma_mark);
3691 ast = (_ls_node_t*)(s->ast);
3692 ast = ast->next;
3693 if(!ast) {
3694 _set_current_error(s, SE_RN_EMPTY_PROGRAM);
3695 _set_error_pos(s, 0, 0, 0);
3696 result = MB_FUNC_ERR;
3697 (s->error_handler)(s, s->last_error, (char*)mb_get_error_desc(s->last_error),
3698 s->last_error_pos,
3699 s->last_error_row,
3700 s->last_error_col,
3701 result);
3702 goto _exit;
3703 }
3704 }
3705
3706 do {
3707 result = _execute_statement(s, &ast);
3708 if(result != MB_FUNC_OK && result != MB_SUB_RETURN) {
3709 if(result != MB_FUNC_SUSPEND && s->error_handler) {
3710 if(result >= MB_EXTENDED_ABORT) {
3711 s->last_error = SE_EA_EXTENDED_ABORT;
3712 }
3713 (s->error_handler)(s, s->last_error, (char*)mb_get_error_desc(s->last_error),
3714 s->last_error_pos,
3715 s->last_error_row,
3716 s->last_error_col,
3717 result);
3718 }
3719 goto _exit;
3720 }
3721 } while(ast);
3722
3723 _exit:
3724 _ls_foreach(running->temp_values, _destroy_object);
3725 _ls_clear(running->temp_values);
3726
3727 return result;
3728 }
3729
mb_suspend(mb_interpreter_t * s,void ** l)3730 int mb_suspend(mb_interpreter_t* s, void** l) {
3731 /* Suspend current execution and save the context */
3732 int result = MB_FUNC_OK;
3733 _ls_node_t* ast;
3734
3735 mb_assert(s && l && *l);
3736
3737 ast = (_ls_node_t*)(*l);
3738 ((_running_context_t*)(s->running_context))->suspent_point = ast;
3739
3740 return result;
3741 }
3742
mb_get_last_error(mb_interpreter_t * s)3743 mb_error_e mb_get_last_error(mb_interpreter_t* s) {
3744 /* Get last error information */
3745 mb_error_e result = SE_NO_ERR;
3746
3747 mb_assert(s);
3748
3749 result = s->last_error;
3750 s->last_error = SE_NO_ERR;
3751
3752 return result;
3753 }
3754
mb_get_error_desc(mb_error_e err)3755 const char* mb_get_error_desc(mb_error_e err) {
3756 /* Get error description text */
3757 return _get_error_desc(err);
3758 }
3759
mb_set_error_handler(mb_interpreter_t * s,mb_error_handler_t h)3760 int mb_set_error_handler(mb_interpreter_t* s, mb_error_handler_t h) {
3761 /* Set an error handler to an interpreter instance */
3762 int result = MB_FUNC_OK;
3763
3764 mb_assert(s);
3765
3766 s->error_handler = h;
3767
3768 return result;
3769 }
3770
mb_set_printer(mb_interpreter_t * s,mb_print_func_t p)3771 int mb_set_printer(mb_interpreter_t* s, mb_print_func_t p) {
3772 /* Set a print functor to an interpreter instance */
3773 int result = MB_FUNC_OK;
3774
3775 mb_assert(s);
3776
3777 s->printer = p;
3778
3779 return result;
3780 }
3781
mb_gets(char * buf,int s)3782 int mb_gets(char* buf, int s) {
3783 /* Safe stdin reader function */
3784 int result = 0;
3785 if(fgets(buf, s, stdin) == 0) {
3786 fprintf(stderr, "Error reading.\n");
3787 exit(1);
3788 }
3789 result = (int)strlen(buf);
3790 if(buf[result - 1] == '\n')
3791 buf[result - 1] = '\0';
3792
3793 return result;
3794 }
3795
mb_set_user_data(mb_interpreter_t * s,void * ptr)3796 void mb_set_user_data(mb_interpreter_t* s, void *ptr)
3797 {
3798 mb_assert(s);
3799 s->userdata = ptr;
3800 }
3801
mb_get_user_data(mb_interpreter_t * s)3802 void *mb_get_user_data(mb_interpreter_t* s)
3803 {
3804 mb_assert(s);
3805 return s->userdata;
3806 }
3807
3808 /* ========================================================} */
3809
3810 /*
3811 ** {========================================================
3812 ** Lib definitions
3813 */
3814
3815 /** Core lib */
_core_dummy_assign(mb_interpreter_t * s,void ** l)3816 int _core_dummy_assign(mb_interpreter_t* s, void** l) {
3817 /* Operator #, dummy assignment */
3818 int result = MB_FUNC_OK;
3819 mb_unrefvar(s);
3820 mb_unrefvar(l);
3821
3822 mb_assert(0 && "Do nothing, impossible here");
3823 _do_nothing;
3824
3825 return result;
3826 }
3827
_core_add(mb_interpreter_t * s,void ** l)3828 int _core_add(mb_interpreter_t* s, void** l) {
3829 /* Operator + */
3830 int result = MB_FUNC_OK;
3831
3832 mb_assert(s && l);
3833
3834 if(_is_string(((_tuple3_t*)(*l))->e1) || _is_string(((_tuple3_t*)(*l))->e2)) {
3835 if(_is_string(((_tuple3_t*)(*l))->e1) && _is_string(((_tuple3_t*)(*l))->e2)) {
3836 _instruct_connect_strings(l);
3837 } else {
3838 _handle_error_on_obj(s, SE_RN_STRING_EXPECTED, (l && *l) ? ((_object_t*)(((_tuple3_t*)(*l))->e1)) : 0, MB_FUNC_ERR, _exit, result);
3839 }
3840 } else {
3841 _instruct_num_op_num(+, l);
3842 }
3843
3844 _exit:
3845 return result;
3846 }
3847
_core_min(mb_interpreter_t * s,void ** l)3848 int _core_min(mb_interpreter_t* s, void** l) {
3849 /* Operator - */
3850 int result = MB_FUNC_OK;
3851
3852 mb_assert(s && l);
3853
3854 _instruct_num_op_num(-, l);
3855
3856 return result;
3857 }
3858
_core_mul(mb_interpreter_t * s,void ** l)3859 int _core_mul(mb_interpreter_t* s, void** l) {
3860 /* Operator * */
3861 int result = MB_FUNC_OK;
3862
3863 mb_assert(s && l);
3864
3865 _instruct_num_op_num(*, l);
3866
3867 return result;
3868 }
3869
_core_div(mb_interpreter_t * s,void ** l)3870 int _core_div(mb_interpreter_t* s, void** l) {
3871 /* Operator / */
3872 int result = MB_FUNC_OK;
3873
3874 mb_assert(s && l);
3875
3876 _proc_div_by_zero(s, l, _exit, result, SE_RN_DIVIDE_BY_ZERO);
3877 _instruct_num_op_num(/, l);
3878
3879 _exit:
3880 return result;
3881 }
3882
_core_mod(mb_interpreter_t * s,void ** l)3883 int _core_mod(mb_interpreter_t* s, void** l) {
3884 /* Operator MOD */
3885 int result = MB_FUNC_OK;
3886
3887 mb_assert(s && l);
3888
3889 _proc_div_by_zero(s, l, _exit, result, SE_RN_MOD_BY_ZERO);
3890 _instruct_int_op_int(%, l);
3891
3892 _exit:
3893 return result;
3894 }
3895
_core_pow(mb_interpreter_t * s,void ** l)3896 int _core_pow(mb_interpreter_t* s, void** l) {
3897 /* Operator ^ */
3898 int result = MB_FUNC_OK;
3899
3900 mb_assert(s && l);
3901
3902 _instruct_fun_num_num(pow, l);
3903
3904 return result;
3905 }
3906
_core_open_bracket(mb_interpreter_t * s,void ** l)3907 int _core_open_bracket(mb_interpreter_t* s, void** l) {
3908 /* Operator ( */
3909 int result = MB_FUNC_OK;
3910 mb_unrefvar(s);
3911 mb_unrefvar(l);
3912
3913 mb_assert(0 && "Do nothing, impossible here");
3914 _do_nothing;
3915
3916 return result;
3917 }
3918
_core_close_bracket(mb_interpreter_t * s,void ** l)3919 int _core_close_bracket(mb_interpreter_t* s, void** l) {
3920 /* Operator ) */
3921 int result = MB_FUNC_OK;
3922 mb_unrefvar(s);
3923 mb_unrefvar(l);
3924
3925 mb_assert(0 && "Do nothing, impossible here");
3926 _do_nothing;
3927
3928 return result;
3929 }
3930
_core_neg(mb_interpreter_t * s,void ** l)3931 int _core_neg(mb_interpreter_t* s, void** l) {
3932 /* Operator - (negative) */
3933 int result = MB_FUNC_OK;
3934 mb_value_t arg;
3935
3936 mb_assert(s && l);
3937
3938 mb_check(mb_attempt_func_begin(s, l));
3939
3940 mb_check(mb_pop_value(s, l, &arg));
3941
3942 mb_check(mb_attempt_func_end(s, l));
3943
3944 switch(arg.type) {
3945 case MB_DT_INT:
3946 arg.value.integer = -(arg.value.integer);
3947 break;
3948 case MB_DT_REAL:
3949 arg.value.float_point = -(arg.value.float_point);
3950 break;
3951 default:
3952 break;
3953 }
3954 mb_check(mb_push_value(s, l, arg));
3955
3956 return result;
3957 }
3958
_core_equal(mb_interpreter_t * s,void ** l)3959 int _core_equal(mb_interpreter_t* s, void** l) {
3960 /* Operator = */
3961 int result = MB_FUNC_OK;
3962 _tuple3_t* tpr = 0;
3963
3964 mb_assert(s && l);
3965
3966 if(_is_string(((_tuple3_t*)(*l))->e1) || _is_string(((_tuple3_t*)(*l))->e2)) {
3967 if(_is_string(((_tuple3_t*)(*l))->e1) && _is_string(((_tuple3_t*)(*l))->e2)) {
3968 _instruct_compare_strings(==, l);
3969 } else {
3970 _set_tuple3_result(l, 0);
3971 _handle_error_on_obj(s, SE_RN_STRING_EXPECTED, (l && *l) ? ((_object_t*)(((_tuple3_t*)(*l))->e1)) : 0, MB_FUNC_WARNING, _exit, result);
3972 }
3973 } else {
3974 _instruct_num_op_num(==, l);
3975 tpr = (_tuple3_t*)(*l);
3976 if(((_object_t*)(tpr->e3))->type != _DT_INT) {
3977 ((_object_t*)(tpr->e3))->type = _DT_INT;
3978 ((_object_t*)(tpr->e3))->data.integer = ((_object_t*)(tpr->e3))->data.float_point != 0.0f;
3979 }
3980 }
3981
3982 _exit:
3983 return result;
3984 }
3985
_core_less(mb_interpreter_t * s,void ** l)3986 int _core_less(mb_interpreter_t* s, void** l) {
3987 /* Operator < */
3988 int result = MB_FUNC_OK;
3989 _tuple3_t* tpr = 0;
3990
3991 mb_assert(s && l);
3992
3993 if(_is_string(((_tuple3_t*)(*l))->e1) || _is_string(((_tuple3_t*)(*l))->e2)) {
3994 if(_is_string(((_tuple3_t*)(*l))->e1) && _is_string(((_tuple3_t*)(*l))->e2)) {
3995 _instruct_compare_strings(<, l);
3996 } else {
3997 if(_is_string(((_tuple3_t*)(*l))->e1)) {
3998 _set_tuple3_result(l, 0);
3999 } else {
4000 _set_tuple3_result(l, 1);
4001 }
4002 _handle_error_on_obj(s, SE_RN_STRING_EXPECTED, (l && *l) ? ((_object_t*)(((_tuple3_t*)(*l))->e1)) : 0, MB_FUNC_WARNING, _exit, result);
4003 }
4004 } else {
4005 _instruct_num_op_num(<, l);
4006 tpr = (_tuple3_t*)(*l);
4007 if(((_object_t*)(tpr->e3))->type != _DT_INT) {
4008 ((_object_t*)(tpr->e3))->type = _DT_INT;
4009 ((_object_t*)(tpr->e3))->data.integer = ((_object_t*)(tpr->e3))->data.float_point != 0.0f;
4010 }
4011 }
4012
4013 _exit:
4014 return result;
4015 }
4016
_core_greater(mb_interpreter_t * s,void ** l)4017 int _core_greater(mb_interpreter_t* s, void** l) {
4018 /* Operator > */
4019 int result = MB_FUNC_OK;
4020 _tuple3_t* tpr = 0;
4021
4022 mb_assert(s && l);
4023
4024 if(_is_string(((_tuple3_t*)(*l))->e1) || _is_string(((_tuple3_t*)(*l))->e2)) {
4025 if(_is_string(((_tuple3_t*)(*l))->e1) && _is_string(((_tuple3_t*)(*l))->e2)) {
4026 _instruct_compare_strings(>, l);
4027 } else {
4028 if(_is_string(((_tuple3_t*)(*l))->e1)) {
4029 _set_tuple3_result(l, 1);
4030 } else {
4031 _set_tuple3_result(l, 0);
4032 }
4033 _handle_error_on_obj(s, SE_RN_STRING_EXPECTED, (l && *l) ? ((_object_t*)(((_tuple3_t*)(*l))->e1)) : 0, MB_FUNC_WARNING, _exit, result);
4034 }
4035 } else {
4036 _instruct_num_op_num(>, l);
4037 tpr = (_tuple3_t*)(*l);
4038 if(((_object_t*)(tpr->e3))->type != _DT_INT) {
4039 ((_object_t*)(tpr->e3))->type = _DT_INT;
4040 ((_object_t*)(tpr->e3))->data.integer = ((_object_t*)(tpr->e3))->data.float_point != 0.0f;
4041 }
4042 }
4043
4044 _exit:
4045 return result;
4046 }
4047
_core_less_equal(mb_interpreter_t * s,void ** l)4048 int _core_less_equal(mb_interpreter_t* s, void** l) {
4049 /* Operator <= */
4050 int result = MB_FUNC_OK;
4051 _tuple3_t* tpr = 0;
4052
4053 mb_assert(s && l);
4054
4055 if(_is_string(((_tuple3_t*)(*l))->e1) || _is_string(((_tuple3_t*)(*l))->e2)) {
4056 if(_is_string(((_tuple3_t*)(*l))->e1) && _is_string(((_tuple3_t*)(*l))->e2)) {
4057 _instruct_compare_strings(<=, l);
4058 } else {
4059 if(_is_string(((_tuple3_t*)(*l))->e1)) {
4060 _set_tuple3_result(l, 0);
4061 } else {
4062 _set_tuple3_result(l, 1);
4063 }
4064 _handle_error_on_obj(s, SE_RN_STRING_EXPECTED, (l && *l) ? ((_object_t*)(((_tuple3_t*)(*l))->e1)) : 0, MB_FUNC_WARNING, _exit, result);
4065 }
4066 } else {
4067 _instruct_num_op_num(<=, l);
4068 tpr = (_tuple3_t*)(*l);
4069 if(((_object_t*)(tpr->e3))->type != _DT_INT) {
4070 ((_object_t*)(tpr->e3))->type = _DT_INT;
4071 ((_object_t*)(tpr->e3))->data.integer = ((_object_t*)(tpr->e3))->data.float_point != 0.0f;
4072 }
4073 }
4074
4075 _exit:
4076 return result;
4077 }
4078
_core_greater_equal(mb_interpreter_t * s,void ** l)4079 int _core_greater_equal(mb_interpreter_t* s, void** l) {
4080 /* Operator >= */
4081 int result = MB_FUNC_OK;
4082 _tuple3_t* tpr = 0;
4083
4084 mb_assert(s && l);
4085
4086 if(_is_string(((_tuple3_t*)(*l))->e1) || _is_string(((_tuple3_t*)(*l))->e2)) {
4087 if(_is_string(((_tuple3_t*)(*l))->e1) && _is_string(((_tuple3_t*)(*l))->e2)) {
4088 _instruct_compare_strings(>=, l);
4089 } else {
4090 if(_is_string(((_tuple3_t*)(*l))->e1)) {
4091 _set_tuple3_result(l, 1);
4092 } else {
4093 _set_tuple3_result(l, 0);
4094 }
4095 _handle_error_on_obj(s, SE_RN_STRING_EXPECTED, (l && *l) ? ((_object_t*)(((_tuple3_t*)(*l))->e1)) : 0, MB_FUNC_WARNING, _exit, result);
4096 }
4097 } else {
4098 _instruct_num_op_num(>=, l);
4099 tpr = (_tuple3_t*)(*l);
4100 if(((_object_t*)(tpr->e3))->type != _DT_INT) {
4101 ((_object_t*)(tpr->e3))->type = _DT_INT;
4102 ((_object_t*)(tpr->e3))->data.integer = ((_object_t*)(tpr->e3))->data.float_point != 0.0f;
4103 }
4104 }
4105
4106 _exit:
4107 return result;
4108 }
4109
_core_not_equal(mb_interpreter_t * s,void ** l)4110 int _core_not_equal(mb_interpreter_t* s, void** l) {
4111 /* Operator <> */
4112 int result = MB_FUNC_OK;
4113 _tuple3_t* tpr = 0;
4114
4115 mb_assert(s && l);
4116
4117 if(_is_string(((_tuple3_t*)(*l))->e1) || _is_string(((_tuple3_t*)(*l))->e2)) {
4118 if(_is_string(((_tuple3_t*)(*l))->e1) && _is_string(((_tuple3_t*)(*l))->e2)) {
4119 _instruct_compare_strings(!=, l);
4120 } else {
4121 _set_tuple3_result(l, 1);
4122 _handle_error_on_obj(s, SE_RN_STRING_EXPECTED, (l && *l) ? ((_object_t*)(((_tuple3_t*)(*l))->e1)) : 0, MB_FUNC_WARNING, _exit, result);
4123 }
4124 } else {
4125 _instruct_num_op_num(!=, l);
4126 tpr = (_tuple3_t*)(*l);
4127 if(((_object_t*)(tpr->e3))->type != _DT_INT) {
4128 ((_object_t*)(tpr->e3))->type = _DT_INT;
4129 ((_object_t*)(tpr->e3))->data.integer = ((_object_t*)(tpr->e3))->data.float_point != 0.0f;
4130 }
4131 }
4132
4133 _exit:
4134 return result;
4135 }
4136
_core_and(mb_interpreter_t * s,void ** l)4137 int _core_and(mb_interpreter_t* s, void** l) {
4138 /* Operator AND */
4139 int result = MB_FUNC_OK;
4140
4141 mb_assert(s && l);
4142
4143 _instruct_num_op_num(&&, l);
4144
4145 return result;
4146 }
4147
_core_or(mb_interpreter_t * s,void ** l)4148 int _core_or(mb_interpreter_t* s, void** l) {
4149 /* Operator OR */
4150 int result = MB_FUNC_OK;
4151
4152 mb_assert(s && l);
4153
4154 _instruct_num_op_num(||, l);
4155
4156 return result;
4157 }
4158
_core_not(mb_interpreter_t * s,void ** l)4159 int _core_not(mb_interpreter_t* s, void** l) {
4160 /* Operator NOT */
4161 int result = MB_FUNC_OK;
4162 mb_value_t arg;
4163
4164 mb_assert(s && l);
4165
4166 mb_check(mb_attempt_func_begin(s, l));
4167
4168 mb_check(mb_pop_value(s, l, &arg));
4169
4170 mb_check(mb_attempt_func_end(s, l));
4171
4172 switch(arg.type) {
4173 case MB_DT_INT:
4174 arg.value.integer = (int_t)(!arg.value.integer);
4175 break;
4176 case MB_DT_REAL:
4177 arg.value.integer = (int_t)(!((int_t)arg.value.float_point));
4178 arg.type = MB_DT_INT;
4179 break;
4180 default:
4181 break;
4182 }
4183 mb_check(mb_push_int(s, l, arg.value.integer));
4184
4185 return result;
4186 }
4187
_core_let(mb_interpreter_t * s,void ** l)4188 int _core_let(mb_interpreter_t* s, void** l) {
4189 /* LET statement */
4190 int result = MB_FUNC_OK;
4191 _ls_node_t* ast = 0;
4192 _object_t* obj = 0;
4193 _var_t* var = 0;
4194 _array_t* arr = 0;
4195 unsigned int arr_idx = 0;
4196 _object_t* val = 0;
4197
4198 mb_assert(s && l);
4199
4200 ast = (_ls_node_t*)(*l);
4201 obj = (_object_t*)(ast->data);
4202 if(obj->type == _DT_FUNC) {
4203 ast = ast->next;
4204 }
4205 if(!ast || !ast->data) {
4206 _handle_error_on_obj(s, SE_RN_SYNTAX, DON(ast), MB_FUNC_ERR, _exit, result);
4207 }
4208 obj = (_object_t*)(ast->data);
4209 if(obj->type == _DT_VAR) {
4210 var = obj->data.variable;
4211 } else if(obj->type == _DT_ARRAY) {
4212 arr = obj->data.array;
4213 result = _get_array_index(s, &ast, &arr_idx);
4214 if(result != MB_FUNC_OK) {
4215 goto _exit;
4216 }
4217 } else {
4218 _handle_error_on_obj(s, SE_RN_VAR_OR_ARRAY_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
4219 }
4220
4221 ast = ast->next;
4222 if(!ast || !ast->data) {
4223 _handle_error_on_obj(s, SE_RN_SYNTAX, DON(ast), MB_FUNC_ERR, _exit, result);
4224 }
4225 obj = (_object_t*)(ast->data);
4226 if(obj->type != _DT_FUNC || strcmp(obj->data.func->name, "=") != 0) {
4227 _handle_error_on_obj(s, SE_RN_ASSIGN_OPERATOR_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
4228 }
4229
4230 ast = ast->next;
4231 val = (_object_t*)mb_malloc(sizeof(_object_t));
4232 memset(val, 0, sizeof(_object_t));
4233 result = _calc_expression(s, &ast, &val);
4234
4235 if(var) {
4236 if(val->type != _DT_ANY) {
4237 _dispose_object(var->data);
4238 var->data->type = val->type;
4239 var->data->data = val->data;
4240 var->data->ref = val->ref;
4241 }
4242 } else if(arr) {
4243 mb_value_u _val;
4244 if(val->type == _DT_INT) {
4245 _val.integer = val->data.integer;
4246 } else if(val->type == _DT_REAL) {
4247 _val.float_point = val->data.float_point;
4248 } else if(val->type == _DT_STRING) {
4249 _val.string = val->data.string;
4250 } else {
4251 mb_assert(0 && "Unsupported");
4252 }
4253 _set_array_elem(s, arr, arr_idx, &_val, &val->type);
4254 }
4255 safe_free(val);
4256
4257 _exit:
4258 *l = ast;
4259
4260 return result;
4261 }
4262
_core_dim(mb_interpreter_t * s,void ** l)4263 int _core_dim(mb_interpreter_t* s, void** l) {
4264 /* DIM statement */
4265 int result = MB_FUNC_OK;
4266 _ls_node_t* ast = 0;
4267 _object_t* arr = 0;
4268 _object_t* len = 0;
4269 mb_value_u val;
4270 _array_t dummy;
4271
4272 mb_assert(s && l);
4273
4274 /* Array name */
4275 ast = (_ls_node_t*)(*l);
4276 if(!ast->next || ((_object_t*)(ast->next->data))->type != _DT_ARRAY) {
4277 _handle_error_on_obj(s, SE_RN_ARRAY_IDENTIFIER_EXPECTED, (ast && ast->next) ? ((_object_t*)(ast->next->data)) : 0, MB_FUNC_ERR, _exit, result);
4278 }
4279 ast = ast->next;
4280 arr = (_object_t*)(ast->data);
4281 memset(&dummy, 0, sizeof(_array_t));
4282 dummy.type = arr->data.array->type;
4283 dummy.name = arr->data.array->name;
4284 /* ( */
4285 if(!ast->next || ((_object_t*)(ast->next->data))->type != _DT_FUNC || ((_object_t*)(ast->next->data))->data.func->pointer != _core_open_bracket) {
4286 _handle_error_on_obj(s, SE_RN_OPEN_BRACKET_EXPECTED, (ast && ast->next) ? ((_object_t*)(ast->next->data)) : 0, MB_FUNC_ERR, _exit, result);
4287 }
4288 ast = ast->next;
4289 /* Array subscript */
4290 if(!ast->next) {
4291 _handle_error_on_obj(s, SE_RN_ARRAY_SUBSCRIPT_EXPECTED, (ast && ast->next) ? ((_object_t*)(ast->next->data)) : 0, MB_FUNC_ERR, _exit, result);
4292 }
4293 ast = ast->next;
4294 while(((_object_t*)(ast->data))->type != _DT_FUNC || ((_object_t*)(ast->data))->data.func->pointer != _core_close_bracket) {
4295 /* Get an integer value */
4296 len = (_object_t*)(ast->data);
4297 if(!_try_get_value(len, &val, _DT_INT)) {
4298 _handle_error_on_obj(s, SE_RN_TYPE_NOT_MATCH, DON(ast), MB_FUNC_ERR, _exit, result);
4299 }
4300 if(val.integer <= 0) {
4301 _handle_error_on_obj(s, SE_RN_ILLEGAL_BOUND, DON(ast), MB_FUNC_ERR, _exit, result);
4302 }
4303 if(dummy.dimension_count >= _MAX_DIMENSION_COUNT) {
4304 _handle_error_on_obj(s, SE_RN_DIMENSION_TOO_MUCH, DON(ast), MB_FUNC_ERR, _exit, result);
4305 }
4306 dummy.dimensions[dummy.dimension_count++] = (int)val.integer;
4307 if(dummy.count) {
4308 dummy.count *= (unsigned int)val.integer;
4309 } else {
4310 dummy.count += (unsigned int)val.integer;
4311 }
4312 ast = ast->next;
4313 /* Comma? */
4314 if(((_object_t*)(ast->data))->type == _DT_SEP && ((_object_t*)(ast->data))->data.separator == ',') {
4315 ast = ast->next;
4316 }
4317 }
4318 /* Create or modify raw data */
4319 _clear_array(arr->data.array);
4320 *(arr->data.array) = dummy;
4321 _init_array(arr->data.array);
4322 if(!arr->data.array->raw) {
4323 arr->data.array->dimension_count = 0;
4324 arr->data.array->dimensions[0] = 0;
4325 arr->data.array->count = 0;
4326 _handle_error_on_obj(s, SE_RN_OUT_OF_MEMORY, DON(ast), MB_FUNC_ERR, _exit, result);
4327 }
4328
4329 _exit:
4330 *l = ast;
4331
4332 return result;
4333 }
4334
_core_if(mb_interpreter_t * s,void ** l)4335 int _core_if(mb_interpreter_t* s, void** l) {
4336 /* IF statement */
4337 int result = MB_FUNC_OK;
4338 _ls_node_t* ast = 0;
4339 _object_t* val = 0;
4340 _object_t* obj = 0;
4341 _running_context_t* running = 0;
4342
4343 mb_assert(s && l);
4344
4345 running = (_running_context_t*)(s->running_context);
4346
4347 ast = (_ls_node_t*)(*l);
4348 ast = ast->next;
4349
4350 val = (_object_t*)mb_malloc(sizeof(_object_t));
4351 memset(val, 0, sizeof(_object_t));
4352 result = _calc_expression(s, &ast, &val);
4353 if(result != MB_FUNC_OK) {
4354 goto _exit;
4355 }
4356 mb_assert(val->type == _DT_INT);
4357
4358 obj = (_object_t*)(ast->data);
4359 if(val->data.integer) {
4360 if(!(obj->type == _DT_FUNC && obj->data.func->pointer == _core_then)) {
4361 _handle_error_on_obj(s, SE_RN_INTEGER_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
4362 }
4363
4364 running->skip_to_eoi = _ls_back(running->sub_stack);
4365 do {
4366 ast = ast->next;
4367 result = _execute_statement(s, &ast);
4368 if(result != MB_FUNC_OK) {
4369 goto _exit;
4370 }
4371 if(ast) {
4372 ast = ast->prev;
4373 }
4374 } while(ast && ((_object_t*)(ast->data))->type == _DT_SEP && ((_object_t*)(ast->data))->data.separator == ':');
4375
4376 if(!ast) {
4377 goto _exit;
4378 }
4379
4380 obj = (_object_t*)(ast->data);
4381 if(obj->type != _DT_EOS) {
4382 running->skip_to_eoi = 0;
4383 result = _skip_to(s, &ast, 0, _DT_EOS);
4384 if(result != MB_FUNC_OK) {
4385 goto _exit;
4386 }
4387 }
4388 } else {
4389 result = _skip_to(s, &ast, _core_else, _DT_EOS);
4390 if(result != MB_FUNC_OK) {
4391 goto _exit;
4392 }
4393
4394 obj = (_object_t*)(ast->data);
4395 if(obj->type != _DT_EOS) {
4396 if(!(obj->type == _DT_FUNC && obj->data.func->pointer == _core_else)) {
4397 _handle_error_on_obj(s, SE_RN_ELSE_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
4398 }
4399
4400 do {
4401 ast = ast->next;
4402 result = _execute_statement(s, &ast);
4403 if(result != MB_FUNC_OK) {
4404 goto _exit;
4405 }
4406 if(ast) {
4407 ast = ast->prev;
4408 }
4409 } while(ast && ((_object_t*)(ast->data))->type == _DT_SEP && ((_object_t*)(ast->data))->data.separator == ':');
4410 }
4411 }
4412
4413 _exit:
4414 _destroy_object(val, 0);
4415
4416 *l = ast;
4417
4418 return result;
4419 }
4420
_core_then(mb_interpreter_t * s,void ** l)4421 int _core_then(mb_interpreter_t* s, void** l) {
4422 /* THEN statement */
4423 int result = MB_FUNC_OK;
4424 mb_unrefvar(s);
4425 mb_unrefvar(l);
4426
4427 mb_assert(0 && "Do nothing, impossible here");
4428 _do_nothing;
4429
4430 return result;
4431 }
4432
_core_else(mb_interpreter_t * s,void ** l)4433 int _core_else(mb_interpreter_t* s, void** l) {
4434 /* ELSE statement */
4435 int result = MB_FUNC_OK;
4436 mb_unrefvar(s);
4437 mb_unrefvar(l);
4438
4439 mb_assert(0 && "Do nothing, impossible here");
4440 _do_nothing;
4441
4442 return result;
4443 }
4444
_core_for(mb_interpreter_t * s,void ** l)4445 int _core_for(mb_interpreter_t* s, void** l) {
4446 /* FOR statement */
4447 int result = MB_FUNC_OK;
4448 _ls_node_t* ast = 0;
4449 _ls_node_t* to_node = 0;
4450 _object_t* obj = 0;
4451 _object_t to_val;
4452 _object_t step_val;
4453 _object_t* to_val_ptr = 0;
4454 _object_t* step_val_ptr = 0;
4455 _var_t* var_loop = 0;
4456 _tuple3_t ass_tuple3;
4457 _tuple3_t* ass_tuple3_ptr = 0;
4458 _running_context_t* running = 0;
4459
4460 mb_assert(s && l);
4461
4462 running = (_running_context_t*)(s->running_context);
4463 ast = (_ls_node_t*)(*l);
4464 ast = ast->next;
4465
4466 to_val_ptr = &to_val;
4467 step_val_ptr = &step_val;
4468 ass_tuple3_ptr = &ass_tuple3;
4469
4470 obj = (_object_t*)(ast->data);
4471 if(obj->type != _DT_VAR) {
4472 _handle_error_on_obj(s, SE_RN_LOOP_VAR_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
4473 }
4474 var_loop = obj->data.variable;
4475
4476 result = _execute_statement(s, &ast);
4477 if(result != MB_FUNC_OK) {
4478 goto _exit;
4479 }
4480 ast = ast->prev;
4481
4482 obj = (_object_t*)(ast->data);
4483 if(!(obj->type == _DT_FUNC && obj->data.func->pointer == _core_to)) {
4484 _handle_error_on_obj(s, SE_RN_TO_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
4485 }
4486
4487 ast = ast->next;
4488 if(!ast) {
4489 _handle_error_on_obj(s, SE_RN_SYNTAX, DON(ast), MB_FUNC_ERR, _exit, result);
4490 }
4491 to_node = ast;
4492
4493 _to:
4494 ast = to_node;
4495
4496 result = _calc_expression(s, &ast, &to_val_ptr);
4497 if(result != MB_FUNC_OK) {
4498 goto _exit;
4499 }
4500
4501 obj = (_object_t*)(ast->data);
4502 if(!(obj->type == _DT_FUNC && obj->data.func->pointer == _core_step)) {
4503 step_val = _OBJ_INT_UNIT;
4504 } else {
4505 ast = ast->next;
4506 if(!ast) {
4507 _handle_error_on_obj(s, SE_RN_SYNTAX, DON(ast), MB_FUNC_ERR, _exit, result);
4508 }
4509
4510 result = _calc_expression(s, &ast, &step_val_ptr);
4511 if(result != MB_FUNC_OK) {
4512 goto _exit;
4513 }
4514 }
4515
4516 if((_compare_numbers(step_val_ptr, &_OBJ_INT_ZERO) == 1 && _compare_numbers(var_loop->data, to_val_ptr) == 1) ||
4517 (_compare_numbers(step_val_ptr, &_OBJ_INT_ZERO) == -1 && _compare_numbers(var_loop->data, to_val_ptr) == -1)) {
4518 /* End looping */
4519 if(_skip_struct(s, &ast, _core_for, _core_next) != MB_FUNC_OK) {
4520 goto _exit;
4521 }
4522 _skip_to(s, &ast, 0, _DT_EOS);
4523 goto _exit;
4524 } else {
4525 /* Keep looping */
4526 obj = (_object_t*)(ast->data);
4527 while(!(obj->type == _DT_FUNC && obj->data.func->pointer == _core_next)) {
4528 result = _execute_statement(s, &ast);
4529 if(result == MB_LOOP_CONTINUE) { /* NEXT */
4530 if(!running->next_loop_var || running->next_loop_var == var_loop) { /* This loop */
4531 running->next_loop_var = 0;
4532 result = MB_FUNC_OK;
4533 break;
4534 } else { /* Not this loop */
4535 if(_skip_struct(s, &ast, _core_for, _core_next) != MB_FUNC_OK) {
4536 goto _exit;
4537 }
4538 _skip_to(s, &ast, 0, _DT_EOS);
4539 goto _exit;
4540 }
4541 } else if(result == MB_LOOP_BREAK) { /* EXIT */
4542 if(_skip_struct(s, &ast, _core_for, _core_next) != MB_FUNC_OK) {
4543 goto _exit;
4544 }
4545 _skip_to(s, &ast, 0, _DT_EOS);
4546 result = MB_FUNC_OK;
4547 goto _exit;
4548 } else if(result != MB_FUNC_OK && result != MB_SUB_RETURN) { /* Normally */
4549 goto _exit;
4550 }
4551
4552 if(!ast) {
4553 _handle_error_on_obj(s, SE_RN_NEXT_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
4554 }
4555 obj = (_object_t*)(ast->data);
4556 }
4557
4558 ass_tuple3.e1 = var_loop->data;
4559 ass_tuple3.e2 = step_val_ptr;
4560 ass_tuple3.e3 = var_loop->data;
4561 _instruct_num_op_num(+, &ass_tuple3_ptr);
4562
4563 goto _to;
4564 }
4565
4566 _exit:
4567 *l = ast;
4568
4569 return result;
4570 }
4571
_core_to(mb_interpreter_t * s,void ** l)4572 int _core_to(mb_interpreter_t* s, void** l) {
4573 /* TO statement */
4574 int result = MB_FUNC_OK;
4575 mb_unrefvar(s);
4576 mb_unrefvar(l);
4577
4578 mb_assert(0 && "Do nothing, impossible here");
4579 _do_nothing;
4580
4581 return result;
4582 }
4583
_core_step(mb_interpreter_t * s,void ** l)4584 int _core_step(mb_interpreter_t* s, void** l) {
4585 /* STEP statement */
4586 int result = MB_FUNC_OK;
4587 mb_unrefvar(s);
4588 mb_unrefvar(l);
4589
4590 mb_assert(0 && "Do nothing, impossible here");
4591 _do_nothing;
4592
4593 return result;
4594 }
4595
_core_next(mb_interpreter_t * s,void ** l)4596 int _core_next(mb_interpreter_t* s, void** l) {
4597 /* NEXT statement */
4598 int result = MB_FUNC_OK;
4599 _ls_node_t* ast = 0;
4600 _object_t* obj = 0;
4601 _running_context_t* running = 0;
4602
4603 mb_assert(s && l);
4604
4605 running = (_running_context_t*)(s->running_context);
4606 ast = (_ls_node_t*)(*l);
4607
4608 result = MB_LOOP_CONTINUE;
4609
4610 ast = ast->next;
4611 if(ast && ((_object_t*)(ast->data))->type == _DT_VAR) {
4612 obj = (_object_t*)(ast->data);
4613 running->next_loop_var = obj->data.variable;
4614 }
4615
4616 *l = ast;
4617
4618 return result;
4619 }
4620
_core_while(mb_interpreter_t * s,void ** l)4621 int _core_while(mb_interpreter_t* s, void** l) {
4622 /* WHILE statement */
4623 int result = MB_FUNC_OK;
4624 _ls_node_t* ast = 0;
4625 _ls_node_t* loop_begin_node = 0;
4626 _object_t* obj = 0;
4627 _object_t loop_cond;
4628 _object_t* loop_cond_ptr = 0;
4629
4630 mb_assert(s && l);
4631
4632 ast = (_ls_node_t*)(*l);
4633 ast = ast->next;
4634
4635 loop_cond_ptr = &loop_cond;
4636
4637 loop_begin_node = ast;
4638
4639 _loop_begin:
4640 ast = loop_begin_node;
4641
4642 result = _calc_expression(s, &ast, &loop_cond_ptr);
4643 if(result != MB_FUNC_OK) {
4644 goto _exit;
4645 }
4646 mb_assert(loop_cond_ptr->type == _DT_INT);
4647
4648 if(loop_cond_ptr->data.integer) {
4649 /* Keep looping */
4650 obj = (_object_t*)(ast->data);
4651 while(!(obj->type == _DT_FUNC && obj->data.func->pointer == _core_wend)) {
4652 result = _execute_statement(s, &ast);
4653 if(result == MB_LOOP_BREAK) { /* EXIT */
4654 if(_skip_struct(s, &ast, _core_while, _core_wend) != MB_FUNC_OK) {
4655 goto _exit;
4656 }
4657 _skip_to(s, &ast, 0, _DT_EOS);
4658 result = MB_FUNC_OK;
4659 goto _exit;
4660 } else if(result != MB_FUNC_OK && result != MB_SUB_RETURN) { /* Normally */
4661 goto _exit;
4662 }
4663
4664 obj = (_object_t*)(ast->data);
4665 }
4666
4667 goto _loop_begin;
4668 } else {
4669 /* End looping */
4670 if(_skip_struct(s, &ast, _core_while, _core_wend) != MB_FUNC_OK) {
4671 goto _exit;
4672 }
4673 _skip_to(s, &ast, 0, _DT_EOS);
4674 goto _exit;
4675 }
4676
4677 _exit:
4678 *l = ast;
4679
4680 return result;
4681 }
4682
_core_wend(mb_interpreter_t * s,void ** l)4683 int _core_wend(mb_interpreter_t* s, void** l) {
4684 /* WEND statement */
4685 int result = MB_FUNC_OK;
4686 mb_unrefvar(s);
4687 mb_unrefvar(l);
4688
4689 mb_assert(0 && "Do nothing, impossible here");
4690 _do_nothing;
4691
4692 return result;
4693 }
4694
_core_do(mb_interpreter_t * s,void ** l)4695 int _core_do(mb_interpreter_t* s, void** l) {
4696 /* DO statement */
4697 int result = MB_FUNC_OK;
4698 _ls_node_t* ast = 0;
4699 _ls_node_t* loop_begin_node = 0;
4700 _object_t* obj = 0;
4701 _object_t loop_cond;
4702 _object_t* loop_cond_ptr = 0;
4703
4704 mb_assert(s && l);
4705
4706 ast = (_ls_node_t*)(*l);
4707 ast = ast->next;
4708
4709 obj = (_object_t*)(ast->data);
4710 if(!(obj->type == _DT_EOS)) {
4711 _handle_error_on_obj(s, SE_RN_SYNTAX, DON(ast), MB_FUNC_ERR, _exit, result);
4712 }
4713 ast = ast->next;
4714
4715 loop_cond_ptr = &loop_cond;
4716
4717 loop_begin_node = ast;
4718
4719 _loop_begin:
4720 ast = loop_begin_node;
4721
4722 obj = (_object_t*)(ast->data);
4723 while(!(obj->type == _DT_FUNC && obj->data.func->pointer == _core_until)) {
4724 result = _execute_statement(s, &ast);
4725 if(result == MB_LOOP_BREAK) { /* EXIT */
4726 if(_skip_struct(s, &ast, _core_do, _core_until) != MB_FUNC_OK) {
4727 goto _exit;
4728 }
4729 _skip_to(s, &ast, 0, _DT_EOS);
4730 result = MB_FUNC_OK;
4731 goto _exit;
4732 } else if(result != MB_FUNC_OK && result != MB_SUB_RETURN) { /* Normally */
4733 goto _exit;
4734 }
4735
4736 obj = (_object_t*)(ast->data);
4737 }
4738
4739 obj = (_object_t*)(ast->data);
4740 if(!(obj->type == _DT_FUNC && obj->data.func->pointer == _core_until)) {
4741 _handle_error_on_obj(s, SE_RN_UNTIL_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
4742 }
4743 ast = ast->next;
4744
4745 result = _calc_expression(s, &ast, &loop_cond_ptr);
4746 if(result != MB_FUNC_OK) {
4747 goto _exit;
4748 }
4749 mb_assert(loop_cond_ptr->type == _DT_INT);
4750
4751 if(loop_cond_ptr->data.integer) {
4752 /* End looping */
4753 _skip_to(s, &ast, 0, _DT_EOS);
4754 goto _exit;
4755 } else {
4756 /* Keep looping */
4757 goto _loop_begin;
4758 }
4759
4760 _exit:
4761 *l = ast;
4762
4763 return result;
4764 }
4765
_core_until(mb_interpreter_t * s,void ** l)4766 int _core_until(mb_interpreter_t* s, void** l) {
4767 /* UNTIL statement */
4768 int result = MB_FUNC_OK;
4769 mb_unrefvar(s);
4770 mb_unrefvar(l);
4771
4772 mb_assert(0 && "Do nothing, impossible here");
4773 _do_nothing;
4774
4775 return result;
4776 }
4777
_core_exit(mb_interpreter_t * s,void ** l)4778 int _core_exit(mb_interpreter_t* s, void** l) {
4779 /* EXIT statement */
4780 int result = MB_FUNC_OK;
4781
4782 mb_assert(s && l);
4783
4784 result = MB_LOOP_BREAK;
4785
4786 return result;
4787 }
4788
_core_goto(mb_interpreter_t * s,void ** l)4789 int _core_goto(mb_interpreter_t* s, void** l) {
4790 /* GOTO statement */
4791 int result = MB_FUNC_OK;
4792 _ls_node_t* ast = 0;
4793 _object_t* obj = 0;
4794 _label_t* label = 0;
4795 _ls_node_t* glbsyminscope = 0;
4796
4797 mb_assert(s && l);
4798
4799 ast = (_ls_node_t*)(*l);
4800 ast = ast->next;
4801
4802 obj = (_object_t*)(ast->data);
4803 if(obj->type != _DT_LABEL) {
4804 _handle_error_on_obj(s, SE_RN_JUMP_LABEL_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
4805 }
4806
4807 label = (_label_t*)(obj->data.label);
4808 if(!label->node) {
4809 glbsyminscope = _ht_find((_ht_node_t*)s->global_var_dict, label->name);
4810 if(!(glbsyminscope && ((_object_t*)(glbsyminscope->data))->type == _DT_LABEL)) {
4811 _handle_error_on_obj(s, SE_RN_LABEL_NOT_EXISTS, DON(ast), MB_FUNC_ERR, _exit, result);
4812 }
4813 label->node = ((_object_t*)(glbsyminscope->data))->data.label->node;
4814 }
4815
4816 mb_assert(label->node && label->node->prev);
4817 ast = label->node->prev;
4818
4819 _exit:
4820 *l = ast;
4821
4822 return result;
4823 }
4824
_core_gosub(mb_interpreter_t * s,void ** l)4825 int _core_gosub(mb_interpreter_t* s, void** l) {
4826 /* GOSUB statement */
4827 int result = MB_FUNC_OK;
4828 _ls_node_t* ast = 0;
4829 _running_context_t* running = 0;
4830
4831 mb_assert(s && l);
4832
4833 running = (_running_context_t*)(s->running_context);
4834 ast = (_ls_node_t*)(*l);
4835 result = _core_goto(s, l);
4836 if(result == MB_FUNC_OK) {
4837 _ls_pushback(running->sub_stack, ast);
4838 }
4839
4840 return result;
4841 }
4842
_core_return(mb_interpreter_t * s,void ** l)4843 int _core_return(mb_interpreter_t* s, void** l) {
4844 /* RETURN statement */
4845 int result = MB_SUB_RETURN;
4846 _ls_node_t* ast = 0;
4847 _running_context_t* running = 0;
4848
4849 mb_assert(s && l);
4850
4851 running = (_running_context_t*)(s->running_context);
4852 ast = (_ls_node_t*)_ls_popback(running->sub_stack);
4853 if(!ast) {
4854 _handle_error_on_obj(s, SE_RN_NO_RETURN_POINT, DON(ast), MB_FUNC_ERR, _exit, result);
4855 }
4856 *l = ast;
4857
4858 _exit:
4859 return result;
4860 }
4861
_core_end(mb_interpreter_t * s,void ** l)4862 int _core_end(mb_interpreter_t* s, void** l) {
4863 /* END statement */
4864 int result = MB_FUNC_OK;
4865
4866 mb_assert(s && l);
4867
4868 result = MB_FUNC_END;
4869
4870 return result;
4871 }
4872
4873 #ifdef _MB_ENABLE_ALLOC_STAT
_core_mem(mb_interpreter_t * s,void ** l)4874 int _core_mem(mb_interpreter_t* s, void** l) {
4875 /* MEM statement */
4876 int result = MB_FUNC_OK;
4877
4878 mb_assert(s && l);
4879
4880 mb_check(mb_attempt_func_begin(s, l));
4881 mb_check(mb_attempt_func_end(s, l));
4882
4883 mb_check(mb_push_int(s, l, (int_t)_mb_allocated));
4884
4885 return result;
4886 }
4887 #endif /* _MB_ENABLE_ALLOC_STAT */
4888
4889 /** Std lib */
_std_abs(mb_interpreter_t * s,void ** l)4890 int _std_abs(mb_interpreter_t* s, void** l) {
4891 /* Get the absolute value of a number */
4892 int result = MB_FUNC_OK;
4893 mb_value_t arg;
4894
4895 mb_assert(s && l);
4896
4897 mb_check(mb_attempt_open_bracket(s, l));
4898
4899 mb_check(mb_pop_value(s, l, &arg));
4900
4901 mb_check(mb_attempt_close_bracket(s, l));
4902
4903 switch(arg.type) {
4904 case MB_DT_INT:
4905 arg.value.integer = (int_t)abs(arg.value.integer);
4906 break;
4907 case MB_DT_REAL:
4908 arg.value.float_point = (real_t)fabs(arg.value.float_point);
4909 break;
4910 default:
4911 break;
4912 }
4913 mb_check(mb_push_value(s, l, arg));
4914
4915 return result;
4916 }
4917
_std_sgn(mb_interpreter_t * s,void ** l)4918 int _std_sgn(mb_interpreter_t* s, void** l) {
4919 /* Get the sign of a number */
4920 int result = MB_FUNC_OK;
4921 mb_value_t arg;
4922
4923 mb_assert(s && l);
4924
4925 mb_check(mb_attempt_open_bracket(s, l));
4926
4927 mb_check(mb_pop_value(s, l, &arg));
4928
4929 mb_check(mb_attempt_close_bracket(s, l));
4930
4931 switch(arg.type) {
4932 case MB_DT_INT:
4933 arg.value.integer = sgn(arg.value.integer);
4934 break;
4935 case MB_DT_REAL:
4936 arg.value.integer = sgn(arg.value.float_point);
4937 arg.type = MB_DT_INT;
4938 break;
4939 default:
4940 break;
4941 }
4942 mb_check(mb_push_int(s, l, arg.value.integer));
4943
4944 return result;
4945 }
4946
_std_sqr(mb_interpreter_t * s,void ** l)4947 int _std_sqr(mb_interpreter_t* s, void** l) {
4948 /* Get the square root of a number */
4949 int result = MB_FUNC_OK;
4950 mb_value_t arg;
4951
4952 mb_assert(s && l);
4953
4954 mb_check(mb_attempt_open_bracket(s, l));
4955
4956 mb_check(mb_pop_value(s, l, &arg));
4957
4958 mb_check(mb_attempt_close_bracket(s, l));
4959
4960 switch(arg.type) {
4961 case MB_DT_INT:
4962 arg.value.float_point = (real_t)sqrt((real_t)arg.value.integer);
4963 arg.type = MB_DT_REAL;
4964 break;
4965 case MB_DT_REAL:
4966 arg.value.float_point = (real_t)sqrt(arg.value.float_point);
4967 break;
4968 default:
4969 break;
4970 }
4971 mb_check(mb_push_value(s, l, arg));
4972
4973 return result;
4974 }
4975
_std_floor(mb_interpreter_t * s,void ** l)4976 int _std_floor(mb_interpreter_t* s, void** l) {
4977 /* Get the greatest integer not greater than a number */
4978 int result = MB_FUNC_OK;
4979 mb_value_t arg;
4980
4981 mb_assert(s && l);
4982
4983 mb_check(mb_attempt_open_bracket(s, l));
4984
4985 mb_check(mb_pop_value(s, l, &arg));
4986
4987 mb_check(mb_attempt_close_bracket(s, l));
4988
4989 switch(arg.type) {
4990 case MB_DT_INT:
4991 arg.value.integer = (int_t)(arg.value.integer);
4992 break;
4993 case MB_DT_REAL:
4994 arg.value.integer = (int_t)floor(arg.value.float_point);
4995 arg.type = MB_DT_INT;
4996 break;
4997 default:
4998 break;
4999 }
5000 mb_check(mb_push_int(s, l, arg.value.integer));
5001
5002 return result;
5003 }
5004
_std_ceil(mb_interpreter_t * s,void ** l)5005 int _std_ceil(mb_interpreter_t* s, void** l) {
5006 /* Get the least integer not less than a number */
5007 int result = MB_FUNC_OK;
5008 mb_value_t arg;
5009
5010 mb_assert(s && l);
5011
5012 mb_check(mb_attempt_open_bracket(s, l));
5013
5014 mb_check(mb_pop_value(s, l, &arg));
5015
5016 mb_check(mb_attempt_close_bracket(s, l));
5017
5018 switch(arg.type) {
5019 case MB_DT_INT:
5020 arg.value.integer = (int_t)(arg.value.integer);
5021 break;
5022 case MB_DT_REAL:
5023 arg.value.integer = (int_t)ceil(arg.value.float_point);
5024 arg.type = MB_DT_INT;
5025 break;
5026 default:
5027 break;
5028 }
5029 mb_check(mb_push_int(s, l, arg.value.integer));
5030
5031 return result;
5032 }
5033
_std_fix(mb_interpreter_t * s,void ** l)5034 int _std_fix(mb_interpreter_t* s, void** l) {
5035 /* Get the integer format of a number */
5036 int result = MB_FUNC_OK;
5037 mb_value_t arg;
5038
5039 mb_assert(s && l);
5040
5041 mb_check(mb_attempt_open_bracket(s, l));
5042
5043 mb_check(mb_pop_value(s, l, &arg));
5044
5045 mb_check(mb_attempt_close_bracket(s, l));
5046
5047 switch(arg.type) {
5048 case MB_DT_INT:
5049 arg.value.integer = (int_t)(arg.value.integer);
5050 break;
5051 case MB_DT_REAL:
5052 arg.value.integer = (int_t)(arg.value.float_point);
5053 arg.type = MB_DT_INT;
5054 break;
5055 default:
5056 break;
5057 }
5058 mb_check(mb_push_int(s, l, arg.value.integer));
5059
5060 return result;
5061 }
5062
_std_round(mb_interpreter_t * s,void ** l)5063 int _std_round(mb_interpreter_t* s, void** l) {
5064 /* Get the rounded integer of a number */
5065 int result = MB_FUNC_OK;
5066 mb_value_t arg;
5067
5068 mb_assert(s && l);
5069
5070 mb_check(mb_attempt_open_bracket(s, l));
5071
5072 mb_check(mb_pop_value(s, l, &arg));
5073
5074 mb_check(mb_attempt_close_bracket(s, l));
5075
5076 switch(arg.type) {
5077 case MB_DT_INT:
5078 arg.value.integer = (int_t)(arg.value.integer);
5079 break;
5080 case MB_DT_REAL:
5081 arg.value.integer = (int_t)(arg.value.float_point + (real_t)0.5f);
5082 arg.type = MB_DT_INT;
5083 break;
5084 default:
5085 break;
5086 }
5087 mb_check(mb_push_int(s, l, arg.value.integer));
5088
5089 return result;
5090 }
5091
_std_rnd(mb_interpreter_t * s,void ** l)5092 int _std_rnd(mb_interpreter_t* s, void** l) {
5093 /* Get a random value among 0 ~ 1 */
5094 int result = MB_FUNC_OK;
5095 real_t rnd = (real_t)0.0f;
5096
5097 mb_assert(s && l);
5098
5099 mb_check(mb_attempt_func_begin(s, l));
5100 mb_check(mb_attempt_func_end(s, l));
5101
5102 rnd = (real_t)(((real_t)(rand() % 101)) / 100.0f);
5103 mb_check(mb_push_real(s, l, rnd));
5104
5105 return result;
5106 }
5107
_std_sin(mb_interpreter_t * s,void ** l)5108 int _std_sin(mb_interpreter_t* s, void** l) {
5109 /* Get the sin value of a number */
5110 int result = MB_FUNC_OK;
5111 mb_value_t arg;
5112
5113 mb_assert(s && l);
5114
5115 mb_check(mb_attempt_open_bracket(s, l));
5116
5117 mb_check(mb_pop_value(s, l, &arg));
5118
5119 mb_check(mb_attempt_close_bracket(s, l));
5120
5121 switch(arg.type) {
5122 case MB_DT_INT:
5123 arg.value.float_point = (real_t)sin((real_t)arg.value.integer);
5124 arg.type = MB_DT_REAL;
5125 break;
5126 case MB_DT_REAL:
5127 arg.value.float_point = (real_t)sin(arg.value.float_point);
5128 break;
5129 default:
5130 break;
5131 }
5132 mb_check(mb_push_value(s, l, arg));
5133
5134 return result;
5135 }
5136
_std_cos(mb_interpreter_t * s,void ** l)5137 int _std_cos(mb_interpreter_t* s, void** l) {
5138 /* Get the cos value of a number */
5139 int result = MB_FUNC_OK;
5140 mb_value_t arg;
5141
5142 mb_assert(s && l);
5143
5144 mb_check(mb_attempt_open_bracket(s, l));
5145
5146 mb_check(mb_pop_value(s, l, &arg));
5147
5148 mb_check(mb_attempt_close_bracket(s, l));
5149
5150 switch(arg.type) {
5151 case MB_DT_INT:
5152 arg.value.float_point = (real_t)cos((real_t)arg.value.integer);
5153 arg.type = MB_DT_REAL;
5154 break;
5155 case MB_DT_REAL:
5156 arg.value.float_point = (real_t)cos(arg.value.float_point);
5157 break;
5158 default:
5159 break;
5160 }
5161 mb_check(mb_push_value(s, l, arg));
5162
5163 return result;
5164 }
5165
_std_tan(mb_interpreter_t * s,void ** l)5166 int _std_tan(mb_interpreter_t* s, void** l) {
5167 /* Get the tan value of a number */
5168 int result = MB_FUNC_OK;
5169 mb_value_t arg;
5170
5171 mb_assert(s && l);
5172
5173 mb_check(mb_attempt_open_bracket(s, l));
5174
5175 mb_check(mb_pop_value(s, l, &arg));
5176
5177 mb_check(mb_attempt_close_bracket(s, l));
5178
5179 switch(arg.type) {
5180 case MB_DT_INT:
5181 arg.value.float_point = (real_t)tan((real_t)arg.value.integer);
5182 arg.type = MB_DT_REAL;
5183 break;
5184 case MB_DT_REAL:
5185 arg.value.float_point = (real_t)tan(arg.value.float_point);
5186 break;
5187 default:
5188 break;
5189 }
5190 mb_check(mb_push_value(s, l, arg));
5191
5192 return result;
5193 }
5194
_std_asin(mb_interpreter_t * s,void ** l)5195 int _std_asin(mb_interpreter_t* s, void** l) {
5196 /* Get the asin value of a number */
5197 int result = MB_FUNC_OK;
5198 mb_value_t arg;
5199
5200 mb_assert(s && l);
5201
5202 mb_check(mb_attempt_open_bracket(s, l));
5203
5204 mb_check(mb_pop_value(s, l, &arg));
5205
5206 mb_check(mb_attempt_close_bracket(s, l));
5207
5208 switch(arg.type) {
5209 case MB_DT_INT:
5210 arg.value.float_point = (real_t)asin((real_t)arg.value.integer);
5211 arg.type = MB_DT_REAL;
5212 break;
5213 case MB_DT_REAL:
5214 arg.value.float_point = (real_t)asin(arg.value.float_point);
5215 break;
5216 default:
5217 break;
5218 }
5219 mb_check(mb_push_value(s, l, arg));
5220
5221 return result;
5222 }
5223
_std_acos(mb_interpreter_t * s,void ** l)5224 int _std_acos(mb_interpreter_t* s, void** l) {
5225 /* Get the acos value of a number */
5226 int result = MB_FUNC_OK;
5227 mb_value_t arg;
5228
5229 mb_assert(s && l);
5230
5231 mb_check(mb_attempt_open_bracket(s, l));
5232
5233 mb_check(mb_pop_value(s, l, &arg));
5234
5235 mb_check(mb_attempt_close_bracket(s, l));
5236
5237 switch(arg.type) {
5238 case MB_DT_INT:
5239 arg.value.float_point = (real_t)acos((real_t)arg.value.integer);
5240 arg.type = MB_DT_REAL;
5241 break;
5242 case MB_DT_REAL:
5243 arg.value.float_point = (real_t)acos(arg.value.float_point);
5244 break;
5245 default:
5246 break;
5247 }
5248 mb_check(mb_push_value(s, l, arg));
5249
5250 return result;
5251 }
5252
_std_atan(mb_interpreter_t * s,void ** l)5253 int _std_atan(mb_interpreter_t* s, void** l) {
5254 /* Get the atan value of a number */
5255 int result = MB_FUNC_OK;
5256 mb_value_t arg;
5257
5258 mb_assert(s && l);
5259
5260 mb_check(mb_attempt_open_bracket(s, l));
5261
5262 mb_check(mb_pop_value(s, l, &arg));
5263
5264 mb_check(mb_attempt_close_bracket(s, l));
5265
5266 switch(arg.type) {
5267 case MB_DT_INT:
5268 arg.value.float_point = (real_t)atan((real_t)arg.value.integer);
5269 arg.type = MB_DT_REAL;
5270 break;
5271 case MB_DT_REAL:
5272 arg.value.float_point = (real_t)atan(arg.value.float_point);
5273 break;
5274 default:
5275 break;
5276 }
5277 mb_check(mb_push_value(s, l, arg));
5278
5279 return result;
5280 }
5281
_std_exp(mb_interpreter_t * s,void ** l)5282 int _std_exp(mb_interpreter_t* s, void** l) {
5283 /* Get the exp value of a number */
5284 int result = MB_FUNC_OK;
5285 mb_value_t arg;
5286
5287 mb_assert(s && l);
5288
5289 mb_check(mb_attempt_open_bracket(s, l));
5290
5291 mb_check(mb_pop_value(s, l, &arg));
5292
5293 mb_check(mb_attempt_close_bracket(s, l));
5294
5295 switch(arg.type) {
5296 case MB_DT_INT:
5297 arg.value.float_point = (real_t)exp((real_t)arg.value.integer);
5298 arg.type = MB_DT_REAL;
5299 break;
5300 case MB_DT_REAL:
5301 arg.value.float_point = (real_t)exp(arg.value.float_point);
5302 break;
5303 default:
5304 break;
5305 }
5306 mb_check(mb_push_value(s, l, arg));
5307
5308 return result;
5309 }
5310
_std_log(mb_interpreter_t * s,void ** l)5311 int _std_log(mb_interpreter_t* s, void** l) {
5312 /* Get the log value of a number */
5313 int result = MB_FUNC_OK;
5314 mb_value_t arg;
5315
5316 mb_assert(s && l);
5317
5318 mb_check(mb_attempt_open_bracket(s, l));
5319
5320 mb_check(mb_pop_value(s, l, &arg));
5321
5322 mb_check(mb_attempt_close_bracket(s, l));
5323
5324 switch(arg.type) {
5325 case MB_DT_INT:
5326 arg.value.float_point = (real_t)log((real_t)arg.value.integer);
5327 arg.type = MB_DT_REAL;
5328 break;
5329 case MB_DT_REAL:
5330 arg.value.float_point = (real_t)log(arg.value.float_point);
5331 break;
5332 default:
5333 break;
5334 }
5335 mb_check(mb_push_value(s, l, arg));
5336
5337 return result;
5338 }
5339
_std_asc(mb_interpreter_t * s,void ** l)5340 int _std_asc(mb_interpreter_t* s, void** l) {
5341 /* Get the ASCII code of a character */
5342 int result = MB_FUNC_OK;
5343 char* arg = 0;
5344
5345 mb_assert(s && l);
5346
5347 mb_check(mb_attempt_open_bracket(s, l));
5348
5349 mb_check(mb_pop_string(s, l, &arg));
5350
5351 mb_check(mb_attempt_close_bracket(s, l));
5352
5353 if(arg[0] == '\0') {
5354 result = MB_FUNC_ERR;
5355 goto _exit;
5356 }
5357 mb_check(mb_push_int(s, l, (int_t)arg[0]));
5358
5359 _exit:
5360 return result;
5361 }
5362
_std_chr(mb_interpreter_t * s,void ** l)5363 int _std_chr(mb_interpreter_t* s, void** l) {
5364 /* Get the character of an ASCII code */
5365 int result = MB_FUNC_OK;
5366 int_t arg = 0;
5367 char* chr = 0;
5368
5369 mb_assert(s && l);
5370
5371 mb_check(mb_attempt_open_bracket(s, l));
5372
5373 mb_check(mb_pop_int(s, l, &arg));
5374
5375 mb_check(mb_attempt_close_bracket(s, l));
5376
5377 chr = (char*)mb_malloc(2);
5378 memset(chr, 0, 2);
5379 chr[0] = (char)arg;
5380 mb_check(mb_push_string(s, l, chr));
5381
5382 return result;
5383 }
5384
_std_left(mb_interpreter_t * s,void ** l)5385 int _std_left(mb_interpreter_t* s, void** l) {
5386 /* Get a number of characters from the left of a string */
5387 int result = MB_FUNC_OK;
5388 char* arg = 0;
5389 int_t count = 0;
5390 char* sub = 0;
5391
5392 mb_assert(s && l);
5393
5394 mb_check(mb_attempt_open_bracket(s, l));
5395
5396 mb_check(mb_pop_string(s, l, &arg));
5397 mb_check(mb_pop_int(s, l, &count));
5398
5399 mb_check(mb_attempt_close_bracket(s, l));
5400
5401 if(count <= 0) {
5402 result = MB_FUNC_ERR;
5403 goto _exit;
5404 }
5405
5406 sub = (char*)mb_malloc(count + 1);
5407 memcpy(sub, arg, count);
5408 sub[count] = '\0';
5409 mb_check(mb_push_string(s, l, sub));
5410
5411 _exit:
5412 return result;
5413 }
5414
_std_len(mb_interpreter_t * s,void ** l)5415 int _std_len(mb_interpreter_t* s, void** l) {
5416 /* Get the length of a string */
5417 int result = MB_FUNC_OK;
5418 char* arg = 0;
5419
5420 mb_assert(s && l);
5421
5422 mb_check(mb_attempt_open_bracket(s, l));
5423
5424 mb_check(mb_pop_string(s, l, &arg));
5425
5426 mb_check(mb_attempt_close_bracket(s, l));
5427
5428 mb_check(mb_push_int(s, l, (int_t)strlen(arg)));
5429
5430 return result;
5431 }
5432
_std_mid(mb_interpreter_t * s,void ** l)5433 int _std_mid(mb_interpreter_t* s, void** l) {
5434 /* Get a number of characters from a given position of a string */
5435 int result = MB_FUNC_OK;
5436 char* arg = 0;
5437 int_t start = 0;
5438 int_t count = 0;
5439 char* sub = 0;
5440
5441 mb_assert(s && l);
5442
5443 mb_check(mb_attempt_open_bracket(s, l));
5444
5445 mb_check(mb_pop_string(s, l, &arg));
5446 mb_check(mb_pop_int(s, l, &start));
5447 mb_check(mb_pop_int(s, l, &count));
5448
5449 mb_check(mb_attempt_close_bracket(s, l));
5450
5451 if(count <= 0 || start < 0 || start >= (int_t)strlen(arg)) {
5452 result = MB_FUNC_ERR;
5453 goto _exit;
5454 }
5455
5456 sub = (char*)mb_malloc(count + 1);
5457 memcpy(sub, arg + start, count);
5458 sub[count] = '\0';
5459 mb_check(mb_push_string(s, l, sub));
5460
5461 _exit:
5462 return result;
5463 }
5464
_std_right(mb_interpreter_t * s,void ** l)5465 int _std_right(mb_interpreter_t* s, void** l) {
5466 /* Get a number of characters from the right of a string */
5467 int result = MB_FUNC_OK;
5468 char* arg = 0;
5469 int_t count = 0;
5470 char* sub = 0;
5471
5472 mb_assert(s && l);
5473
5474 mb_check(mb_attempt_open_bracket(s, l));
5475
5476 mb_check(mb_pop_string(s, l, &arg));
5477 mb_check(mb_pop_int(s, l, &count));
5478
5479 mb_check(mb_attempt_close_bracket(s, l));
5480
5481 if(count <= 0) {
5482 result = MB_FUNC_ERR;
5483 goto _exit;
5484 }
5485
5486 sub = (char*)mb_malloc(count + 1);
5487 memcpy(sub, arg + (strlen(arg) - count), count);
5488 sub[count] = '\0';
5489 mb_check(mb_push_string(s, l, sub));
5490
5491 _exit:
5492 return result;
5493 }
5494
_std_str(mb_interpreter_t * s,void ** l)5495 int _std_str(mb_interpreter_t* s, void** l) {
5496 /* Get the string format of a number */
5497 int result = MB_FUNC_OK;
5498 mb_value_t arg;
5499 char* chr = 0;
5500
5501 mb_assert(s && l);
5502
5503 mb_check(mb_attempt_open_bracket(s, l));
5504
5505 mb_check(mb_pop_value(s, l, &arg));
5506
5507 mb_check(mb_attempt_close_bracket(s, l));
5508
5509 chr = (char*)mb_malloc(32);
5510 memset(chr, 0, 32);
5511 if(arg.type == MB_DT_INT) {
5512 sprintf(chr, "%d", arg.value.integer);
5513 } else if(arg.type == MB_DT_REAL) {
5514 sprintf(chr, "%g", arg.value.float_point);
5515 } else {
5516 result = MB_FUNC_ERR;
5517 free(chr);
5518 goto _exit;
5519 }
5520 mb_check(mb_push_string(s, l, chr));
5521
5522 _exit:
5523 return result;
5524 }
5525
_std_val(mb_interpreter_t * s,void ** l)5526 int _std_val(mb_interpreter_t* s, void** l) {
5527 /* Get the number format of a string */
5528 int result = MB_FUNC_OK;
5529 char* conv_suc = 0;
5530 mb_value_t val;
5531 char* arg = 0;
5532
5533 mb_assert(s && l);
5534
5535 mb_check(mb_attempt_open_bracket(s, l));
5536
5537 mb_check(mb_pop_string(s, l, &arg));
5538
5539 mb_check(mb_attempt_close_bracket(s, l));
5540
5541 val.value.integer = (int_t)strtol(arg, &conv_suc, 0);
5542 if(*conv_suc == '\0') {
5543 val.type = MB_DT_INT;
5544 mb_check(mb_push_value(s, l, val));
5545 goto _exit;
5546 }
5547 val.value.float_point = (real_t)strtod(arg, &conv_suc);
5548 if(*conv_suc == '\0') {
5549 val.type = MB_DT_REAL;
5550 mb_check(mb_push_value(s, l, val));
5551 goto _exit;
5552 }
5553 result = MB_FUNC_ERR;
5554
5555 _exit:
5556 return result;
5557 }
5558
_std_print(mb_interpreter_t * s,void ** l)5559 int _std_print(mb_interpreter_t* s, void** l) {
5560 /* PRINT statement */
5561 int result = MB_FUNC_OK;
5562 _ls_node_t* ast = 0;
5563 _object_t* obj = 0;
5564 _running_context_t* running = 0;
5565
5566 _object_t val_obj;
5567 _object_t* val_ptr = 0;
5568
5569 mb_assert(s && l);
5570
5571 val_ptr = &val_obj;
5572 memset(val_ptr, 0, sizeof(_object_t));
5573
5574 running = (_running_context_t*)(s->running_context);
5575 ++running->no_eat_comma_mark;
5576 ast = (_ls_node_t*)(*l);
5577 ast = ast->next;
5578 if(!ast || !ast->data) {
5579 _handle_error_on_obj(s, SE_RN_SYNTAX, DON(ast), MB_FUNC_ERR, _exit, result);
5580 }
5581
5582 obj = (_object_t*)(ast->data);
5583 do {
5584 switch(obj->type) {
5585 case _DT_INT: /* Fall through */
5586 case _DT_REAL: /* Fall through */
5587 case _DT_STRING: /* Fall through */
5588 case _DT_VAR: /* Fall through */
5589 case _DT_ARRAY: /* Fall through */
5590 case _DT_FUNC:
5591 result = _calc_expression(s, &ast, &val_ptr);
5592 if(val_ptr->type == _DT_INT) {
5593 _get_printer(s)("%d", val_ptr->data.integer);
5594 } else if(val_ptr->type == _DT_REAL) {
5595 _get_printer(s)("%g", val_ptr->data.float_point);
5596 } else if(val_ptr->type == _DT_STRING) {
5597 _get_printer(s)("%s", (val_ptr->data.string ? val_ptr->data.string : _NULL_STRING));
5598 if(!val_ptr->ref) {
5599 safe_free(val_ptr->data.string);
5600 }
5601 }
5602 if(result != MB_FUNC_OK) {
5603 goto _exit;
5604 }
5605 /* Fall through */
5606 case _DT_SEP:
5607 if(!ast) {
5608 break;
5609 }
5610 obj = (_object_t*)(ast->data);
5611 #ifdef _COMMA_AS_NEWLINE
5612 if(obj->data.separator == ',') {
5613 #else /* _COMMA_AS_NEWLINE */
5614 if(obj->data.separator == ';') {
5615 #endif /* _COMMA_AS_NEWLINE */
5616 _get_printer(s)("\n");
5617 }
5618 break;
5619 default:
5620 _handle_error_on_obj(s, SE_RN_NOT_SUPPORTED, DON(ast), MB_FUNC_ERR, _exit, result);
5621 break;
5622 }
5623
5624 if(!ast) {
5625 break;
5626 }
5627 obj = (_object_t*)(ast->data);
5628 if(_is_print_terminal(s, obj)) {
5629 break;
5630 }
5631 if(obj->type == _DT_SEP && (obj->data.separator == ',' || obj->data.separator == ';')) {
5632 ast = ast->next;
5633 obj = (_object_t*)(ast->data);
5634 } else {
5635 _handle_error_on_obj(s, SE_RN_COMMA_OR_SEMICOLON_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
5636 }
5637 } while(ast && !(obj->type == _DT_SEP && obj->data.separator == ':') && (obj->type == _DT_SEP || !_is_expression_terminal(s, obj)));
5638
5639 _exit:
5640 --running->no_eat_comma_mark;
5641
5642 *l = ast;
5643 if(result != MB_FUNC_OK) {
5644 _get_printer(s)("\n");
5645 }
5646
5647 return result;
5648 }
5649
5650 int _std_input(mb_interpreter_t* s, void** l) {
5651 /* INPUT statement */
5652 int result = MB_FUNC_OK;
5653 _ls_node_t* ast = 0;
5654 _object_t* obj = 0;
5655 char line[256];
5656 char* conv_suc = 0;
5657
5658 mb_assert(s && l);
5659
5660 mb_check(mb_attempt_func_begin(s, l));
5661 mb_check(mb_attempt_func_end(s, l));
5662
5663 ast = (_ls_node_t*)(*l);
5664 obj = (_object_t*)(ast->data);
5665
5666 if(!obj || obj->type != _DT_VAR) {
5667 _handle_error_on_obj(s, SE_RN_VARIABLE_EXPECTED, DON(ast), MB_FUNC_ERR, _exit, result);
5668 }
5669 if(obj->data.variable->data->type == _DT_INT || obj->data.variable->data->type == _DT_REAL) {
5670 if(!fgets(line, sizeof(line), stdin)) {
5671 result = MB_FUNC_ERR;
5672 goto _exit;
5673 }
5674 obj->data.variable->data->type = _DT_INT;
5675 obj->data.variable->data->data.integer = (int_t)strtol(line, &conv_suc, 0);
5676 if(*conv_suc != '\0') {
5677 obj->data.variable->data->type = _DT_REAL;
5678 obj->data.variable->data->data.float_point = (real_t)strtod(line, &conv_suc);
5679 if(*conv_suc != '\0') {
5680 result = MB_FUNC_ERR;
5681 goto _exit;
5682 }
5683 }
5684 } else if(obj->data.variable->data->type == _DT_STRING) {
5685 if(obj->data.variable->data->data.string) {
5686 safe_free(obj->data.variable->data->data.string);
5687 }
5688 obj->data.variable->data->data.string = (char*)mb_malloc(256);
5689 memset(obj->data.variable->data->data.string, 0, 256);
5690 if(fgets(line, sizeof(line), stdin)) {
5691 strcpy(obj->data.variable->data->data.string, line);
5692 } else {
5693 result = MB_FUNC_ERR;
5694 goto _exit;
5695 }
5696 } else {
5697 result = MB_FUNC_ERR;
5698 goto _exit;
5699 }
5700
5701 _exit:
5702 *l = ast;
5703
5704 return result;
5705 }
5706
5707 /* ========================================================} */
5708
5709 #ifdef MB_COMPACT_MODE
5710 # pragma pack()
5711 #endif /* MB_COMPACT_MODE */
5712
5713 #ifdef _MSC_VER
5714 # pragma warning(pop)
5715 #endif /* _MSC_VER */
5716
5717 #ifdef __cplusplus
5718 }
5719 #endif /* __cplusplus */
5720