mlispe.h

Go to the documentation of this file.

 
#ifndef MLISPE_H
#define MLISPE_H
 
#include <mlisps.h>


 
#ifndef MLISP_TOKEN_SZ_MAX
#  define MLISP_TOKEN_SZ_MAX 4096
#endif /* !MLISP_TOKEN_SZ_MAX */
 
#ifndef MLISP_EXEC_TRACE_LVL
#  define MLISP_EXEC_TRACE_LVL 0
#endif /* !MLISP_EXEC_TRACE_LVL */
 
#ifndef MLISP_STACK_TRACE_LVL
#  define MLISP_STACK_TRACE_LVL 0
#endif /* !MLISP_STACK_TRACE_LVL */
 
#define MLISP_ENV_FLAG_BUILTIN   0x02

#define MLISP_ENV_FLAG_CMP_GT    0x10

#define MLISP_ENV_FLAG_CMP_LT    0x20

#define MLISP_ENV_FLAG_CMP_EQ    0x40

#define MLISP_ENV_FLAG_ARI_ADD   0x10

#define MLISP_ENV_FLAG_ARI_MUL   0x20
 
#define MLISP_ENV_FLAG_ARI_DIV   0x40
 
#define MLISP_ENV_FLAG_ARI_MOD   0x80
 
#define MLISP_ENV_FLAG_ANO_OR    0x10
 
#define MLISP_ENV_FLAG_ANO_AND   0x20

#define MLISP_ENV_FLAG_DEFINE_GLOBAL   0x10
 
#define MLISP_AUTOLOCK_EXEC_ENV     0x01
 
#define MLISP_AUTOLOCK_CHILD_IDX    0x02
 
#define MLISP_AUTOLOCK_VISIT_CT     0x04
 
#define MLISP_AUTOLOCK_PARSER_AST   0x08
 
#define MLISP_AUTOLOCK_GLOBAL_ENV   0x10


#define MLISP_STACK_FLAG_PEEK    0x01

#define mlisp_stack_pop( exec, o ) mlisp_stack_pop_ex( exec, o, 0 )

#define mlisp_stack_push( exec, i, ctype ) \
   (_mlisp_stack_push_ ## ctype( exec, (ctype)i ))
 
#if defined( MLISP_DUMP_ENABLED ) || defined( DOCUMENTATION )

MERROR_RETVAL mlisp_stack_dump(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec );
 
#endif /* MLISP_DUMP_ENABLED || DOCUMENTATION */

MERROR_RETVAL mlisp_stack_pop_ex(
   struct MLISP_EXEC_STATE* exec, struct MLISP_STACK_NODE* o, uint8_t flags );
 /* mlisp_stack */
 
#if defined( MLISP_DUMP_ENABLED ) || defined( DOCUMENTATION )

MERROR_RETVAL mlisp_env_dump(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec, uint8_t global );
 
#endif /* MLISP_DUMP_ENABLED || DOCUMENTATION */
 
struct MLISP_ENV_NODE* mlisp_env_get(
   struct MLISP_EXEC_STATE* exec, const char* key );
 
MERROR_RETVAL mlisp_env_unset(
   struct MLISP_EXEC_STATE* exec, const char* token, size_t token_sz,
   uint8_t global );
 
MERROR_RETVAL mlisp_env_set(
   struct MLISP_EXEC_STATE* exec,
   const char* token, size_t token_sz, uint8_t env_type, const void* data,
   uint8_t global, uint8_t flags );
 
ssize_t mlisp_count_builtins( struct MLISP_EXEC_STATE* exec );
 
MERROR_RETVAL mlisp_check_state(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec );

MERROR_RETVAL mlisp_step(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec );

MERROR_RETVAL mlisp_step_lambda(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec,
   const char* lambda );
 
MERROR_RETVAL mlisp_exec_add_env_builtins(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec );
 
MERROR_RETVAL mlisp_exec_init(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec, uint8_t flags );

MERROR_RETVAL mlisp_exec_set_global_env(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec,
   struct MDATA_TABLE* global_env );
 
void mlisp_exec_free( struct MLISP_EXEC_STATE* exec );
 
MERROR_RETVAL mlisp_deserialize_prepare_EXEC_STATE(
   struct MLISP_EXEC_STATE* exec, size_t i );
 
#define _MLISP_TYPE_TABLE_PUSH_PROTO( idx, ctype, name, const_name, fmt ) \
   MERROR_RETVAL _mlisp_stack_push_ ## ctype( \
      struct MLISP_EXEC_STATE* exec, ctype i );
 
MLISP_TYPE_TABLE( _MLISP_TYPE_TABLE_PUSH_PROTO )
 
 /* mlisp */
 
#define mlisp_ast_has_ready_children( exec_child_idx, n ) \
   ((exec_child_idx) < (n)->ast_idx_children_sz)
 
#ifdef MLISPE_C
 
uint16_t g_mlispe_last_uid = 0;

static MERROR_RETVAL _mlisp_preempt(
   MERROR_RETVAL retval, const char* caller, struct MLISP_PARSER* parser,
   size_t n_idx, struct MLISP_EXEC_STATE* exec, size_t new_idx );
 
static MERROR_RETVAL _mlisp_step_iter(
   struct MLISP_PARSER* parser,
   size_t n_idx, struct MLISP_EXEC_STATE* exec );
 
static MERROR_RETVAL _mlisp_reset_child_pcs(
   const struct MLISP_PARSER* parser,
   size_t n_idx, struct MLISP_EXEC_STATE* exec );
 
static MERROR_RETVAL _mlisp_autolock(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec,
   uint8_t mask, uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX]
) {
   MERROR_RETVAL retval = MERROR_OK;
   int8_t env_iter = 0;
 
   maug_mzero( autolock, MLISP_EXEC_ENV_FRAME_CT_MAX );
 
   /* Autolock vectors used below. */
   if( MLISP_AUTOLOCK_EXEC_ENV == (MLISP_AUTOLOCK_EXEC_ENV & mask) ) {
      for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
         if( !mdata_table_is_locked( &(exec->env[env_iter]) ) ) {
#if MLISP_EXEC_TRACE_LVL > 0
            debug_printf( MLISP_EXEC_TRACE_LVL,
               "%u: engaging autolock for exec env frame %d...",
               exec->uid, env_iter );
#endif /* MLISP_EXEC_TRACE_LVL */
            mdata_table_lock( &(exec->env[env_iter]) );
            autolock[env_iter] |= MLISP_AUTOLOCK_EXEC_ENV;
         }
      }
   }
   if(
      MLISP_AUTOLOCK_CHILD_IDX == (MLISP_AUTOLOCK_CHILD_IDX & mask) &&
      !mdata_vector_is_locked( &(exec->per_node_child_idx) )
   ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: engaging autolock for exec per-node child index...", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
      mdata_vector_lock( &(exec->per_node_child_idx) );
      autolock[0] |= MLISP_AUTOLOCK_CHILD_IDX;
   }
   if(
      MLISP_AUTOLOCK_VISIT_CT == (MLISP_AUTOLOCK_VISIT_CT & mask) &&
      !mdata_vector_is_locked( &(exec->per_node_visit_ct) )
   ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: engaging autolock for per-node visit count...", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
      mdata_vector_lock( &(exec->per_node_visit_ct) );
      autolock[0] |= MLISP_AUTOLOCK_VISIT_CT;
   }
   if(
      MLISP_AUTOLOCK_PARSER_AST == (MLISP_AUTOLOCK_PARSER_AST & mask) &&
      !mdata_vector_is_locked( &(parser->ast) )
   ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: engaging autolock for parser AST...", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
      mdata_vector_lock( &(parser->ast) );
      autolock[0] |= MLISP_AUTOLOCK_PARSER_AST;
   }
   if(
      MLISP_AUTOLOCK_GLOBAL_ENV == (MLISP_AUTOLOCK_GLOBAL_ENV & mask) &&
      NULL != exec->global_env &&
      0 < mdata_table_ct( exec->global_env ) &&
      !mdata_table_is_locked( exec->global_env )
   ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: engaging autolock for global env...", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
      mdata_table_lock( exec->global_env );
      autolock[0] |= MLISP_AUTOLOCK_GLOBAL_ENV;
   }
 
cleanup:
   return retval;
}
 
/* === */
 
static void _mlisp_autounlock(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec,
   uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX]
) {
   int8_t env_iter = 0;
   for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
      if(
         MLISP_AUTOLOCK_EXEC_ENV ==
         (MLISP_AUTOLOCK_EXEC_ENV & autolock[env_iter])
      ) {
         mdata_table_unlock( &(exec->env[env_iter]) );
      }
   }
   if( MLISP_AUTOLOCK_CHILD_IDX == (MLISP_AUTOLOCK_CHILD_IDX & autolock[0]) ) {
      mdata_vector_unlock( &(exec->per_node_child_idx) );
   }
   if( MLISP_AUTOLOCK_VISIT_CT == (MLISP_AUTOLOCK_VISIT_CT & autolock[0]) ) {
      mdata_vector_unlock( &(exec->per_node_visit_ct) );
   }
   if(
      MLISP_AUTOLOCK_PARSER_AST == (MLISP_AUTOLOCK_PARSER_AST & autolock[0])
   ) {
      mdata_vector_unlock( &(parser->ast) );
   }
   if(
      MLISP_AUTOLOCK_GLOBAL_ENV == (MLISP_AUTOLOCK_GLOBAL_ENV & autolock[0])
   ) {
      mdata_table_unlock( exec->global_env );
   }
}
 
/* === */
 
/* Stack Functions */
 
/* === */
 
#ifdef MLISP_DUMP_ENABLED
 
