scm_closure_t VM::lookup_system_closure(const char* name) { scm_obj_t proc = m_heap->lookup_system_environment(make_symbol(m_heap, name)); if (CLOSUREP(proc)) return (scm_closure_t)proc; fatal("fatal: #<closure %s> not available in system environment", name); }
static void fast_read_macro(lref_t reader, lref_t * retval) { lref_t macro_transformer; fast_read(reader, ¯o_transformer, false); if (!CLOSUREP(macro_transformer)) vmerror_fast_read("malformed macro, bad transformer", macro_transformer, false); *retval = macrocons(macro_transformer); }
// spawn scm_obj_t subr_spawn(VM* vm, int argc, scm_obj_t argv[]) { #if USE_PARALLEL_VM if (argc >= 1) { if (CLOSUREP(argv[0])) { vm->m_interp->update(vm, VM_STATE_BLOCK); int n = vm->m_interp->spawn(vm, (scm_closure_t)argv[0], argc - 1, argv + 1); vm->m_interp->update(vm, VM_STATE_ACTIVE); if (n < 0) return scm_timeout; return MAKEFIXNUM(n); } wrong_type_argument_violation(vm, "spawn", 0, "closure", argv[0], argc, argv); return scm_undef; } wrong_number_of_arguments_violation(vm, "spawn", 1, -1, argc, argv); return scm_undef; #else fatal("%s:%u spawn not supported on this build", __FILE__, __LINE__); #endif }
EVAL_INLINE lref_t apply(lref_t function, size_t argc, lref_t argv[], lref_t *env, lref_t *retval) { lref_t args[3]; if (SUBRP(function)) { return subr_apply(function, argc, argv, env, retval); } else if (CLOSUREP(function)) { lref_t c_code = CLOSURE_CODE(function); *env = extend_env(arg_list_from_buffer(argc, argv), CAR(c_code), CLOSURE_ENV(function)); return CDR(c_code); /* tail call */ } else if (argc > 0) { if (HASHP(function) || STRUCTUREP(function)) { args[0] = function; args[1] = argv[0]; args[2] = (argc > 1) ? argv[1] : NIL; *retval = lslot_ref(MAX2(argc + 1, 2), args); return NIL; } else if (SYMBOLP(function)) { if (HASHP(argv[0]) || STRUCTUREP(argv[0])) { args[0] = argv[0]; args[1] = function; args[2] = (argc > 1) ? argv[1] : NIL; *retval = lslot_ref(MAX2(argc + 1, 2), args); return NIL; } } } vmerror_wrong_type(function); return NIL; }
static void fast_read_loader_application(lref_t reader, enum fasl_opcode_t opcode) { assert(FASL_READER_P(reader)); size_t argc = 0; lref_t argv[FAST_LOAD_STACK_DEPTH]; fast_read(reader, &argv[0], false); if (!(SUBRP(argv[0]) || CLOSUREP(argv[0]))) vmerror_fast_read(_T("Invalid function to apply"), reader, NIL); if (opcode == FASL_OP_LOADER_APPLYN) { lref_t ac; fast_read(reader, &ac, false); if (!FIXNUMP(ac)) vmerror_fast_read("Expected fixnum for loader application argc", reader, ac); argc = (size_t)FIXNM(ac); if (argc > FAST_LOAD_STACK_DEPTH) /* Assuming FAST_LOAD_STACK_DEPTH <= ARG_BUF_LEN - 2 */ vmerror_fast_read("Loader application, argc < FAST_LOAD_STACK_DEPTH", reader, ac); for(size_t ii = 0; ii < argc; ii++) argv[ii + 1] = fast_loader_stack_pop(reader); /* Fake a final NIL argument so that we can pass in the argv arguments * as scalars rather than as a list. */ argc++; argv[argc] = NIL; } else if (opcode != FASL_OP_LOADER_APPLY0) panic("invalid opcode in fast_read_loader_application"); dscwritef(DF_SHOW_FAST_LOAD_FORMS, (_T("; DEBUG: FASL applying ~s (argc=~cd)\n"), argv[0], argc)); FASL_READER_STREAM(reader)->accum = lapply(argc + 1, argv); }
EVAL_INLINE lref_t apply(lref_t function, size_t argc, lref_t argv[], lref_t * env, lref_t * retval) { if (SUBRP(function)) return subr_apply(function, argc, argv, env, retval); if (CLOSUREP(function)) { lref_t c_code = CLOSURE_CODE(function); *env = extend_env(arg_list_from_buffer(argc, argv), CAR(c_code), CLOSURE_ENV(function)); return CDR(c_code); /* tail call */ } vmerror_wrong_type(function); return NIL; }