Exemple #1
0
static bool hash_entry_deleted_p(struct hash_entry_t * entry)
{
     return UNBOUND_MARKER_P(entry->key) && NULLP(entry->val);
}
Exemple #2
0
static lref_t execute_fast_op(lref_t fop, lref_t env)
{
     lref_t retval = NIL;
     lref_t sym;
     lref_t binding;
     lref_t fn;
     lref_t args;
     size_t argc;
     lref_t argv[ARG_BUF_LEN];
     lref_t after;
     lref_t tag;
     lref_t cell;
     lref_t escape_retval;
     jmp_buf *jmpbuf;

     STACK_CHECK(&fop);
     _process_interrupts();

     fstack_enter_eval_frame(&fop, fop, env);

     while(!NULLP(fop)) {
          switch(fop->header.opcode)
          {
          case FOP_LITERAL:
               retval = fop->as.fast_op.arg1;
               fop = fop->as.fast_op.next;
               break;

          case FOP_GLOBAL_REF:
               sym = fop->as.fast_op.arg1;
               binding = SYMBOL_VCELL(sym);

               if (UNBOUND_MARKER_P(binding))
                    vmerror_unbound(sym);

               retval = binding;

               fop = fop->as.fast_op.next;
               break;

          case FOP_GLOBAL_SET:
               sym = fop->as.fast_op.arg1;
               binding = SYMBOL_VCELL(sym);

               if (UNBOUND_MARKER_P(binding))
                    vmerror_unbound(sym);

               SET_SYMBOL_VCELL(sym, retval);

               fop = fop->as.fast_op.next;
               break;

          case FOP_APPLY_GLOBAL:
               sym = fop->as.fast_op.arg1;
               fn = SYMBOL_VCELL(sym);

               if (UNBOUND_MARKER_P(fn))
                    vmerror_unbound(sym);

               argc = 0;
               args = fop->as.fast_op.arg2;

               while (CONSP(args)) {
                    if (argc >= ARG_BUF_LEN) {
                         vmerror_unsupported(_T("too many actual arguments"));
                         break;
                    }

                    argv[argc] = execute_fast_op(CAR(args), env);

                    args = CDR(args);
                    argc++;
               }

               if (!NULLP(args))
                    vmerror_arg_out_of_range(fop->as.fast_op.arg2,
                                             _T("bad formal argument list"));

               fop = apply(fn, argc, argv, &env, &retval);
               break;

          case FOP_APPLY:
               argc = 0;
               fn = execute_fast_op(fop->as.fast_op.arg1, env);
               args = fop->as.fast_op.arg2;

               while (CONSP(args)) {
                    if (argc >= ARG_BUF_LEN) {
                         vmerror_unsupported(_T("too many actual arguments"));
                         break;
                    }

                    argv[argc] = execute_fast_op(CAR(args), env);

                    args = CDR(args);
                    argc++;
               }

               if (!NULLP(args))
                    vmerror_arg_out_of_range(fop->as.fast_op.arg2,
                                             _T("bad formal argument list"));

               fop = apply(fn, argc, argv, &env, &retval);
               break;

          case FOP_IF_TRUE:
               if (TRUEP(retval))
                    fop = fop->as.fast_op.arg1;
               else
                    fop = fop->as.fast_op.arg2;
               break;

          case FOP_RETVAL:
               fop = fop->as.fast_op.next;
               break;

          case FOP_SEQUENCE:
               retval = execute_fast_op(fop->as.fast_op.arg1, env);

               fop = fop->as.fast_op.arg2;
               break;

          case FOP_THROW:
               tag = execute_fast_op(fop->as.fast_op.arg1, env);
               escape_retval = execute_fast_op(fop->as.fast_op.arg2, env);

               dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: throw ~a, retval = ~a\n"), tag, escape_retval));

               CURRENT_TIB()->escape_frame = find_matching_escape(CURRENT_TIB()->frame, tag);
               CURRENT_TIB()->escape_value = escape_retval;

               if (CURRENT_TIB()->escape_frame == NULL) {
                    /* If we don't find a matching catch for the throw, we have a
                     * problem and need to invoke a trap. */
                    vmtrap(TRAP_UNCAUGHT_THROW,
                           (enum vmt_options_t)(VMT_MANDATORY_TRAP | VMT_HANDLER_MUST_ESCAPE),
                           2, tag, escape_retval);
               }

               unwind_stack_for_throw();

               fop = fop->as.fast_op.next;
               break;

          case FOP_CATCH:
               tag = execute_fast_op(fop->as.fast_op.arg1, env);

               jmpbuf = fstack_enter_catch_frame(tag, CURRENT_TIB()->frame);

               dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: setjmp tag: ~a, frame: ~c&, jmpbuf: ~c&\n"), tag, CURRENT_TIB()->frame, jmpbuf));

               if (setjmp(*jmpbuf) == 0) {
                    retval = execute_fast_op(fop->as.fast_op.arg2, env);
               } else {
                    dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: catch, retval = ~a\n"), CURRENT_TIB()->escape_value));

                    retval = CURRENT_TIB()->escape_value;
                    CURRENT_TIB()->escape_value = NIL;
               }

               fstack_leave_frame();

               fop = fop->as.fast_op.next;
               break;

          case FOP_WITH_UNWIND_FN:
               fstack_enter_unwind_frame(execute_fast_op(fop->as.fast_op.arg1, env));

               retval = execute_fast_op(fop->as.fast_op.arg2, env);

               after = CURRENT_TIB()->frame[FOFS_UNWIND_AFTER];

               fstack_leave_frame();

               apply1(after, 0, NULL);

               fop = fop->as.fast_op.next;
               break;

          case FOP_CLOSURE:
               retval = lclosurecons(env,
                                     lcons(lcar(fop->as.fast_op.arg1),
                                           fop->as.fast_op.arg2),
                                     lcdr(fop->as.fast_op.arg1));
               fop = fop->as.fast_op.next;
               break;

          case FOP_CAR:
               retval = lcar(retval);
               fop = fop->as.fast_op.next;
               break;

          case FOP_CDR:
               retval = lcdr(retval);
               fop = fop->as.fast_op.next;
               break;

          case FOP_NOT:
               retval = boolcons(!TRUEP(retval));
               fop = fop->as.fast_op.next;
               break;

          case FOP_NULLP:
               retval = boolcons(NULLP(retval));
               fop = fop->as.fast_op.next;
               break;

          case FOP_EQP:
               retval = boolcons(EQ(execute_fast_op(fop->as.fast_op.arg1, env),
                                    execute_fast_op(fop->as.fast_op.arg2, env)));
               fop = fop->as.fast_op.next;
               break;

          case FOP_GET_ENV:
               retval = env;
               fop = fop->as.fast_op.next;
               break;

          case FOP_GLOBAL_DEF: // three args, third was genv, but currently unused
               retval = lidefine_global(fop->as.fast_op.arg1, fop->as.fast_op.arg2);
               fop = fop->as.fast_op.next;
               break;

          case FOP_GET_FSP:
               retval = fixcons((fixnum_t)CURRENT_TIB()->fsp);
               fop = fop->as.fast_op.next;
               break;

          case FOP_GET_FRAME:
               retval = fixcons((fixnum_t)CURRENT_TIB()->frame);
               fop = fop->as.fast_op.next;
               break;

          case FOP_GET_HFRAMES:
               retval = CURRENT_TIB()->handler_frames;
               fop = fop->as.fast_op.next;
               break;

          case FOP_SET_HFRAMES:
               CURRENT_TIB()->handler_frames = execute_fast_op(fop->as.fast_op.arg1, env);
               fop = fop->as.fast_op.next;
               break;

          case FOP_GLOBAL_PRESERVE_FRAME:
               sym = fop->as.fast_op.arg1;
               binding = SYMBOL_VCELL(sym);

               if (UNBOUND_MARKER_P(binding))
                    vmerror_unbound(sym);

               SET_SYMBOL_VCELL(sym, fixcons((fixnum_t)CURRENT_TIB()->frame));

               retval = execute_fast_op(fop->as.fast_op.arg2, env);
               fop = fop->as.fast_op.next;
               break;

          case FOP_STACK_BOUNDARY:
               sym = execute_fast_op(fop->as.fast_op.arg1, env);

               fstack_enter_boundary_frame(sym);

               retval = execute_fast_op(fop->as.fast_op.arg2, env);

               fstack_leave_frame();

               fop = fop->as.fast_op.next;
               break;

          case FOP_FAST_ENQUEUE_CELL:
               retval = execute_fast_op(fop->as.fast_op.arg2, env);

               cell = execute_fast_op(fop->as.fast_op.arg1, env);

               SET_CDR(CAR(retval), cell);
               SET_CAR(retval, cell);

               fop = fop->as.fast_op.next;
               break;

          case FOP_WHILE_TRUE:
               while(TRUEP(execute_fast_op(fop->as.fast_op.arg1, env))) {
                    retval = execute_fast_op(fop->as.fast_op.arg2, env);
               }
               fop = fop->as.fast_op.next;
               break;

          case FOP_LOCAL_REF_BY_INDEX:
               retval = lenvlookup_by_index(FIXNM(fop->as.fast_op.arg1),
                                            FIXNM(fop->as.fast_op.arg2),
                                            env);
               fop = fop->as.fast_op.next;
               break;

          case FOP_LOCAL_REF_RESTARG:
               retval = lenvlookup_restarg_by_index(FIXNM(fop->as.fast_op.arg1),
                                                    FIXNM(fop->as.fast_op.arg2),
                                                    env);
               fop = fop->as.fast_op.next;
               break;

          case FOP_LOCAL_SET_BY_INDEX:
               lenvlookup_set_by_index(FIXNM(fop->as.fast_op.arg1),
                                       FIXNM(fop->as.fast_op.arg2),
                                       env,
                                       retval);
               fop = fop->as.fast_op.next;
               break;

          default:
               panic("Unsupported fast-op");
          }
     }

     fstack_leave_frame();

     return retval;
}
Exemple #3
0
static bool hash_entry_unused_p(struct hash_entry_t * entry)
{
     return UNBOUND_MARKER_P(entry->key);
}