MERROR_RETVAL mlisp_stack_dump(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
   size_t i = 0;
   struct MLISP_STACK_NODE* n_stack = NULL;
 
#  define _MLISP_TYPE_TABLE_DUMPS( idx, ctype, name, const_name, fmt ) \
      } else if( MLISP_TYPE_ ## const_name == n_stack->type ) { \
         debug_printf( MLISP_STACK_TRACE_LVL, \
            "%u: " MLISP_TRACE_SIGIL " stack " SIZE_T_FMT " (" #const_name "): " fmt, \
            exec->uid, i, n_stack->value.name );
 
   mdata_vector_lock( &(exec->stack) );
   mdata_strpool_lock( &(parser->strpool) ); \
   while( i < mdata_vector_ct( &(exec->stack) ) ) {
      n_stack = mdata_vector_get( &(exec->stack), i, struct MLISP_STACK_NODE );
 
      /* Handle special exceptions. */
      if( MLISP_TYPE_STR == n_stack->type ) {
         debug_printf( 1,
            "%u: " MLISP_TRACE_SIGIL " stack " SIZE_T_FMT " (STR): %s",
            exec->uid, i, mdata_strpool_get(
               &(parser->strpool), n_stack->value.strpool_idx ) );
 
      } else if( MLISP_TYPE_CB == n_stack->type ) {
         debug_printf( 1,
            "%u: " MLISP_TRACE_SIGIL " stack " SIZE_T_FMT " (CB): %p",
            exec->uid, i, n_stack->value.cb );
 
      } else if( MLISP_TYPE_LAMBDA == n_stack->type ) {
         debug_printf( 1,
            "%u: " MLISP_TRACE_SIGIL " stack " SIZE_T_FMT " (LAMBDA): "
               SIZE_T_FMT,
            exec->uid, i, n_stack->value.lambda );
 
      /*
      } else if( MLISP_TYPE_ARGS_S == n_stack->type ) {
         debug_printf( 1,
            "%u: " MLISP_TRACE_SIGIL " stack " SIZE_T_FMT " (ARGS_S): "
               SIZE_T_FMT,
            exec->uid, i, n_stack->value.args_start );
 
      } else if( MLISP_TYPE_ARGS_E == n_stack->type ) {
         debug_printf( 1,
            "%u: " MLISP_TRACE_SIGIL " stack " SIZE_T_FMT " (ARGS_E): "
               SIZE_T_FMT,
            exec->uid, i, n_stack->value.args_end );
      */
 
      } else if( MLISP_TYPE_BEGIN == n_stack->type ) {
         debug_printf( 1,
            "%u: " MLISP_TRACE_SIGIL " stack " SIZE_T_FMT " (BEGIN): "
               SIZE_T_FMT,
            exec->uid, i, n_stack->value.begin );
 
      /* Handle numeric types. */
      MLISP_NUM_TYPE_TABLE( _MLISP_TYPE_TABLE_DUMPS );
      } else {
         error_printf( "invalid stack type: %u", n_stack->type );
      }
      i++;
   }
   mdata_strpool_unlock( &(parser->strpool) );
   mdata_vector_unlock( &(exec->stack) );
 
cleanup:
 
   assert( mdata_strpool_is_locked( &(parser->strpool) ) );
 
   return retval;
}
 
#endif /* MLISP_DUMP_ENABLED */
 
/* === */
 
#define _MLISP_TYPE_TABLE_PUSH( idx, ctype, name, const_name, fmt ) \
   MERROR_RETVAL _mlisp_stack_push_ ## ctype( \
      struct MLISP_EXEC_STATE* exec, ctype i \
   ) { \
      ssize_t stack_idx = 0; \
      struct MLISP_STACK_NODE n_stack; \
      MERROR_RETVAL retval = MERROR_OK; \
      debug_printf( MLISP_STACK_TRACE_LVL, \
         "%u: pushing " #const_name " onto stack: " fmt, exec->uid, i ); \
      n_stack.type = MLISP_TYPE_ ## const_name; \
      n_stack.value.name = i; \
      stack_idx = mdata_vector_append( \
         &(exec->stack), &n_stack, sizeof( struct MLISP_STACK_NODE ) ); \
      if( 0 > stack_idx ) { \
         retval = mdata_retval( stack_idx ); \
      } \
      return retval; \
   }
 
MLISP_TYPE_TABLE( _MLISP_TYPE_TABLE_PUSH );
 
/* === */
 
MERROR_RETVAL mlisp_stack_pop_ex(
   struct MLISP_EXEC_STATE* exec, struct MLISP_STACK_NODE* o, uint8_t flags
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_STACK_NODE* n_stack = NULL;
   size_t n_idx = 0;
 
   maug_mzero( o, sizeof( struct MLISP_STACK_NODE ) );
 
   /* Check for valid stack pointer. */
   maug_cleanup_if_eq(
      mdata_vector_ct( &(exec->stack) ), 0, SIZE_T_FMT, MERROR_OVERFLOW );
 
   n_idx = mdata_vector_ct( &(exec->stack) ) - 1;
 
   /* Perform the pop! */
   mdata_vector_lock( &(exec->stack) );
   n_stack = mdata_vector_get(
      &(exec->stack), n_idx, struct MLISP_STACK_NODE );
   assert( NULL != n_stack );
   memcpy( o, n_stack, sizeof( struct MLISP_STACK_NODE ) );
   n_stack = NULL;
   mdata_vector_unlock( &(exec->stack) );
 
#if MLISP_STACK_TRACE_LVL > 0
#  define _MLISP_TYPE_TABLE_POPD( idx, ctype, name, const_name, fmt ) \
      } else if( MLISP_TYPE_ ## const_name == o->type ) { \
         if( MLISP_STACK_FLAG_PEEK == (MLISP_STACK_FLAG_PEEK & flags) ) { \
            debug_printf( MLISP_STACK_TRACE_LVL, \
               "%u: peeking (%ut): " SSIZE_T_FMT ": " fmt, \
               exec->uid, n_idx, o->type, o->value.name ); \
         } else { \
            debug_printf( MLISP_STACK_TRACE_LVL, \
               "%u: popping (%ut): " SSIZE_T_FMT ": " fmt, \
               exec->uid, n_idx, o->type, o->value.name ); \
         }
 
   if( 0 ) {
   MLISP_TYPE_TABLE( _MLISP_TYPE_TABLE_POPD )
   }
#endif /* MLISP_STACK_TRACE_LVL */
 
   if( MLISP_STACK_FLAG_PEEK != (MLISP_STACK_FLAG_PEEK & flags) ) {
      retval = mdata_vector_remove( &(exec->stack), n_idx );
   }
 
cleanup:
 
   return retval;
}
 
/* === */
 
/* Env Functons */
 
/* === */
 
#if defined( MLISP_DUMP_ENABLED )
 
static MERROR_RETVAL _mlisp_env_dump_iter(
   const struct MDATA_TABLE_KEY* key, void* data, size_t data_sz,
   void* cb_data, size_t cb_data_sz, size_t idx
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_ENV_NODE* e = (struct MLISP_ENV_NODE*)data;
   struct MLISP_PARSER parser;
   struct MLISP_EXEC_STATE* exec = (struct MLISP_EXEC_STATE*)cb_data;
 
   maug_mzero( &parser, sizeof( struct MLISP_PARSER ) );
 
#  define _MLISP_TYPE_TABLE_DUMPE( idx, ctype, name, const_name, fmt ) \
      } else if( MLISP_TYPE_ ## const_name == e->type ) { \
         debug_printf( 1, \
            "%u: " MLISP_TRACE_SIGIL " env \"%s\" (" #const_name "): " fmt, \
            exec->uid, key->string, e->value.name );
 
   if( MLISP_ENV_FLAG_BUILTIN == (MLISP_ENV_FLAG_BUILTIN & e->flags) ) {
      /* Skip builtins. */
      return MERROR_OK;
   }
 
   debug_printf( 1, "%s: %p: 0x%02x", key, e, e->type );
 
   if( 0 ) {
   MLISP_NUM_TYPE_TABLE( _MLISP_TYPE_TABLE_DUMPE );
   /* Handle special exceptions. */
   } else if( MLISP_TYPE_STR == e->type ) {
      debug_printf( 1,
         "%u: " MLISP_TRACE_SIGIL " env \"%s\" (STR): %s",
         exec->uid, key,
         mdata_strpool_get( &(parser.strpool), e->value.strpool_idx ) );
 
   } else if( MLISP_TYPE_CB == e->type ) {
      debug_printf( 1,
         "%u: " MLISP_TRACE_SIGIL " env \"%s\" (CB): %p",
         exec->uid, key, e->value.cb );
 
   } else if( MLISP_TYPE_LAMBDA == e->type ) {
      debug_printf( 1,
         "%u: " MLISP_TRACE_SIGIL " env \"%s\" (LAMBDA): " SIZE_T_FMT,
         exec->uid, key, e->value.lambda );
 
   } else {
      error_printf( MLISP_TRACE_SIGIL " invalid env type: %u", e->type );
   }
 
   return retval;
}
 
/* === */
 
MERROR_RETVAL mlisp_env_dump(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec, uint8_t global
) {
   MERROR_RETVAL retval = MERROR_OK;
   int8_t env_iter = 0;
   uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX];
 
   retval = _mlisp_autolock(
      NULL, exec, MLISP_AUTOLOCK_EXEC_ENV | MLISP_AUTOLOCK_GLOBAL_ENV,
      autolock );
   maug_cleanup_if_not_ok();
 
   if( global ) {
      debug_printf( 1, "# global env:" );
      retval = mdata_table_iter(
         exec->global_env, _mlisp_env_dump_iter, exec, 0 );
   } else {
      for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
         debug_printf( 1, "# env frame %d:", env_iter );
         retval = mdata_table_iter(
            &(exec->env[env_iter]), _mlisp_env_dump_iter, exec, 0 );
         maug_cleanup_if_not_ok();
      }
   }
 
cleanup:
 
   _mlisp_autounlock( NULL, exec, autolock );
 
   return retval;
}
 
#endif /* MLISP_DUMP_ENABLED */
 
/* === */
 
struct MLISP_ENV_NODE* mlisp_env_get(
   struct MLISP_EXEC_STATE* exec, const char* key
) {
   struct MLISP_ENV_NODE* e = NULL;
   struct MDATA_TABLE* env = NULL;
   MERROR_RETVAL retval = MERROR_OK;
   int8_t env_iter = exec->env_select;
 
   while( 0 <= env_iter ) {
      env = &(exec->env[env_iter]);
 
      /* At the very least, the caller using this should be in the same lock
       * context as this search, since we're returning a pointer. So no
       * autolock!
       */
      assert( mdata_table_is_locked( env ) );
 
      e = mdata_table_get( env, key, struct MLISP_ENV_NODE );
      if( NULL != e ) {
         /* Found something, so short-circuit! */
         goto cleanup;
      }
 
      /* Try a higher frame. */
      env_iter--;
   }
 
   /* Did not find anything in the local env, so try the global env if there
    * is one!
    */
   if( NULL != exec->global_env ) {
      assert( mdata_table_is_locked( exec->global_env ) );
      e = mdata_table_get( exec->global_env, key, struct MLISP_ENV_NODE );
   }
 
cleanup:
 
   if( MERROR_OK != retval ) {
      e = NULL;
   }
 
   return e;
}
 
/* === */
 
