43#ifndef MLISP_TOKEN_SZ_MAX
44# define MLISP_TOKEN_SZ_MAX 4096
47#ifndef MLISP_EXEC_TRACE_LVL
48# define MLISP_EXEC_TRACE_LVL 0
51#ifndef MLISP_STEP_TRACE_LVL
52# define MLISP_STEP_TRACE_LVL 0
55#ifndef MLISP_CMP_TRACE_LVL
56# define MLISP_CMP_TRACE_LVL 0
59#ifndef MLISP_ENV_TRACE_LVL
60# define MLISP_ENV_TRACE_LVL 0
63#ifndef MLISP_LOCK_TRACE_LVL
64# define MLISP_LOCK_TRACE_LVL 0
67#ifndef MLISP_STACK_TRACE_LVL
68# define MLISP_STACK_TRACE_LVL 0
71#define MLISP_ENV_FLAG_BUILTIN 0x02
74#define MLISP_ENV_FLAG_CMP_GT 0x10
77#define MLISP_ENV_FLAG_CMP_LT 0x20
80#define MLISP_ENV_FLAG_CMP_EQ 0x40
83#define MLISP_ENV_FLAG_ARI_ADD 0x10
86#define MLISP_ENV_FLAG_ARI_MUL 0x20
88#define MLISP_ENV_FLAG_ARI_DIV 0x40
90#define MLISP_ENV_FLAG_ARI_MOD 0x80
92#define MLISP_ENV_FLAG_ANO_OR 0x10
94#define MLISP_ENV_FLAG_ANO_AND 0x20
97#define MLISP_ENV_FLAG_DEFINE_GLOBAL 0x10
99#define MLISP_AUTOLOCK_EXEC_ENV 0x01
101#define MLISP_AUTOLOCK_CHILD_IDX 0x02
103#define MLISP_AUTOLOCK_VISIT_CT 0x04
105#define MLISP_AUTOLOCK_PARSER_AST 0x08
107#define MLISP_AUTOLOCK_GLOBAL_ENV 0x10
118#define MLISP_STACK_FLAG_PEEK 0x01
123#define mlisp_stack_pop( exec, o ) mlisp_stack_pop_ex( exec, o, 0 )
133#define mlisp_stack_push( exec, i, ctype ) \
134 (_mlisp_stack_push_ ## ctype( exec, (ctype)i ))
136#if defined( MLISP_DUMP_ENABLED ) || defined( DOCUMENTATION )
159#if defined( MLISP_DUMP_ENABLED ) || defined( DOCUMENTATION )
180 const char* token,
size_t token_sz, uint8_t env_type,
const void* data,
181 uint8_t global, uint8_t flags );
209 const char* lambda );
230#define _MLISP_TYPE_TABLE_PUSH_PROTO( idx, ctype, name, const_name, fmt ) \
231 MERROR_RETVAL _mlisp_stack_push_ ## ctype( \
232 struct MLISP_EXEC_STATE* exec, ctype i );
238#define mlisp_ast_has_ready_children( exec_child_idx, n ) \
239 ((exec_child_idx) < (n)->ast_idx_children_sz)
243uint16_t g_mlispe_last_uid = 0;
269 uint8_t mask, uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX]
274 maug_mzero( autolock, MLISP_EXEC_ENV_FRAME_CT_MAX );
277 if( MLISP_AUTOLOCK_EXEC_ENV == (MLISP_AUTOLOCK_EXEC_ENV & mask) ) {
278 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
279 if( !mdata_table_is_locked( &(exec->
env[env_iter]) ) ) {
280#if MLISP_LOCK_TRACE_LVL > 0
281 debug_printf( MLISP_LOCK_TRACE_LVL,
282 "%u: engaging autolock for exec env frame %d...",
283 exec->uid, env_iter );
285 mdata_table_lock( &(exec->
env[env_iter]) );
286 autolock[env_iter] |= MLISP_AUTOLOCK_EXEC_ENV;
291 MLISP_AUTOLOCK_CHILD_IDX == (MLISP_AUTOLOCK_CHILD_IDX & mask) &&
294#if MLISP_LOCK_TRACE_LVL > 0
295 debug_printf( MLISP_LOCK_TRACE_LVL,
296 "%u: engaging autolock for exec per-node child index...", exec->uid );
299 autolock[0] |= MLISP_AUTOLOCK_CHILD_IDX;
302 MLISP_AUTOLOCK_VISIT_CT == (MLISP_AUTOLOCK_VISIT_CT & mask) &&
305#if MLISP_LOCK_TRACE_LVL > 0
306 debug_printf( MLISP_LOCK_TRACE_LVL,
307 "%u: engaging autolock for per-node visit count...", exec->uid );
310 autolock[0] |= MLISP_AUTOLOCK_VISIT_CT;
313 MLISP_AUTOLOCK_PARSER_AST == (MLISP_AUTOLOCK_PARSER_AST & mask) &&
314 !mdata_vector_is_locked( &(parser->ast) )
316#if MLISP_LOCK_TRACE_LVL > 0
317 debug_printf( MLISP_LOCK_TRACE_LVL,
318 "%u: engaging autolock for parser AST...", exec->uid );
321 autolock[0] |= MLISP_AUTOLOCK_PARSER_AST;
324 MLISP_AUTOLOCK_GLOBAL_ENV == (MLISP_AUTOLOCK_GLOBAL_ENV & mask) &&
325 NULL != exec->global_env &&
326 0 < mdata_table_ct( exec->global_env ) &&
327 !mdata_table_is_locked( exec->global_env )
329#if MLISP_LOCK_TRACE_LVL > 0
330 debug_printf( MLISP_LOCK_TRACE_LVL,
331 "%u: engaging autolock for global env...", exec->uid );
333 mdata_table_lock( exec->global_env );
334 autolock[0] |= MLISP_AUTOLOCK_GLOBAL_ENV;
343static void _mlisp_autounlock(
345 uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX]
348 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
350 MLISP_AUTOLOCK_EXEC_ENV ==
351 (MLISP_AUTOLOCK_EXEC_ENV & autolock[env_iter])
353 mdata_table_unlock( &(exec->
env[env_iter]) );
356 if( MLISP_AUTOLOCK_CHILD_IDX == (MLISP_AUTOLOCK_CHILD_IDX & autolock[0]) ) {
359 if( MLISP_AUTOLOCK_VISIT_CT == (MLISP_AUTOLOCK_VISIT_CT & autolock[0]) ) {
363 MLISP_AUTOLOCK_PARSER_AST == (MLISP_AUTOLOCK_PARSER_AST & autolock[0])
368 MLISP_AUTOLOCK_GLOBAL_ENV == (MLISP_AUTOLOCK_GLOBAL_ENV & autolock[0])
370 mdata_table_unlock( exec->global_env );
380#ifdef MLISP_DUMP_ENABLED
389# define _MLISP_TYPE_TABLE_DUMPS( idx, ctype, name, const_name, fmt ) \
390 } else if( MLISP_TYPE_ ## const_name == n_stack->type ) { \
391 debug_printf( MLISP_STACK_TRACE_LVL, \
392 "%u: " MLISP_TRACE_SIGIL " stack " SIZE_T_FMT " (" #const_name "): " fmt, \
393 exec->uid, i, n_stack->value.name );
396 mdata_strpool_lock( &(parser->strpool) ); \
401 if( MLISP_TYPE_STR == n_stack->type ) {
403 "%u: " MLISP_TRACE_SIGIL
" stack " SIZE_T_FMT
" (STR): %s",
405 &(parser->strpool), n_stack->value.strpool_idx ) );
407 }
else if( MLISP_TYPE_CB == n_stack->type ) {
409 "%u: " MLISP_TRACE_SIGIL
" stack " SIZE_T_FMT
" (CB): %p",
410 exec->uid, i, n_stack->value.cb );
412 }
else if( MLISP_TYPE_LAMBDA == n_stack->type ) {
414 "%u: " MLISP_TRACE_SIGIL
" stack " SIZE_T_FMT
" (LAMBDA): "
416 exec->uid, i, n_stack->value.lambda );
432 }
else if( MLISP_TYPE_BEGIN == n_stack->type ) {
434 "%u: " MLISP_TRACE_SIGIL
" stack " SIZE_T_FMT
" (BEGIN): "
436 exec->uid, i, n_stack->value.begin );
441 error_printf(
"invalid stack type: %u", n_stack->type );
445 mdata_strpool_unlock( &(parser->strpool) );
450 assert( mdata_strpool_is_locked( &(parser->strpool) ) );
459#define _MLISP_TYPE_TABLE_PUSH( idx, ctype, name, const_name, fmt ) \
460 MERROR_RETVAL _mlisp_stack_push_ ## ctype( \
461 struct MLISP_EXEC_STATE* exec, ctype i \
463 ssize_t stack_idx = 0; \
464 struct MLISP_STACK_NODE n_stack; \
465 MERROR_RETVAL retval = MERROR_OK; \
466 debug_printf( MLISP_STACK_TRACE_LVL, \
467 "%u: pushing " #const_name " onto stack: " fmt, exec->uid, i ); \
468 n_stack.type = MLISP_TYPE_ ## const_name; \
469 n_stack.value.name = i; \
470 stack_idx = mdata_vector_append( \
471 &(exec->stack), &n_stack, sizeof( struct MLISP_STACK_NODE ) ); \
472 if( 0 > stack_idx ) { \
473 retval = mdata_retval( stack_idx ); \
499 n_stack = mdata_vector_get(
501 assert( NULL != n_stack );
506#if MLISP_STACK_TRACE_LVL > 0
507# define _MLISP_TYPE_TABLE_POPD( idx, ctype, name, const_name, fmt ) \
508 } else if( MLISP_TYPE_ ## const_name == o->type ) { \
509 if( MLISP_STACK_FLAG_PEEK == (MLISP_STACK_FLAG_PEEK & flags) ) { \
510 debug_printf( MLISP_STACK_TRACE_LVL, \
511 "%u: peeking (%ut): " SSIZE_T_FMT ": " fmt, \
512 exec->uid, n_idx, o->type, o->value.name ); \
514 debug_printf( MLISP_STACK_TRACE_LVL, \
515 "%u: popping (%ut): " SSIZE_T_FMT ": " fmt, \
516 exec->uid, n_idx, o->type, o->value.name ); \
539#if defined( MLISP_DUMP_ENABLED )
543 void* cb_data,
size_t cb_data_sz,
size_t idx
552# define _MLISP_TYPE_TABLE_DUMPE( idx, ctype, name, const_name, fmt ) \
553 } else if( MLISP_TYPE_ ## const_name == e->type ) { \
555 "%u: " MLISP_TRACE_SIGIL " env \"%s\" (" #const_name "): " fmt, \
556 exec->uid, key->string, e->value.name );
558 if( MLISP_ENV_FLAG_BUILTIN == (MLISP_ENV_FLAG_BUILTIN & e->flags) ) {
563 debug_printf( 1,
"%s: %p: 0x%02x", key, e, e->type );
568 }
else if( MLISP_TYPE_STR == e->type ) {
570 "%u: " MLISP_TRACE_SIGIL
" env \"%s\" (STR): %s",
574 }
else if( MLISP_TYPE_CB == e->type ) {
576 "%u: " MLISP_TRACE_SIGIL
" env \"%s\" (CB): %p",
577 exec->uid, key, e->value.cb );
579 }
else if( MLISP_TYPE_LAMBDA == e->type ) {
581 "%u: " MLISP_TRACE_SIGIL
" env \"%s\" (LAMBDA): " SIZE_T_FMT,
582 exec->uid, key, e->value.lambda );
585 error_printf( MLISP_TRACE_SIGIL
" invalid env type: %u", e->type );
598 uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX];
600 retval = _mlisp_autolock(
601 NULL, exec, MLISP_AUTOLOCK_EXEC_ENV | MLISP_AUTOLOCK_GLOBAL_ENV,
603 maug_cleanup_if_not_ok();
606 debug_printf( 1,
"# global env:" );
607 retval = mdata_table_iter(
608 exec->global_env, _mlisp_env_dump_iter, exec, 0 );
610 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
611 debug_printf( 1,
"# env frame %d:", env_iter );
612 retval = mdata_table_iter(
613 &(exec->
env[env_iter]), _mlisp_env_dump_iter, exec, 0 );
614 maug_cleanup_if_not_ok();
620 _mlisp_autounlock( NULL, exec, autolock );
637 while( 0 <= env_iter ) {
638 env = &(exec->
env[env_iter]);
644 assert( mdata_table_is_locked( env ) );
659 if( NULL != exec->global_env ) {
660 assert( mdata_table_is_locked( exec->global_env ) );
661 e = mdata_table_get( exec->global_env, key,
struct MLISP_ENV_NODE );
666 if( MERROR_OK != retval ) {
680 uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX];
686 maug_mzero( autolock, MLISP_EXEC_ENV_FRAME_CT_MAX );
688 while( 0 <= env_iter ) {
689#if MLISP_ENV_TRACE_LVL > 0
690 debug_printf( MLISP_ENV_TRACE_LVL,
691 "%u: attempting to undefine %s in frame %d...",
692 exec->uid, token, env_iter );
695 env = &(exec->
env[env_iter]);
697 if( !mdata_table_is_locked( env ) ) {
698 mdata_table_lock( env );
699 autolock[env_iter] |= 0x02;
702 retval = mdata_table_unset( env, token );
707 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
708 if( 0x02 == (0x02 & autolock[env_iter]) ) {
709 env = &(exec->
env[env_iter]);
710 assert( mdata_table_is_locked( env ) );
711 mdata_table_unlock( env );
722 const char* token,
size_t token_sz, uint8_t env_type,
const void* data,
723 uint8_t global, uint8_t flags
731 (MLISP_ENV_FLAG_BUILTIN != (MLISP_ENV_FLAG_BUILTIN & flags)) ||
737 if( NULL != exec->global_env ) {
738 env = exec->global_env;
740 error_printf(
"global env requested but not present!" );
741 retval = MERROR_EXEC;
746 if( 0 == token_sz ) {
747 token_sz = maug_strlen( token );
750 assert( NULL != env );
751 assert( 0 < token_sz );
753 assert( !mdata_table_is_locked( env ) );
757 mdata_table_unset( env, token );
759#if MLISP_ENV_TRACE_LVL > 0
760# define _MLISP_TYPE_TABLE_ASGN( idx, ctype, name, const_name, fmt ) \
762 debug_printf( MLISP_ENV_TRACE_LVL, \
763 "%u: setting env %d: \"%s\": #" fmt, \
764 exec->uid, exec->env_select, token, (ctype)*((ctype*)data) ); \
765 e.value.name = *((ctype*)data); \
768# define _MLISP_TYPE_TABLE_ASGN( idx, ctype, name, const_name, fmt ) \
770 e.value.name = *((ctype*)data); \
777 maug_cleanup_if_not_ok();
786#if MLISP_ENV_TRACE_LVL > 0
787 debug_printf( MLISP_ENV_TRACE_LVL,
788 "%u: setting env %d: \"%s\": strpool(" SSIZE_T_FMT
")",
789 exec->uid, exec->
env_select, token, *((ssize_t*)data) );
791 e.value.strpool_idx = *((mdata_strpool_idx_t*)data);
795#if MLISP_ENV_TRACE_LVL > 0
796 debug_printf( MLISP_ENV_TRACE_LVL,
797 "%u: setting env %d: \"%s\": 0x%p",
804#if MLISP_ENV_TRACE_LVL > 0
805 debug_printf( MLISP_ENV_TRACE_LVL,
806 "%u: setting env %d: \"%s\": node #" SSIZE_T_FMT,
807 exec->uid, exec->
env_select, token, *((mlisp_lambda_t*)data) );
809 e.value.lambda = *((mlisp_lambda_t*)data);
824 "%u: underflow %s: missing lambda arg?",
830 error_printf(
"invalid type: %d", env_type );
831 retval = MERROR_EXEC;
835 retval = mdata_table_set( env, token, &e,
sizeof(
struct MLISP_ENV_NODE ) );
846 size_t args_c,
void* cb_data, uint8_t flags
859 volatile int* cur_int = NULL;
861 mdata_strpool_lock( &(parser->strpool) );
865#if MLISP_EXEC_TRACE_LVL > 0
866# define _MLISP_TYPE_TABLE_CMP( idx, ctype, name, const_name, fmt ) \
867 } else if( MLISP_TYPE_ ## const_name == tmp.type ) { \
868 *cur_int = (int)tmp.value.name; \
869 debug_printf( MLISP_EXEC_TRACE_LVL, \
870 "%u: cmp: pop " fmt " (%d)", exec->uid, tmp.value.name, *cur_int );
872# define _MLISP_TYPE_TABLE_CMP( idx, ctype, name, const_name, fmt ) \
873 } else if( MLISP_TYPE_ ## const_name == tmp.type ) { \
874 *cur_int = (int)tmp.value.name;
878 maug_cleanup_if_not_ok();
880 if( MLISP_TYPE_STR == tmp.type ) {
882 a_type = MLISP_TYPE_STR;
886 error_printf(
"cmp: invalid type: %d", tmp.type );
887 retval = MERROR_EXEC;
892 maug_cleanup_if_not_ok();
894 if( MLISP_TYPE_STR == tmp.type ) {
896 b_type = MLISP_TYPE_STR;
900 error_printf(
"cmp: invalid type!" );
901 retval = MERROR_EXEC;
906 if( MLISP_TYPE_STR == a_type || MLISP_TYPE_STR == b_type ) {
915#if MLISP_EXEC_TRACE_LVL > 0
916 debug_printf( MLISP_EXEC_TRACE_LVL,
"%u: cmp %d > %d",
917 exec->uid, a_int, b_int );
919 truth = a_int > b_int;
921#if MLISP_EXEC_TRACE_LVL > 0
922 debug_printf( MLISP_EXEC_TRACE_LVL,
"%u: cmp %d < %d",
923 exec->uid, a_int, b_int );
925 truth = a_int < b_int;
927#if MLISP_EXEC_TRACE_LVL > 0
928 debug_printf( MLISP_EXEC_TRACE_LVL,
"%u: cmp %d == %d",
929 exec->uid, a_int, b_int );
931 truth = a_int == b_int;
933 error_printf(
"invalid parameter provided to _mlisp_env_cb_cmp()!" );
934 retval = MERROR_EXEC;
942 mdata_strpool_unlock( &(parser->strpool) );
951 size_t args_c,
void* cb_data, uint8_t flags
959# define _MLISP_TYPE_TABLE_ARI1( idx, ctype, name, const_name, fmt ) \
960 } else if( MLISP_TYPE_ ## const_name == num.type ) { \
961 num_out = num.value.name;
964 maug_cleanup_if_not_ok();
969 error_printf(
"arithmetic: invalid type!" );
970 retval = MERROR_EXEC;
974# define _MLISP_TYPE_TABLE_ARI2( idx, ctype, name, const_name, fmt ) \
976 MLISP_TYPE_ ## const_name == num.type && \
977 MLISP_ENV_FLAG_ARI_ADD == (MLISP_ENV_FLAG_ARI_ADD & flags) \
979 debug_printf( MLISP_EXEC_TRACE_LVL, \
980 "%u: arithmetic: %d + " fmt, exec->uid, num_out, num.value.name ); \
981 num_out += num.value.name; \
983 MLISP_TYPE_ ## const_name == num.type && \
984 MLISP_ENV_FLAG_ARI_MUL == (MLISP_ENV_FLAG_ARI_MUL & flags) \
986 debug_printf( MLISP_EXEC_TRACE_LVL, \
987 "%u: arithmetic: %d * " fmt, exec->uid, num_out, num.value.name ); \
988 num_out *= num.value.name; \
990 MLISP_TYPE_ ## const_name == num.type && \
991 MLISP_ENV_FLAG_ARI_DIV == (MLISP_ENV_FLAG_ARI_DIV & flags) \
993 debug_printf( MLISP_EXEC_TRACE_LVL, \
994 "%u: arithmetic: %d / " fmt, exec->uid, num_out, num.value.name ); \
995 num_out /= num.value.name; \
997 for( i = 0 ; args_c - 1 > i ; i++ ) {
999 maug_cleanup_if_not_ok();
1005 MLISP_TYPE_INT == num.type &&
1006 MLISP_ENV_FLAG_ARI_MOD == (MLISP_ENV_FLAG_ARI_MOD & flags)
1009 debug_printf( MLISP_EXEC_TRACE_LVL,
1010 "%u: arithmetic: %d %% %d", exec->uid, num_out, num.value.integer );
1011 num_out %= num.value.integer;
1013 error_printf(
"arithmetic: invalid type!" );
1014 retval = MERROR_EXEC;
1019 debug_printf( MLISP_EXEC_TRACE_LVL,
1020 "%u: arithmetic result: %d", exec->uid, num_out );
1026 mdata_strpool_unlock( &(parser->strpool) );
1035 size_t args_c,
void* cb_data, uint8_t flags
1041 maug_cleanup_if_not_ok();
1043# define _MLISP_TYPE_TABLE_DBG( idx, ctype, name, const_name, fmt ) \
1044 } else if( idx == val.type ) { \
1045 debug_printf( 2, fmt, val.value.name ); \
1047 if( MLISP_TYPE_STR == val.type ) {
1049 &(parser->strpool), val.value.strpool_idx ) );
1062 size_t args_c,
void* cb_data, uint8_t flags
1067 MAUG_MHANDLE key_tmp_h = (MAUG_MHANDLE)NULL;
1068 char* key_tmp = NULL;
1071#if MLISP_EXEC_TRACE_LVL > 0
1072 debug_printf( MLISP_EXEC_TRACE_LVL,
"%u: entering define callback...",
1077 maug_cleanup_if_not_ok();
1080 maug_cleanup_if_not_ok();
1082 if( MLISP_TYPE_STR != key.type ) {
1085 error_printf(
"define: invalid key type: %d", key.type );
1086 retval = MERROR_EXEC;
1090#if MLISP_EXEC_TRACE_LVL > 0
1091 debug_printf( MLISP_EXEC_TRACE_LVL,
1092 "%u: extracting define term for idx: " SIZE_T_FMT,
1093 exec->uid, key.value.strpool_idx );
1097 &(parser->strpool), key.value.strpool_idx );
1099 assert( (MAUG_MHANDLE)NULL != key_tmp_h );
1101 maug_mlock( key_tmp_h, key_tmp );
1102 maug_cleanup_if_null_lock(
char*, key_tmp );
1104#if MLISP_EXEC_TRACE_LVL > 0
1105 debug_printf( MLISP_EXEC_TRACE_LVL,
1106 "%u: define \"%s\" (strpool(" SIZE_T_FMT
"))...",
1107 exec->uid, key_tmp, key.value.strpool_idx );
1114#if MLISP_EXEC_TRACE_LVL > 0
1115 debug_printf( MLISP_EXEC_TRACE_LVL,
1116 "%u: using global env...", exec->uid );
1122 retval = mlisp_env_set(
1123 exec, key_tmp, maug_strlen( key_tmp ), val.type, &(val.value),
1125 maug_cleanup_if_not_ok();
1127#if MLISP_EXEC_TRACE_LVL > 0
1128 debug_printf( MLISP_EXEC_TRACE_LVL,
1129 "%u: setup env node: %s",
1130 exec->uid, key_tmp );
1135 if( NULL != key_tmp ) {
1136 maug_munlock( key_tmp_h, key_tmp );
1139 if( (MAUG_MHANDLE)NULL != key_tmp_h ) {
1140 maug_mfree( key_tmp_h );
1150 size_t args_c,
void* cb_data, uint8_t flags
1153 size_t* p_if_child_idx = NULL;
1157#if MLISP_STEP_TRACE_LVL > 0
1158 debug_printf( MLISP_STEP_TRACE_LVL,
1159 "%u: qrqrqrqrqr STEP IF qrqrqrqrqr", exec->uid );
1164 p_if_child_idx = mdata_vector_get(
1166 assert( NULL != p_if_child_idx );
1167#if MLISP_STEP_TRACE_LVL > 0
1168 debug_printf( MLISP_STEP_TRACE_LVL,
1169 "%u: node " SIZE_T_FMT
" child idx: " SIZE_T_FMT,
1170 exec->uid, n_idx, *p_if_child_idx );
1173 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1175 if( 0 == *p_if_child_idx ) {
1177#if MLISP_STEP_TRACE_LVL > 0
1178 debug_printf( MLISP_STEP_TRACE_LVL,
1179 "%u: stepping into condition...", exec->uid );
1181 retval = _mlisp_step_iter(
1182 parser, n->ast_idx_children[*p_if_child_idx], exec );
1183#if MLISP_STEP_TRACE_LVL > 0
1184 debug_printf( MLISP_STEP_TRACE_LVL,
1185 "%u: ...stepped out of condition", exec->uid );
1189 if( MERROR_OK == retval ) {
1194 maug_cleanup_if_not_ok();
1195 if( MLISP_TYPE_BOOLEAN != s.type ) {
1196 error_printf(
"(if) can only evaluate boolean type!" );
1197 retval = MERROR_EXEC;
1202 retval = _mlisp_preempt(
1203 retval,
"if", parser, n_idx, exec,
1205 (1 - s.value.boolean) + 1 );
1208 }
else if( args_c > *p_if_child_idx ) {
1211#if MLISP_STEP_TRACE_LVL > 0
1212 debug_printf( MLISP_STEP_TRACE_LVL,
1213 "%u: descending into IF path: " SIZE_T_FMT,
1214 exec->uid, *p_if_child_idx );
1220 retval = _mlisp_step_iter(
1221 parser, n->ast_idx_children[*p_if_child_idx], exec );
1222 retval = _mlisp_preempt(
1223 retval,
"if", parser, n_idx, exec, 3 );
1228#if MLISP_STEP_TRACE_LVL > 0
1229 debug_printf( MLISP_STEP_TRACE_LVL,
1230 "%u: qrqrqrqrqr END STEP IF qrqrqrqrqr", exec->uid );
1238#ifndef MAUG_NO_RETRO
1244 size_t args_c,
void* cb_data, uint8_t flags
1248 int16_t random_int = 0;
1251 maug_cleanup_if_not_ok();
1253 if( MLISP_TYPE_INT != mod.type ) {
1255 error_printf(
"random: invalid modulus type: %d", mod.type );
1256 retval = MERROR_EXEC;
1260 random_int = retroflat_get_rand() % mod.value.integer;
1262#if MLISP_EXEC_TRACE_LVL > 0
1263 debug_printf( MLISP_EXEC_TRACE_LVL,
1264 "%u: random: %d", exec->uid, random_int );
1280 size_t args_c,
void* cb_data, uint8_t flags
1284 mlisp_bool_t val_out =
1286 MLISP_ENV_FLAG_ANO_OR == (MLISP_ENV_FLAG_ANO_OR & flags) ?
1294 for( i = 0 ; args_c > i ; i++ ) {
1296 maug_cleanup_if_not_ok();
1298 if( MLISP_TYPE_BOOLEAN != val.type ) {
1299 error_printf(
"or: invalid boolean type: %d", val.type );
1303 MLISP_ENV_FLAG_ANO_OR == (MLISP_ENV_FLAG_ANO_OR & flags) &&
1306#if MLISP_CMP_TRACE_LVL > 0
1307 debug_printf( MLISP_CMP_TRACE_LVL,
"%u: found TRUE in OR compare!",
1313 MLISP_ENV_FLAG_ANO_AND == (MLISP_ENV_FLAG_ANO_AND & flags) &&
1316#if MLISP_CMP_TRACE_LVL > 0
1317 debug_printf( MLISP_CMP_TRACE_LVL,
"%u: found FALSE in AND compare!",
1325#if MLISP_CMP_TRACE_LVL > 0
1326 debug_printf( MLISP_CMP_TRACE_LVL,
"compare result: %d", val_out );
1328 retval = _mlisp_stack_push_mlisp_bool_t( exec, val_out );
1346 size_t* p_child_idx = NULL;
1349 p_child_idx = mdata_vector_get(
1351 assert( NULL != p_child_idx );
1353 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1355 if( 0 < n->token_idx ) {
1356 mdata_strpool_lock( &(parser->strpool) );
1357#if MLISP_STEP_TRACE_LVL > 0
1358 debug_printf( MLISP_STEP_TRACE_LVL,
1359 "%u: eval step " SSIZE_T_FMT
" under (%s) %s...",
1360 exec->uid, *p_child_idx, caller,
1363 mdata_strpool_unlock( &(parser->strpool) );
1364#if MLISP_STEP_TRACE_LVL > 0
1366 debug_printf( MLISP_STEP_TRACE_LVL,
1367 "%u: eval step " SSIZE_T_FMT
" under (%s) (empty token)...",
1368 exec->uid, *p_child_idx, caller );
1372 if( MERROR_OK != retval ) {
1374#if MLISP_STEP_TRACE_LVL > 0
1375 debug_printf( MLISP_STEP_TRACE_LVL,
1376 "%u: not incrementing node " SIZE_T_FMT
" child idx from "
1377 SIZE_T_FMT
" (retval: 0x%x)!",
1378 exec->uid, n_idx, *p_child_idx, retval );
1387 (*p_child_idx) = new_idx;
1388#if MLISP_STEP_TRACE_LVL > 0
1389 debug_printf( MLISP_STEP_TRACE_LVL,
1390 "%u: incremented node " SIZE_T_FMT
" child idx to: " SIZE_T_FMT,
1391 exec->uid, n_idx, *p_child_idx );
1396 assert( !mdata_strpool_is_locked( &(parser->strpool) ) );
1407 size_t* p_child_idx = NULL;
1412 p_child_idx = mdata_vector_get(
1414 assert( NULL != p_child_idx );
1415#if MLISP_STEP_TRACE_LVL > 0
1416 debug_printf( MLISP_STEP_TRACE_LVL,
1417 "%u: node " SIZE_T_FMT
" child idx: " SIZE_T_FMT,
1418 exec->uid, n_idx, *p_child_idx );
1421 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1425 MLISP_AST_FLAG_LAMBDA == (MLISP_AST_FLAG_LAMBDA & n->flags) &&
1428 MLISP_AST_FLAG_IF == (MLISP_AST_FLAG_IF & n->flags)
1437#if MLISP_STEP_TRACE_LVL > 0
1438 debug_printf( MLISP_STEP_TRACE_LVL,
1439 "%u: skipping lambda children...", exec->uid );
1444 if( mlisp_ast_has_ready_children( *p_child_idx, n ) ) {
1448 MLISP_AST_FLAG_DEFINE == (MLISP_AST_FLAG_DEFINE & n->flags) &&
1452#if MLISP_EXEC_TRACE_LVL > 0
1453 debug_printf( MLISP_EXEC_TRACE_LVL,
1454 "%u: setting MLISP_EXEC_FLAG_DEF_TERM!", exec->uid );
1458 exec->
flags &= ~MLISP_EXEC_FLAG_DEF_TERM;
1462 retval = _mlisp_step_iter(
1463 parser, n->ast_idx_children[*p_child_idx], exec );
1464 retval = _mlisp_preempt(
1465 retval,
"node", parser, n_idx, exec, (*p_child_idx) + 1 );
1480 ssize_t arg_idx = 0;
1483 MAUG_MHANDLE key_tmp_h = (MAUG_MHANDLE)NULL;
1484 char* key_tmp = NULL;
1486 int16_t null_val = 0;
1494 if( MLISP_EXEC_ENV_FRAME_CT_MAX > exec->
env_select + 1 ) {
1496#if MLISP_EXEC_TRACE_LVL > 0
1497 debug_printf( MLISP_EXEC_TRACE_LVL,
"selecting env frame: %d",
1500 assert( 0 == mdata_table_ct( &(exec->
env[exec->
env_select]) ) );
1503 retval = mlisp_env_set(
1504 exec,
"null", 4, MLISP_TYPE_INT, &null_val, 0, 0 );
1506 error_printf(
"env frame overflow!" );
1507 retval = MERROR_OVERFLOW;
1512 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1515 while( 0 <= arg_idx ) {
1518 maug_cleanup_if_not_ok();
1520 ast_n_arg = mdata_vector_get(
1521 &(parser->ast), n->ast_idx_children[arg_idx],
1526 &(parser->strpool), ast_n_arg->token_idx );
1528 assert( (MAUG_MHANDLE)NULL != key_tmp_h );
1530 maug_mlock( key_tmp_h, key_tmp );
1531 maug_cleanup_if_null_lock(
char*, key_tmp );
1533 retval = mlisp_env_set(
1534 exec, key_tmp, 0, stack_n_arg.type, &(stack_n_arg.value), 0, 0 );
1535 maug_cleanup_if_not_ok();
1537 maug_munlock( key_tmp_h, key_tmp );
1538 maug_mfree( key_tmp_h );
1545 if( NULL != key_tmp ) {
1546 maug_munlock( key_tmp_h, key_tmp );
1549 if( (MAUG_MHANDLE)NULL != key_tmp_h ) {
1550 maug_mfree( key_tmp_h );
1563 size_t* p_child_idx = NULL;
1564 size_t* p_visit_ct = NULL;
1569 assert( mdata_vector_is_locked( &(parser->ast) ) );
1572#if MLISP_STEP_TRACE_LVL > 0
1573 debug_printf( MLISP_STEP_TRACE_LVL,
1574 "%u: resetting node " SIZE_T_FMT
" child idx to 0", exec->uid, n_idx );
1577 assert( NULL != p_child_idx );
1580#if MLISP_STEP_TRACE_LVL > 0
1581 debug_printf( MLISP_STEP_TRACE_LVL,
1582 "%u: resetting node " SIZE_T_FMT
" visit count to 0", exec->uid, n_idx );
1585 assert( NULL != p_visit_ct );
1588 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1592 retval = _mlisp_reset_child_pcs( parser, n->ast_idx_children[i], exec );
1593 maug_cleanup_if_not_ok();
1609#if MLISP_EXEC_TRACE_LVL > 0
1610 debug_printf( MLISP_EXEC_TRACE_LVL,
1611 "%u: resetting lambda " SIZE_T_FMT
"...", exec->uid, n_idx );
1617 assert( !mdata_table_is_locked( &(exec->
env[exec->
env_select]) ) );
1623 retval = _mlisp_reset_child_pcs( parser, n_idx, exec );
1636 size_t* p_lambda_child_idx = NULL;
1637#if MLISP_STEP_TRACE_LVL > 0
1638 size_t* p_args_child_idx = NULL;
1641 size_t* p_n_last_lambda = NULL;
1642 ssize_t append_retval = 0;
1644#ifdef MLISP_DEBUG_TRACE
1645 exec->trace[exec->trace_depth++] = n_idx;
1646 assert( exec->trace_depth <= MLISP_DEBUG_TRACE );
1651 p_n_last_lambda = mdata_vector_get_last( &(exec->
lambda_trace),
size_t );
1653 if( NULL != p_n_last_lambda && n_idx == *p_n_last_lambda ) {
1657#if MLISP_STEP_TRACE_LVL > 0
1658 debug_printf( MLISP_STEP_TRACE_LVL,
"%u: TRACE TAIL TIME!", exec->uid );
1664 _mlisp_reset_lambda( parser, n_idx, exec );
1665 retval = mdata_vector_remove_last( &(exec->
lambda_trace) );
1666 maug_cleanup_if_not_ok();
1669#if MLISP_STEP_TRACE_LVL > 0
1670 debug_printf( MLISP_STEP_TRACE_LVL,
1671 "%u: xvxvxvxvxvxvx STEP LAMBDA " SIZE_T_FMT
" xvxvxvxvxvx",
1678 retval = mdata_retval( append_retval );
1679 maug_cleanup_if_not_ok();
1683 p_lambda_child_idx = mdata_vector_get(
1685 assert( NULL != p_lambda_child_idx );
1686#if MLISP_STEP_TRACE_LVL > 0
1687 debug_printf( MLISP_STEP_TRACE_LVL,
1688 "%u: lambda node " SIZE_T_FMT
" child idx: " SIZE_T_FMT,
1689 exec->uid, n_idx, *p_lambda_child_idx );
1692 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1698 if( 0 == *p_lambda_child_idx ) {
1703#if MLISP_STEP_TRACE_LVL > 0
1708 n->ast_idx_children[*p_lambda_child_idx],
size_t );
1709#if MLISP_STEP_TRACE_LVL > 0
1710 assert( NULL != p_args_child_idx );
1711 debug_printf( MLISP_STEP_TRACE_LVL,
1712 "%u: child idx for args AST node " SIZE_T_FMT
": " SIZE_T_FMT,
1713 exec->uid, *p_lambda_child_idx, *p_args_child_idx );
1717 retval = _mlisp_step_lambda_args(
1718 parser, n->ast_idx_children[*p_lambda_child_idx], exec );
1724 if( MERROR_OK == retval ) {
1733 (*p_lambda_child_idx)++;
1734#if MLISP_STEP_TRACE_LVL > 0
1735 debug_printf( MLISP_STEP_TRACE_LVL,
1736 "%u: incremented node " SIZE_T_FMT
" child idx to: " SIZE_T_FMT,
1737 exec->uid, n_idx, *p_lambda_child_idx );
1746 }
else if( mlisp_ast_has_ready_children( *p_lambda_child_idx, n ) ) {
1754 NULL == exec->global_env ||
1755 !mdata_table_is_locked( exec->global_env ) );
1757 retval = _mlisp_step_iter(
1758 parser, n->ast_idx_children[*p_lambda_child_idx], exec );
1760 retval = _mlisp_preempt(
1761 retval,
"lambda", parser, n_idx, exec, (*p_lambda_child_idx) + 1 );
1768 NULL == exec->global_env ||
1769 !mdata_table_is_locked( exec->global_env ) );
1770 _mlisp_reset_lambda( parser, n_idx, exec );
1777#if MLISP_STEP_TRACE_LVL > 0
1778 debug_printf( MLISP_STEP_TRACE_LVL,
1779 "%u: xvxvxvxvxvxvx END STEP LAMBDA " SIZE_T_FMT
" xvxvxvxvxvx",
1803 maug_cleanup_if_not_ok();
1805 if( MLISP_TYPE_BEGIN == o.type && n_idx == o.value.begin ) {
1829 char* strpool_token = NULL;
1835 NULL == exec->global_env ||
1836 mdata_table_is_locked( exec->global_env ) );
1838 mdata_strpool_lock( &(parser->strpool) );
1842 assert( NULL != strpool_token );
1844#if MLISP_EXEC_TRACE_LVL > 0
1845 debug_printf( MLISP_EXEC_TRACE_LVL,
1846 "%u: eval token: \"%s\" (strlen: " SIZE_T_FMT
"r/" SIZE_T_FMT
"d)",
1847 exec->uid, strpool_token, token_sz, maug_strlen( strpool_token ) );
1849 if( 0 == maug_strncmp( strpool_token,
"begin", token_sz + 1 ) ) {
1851 e_out->type = MLISP_TYPE_BEGIN;
1853 }
else if( NULL != (p_e = mlisp_env_get( exec, strpool_token ) ) ) {
1855#if MLISP_EXEC_TRACE_LVL > 0
1856 debug_printf( MLISP_EXEC_TRACE_LVL,
"%u: found %s in env!",
1857 exec->uid, strpool_token );
1865 }
else if( maug_is_num( strpool_token, token_sz, 10, 1 ) ) {
1867#if MLISP_EXEC_TRACE_LVL > 0
1868 debug_printf( MLISP_EXEC_TRACE_LVL,
1869 "%u: did not find %s in env, but it is a number...",
1870 exec->uid, strpool_token );
1872 e_out->value.integer = maug_atos32( strpool_token, token_sz );
1873 e_out->type = MLISP_TYPE_INT;
1875 }
else if( maug_is_float( strpool_token, token_sz ) ) {
1876#if MLISP_EXEC_TRACE_LVL > 0
1877 debug_printf( MLISP_EXEC_TRACE_LVL,
1878 "%u: did not find %s in env, but it is a float...",
1879 exec->uid, strpool_token );
1882 e_out->value.floating = maug_atof( strpool_token, token_sz );
1883 e_out->type = MLISP_TYPE_FLOAT;
1886#if MLISP_EXEC_TRACE_LVL > 0
1887 error_printf(
"%u: could not make sense of token: %s",
1888 exec->uid, strpool_token );
1895 if( mdata_strpool_is_locked( &(parser->strpool) ) ) {
1896 mdata_strpool_unlock( &(parser->strpool) );
1899#if MLISP_EXEC_TRACE_LVL > 0
1900 debug_printf( MLISP_EXEC_TRACE_LVL,
"%u: eval token complete!",
1914 size_t* p_visit_ct = NULL;
1916 uint8_t e_flags = 0;
1917 mlisp_lambda_t e_lambda = 0;
1918 int8_t env_iter = 0;
1924 volatile mdata_strpool_idx_t node_strpool_idx = 0;
1926#ifdef MLISP_DEBUG_TRACE
1927 exec->trace[exec->trace_depth++] = n_idx;
1928 assert( exec->trace_depth <= MLISP_DEBUG_TRACE );
1931 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1934 p_visit_ct = mdata_vector_get(
1936 assert( NULL != p_visit_ct );
1938#if MLISP_STEP_TRACE_LVL > 0
1939 debug_printf( MLISP_STEP_TRACE_LVL,
1940 "%u: visit count for AST node " SIZE_T_FMT
": " SIZE_T_FMT,
1941 exec->uid, n_idx, *p_visit_ct );
1946 MLISP_AST_FLAG_BEGIN == (MLISP_AST_FLAG_BEGIN & n->flags) &&
1950 retval = _mlisp_stack_push_mlisp_begin_t( exec, n_idx );
1951 maug_cleanup_if_not_ok();
1956 (retval = _mlisp_step_iter_children( parser, n_idx, exec ))
1962 if( MLISP_AST_FLAG_LAMBDA == (MLISP_AST_FLAG_LAMBDA & n->flags) ) {
1978 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
1979#if MLISP_LOCK_TRACE_LVL > 0
1980 debug_printf( MLISP_LOCK_TRACE_LVL,
1981 "%u: locking local env %d...", exec->uid, env_iter );
1983 mdata_table_lock( &(exec->
env[env_iter]) );
1987 NULL == exec->global_env || !mdata_table_is_locked( exec->global_env ) );
1988 if( NULL != exec->global_env ) {
1989 mdata_table_lock( exec->global_env );
1993 retval = _mlisp_eval_token_strpool(
1994 parser, exec, n->token_idx, n->token_sz, &e );
1995 maug_cleanup_if_not_ok();
1999#if MLISP_STEP_TRACE_LVL > 0
2000 debug_printf( MLISP_STEP_TRACE_LVL,
"%u: acting on evaluated token...",
2005# define _MLISP_TYPE_TABLE_ENVE( idx, ctype, name, const_name, fmt ) \
2006 } else if( MLISP_TYPE_ ## const_name == e.type ) { \
2007 debug_printf( MLISP_EXEC_TRACE_LVL, \
2008 "%u: pushing env: " fmt " to stack...", \
2009 exec->uid, e.value.name ); \
2010 retval = _mlisp_stack_push_ ## ctype( exec, e.value.name ); \
2011 maug_cleanup_if_not_ok();
2017#if MLISP_EXEC_TRACE_LVL > 0
2018 debug_printf( MLISP_EXEC_TRACE_LVL,
2019 "%u: special case! pushing literal to stack: " SSIZE_T_FMT,
2020 exec->uid, n->token_idx );
2022 node_strpool_idx = n->token_idx;
2023 retval = _mlisp_stack_push_mdata_strpool_idx_t( exec, node_strpool_idx );
2024 maug_cleanup_if_not_ok();
2025 }
else if( MLISP_TYPE_BEGIN == e.type ) {
2029#if MLISP_STEP_TRACE_LVL > 0
2030 debug_printf( MLISP_STEP_TRACE_LVL,
2031 "%u: rewinding stack for begin on node " SSIZE_T_FMT,
2034 retval = _mlisp_stack_cleanup( parser, n_idx, exec );
2035 maug_cleanup_if_not_ok();
2040 retval = _mlisp_stack_push_mlisp_begin_t( exec, n_idx );
2041 maug_cleanup_if_not_ok();
2043 }
else if( MLISP_TYPE_CB == e.type ) {
2049#if MLISP_EXEC_TRACE_LVL > 0
2050 debug_printf( MLISP_EXEC_TRACE_LVL,
2051 "%u: special case! executing callback: %p", exec->uid, e_cb );
2057 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2058 mdata_table_unlock( &(exec->
env[env_iter]) );
2060 if( NULL != exec->global_env ) {
2061 mdata_table_unlock( exec->global_env );
2068 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2069 mdata_table_lock( &(exec->
env[env_iter]) );
2071 if( NULL != exec->global_env ) {
2072 mdata_table_lock( exec->global_env );
2075 }
else if( MLISP_TYPE_LAMBDA == e.type ) {
2077#if MLISP_EXEC_TRACE_LVL > 0
2078 debug_printf( MLISP_EXEC_TRACE_LVL,
2079 "%u: special case! executing lambda...", exec->uid );
2087 e_lambda = e.value.lambda;
2088 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2089 mdata_table_unlock( &(exec->
env[env_iter]) );
2091 if( NULL != exec->global_env ) {
2092 mdata_table_unlock( exec->global_env );
2095 retval = _mlisp_step_lambda( parser, e_lambda, exec );
2098 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2099 mdata_table_lock( &(exec->
env[env_iter]) );
2101 if( NULL != exec->global_env ) {
2102 mdata_table_lock( exec->global_env );
2107#if MLISP_EXEC_TRACE_LVL > 0
2108 debug_printf( MLISP_EXEC_TRACE_LVL,
"pushing literal into stack" );
2110 retval = _mlisp_stack_push_mdata_strpool_idx_t( exec, n->token_idx );
2111 maug_cleanup_if_not_ok();
2116 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2117 mdata_table_unlock( &(exec->
env[env_iter]) );
2120 if( NULL != exec->global_env ) {
2121 mdata_table_unlock( exec->global_env );
2131 void* cb_data,
size_t cb_data_sz,
size_t idx
2135 ssize_t* p_builtins = (ssize_t*)cb_data;
2137 if( MLISP_ENV_FLAG_BUILTIN == (MLISP_ENV_FLAG_BUILTIN & e->flags) ) {
2148 ssize_t builtins = 0;
2151 if( 0 == mdata_table_ct( &(exec->
env[0]) ) ) {
2155 if( !mdata_table_is_locked( &(exec->
env[0]) ) ) {
2156 mdata_table_lock( &(exec->
env[0]) );
2160 retval = mdata_table_iter(
2161 &(exec->
env[0]), _mlisp_count_builtins_iter, &builtins, 0 );
2165 if( MERROR_OK != retval ) {
2166 builtins = merror_retval_to_sz( retval );
2170 mdata_table_unlock( &(exec->
env[0]) );
2184 error_printf(
"no valid AST present; could not exec!" );
2185 retval = MERROR_EXEC;
2190 MLISP_EXEC_FLAG_INITIALIZED != (exec->
flags & MLISP_EXEC_FLAG_INITIALIZED)
2192 retval = MERROR_EXEC;
2207#ifdef MLISP_DEBUG_TRACE
2209 char trace_str[MLISP_DEBUG_TRACE * 5];
2210 maug_ms_t ms_start = 0;
2211 maug_ms_t ms_end = 0;
2213 ms_start = retroflat_get_ms();
2216#if MLISP_STEP_TRACE_LVL > 0
2217 debug_printf( MLISP_STEP_TRACE_LVL,
"%u: heartbeat start", exec->uid );
2225 assert( !mdata_vector_is_locked( &(parser->ast) ) );
2234#ifdef MLISP_DEBUG_TRACE
2235 exec->trace_depth = 0;
2239 retval = _mlisp_step_iter( parser, 0, exec );
2243 }
else if( MERROR_OK == retval ) {
2245#if MLISP_EXEC_TRACE_LVL > 0
2246 debug_printf( MLISP_EXEC_TRACE_LVL,
2247 "%u: execution terminated successfully", exec->uid );
2249 retval = MERROR_EXEC;
2250#if MLISP_EXEC_TRACE_LVL > 0
2252 debug_printf( MLISP_EXEC_TRACE_LVL,
2253 "%u: execution terminated with retval: %d", exec->uid, retval );
2257#ifdef MLISP_DEBUG_TRACE
2258 ms_end = retroflat_get_ms();
2260 maug_mzero( trace_str, MLISP_DEBUG_TRACE * 5 );
2261 for( i = 0 ; exec->trace_depth > i ; i++ ) {
2263 &(trace_str[maug_strlen( trace_str )]),
2264 (MLISP_DEBUG_TRACE * 5) - maug_strlen( trace_str ),
2265 SIZE_T_FMT
", ", exec->trace[i] );
2267#if MLISP_STEP_TRACE_LVL > 0
2268 debug_printf( MLISP_STEP_TRACE_LVL,
2269 "%u: " MLISP_TRACE_SIGIL
" HBEXEC (%u): %s",
2270 exec->uid, ms_end - ms_start, trace_str );
2276#if MLISP_STEP_TRACE_LVL > 0
2277 debug_printf( MLISP_STEP_TRACE_LVL,
2278 "%u: heartbeat end: %x", exec->uid, retval );
2281 assert( mdata_vector_is_locked( &(parser->ast) ) );
2297 uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX];
2298 mlisp_lambda_t lambda_idx = 0;
2300 int8_t env_iter = 0;
2302 if( MERROR_OK != mlisp_check_state( parser, exec ) ) {
2303 error_printf(
"mlisp not ready!" );
2304 retval = MERROR_EXEC;
2308 retval = _mlisp_autolock( parser, exec, 0xff, autolock );
2309 maug_cleanup_if_not_ok();
2312 e = mlisp_env_get( exec, lambda );
2314 error_printf(
"lambda \"%s\" not found!", lambda );
2315 retval = MERROR_OVERFLOW;
2318 lambda_idx = e->value.lambda;
2324 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2325 if( MLISP_AUTOLOCK_EXEC_ENV == (MLISP_AUTOLOCK_EXEC_ENV & autolock[0]) ) {
2326 mdata_table_unlock( &(exec->
env[env_iter]) );
2327 autolock[env_iter] &= ~MLISP_AUTOLOCK_EXEC_ENV;
2331 MLISP_AUTOLOCK_GLOBAL_ENV == (MLISP_AUTOLOCK_GLOBAL_ENV & autolock[0])
2333 mdata_table_unlock( exec->global_env );
2334 autolock[0] &= ~MLISP_AUTOLOCK_GLOBAL_ENV;
2337#if MLISP_STEP_TRACE_LVL > 0
2338 debug_printf( MLISP_STEP_TRACE_LVL,
"%u: lambda \"%s\" is AST node idx %ld",
2339 exec->uid, lambda, lambda_idx );
2342 n = mdata_vector_get( &(parser->ast), lambda_idx,
struct MLISP_AST_NODE );
2343 if( MLISP_AST_FLAG_LAMBDA != (MLISP_AST_FLAG_LAMBDA & n->flags) ) {
2344 error_printf(
"invalid node %d: not a lambda!", lambda_idx );
2345 retval = MERROR_EXEC;
2350 retval = _mlisp_step_lambda( parser, lambda_idx, exec );
2354 _mlisp_autounlock( parser, exec, autolock );
2366 retval = mlisp_env_set(
2367 exec,
"gdefine", 7, MLISP_TYPE_CB, _mlisp_env_cb_define,
2369 maug_cleanup_if_not_ok();
2371 retval = mlisp_env_set(
2372 exec,
"and", 3, MLISP_TYPE_CB, _mlisp_env_cb_ano,
2373 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ANO_AND );
2374 maug_cleanup_if_not_ok();
2376 retval = mlisp_env_set(
2377 exec,
"or", 2, MLISP_TYPE_CB, _mlisp_env_cb_ano,
2378 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ANO_OR );
2379 maug_cleanup_if_not_ok();
2381#ifndef MAUG_NO_RETRO
2383 retval = mlisp_env_set(
2384 exec,
"random", 6, MLISP_TYPE_CB, _mlisp_env_cb_random,
2385 0, MLISP_ENV_FLAG_BUILTIN );
2386 maug_cleanup_if_not_ok();
2389 retval = mlisp_env_set(
2390 exec,
"if", 2, MLISP_TYPE_CB, _mlisp_env_cb_if,
2391 0, MLISP_ENV_FLAG_BUILTIN );
2392 maug_cleanup_if_not_ok();
2394 retval = mlisp_env_set(
2395 exec,
"debug", 5, MLISP_TYPE_CB, _mlisp_env_cb_debug,
2396 0, MLISP_ENV_FLAG_BUILTIN );
2397 maug_cleanup_if_not_ok();
2399 retval = mlisp_env_set(
2400 exec,
"define", 6, MLISP_TYPE_CB, _mlisp_env_cb_define,
2401 0, MLISP_ENV_FLAG_BUILTIN );
2402 maug_cleanup_if_not_ok();
2404 retval = mlisp_env_set(
2405 exec,
"*", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2407 maug_cleanup_if_not_ok();
2409 retval = mlisp_env_set(
2410 exec,
"+", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2412 maug_cleanup_if_not_ok();
2414 retval = mlisp_env_set(
2415 exec,
"/", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2416 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ARI_DIV );
2417 maug_cleanup_if_not_ok();
2419 retval = mlisp_env_set(
2420 exec,
"%", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2421 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ARI_MOD );
2422 maug_cleanup_if_not_ok();
2424 retval = mlisp_env_set(
2425 exec,
"<", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
2427 maug_cleanup_if_not_ok();
2429 retval = mlisp_env_set(
2430 exec,
">", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
2432 maug_cleanup_if_not_ok();
2434 retval = mlisp_env_set(
2435 exec,
"=", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
2437 maug_cleanup_if_not_ok();
2450 ssize_t append_retval = 0;
2452 int16_t null_val = 0;
2454 assert( 0 == exec->
flags );
2458 exec->
flags = flags;
2459 exec->uid = g_mlispe_last_uid++;
2464 if( 0 > append_retval ) {
2465 retval = mdata_retval( append_retval );
2467 maug_cleanup_if_not_ok();
2473 retval = mlisp_env_set(
2474 exec,
"null", 4, MLISP_TYPE_INT, &null_val, 0, 0 );
2479 if( 0 > append_retval ) {
2480 retval = mdata_retval( append_retval );
2482 maug_cleanup_if_not_ok();
2491 if( 0 > append_retval ) {
2492 retval = mdata_retval( append_retval );
2494 maug_cleanup_if_not_ok();
2500 if( 0 > append_retval ) {
2501 retval = mdata_retval( append_retval );
2503 maug_cleanup_if_not_ok();
2512 if( 0 > append_retval ) {
2513 retval = mdata_retval( append_retval );
2515 maug_cleanup_if_not_ok();
2518 exec->
flags |= MLISP_EXEC_FLAG_INITIALIZED;
2522 retval = mlisp_exec_add_env_builtins( parser, exec );
2526 if( MERROR_OK != retval ) {
2527 error_printf(
"mlisp exec initialization failed: %d", retval );
2540 int16_t null_val = 0;
2542 exec->global_env = global_env;
2544 if( 0 == mdata_table_ct( global_env ) ) {
2549 retval = mlisp_env_set(
2550 exec,
"null", 4, MLISP_TYPE_INT, &null_val, 1, 0 );
2559 int8_t env_iter = 0;
2561#if MLISP_EXEC_TRACE_LVL > 0
2562 debug_printf( MLISP_EXEC_TRACE_LVL,
2563 "%u: destroying exec (stack: " SIZE_T_FMT
", env: " SIZE_T_FMT
")...",
2570 mdata_vector_free( &(exec->
stack) );
2571 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2572 mdata_table_free( &(exec->
env[env_iter]) );
2576#if MLISP_EXEC_TRACE_LVL > 0
2577 debug_printf( MLISP_EXEC_TRACE_LVL,
"exec destroyed!" );
2596# define MLISP_PSTATE_TABLE_CONST( name, idx ) \
2597 extern MAUG_CONST uint8_t SEG_MCONST name;
2599MLISP_PARSER_PSTATE_TABLE( MLISP_PSTATE_TABLE_CONST )
2601#ifdef MPARSER_TRACE_NAMES
2602extern MAUG_CONST
char* SEG_MCONST gc_mlisp_pstate_names[];
uint16_t MERROR_RETVAL
Return type indicating function returns a value from this list.
Definition: merror.h:28
#define MERROR_PREEMPT
Indicates MLISP_AST_NODE can be executed again on next step iter pass.
Definition: merror.h:67
#define MERROR_RESET
Indicates MLISP_EXEC_STATE has reached a condition where it has run out of instructions.
Definition: merror.h:73
#define mdata_strpool_get(sp, idx)
Get a string by the index of its first character in the strpool.
Definition: mdata.h:334
MAUG_MHANDLE mdata_strpool_extract(struct MDATA_STRPOOL *sp, mdata_strpool_idx_t idx)
Return a dynamically-allocated memory handle containing the contents of the string at the given index...
ssize_t mdata_vector_append(struct MDATA_VECTOR *v, const void *item, size_t item_sz)
Append an item to the specified vector.
MERROR_RETVAL mdata_vector_remove(struct MDATA_VECTOR *v, size_t idx)
Remove item at the given index, shifting subsequent items up by 1.
#define mlisp_check_ast(parser)
Macro to check if a parser contains a valid AST ready to be executed.
Definition: mlispp.h:80
MERROR_RETVAL mlisp_stack_dump(struct MLISP_PARSER *parser, struct MLISP_EXEC_STATE *exec)
Dump the stack from the given parser/exec combination.
#define mlisp_stack_pop(exec, o)
Wrapper for mlisp_stack_pop() with no flags.
Definition: mlispe.h:123
#define MLISP_STACK_FLAG_PEEK
Flag for mlisp_stack_pop_ex() indicating the value should not be removed from the stack.
Definition: mlispe.h:118
#define mlisp_stack_push(exec, i, ctype)
Push a value onto MLISP_EXEC_STATE::stack.
Definition: mlispe.h:133
MERROR_RETVAL mlisp_stack_pop_ex(struct MLISP_EXEC_STATE *exec, struct MLISP_STACK_NODE *o, uint8_t flags)
Pop a value off of (removing from) MLISP_EXEC_STATE::stack and copy it to a provided output.
#define MLISP_TYPE_TABLE(f)
Table of other types.
Definition: mlisps.h:74
#define MLISP_NUM_TYPE_TABLE(f)
Table of numeric types.
Definition: mlisps.h:64
MERROR_RETVAL mlisp_exec_set_global_env(struct MLISP_PARSER *parser, struct MLISP_EXEC_STATE *exec, struct MDATA_TABLE *global_env)
Set the given exec state to use the given vector as a global variable environment....
#define MLISP_ENV_FLAG_CMP_GT
Flag for _mlisp_env_cb_cmp() specifying TRUE if A > B.
Definition: mlispe.h:74
MERROR_RETVAL(* mlisp_env_cb_t)(struct MLISP_PARSER *parser, struct MLISP_EXEC_STATE *exec, size_t n_idx, size_t args_c, uint8_t *cb_data, uint8_t flags)
A callback to attach to an mlisp command with mlisp_env_set() with MLISP_TYPE_CB.
Definition: mlisps.h:92
#define MLISP_ENV_FLAG_ARI_MUL
Flag for _mlisp_env_cb_arithmetic() specifying to multiply A * B.
Definition: mlispe.h:86
MERROR_RETVAL mlisp_step(struct MLISP_PARSER *parser, struct MLISP_EXEC_STATE *exec)
Iterate the current exec_state() starting from the next MLISP_AST_NODE to be executed according to th...
#define MLISP_ENV_FLAG_ARI_ADD
Flag for _mlisp_env_cb_arithmetic() specifying to add A + B.
Definition: mlispe.h:83
#define MLISP_ENV_FLAG_CMP_EQ
Flag for _mlisp_env_cb_cmp() specifying TRUE if A == B.
Definition: mlispe.h:80
MERROR_RETVAL mlisp_env_dump(struct MLISP_PARSER *parser, struct MLISP_EXEC_STATE *exec, uint8_t global)
Dump the environment from the given parser/exec combination.
MERROR_RETVAL mlisp_step_lambda(struct MLISP_PARSER *parser, struct MLISP_EXEC_STATE *exec, const char *lambda)
Iterate the current exec_state() starting from the lambda named.
#define MLISP_ENV_FLAG_CMP_LT
Flag for _mlisp_env_cb_cmp() specifying TRUE if A < B.
Definition: mlispe.h:77
#define MLISP_ENV_FLAG_DEFINE_GLOBAL
Flag for _mlisp_env_cb_define() specifying global env.
Definition: mlispe.h:97
MLISP Interpreter/Parser Structs.
#define mdata_vector_lock(v)
Lock the vector. This should be done when items from the vector are actively being referenced,...
Definition: mdata.h:372
#define mdata_vector_unlock(v)
Unlock the vector so items may be added and removed.
Definition: mdata.h:405
#define mdata_vector_ct(v)
Number of items of MDATA_VECTOR::item_sz bytes actively stored in this vector.
Definition: mdata.h:448
size_t ast_idx_children_sz
Number of children in MLISP_AST_NODE::ast_idx_children.
Definition: mlisps.h:126
Current execution state to associate with a MLISP_PARSER.
Definition: mlisps.h:136
struct MDATA_VECTOR lambda_trace
Path through any lambdas the execution has entered during this heartbeat cycle. Used to detect tail c...
Definition: mlisps.h:184
#define MLISP_EXEC_FLAG_TRANSIENT_MASK
Mask for MLISP_EXEC_STATE::flags to block off flags that persist between steps.
Definition: mlisps.h:34
struct MDATA_VECTOR per_node_child_idx
The hild index that will be visited on next visit of each node.
Definition: mlisps.h:151
struct MDATA_VECTOR per_node_visit_ct
The number of times each node has been visited ever.
Definition: mlisps.h:143
#define MLISP_EXEC_FLAG_DEF_TERM
Flag for MLISP_EXEC_STATE::flags indicating next token is a term to be defined.
Definition: mlisps.h:41
struct MDATA_VECTOR stack
A stack of data values resulting from evaluating statements.
Definition: mlisps.h:154
uint8_t flags
Flags which dictate the behavior of this object.
Definition: mlisps.h:140
struct MDATA_TABLE env[MLISP_EXEC_ENV_FRAME_CT_MAX]
Environment in which statements are defined if ::MLISP_.
Definition: mlisps.h:171
int8_t env_select
The current topmost frame of MLISP_EXEC_STATE::env. Please see that for more information.
Definition: mlisps.h:176