annotate src/bytecode.c @ 1204:e22b0213b713

[xemacs-hg @ 2003-01-12 11:07:58 by michaels] modules/ChangeLog: 2002-12-16 Ben Wing <ben@xemacs.org> * postgresql/postgresql.c: remove ifdef USE_KKCC. src/ChangeLog: 2003-01-08 Mike Sperber <mike@xemacs.org> * console.h (CDFW_CONSOLE): Don't lead to a crash if we're dealing with a dead window/frame/device/console. 2002-12-20 Mike Sperber <mike@xemacs.org> * ui-gtk.c: Fix typo from Ben's patch: emacs_ffi_data is a typedef, not a struct. emacs_gtk_object_data is a typedef, not a struct. * gtk-glue.c (gdk_event_to_emacs_event): Fix typos from Ben's patch: le -> emacs_event + rearrange the code. * event-gtk.c (gtk_event_to_emacs_event): Fix typos from Ben's patch: ..._UNDERLYING_GDK_EVENT -> ..._GDK_EVENT, ev -> key_event. * device-gtk.c: Fix typo from Ben's patch: x_keysym_map_hash_table -> x_keysym_map_hashtable. 2002-12-19 Mike Sperber <mike@xemacs.org> * menubar-x.c (set_frame_menubar): Initialize protect_me field of popup_data. 2002-12-16 Ben Wing <ben@xemacs.org> Major cleanup of KKCC, etc. KKCC, pdump-related: -- descriptions are written for all objects. this required some changes in the format of some objects, e.g. extents, popup-data, coding system, lstream, lcrecord-list. -- KKCC now handles weakness in markers, hash tables, elsewhere correctly (formerly, you'd eventually get a stack overflow due to endlessly expanding markers). -- textual changes: lrecord_description -> memory_description, struct_description -> sized_memory_description. -- extensive comment describing descriptions and pdump. -- redo XD_UNION so it works inline and change its format to provide sufficient info for pdump. implement XD_UNION in pdump. also add XD_UNION_DYNAMIC_SIZE, which works like XD_UNION except for when auto-computing structure sizes. -- add support for XD_INDIRECT in description offsets (used by extents). -- add support for "description maps", allowing for indirect descriptions that are retrieved from an object at run-time. this generalizes XD_CODING_SYSTEM_END, XD_SPECIFIER_END, etc., which have now been eliminated. -- add a fifth field "flags" to memory_description, to support flags that can be specified for this particular line. Currently defined flags are XD_FLAG_NO_KKCC (KKCC should ignore this entry; useful for the weakness above in markers, etc.), XD_FLAG_NO_PDUMP (pdump should ignore this entry), XD_FLAG_UNION_DEFAULT_ENTRY (in union maps, this specifies a "default" entry for all remaining values), and XD_FLAG_FREE_LISP_OBJECT (for use with lcrecord-lists). -- clean up the kkcc-itis in events, so that the differences between event data as separate objects and as a union are now minimized to a small number of places. with the new XD_UNION, we no longer need event data as separate objects, so this code is no longer ifdef USE_KKCC, but instead ifdef EVENT_DATA_AS_OBJECTS, not used by default. make sure that we explicitly free the separate event data objects when no longer in use, to maintain the invariant the event processing causes no consing. -- also remove other USE_KKCC ifdefs when not necessary. -- allow for KKCC compilation under MS Windows. -- fix README.kkcc. -- dump_add_root_object -> dump_add_root_lisp_object. -- implement dump_add_root_block and use this to handle dump_add_opaque. -- factor out some code duplicated in kkcc and pdump. Other allocation/object-related: -- change various *slots.h so MARKED_SLOT() call no longer includes semicolon. -- free_marker() takes a Lisp_Object not a direct pointer. -- make bit vectors lcrecords, like vectors, and eliminate code that essentially duplicated the lcrecord handling. -- additional asserts in FREE_FIXED_TYPE, formerly duplicated in the various callers of this. -- all lcrecord allocation functions now zero out the returned lcrecords. unnecessary calls to zero_lcrecord removed. add long comment describing these functions. -- extract out process and coding system slots, like for buffers, frames, etc. -- lcrecords now set the type of items sitting on the free list to lcrecord_type_free. -- changes to the way that gap arrays are allocated, for kkcc's benefit -- now, one single memory block with a stretchy array on the end, instead of a separate block holding the array. Error-checking-related: -- now can compile with C++ under MS Windows. clean up compile errors discovered that way. (a few were real problems) -- add C++ error-checking code to verify problems with mismatched GCPRO/UNGCPRO. (there were a few in the kkcc code.) add long comment about how to catch insufficient GCPRO (yes, it's possible using C++). -- add debug_p4(), a simple object printer, when debug_print() doesn't work. -- add dp() and db() as short synonyms of debug_print(), debug_backtrace(). -- `print' tries EXTREMELY hard to avoid core dumping when printing when crashing or from debug_print(), and tries as hard as it reasonably can in other situations. -- Correct the message output upon crashing to be more up-to-date. Event-related: -- document event-matches-key-specifier-p better. -- generalize the dispatch queues formerly duplicated in the various event implementations. add event methods to drain pending events. generalize and clean up QUIT handling, removing event-specific quit processing. allow arbitrary keystrokes, not just ASCII, to be the QUIT char. among other things, this should fix some longstanding bugs in X quit handling. long comment describing the various event queues. -- implement delaying of XFlush() if there are pending expose events. SOMEONE PLEASE TRY THIS OUT. -- Fix `xemacs -batch -l dunnet' under Cygwin. Try to fix under MS Windows but not quite there yet. Other: -- class -> class_ and no more C++ games with this item. new -> new_ in the lwlib code, so far not elsewhere. -- use `struct htentry' not `struct hentry' in elhash.c to avoid debugger confusion with hash.c. -- new macros ALIST_LOOP_3, ALIST_LOOP_4. * README.kkcc: * alloc.c: * alloc.c (deadbeef_memory): * alloc.c (allocate_lisp_storage): * alloc.c (copy_lisp_object): * alloc.c (ALLOCATE_FIXED_TYPE_1): * alloc.c (FREE_FIXED_TYPE): * alloc.c (make_vector_internal): * alloc.c (make_bit_vector_internal): * alloc.c (make_key_data): * alloc.c (make_button_data): * alloc.c (make_motion_data): * alloc.c (make_process_data): * alloc.c (make_timeout_data): * alloc.c (make_magic_data): * alloc.c (make_magic_eval_data): * alloc.c (make_eval_data): * alloc.c (make_misc_user_data): * alloc.c (struct string_chars_block): * alloc.c (mark_lcrecord_list): * alloc.c (make_lcrecord_list): * alloc.c (alloc_managed_lcrecord): * alloc.c (free_managed_lcrecord): * alloc.c (alloc_automanaged_lcrecord): * alloc.c (staticpro_1): * alloc.c (staticpro): * alloc.c (lispdesc_indirect_count_1): * alloc.c (lispdesc_indirect_description_1): * alloc.c (lispdesc_one_description_line_size): * alloc.c (lispdesc_structure_size): * alloc.c (mark_object_maybe_checking_free): * alloc.c (mark_with_description): * alloc.c (mark_struct_contents): * alloc.c (mark_object): * alloc.c (tick_lcrecord_stats): * alloc.c (free_cons): * alloc.c (free_key_data): * alloc.c (free_button_data): * alloc.c (free_motion_data): * alloc.c (free_process_data): * alloc.c (free_timeout_data): * alloc.c (free_magic_data): * alloc.c (free_magic_eval_data): * alloc.c (free_eval_data): * alloc.c (free_misc_user_data): * alloc.c (free_marker): * alloc.c (compact_string_chars): * alloc.c (gc_sweep): * alloc.c (garbage_collect_1): * alloc.c (Fgarbage_collect): * alloc.c (common_init_alloc_early): * alloc.c (init_alloc_early): * alloc.c (init_alloc_once_early): * buffer.c: * buffer.c (mark_buffer): * buffer.c (MARKED_SLOT): * buffer.c (cleanup_buffer_undo_lists): * buffer.c (Fget_file_buffer): * buffer.h (MARKED_SLOT): * bufslots.h: * bytecode.c: * callint.c: * casetab.c: * chartab.c: * chartab.c (symbol_to_char_table_type): * cmdloop.c: * cmdloop.c (Fcommand_loop_1): * config.h.in (new): * conslots.h: * console-gtk-impl.h (struct gtk_frame): * console-impl.h: * console-impl.h (struct console): * console-impl.h (MARKED_SLOT): * console-impl.h (CONSOLE_QUIT_EVENT): * console-msw-impl.h (XM_BUMPQUEUE): * console-msw.c (write_string_to_mswindows_debugging_output): * console-msw.h: * console-stream-impl.h: * console-stream-impl.h (struct stream_console): * console-stream.c: * console-stream.c (stream_init_console): * console-stream.h: * console-tty.c: * console-tty.h: * console-x.h: * console.c: * console.c (mark_console): * console.c (MARKED_SLOT): * console.c (allocate_console): * console.c (get_console_variant): * console.c (create_console): * console.c (delete_console_internal): * console.c (Fset_input_mode): * console.c (Fcurrent_input_mode): * console.c (common_init_complex_vars_of_console): * console.h: * console.h (console_variant): * console.h (device_metrics): * data.c: * data.c (Faref): * data.c (Faset): * data.c (decode_weak_list_type): * database.c: * debug.c (xemacs_debug_loop): * debug.c (FROB): * debug.c (Fadd_debug_class_to_check): * debug.c (Fdelete_debug_class_to_check): * debug.c (Fset_debug_classes_to_check): * debug.c (Fset_debug_class_types_to_check): * debug.c (Fdebug_types_being_checked): * debug.h (DASSERT): * device-gtk.c: * device-impl.h (struct device): * device-impl.h (MARKED_SLOT): * device-msw.c: * device-x.c: * device-x.c (x_init_device_class): * device-x.c (x_comp_visual_info): * device-x.c (x_try_best_visual_class): * device-x.c (x_init_device): * device-x.c (construct_name_list): * device-x.c (x_get_resource_prefix): * device-x.c (Fx_get_resource): * device-x.c (Fx_display_visual_class): * device.c: * device.c (MARKED_SLOT): * device.c (allocate_device): * device.c (Fmake_device): * device.c (delete_device_internal): * device.c (Fset_device_class): * device.h: * devslots.h: * devslots.h (MARKED_SLOT): * dialog-msw.c: * dired-msw.c (mswindows_ls_sort_fcn): * dired-msw.c (mswindows_get_files): * dired-msw.c (mswindows_format_file): * doprnt.c (parse_doprnt_spec): * dumper.c: * dumper.c (struct): * dumper.c (dump_add_root_block): * dumper.c (dump_add_root_struct_ptr): * dumper.c (dump_add_root_lisp_object): * dumper.c (pdump_struct_list_elt): * dumper.c (pdump_get_entry_list): * dumper.c (pdump_backtrace): * dumper.c (pdump_bump_depth): * dumper.c (pdump_register_sub): * dumper.c (pdump_register_object): * dumper.c (pdump_register_struct_contents): * dumper.c (pdump_register_struct): * dumper.c (pdump_store_new_pointer_offsets): * dumper.c (pdump_dump_data): * dumper.c (pdump_reloc_one): * dumper.c (pdump_allocate_offset): * dumper.c (pdump_scan_by_alignment): * dumper.c (pdump_dump_root_blocks): * dumper.c (pdump_dump_rtables): * dumper.c (pdump_dump_root_lisp_objects): * dumper.c (pdump): * dumper.c (pdump_load_finish): * dumper.c (pdump_file_get): * dumper.c (pdump_resource_get): * dumper.c (pdump_load): * editfns.c (save_excursion_restore): * editfns.c (user_login_name): * editfns.c (save_restriction_restore): * elhash.c: * elhash.c (htentry): * elhash.c (struct Lisp_Hash_Table): * elhash.c (HTENTRY_CLEAR_P): * elhash.c (LINEAR_PROBING_LOOP): * elhash.c (check_hash_table_invariants): * elhash.c (mark_hash_table): * elhash.c (hash_table_equal): * elhash.c (print_hash_table_data): * elhash.c (free_hentries): * elhash.c (make_general_lisp_hash_table): * elhash.c (decode_hash_table_weakness): * elhash.c (decode_hash_table_test): * elhash.c (Fcopy_hash_table): * elhash.c (resize_hash_table): * elhash.c (pdump_reorganize_hash_table): * elhash.c (find_htentry): * elhash.c (Fgethash): * elhash.c (Fputhash): * elhash.c (remhash_1): * elhash.c (Fremhash): * elhash.c (Fclrhash): * elhash.c (copy_compress_hentries): * elhash.c (elisp_maphash_unsafe): * elhash.c (finish_marking_weak_hash_tables): * elhash.c (prune_weak_hash_tables): * elhash.h: * emacs.c: * emacs.c (main_1): * emacs.c (main): * emacs.c (shut_down_emacs): * emodules.h (dump_add_root_lisp_object): * eval.c: * eval.c (unwind_to_catch): * eval.c (maybe_signal_error_1): * eval.c (maybe_signal_continuable_error_1): * eval.c (maybe_signal_error): * eval.c (maybe_signal_continuable_error): * eval.c (maybe_signal_error_2): * eval.c (maybe_signal_continuable_error_2): * eval.c (maybe_signal_ferror): * eval.c (maybe_signal_continuable_ferror): * eval.c (maybe_signal_ferror_with_frob): * eval.c (maybe_signal_continuable_ferror_with_frob): * eval.c (maybe_syntax_error): * eval.c (maybe_sferror): * eval.c (maybe_invalid_argument): * eval.c (maybe_invalid_constant): * eval.c (maybe_invalid_operation): * eval.c (maybe_invalid_change): * eval.c (maybe_invalid_state): * eval.c (Feval): * eval.c (call_trapping_problems): * eval.c (call_with_suspended_errors): * eval.c (warn_when_safe_lispobj): * eval.c (warn_when_safe): * eval.c (vars_of_eval): * event-Xt.c: * event-Xt.c (maybe_define_x_key_as_self_inserting_character): * event-Xt.c (x_to_emacs_keysym): * event-Xt.c (x_event_to_emacs_event): * event-Xt.c (emacs_Xt_enqueue_focus_event): * event-Xt.c (emacs_Xt_format_magic_event): * event-Xt.c (emacs_Xt_compare_magic_event): * event-Xt.c (emacs_Xt_hash_magic_event): * event-Xt.c (emacs_Xt_handle_magic_event): * event-Xt.c (Xt_timeout_to_emacs_event): * event-Xt.c (Xt_process_to_emacs_event): * event-Xt.c (signal_special_Xt_user_event): * event-Xt.c (emacs_Xt_next_event): * event-Xt.c (emacs_Xt_event_handler): * event-Xt.c (emacs_Xt_drain_queue): * event-Xt.c (emacs_Xt_event_pending_p): * event-Xt.c (check_if_pending_expose_event): * event-Xt.c (reinit_vars_of_event_Xt): * event-Xt.c (vars_of_event_Xt): * event-gtk.c: * event-gtk.c (IS_MODIFIER_KEY): * event-gtk.c (emacs_gtk_format_magic_event): * event-gtk.c (emacs_gtk_compare_magic_event): * event-gtk.c (emacs_gtk_hash_magic_event): * event-gtk.c (emacs_gtk_handle_magic_event): * event-gtk.c (gtk_to_emacs_keysym): * event-gtk.c (gtk_timeout_to_emacs_event): * event-gtk.c (gtk_process_to_emacs_event): * event-gtk.c (dragndrop_data_received): * event-gtk.c (signal_special_gtk_user_event): * event-gtk.c (emacs_gtk_next_event): * event-gtk.c (gtk_event_to_emacs_event): * event-gtk.c (generic_event_handler): * event-gtk.c (emacs_shell_event_handler): * event-gtk.c (emacs_gtk_drain_queue): * event-gtk.c (emacs_gtk_event_pending_p): * event-gtk.c (reinit_vars_of_event_gtk): * event-gtk.c (vars_of_event_gtk): * event-msw.c: * event-msw.c (struct winsock_stream): * event-msw.c (winsock_reader): * event-msw.c (winsock_writer): * event-msw.c (mswindows_enqueue_dispatch_event): * event-msw.c (mswindows_enqueue_misc_user_event): * event-msw.c (mswindows_enqueue_magic_event): * event-msw.c (mswindows_enqueue_process_event): * event-msw.c (mswindows_enqueue_mouse_button_event): * event-msw.c (mswindows_enqueue_keypress_event): * event-msw.c (mswindows_dequeue_dispatch_event): * event-msw.c (emacs_mswindows_drain_queue): * event-msw.c (mswindows_need_event_in_modal_loop): * event-msw.c (mswindows_need_event): * event-msw.c (mswindows_wm_timer_callback): * event-msw.c (dde_eval_string): * event-msw.c (Fdde_alloc_advise_item): * event-msw.c (mswindows_dde_callback): * event-msw.c (mswindows_wnd_proc): * event-msw.c (remove_timeout_mapper): * event-msw.c (emacs_mswindows_remove_timeout): * event-msw.c (emacs_mswindows_event_pending_p): * event-msw.c (emacs_mswindows_format_magic_event): * event-msw.c (emacs_mswindows_compare_magic_event): * event-msw.c (emacs_mswindows_hash_magic_event): * event-msw.c (emacs_mswindows_handle_magic_event): * event-msw.c (emacs_mswindows_select_console): * event-msw.c (emacs_mswindows_unselect_console): * event-msw.c (reinit_vars_of_event_mswindows): * event-msw.c (vars_of_event_mswindows): * event-stream.c: * event-stream.c (mark_command_builder): * event-stream.c (reset_command_builder_event_chain): * event-stream.c (allocate_command_builder): * event-stream.c (copy_command_builder): * event-stream.c (command_builder_append_event): * event-stream.c (event_stream_event_pending_p): * event-stream.c (event_stream_force_event_pending): * event-stream.c (maybe_read_quit_event): * event-stream.c (event_stream_drain_queue): * event-stream.c (remove_quit_p_event): * event-stream.c (event_stream_quit_p): * event-stream.c (echo_key_event): * event-stream.c (maybe_kbd_translate): * event-stream.c (execute_help_form): * event-stream.c (event_stream_generate_wakeup): * event-stream.c (enqueue_dispatch_event): * event-stream.c (enqueue_magic_eval_event): * event-stream.c (Fenqueue_eval_event): * event-stream.c (enqueue_misc_user_event): * event-stream.c (enqueue_misc_user_event_pos): * event-stream.c (next_event_internal): * event-stream.c (Fnext_event): * event-stream.c (Faccept_process_output): * event-stream.c (execute_internal_event): * event-stream.c (munge_keymap_translate): * event-stream.c (command_builder_find_leaf_no_mule_processing): * event-stream.c (command_builder_find_leaf): * event-stream.c (lookup_command_event): * event-stream.c (is_scrollbar_event): * event-stream.c (execute_command_event): * event-stream.c (Fdispatch_event): * event-stream.c (Fread_key_sequence): * event-stream.c (dribble_out_event): * event-stream.c (vars_of_event_stream): * event-tty.c (tty_timeout_to_emacs_event): * event-tty.c (emacs_tty_next_event): * event-tty.c (emacs_tty_drain_queue): * event-tty.c (reinit_vars_of_event_tty): * event-unixoid.c: * event-unixoid.c (find_tty_or_stream_console_from_fd): * event-unixoid.c (read_event_from_tty_or_stream_desc): * event-unixoid.c (drain_tty_devices): * event-unixoid.c (poll_fds_for_input): * events.c: * events.c (deinitialize_event): * events.c (zero_event): * events.c (mark_event): * events.c (print_event_1): * events.c (print_event): * events.c (event_equal): * events.c (event_hash): * events.c (Fmake_event): * events.c (Fdeallocate_event): * events.c (Fcopy_event): * events.c (map_event_chain_remove): * events.c (character_to_event): * events.c (event_to_character): * events.c (Fevent_to_character): * events.c (format_event_object): * events.c (upshift_event): * events.c (downshift_event): * events.c (event_upshifted_p): * events.c (Fevent_live_p): * events.c (Fevent_type): * events.c (Fevent_timestamp): * events.c (CHECK_EVENT_TYPE): * events.c (CHECK_EVENT_TYPE2): * events.c (CHECK_EVENT_TYPE3): * events.c (Fevent_key): * events.c (Fevent_button): * events.c (Fevent_modifier_bits): * events.c (event_x_y_pixel_internal): * events.c (event_pixel_translation): * events.c (Fevent_process): * events.c (Fevent_function): * events.c (Fevent_object): * events.c (Fevent_properties): * events.c (syms_of_events): * events.c (vars_of_events): * events.h: * events.h (struct event_stream): * events.h (struct Lisp_Key_Data): * events.h (KEY_DATA_KEYSYM): * events.h (EVENT_KEY_KEYSYM): * events.h (struct Lisp_Button_Data): * events.h (EVENT_BUTTON_BUTTON): * events.h (struct Lisp_Motion_Data): * events.h (EVENT_MOTION_X): * events.h (struct Lisp_Process_Data): * events.h (EVENT_PROCESS_PROCESS): * events.h (struct Lisp_Timeout_Data): * events.h (EVENT_TIMEOUT_INTERVAL_ID): * events.h (struct Lisp_Eval_Data): * events.h (EVENT_EVAL_FUNCTION): * events.h (struct Lisp_Misc_User_Data): * events.h (EVENT_MISC_USER_FUNCTION): * events.h (struct Lisp_Magic_Eval_Data): * events.h (EVENT_MAGIC_EVAL_INTERNAL_FUNCTION): * events.h (struct Lisp_Magic_Data): * events.h (EVENT_MAGIC_UNDERLYING): * events.h (EVENT_MAGIC_GDK_EVENT): * events.h (struct Lisp_Event): * events.h (XEVENT_CHANNEL): * events.h (SET_EVENT_TIMESTAMP_ZERO): * events.h (SET_EVENT_CHANNEL): * events.h (SET_EVENT_NEXT): * events.h (XSET_EVENT_TYPE): * events.h (struct command_builder): * extents.c: * extents.c (gap_array_adjust_markers): * extents.c (gap_array_recompute_derived_values): * extents.c (gap_array_move_gap): * extents.c (gap_array_make_gap): * extents.c (gap_array_insert_els): * extents.c (gap_array_delete_els): * extents.c (gap_array_make_marker): * extents.c (gap_array_delete_marker): * extents.c (gap_array_move_marker): * extents.c (make_gap_array): * extents.c (free_gap_array): * extents.c (extent_list_num_els): * extents.c (extent_list_insert): * extents.c (mark_extent_auxiliary): * extents.c (allocate_extent_auxiliary): * extents.c (decode_extent_at_flag): * extents.c (verify_extent_mapper): * extents.c (symbol_to_glyph_layout): * extents.c (syms_of_extents): * faces.c: * file-coding.c: * file-coding.c (struct_detector_category_description =): * file-coding.c (detector_category_dynarr_description_1): * file-coding.c (struct_detector_description =): * file-coding.c (detector_dynarr_description_1): * file-coding.c (MARKED_SLOT): * file-coding.c (mark_coding_system): * file-coding.c (coding_system_extra_description_map): * file-coding.c (coding_system_description): * file-coding.c (allocate_coding_system): * file-coding.c (symbol_to_eol_type): * file-coding.c (Fcoding_system_aliasee): * file-coding.c (set_coding_stream_coding_system): * file-coding.c (struct convert_eol_coding_system): * file-coding.c (struct undecided_coding_system): * file-coding.c (undecided_mark_coding_stream): * file-coding.c (coding_category_symbol_to_id): * file-coding.c (struct gzip_coding_system): * file-coding.c (coding_system_type_create): * file-coding.h: * file-coding.h (struct Lisp_Coding_System): * file-coding.h (CODING_SYSTEM_SLOT_DECLARATION): * file-coding.h (coding_system_variant): * file-coding.h (struct coding_system_methods): * file-coding.h (DEFINE_CODING_SYSTEM_TYPE_WITH_DATA): * file-coding.h (INITIALIZE_CODING_SYSTEM_TYPE_WITH_DATA): * file-coding.h (struct coding_stream): * fileio.c (Fsubstitute_in_file_name): * floatfns.c: * fns.c: * fns.c (base64_encode_1): * frame-gtk.c: * frame-gtk.c (Fgtk_start_drag_internal): * frame-impl.h (struct frame): * frame-impl.h (MARKED_SLOT): * frame-msw.c: * frame-x.c: * frame-x.c (Fcde_start_drag_internal): * frame-x.c (Foffix_start_drag_internal): * frame.c: * frame.c (MARKED_SLOT): * frame.c (allocate_frame_core): * frame.c (delete_frame_internal): * frame.c (Fmouse_position_as_motion_event): * frameslots.h: * frameslots.h (MARKED_SLOT_ARRAY): * free-hook.c: * glyphs-msw.c (mswindows_widget_instantiate): * glyphs-x.c: * glyphs-x.c (convert_EImage_to_XImage): * glyphs.c: * glyphs.c (process_image_string_instantiator): * glyphs.c (mark_image_instance): * glyphs.c (allocate_image_instance): * glyphs.c (unmap_subwindow): * glyphs.c (map_subwindow): * glyphs.c (syms_of_glyphs): * glyphs.c (specifier_type_create_image): * glyphs.h: * glyphs.h (struct text_image_instance): * glyphs.h (struct Lisp_Image_Instance): * gmalloc.c: * gmalloc.c ("C"): * gpmevent.c (Freceive_gpm_event): * gpmevent.c (gpm_next_event_cb): * gpmevent.c (vars_of_gpmevent): * gtk-glue.c (gdk_event_to_emacs_event): * gtk-xemacs.c (gtk_xemacs_class_init): * gui-msw.c: * gui-msw.c (mswindows_handle_gui_wm_command): * gui-msw.c (mswindows_translate_menu_or_dialog_item): * gui-x.c: * gui-x.c (mark_popup_data): * gui-x.c (snarf_widget_value_mapper): * gui-x.c (gcpro_popup_callbacks): * gui-x.c (ungcpro_popup_callbacks): * gui-x.c (free_popup_widget_value_tree): * gui-x.c (popup_selection_callback): * gui-x.h: * gui-x.h (struct popup_data): * gui.c: * gui.c (allocate_gui_item): * gutter.c (decode_gutter_position): * hash.c (NULL_ENTRY): * indent.c (vmotion_1): * indent.c (vmotion_pixels): * input-method-motif.c (res): * input-method-xlib.c (IMInstantiateCallback): * input-method-xlib.c (XIM_init_device): * input-method-xlib.c (res): * intl-encap-win32.c: * intl-encap-win32.c (qxeSHGetDataFromIDList): * intl-win32.c: * intl-win32.c (mswindows_multibyte_cp_type): * intl-win32.c (struct mswindows_multibyte_coding_system): * keymap.c: * keymap.c (make_key_description): * keymap.c (keymap_store): * keymap.c (get_keyelt): * keymap.c (keymap_lookup_1): * keymap.c (define_key_parser): * keymap.c (key_desc_list_to_event): * keymap.c (event_matches_key_specifier_p): * keymap.c (meta_prefix_char_p): * keymap.c (ensure_meta_prefix_char_keymapp): * keymap.c (Fdefine_key): * keymap.c (struct raw_lookup_key_mapper_closure): * keymap.c (raw_lookup_key): * keymap.c (raw_lookup_key_mapper): * keymap.c (lookup_keys): * keymap.c (lookup_events): * keymap.c (Flookup_key): * keymap.c (struct map_keymap_unsorted_closure): * keymap.c (map_keymap_unsorted_mapper): * keymap.c (map_keymap_sorted): * keymap.c (map_keymap_mapper): * keymap.c (map_keymap): * keymap.c (accessible_keymaps_mapper_1): * keymap.c (Faccessible_keymaps): * keymap.c (Fsingle_key_description): * keymap.c (raw_keys_to_keys): * keymap.c (format_raw_keys): * keymap.c (where_is_recursive_mapper): * keymap.c (where_is_internal): * keymap.c (describe_map_mapper_shadow_search): * keymap.c (keymap_lookup_inherited_mapper): * keymap.c (describe_map_mapper): * keymap.h (event_matches_key_specifier_p): * lisp.h: * lisp.h (this): * lisp.h (RETURN_NOT_REACHED): * lisp.h (struct Lisp_Vector): * lisp.h (struct Lisp_Bit_Vector): * lisp.h (UNGCPRO_1): * lisp.h (NUNGCPRO): * lisp.h (NNUNGCPRO): * lisp.h (DECLARE_INLINE_HEADER): * lrecord.h: * lrecord.h (struct lrecord_header): * lrecord.h (struct lcrecord_header): * lrecord.h (lrecord_type): * lrecord.h (struct lrecord_implementation): * lrecord.h (RECORD_DUMPABLE): * lrecord.h (memory_description_type): * lrecord.h (data_description_entry_flags): * lrecord.h (struct memory_description): * lrecord.h (struct sized_memory_description): * lrecord.h (XD_INDIRECT): * lrecord.h (XD_IS_INDIRECT): * lrecord.h (XD_DYNARR_DESC): * lrecord.h (DEFINE_BASIC_LRECORD_IMPLEMENTATION): * lrecord.h (MAKE_LRECORD_IMPLEMENTATION): * lrecord.h (MAKE_EXTERNAL_LRECORD_IMPLEMENTATION): * lrecord.h (alloc_lcrecord_type): * lstream.c: * lstream.c (Lstream_new): * lstream.c (lisp_buffer_marker): * lstream.h: * lstream.h (lstream_implementation): * lstream.h (DEFINE_LSTREAM_IMPLEMENTATION): * lstream.h (DEFINE_LSTREAM_IMPLEMENTATION_WITH_DATA): * marker.c: * marker.c (copy_marker_1): * mem-limits.h: * menubar-gtk.c: * menubar-gtk.c (gtk_popup_menu): * menubar-msw.c: * menubar-msw.c (mswindows_popup_menu): * menubar-x.c (make_dummy_xbutton_event): * menubar-x.c (command_builder_operate_menu_accelerator): * menubar-x.c (menu_accelerator_safe_compare): * menubar-x.c (menu_accelerator_safe_mod_compare): * mule-charset.c: * mule-charset.c (make_charset): * mule-charset.c (Fcharset_property): * mule-coding.c: * mule-coding.c (ccs_description_1): * mule-coding.c (ccs_description =): * mule-coding.c (ccsd_description_1): * mule-coding.c (ccsd_description =): * nt.c (getpwnam): * nt.c (init_mswindows_environment): * nt.c (get_cached_volume_information): * nt.c (mswindows_is_executable): * nt.c (read_unc_volume): * nt.c (mswindows_access): * nt.c (mswindows_link): * nt.c (mswindows_fstat): * nt.c (mswindows_stat): * nt.c (mswindows_executable_type): * nt.c (Fmswindows_short_file_name): * nt.c (Fmswindows_long_file_name): * objects-impl.h (struct Lisp_Color_Instance): * objects-impl.h (struct Lisp_Font_Instance): * objects-tty.c: * objects-x.c (allocate_nearest_color): * objects.c: * objects.c (Fmake_color_instance): * objects.c (Fmake_font_instance): * objects.c (font_instantiate): * opaque.c: * opaque.c (make_opaque): * opaque.c (make_opaque_ptr): * opaque.c (reinit_opaque_early): * opaque.c (init_opaque_once_early): * print.c: * print.c (printing_badness): * print.c (printing_major_badness): * print.c (print_internal): * print.c (debug_p4): * print.c (dp): * print.c (debug_backtrace): * process-nt.c (nt_create_process): * process-nt.c (get_internet_address): * process-unix.c: * process-unix.c (struct unix_process_data): * process-unix.c (get_internet_address): * process-unix.c (unix_alloc_process_data): * process-unix.c (unix_create_process): * process-unix.c (try_to_initialize_subtty): * process-unix.c (unix_kill_child_process): * process-unix.c (process_type_create_unix): * process.c: * process.c (mark_process): * process.c (MARKED_SLOT): * process.c (make_process_internal): * process.c (Fprocess_tty_name): * process.c (decode_signal): * process.h: * procimpl.h: * procimpl.h (struct process_methods): * procimpl.h (struct Lisp_Process): * rangetab.c: * realpath.c (readlink_and_correct_case): * redisplay-x.c (x_window_output_end): * redisplay-x.c (x_redraw_exposed_area): * redisplay-x.c (x_clear_frame): * redisplay.c: * redisplay.h: * redisplay.h (struct rune_dglyph): * redisplay.h (struct rune): * scrollbar.c: * scrollbar.c (create_scrollbar_instance): * specifier.c: * specifier.c (specifier_empty_extra_description_1): * specifier.c (make_specifier_internal): * specifier.c (decode_locale_type): * specifier.c (decode_how_to_add_specification): * specifier.h: * specifier.h (struct specifier_methods): * specifier.h (DEFINE_SPECIFIER_TYPE_WITH_DATA): * specifier.h (INITIALIZE_SPECIFIER_TYPE_WITH_DATA): * symbols.c: * symbols.c (Fsetplist): * symbols.c (default_value): * symbols.c (decode_magic_handler_type): * symbols.c (handler_type_from_function_symbol): * symbols.c (Fdefvaralias): * symbols.c (init_symbols_once_early): * symbols.c (reinit_symbols_early): * symsinit.h: * sysdep.c (sys_subshell): * sysdep.c (tty_init_sys_modes_on_device): * syswindows.h: * text.c (dfc_convert_to_external_format): * text.c (dfc_convert_to_internal_format): * text.c (reinit_eistring_early): * text.c (init_eistring_once_early): * text.c (reinit_vars_of_text): * text.h: * text.h (INC_IBYTEPTR_FMT): * text.h (DEC_IBYTEPTR_FMT): * toolbar.c: * toolbar.c (decode_toolbar_position): * tooltalk.c: * ui-gtk.c: * unexnt.c: * unexnt.c (_start): * unexnt.c (unexec): * unexnt.c (get_section_info): * unicode.c: * unicode.c (vars_of_unicode): * window.c: * window.c (allocate_window): * window.c (new_window_mirror): * window.c (update_mirror_internal): * winslots.h:
author michaels
date Sun, 12 Jan 2003 11:08:22 +0000
parents a123f88fa975
children 5cec7ab01719
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Execution of byte code produced by bytecomp.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Implementation of compiled-function objects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1992, 1993 Free Software Foundation, Inc.
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
4 Copyright (C) 1995, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Mule 2.0, FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* This file has been Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 /* Authorship:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 FSF: long ago.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 hacked on by jwz@jwz.org 1991-06
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 o added a compile-time switch to turn on simple sanity checking;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 o put back the obsolete byte-codes for error-detection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 o added a new instruction, unbind_all, which I will use for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 tail-recursion elimination;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 o made temp_output_buffer_show be called with the right number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 of args;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 o made the new bytecodes be called with args in the right order;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 o added metering support.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 by Hallvard:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 o added relative jump instructions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 o all conditionals now only do QUIT if they jump.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 Ben Wing: some changes for Mule, 1995-06.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 Martin Buchholz: performance hacking, 1998-09.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 See Internals Manual, Evaluation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #include "backtrace.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 #include "opaque.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #include "syntax.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
59 #include "window.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 EXFUN (Ffetch_bytecode, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 enum Opcode /* Byte codes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Bvarref = 010,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 Bvarset = 020,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 Bvarbind = 030,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Bcall = 040,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 Bunbind = 050,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 Bnth = 070,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 Bsymbolp = 071,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 Bconsp = 072,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 Bstringp = 073,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 Blistp = 074,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 Bold_eq = 075,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 Bold_memq = 076,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 Bnot = 077,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 Bcar = 0100,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 Bcdr = 0101,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 Bcons = 0102,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 Blist1 = 0103,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 Blist2 = 0104,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Blist3 = 0105,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 Blist4 = 0106,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 Blength = 0107,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 Baref = 0110,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 Baset = 0111,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 Bsymbol_value = 0112,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 Bsymbol_function = 0113,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 Bset = 0114,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 Bfset = 0115,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Bget = 0116,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 Bsubstring = 0117,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 Bconcat2 = 0120,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 Bconcat3 = 0121,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 Bconcat4 = 0122,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Bsub1 = 0123,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 Badd1 = 0124,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 Beqlsign = 0125,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 Bgtr = 0126,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 Blss = 0127,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 Bleq = 0130,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 Bgeq = 0131,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 Bdiff = 0132,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Bnegate = 0133,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 Bplus = 0134,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 Bmax = 0135,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 Bmin = 0136,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 Bmult = 0137,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Bpoint = 0140,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 Beq = 0141, /* was Bmark,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 Bgoto_char = 0142,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 Binsert = 0143,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 Bpoint_max = 0144,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 Bpoint_min = 0145,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 Bchar_after = 0146,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 Bfollowing_char = 0147,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Bpreceding_char = 0150,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 Bcurrent_column = 0151,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 Bindent_to = 0152,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 Bequal = 0153, /* was Bscan_buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 Beolp = 0154,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 Beobp = 0155,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 Bbolp = 0156,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 Bbobp = 0157,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 Bcurrent_buffer = 0160,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 Bset_buffer = 0161,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 Bsave_current_buffer = 0162, /* was Bread_char,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 but no longer generated as of v19 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 Bmemq = 0163, /* was Bset_mark,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 Binteractive_p = 0164, /* Needed since interactive-p takes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 unevalled args */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 Bforward_char = 0165,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 Bforward_word = 0166,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 Bskip_chars_forward = 0167,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 Bskip_chars_backward = 0170,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 Bforward_line = 0171,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 Bchar_syntax = 0172,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 Bbuffer_substring = 0173,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 Bdelete_region = 0174,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 Bnarrow_to_region = 0175,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 Bwiden = 0176,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 Bend_of_line = 0177,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 Bconstant2 = 0201,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Bgoto = 0202,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 Bgotoifnil = 0203,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 Bgotoifnonnil = 0204,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 Bgotoifnilelsepop = 0205,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 Bgotoifnonnilelsepop = 0206,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 Breturn = 0207,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 Bdiscard = 0210,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 Bdup = 0211,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 Bsave_excursion = 0212,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 Bsave_window_excursion= 0213,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 Bsave_restriction = 0214,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 Bcatch = 0215,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 Bunwind_protect = 0216,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 Bcondition_case = 0217,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 Btemp_output_buffer_setup = 0220,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 Btemp_output_buffer_show = 0221,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 Bunbind_all = 0222,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 Bset_marker = 0223,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 Bmatch_beginning = 0224,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 Bmatch_end = 0225,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 Bupcase = 0226,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 Bdowncase = 0227,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 Bstring_equal = 0230,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 Bstring_lessp = 0231,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 Bold_equal = 0232,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 Bnthcdr = 0233,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 Belt = 0234,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Bold_member = 0235,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 Bold_assq = 0236,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 Bnreverse = 0237,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 Bsetcar = 0240,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 Bsetcdr = 0241,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 Bcar_safe = 0242,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 Bcdr_safe = 0243,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 Bnconc = 0244,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 Bquo = 0245,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 Brem = 0246,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 Bnumberp = 0247,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 Bintegerp = 0250,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 BRgoto = 0252,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 BRgotoifnil = 0253,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 BRgotoifnonnil = 0254,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 BRgotoifnilelsepop = 0255,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 BRgotoifnonnilelsepop = 0256,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 BlistN = 0257,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 BconcatN = 0260,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 BinsertN = 0261,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 Bmember = 0266, /* new in v20 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 Bassq = 0267, /* new in v20 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 Bconstant = 0300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 typedef enum Opcode Opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
216 const Opbyte *program_ptr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Opcode opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 /* Define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 This isn't defined in FSF Emacs and isn't defined in XEmacs v19. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 /* #define BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 int byte_metering_on;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 meter_code (Opcode prev_opcode, Opcode this_opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 if (byte_metering_on)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 Lisp_Object *p = XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[this_opcode]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 p[0] = INT_PLUS1 (p[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 if (prev_opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 p[prev_opcode] = INT_PLUS1 (p[prev_opcode]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 #endif /* BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 bytecode_negate (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 if (INTP (obj)) return make_int (- XINT (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 if (FLOATP (obj)) return make_float (- XFLOAT_DATA (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 if (CHARP (obj)) return make_int (- ((int) XCHAR (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 if (MARKERP (obj)) return make_int (- ((int) marker_position (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 bytecode_nreverse (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 REGISTER Lisp_Object prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 REGISTER Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 REGISTER Lisp_Object next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 CHECK_CONS (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 next = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 XCDR (tail) = prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 tail = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 return prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 /* We have our own two-argument versions of various arithmetic ops.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 Only two-argument arithmetic operations have their own byte codes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 else goto arithcompare_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 else goto arithcompare_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 arithcompare_float:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 double dval1, dval2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 if (FLOATP (obj1)) dval1 = XFLOAT_DATA (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 else if (INTP (obj1)) dval1 = (double) XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 else if (CHARP (obj1)) dval1 = (double) XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 else if (MARKERP (obj1)) dval1 = (double) marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 if (FLOATP (obj2)) dval2 = XFLOAT_DATA (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 else if (INTP (obj2)) dval2 = (double) XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 else if (CHARP (obj2)) dval2 = (double) XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 else if (MARKERP (obj2)) dval2 = (double) marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 return dval1 < dval2 ? -1 : dval1 > dval2 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 int float_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 float_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 else if (FLOATP (obj1)) ival1 = 0, float_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 else if (FLOATP (obj2)) ival2 = 0, float_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 if (!float_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 case Bplus: ival1 += ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 case Bdiff: ival1 -= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 case Bmult: ival1 *= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 if (ival2 == 0) Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 ival1 /= ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 case Bmax: if (ival1 < ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 case Bmin: if (ival1 > ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 return make_int (ival1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 double dval1 = FLOATP (obj1) ? XFLOAT_DATA (obj1) : (double) ival1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 double dval2 = FLOATP (obj2) ? XFLOAT_DATA (obj2) : (double) ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 case Bplus: dval1 += dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 case Bdiff: dval1 -= dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 case Bmult: dval1 *= dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 if (dval2 == 0) Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 dval1 /= dval2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 case Bmax: if (dval1 < dval2) dval1 = dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 case Bmin: if (dval1 > dval2) dval1 = dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 return make_float (dval1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 /* Read next uint8 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 #define READ_UINT_1 ((unsigned int) (unsigned char) *program_ptr++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 /* Read next uint16 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 #define READ_UINT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (program_ptr += 2, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (((unsigned int) (unsigned char) program_ptr[-1]) * 256 + \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 ((unsigned int) (unsigned char) program_ptr[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 /* Read next int8 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 #define READ_INT_1 ((int) (signed char) *program_ptr++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 /* Read next int16 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 #define READ_INT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (program_ptr += 2, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (((int) ( signed char) program_ptr[-1]) * 256 + \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 ((int) (unsigned char) program_ptr[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 /* Read next int8 from instruction stream; don't advance program_pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 #define PEEK_INT_1 ((int) (signed char) program_ptr[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 /* Read next int16 from instruction stream; don't advance program_pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 #define PEEK_INT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 ((((int) ( signed char) program_ptr[1]) * 256) | \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 ((int) (unsigned char) program_ptr[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 /* Do relative jumps from the current location.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 We only do a QUIT if we jump backwards, for efficiency.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 No infloops without backward jumps! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 #define JUMP_RELATIVE(jump) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 int JR_jump = (jump); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 if (JR_jump < 0) QUIT; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 program_ptr += JR_jump; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 #define JUMP JUMP_RELATIVE (PEEK_INT_2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 #define JUMPR JUMP_RELATIVE (PEEK_INT_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 #define JUMP_NEXT ((void) (program_ptr += 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 #define JUMPR_NEXT ((void) (program_ptr += 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 /* Push x onto the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 #define PUSH(x) (*++stack_ptr = (x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 /* Pop a value off the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 #define POP (*stack_ptr--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 /* Discard n values from the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 #define DISCARD(n) (stack_ptr -= (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 /* Get the value which is at the top of the execution stack,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 but don't pop it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 #define TOP (*stack_ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 /* The actual interpreter for byte code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 This function has been seriously optimized for performance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 Don't change the constructs unless you are willing to do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 real benchmarking and profiling work -- martin */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
456 Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
457 execute_optimized_program (const Opbyte *program,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 int stack_depth,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 Lisp_Object *constants_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
462 REGISTER const Opbyte *program_ptr = (Opbyte *) program;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 REGISTER Lisp_Object *stack_ptr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 = alloca_array (Lisp_Object, stack_depth + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 Opcode this_opcode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 Opcode prev_opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 Lisp_Object *stack_beg = stack_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 Lisp_Object *stack_end = stack_beg + stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 /* Initialize all the objects on the stack to Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 so we can GCPRO the whole stack.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 The first element of the stack is actually a dummy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 Lisp_Object *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 for (i = stack_depth, p = stack_ptr; i--;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 *++p = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 GCPRO1 (stack_ptr[1]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 gcpro1.nvars = stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 REGISTER Opcode opcode = (Opcode) READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 if (stack_ptr > stack_end)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
496 stack_overflow ("byte code stack overflow", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 if (stack_ptr < stack_beg)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
498 stack_overflow ("byte code stack underflow", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 prev_opcode = this_opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 this_opcode = opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 meter_code (prev_opcode, this_opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 REGISTER int n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 if (opcode >= Bconstant)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 PUSH (constants_data[opcode - Bconstant]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 case Bvarref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 case Bvarref+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 case Bvarref+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 case Bvarref+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 case Bvarref+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 case Bvarref+5: n = opcode - Bvarref; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 case Bvarref+7: n = READ_UINT_2; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 case Bvarref+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 do_varref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 Lisp_Object symbol = constants_data[n];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 Lisp_Object value = XSYMBOL (symbol)->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 if (SYMBOL_VALUE_MAGIC_P (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 value = Fsymbol_value (symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 PUSH (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 case Bvarset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 case Bvarset+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 case Bvarset+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 case Bvarset+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 case Bvarset+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 case Bvarset+5: n = opcode - Bvarset; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 case Bvarset+7: n = READ_UINT_2; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 case Bvarset+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 do_varset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 Lisp_Object symbol = constants_data[n];
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
547 Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 Lisp_Object old_value = symbol_ptr->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 Lisp_Object new_value = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 symbol_ptr->value = new_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 Fset (symbol, new_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 case Bvarbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 case Bvarbind+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 case Bvarbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 case Bvarbind+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 case Bvarbind+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 case Bvarbind+5: n = opcode - Bvarbind; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 case Bvarbind+7: n = READ_UINT_2; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 case Bvarbind+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 do_varbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 Lisp_Object symbol = constants_data[n];
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
568 Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 Lisp_Object old_value = symbol_ptr->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 Lisp_Object new_value = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 specpdl_ptr->symbol = symbol;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 specpdl_ptr->old_value = old_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 specpdl_ptr->func = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 specpdl_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 specpdl_depth_counter++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 symbol_ptr->value = new_value;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
580
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
581 #ifdef ERROR_CHECK_CATCH
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
582 check_specbind_stack_sanity ();
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
583 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 specbind_magic (symbol, new_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 case Bcall:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 case Bcall+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 case Bcall+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 case Bcall+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 case Bcall+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 case Bcall+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 case Bcall+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 case Bcall+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 n = (opcode < Bcall+6 ? opcode - Bcall :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 DISCARD (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 if (byte_metering_on && SYMBOLP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 if (INTP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 Fput (TOP, Qbyte_code_meter, make_int (XINT (val) + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 TOP = Ffuncall (n + 1, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 case Bunbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 case Bunbind+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 case Bunbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 case Bunbind+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 case Bunbind+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 case Bunbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 case Bunbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 case Bunbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 UNBIND_TO (specpdl_depth() -
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (opcode < Bunbind+6 ? opcode-Bunbind :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 if (NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 if (!NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 if (NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 if (!NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 if (NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 if (!NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 if (NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 if (!NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 case Breturn:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 /* Binds and unbinds are supposed to be compiled balanced. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 if (specpdl_depth() != speccount)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
708 invalid_byte_code ("unbalanced specbinding stack", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 return TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 case Bdiscard:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 case Bdup:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 Lisp_Object arg = TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 PUSH (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 case Bconstant2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 PUSH (constants_data[READ_UINT_2]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 case Bcar:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 TOP = CONSP (TOP) ? XCAR (TOP) : Fcar (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 case Bcdr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 TOP = CONSP (TOP) ? XCDR (TOP) : Fcdr (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 case Bunbind_all:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 /* To unbind back to the beginning of this frame. Not used yet,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 but will be needed for tail-recursion elimination. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
739 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 case Bnth:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 TOP = Fcar (Fnthcdr (TOP, arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 case Bsymbolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 TOP = SYMBOLP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 case Bconsp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 TOP = CONSP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 case Bstringp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 TOP = STRINGP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 case Blistp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 TOP = LISTP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 case Bnumberp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 TOP = INT_OR_FLOATP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 case Bintegerp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 TOP = INTP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 case Beq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 TOP = EQ_WITH_EBOLA_NOTICE (TOP, arg) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 case Bnot:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 TOP = NILP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 case Bcons:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 TOP = Fcons (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 case Blist1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 TOP = Fcons (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 case BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 goto do_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 case Blist2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 case Blist3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 case Blist4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 /* common case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 n = opcode - (Blist1 - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 do_list:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 Lisp_Object list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 list_loop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 list = Fcons (TOP, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 if (--n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 goto list_loop;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 TOP = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 case Bconcat2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 case Bconcat3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 case Bconcat4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 n = opcode - (Bconcat2 - 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 goto do_concat;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 /* common case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 do_concat:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 DISCARD (n - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 TOP = Fconcat (n, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 case Blength:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 TOP = Flength (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 case Baset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 TOP = Faset (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 case Bsymbol_value:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 TOP = Fsymbol_value (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 case Bsymbol_function:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 TOP = Fsymbol_function (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 case Bget:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 TOP = Fget (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 case Bsub1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 TOP = INTP (TOP) ? INT_MINUS1 (TOP) : Fsub1 (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 case Badd1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 TOP = INTP (TOP) ? INT_PLUS1 (TOP) : Fadd1 (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 case Beqlsign:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 TOP = bytecode_arithcompare (TOP, arg) == 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 case Bgtr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 TOP = bytecode_arithcompare (TOP, arg) > 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 case Blss:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 TOP = bytecode_arithcompare (TOP, arg) < 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 case Bleq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 TOP = bytecode_arithcompare (TOP, arg) <= 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 case Bgeq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 TOP = bytecode_arithcompare (TOP, arg) >= 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 case Bnegate:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 TOP = bytecode_negate (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 case Bnconc:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 TOP = bytecode_nconc2 (&TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 case Bplus:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 Lisp_Object arg1 = TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 TOP = INTP (arg1) && INTP (arg2) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 INT_PLUS (arg1, arg2) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 bytecode_arithop (arg1, arg2, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 case Bdiff:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 Lisp_Object arg1 = TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 TOP = INTP (arg1) && INTP (arg2) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 INT_MINUS (arg1, arg2) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 bytecode_arithop (arg1, arg2, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 case Bmult:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 case Bmax:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 case Bmin:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 TOP = bytecode_arithop (TOP, arg, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 case Bpoint:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 PUSH (make_int (BUF_PT (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 case Binsert:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 TOP = Finsert (1, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 case BinsertN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 DISCARD (n - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 TOP = Finsert (n, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 case Baref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 TOP = Faref (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 case Bmemq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 TOP = Fmemq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 case Bset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 TOP = Fset (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 case Bequal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 TOP = Fequal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 case Bnthcdr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 TOP = Fnthcdr (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 case Belt:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 TOP = Felt (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 case Bmember:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 TOP = Fmember (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 case Bgoto_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 TOP = Fgoto_char (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 case Bcurrent_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1015 Lisp_Object buffer = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1016
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 PUSH (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 case Bset_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 TOP = Fset_buffer (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 case Bpoint_max:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 PUSH (make_int (BUF_ZV (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 case Bpoint_min:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 PUSH (make_int (BUF_BEGV (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 case Bskip_chars_forward:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 TOP = Fskip_chars_forward (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 case Bassq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 TOP = Fassq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 case Bsetcar:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 TOP = Fsetcar (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 case Bsetcdr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 TOP = Fsetcdr (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 case Bnreverse:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 TOP = bytecode_nreverse (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 case Bcar_safe:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 TOP = CONSP (TOP) ? XCAR (TOP) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 case Bcdr_safe:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 TOP = CONSP (TOP) ? XCDR (TOP) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 /* It makes a worthwhile performance difference (5%) to shunt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 lesser-used opcodes off to a subroutine, to keep the switch in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 execute_optimized_program small. If you REALLY care about
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 performance, you want to keep your heavily executed code away from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 rarely executed code, to minimize cache misses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 Don't make this function static, since then the compiler might inline it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 Lisp_Object *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 execute_rare_opcode (Lisp_Object *stack_ptr,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1086 const Opbyte *program_ptr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 Opcode opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 case Bsave_excursion:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 record_unwind_protect (save_excursion_restore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 case Bsave_window_excursion:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 record_unwind_protect (save_window_excursion_unwind,
1149
a123f88fa975 [xemacs-hg @ 2002-12-08 10:24:33 by michaels]
michaels
parents: 1104
diff changeset
1101 call1 (Qcurrent_window_configuration, Qnil));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 TOP = Fprogn (TOP);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1103 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 case Bsave_restriction:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 record_unwind_protect (save_restriction_restore,
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
1109 save_restriction_save (current_buffer));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 case Bcatch:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 Lisp_Object arg = POP;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
1115 TOP = internal_catch (TOP, Feval, arg, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 case Bskip_chars_backward:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 TOP = Fskip_chars_backward (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 case Bunwind_protect:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 record_unwind_protect (Fprogn, POP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 case Bcondition_case:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 Lisp_Object arg2 = POP; /* handlers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 Lisp_Object arg1 = POP; /* bodyform */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 TOP = condition_case_3 (arg1, TOP, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 case Bset_marker:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 TOP = Fset_marker (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 case Brem:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 TOP = Frem (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 case Bmatch_beginning:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 TOP = Fmatch_beginning (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 case Bmatch_end:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 TOP = Fmatch_end (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 case Bupcase:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 TOP = Fupcase (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 case Bdowncase:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 TOP = Fdowncase (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 case Bfset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 TOP = Ffset (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 case Bstring_equal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 TOP = Fstring_equal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 case Bstring_lessp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 TOP = Fstring_lessp (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 case Bsubstring:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 TOP = Fsubstring (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 case Bcurrent_column:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 PUSH (make_int (current_column (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 case Bchar_after:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 TOP = Fchar_after (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 case Bindent_to:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 TOP = Findent_to (TOP, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 case Bwiden:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 PUSH (Fwiden (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 case Bfollowing_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 PUSH (Ffollowing_char (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 case Bpreceding_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 PUSH (Fpreceding_char (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 case Beolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 PUSH (Feolp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 case Beobp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 PUSH (Feobp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 case Bbolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 PUSH (Fbolp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 case Bbobp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 PUSH (Fbobp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 case Bsave_current_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 record_unwind_protect (save_current_buffer_restore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 case Binteractive_p:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 PUSH (Finteractive_p ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 case Bforward_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 TOP = Fforward_char (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 case Bforward_word:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 TOP = Fforward_word (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 case Bforward_line:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 TOP = Fforward_line (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 case Bchar_syntax:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 TOP = Fchar_syntax (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 case Bbuffer_substring:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 TOP = Fbuffer_substring (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 case Bdelete_region:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 TOP = Fdelete_region (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 case Bnarrow_to_region:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 TOP = Fnarrow_to_region (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 case Bend_of_line:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 TOP = Fend_of_line (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 case Btemp_output_buffer_setup:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 temp_output_buffer_setup (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 TOP = Vstandard_output;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 case Btemp_output_buffer_show:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 temp_output_buffer_show (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 TOP = arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 /* GAG ME!! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 /* pop binding of standard-output */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1300 unbind_to (specpdl_depth() - 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 case Bold_eq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 TOP = HACKEQ_UNSAFE (TOP, arg) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 case Bold_memq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 TOP = Fold_memq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 case Bold_equal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 TOP = Fold_equal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 case Bold_member:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 TOP = Fold_member (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 case Bold_assq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 TOP = Fold_assq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 abort();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 return stack_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1347 DOESNT_RETURN
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1348 invalid_byte_code (const CIbyte *reason, Lisp_Object frob)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1350 signal_error (Qinvalid_byte_code, reason, frob);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 /* Check for valid opcodes. Change this when adding new opcodes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 check_opcode (Opcode opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 if ((opcode < Bvarref) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 (opcode == 0251) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 (opcode > Bassq && opcode < Bconstant))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1360 invalid_byte_code ("invalid opcode in instruction stream",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1361 make_int (opcode));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 /* Check that IDX is a valid offset into the `constants' vector */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 check_constants_index (int idx, Lisp_Object constants)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 if (idx < 0 || idx >= XVECTOR_LENGTH (constants))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1369 signal_ferror
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1370 (Qinvalid_byte_code,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1371 "reference %d to constants array out of range 0, %ld",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 idx, XVECTOR_LENGTH (constants) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 /* Get next character from Lisp instructions string. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1376 #define READ_INSTRUCTION_CHAR(lvalue) do { \
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1377 (lvalue) = itext_ichar (ptr); \
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1378 INC_IBYTEPTR (ptr); \
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1379 *icounts_ptr++ = program_ptr - program; \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1380 if (lvalue > UCHAR_MAX) \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1381 invalid_byte_code \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1382 ("Invalid character in byte code string", make_char (lvalue)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 /* Get opcode from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 #define READ_OPCODE do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 unsigned int c; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 READ_INSTRUCTION_CHAR (c); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 opcode = (Opcode) c; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 /* Get next operand, a uint8, from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 #define READ_OPERAND_1 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 READ_INSTRUCTION_CHAR (arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 argsize = 1; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 /* Get next operand, a uint16, from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 #define READ_OPERAND_2 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 unsigned int arg1, arg2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 READ_INSTRUCTION_CHAR (arg1); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 READ_INSTRUCTION_CHAR (arg2); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 arg = arg1 + (arg2 << 8); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 argsize = 2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 /* Write 1 byte to PTR, incrementing PTR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 #define WRITE_INT8(value, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 *((ptr)++) = (value); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 /* Write 2 bytes to PTR, incrementing PTR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 #define WRITE_INT16(value, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 WRITE_INT8 (((unsigned) (value)) & 0x00ff, (ptr)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 WRITE_INT8 (((unsigned) (value)) >> 8 , (ptr)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 /* We've changed our minds about the opcode we've already written. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 #define REWRITE_OPCODE(new_opcode) ((void) (program_ptr[-1] = new_opcode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 /* Encode an op arg within the opcode, or as a 1 or 2-byte operand. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 #define WRITE_NARGS(base_opcode) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 if (arg <= 5) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 REWRITE_OPCODE (base_opcode + arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 else if (arg <= UCHAR_MAX) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 REWRITE_OPCODE (base_opcode + 6); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 WRITE_INT8 (arg, program_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 REWRITE_OPCODE (base_opcode + 7); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 WRITE_INT16 (arg, program_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 /* Encode a constants reference within the opcode, or as a 2-byte operand. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 #define WRITE_CONSTANT do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 check_constants_index(arg, constants); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 if (arg <= UCHAR_MAX - Bconstant) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 REWRITE_OPCODE (Bconstant + arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 REWRITE_OPCODE (Bconstant2); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 WRITE_INT16 (arg, program_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 #define WRITE_OPCODE WRITE_INT8 (opcode, program_ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 /* Compile byte code instructions into free space provided by caller, with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 size >= (2 * string_char_length (instructions) + 1) * sizeof (Opbyte).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 Returns length of compiled code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 optimize_byte_code (/* in */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 Lisp_Object instructions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 Lisp_Object constants,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 /* out */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1463 Opbyte * const program,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1464 int * const program_length,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1465 int * const varbind_count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 609
diff changeset
1467 Bytecount instructions_length = XSTRING_LENGTH (instructions);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1468 Elemcount comfy_size = (Elemcount) (2 * instructions_length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1470 int * const icounts = alloca_array (int, comfy_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 int * icounts_ptr = icounts;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 /* We maintain a table of jumps in the source code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 struct jump
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 int from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 int to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 };
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1479 struct jump * const jumps = alloca_array (struct jump, comfy_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 struct jump *jumps_ptr = jumps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 Opbyte *program_ptr = program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1484 const Ibyte *ptr = XSTRING_DATA (instructions);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1485 const Ibyte * const end = ptr + instructions_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 *varbind_count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 while (ptr < end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 Opcode opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 int arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 int argsize = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 READ_OPCODE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 WRITE_OPCODE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 case Bvarref+7: READ_OPERAND_2; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 case Bvarref+6: READ_OPERAND_1; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 case Bvarref: case Bvarref+1: case Bvarref+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 case Bvarref+3: case Bvarref+4: case Bvarref+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 arg = opcode - Bvarref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 do_varref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1510 invalid_byte_code ("variable reference to non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 if (EQ (val, Qnil) || EQ (val, Qt) || (SYMBOL_IS_KEYWORD (val)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1512 invalid_byte_code ("variable reference to constant symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 WRITE_NARGS (Bvarref);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 case Bvarset+7: READ_OPERAND_2; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 case Bvarset+6: READ_OPERAND_1; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 case Bvarset: case Bvarset+1: case Bvarset+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 case Bvarset+3: case Bvarset+4: case Bvarset+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 arg = opcode - Bvarset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 do_varset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1525 wtaerror ("attempt to set non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 if (EQ (val, Qnil) || EQ (val, Qt))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1527 signal_error (Qsetting_constant, 0, val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 /* Ignore assignments to keywords by converting to Bdiscard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 For backward compatibility only - we'd like to make this an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 if (SYMBOL_IS_KEYWORD (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 REWRITE_OPCODE (Bdiscard);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 WRITE_NARGS (Bvarset);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 case Bvarbind+7: READ_OPERAND_2; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 case Bvarbind+6: READ_OPERAND_1; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 case Bvarbind: case Bvarbind+1: case Bvarbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 case Bvarbind+3: case Bvarbind+4: case Bvarbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 arg = opcode - Bvarbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 do_varbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 (*varbind_count)++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1546 wtaerror ("attempt to let-bind non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 if (EQ (val, Qnil) || EQ (val, Qt) || (SYMBOL_IS_KEYWORD (val)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1548 signal_error (Qsetting_constant,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1549 "attempt to let-bind constant symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 WRITE_NARGS (Bvarbind);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 case Bcall+7: READ_OPERAND_2; goto do_call;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 case Bcall+6: READ_OPERAND_1; goto do_call;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 case Bcall: case Bcall+1: case Bcall+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 case Bcall+3: case Bcall+4: case Bcall+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 arg = opcode - Bcall;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 do_call:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 WRITE_NARGS (Bcall);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 case Bunbind+7: READ_OPERAND_2; goto do_unbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 case Bunbind+6: READ_OPERAND_1; goto do_unbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 case Bunbind: case Bunbind+1: case Bunbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 case Bunbind+3: case Bunbind+4: case Bunbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 arg = opcode - Bunbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 do_unbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 WRITE_NARGS (Bunbind);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 READ_OPERAND_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 /* Make program_ptr-relative */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 arg += icounts - (icounts_ptr - argsize);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 goto do_jump;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 READ_OPERAND_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 /* Make program_ptr-relative */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 arg -= 127;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 do_jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 /* Record program-relative goto addresses in `jumps' table */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 jumps_ptr->from = icounts_ptr - icounts - argsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 jumps_ptr->to = jumps_ptr->from + arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 jumps_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 if (arg >= -1 && arg <= argsize)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1595 invalid_byte_code ("goto instruction is its own target", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 if (arg <= SCHAR_MIN ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 arg > SCHAR_MAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 if (argsize == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 REWRITE_OPCODE (opcode + Bgoto - BRgoto);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 WRITE_INT16 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 if (argsize == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 REWRITE_OPCODE (opcode + BRgoto - Bgoto);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 WRITE_INT8 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 case Bconstant2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 READ_OPERAND_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 WRITE_CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 case BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 case BinsertN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 READ_OPERAND_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 WRITE_INT8 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 if (opcode < Bconstant)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 check_opcode (opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 arg = opcode - Bconstant;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 WRITE_CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 /* Fix up jumps table to refer to NEW offsets. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 struct jump *j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 for (j = jumps; j < jumps_ptr; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 assert (j->from < icounts_ptr - icounts);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 assert (j->to < icounts_ptr - icounts);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 j->from = icounts[j->from];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 j->to = icounts[j->to];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 assert (j->from < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 assert (j->to < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 check_opcode ((Opcode) (program[j->from-1]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 check_opcode ((Opcode) (program[j->to]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 /* Fixup jumps in byte-code until no more fixups needed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 int more_fixups_needed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 while (more_fixups_needed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 struct jump *j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 more_fixups_needed = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 for (j = jumps; j < jumps_ptr; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 int from = j->from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 int to = j->to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 int jump = to - from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 Opbyte *p = program + from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 Opcode opcode = (Opcode) p[-1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 if (!more_fixups_needed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 check_opcode ((Opcode) p[jump]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 assert (to >= 0 && program + to < program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 WRITE_INT16 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 if (jump > SCHAR_MIN &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 jump <= SCHAR_MAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 WRITE_INT8 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 else /* barf */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 struct jump *jj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 for (jj = jumps; jj < jumps_ptr; jj++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 assert (jj->from < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 assert (jj->to < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 if (jj->from > from) jj->from++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 if (jj->to > from) jj->to++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 p[-1] += Bgoto - BRgoto;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 more_fixups_needed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 memmove (p+1, p, program_ptr++ - p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 WRITE_INT16 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 abort();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 /* *program_ptr++ = 0; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 *program_length = program_ptr - program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 /* Optimize the byte code and store the optimized program, only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 understood by bytecode.c, in an opaque object in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 instructions slot of the Compiled_Function object. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 optimize_compiled_function (Lisp_Object compiled_function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (compiled_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 int program_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 int varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 Opbyte *program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 /* If we have not actually read the bytecode string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 and constants vector yet, fetch them from the file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 if (CONSP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 Ffetch_bytecode (compiled_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 if (STRINGP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1740 /* XSTRING_LENGTH() is more efficient than string_char_length(),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 which would be slightly more `proper' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (f->instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 optimize_byte_code (f->instructions, f->constants,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 program, &program_length, &varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 f->specpdl_depth = XINT (Flength (f->arglist)) + varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 f->instructions =
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1747 make_opaque (program, program_length * sizeof (Opbyte));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 assert (OPAQUEP (f->instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 /* The compiled-function object type */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 Lisp_Compiled_Function *f =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 XCOMPILED_FUNCTION (obj); /* GC doesn't relocate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 int docp = f->flags.documentationp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 int intp = f->flags.interactivep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1768 write_c_string (printcharfun, print_readably ? "#[" : "#<compiled-function ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 if (!print_readably)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 Lisp_Object ann = compiled_function_annotation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 if (!NILP (ann))
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1774 write_fmt_string_lisp (printcharfun, "(from %S) ", 1, ann);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 /* COMPILED_ARGLIST = 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 print_internal (compiled_function_arglist (f), printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 /* COMPILED_INSTRUCTIONS = 1 */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1781 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 Lisp_Object instructions = compiled_function_instructions (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 NGCPRO1 (instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 if (STRINGP (instructions) && !print_readably)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 /* We don't usually want to see that junk in the bytecode. */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1789 write_fmt_string (printcharfun, "\"...(%ld)\"",
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1790 (long) string_char_length (instructions));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 print_internal (instructions, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 /* COMPILED_CONSTANTS = 2 */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1798 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 print_internal (compiled_function_constants (f), printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 /* COMPILED_STACK_DEPTH = 3 */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1802 write_fmt_string (printcharfun, " %d", compiled_function_stack_depth (f));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 /* COMPILED_DOC_STRING = 4 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 if (docp || intp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1807 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 print_internal (compiled_function_documentation (f), printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 /* COMPILED_INTERACTIVE = 5 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 if (intp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1815 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 print_internal (compiled_function_interactive (f), printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 UNGCPRO;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1821 write_c_string (printcharfun, print_readably ? "]" : ">");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 mark_compiled_function (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj);
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1829 int i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 mark_object (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 mark_object (f->arglist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 mark_object (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 mark_object (f->annotated);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 #endif
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1837 for (i = 0; i < f->args_in_array; i++)
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1838 mark_object (f->args[i]);
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1839
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 /* tail-recurse on constants */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 return f->constants;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 compiled_function_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 Lisp_Compiled_Function *f1 = XCOMPILED_FUNCTION (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 Lisp_Compiled_Function *f2 = XCOMPILED_FUNCTION (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 (f1->flags.documentationp == f2->flags.documentationp &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 f1->flags.interactivep == f2->flags.interactivep &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 f1->flags.domainp == f2->flags.domainp && /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 internal_equal (compiled_function_instructions (f1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 compiled_function_instructions (f2), depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 internal_equal (f1->constants, f2->constants, depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 internal_equal (f1->arglist, f2->arglist, depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 internal_equal (f1->doc_and_interactive,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 f2->doc_and_interactive, depth + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1861 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 compiled_function_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 return HASH3 ((f->flags.documentationp << 2) +
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 (f->flags.interactivep << 1) +
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 f->flags.domainp,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 internal_hash (f->instructions, depth + 1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 internal_hash (f->constants, depth + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1149
diff changeset
1872 static const struct memory_description compiled_function_description[] = {
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1873 { XD_INT, offsetof (Lisp_Compiled_Function, args_in_array) },
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1874 { XD_STRUCT_PTR, offsetof (Lisp_Compiled_Function, args),
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1149
diff changeset
1875 XD_INDIRECT (0, 0), &lisp_object_description },
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1876 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1877 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1878 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1879 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, doc_and_interactive) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1881 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1886 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1887 1, /*dumpable_flag*/
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1888 mark_compiled_function,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1889 print_compiled_function, 0,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1890 compiled_function_equal,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1891 compiled_function_hash,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1892 compiled_function_description,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1893 Lisp_Compiled_Function);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 Return t if OBJECT is a byte-compiled function object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 return COMPILED_FUNCTIONP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 /* compiled-function object accessor functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 compiled_function_arglist (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 return f->arglist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 compiled_function_instructions (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 if (! OPAQUEP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 return f->instructions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 /* Invert action performed by optimize_byte_code() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 Lisp_Opaque *opaque = XOPAQUE (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1923 Ibyte * const buffer =
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1924 alloca_array (Ibyte, OPAQUE_SIZE (opaque) * MAX_ICHAR_LEN);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1925 Ibyte *bp = buffer;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1927 const Opbyte * const program = (const Opbyte *) OPAQUE_DATA (opaque);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1928 const Opbyte *program_ptr = program;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1929 const Opbyte * const program_end = program_ptr + OPAQUE_SIZE (opaque);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 while (program_ptr < program_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 Opcode opcode = (Opcode) READ_UINT_1;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1934 bp += set_itext_ichar (bp, opcode);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 case Bvarref+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 case Bvarset+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 case Bvarbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 case Bcall+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 case Bunbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 case Bconstant2:
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1943 bp += set_itext_ichar (bp, READ_UINT_1);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1944 bp += set_itext_ichar (bp, READ_UINT_1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 case Bvarref+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 case Bvarset+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 case Bvarbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 case Bcall+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 case Bunbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 case BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 case BinsertN:
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1955 bp += set_itext_ichar (bp, READ_UINT_1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 int jump = READ_INT_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 Opbyte buf2[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 Opbyte *buf2p = buf2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 /* Convert back to program-relative address */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 WRITE_INT16 (jump + (program_ptr - 2 - program), buf2p);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1969 bp += set_itext_ichar (bp, buf2[0]);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1970 bp += set_itext_ichar (bp, buf2[1]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 case BRgotoifnonnilelsepop:
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1979 bp += set_itext_ichar (bp, READ_INT_1 + 127);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 return make_string (buffer, bp - buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 compiled_function_constants (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 return f->constants;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 compiled_function_stack_depth (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 return f->stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 /* The compiled_function->doc_and_interactive slot uses the minimal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 number of conses, based on compiled_function->flags; it may take
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 any of the following forms:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 domain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 (doc . interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 (doc . domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 (interactive . domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 (doc . (interactive . domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 /* Caller must check flags.interactivep first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 compiled_function_interactive (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 assert (f->flags.interactivep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 if (f->flags.documentationp && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 return XCAR (XCDR (f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 else if (f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 /* Caller need not check flags.documentationp first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 compiled_function_documentation (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 if (! f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 else if (f->flags.interactivep && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 /* Caller need not check flags.domainp first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 compiled_function_domain (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 if (! f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 else if (f->flags.documentationp && f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 return XCDR (XCDR (f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 else if (f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 compiled_function_annotation (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 return f->annotated;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 /* used only by Snarf-documentation; there must be doc already. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 set_compiled_function_documentation (Lisp_Compiled_Function *f,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 Lisp_Object new_doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 assert (f->flags.documentationp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 assert (INTP (new_doc) || STRINGP (new_doc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 if (f->flags.interactivep && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 f->doc_and_interactive = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 DEFUN ("compiled-function-arglist", Fcompiled_function_arglist, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 Return the argument list of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 return compiled_function_arglist (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 DEFUN ("compiled-function-instructions", Fcompiled_function_instructions, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 Return the byte-opcode string of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 return compiled_function_instructions (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 DEFUN ("compiled-function-constants", Fcompiled_function_constants, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 Return the constants vector of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 return compiled_function_constants (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 DEFUN ("compiled-function-stack-depth", Fcompiled_function_stack_depth, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2119 Return the maximum stack depth of the compiled-function object FUNCTION.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 return make_int (compiled_function_stack_depth (XCOMPILED_FUNCTION (function)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 DEFUN ("compiled-function-doc-string", Fcompiled_function_doc_string, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 Return the doc string of the compiled-function object FUNCTION, if available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 Functions that had their doc strings snarfed into the DOC file will have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 an integer returned instead of a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 return compiled_function_documentation (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 DEFUN ("compiled-function-interactive", Fcompiled_function_interactive, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 Return the interactive spec of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 If non-nil, the return value will be a list whose first element is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 `interactive' and whose second element is the interactive spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 return XCOMPILED_FUNCTION (function)->flags.interactivep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 ? list2 (Qinteractive,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 compiled_function_interactive (XCOMPILED_FUNCTION (function)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2154 DEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 Return the annotation of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 The annotation is a piece of information indicating where this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 compiled-function object came from. Generally this will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 a symbol naming a function; or a string naming a file, if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 compiled-function object was not defined in a function; or nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 if the compiled-function object was not created as a result of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 a `load'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 return compiled_function_annotation (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 DEFUN ("compiled-function-domain", Fcompiled_function_domain, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 Return the domain of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 This is only meaningful if I18N3 was enabled when emacs was compiled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 return XCOMPILED_FUNCTION (function)->flags.domainp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 ? compiled_function_domain (XCOMPILED_FUNCTION (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 DEFUN ("fetch-bytecode", Ffetch_bytecode, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 If the byte code for compiled function FUNCTION is lazy-loaded, fetch it now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 f = XCOMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 if (OPAQUEP (f->instructions) || STRINGP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 return function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 if (CONSP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 Lisp_Object tem = read_doc_string (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 if (!CONSP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2201 signal_error (Qinvalid_byte_code,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2202 "Invalid lazy-loaded byte code", tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 /* v18 or v19 bytecode file. Need to Ebolify. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 if (f->flags.ebolified && VECTORP (XCDR (tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 ebolify_bytecode_constants (XCDR (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 f->instructions = XCAR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 f->constants = XCDR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 return function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 abort ();
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
2211 return Qnil; /* not (usually) reached */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 DEFUN ("optimize-compiled-function", Foptimize_compiled_function, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 Convert compiled function FUNCTION into an optimized internal form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 f = XCOMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 if (OPAQUEP (f->instructions)) /* Already optimized? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 optimize_compiled_function (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 DEFUN ("byte-code", Fbyte_code, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 Function used internally in byte-compiled code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 First argument INSTRUCTIONS is a string of byte code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 Second argument CONSTANTS is a vector of constants.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 Third argument STACK-DEPTH is the maximum stack depth used in this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 If STACK-DEPTH is incorrect, Emacs may crash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 (instructions, constants, stack_depth))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 int varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 int program_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 Opbyte *program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 CHECK_STRING (instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 CHECK_VECTOR (constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 CHECK_NATNUM (stack_depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 /* Optimize the `instructions' string, just like when executing a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 regular compiled function, but don't save it for later since this is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 likely to only be executed once. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 optimize_byte_code (instructions, constants, program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 &program_length, &varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 SPECPDL_RESERVE (varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 return execute_optimized_program (program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 XINT (stack_depth),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 XVECTOR_DATA (constants));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 syms_of_bytecode (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2264 INIT_LRECORD_IMPLEMENTATION (compiled_function);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2265
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2266 DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2267 DEFSYMBOL (Qbyte_code);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2268 DEFSYMBOL_MULTIWORD_PREDICATE (Qcompiled_functionp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 DEFSUBR (Fbyte_code);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 DEFSUBR (Ffetch_bytecode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 DEFSUBR (Foptimize_compiled_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 DEFSUBR (Fcompiled_function_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 DEFSUBR (Fcompiled_function_instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 DEFSUBR (Fcompiled_function_constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 DEFSUBR (Fcompiled_function_stack_depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 DEFSUBR (Fcompiled_function_arglist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 DEFSUBR (Fcompiled_function_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 DEFSUBR (Fcompiled_function_doc_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 DEFSUBR (Fcompiled_function_domain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 DEFSUBR (Fcompiled_function_annotation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 #ifdef BYTE_CODE_METER
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2287 DEFSYMBOL (Qbyte_code_meter);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 vars_of_bytecode (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 A vector of vectors which holds a histogram of byte code usage.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 \(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 opcode CODE has been executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 indicates how many times the byte opcodes CODE1 and CODE2 have been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 executed in succession.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 If non-nil, keep profiling information on byte code usage.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 The variable `byte-code-meter' indicates how often each byte opcode is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 If a symbol has a property named `byte-code-meter' whose value is an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 integer, it is incremented each time that symbol's function is called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 byte_metering_on = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 Vbyte_code_meter = make_vector (256, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 int i = 256;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 while (i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 XVECTOR_DATA (Vbyte_code_meter)[i] = make_vector (256, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 #endif /* BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 }