MERROR_RETVAL mlisp_env_unset(
   struct MLISP_EXEC_STATE* exec, const char* token, size_t token_sz,
   uint8_t global
) {
   MERROR_RETVAL retval = MERROR_OK;
   uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX];
   int8_t env_iter = exec->env_select;
   struct MDATA_TABLE* env = NULL;
 
   /* TODO: Unset in global env if requested. */
 
   maug_mzero( autolock, MLISP_EXEC_ENV_FRAME_CT_MAX );
 
   while( 0 <= env_iter ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: attempting to undefine %s in frame %d...",
         exec->uid, token, env_iter );
#endif /* MLISP_EXEC_TRACE_LVL */
 
      env = &(exec->env[env_iter]);
 
      if( !mdata_table_is_locked( env ) ) {
         mdata_table_lock( env );
         autolock[env_iter] |= 0x02;
      }
 
      retval = mdata_table_unset( env, token );
 
      env_iter--;
   }
 
   for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
      if( 0x02 == (0x02 & autolock[env_iter]) ) {
         env = &(exec->env[env_iter]);
         assert( mdata_table_is_locked( env ) );
         mdata_table_unlock( env );
      }
   }
 
   return retval;
}
 
/* === */
 
MERROR_RETVAL mlisp_env_set(
   struct MLISP_EXEC_STATE* exec,
   const char* token, size_t token_sz, uint8_t env_type, const void* data,
   uint8_t global, uint8_t flags
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_ENV_NODE e;
   struct MDATA_TABLE* env = NULL;
 
   /* Builtins can only be inserted into frame 0! */
   assert(
      (MLISP_ENV_FLAG_BUILTIN != (MLISP_ENV_FLAG_BUILTIN & flags)) ||
      0 == exec->env_select );
 
   /* Default to current local env frame, but switch to global if requested. */
   env = &(exec->env[exec->env_select]);
   if( global ) {
      if( NULL != exec->global_env ) {
         env = exec->global_env;
      } else {
         error_printf( "global env requested but not present!" );
         retval = MERROR_EXEC;
         goto cleanup;
      }
   }
 
   if( 0 == token_sz ) {
      token_sz = maug_strlen( token );
   }
 
   assert( NULL != env );
   assert( 0 < token_sz );
 
   assert( !mdata_table_is_locked( env ) );
 
   /* Find previous env nodes with same token and change. */
   /* Ignore the retval, since it doesn't really matter if this fails. */
   mdata_table_unset( env, token );
 
#if MLISP_EXEC_TRACE_LVL > 0
#  define _MLISP_TYPE_TABLE_ASGN( idx, ctype, name, const_name, fmt ) \
      case idx: \
         debug_printf( MLISP_EXEC_TRACE_LVL, \
            "%u: setting env %d: \"%s\": #" fmt, \
            exec->uid, exec->env_select, token, (ctype)*((ctype*)data) ); \
         e.value.name = *((ctype*)data); \
         break;
#else
#  define _MLISP_TYPE_TABLE_ASGN( idx, ctype, name, const_name, fmt ) \
      case idx: \
         e.value.name = *((ctype*)data); \
         break;
#endif /* MLISP_EXEC_TRACE_LVL */
 
   /* Setup the new node to copy. */
   maug_mzero( &e, sizeof( struct MLISP_ENV_NODE ) );
   e.flags = flags;
   maug_cleanup_if_not_ok();
   e.type = env_type;
   switch( env_type ) {
   MLISP_NUM_TYPE_TABLE( _MLISP_TYPE_TABLE_ASGN );
 
   /* Special cases: */
 
   case 4 /* MLISP_TYPE_STR */:
      /* TODO: Don't use strpool for this! */
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: setting env %d: \"%s\": strpool(" SSIZE_T_FMT ")",
         exec->uid, exec->env_select, token, *((ssize_t*)data) );
#endif /* MLISP_EXEC_TRACE_LVL */
      e.value.strpool_idx = *((mdata_strpool_idx_t*)data);
      break;
 
   case 5 /* MLISP_TYPE_CB */:
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: setting env %d: \"%s\": 0x%p",
         exec->uid, exec->env_select, token, (mlisp_env_cb_t)data );
#endif /* MLISP_EXEC_TRACE_LVL */
      e.value.cb = (mlisp_env_cb_t)data;
      break;
 
   case 6 /* MLISP_TYPE_LAMBDA */:
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: setting env %d: \"%s\": node #" SSIZE_T_FMT,
         exec->uid, exec->env_select, token, *((mlisp_lambda_t*)data) );
#endif /* MLISP_EXEC_TRACE_LVL */
      e.value.lambda = *((mlisp_lambda_t*)data);
      break;
 
   case 10: /* MLISP_TYPE_BEGIN */
      /* We probably called a lambda that takes an arg without placing an
       * arg on the stack for it to take up!
       *
       * This could be a script error, but it could also be a lambda being
       * itered into after its finished executing (and thus has no arg on the
       * stack waiting for it).
       * 
       * MERROR_RESET signals the calling program we're embedded in to deal
       * with this situation, maybe by restarting the script with a fresh env.
       */
      error_printf(
         "%u: underflow %s: missing lambda arg?",
         exec->uid, token );
      retval = MERROR_RESET;
      goto cleanup;
 
   default:
      error_printf( "invalid type: %d", env_type );
      retval = MERROR_EXEC;
      goto cleanup;
   }
 
   retval = mdata_table_set( env, token, &e, sizeof( struct MLISP_ENV_NODE ) );
 
cleanup:
 
   return retval;
}
 
/* === */
 
static MERROR_RETVAL _mlisp_env_cb_cmp(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec, size_t n_idx,
   size_t args_c, void* cb_data, uint8_t flags
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_STACK_NODE tmp;
   uint8_t truth = 0;
 
   /* The compiler seems to get a bit too eager if optimization is turned on,
    * and ends up flubbing the comparison if these aren't volatile.
    */
   volatile int a_int,
      b_int,
      a_type,
      b_type;
   volatile int* cur_int = NULL;
 
   mdata_strpool_lock( &(parser->strpool) );
 
   /* XXX: If we put a mutable variable first, it gets modified? */
 
#if MLISP_EXEC_TRACE_LVL > 0
#  define _MLISP_TYPE_TABLE_CMP( idx, ctype, name, const_name, fmt ) \
      } else if( MLISP_TYPE_ ## const_name == tmp.type ) { \
         *cur_int = (int)tmp.value.name; \
         debug_printf( MLISP_EXEC_TRACE_LVL, \
            "%u: cmp: pop " fmt " (%d)", exec->uid, tmp.value.name, *cur_int );
#else
#  define _MLISP_TYPE_TABLE_CMP( idx, ctype, name, const_name, fmt ) \
      } else if( MLISP_TYPE_ ## const_name == tmp.type ) { \
         *cur_int = (int)tmp.value.name;
#endif /* MLISP_EXEC_TRACE_LVL */
 
   retval = mlisp_stack_pop( exec, &tmp );
   maug_cleanup_if_not_ok();
   cur_int = &b_int;
   if( MLISP_TYPE_STR == tmp.type ) {
      /* TODO: Buffer string for later comparison. */
      a_type = MLISP_TYPE_STR;
 
   MLISP_NUM_TYPE_TABLE( _MLISP_TYPE_TABLE_CMP )
   } else {
      error_printf( "cmp: invalid type: %d", tmp.type );
      retval = MERROR_EXEC;
      goto cleanup;
   }
 
   retval = mlisp_stack_pop( exec, &tmp );
   maug_cleanup_if_not_ok();
   cur_int = &a_int;
   if( MLISP_TYPE_STR == tmp.type ) {
      /* TODO: Buffer string for later comparison. */
      b_type = MLISP_TYPE_STR;
 
   MLISP_NUM_TYPE_TABLE( _MLISP_TYPE_TABLE_CMP )
   } else {
      error_printf( "cmp: invalid type!" );
      retval = MERROR_EXEC;
      goto cleanup;
   }
 
   /* TODO: String comparison? */
   if( MLISP_TYPE_STR == a_type || MLISP_TYPE_STR == b_type ) {
   
      /* TODO: Do a strncmp() and push 1 if true. */
      retval = mlisp_stack_push( exec, 0, mlisp_bool_t );
      goto cleanup;
   }
 
   /* String comparison didn't catch, so it must be a number comparison? */
   if( MLISP_ENV_FLAG_CMP_GT == (MLISP_ENV_FLAG_CMP_GT & flags) ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL, "%u: cmp %d > %d",
         exec->uid, a_int, b_int );
#endif /* MLISP_EXEC_TRACE_LVL */
      truth = a_int > b_int;
   } else if( MLISP_ENV_FLAG_CMP_LT == (MLISP_ENV_FLAG_CMP_LT & flags) ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL, "%u: cmp %d < %d",
         exec->uid, a_int, b_int );
#endif /* MLISP_EXEC_TRACE_LVL */
      truth = a_int < b_int;
   } else if( MLISP_ENV_FLAG_CMP_EQ == (MLISP_ENV_FLAG_CMP_EQ & flags) ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL, "%u: cmp %d == %d",
         exec->uid, a_int, b_int );
#endif /* MLISP_EXEC_TRACE_LVL */
      truth = a_int == b_int;
   } else {
      error_printf( "invalid parameter provided to _mlisp_env_cb_cmp()!" );
      retval = MERROR_EXEC;
      goto cleanup;
   }
 
   retval = mlisp_stack_push( exec, truth, mlisp_bool_t );
 
cleanup:
 
   mdata_strpool_unlock( &(parser->strpool) );
 
   return retval;
}
 
/* === */
 
