void unwind_stack_for_throw() { for(lref_t *frame = CURRENT_TIB()->frame; frame != NULL; frame = fstack_prev_frame(frame)) { if (fstack_frame_type(frame) == FRAME_UNWIND) { dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: throw invoking unwind : ~c&\n"), frame)); apply1(frame[FOFS_UNWIND_AFTER], 0, NULL); continue; } if (fstack_frame_type(frame) != FRAME_ESCAPE) continue; if (frame == CURRENT_TIB()->escape_frame) { dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: setjmp (from fsp=~c&) to target frame: ~c&\n"), CURRENT_TIB()->fsp, frame)); CURRENT_TIB()->escape_frame = NULL; CURRENT_TIB()->frame = (lref_t *)frame[FOFS_ESCAPE_FRAME]; CURRENT_TIB()->fsp = CURRENT_TIB()->frame + 1; longjmp((struct __jmp_buf_tag *)frame[FOFS_ESCAPE_JMPBUF_PTR], 1); } } }
static void show_debug_flags() { dscwritef(DF_ALWAYS, ("Available debug flags:\n\n")); for (size_t ii = 0; debug_flag_env_names[ii].df_env_name; ii++) dscwritef(DF_ALWAYS, ("* ~cs\n", debug_flag_env_names[ii].df_env_name)); }
static lref_t *find_matching_escape(lref_t *start_frame, lref_t tag) { if (CURRENT_TIB()->escape_frame != NULL) start_frame = fstack_prev_frame(CURRENT_TIB()->escape_frame); dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: looking for escape tag ~a\n"), tag)); for(lref_t *frame = start_frame; frame != NULL; frame = fstack_prev_frame(frame)) { if (fstack_frame_type(frame) != FRAME_ESCAPE) continue; lref_t ftag = frame[FOFS_ESCAPE_TAG]; dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: frame: ~c&, tag ~a\n"), frame, ftag)); if (NULLP(ftag) || EQ(ftag, tag)) { return frame; } } dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: No escape frame for tag ~a\n"), tag)); return NULL; }
void unwind_stack_for_throw() { for(lref_t *frame = CURRENT_TIB()->frame; frame != NULL; frame = fstack_prev_frame(frame)) { if (fstack_frame_type(frame) == FRAME_UNWIND) { dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: throw invoking unwind, frame: ~c&\n"), frame)); apply1(frame[FOFS_UNWIND_AFTER], 0, NULL); continue; } if (fstack_frame_type(frame) != FRAME_ESCAPE) continue; if (frame == CURRENT_TIB()->escape_frame) { jmp_buf *jmpbuf = (jmp_buf *)frame[FOFS_ESCAPE_JMPBUF_PTR]; dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: longjmp to frame: ~c&, jmpbuf: ~c&\n"), frame, jmpbuf)); CURRENT_TIB()->escape_frame = NULL; CURRENT_TIB()->frame = (lref_t *)frame[FOFS_ESCAPE_FRAME]; CURRENT_TIB()->fsp = CURRENT_TIB()->frame + 1; longjmp(*jmpbuf, 1); } } }
static void show_vm_args() { dscwritef(DF_ALWAYS, ("\nAvailable VM arguments:\n")); for (size_t ii = 0; vm_arg_names[ii].vm_arg_name; ii++) dscwritef(DF_ALWAYS, ("* ~cs\n", vm_arg_names[ii].vm_arg_name)); }
static void fast_read_loader_definition(lref_t reader, enum fasl_opcode_t opcode) { lref_t symbol_to_define; fast_read(reader, &symbol_to_define, false); if (!SYMBOLP(symbol_to_define)) vmerror_fast_read("Expected symbol for definition", reader, symbol_to_define); lref_t definition; fast_read(reader, &definition, false); dscwritef(DF_SHOW_FAST_LOAD_FORMS, (_T("; DEBUG: FASL defining ~s = ~s\n"), symbol_to_define, definition)); switch (opcode) { case FASL_OP_LOADER_DEFINEQ: /* quoted definition, do nothing. */ break; case FASL_OP_LOADER_DEFINEA0: definition = apply1(definition, 0, NULL); break; default: panic("invalid opcode in fast_read_loader_definition"); break; } lidefine_global(symbol_to_define, definition); }
lref_t liifasl_load(lref_t reader) { if (!FASL_READER_P(reader)) vmerror_wrong_type_n(1, reader); dscwritef(DF_SHOW_FAST_LOAD_FORMS, (_T("; DEBUG: FASL from : ~a\n"), reader)); lref_t form = NIL; while (!EOFP(form)) fast_read(reader, &form, true); dscwritef(DF_SHOW_FAST_LOAD_FORMS, (_T("; DEBUG: done FASL from reader: ~a\n"), reader)); return NIL; }
lref_t lset_stack_limit(lref_t amount) { size_t new_size_limit = 0; if (!NULLP(amount) && !FALSEP(amount)) new_size_limit = get_c_long(amount); void *new_limit_obj = sys_set_stack_limit(new_size_limit); if (!new_size_limit) { dscwritef(DF_SHOW_GC, ("stack limit disabled!")); return boolcons(false); } dscwritef(DF_SHOW_GC, ("stack_size = ~cd bytes, [~c&,~c&]\n", new_size_limit, new_limit_obj, sys_get_stack_start())); return fixcons(new_size_limit); }
static void load_init_load_files() { for (size_t ii = 0; ii < interp.init_load_file_count; ii++) { lref_t fname = strconsbuf(interp.init_load_file_name[ii]); dscwritef(DF_ALWAYS, ("; Init Loading ~a...\n", fname)); lref_t port = lopen_raw_input_file(fname); liifasl_load(lmake_fasl_reader(port)); lclose_port(port); } }
enum debug_flag_t debug_flags_from_string(enum debug_flag_t initial, const _TCHAR * source_name, const _TCHAR * str) { enum debug_flag_t rc = initial; while (str) { if (*str == _T('\0')) break; const char *envtokend = strchrnul(str, ','); bool found = false; bool remove = false; if ((str[0] == '-') || (str[0] == '+')) { remove = (str[0] == '-'); str++; } for (size_t ii = 0; debug_flag_env_names[ii].df_env_name; ii++) { if (strncasecmp(str, debug_flag_env_names[ii].df_env_name, envtokend - str) == 0) { found = true; if (remove) rc = (enum debug_flag_t) (rc & ~debug_flag_env_names[ii].df); else rc = (enum debug_flag_t) (rc | debug_flag_env_names[ii].df); break; } } if (!found) { dscwritef(DF_ALWAYS, ("Unknown debug flag while parsing ~cs, starting here: ~cs\n", source_name, str)); show_debug_flags(); panic("Aborting Run"); } str = (char *) ((*envtokend == '\0') ? NULL : envtokend + 1); } return rc; }
lref_t liset_trap_handler(lref_t trap_id, lref_t new_handler) { if (!PROCEDUREP(new_handler)) vmerror_wrong_type_n(2, new_handler); size_t tid = get_trap_id(trap_id); interp.trap_handlers[tid] = new_handler; dscwritef(DF_SHOW_TRAPS, (_T("; DEBUG: set-trap-handler : ~cS := ~s\n"), trap_type_name((enum trap_type_t)tid), new_handler)); return new_handler; }
static void process_vm_argument(_TCHAR * arg_name, _TCHAR * arg_value) { for (size_t ii = 0; vm_arg_names[ii].vm_arg_name; ii++) { if (_tcscmp(arg_name, vm_arg_names[ii].vm_arg_name) == 0) { vm_arg_names[ii].vm_arg_handler(arg_name, arg_value); return; } } dscwritef(DF_ALWAYS, ("Unknown VM argument: ~cs\n", arg_name)); show_vm_args(); panic("Aborting Run"); }
lref_t vmtrap(enum trap_type_t trap, enum vmt_options_t options, size_t argc, ...) { assert((trap > 0) && (trap <= TRAP_LAST)); assert(argc < ARG_BUF_LEN); dscwritef(DF_SHOW_TRAPS, (_T("; DEBUG: trap : ~cS\n"), trap_type_name(trap))); lref_t handler = interp.trap_handlers[trap]; if (!PROCEDUREP(handler)) { if(!NULLP(handler)) vmtrap_panic(trap, "bad trap handler"); if (!(options & VMT_OPTIONAL_TRAP)) vmtrap_panic(trap, "missing trap handler"); return NIL; } lref_t retval = NIL; va_list args; va_start(args, argc); lref_t argv[ARG_BUF_LEN]; argv[0] = fixcons(trap); argv[1] = fixcons((fixnum_t)CURRENT_TIB()->frame); for (size_t ii = 2; ii < argc + 2; ii++) argv[ii] = va_arg(args, lref_t); va_end(args); retval = apply1(handler, argc + 2, argv); if (options & VMT_HANDLER_MUST_ESCAPE) vmtrap_panic(trap, "trap handler must escape"); return retval; }
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); }
static size_t process_vm_int_argument_value(_TCHAR * arg_name, _TCHAR * arg_value) { size_t rc = 0; _TCHAR *endobj = NULL; rc = strtol(arg_value, &endobj, 10); switch (*endobj) { case 'k': case 'K': endobj++; rc *= 1024; break; case 'm': case 'M': endobj++; rc *= (1024 * 1024); break; case 'g': case 'G': endobj++; rc *= (1024 * 1024 * 1024); break; } if (*endobj != _T('\0')) { dscwritef(DF_ALWAYS, ("Invalid numeric value (\"~cs\") for VM argument \"~cs\".", arg_value, arg_name)); panic("Aborting Run"); } return rc; }
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; }
void init0(int argc, _TCHAR * argv[], enum debug_flag_t initial_debug_flags) { global_environment_asserts(); previous_panic_handler = set_panic_handler(scan_panic_handler); /** Initialize the interpreter globals */ memset(&interp, 0, sizeof(interp)); /* We need the debug flags pretty early on, so that we know how * to set up debugger I/O. */ interp.debug_flags = debug_flags_from_environment(initial_debug_flags); init_debugger_output(); interp.init_load_file_count = 0; interp.intr_pending = VMINTR_NONE; interp.intr_masked = false; interp.launch_realtime = sys_runtime(); interp.fasl_package_list = NIL; gc_protect(_T("fasl-package-list"), &interp.fasl_package_list, 1); /* Statistics Counters */ interp.gc_heap_segment_size = DEFAULT_HEAP_SEGMENT_SIZE; interp.gc_max_heap_segments = DEFAULT_MAX_HEAP_SEGMENTS; interp.gc_current_heap_segments = 0; interp.gc_heap_segments = NULL; interp.gc_total_cells_allocated = 0; interp.gc_malloc_bytes_threshold = (sizeof(struct lobject_t) * interp.gc_heap_segment_size); interp.gc_total_run_time = 0.0; interp.gc_start_time = 0.0; interp.thread.fsp = &(interp.thread.frame_stack[FRAME_STACK_SIZE]); interp.thread.frame = NULL; process_vm_arguments(argc, argv); if (interp.debug_flags != DF_NONE) dscwritef(DF_ALWAYS, ("; DEBUG: debug_flags=0x~cx\n", interp.debug_flags)); /*** Create the gc heap and populate it with the standard objects */ gc_initialize_heap(); create_initial_packages(); init_base_scheme_objects(); init_stdio_ports(); register_main_subrs(); gc_protect(_T("handler-frames"), &(CURRENT_TIB()->handler_frames), 1); gc_protect(_T("frame-stack"), (struct lobject_t **)&(CURRENT_TIB()->frame_stack[0]), sizeof(CURRENT_TIB()->frame_stack) / sizeof(lref_t)); accept_command_line_arguments(argc, argv); load_init_load_files(); }
static void fast_read(lref_t reader, lref_t * retval, bool allow_loader_ops /* = false */ ) { lref_t *fasl_table_entry = NULL; *retval = NIL; if (!FASL_READER_P(reader)) vmerror_wrong_type_n(1, reader); assert(NULLP(FASL_READER_STREAM(reader)->table) || VECTORP(FASL_READER_STREAM(reader)->table)); /* The core of this function is wrapped in a giant while loop to remove * tail recursive calls. Some opcodes don't directly return anything: * they just tail recursively read the next opcode after performing their * action via side effect. */ bool current_read_complete = false; while (!current_read_complete) { /* Assume we're going to complete the read unless we find out otherwise.. */ current_read_complete = true; size_t opcode_location = PORT_BYTES_READ(FASL_READER_PORT(reader)); enum fasl_opcode_t opcode = fast_read_opcode(reader); fixnum_t index = 0; lref_t name; if (DEBUG_FLAG(DF_FASL_SHOW_OPCODES)) { const _TCHAR *opcode_name = fasl_opcode_name(opcode); dscwritef(DF_FASL_SHOW_OPCODES, (_T("; DEBUG: fasl-opcode@~cx :~cS\n"), opcode_location, opcode_name ? opcode_name : _T("<INVALID>"))); } switch (opcode) { case FASL_OP_NIL: *retval = NIL; break; case FASL_OP_TRUE: *retval = boolcons(true); break; case FASL_OP_FALSE: *retval = boolcons(false); break; case FASL_OP_CHARACTER: fast_read_character(reader, retval); break; case FASL_OP_LIST: fast_read_list(reader, false, retval); break; case FASL_OP_LISTD: fast_read_list(reader, true, retval); break; case FASL_OP_FIX8: fast_read_fixnum_int8(reader, retval); break; case FASL_OP_FIX16: fast_read_fixnum_int16(reader, retval); break; case FASL_OP_FIX32: fast_read_fixnum_int32(reader, retval); break; case FASL_OP_FIX64: fast_read_fixnum_int64(reader, retval); break; case FASL_OP_FLOAT: fast_read_flonum(reader, false, retval); break; case FASL_OP_COMPLEX: fast_read_flonum(reader, true, retval); break; case FASL_OP_STRING: fast_read_string(reader, retval); break; case FASL_OP_PACKAGE: fast_read_package(reader, retval); break; case FASL_OP_VECTOR: fast_read_vector(reader, retval); break; case FASL_OP_HASH: fast_read_hash(reader, retval); break; case FASL_OP_CLOSURE: fast_read_closure(reader, retval); break; case FASL_OP_MACRO: fast_read_macro(reader, retval); break; case FASL_OP_SYMBOL: fast_read_symbol(reader, retval); break; case FASL_OP_SUBR: fast_read_subr(reader, retval); break; case FASL_OP_STRUCTURE: fast_read_structure(reader, retval); break; case FASL_OP_STRUCTURE_LAYOUT: fast_read_structure_layout(reader, retval); break; case FASL_OP_FAST_OP_0: fast_read_fast_op(0, false, reader, retval); break; case FASL_OP_FAST_OP_1: fast_read_fast_op(1, false, reader, retval); break; case FASL_OP_FAST_OP_2: fast_read_fast_op(2, false, reader, retval); break; case FASL_OP_FAST_OP_0N: fast_read_fast_op(0, true, reader, retval); break; case FASL_OP_FAST_OP_1N: fast_read_fast_op(1, true, reader, retval); break; case FASL_OP_FAST_OP_2N: fast_read_fast_op(2, true, reader, retval); break; case FASL_OP_NOP_1: case FASL_OP_NOP_2: case FASL_OP_NOP_3: current_read_complete = false; break; case FASL_OP_COMMENT_1: case FASL_OP_COMMENT_2: fast_read_to_newline(reader); current_read_complete = false; break; case FASL_OP_RESET_READER_DEFS: FASL_READER_STREAM(reader)->table = NIL; current_read_complete = false; break; case FASL_OP_READER_DEFINITION: index = fast_read_table_index(reader); fasl_table_entry = &(FASL_READER_STREAM(reader)->table->as.vector.data[index]); fast_read(reader, fasl_table_entry, allow_loader_ops); /* This should throw if the FASL table was resized * during the call to read. */ assert(fasl_table_entry == &(FASL_READER_STREAM(reader)->table->as.vector.data[index])); *retval = *fasl_table_entry; break; case FASL_OP_READER_REFERENCE: index = fast_read_table_index(reader); *retval = FASL_READER_STREAM(reader)->table->as.vector.data[index]; break; case FASL_OP_EOF: *retval = lmake_eof(); break; case FASL_OP_LOADER_DEFINEQ: case FASL_OP_LOADER_DEFINEA0: if (!allow_loader_ops) vmerror_fast_read(_T("loader definitions not allowed outside loader"), reader, NIL); fast_read_loader_definition(reader, opcode); current_read_complete = false; break; case FASL_OP_LOADER_APPLY0: case FASL_OP_LOADER_APPLYN: if (!allow_loader_ops) vmerror_fast_read(_T("loader function applications not allowed outside loader"), reader, NIL); fast_read_loader_application(reader, opcode); break; case FASL_OP_BEGIN_LOAD_UNIT: if (!allow_loader_ops) vmerror_fast_read(_T("load units are not allowed outside loader"), reader, NIL); fast_read(reader, &name, allow_loader_ops); dscwritef(DF_SHOW_FAST_LOAD_UNITS, ("; DEBUG: FASL entering unit ~s\n", name)); break; case FASL_OP_END_LOAD_UNIT: if (!allow_loader_ops) vmerror_fast_read(_T("load units are not allowed outside loader"), reader, NIL); fast_read(reader, &name, allow_loader_ops); dscwritef(DF_SHOW_FAST_LOAD_UNITS, ("; DEBUG: FASL leaving unit ~s\n", name)); break; case FASL_OP_LOADER_PUSH: fast_loader_stack_push(reader, FASL_READER_STREAM(reader)->accum); break; case FASL_OP_LOADER_DROP: fast_loader_stack_pop(reader); break; default: vmerror_fast_read("invalid opcode", reader, fixcons(opcode)); } } }