mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-28 00:01:33 -08:00
Code Issues Projects Releases Wiki Activity
emacs/src/bytecode.c
Paul Eggert d311d28c3f * alloc.c (pure_bytes_used_lisp, pure_bytes_used_non_lisp): 
(allocate_vectorlike, buffer_memory_full, struct sdata, SDATA_SIZE)
(string_bytes, check_sblock, allocate_string_data):
(compact_small_strings, Fmake_bool_vector, make_string)
(make_unibyte_string, make_multibyte_string)
(make_string_from_bytes, make_specified_string)
(allocate_vectorlike, Fmake_vector, find_string_data_in_pure)
(make_pure_string, make_pure_c_string, make_pure_vector, Fpurecopy)
(mark_vectorlike):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(allocate_pseudovector):
Use int, not EMACS_INT, where int is wide enough.
(inhibit_garbage_collection, Fgarbage_collect):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* bidi.c (bidi_mirror_char): Use EMACS_INT, not int, where
int might not be wide enough.
(bidi_cache_search, bidi_cache_find, bidi_init_it)
(bidi_count_bytes, bidi_char_at_pos, bidi_fetch_char)
(bidi_at_paragraph_end, bidi_find_paragraph_start)
(bidi_paragraph_init, bidi_resolve_explicit, bidi_resolve_weak)
(bidi_level_of_next_char, bidi_move_to_visually_next):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* buffer.c (copy_overlays, Fgenerate_new_buffer_name)
(Fkill_buffer, Fset_buffer_major_mode)
(advance_to_char_boundary, Fbuffer_swap_text)
(Fset_buffer_multibyte, overlays_at, overlays_in)
(overlay_touches_p, struct sortvec, record_overlay_string)
(overlay_strings, recenter_overlay_lists)
(adjust_overlays_for_insert, adjust_overlays_for_delete)
(fix_start_end_in_overlays, fix_overlays_before, modify_overlay)
(Fmove_overlay, Fnext_overlay_change, Fprevious_overlay_change)
(Foverlay_recenter, last_overlay_modification_hooks_used)
(report_overlay_modification, evaporate_overlays, enlarge_buffer_text):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(validate_region): Omit unnecessary test for b <= e, since
that's guaranteed by the previous test.
(adjust_overlays_for_delete): Avoid pos + length overflow.
(Fmove_overlay, Fdelete_overlay, add_overlay_mod_hooklist)
(report_overlay_modification):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(Foverlays_at, Fnext_overlay_change, Fprevious_overlay_change):
Omit pointer cast, which isn't needed anyway, and doesn't work
after the EMACS_INT -> ptrdiff_t change.
* buffer.h: Adjust decls to match defn changes elsewhere.
(struct buffer_text, struct buffer):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
Use EMACS_INT, not int, where int might not be wide enough.
* bytecode.c (exec_byte_code): Use ptrdiff_t, not int, to avoid
needless 32-bit limit on 64-bit hosts.  Remove unnecessary
memory-full test.  Use EMACS_INT, not ptrdiff_t or int, where
ptrdiff_t or int might not be wide enough.
* callint.c (Fcall_interactively):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* callproc.c (call_process_kill, Fcall_process):
Don't assume pid_t fits into an Emacs fixnum.
(call_process_cleanup, Fcall_process, child_setup):
Don't assume pid_t fits into int.
(call_process_cleanup, Fcall_process, delete_temp_file)
(Fcall_process_region):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(Fcall_process): Simplify handling of volatile integers.
Use int, not EMACS_INT, where int will do.
* casefiddle.c (casify_object, casify_region, operate_on_word)
(Fupcase_word, Fdowncase_word, Fcapitalize_word):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(casify_object): Avoid integer overflow when overallocating buffer.
* casetab.c (set_identity, shuffle): Prefer int to unsigned when
either works.
* category.c (Fchar_category_set): Don't assume fixnum fits in int.
* category.h (CATEGORYP): Don't assume arg is nonnegative.
* ccl.c (GET_CCL_INT): Remove; no longer needed, since the
integers are now checked earlier.  All uses replaced with XINT.
(ccl_driver):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
For CCL_MapSingle, check that content and value are in int range.
(resolve_symbol_ccl_program): Check that vector header is in range.
Always copy the vector, so that we can check its contents reliably
now rather than having to recheck each instruction as it's being
executed.  Check that vector words fit in 'int'.
(ccl_get_compiled_code, Fregister_ccl_program)
(Fregister_code_conversion_map): Use ptrdiff_t, not int, for
program indexes, to avoid needless 32-bit limit on 64-bit hosts.
(Fccl_execute, Fccl_execute_on_string): Check that initial reg
contents are in range.
(Fccl_execute_on_string): Check that status is in range.
* ccl.h (struct ccl_program.idx): Now ptrdiff_t, not int.
* character.c (char_resolve_modifier_mask, Fchar_resolve_modifiers):
Accept and return EMACS_INT, not int, because callers can pass values
out of 'int' range.
(c_string_width, strwidth, lisp_string_width, chars_in_text)
(multibyte_chars_in_text, parse_str_as_multibyte)
(str_as_multibyte, count_size_as_multibyte, str_to_multibyte)
(str_as_unibyte, str_to_unibyte, string_count_byte8)
(string_escape_byte8, Fget_byte):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Funibyte_string): Use CHECK_CHARACTER, not CHECK_NATNUM, to
avoid mishandling large integers.
* character.h: Adjust decls to match defn changes elsewhere.
* charset.c (load_charset_map_from_file, find_charsets_in_text)
(Ffind_charset_region):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(load_charset_map_from_file): Redo idx calculation to avoid overflow.
(load_charset_map_from_vector, Fdefine_charset_internal):
Don't assume fixnum fits in int or unsigned int.
(load_charset_map_from_vector, Fmap_charset_chars):
Remove now-unnecessary CHECK_NATNUMs.
(Fdefine_charset_internal): Check ranges here, more carefully.
* chartab.c (Fmake_char_table, Fset_char_table_range)
(uniprop_get_decoder, uniprop_get_encoder):
Don't assume fixnum fits in int.
* cmds.c (move_point): New function, that does the gist of
Fforward_char and Fbackward_char, but does so while checking
for integer overflow more accurately.
(Fforward_char, Fbackward_char, internal_self_insert): Use it.
(Fforward_line, Fend_of_line, internal_self_insert)
(internal_self_insert):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
Fix a FIXME, by checking for integer overflow when calculating
target_clm and actual_clm.
* coding.c (detect_coding_XXX, encode_coding_XXX, CODING_DECODE_CHAR)
(ASSURE_DESTINATION, coding_alloc_by_realloc)
(coding_alloc_by_making_gap, alloc_destination)
(detect_coding_utf_8, encode_coding_utf_8, decode_coding_utf_16)
(encode_coding_utf_16, detect_coding_emacs_mule)
(decode_coding_emacs_mule, encode_coding_emacs_mule)
(detect_coding_iso_2022, decode_coding_iso_2022)
(encode_invocation_designation, encode_designation_at_bol)
(encode_coding_iso_2022, detect_coding_sjis, detect_coding_big5)
(decode_coding_sjis, decode_coding_big5, encode_coding_sjis)
(encode_coding_big5, detect_coding_ccl, decode_coding_ccl)
(encode_coding_ccl, encode_coding_raw_text)
(detect_coding_charset, decode_coding_charset)
(encode_coding_charset, detect_eol, decode_eol, produce_chars)
(produce_composition, produce_charset, produce_annotation)
(decode_coding, handle_composition_annotation)
(handle_charset_annotation, consume_chars, decode_coding_gap)
(decode_coding_object, encode_coding_object, detect_coding_system)
(Ffind_coding_systems_region_internal, Fcheck_coding_systems_region)
(code_convert_region, code_convert_string)
(Fdefine_coding_system_internal):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(setup_iso_safe_charsets, consume_chars, Funencodable_char_position)
(Fdefine_coding_system_internal):
Don't assume fixnums fit in int.
(decode_coding_gap, decode_coding_object, encode_coding_object)
(Fread_coding_system, Fdetect_coding_region, Funencodable_char_position)
(Fcheck_coding_systems_region):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(Ffind_operation_coding_system): NATNUMP can eval its arg twice.
(Fdefine_coding_system_internal): Check for charset-id overflow.
* coding.h: Adjust decls to match defn changes elsewhere.
(struct coding_system):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* composite.c (get_composition_id, find_composition)
(run_composition_function, update_compositions)
(compose_text, composition_gstring_put_cache)
(composition_gstring_p, composition_gstring_width)
(fill_gstring_header, fill_gstring_body, autocmp_chars)
(composition_compute_stop_pos, composition_reseat_it)
(composition_update_it, struct position_record)
(find_automatic_composition, composition_adjust_point)
(Fcomposition_get_gstring, Ffind_composition_internal):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(update_compositions):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* composite.h: Adjust decls to match defn changes elsewhere.
(struct composition):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* data.c (let_shadows_buffer_binding_p, let_shadows_global_binding_p):
Do not attempt to compute the address of the object just before a
buffer; this is not portable.
(Faref, Faset):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Faset): Use int, not EMACS_INT, where int is wide enough.
(Fstring_to_number): Don't assume fixnums fit in int.
(Frem): Don't assume arg is nonnegative.
* dbusbind.c (xd_append_arg): Check for integers out of range.
(Fdbus_call_method): Don't overflow the timeout int.
* dired.c (directory_files_internal, file_name_completion, scmp)
(file_name_completion_stat):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(file_name_completion): Don't overflow matchcount.
(file_name_completion_stat): Use SAFE_ALLOCA, not alloca.
* dispextern.h: Adjust decls to match defn changes elsewhere.
(struct text_pos, struct glyph, struct bidi_saved_info)
(struct bidi_string_data, struct bidi_it, struct composition_it)
(struct it):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(struct display_pos, struct composition_it, struct it):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* dispnew.c (increment_matrix_positions)
(increment_row_positions, mode_line_string)
(marginal_area_string):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(change_frame_size_1, Fredisplay):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(duration_to_sec_usec): New function, to check for overflow better.
(Fsleep_for, sit_for): Use it.
* doc.c (get_doc_string, store_function_docstring):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(get_doc_string, Fsnarf_documentation):
Use int, not EMACS_INT, where int is wide enough.
(get_doc_string):
Use SAFE_ALLOCA, not alloca.
Check for overflow when converting EMACS_INT to off_t.
* doprnt.c (doprnt):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* editfns.c (init_editfns, Fuser_uid, Fuser_real_uid):
Don't assume uid_t fits into fixnum.
(buildmark, Fgoto_char, overlays_around, find_field, Fdelete_field)
(Ffield_string, Ffield_string_no_properties, Ffield_beginning)
(Ffield_end, Fconstrain_to_field, Fline_beginning_position)
(Fline_end_position, Fprevious_char, Fchar_after, Fchar_before)
(general_insert_function)
(Finsert_char, make_buffer_string, make_buffer_string_both)
(update_buffer_properties, Fbuffer_substring)
(Fbuffer_substring_no_properties, Fcompare_buffer_substrings)
(Fsubst_char_in_region, check_translation)
(Ftranslate_region_internal, save_restriction_restore, Fformat)
(transpose_markers, Ftranspose_regions):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(clip_to_bounds): Move to lisp.h as an inline function).
(Fconstrain_to_field): Don't assume integers are nonnegative.
(Fline_beginning_position, Fsave_excursion, Fsave_current_buffer):
(Fsubst_char_in_region, Fsave_restriction):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(Femacs_pid): Don't assume pid_t fits into fixnum.
(lo_time): Use int, not EMACS_INT, when int suffices.
(lisp_time_argument): Check for usec out of range.
(Fencode_time): Don't assume fixnum fits in int.
* emacs.c (gdb_valbits, gdb_gctypebits): Now int, not EMACS_INT.
(gdb_data_seg_bits): Now uintptr_t, not EMACS_INT.
(PVEC_FLAG, gdb_array_mark_flag): Now ptrdiff_t, not EMACS_INT.
(init_cmdargs, Fdump_emacs):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(Fkill_emacs): Don't assume fixnum fits in int; instead, take just
the bottom (typically) 32 bits of the fixnum.
* eval.c (specpdl_size, call_debugger):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(when_entered_debugger, Fbacktrace_debug):
Don't assume fixnum can fit in int.
(Fdefvaralias, Fdefvar): Do not attempt to compute the address of
the object just before a buffer; this is not portable.
(FletX, Flet, Funwind_protect, do_autoload, Feval, funcall_lambda)
(grow_specpdl, unbind_to):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(Fapply, apply_lambda): Don't assume ptrdiff_t can hold fixnum.
(grow_specpdl): Simplify allocation by using xpalloc.
* fileio.c (Ffind_file_name_handler, Fcopy_file, Frename_file)
(Finsert_file_contents, Fwrite_region, Fdo_auto_save):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(Ffind_file_name_handler, non_regular_inserted, Finsert_file_contents)
(a_write, e_write):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Fcopy_file, non_regular_nbytes, read_non_regular)
(Finsert_file_contents):
Use int, not EMACS_INT, where int is wide enough.
(READ_BUF_SIZE): Verify that it fits in int.
(Finsert_file_contents): Check that counts are in proper range,
rather than assuming fixnums fit into ptrdiff_t etc.
Don't assume fixnums fit into int.
(Fdo_auto_save, Fset_buffer_auto_saved)
(Fclear_buffer_auto_save_failure):
Don't assume time_t is signed, or that it fits in int.
* fns.c (Fcompare_strings, Fstring_lessp, struct textprop_rec)
(concat, string_char_byte_cache_charpos, string_char_byte_cache_bytepos)
(string_char_to_byte, string_byte_to_char)
(string_make_multibyte, string_to_multibyte)
(string_make_unibyte, Fstring_as_unibyte, Fstring_as_multibyte)
(Fstring_to_unibyte, Fsubstring, Fsubstring_no_properties)
(substring_both, Fdelete, internal_equal, Ffillarray)
(Fclear_string, mapcar1)
(Fbase64_encode_region, Fbase64_encode_string, base64_encode_1)
(Fbase64_decode_region, Fbase64_decode_string, base64_decode_1)
(larger_vector, make_hash_table, maybe_resize_hash_table)
(hash_lookup, hash_remove_from_table, hash_clear, sweep_weak_table)
(Fmaphash, secure_hash):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(concat): Check for string index and length overflow.
(Fmapconcat): Don't assume fixnums fit into ptrdiff_t.
(Frequire):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(larger_vector): New API (vec, incr_min, size_max) replaces old
one (vec, new_size, init).  This catches size overflow.
INIT was removed because it was always Qnil.
All callers changed.
(INDEX_SIZE_BOUND): New macro, which calculates more precisely
the upper bound on a hash table index size.
(make_hash_table, maybe_resize_hash_table): Use it.
(secure_hash): Computer start_byte and end_byte only after
they're known to be in ptrdiff_t range.
* font.c (font_intern_prop, font_at, font_range, Ffont_shape_gstring)
(Ffont_get_glyphs, Ffont_at):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(font_style_to_value, font_prop_validate_style, font_expand_wildcards)
(Flist_fonts, Fopen_font):
Don't assume fixnum can fit in int.
(check_gstring): Don't assume index can fit in int.
(font_match_p): Check that fixnum is a character, not a nonnegative
fixnum, since the later code needs to stuff it into an int.
(font_find_for_lface): Use SAFE_ALLOCA_LISP, not alloca.
(font_fill_lglyph_metrics): Use unsigned, not EMACS_INT, to avoid
conversion overflow issues.
(Fopen_font): Check for integer out of  range.
(Ffont_get_glyphs): Don't assume index can fit in int.
* font.h: Adjust decls to match defn changes elsewhere.
* fontset.c (reorder_font_vector): Redo score calculation to avoid
integer overflow.
(num_auto_fontsets, fontset_from_font): Use ptrdiff_t, not
printmax_t, where ptrdiff_t is wide enough.
(Finternal_char_font):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* frame.c (Fset_mouse_position, Fset_mouse_pixel_position)
(Fset_frame_height, Fset_frame_width, Fset_frame_size)
(Fset_frame_position, x_set_frame_parameters)
(x_set_line_spacing, x_set_border_width)
(x_set_internal_border_width, x_set_alpha, x_figure_window_size):
Check that fixnums are in proper range for system types.
(frame_name_fnn_p, Fframe_parameter, Fmodify_frame_parameters):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Fmodify_frame_parameters): Don't assume fixnum fits in int.
Use SAFE_ALLOCA_LISP, not alloca.
* frame.h (struct frame): Use intptr_t, not EMACS_INT, where
intptr_t is wide enough.
* fringe.c (lookup_fringe_bitmap, get_logical_fringe_bitmap)
(Fdefine_fringe_bitmap): Don't assume fixnum fits in int.
(Ffringe_bitmaps_at_pos): Don't assume index fits in int.
Check for fixnum out of range.
* ftfont.c (ftfont_list): Don't assume index fits in int.
Check that fixnums are in proper range for system types.
(ftfont_shape_by_flt):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
Remove no-longer-needed lint_assume.
* gnutls.c (emacs_gnutls_write, emacs_gnutls_read):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Fgnutls_error_fatalp, Fgnutls_error_string, Fgnutls_boot):
Check that fixnums are in proper range for system types.
* gnutls.h: Adjust decls to match defn changes elsewhere.
* gtkutil.c (xg_dialog_run):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(update_frame_tool_bar):
Check that fixnums are in proper range for system types.
* image.c (parse_image_spec): Redo count calculation to avoid overflow.
(lookup_image): Check that fixnums are in proper range for system types.
* indent.c (last_known_column, last_known_column_point):
(current_column_bol_cache):
(skip_invisible, current_column, check_display_width):
(check_display_width, scan_for_column, current_column_1)
(Findent_to, Fcurrent_indentation, position_indentation)
(indented_beyond_p, Fmove_to_column, compute_motion):
(Fcompute_motion, Fvertical_motion):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(last_known_column_modified): Use EMACS_INT, not int.
(check_display_width):
(Fcompute_motion):
Check that fixnums and floats are in proper range for system types.
(compute_motion): Don't assume index or fixnum fits in int.
(compute_motion, Fcompute_motion):
Use int, not EMACS_INT, when it is wide enough.
(vmotion): Omit local var start_hpos that is always 0; that way
we don't need to worry about overflow in expressions involving it.
* indent.h: Adjust decls to match defn changes elsewhere.
(struct position):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
Use int, not EMACS_INT, where int is wide enough.
Remove unused members ovstring_chars_done and tab_offset;
all uses removed.
* insdel.c (move_gap, move_gap_both, gap_left, gap_right)
(adjust_markers_for_delete, adjust_markers_for_insert, adjust_point)
(adjust_markers_for_replace, make_gap_larger, make_gap_smaller)
(make_gap, copy_text, insert, insert_and_inherit)
(insert_before_markers, insert_before_markers_and_inherit)
(insert_1, count_combining_before, count_combining_after)
(insert_1_both, insert_from_string)
(insert_from_string_before_markers, insert_from_string_1)
(insert_from_gap, insert_from_buffer, insert_from_buffer_1)
(adjust_after_replace, adjust_after_insert, replace_range)
(replace_range_2, del_range, del_range_1, del_range_byte)
(del_range_both, del_range_2, modify_region)
(prepare_to_modify_buffer, signal_before_change)
(signal_after_change, Fcombine_after_change_execute):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* intervals.c (traverse_intervals, rotate_right, rotate_left)
(balance_an_interval, split_interval_right, split_interval_left)
(find_interval, next_interval, update_interval)
(adjust_intervals_for_insertion, delete_node, delete_interval)
(interval_deletion_adjustment, adjust_intervals_for_deletion)
(static_offset_intervals, offset_intervals)
(merge_interval_right, merge_interval_left, make_new_interval)
(graft_intervals_into_buffer, temp_set_point_both)
(temp_set_point, set_point, adjust_for_invis_intang)
(set_point_both, move_if_not_intangible, get_property_and_range)
(get_local_map, copy_intervals, copy_intervals_to_string)
(compare_string_intervals, set_intervals_multibyte_1):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* intervals.h: Adjust decls to match defn changes elsewhere.
(struct interval):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* keyboard.c (this_command_key_count, this_single_command_key_start)
(before_command_key_count, before_command_echo_length, echo_now)
(echo_length, recursive_edit_1, Frecursive_edit, Ftrack_mouse)
(command_loop_1, safe_run_hooks, read_char, timer_check_2)
(menu_item_eval_property, read_key_sequence, Fread_key_sequence)
(Fread_key_sequence_vector, Fexecute_extended_command, Fsuspend_emacs):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(last_non_minibuf_size, last_point_position, echo_truncate)
(command_loop_1, adjust_point_for_property, read_char, gen_help_event)
(make_lispy_position, make_lispy_event, parse_modifiers_uncached)
(parse_modifiers, modify_event_symbol, Fexecute_extended_command)
(stuff_buffered_input):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(last_auto_save, command_loop_1, read_char):
Use EMACS_INT, not int, to avoid integer overflow.
(record_char): Avoid overflow in total_keys computation.
(parse_modifiers_uncached): Redo index calculation to avoid overflow.
* keyboard.h: Adjust decls to match defn changes elsewhere.
* keymap.c (Fdefine_key, Fcurrent_active_maps, accessible_keymaps_1)
(Fkey_description, Fdescribe_vector, Flookup_key):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(click_position): New function, to check that positions are in range.
(Fcurrent_active_maps):
(describe_command):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Faccessible_keymaps, Fkey_description):
(preferred_sequence_p):
Don't assume fixnum can fit into int.
(Fkey_description): Use SAFE_ALLOCA_LISP, not alloca.
Check for integer overflow in size calculations.
(Ftext_char_description): Use CHECK_CHARACTER, not CHECK_NUMBER, to
avoid mishandling large integers.
* lisp.h: Adjust decls to match defn changes elsewhere.
(ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, struct Lisp_String)
(struct vectorlike_header, struct Lisp_Subr, struct Lisp_Hash_Table)
(struct Lisp_Marker):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(clip_to_bounds): Now an inline function, moved here from editfns.c.
(XSETSUBR): Use size of 0 since the actual size doesn't matter,
and using 0 avoids overflow.
(GLYPH_CODE_P): Check for overflow in system types, subsuming the
need for GLYPH_CODE_CHAR_VALID_P and doing proper checking ourselves.
All callers changed.
(GLYPH_CODE_CHAR, GLYPH_CODE_FACE):
Assume the arg has valid form, since it always does.
(TYPE_RANGED_INTEGERP): Avoid bug when checking against a wide
unsigned integer system type.
(CHECK_RANGED_INTEGER, CHECK_TYPE_RANGED_INTEGER): New macros.
(struct catchtag, specpdl_size, SPECPDL_INDEX, USE_SAFE_ALLOCA):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(struct catchtag): Use EMACS_INT, not int, since it may be a fixnum.
(duration_to_sec_usec): New decl.
* lread.c (read_from_string_index, read_from_string_index_byte)
(read_from_string_limit, readchar, unreadchar, openp)
(read_internal_start, read1, oblookup):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Fload, readevalloop, Feval_buffer, Feval_region):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(openp): Check for out-of-range argument to 'access'.
(read1): Use int, not EMACS_INT, where int is wide enough.
Don't assume fixnum fits into int.
* macros.c (Fstart_kbd_macro): Use xpalloc to check for overflow
in size calculation.
(Fexecute_kbd_macro):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* marker.c (cached_charpos, cached_bytepos, CONSIDER)
(byte_char_debug_check, buf_charpos_to_bytepos, verify_bytepos)
(buf_bytepos_to_charpos, Fset_marker, set_marker_restricted)
(set_marker_both, set_marker_restricted_both, marker_position)
(marker_byte_position, Fbuffer_has_markers_at):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Fset_marker, set_marker_restricted): Don't assume fixnum fits in int.
* menu.c (ensure_menu_items): Renamed from grow_menu_items.
It now merely ensures that the menu is large enough, without
necessarily growing it, as this avoids some integer overflow issues.
All callers changed.
(keymap_panes, parse_single_submenu, Fx_popup_menu):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(parse_single_submenu, Fx_popup_menu): Don't assume fixnum fits in int.
Use SAFE_ALLOCA_LISP, not alloca.
(find_and_return_menu_selection): Avoid unnecessary casts of pointers
to EMACS_INT.  Check that fixnums are in proper range for system types.
* minibuf.c (minibuf_prompt_width, string_to_object)
(Fminibuffer_contents, Fminibuffer_contents_no_properties)
(Fminibuffer_completion_contents, Ftry_completion, Fall_completions):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(get_minibuffer, read_minibuf_unwind):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(read_minibuf): Omit unnecessary arg BACKUP_N, which is always nil;
this simplifies overflow checking.  All callers changed.
(read_minibuf, Fread_buffer, Ftry_completion, Fall_completions)
(Ftest_completion):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* nsfns.m (check_ns_display_info): Don't assume fixnum fits in long.
(x_set_menu_bar_lines, x_set_tool_bar_lines, Fx_create_frame):
Check that fixnums are in proper range for system types.
(Fx_create_frame, Fx_show_tip):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* nsfont.m (ns_findfonts, nsfont_list_family):
Don't assume fixnum fits in long.
* nsmenu.m (ns_update_menubar, ns_menu_show, ns_popup_dialog):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(ns_update_menubar): Use intptr_t, not EMACS_INT, when intptr_t is
wide enough.
* nsselect.m (ns_get_local_selection):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* print.c (print_buffer_size, print_buffer_pos, print_buffer_pos_byte)
(PRINTDECLARE, PRINTPREPARE):
(strout, print_string):
(print, print_preprocess, print_check_string_charset_prop)
(print_object):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(PRINTDECLARE):
(temp_output_buffer_setup, Fprin1_to_string, print_object):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(PRINTPREPARE): Use int, not ptrdiff_t, where int is wide enough.
(PRINTFINISH): Use SAFE_ALLOCA, not alloca.
(printchar, strout): Use xpalloc to catch size calculation overflow.
(Fexternal_debugging_output): Use CHECK_CHARACTER, not CHECK_NUMBER,
to avoid mishandling large integers.
(print_error_message): Use SAFE_ALLOCA, not alloca.
(print_object): Use int, not EMACS_INT, where int is wide enough.
* process.c (Fdelete_process): Don't assume pid fits into EMACS_INT.
(Fset_process_window_size, Fformat_network_address)
(get_lisp_to_sockaddr_size, set_socket_option, Fmake_network_process)
(Fsignal_process, sigchld_handler):
Check that fixnums are in proper range for system types.
(Fformat_network_address, read_process_output, send_process)
(Fprocess_send_region, status_notify):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Fformat_network_address, Fmake_serial_process, Fmake_network_process)
(wait_reading_process_output, read_process_output, exec_sentinel):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(conv_lisp_to_sockaddr): Don't assume fixnums fit into int.
(Faccept_process_output): Use duration_to_sec_usec to do proper
overflow checking on durations.
* scroll.c (calculate_scrolling, calculate_direct_scrolling)
(line_ins_del): Use int, not EMACS_INT, where int is wide enough.
* search.c (looking_at_1, string_match_1):
(fast_string_match, fast_c_string_match_ignore_case)
(fast_string_match_ignore_case, fast_looking_at, scan_buffer)
(scan_newline, find_before_next_newline, search_command)
(trivial_regexp_p, search_buffer, simple_search, boyer_moore)
(set_search_regs, wordify):
(Freplace_match):
(Fmatch_data):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(string_match_1, search_buffer, set_search_regs):
(Fmatch_data):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(wordify): Check for overflow in size calculation.
(Freplace_match): Avoid potential buffer overflow in search_regs.start.
(Fset_match_data): Don't assume fixnum fits in ptrdiff_t.
Check that fixnums are in proper range for system types.
* sound.c (struct sound_device)
(wav_play, au_play, vox_write, alsa_period_size, alsa_write):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Fplay_sound_internal):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* syntax.c (ST_COMMENT_STYLE, ST_STRING_STYLE):
In definitions, make it clearer that these values must be out of range
for the respective integer ranges.  This fixes a bug with ST_STRING_STYLE
and non-ASCII characters.
(struct lisp_parse_state, find_start_modiff)
(Finternal_describe_syntax_value, scan_lists, scan_sexps_forward):
(Fparse_partial_sexp):
Don't assume fixnums can fit in int.
(struct lisp_parse_state, find_start_pos, find_start_value)
(find_start_value_byte, find_start_begv)
(update_syntax_table, char_quoted, dec_bytepos)
(find_defun_start, prev_char_comend_first, back_comment):
(scan_words, skip_chars, skip_syntaxes, forw_comment, Fforward_comment)
(scan_lists, Fbackward_prefix_chars, scan_sexps_forward):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Finternal_describe_syntax_value): Check that match_lisp is a
character, not an integer, since the code stuffs it into int.
(scan_words, scan_sexps_forward):
Check that fixnums are in proper range for system types.
(Fforward_word):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(scan_sexps_forward):
Use CHARACTERP, not INTEGERP, since the value must fit into int.
(Fparse_partial_sexp): Fix doc; element 8 is not ignored.
* syntax.h: Adjust decls to match defn changes elsewhere.
(struct gl_state_s):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* sysdep.c (wait_for_termination_1, wait_for_termination)
(interruptible_wait_for_termination, mkdir):
Don't assume pid_t fits in int; on 64-bit AIX pid_t is 64-bit.
(emacs_read, emacs_write):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(system_process_attributes): Don't assume uid_t, gid_t, and
double all fit in int or even EMACS_INT.
* term.c (set_tty_color_mode):
Check that fixnums are in proper range for system types.
* termhooks.h (struct input_event):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* textprop.c (validate_interval_range, interval_of)
(Fadd_text_properties, set_text_properties_1)
(Fremove_text_properties, Fremove_list_of_text_properties)
(Ftext_property_any, Ftext_property_not_all)
(copy_text_properties, text_property_list, extend_property_ranges)
(verify_interval_modification):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Fnext_single_char_property_change)
(Fprevious_single_char_property_change):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(copy_text_properties): Check for integer overflow in index calculation.
* undo.c (last_boundary_position, record_point, record_insert)
(record_delete, record_marker_adjustment, record_change)
(record_property_change):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(truncate_undo_list, Fprimitive_undo): Don't assume fixnum fits in int.
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* w32fns.c (Fx_create_frame, x_create_tip_frame, Fx_show_tip)
(Fx_hide_tip, Fx_file_dialog):
* w32menu.c (set_frame_menubar):
Use ptrdiff_t, not int, for consistency with rest of code.
* window.c (window_scroll_preserve_hpos, window_scroll_preserve_vpos)
(select_window, Fdelete_other_windows_internal)
(window_scroll_pixel_based, window_scroll_line_based)
(Frecenter, Fset_window_configuration):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(Fset_window_hscroll, run_window_configuration_change_hook)
(set_window_buffer, temp_output_buffer_show, scroll_command)
(Fscroll_other_window):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(Fwindow_line_height, window_scroll, Fscroll_left, Fscroll_right):
Don't assume fixnum fits in int.
(Fset_window_scroll_bars):
Check that fixnums are in proper range for system types.
* xdisp.c (help_echo_pos, pos_visible_p, string_pos_nchars_ahead)
(string_pos, c_string_pos, number_of_chars, init_iterator)
(in_ellipses_for_invisible_text_p, init_from_display_pos)
(compute_stop_pos, next_overlay_change, compute_display_string_pos)
(compute_display_string_end, handle_face_prop)
(face_before_or_after_it_pos, handle_invisible_prop, handle_display_prop)
(handle_display_spec, handle_single_display_spec)
(display_prop_intangible_p, string_buffer_position_lim)
(string_buffer_position, handle_composition_prop, load_overlay_strings)
(get_overlay_strings_1, get_overlay_strings)
(iterate_out_of_display_property, forward_to_next_line_start)
(back_to_previous_visible_line_start, reseat, reseat_to_string)
(get_next_display_element, set_iterator_to_next)
(get_visually_first_element, compute_stop_pos_backwards)
(handle_stop_backwards, next_element_from_buffer)
(move_it_in_display_line_to, move_it_in_display_line)
(move_it_to, move_it_vertically_backward, move_it_by_lines)
(add_to_log, message_dolog, message_log_check_duplicate)
(message2, message2_nolog, message3, message3_nolog
(with_echo_area_buffer, display_echo_area_1, resize_mini_window_1)
(current_message_1, truncate_echo_area, truncate_message_1)
(set_message, set_message_1, store_mode_line_noprop)
(hscroll_window_tree, debug_delta, debug_delta_bytes, debug_end_vpos)
(text_outside_line_unchanged_p, check_point_in_composition)
(reconsider_clip_changes)
(redisplay_internal, set_cursor_from_row, try_scrolling)
(try_cursor_movement, set_vertical_scroll_bar, redisplay_window)
(redisplay_window, find_last_unchanged_at_beg_row)
(find_first_unchanged_at_end_row, row_containing_pos, try_window_id)
(trailing_whitespace_p, find_row_edges, display_line)
(RECORD_MAX_MIN_POS, Fcurrent_bidi_paragraph_direction)
(display_mode_element, store_mode_line_string)
(pint2str, pint2hrstr, decode_mode_spec)
(display_count_lines, display_string, draw_glyphs)
(x_produce_glyphs, x_insert_glyphs)
(rows_from_pos_range, mouse_face_from_buffer_pos)
(fast_find_string_pos, mouse_face_from_string_pos)
(note_mode_line_or_margin_highlight, note_mouse_highlight):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(safe_call, init_from_display_pos, handle_fontified_prop)
(handle_single_display_spec, load_overlay_strings)
(with_echo_area_buffer, setup_echo_area_for_printing)
(display_echo_area, echo_area_display)
(x_consider_frame_title, prepare_menu_bars, update_menu_bar)
(update_tool_bar, hscroll_window_tree, redisplay_internal)
(redisplay_window, dump_glyph_row, display_mode_line, Fformat_mode_line)
(decode_mode_spec, on_hot_spot_p):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(handle_single_display_spec, build_desired_tool_bar_string)
(redisplay_tool_bar, scroll_window_tree, Fdump_glyph_matrix)
(get_specified_cursor_type):
Check that fixnums are in proper range for system types.
(struct overlay_entry, resize_mini_window, Fdump_glyph_row)
(Flookup_image_map):
Don't assume fixnums fit in int.
(compare_overlay_entries):
Avoid mishandling comparisons due to subtraction overflow.
(load_overlay_strings): Use SAFE_NALLOCA, not alloca.
(last_escape_glyph_face_id, last_glyphless_glyph_face_id):
(handle_tool_bar_click):
Use int, not unsigned, since we prefer signed and the signedness
doesn't matter here.
(get_next_display_element, next_element_from_display_vector):
Use int, not EMACS_INT, when int is wide enough.
(start_hourglass): Use duration_to_sec_usec to do proper
overflow checking on durations.
* xfaces.c (Fbitmap_spec_p):
Check that fixnums are in proper range for system types.
(compare_fonts_by_sort_order):
Avoid mishandling comparisons due to subtraction overflow.
(Fx_family_fonts, realize_basic_faces):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(Fx_family_fonts):
Don't assume fixnum fits in int.
Use SAFE_ALLOCA_LISP, not alloca.
(merge_face_heights): Remove unnecessary cast to EMACS_INT.
(Finternal_make_lisp_face): Don't allocate more than MAX_FACE_ID.
(face_at_buffer_position, face_for_overlay_string)
(face_at_string_position):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
(merge_faces): Use int, not EMACS_INT, where int is wide enough.
* xfns.c (x_set_menu_bar_lines, x_set_tool_bar_lines, x_icon_verify)
(Fx_show_tip):
Check that fixnums are in proper range for system types.
(Fx_create_frame, x_create_tip_frame, Fx_show_tip)
(Fx_hide_tip, Fx_file_dialog, Fx_select_font):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(Fx_change_window_property): Don't assume fixnums fit in int.
* xfont.c (xfont_chars_supported):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* xmenu.c (Fx_popup_dialog, set_frame_menubar)
(create_and_show_popup_menu, create_and_show_dialog, xmenu_show):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* xml.c (parse_region):
* xrdb.c (magic_file_p):
Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
* xselect.c (TRACE1): Don't assume pid_t promotes to int.
(x_get_local_selection, x_reply_selection_request)
(x_handle_selection_request, wait_for_property_change):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
(selection_data_to_lisp_data): Use short, not EMACS_INT, where
short is wide enough.
(x_send_client_event): Don't assume fixnum fits in int.
* xterm.c (x_x_to_emacs_modifiers):
Don't assume EMACS_INT overflows nicely into int.
(x_emacs_to_x_modifiers): Use EMACS_INT, not int, because values
may come from Lisp.
(handle_one_xevent): NATNUMP can eval its arg twice.
(x_connection_closed):
Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
* xterm.h: Adjust decls to match defn changes elsewhere.
(struct scroll_bar): Use struct vectorlike_header
rather than rolling our own approximation.
(SCROLL_BAR_VEC_SIZE): Remove; not used.
2011-09-21 10:41:20 -07:00

1873 lines
38 KiB
C
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/* Execution of byte code produced by bytecomp.el.
Copyright (C) 1985-1988, 1993, 2000-2011 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/*
hacked on by jwz@lucid.com 17-jun-91
o added a compile-time switch to turn on simple sanity checking;
o put back the obsolete byte-codes for error-detection;
o added a new instruction, unbind_all, which I will use for
tail-recursion elimination;
o made temp_output_buffer_show be called with the right number
of args;
o made the new bytecodes be called with args in the right order;
o added metering support.
by Hallvard:
o added relative jump instructions;
o all conditionals now only do QUIT if they jump.
*/
#include <config.h>
#include <setjmp.h>
#include "lisp.h"
#include "buffer.h"
#include "character.h"
#include "syntax.h"
#include "window.h"
#ifdef CHECK_FRAME_FONT
#include "frame.h"
#include "xterm.h"
#endif
/*
* define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
* debugging the byte compiler...)
*
* define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
*/
/* #define BYTE_CODE_SAFE */
/* #define BYTE_CODE_METER */
#ifdef BYTE_CODE_METER
Lisp_Object Qbyte_code_meter;
#define METER_2(code1, code2) \
XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
->contents[(code2)])
#define METER_1(code) METER_2 (0, (code))
#define METER_CODE(last_code, this_code) \
{ \
if (byte_metering_on) \
{ \
if (METER_1 (this_code) < MOST_POSITIVE_FIXNUM) \
METER_1 (this_code)++; \
if (last_code \
&& METER_2 (last_code, this_code) < MOST_POSITIVE_FIXNUM) \
METER_2 (last_code, this_code)++; \
} \
}
#endif /* BYTE_CODE_METER */
Lisp_Object Qbytecode;
/* Byte codes: */
#define Bstack_ref 0 /* Actually, Bstack_ref+0 is not implemented: use dup. */
#define Bvarref 010
#define Bvarset 020
#define Bvarbind 030
#define Bcall 040
#define Bunbind 050
#define Bnth 070
#define Bsymbolp 071
#define Bconsp 072
#define Bstringp 073
#define Blistp 074
#define Beq 075
#define Bmemq 076
#define Bnot 077
#define Bcar 0100
#define Bcdr 0101
#define Bcons 0102
#define Blist1 0103
#define Blist2 0104
#define Blist3 0105
#define Blist4 0106
#define Blength 0107
#define Baref 0110
#define Baset 0111
#define Bsymbol_value 0112
#define Bsymbol_function 0113
#define Bset 0114
#define Bfset 0115
#define Bget 0116
#define Bsubstring 0117
#define Bconcat2 0120
#define Bconcat3 0121
#define Bconcat4 0122
#define Bsub1 0123
#define Badd1 0124
#define Beqlsign 0125
#define Bgtr 0126
#define Blss 0127
#define Bleq 0130
#define Bgeq 0131
#define Bdiff 0132
#define Bnegate 0133
#define Bplus 0134
#define Bmax 0135
#define Bmin 0136
#define Bmult 0137
#define Bpoint 0140
/* Was Bmark in v17. */
#define Bsave_current_buffer 0141 /* Obsolete. */
#define Bgoto_char 0142
#define Binsert 0143
#define Bpoint_max 0144
#define Bpoint_min 0145
#define Bchar_after 0146
#define Bfollowing_char 0147
#define Bpreceding_char 0150
#define Bcurrent_column 0151
#define Bindent_to 0152
#ifdef BYTE_CODE_SAFE
#define Bscan_buffer 0153 /* No longer generated as of v18. */
#endif
#define Beolp 0154
#define Beobp 0155
#define Bbolp 0156
#define Bbobp 0157
#define Bcurrent_buffer 0160
#define Bset_buffer 0161
#define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */
#if 0
#define Bread_char 0162 /* No longer generated as of v19 */
#endif
#ifdef BYTE_CODE_SAFE
#define Bset_mark 0163 /* this loser is no longer generated as of v18 */
#endif
#define Binteractive_p 0164 /* Obsolete since Emacs-24.1. */
#define Bforward_char 0165
#define Bforward_word 0166
#define Bskip_chars_forward 0167
#define Bskip_chars_backward 0170
#define Bforward_line 0171
#define Bchar_syntax 0172
#define Bbuffer_substring 0173
#define Bdelete_region 0174
#define Bnarrow_to_region 0175
#define Bwiden 0176
#define Bend_of_line 0177
#define Bconstant2 0201
#define Bgoto 0202
#define Bgotoifnil 0203
#define Bgotoifnonnil 0204
#define Bgotoifnilelsepop 0205
#define Bgotoifnonnilelsepop 0206
#define Breturn 0207
#define Bdiscard 0210
#define Bdup 0211
#define Bsave_excursion 0212
#define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1. */
#define Bsave_restriction 0214
#define Bcatch 0215
#define Bunwind_protect 0216
#define Bcondition_case 0217
#define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1. */
#define Btemp_output_buffer_show 0221 /* Obsolete since Emacs-24.1. */
#define Bunbind_all 0222 /* Obsolete. Never used. */
#define Bset_marker 0223
#define Bmatch_beginning 0224
#define Bmatch_end 0225
#define Bupcase 0226
#define Bdowncase 0227
#define Bstringeqlsign 0230
#define Bstringlss 0231
#define Bequal 0232
#define Bnthcdr 0233
#define Belt 0234
#define Bmember 0235
#define Bassq 0236
#define Bnreverse 0237
#define Bsetcar 0240
#define Bsetcdr 0241
#define Bcar_safe 0242
#define Bcdr_safe 0243
#define Bnconc 0244
#define Bquo 0245
#define Brem 0246
#define Bnumberp 0247
#define Bintegerp 0250
#define BRgoto 0252
#define BRgotoifnil 0253
#define BRgotoifnonnil 0254
#define BRgotoifnilelsepop 0255
#define BRgotoifnonnilelsepop 0256
#define BlistN 0257
#define BconcatN 0260
#define BinsertN 0261
/* Bstack_ref is code 0. */
#define Bstack_set 0262
#define Bstack_set2 0263
#define BdiscardN 0266
#define Bconstant 0300
/* Whether to maintain a `top' and `bottom' field in the stack frame. */
#define BYTE_MAINTAIN_TOP (BYTE_CODE_SAFE || BYTE_MARK_STACK)
/* Structure describing a value stack used during byte-code execution
in Fbyte_code. */
struct byte_stack
{
/* Program counter. This points into the byte_string below
and is relocated when that string is relocated. */
const unsigned char *pc;
/* Top and bottom of stack. The bottom points to an area of memory
allocated with alloca in Fbyte_code. */
#if BYTE_MAINTAIN_TOP
Lisp_Object *top, *bottom;
#endif
/* The string containing the byte-code, and its current address.
Storing this here protects it from GC because mark_byte_stack
marks it. */
Lisp_Object byte_string;
const unsigned char *byte_string_start;
/* The vector of constants used during byte-code execution. Storing
this here protects it from GC because mark_byte_stack marks it. */
Lisp_Object constants;
/* Next entry in byte_stack_list. */
struct byte_stack *next;
};
/* A list of currently active byte-code execution value stacks.
Fbyte_code adds an entry to the head of this list before it starts
processing byte-code, and it removed the entry again when it is
done. Signalling an error truncates the list analoguous to
gcprolist. */
struct byte_stack *byte_stack_list;
/* Mark objects on byte_stack_list. Called during GC. */
#if BYTE_MARK_STACK
void
mark_byte_stack (void)
{
struct byte_stack *stack;
Lisp_Object *obj;
for (stack = byte_stack_list; stack; stack = stack->next)
{
/* If STACK->top is null here, this means there's an opcode in
Fbyte_code that wasn't expected to GC, but did. To find out
which opcode this is, record the value of `stack', and walk
up the stack in a debugger, stopping in frames of Fbyte_code.
The culprit is found in the frame of Fbyte_code where the
address of its local variable `stack' is equal to the
recorded value of `stack' here. */
eassert (stack->top);
for (obj = stack->bottom; obj <= stack->top; ++obj)
mark_object (*obj);
mark_object (stack->byte_string);
mark_object (stack->constants);
}
}
#endif
/* Unmark objects in the stacks on byte_stack_list. Relocate program
counters. Called when GC has completed. */
void
unmark_byte_stack (void)
{
struct byte_stack *stack;
for (stack = byte_stack_list; stack; stack = stack->next)
{
if (stack->byte_string_start != SDATA (stack->byte_string))
{
int offset = stack->pc - stack->byte_string_start;
stack->byte_string_start = SDATA (stack->byte_string);
stack->pc = stack->byte_string_start + offset;
}
}
}
/* Fetch the next byte from the bytecode stream */
#define FETCH *stack.pc++
/* Fetch two bytes from the bytecode stream and make a 16-bit number
out of them */
#define FETCH2 (op = FETCH, op + (FETCH << 8))
/* Push x onto the execution stack. This used to be #define PUSH(x)
(*++stackp = (x)) This oddity is necessary because Alliant can't be
bothered to compile the preincrement operator properly, as of 4/91.
-JimB */
#define PUSH(x) (top++, *top = (x))
/* Pop a value off the execution stack. */
#define POP (*top--)
/* Discard n values from the execution stack. */
#define DISCARD(n) (top -= (n))
/* Get the value which is at the top of the execution stack, but don't
pop it. */
#define TOP (*top)
/* Actions that must be performed before and after calling a function
that might GC. */
#if !BYTE_MAINTAIN_TOP
#define BEFORE_POTENTIAL_GC() ((void)0)
#define AFTER_POTENTIAL_GC() ((void)0)
#else
#define BEFORE_POTENTIAL_GC() stack.top = top
#define AFTER_POTENTIAL_GC() stack.top = NULL
#endif
/* Garbage collect if we have consed enough since the last time.
We do this at every branch, to avoid loops that never GC. */
#define MAYBE_GC() \
do { \
if (consing_since_gc > gc_cons_threshold \
&& consing_since_gc > gc_relative_threshold) \
{ \
BEFORE_POTENTIAL_GC (); \
Fgarbage_collect (); \
AFTER_POTENTIAL_GC (); \
} \
} while (0)
/* Check for jumping out of range. */
#ifdef BYTE_CODE_SAFE
#define CHECK_RANGE(ARG) \
if (ARG >= bytestr_length) abort ()
#else /* not BYTE_CODE_SAFE */
#define CHECK_RANGE(ARG)
#endif /* not BYTE_CODE_SAFE */
/* A version of the QUIT macro which makes sure that the stack top is
set before signaling `quit'. */
#define BYTE_CODE_QUIT \
do { \
if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
{ \
Lisp_Object flag = Vquit_flag; \
Vquit_flag = Qnil; \
BEFORE_POTENTIAL_GC (); \
if (EQ (Vthrow_on_input, flag)) \
Fthrow (Vthrow_on_input, Qt); \
Fsignal (Qquit, Qnil); \
AFTER_POTENTIAL_GC (); \
} \
ELSE_PENDING_SIGNALS \
} while (0)
DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
doc: /* Function used internally in byte-compiled code.
The first argument, BYTESTR, is a string of byte code;
the second, VECTOR, a vector of constants;
the third, MAXDEPTH, the maximum stack depth used in this function.
If the third argument is incorrect, Emacs may crash. */)
(Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
{
return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
}
/* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and
MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect,
emacs may crash!). If ARGS_TEMPLATE is non-nil, it should be a lisp
argument list (including &rest, &optional, etc.), and ARGS, of size
NARGS, should be a vector of the actual arguments. The arguments in
ARGS are pushed on the stack according to ARGS_TEMPLATE before
executing BYTESTR. */
Lisp_Object
exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t count = SPECPDL_INDEX ();
#ifdef BYTE_CODE_METER
int this_op = 0;
int prev_op;
#endif
int op;
/* Lisp_Object v1, v2; */
Lisp_Object *vectorp;
#ifdef BYTE_CODE_SAFE
ptrdiff_t const_length;
Lisp_Object *stacke;
int bytestr_length;
#endif
struct byte_stack stack;
Lisp_Object *top;
Lisp_Object result;
#if 0 /* CHECK_FRAME_FONT */
{
struct frame *f = SELECTED_FRAME ();
if (FRAME_X_P (f)
&& FRAME_FONT (f)->direction != 0
&& FRAME_FONT (f)->direction != 1)
abort ();
}
#endif
CHECK_STRING (bytestr);
CHECK_VECTOR (vector);
CHECK_NATNUM (maxdepth);
#ifdef BYTE_CODE_SAFE
const_length = ASIZE (vector);
#endif
if (STRING_MULTIBYTE (bytestr))
/* BYTESTR must have been produced by Emacs 20.2 or the earlier
because they produced a raw 8-bit string for byte-code and now
such a byte-code string is loaded as multibyte while raw 8-bit
characters converted to multibyte form. Thus, now we must
convert them back to the originally intended unibyte form. */
bytestr = Fstring_as_unibyte (bytestr);
#ifdef BYTE_CODE_SAFE
bytestr_length = SBYTES (bytestr);
#endif
vectorp = XVECTOR (vector)->contents;
stack.byte_string = bytestr;
stack.pc = stack.byte_string_start = SDATA (bytestr);
stack.constants = vector;
top = (Lisp_Object *) alloca (XFASTINT (maxdepth)
* sizeof (Lisp_Object));
#if BYTE_MAINTAIN_TOP
stack.bottom = top;
stack.top = NULL;
#endif
top -= 1;
stack.next = byte_stack_list;
byte_stack_list = &stack;
#ifdef BYTE_CODE_SAFE
stacke = stack.bottom - 1 + XFASTINT (maxdepth);
#endif
if (INTEGERP (args_template))
{
EMACS_INT at = XINT (args_template);
int rest = at & 128;
int mandatory = at & 127;
EMACS_INT nonrest = at >> 8;
eassert (mandatory <= nonrest);
if (nargs <= nonrest)
{
EMACS_INT i;
for (i = 0 ; i < nargs; i++, args++)
PUSH (*args);
if (nargs < mandatory)
/* Too few arguments. */
Fsignal (Qwrong_number_of_arguments,
Fcons (Fcons (make_number (mandatory),
rest ? Qand_rest : make_number (nonrest)),
Fcons (make_number (nargs), Qnil)));
else
{
for (; i < nonrest; i++)
PUSH (Qnil);
if (rest)
PUSH (Qnil);
}
}
else if (rest)
{
ptrdiff_t i;
for (i = 0 ; i < nonrest; i++, args++)
PUSH (*args);
PUSH (Flist (nargs - nonrest, args));
}
else
/* Too many arguments. */
Fsignal (Qwrong_number_of_arguments,
Fcons (Fcons (make_number (mandatory),
make_number (nonrest)),
Fcons (make_number (nargs), Qnil)));
}
else if (! NILP (args_template))
/* We should push some arguments on the stack. */
{
error ("Unknown args template!");
}
while (1)
{
#ifdef BYTE_CODE_SAFE
if (top > stacke)
abort ();
else if (top < stack.bottom - 1)
abort ();
#endif
#ifdef BYTE_CODE_METER
prev_op = this_op;
this_op = op = FETCH;
METER_CODE (prev_op, op);
#else
op = FETCH;
#endif
switch (op)
{
case Bvarref + 7:
op = FETCH2;
goto varref;
case Bvarref:
case Bvarref + 1:
case Bvarref + 2:
case Bvarref + 3:
case Bvarref + 4:
case Bvarref + 5:
op = op - Bvarref;
goto varref;
/* This seems to be the most frequently executed byte-code
among the Bvarref's, so avoid a goto here. */
case Bvarref+6:
op = FETCH;
varref:
{
Lisp_Object v1, v2;
v1 = vectorp[op];
if (SYMBOLP (v1))
{
if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
|| (v2 = SYMBOL_VAL (XSYMBOL (v1)),
EQ (v2, Qunbound)))
{
BEFORE_POTENTIAL_GC ();
v2 = Fsymbol_value (v1);
AFTER_POTENTIAL_GC ();
}
}
else
{
BEFORE_POTENTIAL_GC ();
v2 = Fsymbol_value (v1);
AFTER_POTENTIAL_GC ();
}
PUSH (v2);
break;
}
case Bgotoifnil:
{
Lisp_Object v1;
MAYBE_GC ();
op = FETCH2;
v1 = POP;
if (NILP (v1))
{
BYTE_CODE_QUIT;
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
}
break;
}
case Bcar:
{
Lisp_Object v1;
v1 = TOP;
if (CONSP (v1))
TOP = XCAR (v1);
else if (NILP (v1))
TOP = Qnil;
else
{
BEFORE_POTENTIAL_GC ();
wrong_type_argument (Qlistp, v1);
AFTER_POTENTIAL_GC ();
}
break;
}
case Beq:
{
Lisp_Object v1;
v1 = POP;
TOP = EQ (v1, TOP) ? Qt : Qnil;
break;
}
case Bmemq:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fmemq (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bcdr:
{
Lisp_Object v1;
v1 = TOP;
if (CONSP (v1))
TOP = XCDR (v1);
else if (NILP (v1))
TOP = Qnil;
else
{
BEFORE_POTENTIAL_GC ();
wrong_type_argument (Qlistp, v1);
AFTER_POTENTIAL_GC ();
}
break;
break;
}
case Bvarset:
case Bvarset+1:
case Bvarset+2:
case Bvarset+3:
case Bvarset+4:
case Bvarset+5:
op -= Bvarset;
goto varset;
case Bvarset+7:
op = FETCH2;
goto varset;
case Bvarset+6:
op = FETCH;
varset:
{
Lisp_Object sym, val;
sym = vectorp[op];
val = TOP;
/* Inline the most common case. */
if (SYMBOLP (sym)
&& !EQ (val, Qunbound)
&& !XSYMBOL (sym)->redirect
&& !SYMBOL_CONSTANT_P (sym))
XSYMBOL (sym)->val.value = val;
else
{
BEFORE_POTENTIAL_GC ();
set_internal (sym, val, Qnil, 0);
AFTER_POTENTIAL_GC ();
}
}
(void) POP;
break;
case Bdup:
{
Lisp_Object v1;
v1 = TOP;
PUSH (v1);
break;
}
/* ------------------ */
case Bvarbind+6:
op = FETCH;
goto varbind;
case Bvarbind+7:
op = FETCH2;
goto varbind;
case Bvarbind:
case Bvarbind+1:
case Bvarbind+2:
case Bvarbind+3:
case Bvarbind+4:
case Bvarbind+5:
op -= Bvarbind;
varbind:
/* Specbind can signal and thus GC. */
BEFORE_POTENTIAL_GC ();
specbind (vectorp[op], POP);
AFTER_POTENTIAL_GC ();
break;
case Bcall+6:
op = FETCH;
goto docall;
case Bcall+7:
op = FETCH2;
goto docall;
case Bcall:
case Bcall+1:
case Bcall+2:
case Bcall+3:
case Bcall+4:
case Bcall+5:
op -= Bcall;
docall:
{
BEFORE_POTENTIAL_GC ();
DISCARD (op);
#ifdef BYTE_CODE_METER
if (byte_metering_on && SYMBOLP (TOP))
{
Lisp_Object v1, v2;
v1 = TOP;
v2 = Fget (v1, Qbyte_code_meter);
if (INTEGERP (v2)
&& XINT (v2) < MOST_POSITIVE_FIXNUM)
{
XSETINT (v2, XINT (v2) + 1);
Fput (v1, Qbyte_code_meter, v2);
}
}
#endif
TOP = Ffuncall (op + 1, &TOP);
AFTER_POTENTIAL_GC ();
break;
}
case Bunbind+6:
op = FETCH;
goto dounbind;
case Bunbind+7:
op = FETCH2;
goto dounbind;
case Bunbind:
case Bunbind+1:
case Bunbind+2:
case Bunbind+3:
case Bunbind+4:
case Bunbind+5:
op -= Bunbind;
dounbind:
BEFORE_POTENTIAL_GC ();
unbind_to (SPECPDL_INDEX () - op, Qnil);
AFTER_POTENTIAL_GC ();
break;
case Bunbind_all: /* Obsolete. Never used. */
/* To unbind back to the beginning of this frame. Not used yet,
but will be needed for tail-recursion elimination. */
BEFORE_POTENTIAL_GC ();
unbind_to (count, Qnil);
AFTER_POTENTIAL_GC ();
break;
case Bgoto:
MAYBE_GC ();
BYTE_CODE_QUIT;
op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
break;
case Bgotoifnonnil:
{
Lisp_Object v1;
MAYBE_GC ();
op = FETCH2;
v1 = POP;
if (!NILP (v1))
{
BYTE_CODE_QUIT;
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
}
break;
}
case Bgotoifnilelsepop:
MAYBE_GC ();
op = FETCH2;
if (NILP (TOP))
{
BYTE_CODE_QUIT;
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
}
else DISCARD (1);
break;
case Bgotoifnonnilelsepop:
MAYBE_GC ();
op = FETCH2;
if (!NILP (TOP))
{
BYTE_CODE_QUIT;
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
}
else DISCARD (1);
break;
case BRgoto:
MAYBE_GC ();
BYTE_CODE_QUIT;
stack.pc += (int) *stack.pc - 127;
break;
case BRgotoifnil:
{
Lisp_Object v1;
MAYBE_GC ();
v1 = POP;
if (NILP (v1))
{
BYTE_CODE_QUIT;
stack.pc += (int) *stack.pc - 128;
}
stack.pc++;
break;
}
case BRgotoifnonnil:
{
Lisp_Object v1;
MAYBE_GC ();
v1 = POP;
if (!NILP (v1))
{
BYTE_CODE_QUIT;
stack.pc += (int) *stack.pc - 128;
}
stack.pc++;
break;
}
case BRgotoifnilelsepop:
MAYBE_GC ();
op = *stack.pc++;
if (NILP (TOP))
{
BYTE_CODE_QUIT;
stack.pc += op - 128;
}
else DISCARD (1);
break;
case BRgotoifnonnilelsepop:
MAYBE_GC ();
op = *stack.pc++;
if (!NILP (TOP))
{
BYTE_CODE_QUIT;
stack.pc += op - 128;
}
else DISCARD (1);
break;
case Breturn:
result = POP;
goto exit;
case Bdiscard:
DISCARD (1);
break;
case Bconstant2:
PUSH (vectorp[FETCH2]);
break;
case Bsave_excursion:
record_unwind_protect (save_excursion_restore,
save_excursion_save ());
break;
case Bsave_current_buffer: /* Obsolete since ??. */
case Bsave_current_buffer_1:
record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
break;
case Bsave_window_excursion: /* Obsolete since 24.1. */
{
register ptrdiff_t count1 = SPECPDL_INDEX ();
record_unwind_protect (Fset_window_configuration,
Fcurrent_window_configuration (Qnil));
BEFORE_POTENTIAL_GC ();
TOP = Fprogn (TOP);
unbind_to (count1, TOP);
AFTER_POTENTIAL_GC ();
break;
}
case Bsave_restriction:
record_unwind_protect (save_restriction_restore,
save_restriction_save ());
break;
case Bcatch: /* FIXME: ill-suited for lexbind. */
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = internal_catch (TOP, eval_sub, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bunwind_protect: /* FIXME: avoid closure for lexbind. */
record_unwind_protect (Fprogn, POP);
break;
case Bcondition_case: /* FIXME: ill-suited for lexbind. */
{
Lisp_Object handlers, body;
handlers = POP;
body = POP;
BEFORE_POTENTIAL_GC ();
TOP = internal_lisp_condition_case (TOP, body, handlers);
AFTER_POTENTIAL_GC ();
break;
}
case Btemp_output_buffer_setup: /* Obsolete since 24.1. */
BEFORE_POTENTIAL_GC ();
CHECK_STRING (TOP);
temp_output_buffer_setup (SSDATA (TOP));
AFTER_POTENTIAL_GC ();
TOP = Vstandard_output;
break;
case Btemp_output_buffer_show: /* Obsolete since 24.1. */
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
temp_output_buffer_show (TOP);
TOP = v1;
/* pop binding of standard-output */
unbind_to (SPECPDL_INDEX () - 1, Qnil);
AFTER_POTENTIAL_GC ();
break;
}
case Bnth:
{
Lisp_Object v1, v2;
EMACS_INT n;
BEFORE_POTENTIAL_GC ();
v1 = POP;
v2 = TOP;
CHECK_NUMBER (v2);
n = XINT (v2);
immediate_quit = 1;
while (--n >= 0 && CONSP (v1))
v1 = XCDR (v1);
immediate_quit = 0;
TOP = CAR (v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bsymbolp:
TOP = SYMBOLP (TOP) ? Qt : Qnil;
break;
case Bconsp:
TOP = CONSP (TOP) ? Qt : Qnil;
break;
case Bstringp:
TOP = STRINGP (TOP) ? Qt : Qnil;
break;
case Blistp:
TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
break;
case Bnot:
TOP = NILP (TOP) ? Qt : Qnil;
break;
case Bcons:
{
Lisp_Object v1;
v1 = POP;
TOP = Fcons (TOP, v1);
break;
}
case Blist1:
TOP = Fcons (TOP, Qnil);
break;
case Blist2:
{
Lisp_Object v1;
v1 = POP;
TOP = Fcons (TOP, Fcons (v1, Qnil));
break;
}
case Blist3:
DISCARD (2);
TOP = Flist (3, &TOP);
break;
case Blist4:
DISCARD (3);
TOP = Flist (4, &TOP);
break;
case BlistN:
op = FETCH;
DISCARD (op - 1);
TOP = Flist (op, &TOP);
break;
case Blength:
BEFORE_POTENTIAL_GC ();
TOP = Flength (TOP);
AFTER_POTENTIAL_GC ();
break;
case Baref:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Faref (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Baset:
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
v2 = POP; v1 = POP;
TOP = Faset (TOP, v1, v2);
AFTER_POTENTIAL_GC ();
break;
}
case Bsymbol_value:
BEFORE_POTENTIAL_GC ();
TOP = Fsymbol_value (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bsymbol_function:
BEFORE_POTENTIAL_GC ();
TOP = Fsymbol_function (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bset:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fset (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bfset:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Ffset (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bget:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fget (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bsubstring:
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
v2 = POP; v1 = POP;
TOP = Fsubstring (TOP, v1, v2);
AFTER_POTENTIAL_GC ();
break;
}
case Bconcat2:
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fconcat (2, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Bconcat3:
BEFORE_POTENTIAL_GC ();
DISCARD (2);
TOP = Fconcat (3, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Bconcat4:
BEFORE_POTENTIAL_GC ();
DISCARD (3);
TOP = Fconcat (4, &TOP);
AFTER_POTENTIAL_GC ();
break;
case BconcatN:
op = FETCH;
BEFORE_POTENTIAL_GC ();
DISCARD (op - 1);
TOP = Fconcat (op, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Bsub1:
{
Lisp_Object v1;
v1 = TOP;
if (INTEGERP (v1))
{
XSETINT (v1, XINT (v1) - 1);
TOP = v1;
}
else
{
BEFORE_POTENTIAL_GC ();
TOP = Fsub1 (v1);
AFTER_POTENTIAL_GC ();
}
break;
}
case Badd1:
{
Lisp_Object v1;
v1 = TOP;
if (INTEGERP (v1))
{
XSETINT (v1, XINT (v1) + 1);
TOP = v1;
}
else
{
BEFORE_POTENTIAL_GC ();
TOP = Fadd1 (v1);
AFTER_POTENTIAL_GC ();
}
break;
}
case Beqlsign:
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
v2 = POP; v1 = TOP;
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
AFTER_POTENTIAL_GC ();
if (FLOATP (v1) || FLOATP (v2))
{
double f1, f2;
f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
TOP = (f1 == f2 ? Qt : Qnil);
}
else
TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
break;
}
case Bgtr:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fgtr (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Blss:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Flss (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bleq:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fleq (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bgeq:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fgeq (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bdiff:
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fminus (2, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Bnegate:
{
Lisp_Object v1;
v1 = TOP;
if (INTEGERP (v1))
{
XSETINT (v1, - XINT (v1));
TOP = v1;
}
else
{
BEFORE_POTENTIAL_GC ();
TOP = Fminus (1, &TOP);
AFTER_POTENTIAL_GC ();
}
break;
}
case Bplus:
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fplus (2, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Bmax:
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fmax (2, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Bmin:
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fmin (2, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Bmult:
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Ftimes (2, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Bquo:
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fquo (2, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Brem:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Frem (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bpoint:
{
Lisp_Object v1;
XSETFASTINT (v1, PT);
PUSH (v1);
break;
}
case Bgoto_char:
BEFORE_POTENTIAL_GC ();
TOP = Fgoto_char (TOP);
AFTER_POTENTIAL_GC ();
break;
case Binsert:
BEFORE_POTENTIAL_GC ();
TOP = Finsert (1, &TOP);
AFTER_POTENTIAL_GC ();
break;
case BinsertN:
op = FETCH;
BEFORE_POTENTIAL_GC ();
DISCARD (op - 1);
TOP = Finsert (op, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Bpoint_max:
{
Lisp_Object v1;
XSETFASTINT (v1, ZV);
PUSH (v1);
break;
}
case Bpoint_min:
{
Lisp_Object v1;
XSETFASTINT (v1, BEGV);
PUSH (v1);
break;
}
case Bchar_after:
BEFORE_POTENTIAL_GC ();
TOP = Fchar_after (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bfollowing_char:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = Ffollowing_char ();
AFTER_POTENTIAL_GC ();
PUSH (v1);
break;
}
case Bpreceding_char:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = Fprevious_char ();
AFTER_POTENTIAL_GC ();
PUSH (v1);
break;
}
case Bcurrent_column:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
XSETFASTINT (v1, current_column ());
AFTER_POTENTIAL_GC ();
PUSH (v1);
break;
}
case Bindent_to:
BEFORE_POTENTIAL_GC ();
TOP = Findent_to (TOP, Qnil);
AFTER_POTENTIAL_GC ();
break;
case Beolp:
PUSH (Feolp ());
break;
case Beobp:
PUSH (Feobp ());
break;
case Bbolp:
PUSH (Fbolp ());
break;
case Bbobp:
PUSH (Fbobp ());
break;
case Bcurrent_buffer:
PUSH (Fcurrent_buffer ());
break;
case Bset_buffer:
BEFORE_POTENTIAL_GC ();
TOP = Fset_buffer (TOP);
AFTER_POTENTIAL_GC ();
break;
case Binteractive_p: /* Obsolete since 24.1. */
PUSH (Finteractive_p ());
break;
case Bforward_char:
BEFORE_POTENTIAL_GC ();
TOP = Fforward_char (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bforward_word:
BEFORE_POTENTIAL_GC ();
TOP = Fforward_word (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bskip_chars_forward:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fskip_chars_forward (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bskip_chars_backward:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fskip_chars_backward (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bforward_line:
BEFORE_POTENTIAL_GC ();
TOP = Fforward_line (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bchar_syntax:
{
int c;
BEFORE_POTENTIAL_GC ();
CHECK_CHARACTER (TOP);
AFTER_POTENTIAL_GC ();
c = XFASTINT (TOP);
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
MAKE_CHAR_MULTIBYTE (c);
XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]);
}
break;
case Bbuffer_substring:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fbuffer_substring (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bdelete_region:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fdelete_region (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bnarrow_to_region:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fnarrow_to_region (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bwiden:
BEFORE_POTENTIAL_GC ();
PUSH (Fwiden ());
AFTER_POTENTIAL_GC ();
break;
case Bend_of_line:
BEFORE_POTENTIAL_GC ();
TOP = Fend_of_line (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bset_marker:
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
v1 = POP;
v2 = POP;
TOP = Fset_marker (TOP, v2, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bmatch_beginning:
BEFORE_POTENTIAL_GC ();
TOP = Fmatch_beginning (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bmatch_end:
BEFORE_POTENTIAL_GC ();
TOP = Fmatch_end (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bupcase:
BEFORE_POTENTIAL_GC ();
TOP = Fupcase (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bdowncase:
BEFORE_POTENTIAL_GC ();
TOP = Fdowncase (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bstringeqlsign:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fstring_equal (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bstringlss:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fstring_lessp (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bequal:
{
Lisp_Object v1;
v1 = POP;
TOP = Fequal (TOP, v1);
break;
}
case Bnthcdr:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fnthcdr (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Belt:
{
Lisp_Object v1, v2;
if (CONSP (TOP))
{
/* Exchange args and then do nth. */
EMACS_INT n;
BEFORE_POTENTIAL_GC ();
v2 = POP;
v1 = TOP;
CHECK_NUMBER (v2);
AFTER_POTENTIAL_GC ();
n = XINT (v2);
immediate_quit = 1;
while (--n >= 0 && CONSP (v1))
v1 = XCDR (v1);
immediate_quit = 0;
TOP = CAR (v1);
}
else
{
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Felt (TOP, v1);
AFTER_POTENTIAL_GC ();
}
break;
}
case Bmember:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fmember (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bassq:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fassq (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bnreverse:
BEFORE_POTENTIAL_GC ();
TOP = Fnreverse (TOP);
AFTER_POTENTIAL_GC ();
break;
case Bsetcar:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fsetcar (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bsetcdr:
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fsetcdr (TOP, v1);
AFTER_POTENTIAL_GC ();
break;
}
case Bcar_safe:
{
Lisp_Object v1;
v1 = TOP;
TOP = CAR_SAFE (v1);
break;
}
case Bcdr_safe:
{
Lisp_Object v1;
v1 = TOP;
TOP = CDR_SAFE (v1);
break;
}
case Bnconc:
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fnconc (2, &TOP);
AFTER_POTENTIAL_GC ();
break;
case Bnumberp:
TOP = (NUMBERP (TOP) ? Qt : Qnil);
break;
case Bintegerp:
TOP = INTEGERP (TOP) ? Qt : Qnil;
break;
#ifdef BYTE_CODE_SAFE
case Bset_mark:
BEFORE_POTENTIAL_GC ();
error ("set-mark is an obsolete bytecode");
AFTER_POTENTIAL_GC ();
break;
case Bscan_buffer:
BEFORE_POTENTIAL_GC ();
error ("scan-buffer is an obsolete bytecode");
AFTER_POTENTIAL_GC ();
break;
#endif
case 0:
/* Actually this is Bstack_ref with offset 0, but we use Bdup
for that instead. */
/* case Bstack_ref: */
abort ();
/* Handy byte-codes for lexical binding. */
case Bstack_ref+1:
case Bstack_ref+2:
case Bstack_ref+3:
case Bstack_ref+4:
case Bstack_ref+5:
{
Lisp_Object *ptr = top - (op - Bstack_ref);
PUSH (*ptr);
break;
}
case Bstack_ref+6:
{
Lisp_Object *ptr = top - (FETCH);
PUSH (*ptr);
break;
}
case Bstack_ref+7:
{
Lisp_Object *ptr = top - (FETCH2);
PUSH (*ptr);
break;
}
case Bstack_set:
/* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
{
Lisp_Object *ptr = top - (FETCH);
*ptr = POP;
break;
}
case Bstack_set2:
{
Lisp_Object *ptr = top - (FETCH2);
*ptr = POP;
break;
}
case BdiscardN:
op = FETCH;
if (op & 0x80)
{
op &= 0x7F;
top[-op] = TOP;
}
DISCARD (op);
break;
case 255:
default:
#ifdef BYTE_CODE_SAFE
if (op < Bconstant)
{
abort ();
}
if ((op -= Bconstant) >= const_length)
{
abort ();
}
PUSH (vectorp[op]);
#else
PUSH (vectorp[op - Bconstant]);
#endif
}
}
exit:
byte_stack_list = byte_stack_list->next;
/* Binds and unbinds are supposed to be compiled balanced. */
if (SPECPDL_INDEX () != count)
#ifdef BYTE_CODE_SAFE
error ("binding stack not balanced (serious byte compiler bug)");
#else
abort ();
#endif
return result;
}
void
syms_of_bytecode (void)
{
DEFSYM (Qbytecode, "byte-code");
defsubr (&Sbyte_code);
#ifdef BYTE_CODE_METER
DEFVAR_LISP ("byte-code-meter", Vbyte_code_meter,
doc: /* A vector of vectors which holds a histogram of byte-code usage.
\(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
opcode CODE has been executed.
\(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
indicates how many times the byte opcodes CODE1 and CODE2 have been
executed in succession. */);
DEFVAR_BOOL ("byte-metering-on", byte_metering_on,
doc: /* If non-nil, keep profiling information on byte code usage.
The variable byte-code-meter indicates how often each byte opcode is used.
If a symbol has a property named `byte-code-meter' whose value is an
integer, it is incremented each time that symbol's function is called. */);
byte_metering_on = 0;
Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
DEFSYM (Qbyte_code_meter, "byte-code-meter");
{
int i = 256;
while (i--)
XVECTOR (Vbyte_code_meter)->contents[i] =
Fmake_vector (make_number (256), make_number (0));
}
#endif
}
Reference in a new issue View git blame Copy permalink