static MERROR_RETVAL _mlisp_env_cb_arithmetic(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec, size_t n_idx,
   size_t args_c, void* cb_data, uint8_t flags
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_STACK_NODE num;
   /* TODO: Vary type based on multiplied types. */
   int16_t num_out = 0;
   size_t i = 0;
 
#  define _MLISP_TYPE_TABLE_ARI1( idx, ctype, name, const_name, fmt ) \
      } else if( MLISP_TYPE_ ## const_name == num.type ) { \
         num_out = num.value.name;
 
   retval = mlisp_stack_pop( exec, &num );
   maug_cleanup_if_not_ok();
 
   if( 0 ) {
   MLISP_NUM_TYPE_TABLE( _MLISP_TYPE_TABLE_ARI1 )
   } else {
      error_printf( "arithmetic: invalid type!" );
      retval = MERROR_EXEC;
      goto cleanup;
   }
 
#  define _MLISP_TYPE_TABLE_ARI2( idx, ctype, name, const_name, fmt ) \
      } else if( \
         MLISP_TYPE_ ## const_name == num.type && \
         MLISP_ENV_FLAG_ARI_ADD == (MLISP_ENV_FLAG_ARI_ADD & flags) \
      ) { \
         debug_printf( MLISP_EXEC_TRACE_LVL, \
            "%u: arithmetic: %d + " fmt, exec->uid, num_out, num.value.name ); \
         num_out += num.value.name; \
      } else if( \
         MLISP_TYPE_ ## const_name == num.type && \
         MLISP_ENV_FLAG_ARI_MUL == (MLISP_ENV_FLAG_ARI_MUL & flags) \
      ) { \
         debug_printf( MLISP_EXEC_TRACE_LVL, \
            "%u: arithmetic: %d * " fmt, exec->uid, num_out, num.value.name ); \
         num_out *= num.value.name; \
      } else if( \
         MLISP_TYPE_ ## const_name == num.type && \
         MLISP_ENV_FLAG_ARI_DIV == (MLISP_ENV_FLAG_ARI_DIV & flags) \
      ) { \
         debug_printf( MLISP_EXEC_TRACE_LVL, \
            "%u: arithmetic: %d / " fmt, exec->uid, num_out, num.value.name ); \
         num_out /= num.value.name; \
 
   for( i = 0 ; args_c - 1 > i ; i++ ) {
      retval = mlisp_stack_pop( exec, &num );
      maug_cleanup_if_not_ok();
 
      if( 0 ) {
      MLISP_NUM_TYPE_TABLE( _MLISP_TYPE_TABLE_ARI2 )
 
      } else if(
         MLISP_TYPE_INT == num.type &&
         MLISP_ENV_FLAG_ARI_MOD == (MLISP_ENV_FLAG_ARI_MOD & flags)
      ) {
         /* Modulus is a special case, as you can't mod by float. */
         debug_printf( MLISP_EXEC_TRACE_LVL,
            "%u: arithmetic: %d %% %d", exec->uid, num_out, num.value.integer );
         num_out %= num.value.integer;
      } else {
         error_printf( "arithmetic: invalid type!" );
         retval = MERROR_EXEC;
         goto cleanup;
      }
   }
 
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: arithmetic result: %d", exec->uid, num_out );
 
   retval = mlisp_stack_push( exec, num_out, int16_t );
 
cleanup:
 
   mdata_strpool_unlock( &(parser->strpool) );
 
   return retval;
}
 
/* === */
 
static MERROR_RETVAL _mlisp_env_cb_define(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec, size_t n_idx,
   size_t args_c, void* cb_data, uint8_t flags
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_STACK_NODE key;
   struct MLISP_STACK_NODE val;
   MAUG_MHANDLE key_tmp_h = (MAUG_MHANDLE)NULL;
   char* key_tmp = NULL;
   uint8_t global = 0;
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL, "%u: entering define callback...",
      exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   retval = mlisp_stack_pop( exec, &val );
   maug_cleanup_if_not_ok();
 
   retval = mlisp_stack_pop( exec, &key );
   maug_cleanup_if_not_ok();
 
   if( MLISP_TYPE_STR != key.type ) {
      /* TODO: Do we want to allow defining other types? */
      /* TODO: We can use _mlisp_eval_token_strpool, maybe? */
      error_printf( "define: invalid key type: %d", key.type );
      retval = MERROR_EXEC;
      goto cleanup;
   }
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: extracting define term for idx: " SIZE_T_FMT,
      exec->uid, key.value.strpool_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   key_tmp_h = mdata_strpool_extract(
      &(parser->strpool), key.value.strpool_idx );
   /* TODO: Handle this gracefully. */
   assert( (MAUG_MHANDLE)NULL != key_tmp_h );
 
   maug_mlock( key_tmp_h, key_tmp );
   maug_cleanup_if_null_lock( char*, key_tmp );
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: define \"%s\" (strpool(" SIZE_T_FMT "))...",
      exec->uid, key_tmp, key.value.strpool_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   /* Figure out the env to use. */
   if(
      MLISP_ENV_FLAG_DEFINE_GLOBAL == (MLISP_ENV_FLAG_DEFINE_GLOBAL & flags)
   ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: using global env...", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
      global = 1;
   }
 
   /* Perform the insertion. */
   retval = mlisp_env_set(
      exec, key_tmp, maug_strlen( key_tmp ), val.type, &(val.value),
      global, 0 );
   maug_cleanup_if_not_ok();
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: setup env node: %s",
      exec->uid, key_tmp );
#endif /* MLISP_EXEC_TRACE_LVL */
 
cleanup:
 
   if( NULL != key_tmp ) {
      maug_munlock( key_tmp_h, key_tmp );
   }
 
   if( (MAUG_MHANDLE)NULL != key_tmp_h ) {
      maug_mfree( key_tmp_h );
   }
 
   return retval;
}
 
/* === */
 
static MERROR_RETVAL _mlisp_env_cb_if(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec, size_t n_idx,
   size_t args_c, void* cb_data, uint8_t flags
) {
   MERROR_RETVAL retval = MERROR_OK;
   size_t* p_if_child_idx = NULL;
   struct MLISP_STACK_NODE s;
   struct MLISP_AST_NODE* n = NULL;
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: qrqrqrqrqr STEP IF qrqrqrqrqr", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   /* Grab the current exec index for the child vector for this node. */
   assert( mdata_vector_is_locked( &(exec->per_node_child_idx) ) );
   p_if_child_idx = mdata_vector_get(
      &(exec->per_node_child_idx), n_idx, size_t );
   assert( NULL != p_if_child_idx );
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: node " SIZE_T_FMT " child idx: " SIZE_T_FMT,
      exec->uid, n_idx, *p_if_child_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   n = mdata_vector_get( &(parser->ast), n_idx, struct MLISP_AST_NODE );
 
   if( 0 == *p_if_child_idx ) {
      /* Evaluating if condition. */
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: stepping into condition...", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
      retval = _mlisp_step_iter(
         parser, n->ast_idx_children[*p_if_child_idx], exec );
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: ...stepped out of condition", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
 
      /* Vary the child we jump to based on the boolean val on the stack. */
      if( MERROR_OK == retval ) {
         /* Condition evaluation complete. */
 
         /* Pop the result and check it. */
         retval = mlisp_stack_pop( exec, &s );
         maug_cleanup_if_not_ok();
         if( MLISP_TYPE_BOOLEAN != s.type ) {
            error_printf( "(if) can only evaluate boolean type!" );
            retval = MERROR_EXEC;
            goto cleanup;
         }
 
         /* Set the child pointer to 1 if TRUE and 2 if FALSE. */
         retval = _mlisp_preempt(
            retval, "if", parser, n_idx, exec,
            /* Flip boolean and increment. */
            (1 - s.value.boolean) + 1 );
      }
 
   } else if( args_c > *p_if_child_idx ) { /* 3 if else present, else 2. */
      /* Pursuing TRUE or FALSE clause. */
 
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: descending into IF path: " SIZE_T_FMT,
         exec->uid, *p_if_child_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
      
      /* Prepare for stepping. */
 
      /* Step and check. */
      retval = _mlisp_step_iter(
         parser, n->ast_idx_children[*p_if_child_idx], exec );
      retval = _mlisp_preempt(
         retval, "if", parser, n_idx, exec, 3 );
   }
 
cleanup:
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: qrqrqrqrqr END STEP IF qrqrqrqrqr", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   return retval;
}
 
/* === */
 
#ifndef MAUG_NO_RETRO
/* TODO: Define this callback in retroflat in line with dependency guidelines.
 */
 
static MERROR_RETVAL _mlisp_env_cb_random(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec, size_t n_idx,
   size_t args_c, void* cb_data, uint8_t flags
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_STACK_NODE mod;
   int16_t random_int = 0;
 
   retval = mlisp_stack_pop( exec, &mod );
   maug_cleanup_if_not_ok();
 
   if( MLISP_TYPE_INT != mod.type ) {
      /* TODO: Setup float. */
      error_printf( "random: invalid modulus type: %d", mod.type );
      retval = MERROR_EXEC;
      goto cleanup;
   }
 
   random_int = retroflat_get_rand() % mod.value.integer;
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: random: %d", exec->uid, random_int ); 
#endif /* MLISP_EXEC_TRACE_LVL */
 
   mlisp_stack_push( exec, random_int, int16_t );
 
cleanup:
 
   return retval;
}
 
#endif /* !MAUG_NO_RETRO */
 
/* === */
 
static MERROR_RETVAL _mlisp_env_cb_ano(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec, size_t n_idx,
   size_t args_c, void* cb_data, uint8_t flags
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_STACK_NODE val;
   mlisp_bool_t val_out =
      MLISP_ENV_FLAG_ANO_OR == (MLISP_ENV_FLAG_ANO_OR & flags) ?
      0 : 1;
   size_t i = 0;
 
   /* TODO: Switch this to a step_or() function so that we can opt not to
    *       evaluate conditions unless prior stepped children are false.
    */
 
   for( i = 0 ; args_c > i ; i++ ) {
      retval = mlisp_stack_pop( exec, &val );
      maug_cleanup_if_not_ok();
 
      if( MLISP_TYPE_BOOLEAN != val.type ) {
         error_printf( "or: invalid boolean type: %d", val.type );
      }
 
      if( val.value.boolean ) {
#if MLISP_EXEC_TRACE_LVL > 0
         debug_printf( MLISP_EXEC_TRACE_LVL, "%u: found TRUE in %s!",
            exec->uid,
            MLISP_ENV_FLAG_ANO_OR == (MLISP_ENV_FLAG_ANO_OR & flags) ?
            "or" : "and" );
#endif /* MLISP_EXEC_TRACE_LVL */
         val_out =
            MLISP_ENV_FLAG_ANO_OR == (MLISP_ENV_FLAG_ANO_OR & flags) ? 1 : 0;
      }
   }
 
   retval = _mlisp_stack_push_mlisp_bool_t( exec, val_out );
 
cleanup:
 
   return retval;
}
 
/* === */
 
/* Execution Functions */
 
/* === */
 
static MERROR_RETVAL _mlisp_preempt(
   MERROR_RETVAL retval, const char* caller, struct MLISP_PARSER* parser,
   size_t n_idx, struct MLISP_EXEC_STATE* exec, size_t new_idx
) {
   struct MLISP_AST_NODE* n = NULL;
   size_t* p_child_idx = NULL;
 
   assert( mdata_vector_is_locked( &(exec->per_node_child_idx) ) );
   p_child_idx = mdata_vector_get(
      &(exec->per_node_child_idx), n_idx, size_t );
   assert( NULL != p_child_idx );
 
   n = mdata_vector_get( &(parser->ast), n_idx, struct MLISP_AST_NODE );
 
   if( 0 < n->token_idx ) {
      mdata_strpool_lock( &(parser->strpool) );
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: eval step " SSIZE_T_FMT " under (%s) %s...",
         exec->uid, *p_child_idx, caller,
         mdata_strpool_get( &(parser->strpool), n->token_idx ) );
#endif /* MLISP_EXEC_TRACE_LVL */
      mdata_strpool_unlock( &(parser->strpool) );
#if MLISP_EXEC_TRACE_LVL > 0
   } else {
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: eval step " SSIZE_T_FMT " under (%s) (empty token)...",
         exec->uid, *p_child_idx, caller );
