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 );
320 mdata_vector_lock( &(parser->ast) );
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])
365 mdata_vector_unlock( &(parser->ast) );
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 );
395 mdata_vector_lock( &(exec->
stack) );
396 mdata_strpool_lock( &(parser->strpool) ); \
397 while( i < mdata_vector_ct( &(exec->
stack) ) ) {
401 if( MLISP_TYPE_STR == n_stack->type ) {
403 "%u: " MLISP_TRACE_SIGIL
" stack " SIZE_T_FMT
" (STR): %s",
404 exec->uid, i, mdata_strpool_get(
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) );
446 mdata_vector_unlock( &(exec->
stack) );
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 ); \
493 mdata_vector_ct( &(exec->
stack) ), 0, SIZE_T_FMT, MERROR_OVERFLOW );
495 n_idx = mdata_vector_ct( &(exec->
stack) ) - 1;
498 mdata_vector_lock( &(exec->
stack) );
499 n_stack = mdata_vector_get(
501 assert( NULL != n_stack );
504 mdata_vector_unlock( &(exec->
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 ); \
525 retval = mdata_vector_remove( &(exec->
stack), n_idx );
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",
572 mdata_strpool_get( &(parser.strpool), e->value.strpool_idx ) );
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 ) \
1045 debug_printf( 2, fmt, val.value.name ); \
1048 switch( val.type ) {
1049 case MLISP_TYPE_STR:
1051 &(parser->strpool), val.value.strpool_idx ) );
1065 size_t args_c,
void* cb_data, uint8_t flags
1070 MAUG_MHANDLE key_tmp_h = (MAUG_MHANDLE)NULL;
1071 char* key_tmp = NULL;
1074#if MLISP_EXEC_TRACE_LVL > 0
1075 debug_printf( MLISP_EXEC_TRACE_LVL,
"%u: entering define callback...",
1080 maug_cleanup_if_not_ok();
1083 maug_cleanup_if_not_ok();
1085 if( MLISP_TYPE_STR != key.type ) {
1088 error_printf(
"define: invalid key type: %d", key.type );
1089 retval = MERROR_EXEC;
1093#if MLISP_EXEC_TRACE_LVL > 0
1094 debug_printf( MLISP_EXEC_TRACE_LVL,
1095 "%u: extracting define term for idx: " SIZE_T_FMT,
1096 exec->uid, key.value.strpool_idx );
1100 &(parser->strpool), key.value.strpool_idx );
1102 assert( (MAUG_MHANDLE)NULL != key_tmp_h );
1104 maug_mlock( key_tmp_h, key_tmp );
1105 maug_cleanup_if_null_lock(
char*, key_tmp );
1107#if MLISP_EXEC_TRACE_LVL > 0
1108 debug_printf( MLISP_EXEC_TRACE_LVL,
1109 "%u: define \"%s\" (strpool(" SIZE_T_FMT
"))...",
1110 exec->uid, key_tmp, key.value.strpool_idx );
1117#if MLISP_EXEC_TRACE_LVL > 0
1118 debug_printf( MLISP_EXEC_TRACE_LVL,
1119 "%u: using global env...", exec->uid );
1125 retval = mlisp_env_set(
1126 exec, key_tmp, maug_strlen( key_tmp ), val.type, &(val.value),
1128 maug_cleanup_if_not_ok();
1130#if MLISP_EXEC_TRACE_LVL > 0
1131 debug_printf( MLISP_EXEC_TRACE_LVL,
1132 "%u: setup env node: %s",
1133 exec->uid, key_tmp );
1138 if( NULL != key_tmp ) {
1139 maug_munlock( key_tmp_h, key_tmp );
1142 if( (MAUG_MHANDLE)NULL != key_tmp_h ) {
1143 maug_mfree( key_tmp_h );
1153 size_t args_c,
void* cb_data, uint8_t flags
1156 size_t* p_if_child_idx = NULL;
1160#if MLISP_STEP_TRACE_LVL > 0
1161 debug_printf( MLISP_STEP_TRACE_LVL,
1162 "%u: qrqrqrqrqr STEP IF qrqrqrqrqr", exec->uid );
1167 p_if_child_idx = mdata_vector_get(
1169 assert( NULL != p_if_child_idx );
1170#if MLISP_STEP_TRACE_LVL > 0
1171 debug_printf( MLISP_STEP_TRACE_LVL,
1172 "%u: node " SIZE_T_FMT
" child idx: " SIZE_T_FMT,
1173 exec->uid, n_idx, *p_if_child_idx );
1176 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1178 if( 0 == *p_if_child_idx ) {
1180#if MLISP_STEP_TRACE_LVL > 0
1181 debug_printf( MLISP_STEP_TRACE_LVL,
1182 "%u: stepping into condition...", exec->uid );
1184 retval = _mlisp_step_iter(
1185 parser, n->ast_idx_children[*p_if_child_idx], exec );
1186#if MLISP_STEP_TRACE_LVL > 0
1187 debug_printf( MLISP_STEP_TRACE_LVL,
1188 "%u: ...stepped out of condition", exec->uid );
1192 if( MERROR_OK == retval ) {
1197 maug_cleanup_if_not_ok();
1198 if( MLISP_TYPE_BOOLEAN != s.type ) {
1199 error_printf(
"(if) can only evaluate boolean type!" );
1200 retval = MERROR_EXEC;
1205 retval = _mlisp_preempt(
1206 retval,
"if", parser, n_idx, exec,
1208 (1 - s.value.boolean) + 1 );
1211 }
else if( args_c > *p_if_child_idx ) {
1214#if MLISP_STEP_TRACE_LVL > 0
1215 debug_printf( MLISP_STEP_TRACE_LVL,
1216 "%u: descending into IF path: " SIZE_T_FMT,
1217 exec->uid, *p_if_child_idx );
1223 retval = _mlisp_step_iter(
1224 parser, n->ast_idx_children[*p_if_child_idx], exec );
1225 retval = _mlisp_preempt(
1226 retval,
"if", parser, n_idx, exec, 3 );
1231#if MLISP_STEP_TRACE_LVL > 0
1232 debug_printf( MLISP_STEP_TRACE_LVL,
1233 "%u: qrqrqrqrqr END STEP IF qrqrqrqrqr", exec->uid );
1241#ifndef MAUG_NO_RETRO
1247 size_t args_c,
void* cb_data, uint8_t flags
1251 int16_t random_int = 0;
1254 maug_cleanup_if_not_ok();
1256 if( MLISP_TYPE_INT != mod.type ) {
1258 error_printf(
"random: invalid modulus type: %d", mod.type );
1259 retval = MERROR_EXEC;
1263 random_int = retroflat_get_rand() % mod.value.integer;
1265#if MLISP_EXEC_TRACE_LVL > 0
1266 debug_printf( MLISP_EXEC_TRACE_LVL,
1267 "%u: random: %d", exec->uid, random_int );
1283 size_t args_c,
void* cb_data, uint8_t flags
1287 mlisp_bool_t val_out =
1289 MLISP_ENV_FLAG_ANO_OR == (MLISP_ENV_FLAG_ANO_OR & flags) ?
1297 for( i = 0 ; args_c > i ; i++ ) {
1299 maug_cleanup_if_not_ok();
1301 if( MLISP_TYPE_BOOLEAN != val.type ) {
1302 error_printf(
"or: invalid boolean type: %d", val.type );
1306 MLISP_ENV_FLAG_ANO_OR == (MLISP_ENV_FLAG_ANO_OR & flags) &&
1309#if MLISP_CMP_TRACE_LVL > 0
1310 debug_printf( MLISP_CMP_TRACE_LVL,
"%u: found TRUE in OR compare!",
1316 MLISP_ENV_FLAG_ANO_AND == (MLISP_ENV_FLAG_ANO_AND & flags) &&
1319#if MLISP_CMP_TRACE_LVL > 0
1320 debug_printf( MLISP_CMP_TRACE_LVL,
"%u: found FALSE in AND compare!",
1328#if MLISP_CMP_TRACE_LVL > 0
1329 debug_printf( MLISP_CMP_TRACE_LVL,
"compare result: %d", val_out );
1331 retval = _mlisp_stack_push_mlisp_bool_t( exec, val_out );
1349 size_t* p_child_idx = NULL;
1352 p_child_idx = mdata_vector_get(
1354 assert( NULL != p_child_idx );
1356 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1358 if( 0 < n->token_idx ) {
1359 mdata_strpool_lock( &(parser->strpool) );
1360#if MLISP_STEP_TRACE_LVL > 0
1361 debug_printf( MLISP_STEP_TRACE_LVL,
1362 "%u: eval step " SSIZE_T_FMT
" under (%s) %s...",
1363 exec->uid, *p_child_idx, caller,
1364 mdata_strpool_get( &(parser->strpool), n->token_idx ) );
1366 mdata_strpool_unlock( &(parser->strpool) );
1367#if MLISP_STEP_TRACE_LVL > 0
1369 debug_printf( MLISP_STEP_TRACE_LVL,
1370 "%u: eval step " SSIZE_T_FMT
" under (%s) (empty token)...",
1371 exec->uid, *p_child_idx, caller );
1375 if( MERROR_OK != retval ) {
1377#if MLISP_STEP_TRACE_LVL > 0
1378 debug_printf( MLISP_STEP_TRACE_LVL,
1379 "%u: not incrementing node " SIZE_T_FMT
" child idx from "
1380 SIZE_T_FMT
" (retval: 0x%x)!",
1381 exec->uid, n_idx, *p_child_idx, retval );
1390 (*p_child_idx) = new_idx;
1391#if MLISP_STEP_TRACE_LVL > 0
1392 debug_printf( MLISP_STEP_TRACE_LVL,
1393 "%u: incremented node " SIZE_T_FMT
" child idx to: " SIZE_T_FMT,
1394 exec->uid, n_idx, *p_child_idx );
1399 assert( !mdata_strpool_is_locked( &(parser->strpool) ) );
1410 size_t* p_child_idx = NULL;
1415 p_child_idx = mdata_vector_get(
1417 assert( NULL != p_child_idx );
1418#if MLISP_STEP_TRACE_LVL > 0
1419 debug_printf( MLISP_STEP_TRACE_LVL,
1420 "%u: node " SIZE_T_FMT
" child idx: " SIZE_T_FMT,
1421 exec->uid, n_idx, *p_child_idx );
1424 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1428 MLISP_AST_FLAG_LAMBDA == (MLISP_AST_FLAG_LAMBDA & n->flags) &&
1431 MLISP_AST_FLAG_IF == (MLISP_AST_FLAG_IF & n->flags)
1440#if MLISP_STEP_TRACE_LVL > 0
1441 debug_printf( MLISP_STEP_TRACE_LVL,
1442 "%u: skipping lambda children...", exec->uid );
1447 if( mlisp_ast_has_ready_children( *p_child_idx, n ) ) {
1451 MLISP_AST_FLAG_DEFINE == (MLISP_AST_FLAG_DEFINE & n->flags) &&
1455#if MLISP_EXEC_TRACE_LVL > 0
1456 debug_printf( MLISP_EXEC_TRACE_LVL,
1457 "%u: setting MLISP_EXEC_FLAG_DEF_TERM!", exec->uid );
1459 exec->
flags |= MLISP_EXEC_FLAG_DEF_TERM;
1461 exec->
flags &= ~MLISP_EXEC_FLAG_DEF_TERM;
1465 retval = _mlisp_step_iter(
1466 parser, n->ast_idx_children[*p_child_idx], exec );
1467 retval = _mlisp_preempt(
1468 retval,
"node", parser, n_idx, exec, (*p_child_idx) + 1 );
1483 ssize_t arg_idx = 0;
1486 MAUG_MHANDLE key_tmp_h = (MAUG_MHANDLE)NULL;
1487 char* key_tmp = NULL;
1489 int16_t null_val = 0;
1497 if( MLISP_EXEC_ENV_FRAME_CT_MAX > exec->
env_select + 1 ) {
1499#if MLISP_EXEC_TRACE_LVL > 0
1500 debug_printf( MLISP_EXEC_TRACE_LVL,
"selecting env frame: %d",
1503 assert( 0 == mdata_table_ct( &(exec->
env[exec->
env_select]) ) );
1506 retval = mlisp_env_set(
1507 exec,
"null", 4, MLISP_TYPE_INT, &null_val, 0, 0 );
1509 error_printf(
"env frame overflow!" );
1510 retval = MERROR_OVERFLOW;
1515 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1518 while( 0 <= arg_idx ) {
1521 maug_cleanup_if_not_ok();
1523 ast_n_arg = mdata_vector_get(
1524 &(parser->ast), n->ast_idx_children[arg_idx],
1529 &(parser->strpool), ast_n_arg->token_idx );
1531 assert( (MAUG_MHANDLE)NULL != key_tmp_h );
1533 maug_mlock( key_tmp_h, key_tmp );
1534 maug_cleanup_if_null_lock(
char*, key_tmp );
1536 retval = mlisp_env_set(
1537 exec, key_tmp, 0, stack_n_arg.type, &(stack_n_arg.value), 0, 0 );
1538 maug_cleanup_if_not_ok();
1540 maug_munlock( key_tmp_h, key_tmp );
1541 maug_mfree( key_tmp_h );
1548 if( NULL != key_tmp ) {
1549 maug_munlock( key_tmp_h, key_tmp );
1552 if( (MAUG_MHANDLE)NULL != key_tmp_h ) {
1553 maug_mfree( key_tmp_h );
1566 size_t* p_child_idx = NULL;
1567 size_t* p_visit_ct = NULL;
1572 assert( mdata_vector_is_locked( &(parser->ast) ) );
1575#if MLISP_STEP_TRACE_LVL > 0
1576 debug_printf( MLISP_STEP_TRACE_LVL,
1577 "%u: resetting node " SIZE_T_FMT
" child idx to 0", exec->uid, n_idx );
1580 assert( NULL != p_child_idx );
1583#if MLISP_STEP_TRACE_LVL > 0
1584 debug_printf( MLISP_STEP_TRACE_LVL,
1585 "%u: resetting node " SIZE_T_FMT
" visit count to 0", exec->uid, n_idx );
1588 assert( NULL != p_visit_ct );
1591 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1595 retval = _mlisp_reset_child_pcs( parser, n->ast_idx_children[i], exec );
1596 maug_cleanup_if_not_ok();
1612#if MLISP_EXEC_TRACE_LVL > 0
1613 debug_printf( MLISP_EXEC_TRACE_LVL,
1614 "%u: resetting lambda " SIZE_T_FMT
"...", exec->uid, n_idx );
1620 assert( !mdata_table_is_locked( &(exec->
env[exec->
env_select]) ) );
1626 retval = _mlisp_reset_child_pcs( parser, n_idx, exec );
1639 size_t* p_lambda_child_idx = NULL;
1640#if MLISP_STEP_TRACE_LVL > 0
1641 size_t* p_args_child_idx = NULL;
1644 size_t* p_n_last_lambda = NULL;
1645 ssize_t append_retval = 0;
1647#ifdef MLISP_DEBUG_TRACE
1648 exec->trace[exec->trace_depth++] = n_idx;
1649 assert( exec->trace_depth <= MLISP_DEBUG_TRACE );
1654 p_n_last_lambda = mdata_vector_get_last( &(exec->
lambda_trace),
size_t );
1656 if( NULL != p_n_last_lambda && n_idx == *p_n_last_lambda ) {
1660#if MLISP_STEP_TRACE_LVL > 0
1661 debug_printf( MLISP_STEP_TRACE_LVL,
"%u: TRACE TAIL TIME!", exec->uid );
1667 _mlisp_reset_lambda( parser, n_idx, exec );
1668 retval = mdata_vector_remove_last( &(exec->
lambda_trace) );
1669 maug_cleanup_if_not_ok();
1672#if MLISP_STEP_TRACE_LVL > 0
1673 debug_printf( MLISP_STEP_TRACE_LVL,
1674 "%u: xvxvxvxvxvxvx STEP LAMBDA " SIZE_T_FMT
" xvxvxvxvxvx",
1679 append_retval = mdata_vector_append(
1681 retval = mdata_retval( append_retval );
1682 maug_cleanup_if_not_ok();
1686 p_lambda_child_idx = mdata_vector_get(
1688 assert( NULL != p_lambda_child_idx );
1689#if MLISP_STEP_TRACE_LVL > 0
1690 debug_printf( MLISP_STEP_TRACE_LVL,
1691 "%u: lambda node " SIZE_T_FMT
" child idx: " SIZE_T_FMT,
1692 exec->uid, n_idx, *p_lambda_child_idx );
1695 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1701 if( 0 == *p_lambda_child_idx ) {
1706#if MLISP_STEP_TRACE_LVL > 0
1711 n->ast_idx_children[*p_lambda_child_idx],
size_t );
1712#if MLISP_STEP_TRACE_LVL > 0
1713 assert( NULL != p_args_child_idx );
1714 debug_printf( MLISP_STEP_TRACE_LVL,
1715 "%u: child idx for args AST node " SIZE_T_FMT
": " SIZE_T_FMT,
1716 exec->uid, *p_lambda_child_idx, *p_args_child_idx );
1720 retval = _mlisp_step_lambda_args(
1721 parser, n->ast_idx_children[*p_lambda_child_idx], exec );
1727 if( MERROR_OK == retval ) {
1736 (*p_lambda_child_idx)++;
1737#if MLISP_STEP_TRACE_LVL > 0
1738 debug_printf( MLISP_STEP_TRACE_LVL,
1739 "%u: incremented node " SIZE_T_FMT
" child idx to: " SIZE_T_FMT,
1740 exec->uid, n_idx, *p_lambda_child_idx );
1749 }
else if( mlisp_ast_has_ready_children( *p_lambda_child_idx, n ) ) {
1757 NULL == exec->global_env ||
1758 !mdata_table_is_locked( exec->global_env ) );
1760 retval = _mlisp_step_iter(
1761 parser, n->ast_idx_children[*p_lambda_child_idx], exec );
1763 retval = _mlisp_preempt(
1764 retval,
"lambda", parser, n_idx, exec, (*p_lambda_child_idx) + 1 );
1771 NULL == exec->global_env ||
1772 !mdata_table_is_locked( exec->global_env ) );
1773 _mlisp_reset_lambda( parser, n_idx, exec );
1780#if MLISP_STEP_TRACE_LVL > 0
1781 debug_printf( MLISP_STEP_TRACE_LVL,
1782 "%u: xvxvxvxvxvxvx END STEP LAMBDA " SIZE_T_FMT
" xvxvxvxvxvx",
1802 i = mdata_vector_ct( &(exec->
stack) ) - 1;
1806 maug_cleanup_if_not_ok();
1808 if( MLISP_TYPE_BEGIN == o.type && n_idx == o.value.begin ) {
1832 char* strpool_token = NULL;
1838 NULL == exec->global_env ||
1839 mdata_table_is_locked( exec->global_env ) );
1841 mdata_strpool_lock( &(parser->strpool) );
1844 strpool_token = mdata_strpool_get( &(parser->strpool), token_idx );
1845 assert( NULL != strpool_token );
1847#if MLISP_EXEC_TRACE_LVL > 0
1848 debug_printf( MLISP_EXEC_TRACE_LVL,
1849 "%u: eval token: \"%s\" (strlen: " SIZE_T_FMT
"r/" SIZE_T_FMT
"d)",
1850 exec->uid, strpool_token, token_sz, maug_strlen( strpool_token ) );
1852 if( 0 == maug_strncmp( strpool_token,
"begin", token_sz + 1 ) ) {
1854 e_out->type = MLISP_TYPE_BEGIN;
1856 }
else if( NULL != (p_e = mlisp_env_get( exec, strpool_token ) ) ) {
1858#if MLISP_EXEC_TRACE_LVL > 0
1859 debug_printf( MLISP_EXEC_TRACE_LVL,
"%u: found %s in env!",
1860 exec->uid, strpool_token );
1868 }
else if( maug_is_num( strpool_token, token_sz, 10, 1 ) ) {
1870#if MLISP_EXEC_TRACE_LVL > 0
1871 debug_printf( MLISP_EXEC_TRACE_LVL,
1872 "%u: did not find %s in env, but it is a number...",
1873 exec->uid, strpool_token );
1875 e_out->value.integer = maug_atos32( strpool_token, token_sz );
1876 e_out->type = MLISP_TYPE_INT;
1878 }
else if( maug_is_float( strpool_token, token_sz ) ) {
1879#if MLISP_EXEC_TRACE_LVL > 0
1880 debug_printf( MLISP_EXEC_TRACE_LVL,
1881 "%u: did not find %s in env, but it is a float...",
1882 exec->uid, strpool_token );
1885 e_out->value.floating = maug_atof( strpool_token, token_sz );
1886 e_out->type = MLISP_TYPE_FLOAT;
1889#if MLISP_EXEC_TRACE_LVL > 0
1890 error_printf(
"%u: could not make sense of token: %s",
1891 exec->uid, strpool_token );
1898 if( mdata_strpool_is_locked( &(parser->strpool) ) ) {
1899 mdata_strpool_unlock( &(parser->strpool) );
1902#if MLISP_EXEC_TRACE_LVL > 0
1903 debug_printf( MLISP_EXEC_TRACE_LVL,
"%u: eval token complete!",
1917 size_t* p_visit_ct = NULL;
1919 uint8_t e_flags = 0;
1920 mlisp_lambda_t e_lambda = 0;
1921 int8_t env_iter = 0;
1927 volatile mdata_strpool_idx_t node_strpool_idx = 0;
1929#ifdef MLISP_DEBUG_TRACE
1930 exec->trace[exec->trace_depth++] = n_idx;
1931 assert( exec->trace_depth <= MLISP_DEBUG_TRACE );
1934 n = mdata_vector_get( &(parser->ast), n_idx,
struct MLISP_AST_NODE );
1937 p_visit_ct = mdata_vector_get(
1939 assert( NULL != p_visit_ct );
1941#if MLISP_STEP_TRACE_LVL > 0
1942 debug_printf( MLISP_STEP_TRACE_LVL,
1943 "%u: visit count for AST node " SIZE_T_FMT
": " SIZE_T_FMT,
1944 exec->uid, n_idx, *p_visit_ct );
1949 MLISP_AST_FLAG_BEGIN == (MLISP_AST_FLAG_BEGIN & n->flags) &&
1953 retval = _mlisp_stack_push_mlisp_begin_t( exec, n_idx );
1954 maug_cleanup_if_not_ok();
1959 (retval = _mlisp_step_iter_children( parser, n_idx, exec ))
1965 if( MLISP_AST_FLAG_LAMBDA == (MLISP_AST_FLAG_LAMBDA & n->flags) ) {
1981 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
1982#if MLISP_LOCK_TRACE_LVL > 0
1983 debug_printf( MLISP_LOCK_TRACE_LVL,
1984 "%u: locking local env %d...", exec->uid, env_iter );
1986 mdata_table_lock( &(exec->
env[env_iter]) );
1990 NULL == exec->global_env || !mdata_table_is_locked( exec->global_env ) );
1991 if( NULL != exec->global_env ) {
1992 mdata_table_lock( exec->global_env );
1996 retval = _mlisp_eval_token_strpool(
1997 parser, exec, n->token_idx, n->token_sz, &e );
1998 maug_cleanup_if_not_ok();
2002#if MLISP_STEP_TRACE_LVL > 0
2003 debug_printf( MLISP_STEP_TRACE_LVL,
"%u: acting on evaluated token...",
2008# define _MLISP_TYPE_TABLE_ENVE( idx, ctype, name, const_name, fmt ) \
2009 } else if( MLISP_TYPE_ ## const_name == e.type ) { \
2010 debug_printf( MLISP_EXEC_TRACE_LVL, \
2011 "%u: pushing env: " fmt " to stack...", \
2012 exec->uid, e.value.name ); \
2013 retval = _mlisp_stack_push_ ## ctype( exec, e.value.name ); \
2014 maug_cleanup_if_not_ok();
2016 if( MLISP_EXEC_FLAG_DEF_TERM == (MLISP_EXEC_FLAG_DEF_TERM & exec->
flags) ) {
2020#if MLISP_EXEC_TRACE_LVL > 0
2021 debug_printf( MLISP_EXEC_TRACE_LVL,
2022 "%u: special case! pushing literal to stack: " SSIZE_T_FMT,
2023 exec->uid, n->token_idx );
2025 node_strpool_idx = n->token_idx;
2026 retval = _mlisp_stack_push_mdata_strpool_idx_t( exec, node_strpool_idx );
2027 maug_cleanup_if_not_ok();
2028 }
else if( MLISP_TYPE_BEGIN == e.type ) {
2032#if MLISP_STEP_TRACE_LVL > 0
2033 debug_printf( MLISP_STEP_TRACE_LVL,
2034 "%u: rewinding stack for begin on node " SSIZE_T_FMT,
2037 retval = _mlisp_stack_cleanup( parser, n_idx, exec );
2038 maug_cleanup_if_not_ok();
2043 retval = _mlisp_stack_push_mlisp_begin_t( exec, n_idx );
2044 maug_cleanup_if_not_ok();
2046 }
else if( MLISP_TYPE_CB == e.type ) {
2052#if MLISP_EXEC_TRACE_LVL > 0
2053 debug_printf( MLISP_EXEC_TRACE_LVL,
2054 "%u: special case! executing callback: %p", exec->uid, e_cb );
2060 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2061 mdata_table_unlock( &(exec->
env[env_iter]) );
2063 if( NULL != exec->global_env ) {
2064 mdata_table_unlock( exec->global_env );
2071 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2072 mdata_table_lock( &(exec->
env[env_iter]) );
2074 if( NULL != exec->global_env ) {
2075 mdata_table_lock( exec->global_env );
2078 }
else if( MLISP_TYPE_LAMBDA == e.type ) {
2080#if MLISP_EXEC_TRACE_LVL > 0
2081 debug_printf( MLISP_EXEC_TRACE_LVL,
2082 "%u: special case! executing lambda...", exec->uid );
2090 e_lambda = e.value.lambda;
2091 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2092 mdata_table_unlock( &(exec->
env[env_iter]) );
2094 if( NULL != exec->global_env ) {
2095 mdata_table_unlock( exec->global_env );
2098 retval = _mlisp_step_lambda( parser, e_lambda, exec );
2101 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2102 mdata_table_lock( &(exec->
env[env_iter]) );
2104 if( NULL != exec->global_env ) {
2105 mdata_table_lock( exec->global_env );
2110#if MLISP_EXEC_TRACE_LVL > 0
2111 debug_printf( MLISP_EXEC_TRACE_LVL,
"pushing literal into stack" );
2113 retval = _mlisp_stack_push_mdata_strpool_idx_t( exec, n->token_idx );
2114 maug_cleanup_if_not_ok();
2119 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2120 mdata_table_unlock( &(exec->
env[env_iter]) );
2123 if( NULL != exec->global_env ) {
2124 mdata_table_unlock( exec->global_env );
2134 void* cb_data,
size_t cb_data_sz,
size_t idx
2138 ssize_t* p_builtins = (ssize_t*)cb_data;
2140 if( MLISP_ENV_FLAG_BUILTIN == (MLISP_ENV_FLAG_BUILTIN & e->flags) ) {
2151 ssize_t builtins = 0;
2154 if( 0 == mdata_table_ct( &(exec->
env[0]) ) ) {
2158 if( !mdata_table_is_locked( &(exec->
env[0]) ) ) {
2159 mdata_table_lock( &(exec->
env[0]) );
2163 retval = mdata_table_iter(
2164 &(exec->
env[0]), _mlisp_count_builtins_iter, &builtins, 0 );
2168 if( MERROR_OK != retval ) {
2169 builtins = merror_retval_to_sz( retval );
2173 mdata_table_unlock( &(exec->
env[0]) );
2187 error_printf(
"no valid AST present; could not exec!" );
2188 retval = MERROR_EXEC;
2193 MLISP_EXEC_FLAG_INITIALIZED != (exec->
flags & MLISP_EXEC_FLAG_INITIALIZED)
2195 retval = MERROR_EXEC;
2210#ifdef MLISP_DEBUG_TRACE
2212 char trace_str[MLISP_DEBUG_TRACE * 5];
2213 maug_ms_t ms_start = 0;
2214 maug_ms_t ms_end = 0;
2216 ms_start = retroflat_get_ms();
2219#if MLISP_STEP_TRACE_LVL > 0
2220 debug_printf( MLISP_STEP_TRACE_LVL,
"%u: heartbeat start", exec->uid );
2228 assert( !mdata_vector_is_locked( &(parser->ast) ) );
2231 mdata_vector_lock( &(parser->ast) );
2234 exec->
flags &= MLISP_EXEC_FLAG_TRANSIENT_MASK;
2235 assert( 0 == mdata_vector_ct( &(exec->
lambda_trace) ) );
2237#ifdef MLISP_DEBUG_TRACE
2238 exec->trace_depth = 0;
2242 retval = _mlisp_step_iter( parser, 0, exec );
2246 }
else if( MERROR_OK == retval ) {
2248#if MLISP_EXEC_TRACE_LVL > 0
2249 debug_printf( MLISP_EXEC_TRACE_LVL,
2250 "%u: execution terminated successfully", exec->uid );
2252 retval = MERROR_EXEC;
2253#if MLISP_EXEC_TRACE_LVL > 0
2255 debug_printf( MLISP_EXEC_TRACE_LVL,
2256 "%u: execution terminated with retval: %d", exec->uid, retval );
2260#ifdef MLISP_DEBUG_TRACE
2261 ms_end = retroflat_get_ms();
2263 maug_mzero( trace_str, MLISP_DEBUG_TRACE * 5 );
2264 for( i = 0 ; exec->trace_depth > i ; i++ ) {
2266 &(trace_str[maug_strlen( trace_str )]),
2267 (MLISP_DEBUG_TRACE * 5) - maug_strlen( trace_str ),
2268 SIZE_T_FMT
", ", exec->trace[i] );
2270#if MLISP_STEP_TRACE_LVL > 0
2271 debug_printf( MLISP_STEP_TRACE_LVL,
2272 "%u: " MLISP_TRACE_SIGIL
" HBEXEC (%u): %s",
2273 exec->uid, ms_end - ms_start, trace_str );
2279#if MLISP_STEP_TRACE_LVL > 0
2280 debug_printf( MLISP_STEP_TRACE_LVL,
2281 "%u: heartbeat end: %x", exec->uid, retval );
2284 assert( mdata_vector_is_locked( &(parser->ast) ) );
2285 mdata_vector_unlock( &(parser->ast) );
2300 uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX];
2301 mlisp_lambda_t lambda_idx = 0;
2303 int8_t env_iter = 0;
2305 if( MERROR_OK != mlisp_check_state( parser, exec ) ) {
2306 error_printf(
"mlisp not ready!" );
2307 retval = MERROR_EXEC;
2311 retval = _mlisp_autolock( parser, exec, 0xff, autolock );
2312 maug_cleanup_if_not_ok();
2315 e = mlisp_env_get( exec, lambda );
2317 error_printf(
"lambda \"%s\" not found!", lambda );
2318 retval = MERROR_OVERFLOW;
2321 lambda_idx = e->value.lambda;
2327 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2328 if( MLISP_AUTOLOCK_EXEC_ENV == (MLISP_AUTOLOCK_EXEC_ENV & autolock[0]) ) {
2329 mdata_table_unlock( &(exec->
env[env_iter]) );
2330 autolock[env_iter] &= ~MLISP_AUTOLOCK_EXEC_ENV;
2334 MLISP_AUTOLOCK_GLOBAL_ENV == (MLISP_AUTOLOCK_GLOBAL_ENV & autolock[0])
2336 mdata_table_unlock( exec->global_env );
2337 autolock[0] &= ~MLISP_AUTOLOCK_GLOBAL_ENV;
2340#if MLISP_STEP_TRACE_LVL > 0
2341 debug_printf( MLISP_STEP_TRACE_LVL,
"%u: lambda \"%s\" is AST node idx %ld",
2342 exec->uid, lambda, lambda_idx );
2345 n = mdata_vector_get( &(parser->ast), lambda_idx,
struct MLISP_AST_NODE );
2346 if( MLISP_AST_FLAG_LAMBDA != (MLISP_AST_FLAG_LAMBDA & n->flags) ) {
2347 error_printf(
"invalid node %d: not a lambda!", lambda_idx );
2348 retval = MERROR_EXEC;
2353 retval = _mlisp_step_lambda( parser, lambda_idx, exec );
2357 _mlisp_autounlock( parser, exec, autolock );
2369 retval = mlisp_env_set(
2370 exec,
"gdefine", 7, MLISP_TYPE_CB, _mlisp_env_cb_define,
2372 maug_cleanup_if_not_ok();
2374 retval = mlisp_env_set(
2375 exec,
"and", 3, MLISP_TYPE_CB, _mlisp_env_cb_ano,
2376 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ANO_AND );
2377 maug_cleanup_if_not_ok();
2379 retval = mlisp_env_set(
2380 exec,
"or", 2, MLISP_TYPE_CB, _mlisp_env_cb_ano,
2381 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ANO_OR );
2382 maug_cleanup_if_not_ok();
2384#ifndef MAUG_NO_RETRO
2386 retval = mlisp_env_set(
2387 exec,
"random", 6, MLISP_TYPE_CB, _mlisp_env_cb_random,
2388 0, MLISP_ENV_FLAG_BUILTIN );
2389 maug_cleanup_if_not_ok();
2392 retval = mlisp_env_set(
2393 exec,
"if", 2, MLISP_TYPE_CB, _mlisp_env_cb_if,
2394 0, MLISP_ENV_FLAG_BUILTIN );
2395 maug_cleanup_if_not_ok();
2397 retval = mlisp_env_set(
2398 exec,
"debug", 5, MLISP_TYPE_CB, _mlisp_env_cb_debug,
2399 0, MLISP_ENV_FLAG_BUILTIN );
2400 maug_cleanup_if_not_ok();
2402 retval = mlisp_env_set(
2403 exec,
"define", 6, MLISP_TYPE_CB, _mlisp_env_cb_define,
2404 0, MLISP_ENV_FLAG_BUILTIN );
2405 maug_cleanup_if_not_ok();
2407 retval = mlisp_env_set(
2408 exec,
"*", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2410 maug_cleanup_if_not_ok();
2412 retval = mlisp_env_set(
2413 exec,
"+", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2415 maug_cleanup_if_not_ok();
2417 retval = mlisp_env_set(
2418 exec,
"/", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2419 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ARI_DIV );
2420 maug_cleanup_if_not_ok();
2422 retval = mlisp_env_set(
2423 exec,
"%", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2424 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ARI_MOD );
2425 maug_cleanup_if_not_ok();
2427 retval = mlisp_env_set(
2428 exec,
"<", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
2430 maug_cleanup_if_not_ok();
2432 retval = mlisp_env_set(
2433 exec,
">", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
2435 maug_cleanup_if_not_ok();
2437 retval = mlisp_env_set(
2438 exec,
"=", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
2440 maug_cleanup_if_not_ok();
2453 ssize_t append_retval = 0;
2455 int16_t null_val = 0;
2457 assert( 0 == exec->
flags );
2461 exec->
flags = flags;
2462 exec->uid = g_mlispe_last_uid++;
2465 append_retval = mdata_vector_append(
2467 if( 0 > append_retval ) {
2468 retval = mdata_retval( append_retval );
2470 maug_cleanup_if_not_ok();
2476 retval = mlisp_env_set(
2477 exec,
"null", 4, MLISP_TYPE_INT, &null_val, 0, 0 );
2480 append_retval = mdata_vector_append(
2482 if( 0 > append_retval ) {
2483 retval = mdata_retval( append_retval );
2485 maug_cleanup_if_not_ok();
2490 mdata_vector_ct( &(parser->ast) )
2494 if( 0 > append_retval ) {
2495 retval = mdata_retval( append_retval );
2497 maug_cleanup_if_not_ok();
2501 append_retval = mdata_vector_append(
2503 if( 0 > append_retval ) {
2504 retval = mdata_retval( append_retval );
2506 maug_cleanup_if_not_ok();
2511 mdata_vector_ct( &(parser->ast) )
2515 if( 0 > append_retval ) {
2516 retval = mdata_retval( append_retval );
2518 maug_cleanup_if_not_ok();
2521 exec->
flags |= MLISP_EXEC_FLAG_INITIALIZED;
2525 retval = mlisp_exec_add_env_builtins( parser, exec );
2529 if( MERROR_OK != retval ) {
2530 error_printf(
"mlisp exec initialization failed: %d", retval );
2543 int16_t null_val = 0;
2545 exec->global_env = global_env;
2547 if( 0 == mdata_table_ct( global_env ) ) {
2552 retval = mlisp_env_set(
2553 exec,
"null", 4, MLISP_TYPE_INT, &null_val, 1, 0 );
2562 int8_t env_iter = 0;
2564#if MLISP_EXEC_TRACE_LVL > 0
2565 debug_printf( MLISP_EXEC_TRACE_LVL,
2566 "%u: destroying exec (stack: " SIZE_T_FMT
", env: " SIZE_T_FMT
")...",
2568 mdata_vector_ct( &(exec->
stack) ),
2573 mdata_vector_free( &(exec->
stack) );
2574 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2575 mdata_table_free( &(exec->
env[env_iter]) );
2579#if MLISP_EXEC_TRACE_LVL > 0
2580 debug_printf( MLISP_EXEC_TRACE_LVL,
"exec destroyed!" );
2599# define MLISP_PSTATE_TABLE_CONST( name, idx ) \
2600 extern MAUG_CONST uint8_t SEG_MCONST name;
2602MLISP_PARSER_PSTATE_TABLE( MLISP_PSTATE_TABLE_CONST )
2604#ifdef MPARSER_TRACE_NAMES
2605extern 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
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...
#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.
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
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
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