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",
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",
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 );
1456 exec->
flags |= MLISP_EXEC_FLAG_DEF_TERM;
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",
1676 append_retval = mdata_vector_append(
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 );
1696 retval = MERROR_EXEC;
1697 error_printf(
"%u: invalid lambda node: too few children!" );
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) );
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 debug_printf( MLISP_STEP_TRACE_LVL,
2271 "%u: " MLISP_TRACE_SIGIL
" HBEXEC (%u): %s",
2272 exec->uid, ms_end - ms_start, trace_str );
2277#if MLISP_STEP_TRACE_LVL > 0
2278 debug_printf( MLISP_STEP_TRACE_LVL,
2279 "%u: heartbeat end: %x", exec->uid, retval );
2282 assert( mdata_vector_is_locked( &(parser->ast) ) );
2283 mdata_vector_unlock( &(parser->ast) );
2298 uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX];
2299 mlisp_lambda_t lambda_idx = 0;
2301 int8_t env_iter = 0;
2303 if( MERROR_OK != mlisp_check_state( parser, exec ) ) {
2304 error_printf(
"mlisp not ready!" );
2305 retval = MERROR_EXEC;
2309 retval = _mlisp_autolock( parser, exec, 0xff, autolock );
2310 maug_cleanup_if_not_ok();
2313 e = mlisp_env_get( exec, lambda );
2315 error_printf(
"lambda \"%s\" not found!", lambda );
2316 retval = MERROR_OVERFLOW;
2319 lambda_idx = e->value.lambda;
2325 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2326 if( MLISP_AUTOLOCK_EXEC_ENV == (MLISP_AUTOLOCK_EXEC_ENV & autolock[0]) ) {
2327 mdata_table_unlock( &(exec->
env[env_iter]) );
2328 autolock[env_iter] &= ~MLISP_AUTOLOCK_EXEC_ENV;
2332 MLISP_AUTOLOCK_GLOBAL_ENV == (MLISP_AUTOLOCK_GLOBAL_ENV & autolock[0])
2334 mdata_table_unlock( exec->global_env );
2335 autolock[0] &= ~MLISP_AUTOLOCK_GLOBAL_ENV;
2338#if MLISP_STEP_TRACE_LVL > 0
2339 debug_printf( MLISP_STEP_TRACE_LVL,
"%u: lambda \"%s\" is AST node idx %ld",
2340 exec->uid, lambda, lambda_idx );
2343 n = mdata_vector_get( &(parser->ast), lambda_idx,
struct MLISP_AST_NODE );
2344 if( MLISP_AST_FLAG_LAMBDA != (MLISP_AST_FLAG_LAMBDA & n->flags) ) {
2345 error_printf(
"invalid node %d: not a lambda!", lambda_idx );
2346 retval = MERROR_EXEC;
2351 retval = _mlisp_step_lambda( parser, lambda_idx, exec );
2355 _mlisp_autounlock( parser, exec, autolock );
2367 retval = mlisp_env_set(
2368 exec,
"gdefine", 7, MLISP_TYPE_CB, _mlisp_env_cb_define,
2370 maug_cleanup_if_not_ok();
2372 retval = mlisp_env_set(
2373 exec,
"and", 3, MLISP_TYPE_CB, _mlisp_env_cb_ano,
2374 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ANO_AND );
2375 maug_cleanup_if_not_ok();
2377 retval = mlisp_env_set(
2378 exec,
"or", 2, MLISP_TYPE_CB, _mlisp_env_cb_ano,
2379 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ANO_OR );
2380 maug_cleanup_if_not_ok();
2382#ifndef MAUG_NO_RETRO
2384 retval = mlisp_env_set(
2385 exec,
"random", 6, MLISP_TYPE_CB, _mlisp_env_cb_random,
2386 0, MLISP_ENV_FLAG_BUILTIN );
2387 maug_cleanup_if_not_ok();
2390 retval = mlisp_env_set(
2391 exec,
"if", 2, MLISP_TYPE_CB, _mlisp_env_cb_if,
2392 0, MLISP_ENV_FLAG_BUILTIN );
2393 maug_cleanup_if_not_ok();
2395 retval = mlisp_env_set(
2396 exec,
"debug", 5, MLISP_TYPE_CB, _mlisp_env_cb_debug,
2397 0, MLISP_ENV_FLAG_BUILTIN );
2398 maug_cleanup_if_not_ok();
2400 retval = mlisp_env_set(
2401 exec,
"define", 6, MLISP_TYPE_CB, _mlisp_env_cb_define,
2402 0, MLISP_ENV_FLAG_BUILTIN );
2403 maug_cleanup_if_not_ok();
2405 retval = mlisp_env_set(
2406 exec,
"*", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2408 maug_cleanup_if_not_ok();
2410 retval = mlisp_env_set(
2411 exec,
"+", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2413 maug_cleanup_if_not_ok();
2415 retval = mlisp_env_set(
2416 exec,
"/", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2417 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ARI_DIV );
2418 maug_cleanup_if_not_ok();
2420 retval = mlisp_env_set(
2421 exec,
"%", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
2422 0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ARI_MOD );
2423 maug_cleanup_if_not_ok();
2425 retval = mlisp_env_set(
2426 exec,
"<", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
2428 maug_cleanup_if_not_ok();
2430 retval = mlisp_env_set(
2431 exec,
">", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
2433 maug_cleanup_if_not_ok();
2435 retval = mlisp_env_set(
2436 exec,
"=", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
2438 maug_cleanup_if_not_ok();
2451 ssize_t append_retval = 0;
2453 int16_t null_val = 0;
2455 assert( 0 == exec->
flags );
2459 exec->
flags = flags;
2460 exec->uid = g_mlispe_last_uid++;
2463 append_retval = mdata_vector_append(
2465 if( 0 > append_retval ) {
2466 retval = mdata_retval( append_retval );
2468 maug_cleanup_if_not_ok();
2474 retval = mlisp_env_set(
2475 exec,
"null", 4, MLISP_TYPE_INT, &null_val, 0, 0 );
2478 append_retval = mdata_vector_append(
2480 if( 0 > append_retval ) {
2481 retval = mdata_retval( append_retval );
2483 maug_cleanup_if_not_ok();
2488 mdata_vector_ct( &(parser->ast) )
2492 if( 0 > append_retval ) {
2493 retval = mdata_retval( append_retval );
2495 maug_cleanup_if_not_ok();
2499 append_retval = mdata_vector_append(
2501 if( 0 > append_retval ) {
2502 retval = mdata_retval( append_retval );
2504 maug_cleanup_if_not_ok();
2509 mdata_vector_ct( &(parser->ast) )
2513 if( 0 > append_retval ) {
2514 retval = mdata_retval( append_retval );
2516 maug_cleanup_if_not_ok();
2519 exec->
flags |= MLISP_EXEC_FLAG_INITIALIZED;
2523 retval = mlisp_exec_add_env_builtins( parser, exec );
2527 if( MERROR_OK != retval ) {
2528 error_printf(
"mlisp exec initialization failed: %d", retval );
2541 int16_t null_val = 0;
2543 exec->global_env = global_env;
2545 if( 0 == mdata_table_ct( global_env ) ) {
2550 retval = mlisp_env_set(
2551 exec,
"null", 4, MLISP_TYPE_INT, &null_val, 1, 0 );
2560 int8_t env_iter = 0;
2562#if MLISP_EXEC_TRACE_LVL > 0
2563 debug_printf( MLISP_EXEC_TRACE_LVL,
2564 "%u: destroying exec (stack: " SIZE_T_FMT
", env: " SIZE_T_FMT
")...",
2566 mdata_vector_ct( &(exec->
stack) ),
2571 mdata_vector_free( &(exec->
stack) );
2572 for( env_iter = exec->
env_select ; 0 <= env_iter ; env_iter-- ) {
2573 mdata_table_free( &(exec->
env[env_iter]) );
2577#if MLISP_EXEC_TRACE_LVL > 0
2578 debug_printf( MLISP_EXEC_TRACE_LVL,
"exec destroyed!" );
2597# define MLISP_PSTATE_TABLE_CONST( name, idx ) \
2598 extern MAUG_CONST uint8_t SEG_MCONST name;
2600MLISP_PARSER_PSTATE_TABLE( MLISP_PSTATE_TABLE_CONST )
2602#ifdef MPARSER_TRACE_NAMES
2603extern 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...
#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