#endif /* MLISP_EXEC_TRACE_LVL */
   }
 
   if( MERROR_OK != retval ) {
      /* Something bad happened, so don't increment! */
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: not incrementing node " SIZE_T_FMT " child idx from "
            SIZE_T_FMT " (retval: 0x%x)!",
         exec->uid, n_idx, *p_child_idx, retval );
#endif /* MLISP_EXEC_TRACE_LVL */
      goto cleanup;
   }
 
   /* Could not exec *this* node yet, so don't increment its parent. */
   retval = MERROR_PREEMPT;
 
   /* Increment this node, since the child actually executed. */
   (*p_child_idx) = new_idx;
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: incremented node " SIZE_T_FMT " child idx to: " SIZE_T_FMT,
      exec->uid, n_idx, *p_child_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
cleanup:
 
   assert( !mdata_strpool_is_locked( &(parser->strpool) ) );
 
   return retval;
}
 
/* === */
 
static MERROR_RETVAL _mlisp_step_iter_children(
   struct MLISP_PARSER* parser, size_t n_idx, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
   size_t* p_child_idx = NULL;
   struct MLISP_AST_NODE* n = NULL;
 
   /* Grab the current exec index for the child vector for this node. */
   assert( mdata_vector_is_locked( &(exec->per_node_child_idx) ) );
   p_child_idx = mdata_vector_get(
      &(exec->per_node_child_idx), n_idx, size_t );
   assert( NULL != p_child_idx );
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: node " SIZE_T_FMT " child idx: " SIZE_T_FMT,
      exec->uid, n_idx, *p_child_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   n = mdata_vector_get( &(parser->ast), n_idx, struct MLISP_AST_NODE );
 
   if(
      (
         MLISP_AST_FLAG_LAMBDA == (MLISP_AST_FLAG_LAMBDA & n->flags) &&
         0 == *p_child_idx
      ) ||
      MLISP_AST_FLAG_IF == (MLISP_AST_FLAG_IF & n->flags) 
   ) {
      /* A lambda definition was found, and its exec counter is still pointing
       * to the arg list. This means the lambda was *not* called on the last
       * heartbeat, and we're probably just enountering its definition.
       *
       * Lambdas are lazily evaluated, so don't pursue it further until it's
       * called (stee _mlisp_step_lambda() for more info on this.
       */
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: skipping lambda children...", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
      goto cleanup;
   }
 
   if( mlisp_ast_has_ready_children( *p_child_idx, n ) ) {
      /* Call the next uncalled child. */
 
      if(
         MLISP_AST_FLAG_DEFINE == (MLISP_AST_FLAG_DEFINE & n->flags) &&
         0 == *p_child_idx
      ) {
         /* The next child is a term to be defined. */
#if MLISP_EXEC_TRACE_LVL > 0
         debug_printf( MLISP_EXEC_TRACE_LVL,
            "%u: setting MLISP_EXEC_FLAG_DEF_TERM!", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
         exec->flags |= MLISP_EXEC_FLAG_DEF_TERM;
      } else {
         exec->flags &= ~MLISP_EXEC_FLAG_DEF_TERM;
      }
 
      /* Step and check. */
      retval = _mlisp_step_iter(
         parser, n->ast_idx_children[*p_child_idx], exec );
      retval = _mlisp_preempt(
         retval, "node", parser, n_idx, exec, (*p_child_idx) + 1 );
      goto cleanup;
   }
 
cleanup:
 
   return retval;
}
 
/* === */
 
static MERROR_RETVAL _mlisp_step_lambda_args(
   struct MLISP_PARSER* parser, size_t n_idx, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
   ssize_t arg_idx = 0;
   struct MLISP_STACK_NODE stack_n_arg;
   struct MLISP_AST_NODE* ast_n_arg = NULL;
   MAUG_MHANDLE key_tmp_h = (MAUG_MHANDLE)NULL;
   char* key_tmp = NULL;
   struct MLISP_AST_NODE* n = NULL;
   int16_t null_val = 0;
 
   /* Pop stack into args into the env. These are all the results of previous
    * evaluations, before the lambda call, so we can just grab them all in
    * one go!
    */
 
   /* Create a new env and bump up env_select. */
   if( MLISP_EXEC_ENV_FRAME_CT_MAX > exec->env_select + 1 ) {
      exec->env_select++;
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL, "selecting env frame: %d",
         exec->env_select );
#endif /* MLISP_EXEC_TRACE_LVL */
      assert( 0 == mdata_table_ct( &(exec->env[exec->env_select]) ) );
 
      /* Toss a constant into the new env so it's not as wonky. */
      retval = mlisp_env_set(
         exec, "null", 4, MLISP_TYPE_INT, &null_val, 0, 0 );
   } else {
      error_printf( "env frame overflow!" );
      retval = MERROR_OVERFLOW;
      goto cleanup;
   }
 
   /* Get the current args node. */
   n = mdata_vector_get( &(parser->ast), n_idx, struct MLISP_AST_NODE );
   arg_idx = n->ast_idx_children_sz - 1;
 
   while( 0 <= arg_idx ) {
      
      retval = mlisp_stack_pop( exec, &stack_n_arg );
      maug_cleanup_if_not_ok();
 
      ast_n_arg = mdata_vector_get(
         &(parser->ast), n->ast_idx_children[arg_idx],
         struct MLISP_AST_NODE );
 
      /* Pull out the arg name from the strpool so we can call env_set(). */
      key_tmp_h = mdata_strpool_extract(
         &(parser->strpool), ast_n_arg->token_idx );
      /* TODO: Handle this gracefully. */
      assert( (MAUG_MHANDLE)NULL != key_tmp_h );
 
      maug_mlock( key_tmp_h, key_tmp );
      maug_cleanup_if_null_lock( char*, key_tmp );
 
      retval = mlisp_env_set(
         exec, key_tmp, 0, stack_n_arg.type, &(stack_n_arg.value), 0, 0 );
      maug_cleanup_if_not_ok();
 
      maug_munlock( key_tmp_h, key_tmp );
      maug_mfree( key_tmp_h );
 
      arg_idx--;
   }
 
cleanup:
 
   if( NULL != key_tmp ) {
      maug_munlock( key_tmp_h, key_tmp );
   }
 
   if( (MAUG_MHANDLE)NULL != key_tmp_h ) {
      maug_mfree( key_tmp_h );
   }
 
   return retval;
}
 
/* === */
 
static MERROR_RETVAL _mlisp_reset_child_pcs(
   const struct MLISP_PARSER* parser,
   size_t n_idx, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
   size_t* p_child_idx = NULL;
   size_t* p_visit_ct = NULL;
   struct MLISP_AST_NODE* n = NULL;
   size_t i = 0;
 
   assert( mdata_vector_is_locked( &(exec->per_node_child_idx) ) );
   assert( mdata_vector_is_locked( &(parser->ast) ) );
 
   /* Perform the actual reset. */
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: resetting node " SIZE_T_FMT " child idx to 0", exec->uid, n_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
   p_child_idx = mdata_vector_get( &(exec->per_node_child_idx), n_idx, size_t );
   assert( NULL != p_child_idx );
   *p_child_idx = 0;
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: resetting node " SIZE_T_FMT " visit count to 0", exec->uid, n_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
   p_visit_ct = mdata_vector_get( &(exec->per_node_visit_ct), n_idx, size_t );
   assert( NULL != p_visit_ct );
   *p_visit_ct = 0;
 
   n = mdata_vector_get( &(parser->ast), n_idx, struct MLISP_AST_NODE );
 
   /* Call reset on all children. */
   for( i = 0 ;  n->ast_idx_children_sz > i ; i++ ) {
      retval = _mlisp_reset_child_pcs( parser, n->ast_idx_children[i], exec );
      maug_cleanup_if_not_ok();
   }
 
cleanup:
 
   return retval;
}
 
/* === */
 
static MERROR_RETVAL _mlisp_reset_lambda(
   const struct MLISP_PARSER* parser,
   size_t n_idx, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: resetting lambda " SIZE_T_FMT "...", exec->uid, n_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   assert( mdata_vector_is_locked( &(exec->per_node_child_idx) ) );
 
   /* Move up one env frame. */
   assert( !mdata_table_is_locked( &(exec->env[exec->env_select]) ) );
   assert( 0 < exec->env_select );
   mdata_table_free( &(exec->env[exec->env_select]) );
   exec->env_select--;
 
   /* Reset per-node program counters. */
   retval = _mlisp_reset_child_pcs( parser, n_idx, exec );
 
   return retval;
}
 
/* === */
 
/* This is internal-only and should only be called from _mlisp_step_iter()! */
static MERROR_RETVAL _mlisp_step_lambda(
   struct MLISP_PARSER* parser,
   size_t n_idx, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
   size_t* p_lambda_child_idx = NULL;
   size_t* p_args_child_idx = NULL;
   struct MLISP_AST_NODE* n = NULL;
   size_t* p_n_last_lambda = NULL;
   ssize_t append_retval = 0;
 
#ifdef MLISP_DEBUG_TRACE
   exec->trace[exec->trace_depth++] = n_idx;
   assert( exec->trace_depth <= MLISP_DEBUG_TRACE );
#endif /* MLISP_DEBUG_TRACE */
 
   /* n_idx is the node of this lambda. */
   mdata_vector_lock( &(exec->lambda_trace) );
   p_n_last_lambda = mdata_vector_get_last( &(exec->lambda_trace), size_t );
   mdata_vector_unlock( &(exec->lambda_trace) );
   if( NULL != p_n_last_lambda && n_idx == *p_n_last_lambda ) {
      /* This is a recursive call, so get rid of the lambda context so we can
       * replace it with a new one afterwards.
       */
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL, "%u: TRACE TAIL TIME!", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
      /*
      assert(
         !mdata_table_is_locked( &(exec->env) ) );
      */
      _mlisp_reset_lambda( parser, n_idx, exec );
      retval = mdata_vector_remove_last( &(exec->lambda_trace) );
      maug_cleanup_if_not_ok();
   }
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: xvxvxvxvxvxvx STEP LAMBDA " SIZE_T_FMT " xvxvxvxvxvx",
      exec->uid, n_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   /* Note that we passed through this lambda to detect tail calls later. */
   append_retval = mdata_vector_append(
      &(exec->lambda_trace), &n_idx, sizeof( size_t ) );
   retval = mdata_retval( append_retval );
   maug_cleanup_if_not_ok();
 
   /* Grab the current exec index for the child vector for this node. */
   assert( mdata_vector_is_locked( &(exec->per_node_child_idx) ) );
   p_lambda_child_idx = mdata_vector_get(
      &(exec->per_node_child_idx), n_idx, size_t );
   assert( NULL != p_lambda_child_idx );
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: lambda node " SIZE_T_FMT " child idx: " SIZE_T_FMT,
      exec->uid, n_idx, *p_lambda_child_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   n = mdata_vector_get( &(parser->ast), n_idx, struct MLISP_AST_NODE );
   
   /* There needs to be an arg node and an exec node. */
   /* TODO: Handle this gracefully. */
   assert( 1 < n->ast_idx_children_sz );
 
   if( 0 == *p_lambda_child_idx ) {
      /* Parse the args passed to this lambda into the env, temporarily. */
 
      /* Get the current args node child index. */
      assert( mdata_vector_is_locked( &(exec->per_node_child_idx) ) );
      p_args_child_idx = mdata_vector_get(
         &(exec->per_node_child_idx),
         n->ast_idx_children[*p_lambda_child_idx], size_t );
      assert( NULL != p_args_child_idx );
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: child idx for args AST node " SIZE_T_FMT ": " SIZE_T_FMT,
         exec->uid, *p_lambda_child_idx, *p_args_child_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
      /* Pop stack into args in the env. */
      retval = _mlisp_step_lambda_args(
         parser, n->ast_idx_children[*p_lambda_child_idx], exec );
      if( MERROR_OK != retval && MERROR_PREEMPT != retval ) {
         /* Something bad happened! */
         goto cleanup;
      }
 
      if( MERROR_OK == retval ) {
         /* Set *after-arg* delimiter in env after last arg. */
         /*
         retval = mlisp_env_set(
            parser, exec, "$ARGS_E$", 0, MLISP_TYPE_ARGS_E, &n_idx, NULL, 0 );
         maug_cleanup_if_not_ok();
         */
 
         /* Increment child idx so we call the exec child on next heartbeat. */
         (*p_lambda_child_idx)++;
#if MLISP_EXEC_TRACE_LVL > 0
         debug_printf( MLISP_EXEC_TRACE_LVL,
            "%u: incremented node " SIZE_T_FMT " child idx to: " SIZE_T_FMT,
            exec->uid, n_idx, *p_lambda_child_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
      }
 
      /* Set the error to MERROR_PREEMPT so that caller knows this lambda isn't
       * finished executing.
       */
      retval = MERROR_PREEMPT;
 
   } else if( mlisp_ast_has_ready_children( *p_lambda_child_idx, n ) ) {
      /* Dive into first lambda child until we no longer can. */
 
      /*
      assert(
         !mdata_table_is_locked( &(exec->env) ) );
      */
      assert(
         NULL == exec->global_env ||
         !mdata_table_is_locked( exec->global_env ) );
 
      retval = _mlisp_step_iter(
         parser, n->ast_idx_children[*p_lambda_child_idx], exec );
 
      retval = _mlisp_preempt(
         retval, "lambda", parser, n_idx, exec, (*p_lambda_child_idx) + 1 );
 
   } else {
      /* No more children to execute! */
      /* assert(
         !mdata_table_is_locked( &(exec->env) ) ); */
      assert(
         NULL == exec->global_env ||
         !mdata_table_is_locked( exec->global_env ) );
      _mlisp_reset_lambda( parser, n_idx, exec );
   }
 
   /* TODO: If MERROR_PREEMPT is not returned, remove args_s and args_e? */
 
cleanup:
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: xvxvxvxvxvxvx END STEP LAMBDA " SIZE_T_FMT " xvxvxvxvxvx",
      exec->uid, n_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   /* Cleanup the passthrough note for this heartbeat. */
   mdata_vector_remove_last( &(exec->lambda_trace) );
 
   return retval;
}
 
/* === */
 
static MERROR_RETVAL _mlisp_stack_cleanup(
   struct MLISP_PARSER* parser, size_t n_idx, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
   ssize_t i = 0;
   struct MLISP_STACK_NODE o;
 
   /* Pop elements off the stack until we hit the matching begin frame. */
   i = mdata_vector_ct( &(exec->stack) ) - 1;
   while( 0 <= i ) {
      
      retval = mlisp_stack_pop( exec, &o );
      maug_cleanup_if_not_ok();
 
      if( MLISP_TYPE_BEGIN == o.type && n_idx == o.value.begin ) {
         break;
      }
 
      i--;
   }
 
cleanup:
 
   return retval;
}
 
/* === */

static MERROR_RETVAL _mlisp_eval_token_strpool(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec,
   size_t token_idx, size_t token_sz, struct MLISP_ENV_NODE* e_out
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_ENV_NODE* p_e = NULL;
   char* strpool_token = NULL;
 
   /* Make sure we're sharing env context with our caller! */
   /* assert(
      mdata_table_is_locked( &(exec->env) ) ); */
   assert( /* Also make sure we're sharing ctx for global env if present! */
      NULL == exec->global_env ||
      mdata_table_is_locked( exec->global_env ) );
 
   mdata_strpool_lock( &(parser->strpool) );
 
   /* TODO: Use exec_state strpool. */
   strpool_token = mdata_strpool_get( &(parser->strpool), token_idx );
   assert( NULL != strpool_token );
   
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: eval token: \"%s\" (strlen: " SIZE_T_FMT "r/" SIZE_T_FMT "d)",
      exec->uid, strpool_token, token_sz, maug_strlen( strpool_token ) );
#endif /* MLISP_EXEC_TRACE_LVL */
   if( 0 == strncmp( strpool_token, "begin", token_sz ) ) {
      /* Fake env node e to signal step_iter() to place/cleanup stack frame. */
      e_out->type = MLISP_TYPE_BEGIN;
 
   } else if( NULL != (p_e = mlisp_env_get( exec, strpool_token ) ) ) {
      /* A literal found in the environment. */
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL, "%u: found %s in env!",
         exec->uid, strpool_token );
#endif /* MLISP_EXEC_TRACE_LVL */
 
      /* Copy onto native stack so we can unlock env in case this is a
       * callback that needs to execute. */
      memcpy( e_out, p_e, sizeof( struct MLISP_ENV_NODE ) );
      p_e = NULL;
 
   } else if( maug_is_num( strpool_token, token_sz, 10, 1 ) ) {
      /* Fake env node e from a numeric literal. */
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: did not find %s in env, but it is a number...",
         exec->uid, strpool_token );
#endif /* MLISP_EXEC_TRACE_LVL */
      e_out->value.integer = maug_atos32( strpool_token, token_sz );
      e_out->type = MLISP_TYPE_INT;
 
   } else if( maug_is_float( strpool_token, token_sz ) ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: did not find %s in env, but it is a float...",
         exec->uid, strpool_token );
#endif /* MLISP_EXEC_TRACE_LVL */
      /* Fake env node e from a floating point numeric literal. */
      e_out->value.floating = maug_atof( strpool_token, token_sz );
      e_out->type = MLISP_TYPE_FLOAT;
 
   } else {
#if MLISP_EXEC_TRACE_LVL > 0
      error_printf( "%u: could not make sense of token: %s",
         exec->uid, strpool_token );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   }
 
cleanup:
 
   if( mdata_strpool_is_locked( &(parser->strpool) ) ) {
      mdata_strpool_unlock( &(parser->strpool) );
   }
 
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL, "%u: eval token complete!",
         exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   return retval;
}
 
static MERROR_RETVAL _mlisp_step_iter(
   struct MLISP_PARSER* parser,
   size_t n_idx, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_ENV_NODE e;
   struct MLISP_AST_NODE* n = NULL;
   size_t* p_visit_ct = NULL;
   mlisp_env_cb_t e_cb = NULL;
   uint8_t e_flags = 0;
   mlisp_lambda_t e_lambda = 0;
   int8_t env_iter = 0;
 
   /* With -O2, gcc seems to sometimes(?) push an arbitrary integer to the
    * stack, unless we use this variable force it to pass the literal index.
    * This *seems* to resolve the issue.
    */
   volatile mdata_strpool_idx_t node_strpool_idx = 0;
 
#ifdef MLISP_DEBUG_TRACE
   exec->trace[exec->trace_depth++] = n_idx;
   assert( exec->trace_depth <= MLISP_DEBUG_TRACE );
#endif /* MLISP_DEBUG_TRACE */
 
   n = mdata_vector_get( &(parser->ast), n_idx, struct MLISP_AST_NODE );
 
   assert( mdata_vector_is_locked( &(exec->per_node_visit_ct) ) );
   p_visit_ct = mdata_vector_get(
      &(exec->per_node_visit_ct), n_idx, size_t );
   assert( NULL != p_visit_ct );
   (*p_visit_ct)++;
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: visit count for AST node " SIZE_T_FMT ": " SIZE_T_FMT,
      exec->uid, n_idx, *p_visit_ct );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   /* Push a stack frame marker on the first visit to a BEGIN node. */
   if(
      MLISP_AST_FLAG_BEGIN == (MLISP_AST_FLAG_BEGIN & n->flags) &&
      1 == *p_visit_ct
   ) {
      /* Push a stack frame on first visit. */
      retval = _mlisp_stack_push_mlisp_begin_t( exec, n_idx );
      maug_cleanup_if_not_ok();
   }
 
   if(
      MERROR_OK !=
      (retval = _mlisp_step_iter_children( parser, n_idx, exec ))
   ) {
      goto cleanup;
   }
 
   /* Check for special types like lambda, that are lazily evaluated. */
   if( MLISP_AST_FLAG_LAMBDA == (MLISP_AST_FLAG_LAMBDA & n->flags) ) {
      /* Push the lambda to the stack so that the "define" above it can
       * grab it and associate it with the env.
       */
      /* TODO: Assert node above it is a define! */
      mlisp_stack_push( exec, n_idx, mlisp_lambda_t );
      goto cleanup;
   }
 
   /* Now that the children have been evaluated above, evaluate this node.
    * Assume all the previously called children are now on the stack.
    */
 
   /* Lock the env so we can grab the token from it and evalauate it below
    * in one swoop without an unlock.
    */
   for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: locking local env %d...", exec->uid, env_iter );
#endif /* MLISP_EXEC_TRACE_LVL */
      mdata_table_lock( &(exec->env[env_iter]) );
   }
 
   assert(
      NULL == exec->global_env || !mdata_table_is_locked( exec->global_env ) );
   if( NULL != exec->global_env ) {
      mdata_table_lock( exec->global_env );
   }
 
   /* Grab the token for this node and figure out what it is. */
   retval = _mlisp_eval_token_strpool(
      parser, exec, n->token_idx, n->token_sz, &e );
   maug_cleanup_if_not_ok();
 
   /* Prepare to step. */
 
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL, "%u: acting on evaluated token...",
         exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   /* Put the token or its result (if callable) on the stack. */
#  define _MLISP_TYPE_TABLE_ENVE( idx, ctype, name, const_name, fmt ) \
   } else if( MLISP_TYPE_ ## const_name == e.type ) { \
      debug_printf( MLISP_EXEC_TRACE_LVL, \
         "%u: pushing env: " fmt " to stack...", \
         exec->uid, e.value.name ); \
      retval = _mlisp_stack_push_ ## ctype( exec, e.value.name ); \
      maug_cleanup_if_not_ok();
 
   if( MLISP_EXEC_FLAG_DEF_TERM == (MLISP_EXEC_FLAG_DEF_TERM & exec->flags) ) {
      /* Avoid a deadlock when *re*-assigning terms caused by term being
       * evaluated before it is defined.
       */
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: special case! pushing literal to stack: " SSIZE_T_FMT,
         exec->uid, n->token_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
      node_strpool_idx = n->token_idx;
      retval = _mlisp_stack_push_mdata_strpool_idx_t( exec, node_strpool_idx );
      maug_cleanup_if_not_ok();
   } else if( MLISP_TYPE_BEGIN == e.type ) {
      /* Cleanup the stack that's been pushed by children since this BEGIN's
       * initial visit.
       */
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: rewinding stack for begin on node " SSIZE_T_FMT,
         exec->uid, n_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
      retval = _mlisp_stack_cleanup( parser, n_idx, exec );
      maug_cleanup_if_not_ok();
 
      /* Push a replacement BEGIN that can be caught later and throw an
       * MERROR_RESET.
       */
      retval = _mlisp_stack_push_mlisp_begin_t( exec, n_idx );
      maug_cleanup_if_not_ok();
 
   } else if( MLISP_TYPE_CB == e.type ) {
      /* This is a special case... rather than pushing the callback, *execute*
       * it and let it push its result to the stack. This will create a 
       * redundant case below, but that can't be helped...
       */
 
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: special case! executing callback: %p", exec->uid, e_cb );
#endif /* MLISP_EXEC_TRACE_LVL */
 
      /* Unlock the env so the callback below can use it if needed. */
      e_cb = e.value.cb;
      e_flags = e.flags;
      for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
         mdata_table_unlock( &(exec->env[env_iter]) );
      }
      if( NULL != exec->global_env ) {
         mdata_table_unlock( exec->global_env );
      }
 
      retval = e_cb(
         parser, exec, n_idx, n->ast_idx_children_sz, NULL, e_flags );
 
      /* Relock it for the benefit of the unlock in cleanup. */
      for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
         mdata_table_lock( &(exec->env[env_iter]) );
      }
      if( NULL != exec->global_env ) {
         mdata_table_lock( exec->global_env );
      }
 
   } else if( MLISP_TYPE_LAMBDA == e.type ) {
 
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: special case! executing lambda...", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
 
      /* Create a "portal" into the lambda. The execution chain stays pointing
       * to this lambda-call node, but _mlisp_step_lambda() returns
       * MERROR_PREEMPT up the chain for subsequent heartbeats, until lambda is
       * done.
       */
      e_lambda = e.value.lambda;
      for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
         mdata_table_unlock( &(exec->env[env_iter]) );
      }
      if( NULL != exec->global_env ) {
         mdata_table_unlock( exec->global_env );
      }
 
      retval = _mlisp_step_lambda( parser, e_lambda, exec );
 
      /* Relock it for the benefit of the unlock in cleanup. */
      for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
         mdata_table_lock( &(exec->env[env_iter]) );
      }
      if( NULL != exec->global_env ) {
         mdata_table_lock( exec->global_env );
      }
 
   MLISP_TYPE_TABLE( _MLISP_TYPE_TABLE_ENVE )
   } else {
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL, "pushing literal into stack" );
#endif /* !MLISP_EXEC_TRACE_LVL */
      retval = _mlisp_stack_push_mdata_strpool_idx_t( exec, n->token_idx );
      maug_cleanup_if_not_ok();
   }
 
cleanup:
 
   for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
      mdata_table_unlock( &(exec->env[env_iter]) );
   }
 
   if( NULL != exec->global_env ) {
      mdata_table_unlock( exec->global_env );
   }
 
   return retval;
}
 
/* === */
 
static MERROR_RETVAL _mlisp_count_builtins_iter(
   const struct MDATA_TABLE_KEY* key, void* data, size_t data_sz,
   void* cb_data, size_t cb_data_sz, size_t idx
) {
   MERROR_RETVAL retval = MERROR_OK;
   struct MLISP_ENV_NODE* e = (struct MLISP_ENV_NODE*)data;
   ssize_t* p_builtins = (ssize_t*)cb_data;
 
   if( MLISP_ENV_FLAG_BUILTIN == (MLISP_ENV_FLAG_BUILTIN & e->flags) ) {
      (*p_builtins)++;
   }
 
   return retval;
}
 
/* === */
 
ssize_t mlisp_count_builtins( struct MLISP_EXEC_STATE* exec ) {
   MERROR_RETVAL retval = MERROR_OK;
   ssize_t builtins = 0;
   int autolock = 0;
 
   if( 0 == mdata_table_ct( &(exec->env[0]) ) ) {
      goto cleanup;
   }
 
   if( !mdata_table_is_locked( &(exec->env[0]) ) ) {
      mdata_table_lock( &(exec->env[0]) );
      autolock = 1;
   }
 
   retval = mdata_table_iter(
      &(exec->env[0]), _mlisp_count_builtins_iter, &builtins, 0 );
 
cleanup:
 
   if( MERROR_OK != retval ) {
      builtins = merror_retval_to_sz( retval );
   }
 
   if( autolock ) {
      mdata_table_unlock( &(exec->env[0]) );
   }
 
   return builtins;
}
 
/* === */
 
MERROR_RETVAL mlisp_check_state(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
 
   if( !mlisp_check_ast( parser  ) ) {
      error_printf( "no valid AST present; could not exec!" );
      retval = MERROR_EXEC;
      goto cleanup;
   }
 
   if(
      MLISP_EXEC_FLAG_INITIALIZED != (exec->flags & MLISP_EXEC_FLAG_INITIALIZED)
   ) {
      retval = MERROR_EXEC;
      goto cleanup;
   }
 
cleanup:
 
   return retval;
}
 
/* === */
 
MERROR_RETVAL mlisp_step(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
#ifdef MLISP_DEBUG_TRACE
   size_t i = 0;
   char trace_str[MLISP_DEBUG_TRACE * 5];
   maug_ms_t ms_start = 0;
   maug_ms_t ms_end = 0;
 
   ms_start = retroflat_get_ms();
#endif /* MLISP_DEBUG_TRACE */
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL, "%u: heartbeat start", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   /* These can remain locked for the whole step, as they're never added or
    * removed.
    */
   assert( !mdata_vector_is_locked( &(exec->per_node_child_idx) ) );
   assert( !mdata_vector_is_locked( &(exec->per_node_visit_ct) ) );
   assert( !mdata_vector_is_locked( &(parser->ast) ) );
   mdata_vector_lock( &(exec->per_node_child_idx) );
   mdata_vector_lock( &(exec->per_node_visit_ct) );
   mdata_vector_lock( &(parser->ast) );
 
   /* Disable transient flags. */
   exec->flags &= MLISP_EXEC_FLAG_TRANSIENT_MASK;
   assert( 0 == mdata_vector_ct( &(exec->lambda_trace) ) );
 
#ifdef MLISP_DEBUG_TRACE
   exec->trace_depth = 0;
#endif /* MLISP_DEBUG_TRACE */
 
   /* Find next unevaluated symbol. */
   retval = _mlisp_step_iter( parser, 0, exec );
   if( MERROR_PREEMPT == retval ) {
      /* There's still more to execute. */
      retval = MERROR_OK;
   } else if( MERROR_OK == retval ) {
      /* The last node executed completely. */
#if MLISP_EXEC_TRACE_LVL > 0
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: execution terminated successfully", exec->uid );
#endif /* MLISP_EXEC_TRACE_LVL */
      retval = MERROR_EXEC; /* Signal the caller: we're out of instructions! */
#if MLISP_EXEC_TRACE_LVL > 0
   } else {
      debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: execution terminated with retval: %d", exec->uid, retval );
#endif /* MLISP_EXEC_TRACE_LVL */
   }
 
#ifdef MLISP_DEBUG_TRACE
   ms_end = retroflat_get_ms();
 
   maug_mzero( trace_str, MLISP_DEBUG_TRACE * 5 );
   for( i = 0 ; exec->trace_depth > i ; i++ ) {
      maug_snprintf(
         &(trace_str[maug_strlen( trace_str )]),
         (MLISP_DEBUG_TRACE * 5) - maug_strlen( trace_str ),
         SIZE_T_FMT ", ", exec->trace[i] );
   }
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: " MLISP_TRACE_SIGIL " HBEXEC (%u): %s",
      exec->uid, ms_end - ms_start, trace_str );
#endif /* MLISP_EXEC_TRACE_LVL */
#endif /* MLISP_DEBUG_TRACE */
  
cleanup:
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
      "%u: heartbeat end: %x", exec->uid, retval );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   assert( mdata_vector_is_locked( &(parser->ast) ) );
   mdata_vector_unlock( &(parser->ast) );
   mdata_vector_unlock( &(exec->per_node_visit_ct) );
   mdata_vector_unlock( &(exec->per_node_child_idx) );
 
   return retval;
}
 
/* === */
 
MERROR_RETVAL mlisp_step_lambda(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec,
   const char* lambda
) {
   struct MLISP_ENV_NODE* e = NULL;
   MERROR_RETVAL retval = MERROR_OK;
   uint8_t autolock[MLISP_EXEC_ENV_FRAME_CT_MAX];
   mlisp_lambda_t lambda_idx = 0;
   struct MLISP_AST_NODE* n = NULL;
   int8_t env_iter = 0;
 
   if( MERROR_OK != mlisp_check_state( parser, exec ) ) {
      error_printf( "mlisp not ready!" );
      retval = MERROR_EXEC;
      goto cleanup;
   }
 
   retval = _mlisp_autolock( parser, exec, 0xff, autolock );
   maug_cleanup_if_not_ok();
 
   /* Find the AST node for the lambda. */
   e = mlisp_env_get( exec, lambda );
   if( NULL == e ) {
      error_printf( "lambda \"%s\" not found!", lambda );
      retval = MERROR_OVERFLOW;
      goto cleanup;
   }
   lambda_idx = e->value.lambda;
 
   /* Autounlock just env so _mlisp_step_lambda() works. */
   /* We use autolock with the env minimally to avoid passing around bad
    * pointers.
    */
   for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
      if( MLISP_AUTOLOCK_EXEC_ENV == (MLISP_AUTOLOCK_EXEC_ENV & autolock[0]) ) {
         mdata_table_unlock( &(exec->env[env_iter]) );
         autolock[env_iter] &= ~MLISP_AUTOLOCK_EXEC_ENV;
      }
   }
   if(
      MLISP_AUTOLOCK_GLOBAL_ENV == (MLISP_AUTOLOCK_GLOBAL_ENV & autolock[0])
   ) {
      mdata_table_unlock( exec->global_env );
      autolock[0] &= ~MLISP_AUTOLOCK_GLOBAL_ENV;
   }
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL, "%u: lambda \"%s\" is AST node idx %ld",
      exec->uid, lambda, lambda_idx );
#endif /* MLISP_EXEC_TRACE_LVL */
 
   n = mdata_vector_get( &(parser->ast), lambda_idx, struct MLISP_AST_NODE );
   assert( MLISP_AST_FLAG_LAMBDA == (MLISP_AST_FLAG_LAMBDA & n->flags) );
 
   /* Jump execution to the lambda on next iter. */
   retval = _mlisp_step_lambda( parser, lambda_idx, exec );
 
cleanup:
 
   _mlisp_autounlock( parser, exec, autolock );
 
   return retval;
}
 
/* === */
 
MERROR_RETVAL mlisp_exec_add_env_builtins(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec
) {
   MERROR_RETVAL retval = MERROR_OK;
 
   retval = mlisp_env_set(
      exec, "gdefine", 7, MLISP_TYPE_CB, _mlisp_env_cb_define,
      0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_DEFINE_GLOBAL );
   maug_cleanup_if_not_ok();
 
   retval = mlisp_env_set(
      exec, "and", 3, MLISP_TYPE_CB, _mlisp_env_cb_ano,
      0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ANO_AND );
   maug_cleanup_if_not_ok();
   
   retval = mlisp_env_set(
      exec, "or", 2, MLISP_TYPE_CB, _mlisp_env_cb_ano,
      0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ANO_OR );
   maug_cleanup_if_not_ok();
   
#ifndef MAUG_NO_RETRO
/* TODO: Call this in retroflat in line with dependency guidelines. */
   retval = mlisp_env_set(
      exec, "random", 6, MLISP_TYPE_CB, _mlisp_env_cb_random,
      0, MLISP_ENV_FLAG_BUILTIN );
   maug_cleanup_if_not_ok();
#endif /* !MAUG_NO_RETRO */
   
   retval = mlisp_env_set(
      exec, "if", 2, MLISP_TYPE_CB, _mlisp_env_cb_if,
      0, MLISP_ENV_FLAG_BUILTIN );
   maug_cleanup_if_not_ok();
   
   retval = mlisp_env_set(
      exec, "define", 6, MLISP_TYPE_CB, _mlisp_env_cb_define,
      0, MLISP_ENV_FLAG_BUILTIN );
   maug_cleanup_if_not_ok();
   
   retval = mlisp_env_set(
      exec, "*", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
      0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ARI_MUL );
   maug_cleanup_if_not_ok();
   
   retval = mlisp_env_set(
      exec, "+", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
      0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ARI_ADD );
   maug_cleanup_if_not_ok();
   
   retval = mlisp_env_set(
      exec, "/", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
      0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ARI_DIV );
   maug_cleanup_if_not_ok();
   
   retval = mlisp_env_set(
      exec, "%", 1, MLISP_TYPE_CB, _mlisp_env_cb_arithmetic,
      0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_ARI_MOD );
   maug_cleanup_if_not_ok();
   
   retval = mlisp_env_set(
      exec, "<", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
      0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_CMP_LT );
   maug_cleanup_if_not_ok();
   
   retval = mlisp_env_set(
      exec, ">", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
      0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_CMP_GT );
   maug_cleanup_if_not_ok();
   
   retval = mlisp_env_set(
      exec, "=", 1, MLISP_TYPE_CB, _mlisp_env_cb_cmp,
      0, MLISP_ENV_FLAG_BUILTIN | MLISP_ENV_FLAG_CMP_EQ );
   maug_cleanup_if_not_ok();
 
cleanup:
 
   return retval;
}
 
/* === */
 
MERROR_RETVAL mlisp_exec_init(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec, uint8_t flags
) {
   MERROR_RETVAL retval = MERROR_OK;
   ssize_t append_retval = 0;
   size_t zero = 0;
   int16_t null_val = 0;
 
   assert( 0 == exec->flags );
 
   maug_mzero( exec, sizeof( struct MLISP_EXEC_STATE ) );
 
   exec->flags = flags;
   exec->uid = g_mlispe_last_uid++;
 
   /* Setup lambda visit stack so it can be locked on first step. */
   append_retval = mdata_vector_append(
      &(exec->lambda_trace), &zero, sizeof( size_t ) );
   if( 0 > append_retval ) {
      retval = mdata_retval( append_retval );
   }
   maug_cleanup_if_not_ok();
   mdata_vector_remove_last( &(exec->lambda_trace) );
 
   /* Define a constant so that the table is never empty, which makes things
    * run more smoothly.
    */
   retval = mlisp_env_set(
      exec, "null", 4, MLISP_TYPE_INT, &null_val, 0, 0 );
 
   /* Create the node PCs. */
   append_retval = mdata_vector_append(
      &(exec->per_node_child_idx), &zero, sizeof( size_t ) );
   if( 0 > append_retval ) {
      retval = mdata_retval( append_retval );
   }
   maug_cleanup_if_not_ok();
 
   /* Make sure there's an exec child node for every AST node. */
   while(
      mdata_vector_ct( &(exec->per_node_child_idx) ) <= 
      mdata_vector_ct( &(parser->ast) )
   ) {
      append_retval = mdata_vector_append( &(exec->per_node_child_idx), &zero,
         sizeof( size_t ) );
      if( 0 > append_retval ) {
         retval = mdata_retval( append_retval );
      }
      maug_cleanup_if_not_ok();
   }
 
   /* Create the node visit counters. */
   append_retval = mdata_vector_append(
      &(exec->per_node_visit_ct), &zero, sizeof( size_t ) );
   if( 0 > append_retval ) {
      retval = mdata_retval( append_retval );
   }
   maug_cleanup_if_not_ok();
 
   /* Make sure there's an exec visit count for every AST node. */
   while(
      mdata_vector_ct( &(exec->per_node_visit_ct) ) <= 
      mdata_vector_ct( &(parser->ast) )
   ) {
      append_retval = mdata_vector_append( &(exec->per_node_visit_ct), &zero,
         sizeof( size_t ) );
      if( 0 > append_retval ) {
         retval = mdata_retval( append_retval );
      }
      maug_cleanup_if_not_ok();
   }
 
   exec->flags |= MLISP_EXEC_FLAG_INITIALIZED;
 
   /* Setup initial env. */
 
   retval = mlisp_exec_add_env_builtins( parser, exec );
 
cleanup:
 
   if( MERROR_OK != retval ) {
      error_printf( "mlisp exec initialization failed: %d", retval );
   }
 
   return retval;
}
 
/* === */
 
MERROR_RETVAL mlisp_exec_set_global_env(
   struct MLISP_PARSER* parser, struct MLISP_EXEC_STATE* exec,
   struct MDATA_TABLE* global_env
) {
   MERROR_RETVAL retval = MERROR_OK;
   int16_t null_val = 0;
 
   exec->global_env = global_env;
 
   if( 0 == mdata_table_ct( global_env ) ) {
      /* Things get very wonky if the env is completely empty due to how empty
       * vectors respond to locking. This is a simple way of working around
       * that rather than adding a lot of special cases!
       */
      retval = mlisp_env_set(
         exec, "null", 4, MLISP_TYPE_INT, &null_val, 1, 0 );
   }
 
   return retval;
}
 
/* === */
 
void mlisp_exec_free( struct MLISP_EXEC_STATE* exec ) {
   int8_t env_iter = 0;
 
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL,
         "%u: destroying exec (stack: " SIZE_T_FMT ", env: " SIZE_T_FMT ")...",
         exec->uid,
         mdata_vector_ct( &(exec->stack) ),
         mdata_table_ct( &(exec->env[exec->env_select]) ) );
#endif /* MLISP_EXEC_TRACE_LVL */
   mdata_vector_free( &(exec->per_node_child_idx) );
   mdata_vector_free( &(exec->per_node_visit_ct) );
   mdata_vector_free( &(exec->stack) );
   for( env_iter = exec->env_select ; 0 <= env_iter ; env_iter-- ) {
      mdata_table_free( &(exec->env[env_iter]) );
   }
   mdata_vector_free( &(exec->lambda_trace) );
   exec->flags = 0;
#if MLISP_EXEC_TRACE_LVL > 0
   debug_printf( MLISP_EXEC_TRACE_LVL, "exec destroyed!" );
#endif /* MLISP_EXEC_TRACE_LVL */
}
 
/* === */
 
MERROR_RETVAL mlisp_deserialize_prepare_EXEC_STATE(
   struct MLISP_EXEC_STATE* exec, size_t i
) {
   MERROR_RETVAL retval = MERROR_OK;
   /* TODO: Re-add built-in function definitions. */
   /* TODO: Provide mechanism for program using maug to re-add function
    *       definitions!
    */
   return retval;
}
 
#else
 
#  define MLISP_PSTATE_TABLE_CONST( name, idx ) \
      extern MAUG_CONST uint8_t SEG_MCONST name;
 
MLISP_PARSER_PSTATE_TABLE( MLISP_PSTATE_TABLE_CONST )
 
#ifdef MPARSER_TRACE_NAMES
extern MAUG_CONST char* SEG_MCONST gc_mlisp_pstate_names[];
#endif /* MPARSER_TRACE_NAMES */
 
#endif /* MLISPE_C */
 
#endif /* !MLISPE_H */