From b9598260f96ddc652cd82ab64bbe922ccfc48a29 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 13 Jun 2010 16:36:17 -0400 Subject: New branch for lexbind, losing all history. This initial patch is based on 2002-06-27T22:39:10Z!storm@cua.dk of the original lexbind branch. --- src/alloc.c | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 69 insertions(+), 7 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index e0f07cc5f5a..a23c688043c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3042,6 +3042,39 @@ See also the function `vector'. */) } +/* Return a new `function vector' containing KIND as the first element, + followed by NUM_NIL_SLOTS nil elements, and further elements copied from + the vector PARAMS of length NUM_PARAMS (so the total length of the + resulting vector is 1 + NUM_NIL_SLOTS + NUM_PARAMS). + + If NUM_PARAMS is zero, then PARAMS may be NULL. + + A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp. + See the function `funvec' for more detail. */ + +Lisp_Object +make_funvec (kind, num_nil_slots, num_params, params) + Lisp_Object kind; + int num_nil_slots, num_params; + Lisp_Object *params; +{ + int param_index; + Lisp_Object funvec; + + funvec = Fmake_vector (make_number (1 + num_nil_slots + num_params), Qnil); + + ASET (funvec, 0, kind); + + for (param_index = 0; param_index < num_params; param_index++) + ASET (funvec, 1 + num_nil_slots + param_index, params[param_index]); + + XSETPVECTYPE (XVECTOR (funvec), PVEC_FUNVEC); + XSETFUNVEC (funvec, XVECTOR (funvec)); + + return funvec; +} + + DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. @@ -3063,6 +3096,29 @@ usage: (vector &rest OBJECTS) */) } +DEFUN ("funvec", Ffunvec, Sfunvec, 1, MANY, 0, + doc: /* Return a newly created `function vector' of type KIND. +A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp. +KIND indicates the kind of funvec, and determines its behavior when called. +The meaning of the remaining arguments depends on KIND. Currently +implemented values of KIND, and their meaning, are: + + A list -- A byte-compiled function. See `make-byte-code' for the usual + way to create byte-compiled functions. + + `curry' -- A curried function. Remaining arguments are a function to + call, and arguments to prepend to user arguments at the + time of the call; see the `curry' function. + +usage: (funvec KIND &rest PARAMS) */) + (nargs, args) + register int nargs; + Lisp_Object *args; +{ + return make_funvec (args[0], 0, nargs - 1, args + 1); +} + + DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, doc: /* Create a byte-code object with specified arguments as elements. The arguments should be the arglist, bytecode-string, constant vector, @@ -3078,6 +3134,10 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT register int index; register struct Lisp_Vector *p; + /* Make sure the arg-list is really a list, as that's what's used to + distinguish a byte-compiled object from other funvecs. */ + CHECK_LIST (args[0]); + XSETFASTINT (len, nargs); if (!NILP (Vpurify_flag)) val = make_pure_vector ((EMACS_INT) nargs); @@ -3099,8 +3159,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT args[index] = Fpurecopy (args[index]); p->contents[index] = args[index]; } - XSETPVECTYPE (p, PVEC_COMPILED); - XSETCOMPILED (val, p); + XSETPVECTYPE (p, PVEC_FUNVEC); + XSETFUNVEC (val, p); return val; } @@ -3199,6 +3259,7 @@ Its value and function definition are void, and its property list is nil. */) p->gcmarkbit = 0; p->interned = SYMBOL_UNINTERNED; p->constant = 0; + p->declared_special = 0; consing_since_gc += sizeof (struct Lisp_Symbol); symbols_consed++; return val; @@ -4907,7 +4968,7 @@ Does not copy symbols. Copies strings without text properties. */) obj = make_pure_string (SDATA (obj), SCHARS (obj), SBYTES (obj), STRING_MULTIBYTE (obj)); - else if (COMPILEDP (obj) || VECTORP (obj)) + else if (FUNVECP (obj) || VECTORP (obj)) { register struct Lisp_Vector *vec; register int i; @@ -4919,10 +4980,10 @@ Does not copy symbols. Copies strings without text properties. */) vec = XVECTOR (make_pure_vector (size)); for (i = 0; i < size; i++) vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]); - if (COMPILEDP (obj)) + if (FUNVECP (obj)) { - XSETPVECTYPE (vec, PVEC_COMPILED); - XSETCOMPILED (obj, vec); + XSETPVECTYPE (vec, PVEC_FUNVEC); + XSETFUNVEC (obj, vec); } else XSETVECTOR (obj, vec); @@ -5512,7 +5573,7 @@ mark_object (arg) } else if (SUBRP (obj)) break; - else if (COMPILEDP (obj)) + else if (FUNVECP (obj) && FUNVEC_COMPILED_P (obj)) /* We could treat this just like a vector, but it is better to save the COMPILED_CONSTANTS element for last and avoid recursion there. */ @@ -6423,6 +6484,7 @@ The time is in seconds as a floating point value. */); defsubr (&Scons); defsubr (&Slist); defsubr (&Svector); + defsubr (&Sfunvec); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); -- cgit v1.2.1 From 902568414670901f4038df6f5431b0de37028f95 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 6 Feb 2011 18:05:30 -0800 Subject: * alloc.c: conform to C89 pointer rules --- src/alloc.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 67d34d25642..f75903aab5a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2281,7 +2281,8 @@ make_string (const char *contents, EMACS_INT nbytes) register Lisp_Object val; EMACS_INT nchars, multibyte_nbytes; - parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes); + parse_str_as_multibyte ((const unsigned char *) contents, nbytes, + &nchars, &multibyte_nbytes); if (nbytes == nchars || nbytes != multibyte_nbytes) /* CONTENTS contains no multibyte sequences or contains an invalid multibyte sequence. We must make unibyte string. */ @@ -2349,7 +2350,8 @@ make_specified_string (const char *contents, if (nchars < 0) { if (multibyte) - nchars = multibyte_chars_in_text (contents, nbytes); + nchars = multibyte_chars_in_text ((const unsigned char *) contents, + nbytes); else nchars = nbytes; } @@ -4650,7 +4652,7 @@ make_pure_string (const char *data, struct Lisp_String *s; s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); - s->data = find_string_data_in_pure (data, nbytes); + s->data = (unsigned char *) find_string_data_in_pure (data, nbytes); if (s->data == NULL) { s->data = (unsigned char *) pure_alloc (nbytes + 1, -1); -- cgit v1.2.1 From 5d8ea1203d1e659bc77d953784a85a6e7da0ce95 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Mon, 14 Feb 2011 08:39:19 -0700 Subject: Hide implementation of `struct buffer' * composite.c (fill_gstring_header) (composition_compute_stop_pos, composition_adjust_point) (Ffind_composition_internal): Use B_. * intervals.c (set_point_both, get_local_map): Use B_. * callproc.c (Fcall_process, Fcall_process_region): Use B_. * process.c (get_process, list_processes_1, Fstart_process) (Fmake_serial_process, Fmake_network_process) (read_process_output, send_process, exec_sentinel) (status_notify, setup_process_coding_systems): Use B_. * bytecode.c (Fbyte_code): Use B_. * syntax.c (update_syntax_table, dec_bytepos, Fsyntax_table) (Fset_syntax_table, Fmodify_syntax_entry, skip_chars) (skip_syntaxes, scan_lists): Use B_. * lread.c (readchar, unreadchar, openp, readevalloop) (Feval_buffer, Feval_region): Use B_. * print.c (printchar, strout, print_string, PRINTDECLARE) (PRINTPREPARE, PRINTFINISH, temp_output_buffer_setup) (print_object): Use B_. * font.c (font_at): Use B_. * fns.c (Fbase64_encode_region, Fbase64_decode_region, Fmd5): Use B_. * callint.c (check_mark, Fcall_interactively): Use B_. * editfns.c (region_limit, Fmark_marker, save_excursion_save) (save_excursion_restore, Fprevious_char, Fchar_before) (general_insert_function, Finsert_char, Finsert_byte) (make_buffer_string_both, Finsert_buffer_substring) (Fcompare_buffer_substrings, subst_char_in_region_unwind) (subst_char_in_region_unwind_1, Fsubst_char_in_region) (Ftranslate_region_internal, save_restriction_restore) (Fchar_equal): Use B_. * data.c (swap_in_symval_forwarding, set_internal) (Fmake_local_variable, Fkill_local_variable, Flocal_variable_p): Use B_. * undo.c (record_point, record_insert, record_delete) (record_marker_adjustment, record_first_change) (record_property_change, Fundo_boundary, truncate_undo_list) (Fprimitive_undo): Use B_. * search.c (compile_pattern_1, compile_pattern, looking_at_1) (string_match_1, fast_looking_at, newline_cache_on_off) (search_command, search_buffer, simple_search, boyer_moore) (Freplace_match): Use B_. * indent.c (buffer_display_table, recompute_width_table) (width_run_cache_on_off, current_column, scan_for_column) (Findent_to, position_indentation, compute_motion, vmotion): Use B_. * casefiddle.c (casify_object, casify_region): Use B_. * casetab.c (Fcurrent_case_table, set_case_table): Use B_. * cmds.c (Fself_insert_command, internal_self_insert): Use B_. * fileio.c (Fexpand_file_name, Ffile_directory_p) (Ffile_regular_p, Ffile_selinux_context) (Fset_file_selinux_context, Ffile_modes, Fset_file_modes) (Fset_file_times, Ffile_newer_than_file_p, decide_coding_unwind) (Finsert_file_contents, choose_write_coding_system) (Fwrite_region, build_annotations, Fverify_visited_file_modtime) (Fset_visited_file_modtime, auto_save_error, auto_save_1) (Fdo_auto_save, Fset_buffer_auto_saved): Use B_. * minibuf.c (read_minibuf, get_minibuffer, Fread_buffer): Use B_. * marker.c (Fmarker_buffer, Fset_marker, set_marker_restricted) (set_marker_both, set_marker_restricted_both, unchain_marker): Use B_. * insdel.c (check_markers, insert_char, insert_1_both) (insert_from_string_1, insert_from_gap, insert_from_buffer_1) (adjust_after_replace, replace_range, del_range_2) (modify_region, prepare_to_modify_buffer) (Fcombine_after_change_execute): Use B_. * filelock.c (unlock_all_files, Flock_buffer, Funlock_buffer) (unlock_buffer): Use B_. * keymap.c (Flocal_key_binding, Fuse_local_map) (Fcurrent_local_map, push_key_description) (Fdescribe_buffer_bindings): Use B_. * keyboard.c (command_loop_1, read_char_minibuf_menu_prompt) (read_key_sequence): Use B_. * fringe.c (get_logical_cursor_bitmap) (get_logical_fringe_bitmap, update_window_fringes): Use B_. * xfns.c (x_create_tip_frame, Fx_show_tip): Use B_. * xfaces.c (compute_char_face): Use B_. * character.c (chars_in_text, Fget_byte): Use B_. * category.c (check_category_table, Fcategory_table) (Fset_category_table, char_category_set): Use B_. * coding.c (decode_coding, encode_coding) (make_conversion_work_buffer, decode_coding_gap) (decode_coding_object, encode_coding_object) (Fdetect_coding_region, Ffind_coding_systems_region_internal) (Funencodable_char_position, Fcheck_coding_systems_region): Use B_. * charset.c (Ffind_charset_region): Use B_. * window.c (window_display_table, unshow_buffer, window_loop) (window_min_size_2, set_window_buffer, Fset_window_buffer) (select_window, Fforce_window_update, temp_output_buffer_show) (Fset_window_configuration, save_window_save): Use B_. * xdisp.c (pos_visible_p, init_iterator, reseat_1) (message_dolog, update_echo_area, ensure_echo_area_buffers) (with_echo_area_buffer, setup_echo_area_for_printing) (set_message_1, update_menu_bar, update_tool_bar) (text_outside_line_unchanged_p, redisplay_internal) (try_scrolling, try_cursor_movement, redisplay_window) (try_window_reusing_current_matrix, row_containing_pos) (try_window_id, get_overlay_arrow_glyph_row, display_line) (Fcurrent_bidi_paragraph_direction, display_mode_lines) (decode_mode_spec_coding, decode_mode_spec, display_count_lines) (get_window_cursor_type, note_mouse_highlight): Use B_. * frame.c (make_frame_visible_1): Use B_. * dispnew.c (Fframe_or_buffer_changed_p): Use B_. * dispextern.h (WINDOW_WANTS_HEADER_LINE_P) (WINDOW_WANTS_MODELINE_P): Use B_. * syntax.h (Vstandard_syntax_table): Update. (CURRENT_SYNTAX_TABLE, SETUP_BUFFER_SYNTAX_TABLE): Use B_. * intervals.h (TEXT_PROP_MEANS_INVISIBLE): Update. (TEXT_PROP_MEANS_INVISIBLE): Use B_. * character.h (FETCH_CHAR_ADVANCE): Update. (INC_BOTH, ASCII_CHAR_WIDTH, DEC_BOTH): Use B_. * category.h (Vstandard_category_table): Update. * lisp.h (DEFVAR_BUFFER_DEFAULTS): Update for change to field names. (DOWNCASE_TABLE, UPCASE_TABLE): Use B_. * buffer.c (swapfield_): New macro. (Fbuffer_swap_text): Use swapfield_ where appropriate. (Fbuffer_live_p, Fget_file_buffer, get_truename_buffer) (Fget_buffer_create, clone_per_buffer_values) (Fmake_indirect_buffer, reset_buffer) (reset_buffer_local_variables, Fbuffer_name, Fbuffer_file_name) (Fbuffer_local_value, buffer_lisp_local_variables) (Fset_buffer_modified_p, Frestore_buffer_modified_p) (Frename_buffer, Fother_buffer, Fbuffer_enable_undo) (Fkill_buffer, Fset_buffer_major_mode, set_buffer_internal_1) (set_buffer_temp, Fset_buffer, set_buffer_if_live) (Fbarf_if_buffer_read_only, Fbury_buffer, Ferase_buffer) (Fbuffer_swap_text, Fset_buffer_multibyte) (swap_out_buffer_local_variables, record_overlay_string) (overlay_strings, init_buffer_once, init_buffer, syms_of_buffer): Use B_. * buffer.h (struct buffer): Rename all Lisp_Object fields. (BUFFER_INTERNAL_FIELD, B_): New macro. (FETCH_CHAR, FETCH_CHAR_AS_MULTIBYTE): Use B_. --- src/alloc.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index f75903aab5a..566c6fe00b9 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3886,7 +3886,7 @@ live_buffer_p (struct mem_node *m, void *p) must not have been killed. */ return (m->type == MEM_TYPE_BUFFER && p == m->start - && !NILP (((struct buffer *) p)->name)); + && !NILP (((struct buffer *) p)->BUFFER_INTERNAL_FIELD (name))); } #endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */ @@ -4872,11 +4872,11 @@ returns nil, because real GC can't be done. */) turned off in that buffer. Calling truncate_undo_list on Qt tends to return NULL, which effectively turns undo back on. So don't call truncate_undo_list if undo_list is Qt. */ - if (! NILP (nextb->name) && ! EQ (nextb->undo_list, Qt)) + if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt)) truncate_undo_list (nextb); /* Shrink buffer gaps, but skip indirect and dead buffers. */ - if (nextb->base_buffer == 0 && !NILP (nextb->name) + if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! nextb->text->inhibit_shrinking) { /* If a buffer's gap size is more than 10% of the buffer @@ -5009,10 +5009,10 @@ returns nil, because real GC can't be done. */) turned off in that buffer. Calling truncate_undo_list on Qt tends to return NULL, which effectively turns undo back on. So don't call truncate_undo_list if undo_list is Qt. */ - if (! EQ (nextb->undo_list, Qt)) + if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt)) { Lisp_Object tail, prev; - tail = nextb->undo_list; + tail = nextb->BUFFER_INTERNAL_FIELD (undo_list); prev = Qnil; while (CONSP (tail)) { @@ -5021,7 +5021,7 @@ returns nil, because real GC can't be done. */) && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) { if (NILP (prev)) - nextb->undo_list = tail = XCDR (tail); + nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail); else { tail = XCDR (tail); @@ -5037,7 +5037,7 @@ returns nil, because real GC can't be done. */) } /* Now that we have stripped the elements that need not be in the undo_list any more, we can finally mark the list. */ - mark_object (nextb->undo_list); + mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list)); nextb = nextb->next; } @@ -5595,7 +5595,7 @@ mark_buffer (Lisp_Object buf) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (ptr = &buffer->name; + for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name); (char *)ptr < (char *)buffer + sizeof (struct buffer); ptr++) mark_object (*ptr); -- cgit v1.2.1 From b286858c7a0d5dafa302b9e88970c13385358a6a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 17 Feb 2011 21:07:36 -0500 Subject: Don't GC-scan stack data redundantly. * src/alloc.c (Fgarbage_collect): When using stack scanning, don't redundantly scan byte-code stacks, catchlist, and handlerlist. * src/bytecode.c (BYTE_MAINTAIN_TOP): New macros. (struct byte_stack): Only define `top' and `bottom' if used. (mark_byte_stack): Only define if used. (BEFORE_POTENTIAL_GC, AFTER_POTENTIAL_GC): Nullify if BYTE_MAINTAIN_TOP is not set. (Fbyte_code): Don't set `bottom' unless BYTE_MAINTAIN_TOP is set. * src/lisp.h (BYTE_MARK_STACK): New macro. (mark_byte_stack): Only declare if BYTE_MARK_STACK is set. * src/term.c (OUTPUT_IF): Use OUTPUT. --- src/alloc.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 566c6fe00b9..e8b8f45e9b1 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4842,8 +4842,6 @@ returns nil, because real GC can't be done. */) (void) { register struct specbinding *bind; - struct catchtag *catch; - struct handler *handler; char stack_top_variable; register int i; int message_p; @@ -4972,9 +4970,11 @@ returns nil, because real GC can't be done. */) for (i = 0; i < tail->nvars; i++) mark_object (tail->var[i]); } -#endif - mark_byte_stack (); + { + struct catchtag *catch; + struct handler *handler; + for (catch = catchlist; catch; catch = catch->next) { mark_object (catch->tag); @@ -4985,7 +4985,9 @@ returns nil, because real GC can't be done. */) mark_object (handler->handler); mark_object (handler->var); } + } mark_backtrace (); +#endif #ifdef HAVE_WINDOW_SYSTEM mark_fringe_data (); -- cgit v1.2.1 From cbe81f1d96ca482c15d583cfd4a196d38af87972 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 18 Feb 2011 12:37:30 -0500 Subject: * alloc.c (make_unibyte_string): Don't SET_UNIBYTE redundantly. * process.c (Fstart_process, Fmake_serial_process) (Fmake_network_process, server_accept_connection): Use empty_unibyte_string. --- src/alloc.c | 1 - 1 file changed, 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index e8b8f45e9b1..d7006ca6bfd 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2301,7 +2301,6 @@ make_unibyte_string (const char *contents, EMACS_INT length) register Lisp_Object val; val = make_uninit_string (length); memcpy (SDATA (val), contents, length); - STRING_SET_UNIBYTE (val); return val; } -- cgit v1.2.1 From 3e21b6a72b87787e2327513a44623b250054f77d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 21 Feb 2011 15:12:44 -0500 Subject: Use offsets relative to top rather than bottom for stack refs * lisp/emacs-lisp/byte-opt.el (byte-compile-side-effect-and-error-free-ops): Remove interactive-p. (byte-optimize-lapcode): Update optimizations now that stack-refs are relative to the top rather than to the bottom. * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Turn stack-ref-0 into dup. (byte-compile-form): Don't indirect-function since it can signal errors. (byte-compile-stack-ref, byte-compile-stack-set): Adjust to stack-refs being relative to top rather than to bottom in the byte-code. (with-output-to-temp-buffer): Remove. (byte-compile-with-output-to-temp-buffer): Remove. * lisp/emacs-lisp/cconv.el: Use lexical-binding. (cconv--lookup-let): Rename from cconv-lookup-let. (cconv-closure-convert-rec): Fix handling of captured+mutated arguments in defun/defmacro. * lisp/emacs-lisp/eieio-comp.el (eieio-byte-compile-file-form-defmethod): Rename from byte-compile-file-form-defmethod. Don't byte-compile-lambda. (eieio-byte-compile-defmethod-param-convert): Rename from byte-compile-defmethod-param-convert. * lisp/emacs-lisp/eieio.el (eieio-defgeneric-form-primary-only-one): Call byte-compile rather than byte-compile-lambda. * src/alloc.c (Fgarbage_collect): Don't mark the byte-stack redundantly. * src/bytecode.c (exec_byte_code): Change stack_ref and stack_set to use offsets relative to top rather than to bottom. * lisp/subr.el (with-output-to-temp-buffer): New macro. * lisp/simple.el (count-words-region): Don't use interactive-p. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 36c849418f3..4c29ce0b4ec 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5029,9 +5029,9 @@ returns nil, because real GC can't be done. */) for (i = 0; i < tail->nvars; i++) mark_object (tail->var[i]); } + mark_byte_stack (); #endif - mark_byte_stack (); for (catch = catchlist; catch; catch = catch->next) { mark_object (catch->tag); -- cgit v1.2.1 From 876c194cbac17a6220dbf406b0a602325978011c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 24 Feb 2011 22:27:45 -0500 Subject: Get rid of funvec. * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle new form of `byte-constant'. (byte-compile-close-variables, displaying-byte-compile-warnings): Add edebug spec. (byte-compile-toplevel-file-form): New fun, split out of byte-compile-file-form. (byte-compile-from-buffer): Use it to avoid applying cconv multiple times. (byte-compile): Only strip `function' if it's present. (byte-compile-lambda): Add `reserved-csts' argument. Use new lexenv arg of byte-compile-top-level. (byte-compile-reserved-constants): New var. (byte-compile-constants-vector): Obey it. (byte-compile-constants-vector): Handle new `byte-constant' form. (byte-compile-top-level): Add args `lexenv' and `reserved-csts'. (byte-compile-form): Don't check callargs here. (byte-compile-normal-call): Do it here instead. (byte-compile-push-unknown-constant) (byte-compile-resolve-unknown-constant): Remove, unused. (byte-compile-make-closure): Use `make-byte-code' rather than `curry', putting the environment into the "constant" pool. (byte-compile-get-closed-var): Use special byte-constant. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Handle new intermediate special form `internal-make-vector'. (byte-optimize-lapcode): Handle new form of `byte-constant'. * lisp/help-fns.el (describe-function-1): Don't handle funvecs. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Only convert quote to function if the content is a lambda expression, not if it's a closure. * emacs-lisp/eieio-come.el: Remove. * lisp/emacs-lisp/eieio.el: Don't require eieio-comp. (defmethod): Do a bit more work to find the body and wrap it into a function before passing it to eieio-defmethod. (eieio-defmethod): New arg `code' for it. * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Don't hide things in debugger backtrace. * lisp/emacs-lisp/cl-extra.el (cl-macroexpand-all): Use backquotes, and be more careful when quoting a function value. * lisp/emacs-lisp/cconv.el (cconv-freevars): Accept defvar/defconst. (cconv-closure-convert-rec): Catch stray `internal-make-closure'. * lisp/Makefile.in (COMPILE_FIRST): Compile pcase and cconv early. * src/eval.c (Qcurry): Remove. (funcall_funvec): Remove. (funcall_lambda): Move new byte-code handling to reduce impact. Treat all args as lexical in the case of lexbind. (Fcurry): Remove. * src/data.c (Qfunction_vector): Remove. (Ffunvecp): Remove. * src/lread.c (read1): Revert to calling make_byte_code here. (read_vector): Don't call make_byte_code any more. * src/lisp.h (enum pvec_type): Rename back to PVEC_COMPILED. (XSETCOMPILED): Rename back from XSETFUNVEC. (FUNVEC_SIZE): Remove. (FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): Remove. (COMPILEDP): Rename back from FUNVECP. * src/fns.c (Felt): Remove unexplained FUNVEC check. * src/doc.c (Fdocumentation): Don't handle funvec. * src/alloc.c (make_funvec, Ffunvec): Remove. * doc/lispref/vol2.texi (Top): * doc/lispref/vol1.texi (Top): * doc/lispref/objects.texi (Programming Types, Funvec Type, Type Predicates): * doc/lispref/functions.texi (Functions, What Is a Function, FunctionCurrying): * doc/lispref/elisp.texi (Top): Remove mentions of funvec and curry. --- src/alloc.c | 71 ++++++------------------------------------------------------- 1 file changed, 7 insertions(+), 64 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 81a17b5c13b..0b7db7ec627 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2924,37 +2924,6 @@ See also the function `vector'. */) } -/* Return a new `function vector' containing KIND as the first element, - followed by NUM_NIL_SLOTS nil elements, and further elements copied from - the vector PARAMS of length NUM_PARAMS (so the total length of the - resulting vector is 1 + NUM_NIL_SLOTS + NUM_PARAMS). - - If NUM_PARAMS is zero, then PARAMS may be NULL. - - A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp. - See the function `funvec' for more detail. */ - -Lisp_Object -make_funvec (Lisp_Object kind, int num_nil_slots, int num_params, - Lisp_Object *params) -{ - int param_index; - Lisp_Object funvec; - - funvec = Fmake_vector (make_number (1 + num_nil_slots + num_params), Qnil); - - ASET (funvec, 0, kind); - - for (param_index = 0; param_index < num_params; param_index++) - ASET (funvec, 1 + num_nil_slots + param_index, params[param_index]); - - XSETPVECTYPE (XVECTOR (funvec), PVEC_FUNVEC); - XSETFUNVEC (funvec, XVECTOR (funvec)); - - return funvec; -} - - DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. @@ -2974,27 +2943,6 @@ usage: (vector &rest OBJECTS) */) } -DEFUN ("funvec", Ffunvec, Sfunvec, 1, MANY, 0, - doc: /* Return a newly created `function vector' of type KIND. -A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp. -KIND indicates the kind of funvec, and determines its behavior when called. -The meaning of the remaining arguments depends on KIND. Currently -implemented values of KIND, and their meaning, are: - - A list -- A byte-compiled function. See `make-byte-code' for the usual - way to create byte-compiled functions. - - `curry' -- A curried function. Remaining arguments are a function to - call, and arguments to prepend to user arguments at the - time of the call; see the `curry' function. - -usage: (funvec KIND &rest PARAMS) */) - (int nargs, Lisp_Object *args) -{ - return make_funvec (args[0], 0, nargs - 1, args + 1); -} - - DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, doc: /* Create a byte-code object with specified arguments as elements. The arguments should be the arglist, bytecode-string, constant vector, @@ -3008,10 +2956,6 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT register int index; register struct Lisp_Vector *p; - /* Make sure the arg-list is really a list, as that's what's used to - distinguish a byte-compiled object from other funvecs. */ - CHECK_LIST (args[0]); - XSETFASTINT (len, nargs); if (!NILP (Vpurify_flag)) val = make_pure_vector ((EMACS_INT) nargs); @@ -3033,8 +2977,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT args[index] = Fpurecopy (args[index]); p->contents[index] = args[index]; } - XSETPVECTYPE (p, PVEC_FUNVEC); - XSETFUNVEC (val, p); + XSETPVECTYPE (p, PVEC_COMPILED); + XSETCOMPILED (val, p); return val; } @@ -4817,7 +4761,7 @@ Does not copy symbols. Copies strings without text properties. */) obj = make_pure_string (SSDATA (obj), SCHARS (obj), SBYTES (obj), STRING_MULTIBYTE (obj)); - else if (FUNVECP (obj) || VECTORP (obj)) + else if (COMPILEDP (obj) || VECTORP (obj)) { register struct Lisp_Vector *vec; register EMACS_INT i; @@ -4829,10 +4773,10 @@ Does not copy symbols. Copies strings without text properties. */) vec = XVECTOR (make_pure_vector (size)); for (i = 0; i < size; i++) vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]); - if (FUNVECP (obj)) + if (COMPILEDP (obj)) { - XSETPVECTYPE (vec, PVEC_FUNVEC); - XSETFUNVEC (obj, vec); + XSETPVECTYPE (vec, PVEC_COMPILED); + XSETCOMPILED (obj, vec); } else XSETVECTOR (obj, vec); @@ -5418,7 +5362,7 @@ mark_object (Lisp_Object arg) } else if (SUBRP (obj)) break; - else if (FUNVECP (obj) && FUNVEC_COMPILED_P (obj)) + else if (COMPILEDP (obj)) /* We could treat this just like a vector, but it is better to save the COMPILED_CONSTANTS element for last and avoid recursion there. */ @@ -6320,7 +6264,6 @@ The time is in seconds as a floating point value. */); defsubr (&Scons); defsubr (&Slist); defsubr (&Svector); - defsubr (&Sfunvec); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); -- cgit v1.2.1 From e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 5 Mar 2011 23:48:17 -0500 Subject: Fix pcase memoizing; change lexbound byte-code marker. * src/bytecode.c (exec_byte_code): Remove old lexical binding slot handling and replace it with the a integer args-desc handling. * eval.c (funcall_lambda): Adjust arglist test accordingly. * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-signature): Handle integer arglist descriptor. (byte-compile-make-args-desc): Make integer arglist descriptor. (byte-compile-lambda): Use integer arglist descriptor to mark lexical byte-coded functions instead of an extra slot. * lisp/help-fns.el (help-add-fundoc-usage): Don't add a dummy doc. (help-split-fundoc): Return a nil doc if there was no actual doc. (help-function-arglist): Generate an arglist from an integer arg-desc. * lisp/emacs-lisp/pcase.el (pcase--memoize): Rename from pcase-memoize; Make only the key weak. (pcase): Change the key used in the memoization table, so it does not always get GC'd away. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Slight change to the pcase pattern to generate slightly better code. --- src/alloc.c | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 0b7db7ec627..c7fd8747f74 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2945,10 +2945,19 @@ usage: (vector &rest OBJECTS) */) DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, doc: /* Create a byte-code object with specified arguments as elements. -The arguments should be the arglist, bytecode-string, constant vector, -stack size, (optional) doc string, and (optional) interactive spec. +The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant +vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING, +and (optional) INTERACTIVE-SPEC. The first four arguments are required; at most six have any significance. +The ARGLIST can be either like the one of `lambda', in which case the arguments +will be dynamically bound before executing the byte code, or it can be an +integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the +minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number +of arguments (ignoring &rest) and the R bit specifies whether there is a &rest +argument to catch the left-over arguments. If such an integer is used, the +arguments will not be dynamically bound but will be instead pushed on the +stack before executing the byte-code. usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) (register int nargs, Lisp_Object *args) { -- cgit v1.2.1 From e6ca6543685fded0d1b3322dd06d0fa70d3e2a44 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 8 Mar 2011 21:40:59 -0800 Subject: * alloc.c (mark_ttys): Move decl from here ... * lisp.h (mark_ttys): ... to here, so that it's checked against defn. --- src/alloc.c | 1 - 1 file changed, 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index d7006ca6bfd..8632897606a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -271,7 +271,6 @@ Lisp_Object Qpost_gc_hook; static void mark_buffer (Lisp_Object); static void mark_terminals (void); extern void mark_kboards (void); -extern void mark_ttys (void); extern void mark_backtrace (void); static void gc_sweep (void); static void mark_glyph_matrix (struct glyph_matrix *); -- cgit v1.2.1 From 524c7aa6108b4178ca8436db8022686d180a5ca5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 9 Mar 2011 18:01:53 -0800 Subject: * alloc.c (mark_fringe_data): Move decl from here ... * lisp.h (mark_fringe_data) [HAVE_WINDOW_SYSTEM]: ... to here, to check its interface. (init_fringe_once): Do not declare unless HAVE_WINDOW_SYSTEM. --- src/alloc.c | 4 ---- 1 file changed, 4 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 8632897606a..6c92f36ca7d 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -276,10 +276,6 @@ static void gc_sweep (void); static void mark_glyph_matrix (struct glyph_matrix *); static void mark_face_cache (struct face_cache *); -#ifdef HAVE_WINDOW_SYSTEM -extern void mark_fringe_data (void); -#endif /* HAVE_WINDOW_SYSTEM */ - static struct Lisp_String *allocate_string (void); static void compact_small_strings (void); static void free_large_strings (void); -- cgit v1.2.1 From da2f2dd9c2fac1bb1e3d5e5c4a3b38cad3c20ad5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 13 Mar 2011 22:55:38 -0700 Subject: * keyboard.h (mark_kboards): Move decl here ... * alloc.c (mark_kboards): ... from here. --- src/alloc.c | 1 - 1 file changed, 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 6c92f36ca7d..d6b64de5af9 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -270,7 +270,6 @@ Lisp_Object Qpost_gc_hook; static void mark_buffer (Lisp_Object); static void mark_terminals (void); -extern void mark_kboards (void); extern void mark_backtrace (void); static void gc_sweep (void); static void mark_glyph_matrix (struct glyph_matrix *); -- cgit v1.2.1 From e5aab7e74931e4b4b0fd21abf4a6ea5b7f5134f4 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 15 Mar 2011 14:56:37 -0700 Subject: * alloc.c (check_cons_list): Do not define unless GC_CHECK_CONS_LIST. * lisp.h (check_cons_list): Declare if GC_CHECK_CONS_LIST; this avoids undefined behavior in theory. --- src/alloc.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index d6b64de5af9..1ad8af0d61a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2653,17 +2653,17 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, return val; } +#ifdef GC_CHECK_CONS_LIST /* Get an error now if there's any junk in the cons free list. */ void check_cons_list (void) { -#ifdef GC_CHECK_CONS_LIST struct Lisp_Cons *tail = cons_free_list; while (tail) tail = tail->u.chain; -#endif } +#endif /* Make a list of 1, 2, 3, 4 or 5 specified objects. */ -- cgit v1.2.1 From ae35e7564b5fc774798d5e9494123a2ff0522885 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 15 Mar 2011 15:02:48 -0700 Subject: * alloc.c: (Fmake_vector, Fvector, Fmake_byte_code, Fgarbage_collect): Rename locals to avoid shadowing. --- src/alloc.c | 48 ++++++++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 24 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 1ad8af0d61a..6f379ef35f9 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2903,15 +2903,15 @@ See also the function `vector'. */) { Lisp_Object vector; register EMACS_INT sizei; - register EMACS_INT index; + register EMACS_INT i; register struct Lisp_Vector *p; CHECK_NATNUM (length); sizei = XFASTINT (length); p = allocate_vector (sizei); - for (index = 0; index < sizei; index++) - p->contents[index] = init; + for (i = 0; i < sizei; i++) + p->contents[i] = init; XSETVECTOR (vector, p); return vector; @@ -2925,14 +2925,14 @@ usage: (vector &rest OBJECTS) */) (register int nargs, Lisp_Object *args) { register Lisp_Object len, val; - register int index; + register int i; register struct Lisp_Vector *p; XSETFASTINT (len, nargs); val = Fmake_vector (len, Qnil); p = XVECTOR (val); - for (index = 0; index < nargs; index++) - p->contents[index] = args[index]; + for (i = 0; i < nargs; i++) + p->contents[i] = args[i]; return val; } @@ -2947,7 +2947,7 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT (register int nargs, Lisp_Object *args) { register Lisp_Object len, val; - register int index; + register int i; register struct Lisp_Vector *p; XSETFASTINT (len, nargs); @@ -2965,11 +2965,11 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT args[1] = Fstring_as_unibyte (args[1]); p = XVECTOR (val); - for (index = 0; index < nargs; index++) + for (i = 0; i < nargs; i++) { if (!NILP (Vpurify_flag)) - args[index] = Fpurecopy (args[index]); - p->contents[index] = args[index]; + args[i] = Fpurecopy (args[i]); + p->contents[i] = args[i]; } XSETPVECTYPE (p, PVEC_COMPILED); XSETCOMPILED (val, p); @@ -5063,18 +5063,18 @@ returns nil, because real GC can't be done. */) if (FLOATP (Vgc_cons_percentage)) { /* Set gc_cons_combined_threshold. */ - EMACS_INT total = 0; - - total += total_conses * sizeof (struct Lisp_Cons); - total += total_symbols * sizeof (struct Lisp_Symbol); - total += total_markers * sizeof (union Lisp_Misc); - total += total_string_size; - total += total_vector_size * sizeof (Lisp_Object); - total += total_floats * sizeof (struct Lisp_Float); - total += total_intervals * sizeof (struct interval); - total += total_strings * sizeof (struct Lisp_String); - - gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage); + EMACS_INT tot = 0; + + tot += total_conses * sizeof (struct Lisp_Cons); + tot += total_symbols * sizeof (struct Lisp_Symbol); + tot += total_markers * sizeof (union Lisp_Misc); + tot += total_string_size; + tot += total_vector_size * sizeof (Lisp_Object); + tot += total_floats * sizeof (struct Lisp_Float); + tot += total_intervals * sizeof (struct interval); + tot += total_strings * sizeof (struct Lisp_String); + + gc_relative_threshold = tot * XFLOAT_DATA (Vgc_cons_percentage); } else gc_relative_threshold = 0; @@ -5123,9 +5123,9 @@ returns nil, because real GC can't be done. */) if (!NILP (Vpost_gc_hook)) { - int count = inhibit_garbage_collection (); + int gc_count = inhibit_garbage_collection (); safe_run_hooks (Qpost_gc_hook); - unbind_to (count, Qnil); + unbind_to (gc_count, Qnil); } /* Accumulate statistics. */ -- cgit v1.2.1 From dff45157417d1620c4fb7b6c117cc89142009b69 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 15 Mar 2011 15:09:50 -0700 Subject: * alloc.c (mark_stack): Move local variables into the #ifdef region where they're used. --- src/alloc.c | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 6f379ef35f9..fd1334a6ef7 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4312,12 +4312,6 @@ static void mark_stack (void) { int i; - /* jmp_buf may not be aligned enough on darwin-ppc64 */ - union aligned_jmpbuf { - Lisp_Object o; - jmp_buf j; - } j; - volatile int stack_grows_down_p = (char *) &j > (char *) stack_base; void *end; #ifdef HAVE___BUILTIN_UNWIND_INIT @@ -4327,6 +4321,14 @@ mark_stack (void) __builtin_unwind_init (); end = &end; #else /* not HAVE___BUILTIN_UNWIND_INIT */ +#ifndef GC_SAVE_REGISTERS_ON_STACK + /* jmp_buf may not be aligned enough on darwin-ppc64 */ + union aligned_jmpbuf { + Lisp_Object o; + jmp_buf j; + } j; + volatile int stack_grows_down_p = (char *) &j > (char *) stack_base; +#endif /* This trick flushes the register windows so that all the state of the process is contained in the stack. */ /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is -- cgit v1.2.1 From 7bc26fdb5c3b50b29bff966a55394e730fbfadd8 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 15 Mar 2011 15:31:22 -0700 Subject: * alloc.c (BLOCK_INPUT_ALLOC, UNBLOCK_INPUT_ALLOC): Define only if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT, as they are not needed otherwise. (CHECK_ALLOCATED): Define only if GC_CHECK_MARKED_OBJECTS. (GC_STRING_CHARS): Remove; not used. --- src/alloc.c | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index fd1334a6ef7..7fa2790cb1e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -92,7 +92,8 @@ extern __malloc_size_t __malloc_extra_blocks; #endif /* not DOUG_LEA_MALLOC */ -#if ! defined (SYSTEM_MALLOC) && defined (HAVE_GTK_AND_PTHREAD) +#if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT +#ifdef HAVE_GTK_AND_PTHREAD /* When GTK uses the file chooser dialog, different backends can be loaded dynamically. One such a backend is the Gnome VFS backend that gets loaded @@ -130,12 +131,13 @@ static pthread_mutex_t alloc_mutex; } \ while (0) -#else /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */ +#else /* ! defined HAVE_GTK_AND_PTHREAD */ #define BLOCK_INPUT_ALLOC BLOCK_INPUT #define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT -#endif /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */ +#endif /* ! defined HAVE_GTK_AND_PTHREAD */ +#endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */ /* Value of _bytes_used, when spare_memory was freed. */ @@ -152,13 +154,11 @@ static __malloc_size_t bytes_used_when_full; #define VECTOR_UNMARK(V) ((V)->size &= ~ARRAY_MARK_FLAG) #define VECTOR_MARKED_P(V) (((V)->size & ARRAY_MARK_FLAG) != 0) -/* Value is the number of bytes/chars of S, a pointer to a struct - Lisp_String. This must be used instead of STRING_BYTES (S) or - S->size during GC, because S->size contains the mark bit for +/* Value is the number of bytes of S, a pointer to a struct Lisp_String. + Be careful during GC, because S->size contains the mark bit for strings. */ #define GC_STRING_BYTES(S) (STRING_BYTES (S)) -#define GC_STRING_CHARS(S) ((S)->size & ~ARRAY_MARK_FLAG) /* Global variables. */ struct emacs_globals globals; @@ -5306,7 +5306,6 @@ mark_object (Lisp_Object arg) #else /* not GC_CHECK_MARKED_OBJECTS */ -#define CHECK_ALLOCATED() (void) 0 #define CHECK_LIVE(LIVEP) (void) 0 #define CHECK_ALLOCATED_AND_LIVE(LIVEP) (void) 0 -- cgit v1.2.1 From d40d4be1bdebdc52a6061534d5ed1a76f54a1272 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 15 Mar 2011 15:37:59 -0700 Subject: * alloc.c (Fmemory_limit): Cast sbrk's returned value to char *. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 7fa2790cb1e..6262e002ed3 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6057,7 +6057,7 @@ We divide the value by 1024 to make sure it fits in a Lisp integer. */) { Lisp_Object end; - XSETINT (end, (EMACS_INT) sbrk (0) / 1024); + XSETINT (end, (EMACS_INT) (char *) sbrk (0) / 1024); return end; } -- cgit v1.2.1 From 8b2c52e913dcfed4dc39d79a994a2d301b06478a Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 16 Mar 2011 00:37:10 -0700 Subject: * alloc.c (mark_backtrace): Move decl from here ... * lisp.h: ... to here, so that it can be checked. --- src/alloc.c | 1 - 1 file changed, 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 6262e002ed3..66695e7a9bc 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -270,7 +270,6 @@ Lisp_Object Qpost_gc_hook; static void mark_buffer (Lisp_Object); static void mark_terminals (void); -extern void mark_backtrace (void); static void gc_sweep (void); static void mark_glyph_matrix (struct glyph_matrix *); static void mark_face_cache (struct face_cache *); -- cgit v1.2.1 From dd3f25f792d724f59fac3e2d4faa21b311f21137 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 25 Mar 2011 21:17:38 -0700 Subject: * alloc.c (garbage_collect): Don't assume stack size fits in int. (stack_copy_size): Now size_t, not int. (stack_copy, stack_copy_size): Define only if MAX_SAVE_STACK > 0. --- src/alloc.c | 33 ++++++++++++++++++++------------- 1 file changed, 20 insertions(+), 13 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 66695e7a9bc..00f053e9090 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -254,8 +254,10 @@ const char *pending_malloc_warning; /* Buffer in which we save a copy of the C stack at each GC. */ +#if MAX_SAVE_STACK > 0 static char *stack_copy; -static int stack_copy_size; +static size_t stack_copy_size; +#endif /* Non-zero means ignore malloc warnings. Set during initialization. Currently not used. */ @@ -4903,21 +4905,26 @@ returns nil, because real GC can't be done. */) #if MAX_SAVE_STACK > 0 if (NILP (Vpurify_flag)) { - i = &stack_top_variable - stack_bottom; - if (i < 0) i = -i; - if (i < MAX_SAVE_STACK) + char *stack; + size_t stack_size; + if (&stack_top_variable < stack_bottom) + { + stack = &stack_top_variable; + stack_size = stack_bottom - &stack_top_variable; + } + else + { + stack = stack_bottom; + stack_size = &stack_top_variable - stack_bottom; + } + if (stack_size <= MAX_SAVE_STACK) { - if (stack_copy == 0) - stack_copy = (char *) xmalloc (stack_copy_size = i); - else if (stack_copy_size < i) - stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i)); - if (stack_copy) + if (stack_copy_size < stack_size) { - if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0) - memcpy (stack_copy, stack_bottom, i); - else - memcpy (stack_copy, &stack_top_variable, i); + stack_copy = (char *) xrealloc (stack_copy, stack_size); + stack_copy_size = stack_size; } + memcpy (stack_copy, stack, stack_size); } } #endif /* MAX_SAVE_STACK > 0 */ -- cgit v1.2.1 From c5101a77a4066d979698d356c3a9c7f387007359 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 26 Mar 2011 19:12:36 -0700 Subject: Variadic C functions now count arguments with size_t, not int. --- src/alloc.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 00f053e9090..177a2266fb6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2707,7 +2707,7 @@ DEFUN ("list", Flist, Slist, 0, MANY, 0, doc: /* Return a newly created list with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (list &rest OBJECTS) */) - (int nargs, register Lisp_Object *args) + (size_t nargs, register Lisp_Object *args) { register Lisp_Object val; val = Qnil; @@ -2923,10 +2923,10 @@ DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (vector &rest OBJECTS) */) - (register int nargs, Lisp_Object *args) + (register size_t nargs, Lisp_Object *args) { register Lisp_Object len, val; - register int i; + register size_t i; register struct Lisp_Vector *p; XSETFASTINT (len, nargs); @@ -2945,10 +2945,10 @@ stack size, (optional) doc string, and (optional) interactive spec. The first four arguments are required; at most six have any significance. usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) - (register int nargs, Lisp_Object *args) + (register size_t nargs, Lisp_Object *args) { register Lisp_Object len, val; - register int i; + register size_t i; register struct Lisp_Vector *p; XSETFASTINT (len, nargs); @@ -4230,7 +4230,7 @@ static void check_gcpros (void) { struct gcpro *p; - int i; + size_t i; for (p = gcprolist; p; p = p->next) for (i = 0; i < p->nvars; ++i) @@ -4839,7 +4839,7 @@ returns nil, because real GC can't be done. */) { register struct specbinding *bind; char stack_top_variable; - register int i; + register size_t i; int message_p; Lisp_Object total[8]; int count = SPECPDL_INDEX (); -- cgit v1.2.1 From b895abced91e6dcedf6c580ea3e51befc5c757c1 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 2 Apr 2011 22:41:46 -0700 Subject: * alloc.c (mark_object_loop_halt, mark_object): Use size_t, not int. Otherwise, GCC 4.6.0 optimizes the loop check away since the check can always succeed if overflow has undefined behavior. --- src/alloc.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 07f1caae46b..54c4760abab 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5221,7 +5221,7 @@ int last_marked_index; links of a list, in mark_object. In debugging, the call to abort will hit a breakpoint. Normally this is zero and the check never goes off. */ -static int mark_object_loop_halt; +static size_t mark_object_loop_halt; static void mark_vectorlike (struct Lisp_Vector *ptr) @@ -5278,7 +5278,7 @@ mark_object (Lisp_Object arg) void *po; struct mem_node *m; #endif - int cdr_count = 0; + size_t cdr_count = 0; loop: -- cgit v1.2.1 From 16a97296c05ec9d5bb4ffeae9dce90fc63f578ed Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 10 Apr 2011 18:41:15 -0700 Subject: Make Emacs functions such as Fatom 'static' by default. This makes it easier for human readers (and static analyzers) to see whether these functions can be called from other modules. DEFUN now defines a static function. To make the function external so that it can be used in other C modules, use the new macro DEFUE. * lisp.h (DEFINE_FUNC): New macro, with the old contents of DEFUN. (DEFUN): Rewrite in terms of DEFINE_FUNC. It now generates a static function definition. Use DEFUE if you want an extern one. (DEFUE, INFUN): New macros. (Funibyte_char_to_multibyte, Fsyntax_table_p, Finit_image_library): (Feval_region, Fbacktrace, Ffetch_bytecode, Fswitch_to_buffer): (Ffile_executable_p, Fmake_symbolic_link, Fcommand_execute): (Fget_process, Fdocumentation_property, Fbyte_code, Ffile_attributes): Remove decls, since these functions are now static. (Funintern, Fget_internal_run_time): New decls, since these functions were already external. * alloc.c, buffer.c, callint.c, callproc.c, casefiddle.c, casetab.c: * ccl.c, character.c, chartab.c, cmds.c, coding.c, data.c, dispnew.c: * doc.c, editfns.c, emacs.c, eval.c, fileio.c, filelock.c, floatfns.c: * fns.c, font.c, fontset.c, frame.c, image.c, indent.c: * keyboard.c, keymap.c, lread.c: * macros.c, marker.c, menu.c, minibuf.c, print.c, process.c, search.c: * syntax.c, term.c, terminal.c, textprop.c, undo.c: * window.c, xdisp.c, xfaces.c, xfns.c, xmenu.c, xsettings.c: Mark functions with DEFUE instead of DEFUN, if they are used in other modules. * buffer.c (Fset_buffer_major_mode, Fdelete_overlay): New forward decls for now-static functions. * buffer.h (Fdelete_overlay): Remove decl. * callproc.c (Fgetenv_internal): Mark as internal. * composite.c (Fremove_list_of_text_properties): Remove decl. (Fcomposition_get_gstring): New forward static decl. * composite.h (Fcomposite_get_gstring): Remove decl. * dired.c (Ffile_attributes): New forward static decl. * doc.c (Fdocumntation_property): New forward static decl. * eval.c (Ffetch_bytecode): New forward static decl. (Funintern): Remove extern decl; now in .h file where it belongs. * fileio.c (Fmake_symbolic_link): New forward static decl. * image.c (Finit_image_library): New forward static decl. * insdel.c (Fcombine_after_change_execute): Make forward decl static. * intervals.h (Fprevious_property_change): (Fremove_list_of_text_properties): Remove decls. * keyboard.c (Fthis_command_keys): Remove decl. (Fcommand_execute): New forward static decl. * keymap.c (Flookup_key): New forward static decl. (Fcopy_keymap): Now static. * keymap.h (Flookup_key): Remove decl. * process.c (Fget_process): New forward static decl. (Fprocess_datagram_address): Mark as internal. * syntax.c (Fsyntax_table_p): New forward static decl. (skip_chars): Remove duplicate decl. * textprop.c (Fprevious_property_change): New forward static decl. * window.c (Fset_window_fringes, Fset_window_scroll_bars): Now internal. (Fset_window_margins, Fset_window_vscroll): New forward static decls. * window.h (Fset_window_vscroll, Fset_window_margins): Remove decls. --- src/alloc.c | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 54c4760abab..1396586ba3e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2174,7 +2174,7 @@ compact_small_strings (void) } -DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, +DEFUE ("make-string", Fmake_string, Smake_string, 2, 2, 0, doc: /* Return a newly created string of length LENGTH, with INIT in each element. LENGTH must be an integer. INIT must be an integer that represents a character. */) @@ -2222,7 +2222,7 @@ INIT must be an integer that represents a character. */) } -DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, +DEFUE ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, doc: /* Return a new bool-vector of length LENGTH, using INIT for each element. LENGTH must be a number. INIT matters only in whether it is t or nil. */) (Lisp_Object length, Lisp_Object init) @@ -2610,7 +2610,7 @@ free_cons (struct Lisp_Cons *ptr) cons_free_list = ptr; } -DEFUN ("cons", Fcons, Scons, 2, 2, 0, +DEFUE ("cons", Fcons, Scons, 2, 2, 0, doc: /* Create a new cons, give it CAR and CDR as components, and return it. */) (Lisp_Object car, Lisp_Object cdr) { @@ -2703,7 +2703,7 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, L } -DEFUN ("list", Flist, Slist, 0, MANY, 0, +DEFUE ("list", Flist, Slist, 0, MANY, 0, doc: /* Return a newly created list with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (list &rest OBJECTS) */) @@ -2721,7 +2721,7 @@ usage: (list &rest OBJECTS) */) } -DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, +DEFUE ("make-list", Fmake_list, Smake_list, 2, 2, 0, doc: /* Return a newly created list of length LENGTH, with each element being INIT. */) (register Lisp_Object length, Lisp_Object init) { @@ -2897,7 +2897,7 @@ allocate_process (void) } -DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, +DEFUE ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, doc: /* Return a newly created vector of length LENGTH, with each element being INIT. See also the function `vector'. */) (register Lisp_Object length, Lisp_Object init) @@ -2919,7 +2919,7 @@ See also the function `vector'. */) } -DEFUN ("vector", Fvector, Svector, 0, MANY, 0, +DEFUE ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (vector &rest OBJECTS) */) @@ -2938,7 +2938,7 @@ usage: (vector &rest OBJECTS) */) } -DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, +DEFUE ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, doc: /* Create a byte-code object with specified arguments as elements. The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING, @@ -3033,7 +3033,7 @@ init_symbol (void) } -DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, +DEFUE ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, doc: /* Return a newly allocated uninterned symbol whose name is NAME. Its value and function definition are void, and its property list is nil. */) (Lisp_Object name) @@ -3196,7 +3196,7 @@ make_save_value (void *pointer, int integer) return val; } -DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, +DEFUE ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, doc: /* Return a newly allocated marker which does not point at any place. */) (void) { @@ -3925,7 +3925,7 @@ static int max_live, max_zombies; static double avg_live; -DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "", +DEFUE ("gc-status", Fgc_status, Sgc_status, 0, 0, "", doc: /* Show information about live and zombie objects. */) (void) { @@ -4740,7 +4740,7 @@ make_pure_vector (EMACS_INT len) } -DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, +DEFUE ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, doc: /* Make a copy of object OBJ in pure storage. Recursively copies contents of vectors and cons cells. Does not copy symbols. Copies strings without text properties. */) @@ -4834,7 +4834,7 @@ inhibit_garbage_collection (void) } -DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", +DEFUE ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", doc: /* Reclaim storage for Lisp objects no longer needed. Garbage collection happens automatically if you cons more than `gc-cons-threshold' bytes of Lisp data since previous garbage collection. -- cgit v1.2.1 From 955cbe7b1720f09b2991b7d981147d9cc79d52e3 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 10 Apr 2011 20:39:45 -0700 Subject: Declare Lisp_Object Q* variables to be 'static' if not exproted. This makes it easier for human readers (and static analyzers) to see whether these variables are used from other modules. * alloc.c, buffer.c, bytecode.c, callint.c, casetab.c, category.c: * ccl.c, character.c, charset.c, cmds.c, coding.c, composite.c: * data.c, dbusbind.c, dired.c, editfns.c, eval.c, fileio.c, fns.c: * font.c, frame.c, fringe.c, ftfont.c, image.c, keyboard.c, keymap.c: * lread.c, macros.c, minibuf.c, print.c, process.c, search.c: * sound.c, syntax.c, textprop.c, window.c, xdisp.c, xfaces.c, xfns.c: * xmenu.c, xselect.c: Declare Q* vars static if they are not used in other modules. * ccl.h, character.h, charset.h, coding.h, composite.h, font.h: * frame.h, intervals.h, keyboard.h, lisp.h, process.h, syntax.h: Remove decls of unexported vars. * keyboard.h (EVENT_HEAD_UNMODIFIED): Remove now-unused macro. --- src/alloc.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 1396586ba3e..ad3dfa96cd2 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -264,11 +264,12 @@ static size_t stack_copy_size; static int ignore_warnings; -Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots; +static Lisp_Object Qgc_cons_threshold; +Lisp_Object Qchar_table_extra_slots; /* Hook run after GC has finished. */ -Lisp_Object Qpost_gc_hook; +static Lisp_Object Qpost_gc_hook; static void mark_buffer (Lisp_Object); static void mark_terminals (void); -- cgit v1.2.1 From 244ed9077fe7ccebbc15c7157cb45832f46a46d3 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 10 Apr 2011 21:39:49 -0700 Subject: alloc.c: Import and export fewer symbols, and remove unused items. * lisp.h (suppress_checking, die): Declare only if ENABLE_CHECKING is defined. (suppress_checking): Add EXTERNALLY_VISIBLE attribute, so that it's not optimized away by whole-program optimization. (message_enable_multibyte, free_misc): Remove. (catchlist, handlerlist, mark_backtrace): Declare only if BYTE_MARK_STACK. (mark_byte_stack): Likewise, fixing a ifdef-vs-if typo. * alloc.c (pure): Export only if VIRT_ADDR_VARIES is defined. (message_enable_multibyte): Remove decl. (free_misc, interval_free_list, float_block, float_block_index): (n_float_blocks, float_free_list, cons_block, cons_block_index): (cons_free_list, last_marked_index): Now static. (suppress_checking, die): Define only if ENABLE_CHECKING is defined. * eval.c (catchlist, handlerlist): Export only if BYTE_MARK_STACK. (mark_backtrace): Define only if BYTE_MARK_STACK. * xdisp.c (message_enable_multibyte): Now static. --- src/alloc.c | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index ad3dfa96cd2..7803ccdc976 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -212,6 +212,9 @@ static int malloc_hysteresis; remapping on more recent systems because this is less important nowadays than in the days of small memories and timesharing. */ +#ifndef VIRT_ADDR_VARIES +static +#endif EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,}; #define PUREBEG (char *) pure @@ -281,8 +284,7 @@ static struct Lisp_String *allocate_string (void); static void compact_small_strings (void); static void free_large_strings (void); static void sweep_strings (void); - -extern int message_enable_multibyte; +static void free_misc (Lisp_Object); /* When scanning the C stack for live Lisp objects, Emacs keeps track of what memory allocated via lisp_malloc is intended for what @@ -1341,7 +1343,7 @@ static int total_free_intervals, total_intervals; /* List of free intervals. */ -INTERVAL interval_free_list; +static INTERVAL interval_free_list; /* Total number of interval blocks now in use. */ @@ -2460,19 +2462,19 @@ struct float_block /* Current float_block. */ -struct float_block *float_block; +static struct float_block *float_block; /* Index of first unused Lisp_Float in the current float_block. */ -int float_block_index; +static int float_block_index; /* Total number of float blocks now in use. */ -int n_float_blocks; +static int n_float_blocks; /* Free-list of Lisp_Floats. */ -struct Lisp_Float *float_free_list; +static struct Lisp_Float *float_free_list; /* Initialize float allocation. */ @@ -2572,15 +2574,15 @@ struct cons_block /* Current cons_block. */ -struct cons_block *cons_block; +static struct cons_block *cons_block; /* Index of first unused Lisp_Cons in the current block. */ -int cons_block_index; +static int cons_block_index; /* Free-list of Lisp_Cons structures. */ -struct Lisp_Cons *cons_free_list; +static struct Lisp_Cons *cons_free_list; /* Total number of cons blocks now in use. */ @@ -3168,7 +3170,7 @@ allocate_misc (void) /* Free a Lisp_Misc object */ -void +static void free_misc (Lisp_Object misc) { XMISCTYPE (misc) = Lisp_Misc_Free; @@ -5216,7 +5218,7 @@ mark_face_cache (struct face_cache *c) #define LAST_MARKED_SIZE 500 static Lisp_Object last_marked[LAST_MARKED_SIZE]; -int last_marked_index; +static int last_marked_index; /* For debugging--call abort when we cdr down this many links of a list, in mark_object. In debugging, @@ -6108,6 +6110,7 @@ Frames, windows, buffers, and subprocesses count as vectors return Flist (8, consed); } +#ifdef ENABLE_CHECKING int suppress_checking; void @@ -6117,6 +6120,7 @@ die (const char *msg, const char *file, int line) file, line, msg); abort (); } +#endif /* Initialization */ -- cgit v1.2.1 From e7974947bc66f311e3883bb19aec11f3fe4dc7f6 Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Tue, 12 Apr 2011 12:20:32 +0200 Subject: * alloc.c (overrun_check_malloc, overrun_check_realloc) (overrun_check_free): Protoize. --- src/alloc.c | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 54c4760abab..6a018b87029 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -559,8 +559,7 @@ static int check_depth; /* Like malloc, but wraps allocated block with header and trailer. */ POINTER_TYPE * -overrun_check_malloc (size) - size_t size; +overrun_check_malloc (size_t size) { register unsigned char *val; size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0; @@ -584,11 +583,9 @@ overrun_check_malloc (size) with header and trailer. */ POINTER_TYPE * -overrun_check_realloc (block, size) - POINTER_TYPE *block; - size_t size; +overrun_check_realloc (POINTER_TYPE *block, size_t size) { - register unsigned char *val = (unsigned char *)block; + register unsigned char *val = (unsigned char *) block; size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0; if (val @@ -624,10 +621,9 @@ overrun_check_realloc (block, size) /* Like free, but checks block for overrun. */ void -overrun_check_free (block) - POINTER_TYPE *block; +overrun_check_free (POINTER_TYPE *block) { - unsigned char *val = (unsigned char *)block; + unsigned char *val = (unsigned char *) block; ++check_depth; if (val -- cgit v1.2.1 From a7ca3326c4740ed3ed118b794d35d235de49f346 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 13 Apr 2011 22:04:02 -0700 Subject: Undo the DEFUN->DEFUE change. --- src/alloc.c | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 7803ccdc976..d1d6323f905 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2177,7 +2177,7 @@ compact_small_strings (void) } -DEFUE ("make-string", Fmake_string, Smake_string, 2, 2, 0, +DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, doc: /* Return a newly created string of length LENGTH, with INIT in each element. LENGTH must be an integer. INIT must be an integer that represents a character. */) @@ -2225,7 +2225,7 @@ INIT must be an integer that represents a character. */) } -DEFUE ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, +DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, doc: /* Return a new bool-vector of length LENGTH, using INIT for each element. LENGTH must be a number. INIT matters only in whether it is t or nil. */) (Lisp_Object length, Lisp_Object init) @@ -2613,7 +2613,7 @@ free_cons (struct Lisp_Cons *ptr) cons_free_list = ptr; } -DEFUE ("cons", Fcons, Scons, 2, 2, 0, +DEFUN ("cons", Fcons, Scons, 2, 2, 0, doc: /* Create a new cons, give it CAR and CDR as components, and return it. */) (Lisp_Object car, Lisp_Object cdr) { @@ -2706,7 +2706,7 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, L } -DEFUE ("list", Flist, Slist, 0, MANY, 0, +DEFUN ("list", Flist, Slist, 0, MANY, 0, doc: /* Return a newly created list with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (list &rest OBJECTS) */) @@ -2724,7 +2724,7 @@ usage: (list &rest OBJECTS) */) } -DEFUE ("make-list", Fmake_list, Smake_list, 2, 2, 0, +DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, doc: /* Return a newly created list of length LENGTH, with each element being INIT. */) (register Lisp_Object length, Lisp_Object init) { @@ -2900,7 +2900,7 @@ allocate_process (void) } -DEFUE ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, +DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, doc: /* Return a newly created vector of length LENGTH, with each element being INIT. See also the function `vector'. */) (register Lisp_Object length, Lisp_Object init) @@ -2922,7 +2922,7 @@ See also the function `vector'. */) } -DEFUE ("vector", Fvector, Svector, 0, MANY, 0, +DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (vector &rest OBJECTS) */) @@ -2941,7 +2941,7 @@ usage: (vector &rest OBJECTS) */) } -DEFUE ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, +DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, doc: /* Create a byte-code object with specified arguments as elements. The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING, @@ -3036,7 +3036,7 @@ init_symbol (void) } -DEFUE ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, +DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, doc: /* Return a newly allocated uninterned symbol whose name is NAME. Its value and function definition are void, and its property list is nil. */) (Lisp_Object name) @@ -3199,7 +3199,7 @@ make_save_value (void *pointer, int integer) return val; } -DEFUE ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, +DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, doc: /* Return a newly allocated marker which does not point at any place. */) (void) { @@ -3928,7 +3928,7 @@ static int max_live, max_zombies; static double avg_live; -DEFUE ("gc-status", Fgc_status, Sgc_status, 0, 0, "", +DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "", doc: /* Show information about live and zombie objects. */) (void) { @@ -4743,7 +4743,7 @@ make_pure_vector (EMACS_INT len) } -DEFUE ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, +DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, doc: /* Make a copy of object OBJ in pure storage. Recursively copies contents of vectors and cons cells. Does not copy symbols. Copies strings without text properties. */) @@ -4837,7 +4837,7 @@ inhibit_garbage_collection (void) } -DEFUE ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", +DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", doc: /* Reclaim storage for Lisp objects no longer needed. Garbage collection happens automatically if you cons more than `gc-cons-threshold' bytes of Lisp data since previous garbage collection. -- cgit v1.2.1 From 69003fd8410b1d08ad4364af1eb29a4b795f59bb Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 13 Apr 2011 23:15:53 -0700 Subject: 2011-04-14 Paul Eggert * alloc.c (refill_memory_reserve): Now static if !defined REL_ALLOC || defined SYSTEM_MALLOC. * lisp.h (refill_memory_reserve): Declare only if not static. --- src/alloc.c | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index d1d6323f905..1c793c985eb 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -280,6 +280,9 @@ static void gc_sweep (void); static void mark_glyph_matrix (struct glyph_matrix *); static void mark_face_cache (struct face_cache *); +#if !defined REL_ALLOC || defined SYSTEM_MALLOC +static void refill_memory_reserve (void); +#endif static struct Lisp_String *allocate_string (void); static void compact_small_strings (void); static void free_large_strings (void); -- cgit v1.2.1 From 4e75f29d3a9eaaaa185d67facb7ba38611045aed Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 16 Apr 2011 14:47:57 -0700 Subject: * alloc.c (bytes_used_when_full, SPARE_MEMORY, BYTES_USED): Define only if needed. --- src/alloc.c | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 16cd183aaa1..412527b41a0 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -139,10 +139,6 @@ static pthread_mutex_t alloc_mutex; #endif /* ! defined HAVE_GTK_AND_PTHREAD */ #endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */ -/* Value of _bytes_used, when spare_memory was freed. */ - -static __malloc_size_t bytes_used_when_full; - /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer to a struct Lisp_String. */ @@ -198,9 +194,11 @@ static int total_free_floats, total_floats; static char *spare_memory[7]; +#ifndef SYSTEM_MALLOC /* Amount of spare memory to keep in large reserve block. */ #define SPARE_MEMORY (1 << 14) +#endif /* Number of extra blocks malloc should get when it needs more core. */ @@ -469,13 +467,6 @@ display_malloc_warning (void) intern ("emergency")); pending_malloc_warning = 0; } - - -#ifdef DOUG_LEA_MALLOC -# define BYTES_USED (mallinfo ().uordblks) -#else -# define BYTES_USED _bytes_used -#endif /* Called if we can't allocate relocatable space for a buffer. */ @@ -1096,8 +1087,18 @@ static void * (*old_malloc_hook) (size_t, const void *); static void * (*old_realloc_hook) (void *, size_t, const void*); static void (*old_free_hook) (void*, const void*); +#ifdef DOUG_LEA_MALLOC +# define BYTES_USED (mallinfo ().uordblks) +#else +# define BYTES_USED _bytes_used +#endif + static __malloc_size_t bytes_used_when_reconsidered; +/* Value of _bytes_used, when spare_memory was freed. */ + +static __malloc_size_t bytes_used_when_full; + /* This function is used as the hook for free to call. */ static void @@ -3296,7 +3297,7 @@ memory_full (void) /* Record the space now used. When it decreases substantially, we can refill the memory reserve. */ -#ifndef SYSTEM_MALLOC +#if !defined SYSTEM_MALLOC && !defined SYNC_INPUT bytes_used_when_full = BYTES_USED; #endif -- cgit v1.2.1 From 0b432f213c529745b3a8315db6356199fde2ec25 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Apr 2011 21:08:35 -0700 Subject: * alloc.c (BLOCK BYTES): Fix typo by changing "ablock" to "ablocks". This doesn't fix a bug but makes the code clearer. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 412527b41a0..ca4abba9f8d 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -835,7 +835,7 @@ lisp_free (POINTER_TYPE *block) nothing else. */ #define BLOCK_PADDING 0 #define BLOCK_BYTES \ - (BLOCK_ALIGN - sizeof (struct ablock *) - BLOCK_PADDING) + (BLOCK_ALIGN - sizeof (struct ablocks *) - BLOCK_PADDING) /* Internal data structures and constants. */ -- cgit v1.2.1 From 83998b7a924b8362ec0c5650aa2c2911ac96cf70 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Apr 2011 21:11:56 -0700 Subject: Fix typo in comment. --- src/alloc.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index ca4abba9f8d..8e0cf5d43e1 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1521,14 +1521,13 @@ struct sdata union { - /* When STRING in non-null. */ + /* When STRING is non-null. */ unsigned char data[1]; /* When STRING is null. */ EMACS_INT nbytes; } u; - #define SDATA_NBYTES(S) (S)->u.nbytes #define SDATA_DATA(S) (S)->u.data -- cgit v1.2.1 From bfd1c7811d3661512b382906334ac959d332735b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Apr 2011 21:13:51 -0700 Subject: * alloc.c (string_overrun_cookie): Now const. Use initializers that don't formally overflow signed char, to avoid warnings. --- src/alloc.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 8e0cf5d43e1..2029383dec8 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1628,8 +1628,8 @@ static EMACS_INT total_string_size; presence of this cookie during GC. */ #define GC_STRING_OVERRUN_COOKIE_SIZE 4 -static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = - { 0xde, 0xad, 0xbe, 0xef }; +static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = + { '\xde', '\xad', '\xbe', '\xef' }; #else #define GC_STRING_OVERRUN_COOKIE_SIZE 0 -- cgit v1.2.1 From 000098c13577337d3bb8cb381bd16701dc11cc32 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Apr 2011 21:16:47 -0700 Subject: * alloc.c (allocate_string_data) [GC_CHECK_STRING_OVERRUN]: Fix typo that can cause Emacs to crash when string overrun checking is enabled. --- src/alloc.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 2029383dec8..2af75e3c471 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1937,7 +1937,8 @@ allocate_string_data (struct Lisp_String *s, s->size_byte = nbytes; s->data[nbytes] = '\0'; #ifdef GC_CHECK_STRING_OVERRUN - memcpy (data + needed, string_overrun_cookie, GC_STRING_OVERRUN_COOKIE_SIZE); + memcpy ((char *) data + needed, string_overrun_cookie, + GC_STRING_OVERRUN_COOKIE_SIZE); #endif /* If S had already data assigned, mark that as free by setting its -- cgit v1.2.1 From c7bda33cad5112de8c093dce0eaf62c84fb32063 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Apr 2011 21:25:27 -0700 Subject: * alloc.c (allocate_buffer): Don't assume sizeof (struct buffer) is a multiple of sizeof (EMACS_INT); it need not be, if alignof(EMACS_INT) < sizeof (EMACS_INT). --- src/alloc.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 2af75e3c471..2d1c8ffe70b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1055,7 +1055,8 @@ allocate_buffer (void) struct buffer *b = (struct buffer *) lisp_malloc (sizeof (struct buffer), MEM_TYPE_BUFFER); - b->size = sizeof (struct buffer) / sizeof (EMACS_INT); + b->size = ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1) + / sizeof (EMACS_INT)); XSETPVECTYPE (b, PVEC_BUFFER); return b; } -- cgit v1.2.1 From 36372bf93fc75b5f85d04007268e98840d1699c5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Apr 2011 21:41:29 -0700 Subject: * alloc.c: Remove unportable assumptions about struct layout. (SDATA_SELECTOR, SDATA_DATA_OFFSET): New macros. (SDATA_OF_STRING, SDATA_SIZE, allocate_string_data): (allocate_vectorlike, make_pure_vector): Use the new macros, plus offsetof, to remove unportable assumptions about struct layout. These assumptions hold on all porting targets that I know of, but they are not guaranteed, they're easy to remove, and removing them makes further changes easier. --- src/alloc.c | 32 +++++++++++++------------------- 1 file changed, 13 insertions(+), 19 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 2d1c8ffe70b..fbc075be3be 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1517,6 +1517,7 @@ struct sdata #define SDATA_NBYTES(S) (S)->nbytes #define SDATA_DATA(S) (S)->data +#define SDATA_SELECTOR(member) member #else /* not GC_CHECK_STRING_BYTES */ @@ -1531,8 +1532,11 @@ struct sdata #define SDATA_NBYTES(S) (S)->u.nbytes #define SDATA_DATA(S) (S)->u.data +#define SDATA_SELECTOR(member) u.member #endif /* not GC_CHECK_STRING_BYTES */ + +#define SDATA_DATA_OFFSET offsetof (struct sdata, SDATA_SELECTOR (data)) }; @@ -1608,18 +1612,7 @@ static EMACS_INT total_string_size; a pointer to the `u.data' member of its sdata structure; the structure starts at a constant offset in front of that. */ -#ifdef GC_CHECK_STRING_BYTES - -#define SDATA_OF_STRING(S) \ - ((struct sdata *) ((S)->data - sizeof (struct Lisp_String *) \ - - sizeof (EMACS_INT))) - -#else /* not GC_CHECK_STRING_BYTES */ - -#define SDATA_OF_STRING(S) \ - ((struct sdata *) ((S)->data - sizeof (struct Lisp_String *))) - -#endif /* not GC_CHECK_STRING_BYTES */ +#define SDATA_OF_STRING(S) ((struct sdata *) ((S)->data - SDATA_DATA_OFFSET)) #ifdef GC_CHECK_STRING_OVERRUN @@ -1643,17 +1636,16 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = #ifdef GC_CHECK_STRING_BYTES #define SDATA_SIZE(NBYTES) \ - ((sizeof (struct Lisp_String *) \ + ((SDATA_DATA_OFFSET \ + (NBYTES) + 1 \ - + sizeof (EMACS_INT) \ + sizeof (EMACS_INT) - 1) \ & ~(sizeof (EMACS_INT) - 1)) #else /* not GC_CHECK_STRING_BYTES */ #define SDATA_SIZE(NBYTES) \ - ((sizeof (struct Lisp_String *) \ - + (NBYTES) + 1 \ + ((SDATA_DATA_OFFSET \ + + max (NBYTES, sizeof (EMACS_INT) - 1) + 1 \ + sizeof (EMACS_INT) - 1) \ & ~(sizeof (EMACS_INT) - 1)) @@ -1877,7 +1869,7 @@ allocate_string_data (struct Lisp_String *s, if (nbytes > LARGE_STRING_BYTES) { - size_t size = sizeof *b - sizeof (struct sdata) + needed; + size_t size = offsetof (struct sblock, first_data) + needed; #ifdef DOUG_LEA_MALLOC /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed @@ -2807,7 +2799,8 @@ allocate_vectorlike (EMACS_INT len) /* This gets triggered by code which I haven't bothered to fix. --Stef */ /* eassert (!handling_signal); */ - nbytes = sizeof *p + (len - 1) * sizeof p->contents[0]; + nbytes = (offsetof (struct Lisp_Vector, contents) + + len * sizeof p->contents[0]); p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); #ifdef DOUG_LEA_MALLOC @@ -4735,7 +4728,8 @@ make_pure_vector (EMACS_INT len) { Lisp_Object new; struct Lisp_Vector *p; - size_t size = sizeof *p + (len - 1) * sizeof (Lisp_Object); + size_t size = (offsetof (struct Lisp_Vector, contents) + + len * sizeof (Lisp_Object)); p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike); XSETVECTOR (new, p); -- cgit v1.2.1 From d0f4e1f5ac162d9c32381c65a0bc7b456e189826 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Apr 2011 21:45:15 -0700 Subject: * alloc.c (check_sblock, check_string_bytes, check_string_free_list): Protoize. --- src/alloc.c | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index fbc075be3be..f2aeaa938eb 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1674,9 +1674,6 @@ init_strings (void) static int check_string_bytes_count; -static void check_string_bytes (int); -static void check_sblock (struct sblock *); - #define CHECK_STRING_BYTES(S) STRING_BYTES (S) @@ -1698,8 +1695,7 @@ string_bytes (struct Lisp_String *s) /* Check validity of Lisp strings' string_bytes member in B. */ static void -check_sblock (b) - struct sblock *b; +check_sblock (struct sblock *b) { struct sdata *from, *end, *from_end; @@ -1732,8 +1728,7 @@ check_sblock (b) recently allocated strings. Used for hunting a bug. */ static void -check_string_bytes (all_p) - int all_p; +check_string_bytes (int all_p) { if (all_p) { @@ -1761,7 +1756,7 @@ check_string_bytes (all_p) This may catch buffer overrun from a previous string. */ static void -check_string_free_list () +check_string_free_list (void) { struct Lisp_String *s; -- cgit v1.2.1 From c2982e87d382f0b5c00a65e63716c2b43d342881 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 18 Apr 2011 17:34:42 -0700 Subject: Replace pEd with more-general pI, and fix some printf arg casts. * lisp.h (pI): New macro, generalizing old pEd macro to other conversion specifiers. For example, use "...%"pI"d..." rather than "...%"pEd"...". (pEd): Remove. All uses replaced with similar uses of pI. * src/m/amdx86-64.h, src/m/ia64.h, src/m/ibms390x.h: Likewise. * alloc.c (check_pure_size): Don't overflow by converting size to int. * bidi.c (bidi_dump_cached_states): Use pI to avoid cast. * data.c (Fnumber_to_string): Use pI instead of if-then-else-abort. * dbusbind.c (xd_append_arg): Use pI to avoid cast. (Fdbus_method_return_internal, Fdbus_method_error_internal): Likewise. * font.c (font_unparse_xlfd): Avoid potential buffer overrun on 64-bit hosts. (font_unparse_xlfd, font_unparse_fcname): Use pI to avoid casts. * keyboard.c (record_char, modify_event_symbol): Use pI to avoid casts. * print.c (safe_debug_print, print_object): Likewise. (print_object): Don't overflow by converting EMACS_INT or EMACS_UINT to int. Use pI instead of if-then-else-abort. Use %p to avoid casts. * process.c (Fmake_network_process): Use pI to avoid cast. * region-cache.c (pp_cache): Likewise. * xdisp.c (decode_mode_spec): Likewise. * xrdb.c (x_load_resources) [USE_MOTIF]: Use pI to avoid undefined behavior on 64-bit hosts with printf arg. * xselect.c (x_queue_event): Use %p to avoid casts. (x_stop_queuing_selection_requests): Likewise. (x_get_window_property): Don't truncate byte count to an 'int' when tracing. --- src/alloc.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index f2aeaa938eb..423c1f167db 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4563,8 +4563,9 @@ void check_pure_size (void) { if (pure_bytes_used_before_overflow) - message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)", - (int) (pure_bytes_used + pure_bytes_used_before_overflow)); + message (("emacs:0:Pure Lisp storage overflow (approx. %"pI"d" + " bytes needed)"), + pure_bytes_used + pure_bytes_used_before_overflow); } -- cgit v1.2.1 From 3c616cfa1341ea3dd54dd8b1927213e5e21aa322 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 18 Apr 2011 17:42:41 -0700 Subject: * alloc.c (compact_small_strings): Tighten assertion a little. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 423c1f167db..82be8a903b4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2140,7 +2140,7 @@ compact_small_strings (void) /* Copy, and update the string's `data' pointer. */ if (from != to) { - xassert (tb != b || to <= from); + xassert (tb != b || to < from); memmove (to, from, nbytes + GC_STRING_EXTRA); to->string->data = SDATA_DATA (to); } -- cgit v1.2.1 From f2d3008d3ce90e30e347f184d6394f96f04dae3c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 19 Apr 2011 12:10:31 -0700 Subject: * alloc.c (SDATA_SIZE) [!GC_CHECK_STRING_BYTES]: Avoid runtime check in the common case where SDATA_DATA_OFFSET is a multiple of Emacs word size. --- src/alloc.c | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 82be8a903b4..8be6371d247 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1643,10 +1643,18 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = #else /* not GC_CHECK_STRING_BYTES */ -#define SDATA_SIZE(NBYTES) \ - ((SDATA_DATA_OFFSET \ - + max (NBYTES, sizeof (EMACS_INT) - 1) + 1 \ - + sizeof (EMACS_INT) - 1) \ +/* The 'max' reserves space for the nbytes union member even when NBYTES + 1 is + less than the size of that member. The 'max' is not needed when + SDATA_DATA_OFFSET is a multiple of sizeof (EMACS_INT), because then the + alignment code reserves enough space. */ + +#define SDATA_SIZE(NBYTES) \ + ((SDATA_DATA_OFFSET \ + + (SDATA_DATA_OFFSET % sizeof (EMACS_INT) == 0 \ + ? NBYTES \ + : max (NBYTES, sizeof (EMACS_INT) - 1)) \ + + 1 \ + + sizeof (EMACS_INT) - 1) \ & ~(sizeof (EMACS_INT) - 1)) #endif /* not GC_CHECK_STRING_BYTES */ -- cgit v1.2.1 From 2538aa2f5f92dd8878652d299e7d6ebabc352075 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 20 Apr 2011 00:11:43 -0700 Subject: * alloc.c (overrun_check_malloc, overrun_check_realloc): Now static. (overrun_check_free): Likewise. --- src/alloc.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 8be6371d247..dd27303428f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -555,7 +555,7 @@ static int check_depth; /* Like malloc, but wraps allocated block with header and trailer. */ -POINTER_TYPE * +static POINTER_TYPE * overrun_check_malloc (size_t size) { register unsigned char *val; @@ -579,7 +579,7 @@ overrun_check_malloc (size_t size) /* Like realloc, but checks old block for overrun, and wraps new block with header and trailer. */ -POINTER_TYPE * +static POINTER_TYPE * overrun_check_realloc (POINTER_TYPE *block, size_t size) { register unsigned char *val = (unsigned char *) block; @@ -617,7 +617,7 @@ overrun_check_realloc (POINTER_TYPE *block, size_t size) /* Like free, but checks block for overrun. */ -void +static void overrun_check_free (POINTER_TYPE *block) { unsigned char *val = (unsigned char *) block; -- cgit v1.2.1 From eab3844f965646b62e242aa622754b86d1fd3444 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 25 Apr 2011 00:14:46 -0700 Subject: lisp.h: Fix a problem with aliasing and vector headers. GCC 4.6.0 optimizes based on type-based alias analysis. For example, if b is of type struct buffer * and v of type struct Lisp_Vector *, then gcc -O2 was incorrectly assuming that &b->size != &v->size, and therefore "v->size = 1; b->size = 2; return v->size;" must therefore return 1. This assumption is incorrect for Emacs, since it type-puns struct Lisp_Vector * with many other types. To fix this problem, this patch adds a new type struct vector_header that documents the constraints on layout of vectors and pseudovectors, and helps optimizing compilers not get fooled by Emacs's type punning. It also adds the macros XSETTYPED_PVECTYPE XSETTYPED_PSEUDOVECTOR, TYPED_PSEUDOVECTORP, for similar reasons. * lisp.h (XVECTOR_SIZE): New convenience macro. All previous uses of XVECTOR (foo)->size replaced to use this macro, to avoid the hassle of writing XVECTOR (foo)->header.size. (XVECTOR_HEADER_SIZE): New macro, for use in XSETPSEUDOVECTOR. (XSETTYPED_PVECTYPE): New macro, specifying the name of the size member. (XSETPVECTYPE): Rewrite in terms of new macro. (XSETPVECTYPESIZE): New macro, specifying both type and size. This is a bit clearer, and further avoids the possibility of undesirable aliasing. (XSETTYPED_PSEUDOVECTOR): New macro, specifying the size. (XSETPSEUDOVECTOR): Rewrite in terms of XSETTYPED_PSEUDOVECTOR and XVECTOR_HEADER_SIZE. (XSETSUBR): Rewrite in terms of XSETTYPED_PSEUDOVECTOR and XSIZE, since Lisp_Subr is a special case (no "next" field). (ASIZE): Rewrite in terms of XVECTOR_SIZE. (struct vector_header): New type. (TYPED_PSEUDOVECTORP): New macro, also specifying the C type of the object, to help avoid aliasing. (PSEUDOVECTORP): Rewrite in terms of TYPED_PSEUDOVECTORP. (SUBRP): Likewise, since Lisp_Subr is a special case. * lisp.h (struct Lisp_Vector, struct Lisp_Char_Table): (struct Lisp_Sub_Char_Table, struct Lisp_Bool_Vector): (struct Lisp_Hash_Table): Combine first two members into a single struct vector_header member. All uses of "size" and "next" members changed to be "header.size" and "header.next". * buffer.h (struct buffer): Likewise. * font.h (struct font_spec, struct font_entity, struct font): Likewise. * frame.h (struct frame): Likewise. * process.h (struct Lisp_Process): Likewise. * termhooks.h (struct terminal): Likewise. * window.c (struct save_window_data, struct saved_window): Likewise. * window.h (struct window): Likewise. * alloc.c (allocate_buffer, Fmake_bool_vector, allocate_pseudovector): Use XSETPVECTYPESIZE, not XSETPVECTYPE, to avoid aliasing problems. * buffer.c (init_buffer_once): Likewise. * lread.c (defsubr): Use XSETTYPED_PVECTYPE, since Lisp_Subr is a special case. * process.c (Fformat_network_address): Use local var for size, for brevity. --- src/alloc.c | 63 +++++++++++++++++++++++++++++-------------------------------- 1 file changed, 30 insertions(+), 33 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index dd27303428f..c9496ecf25c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -146,9 +146,9 @@ static pthread_mutex_t alloc_mutex; #define UNMARK_STRING(S) ((S)->size &= ~ARRAY_MARK_FLAG) #define STRING_MARKED_P(S) (((S)->size & ARRAY_MARK_FLAG) != 0) -#define VECTOR_MARK(V) ((V)->size |= ARRAY_MARK_FLAG) -#define VECTOR_UNMARK(V) ((V)->size &= ~ARRAY_MARK_FLAG) -#define VECTOR_MARKED_P(V) (((V)->size & ARRAY_MARK_FLAG) != 0) +#define VECTOR_MARK(V) ((V)->header.size |= ARRAY_MARK_FLAG) +#define VECTOR_UNMARK(V) ((V)->header.size &= ~ARRAY_MARK_FLAG) +#define VECTOR_MARKED_P(V) (((V)->header.size & ARRAY_MARK_FLAG) != 0) /* Value is the number of bytes of S, a pointer to a struct Lisp_String. Be careful during GC, because S->size contains the mark bit for @@ -1055,9 +1055,9 @@ allocate_buffer (void) struct buffer *b = (struct buffer *) lisp_malloc (sizeof (struct buffer), MEM_TYPE_BUFFER); - b->size = ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1) - / sizeof (EMACS_INT)); - XSETPVECTYPE (b, PVEC_BUFFER); + XSETPVECTYPESIZE (b, PVEC_BUFFER, + ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1) + / sizeof (EMACS_INT))); return b; } @@ -2244,10 +2244,8 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) slot `size' of the struct Lisp_Bool_Vector. */ val = Fmake_vector (make_number (length_in_elts + 1), Qnil); - /* Get rid of any bits that would cause confusion. */ - XVECTOR (val)->size = 0; /* No Lisp_Object to trace in there. */ - /* Use XVECTOR (val) rather than `p' because p->size is not TRT. */ - XSETPVECTYPE (XVECTOR (val), PVEC_BOOL_VECTOR); + /* No Lisp_Object to trace in there. */ + XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0); p = XBOOL_VECTOR (val); p->size = XFASTINT (length); @@ -2814,7 +2812,7 @@ allocate_vectorlike (EMACS_INT len) consing_since_gc += nbytes; vector_cells_consed += len; - p->next = all_vectors; + p->header.next.vector = all_vectors; all_vectors = p; MALLOC_UNBLOCK_INPUT; @@ -2830,7 +2828,7 @@ struct Lisp_Vector * allocate_vector (EMACS_INT nslots) { struct Lisp_Vector *v = allocate_vectorlike (nslots); - v->size = nslots; + v->header.size = nslots; return v; } @@ -2844,11 +2842,10 @@ allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag) EMACS_INT i; /* Only the first lisplen slots will be traced normally by the GC. */ - v->size = lisplen; for (i = 0; i < lisplen; ++i) v->contents[i] = Qnil; - XSETPVECTYPE (v, tag); /* Add the appropriate tag. */ + XSETPVECTYPESIZE (v, tag, lisplen); return v; } @@ -4737,7 +4734,7 @@ make_pure_vector (EMACS_INT len) p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike); XSETVECTOR (new, p); - XVECTOR (new)->size = len; + XVECTOR (new)->header.size = len; return new; } @@ -4775,7 +4772,7 @@ Does not copy symbols. Copies strings without text properties. */) register EMACS_INT i; EMACS_INT size; - size = XVECTOR (obj)->size; + size = XVECTOR_SIZE (obj); if (size & PSEUDOVECTOR_FLAG) size &= PSEUDOVECTOR_SIZE_MASK; vec = XVECTOR (make_pure_vector (size)); @@ -4899,7 +4896,7 @@ returns nil, because real GC can't be done. */) } } - nextb = nextb->next; + nextb = nextb->header.next.buffer; } } @@ -5054,7 +5051,7 @@ returns nil, because real GC can't be done. */) undo_list any more, we can finally mark the list. */ mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list)); - nextb = nextb->next; + nextb = nextb->header.next.buffer; } } @@ -5228,7 +5225,7 @@ static size_t mark_object_loop_halt; static void mark_vectorlike (struct Lisp_Vector *ptr) { - register EMACS_UINT size = ptr->size; + register EMACS_UINT size = ptr->header.size; register EMACS_UINT i; eassert (!VECTOR_MARKED_P (ptr)); @@ -5251,7 +5248,7 @@ mark_vectorlike (struct Lisp_Vector *ptr) static void mark_char_table (struct Lisp_Vector *ptr) { - register EMACS_UINT size = ptr->size & PSEUDOVECTOR_SIZE_MASK; + register EMACS_UINT size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; register EMACS_UINT i; eassert (!VECTOR_MARKED_P (ptr)); @@ -5364,7 +5361,7 @@ mark_object (Lisp_Object arg) if (po != &buffer_defaults && po != &buffer_local_symbols) { struct buffer *b; - for (b = all_buffers; b && b != po; b = b->next) + for (b = all_buffers; b && b != po; b = b->header.next) ; if (b == NULL) abort (); @@ -5380,7 +5377,7 @@ mark_object (Lisp_Object arg) recursion there. */ { register struct Lisp_Vector *ptr = XVECTOR (obj); - register EMACS_UINT size = ptr->size; + register EMACS_UINT size = ptr->header.size; register EMACS_UINT i; CHECK_LIVE (live_vector_p); @@ -6012,10 +6009,10 @@ gc_sweep (void) if (!VECTOR_MARKED_P (buffer)) { if (prev) - prev->next = buffer->next; + prev->header.next = buffer->header.next; else - all_buffers = buffer->next; - next = buffer->next; + all_buffers = buffer->header.next.buffer; + next = buffer->header.next.buffer; lisp_free (buffer); buffer = next; } @@ -6023,7 +6020,7 @@ gc_sweep (void) { VECTOR_UNMARK (buffer); UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer)); - prev = buffer, buffer = buffer->next; + prev = buffer, buffer = buffer->header.next.buffer; } } @@ -6036,10 +6033,10 @@ gc_sweep (void) if (!VECTOR_MARKED_P (vector)) { if (prev) - prev->next = vector->next; + prev->header.next = vector->header.next; else - all_vectors = vector->next; - next = vector->next; + all_vectors = vector->header.next.vector; + next = vector->header.next.vector; lisp_free (vector); n_vectors--; vector = next; @@ -6048,11 +6045,11 @@ gc_sweep (void) else { VECTOR_UNMARK (vector); - if (vector->size & PSEUDOVECTOR_FLAG) - total_vector_size += (PSEUDOVECTOR_SIZE_MASK & vector->size); + if (vector->header.size & PSEUDOVECTOR_FLAG) + total_vector_size += PSEUDOVECTOR_SIZE_MASK & vector->header.size; else - total_vector_size += vector->size; - prev = vector, vector = vector->next; + total_vector_size += vector->header.size; + prev = vector, vector = vector->header.next.vector; } } -- cgit v1.2.1 From 179dade40292e5bdccdd4ab88748a06a94307570 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 25 Apr 2011 00:33:57 -0700 Subject: Fix minor typos in previous change. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index c9496ecf25c..0de83f02f65 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5361,7 +5361,7 @@ mark_object (Lisp_Object arg) if (po != &buffer_defaults && po != &buffer_local_symbols) { struct buffer *b; - for (b = all_buffers; b && b != po; b = b->header.next) + for (b = all_buffers; b && b != po; b = b->header.next.buffer) ; if (b == NULL) abort (); -- cgit v1.2.1 From 77b37c05572d1028d0ec2c264ac0ed3a89c0f4da Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 25 Apr 2011 14:34:39 -0700 Subject: * lisp.h: (XVECTOR_SIZE): Remove. All uses replaced with ASIZE. (ASIZE): Now contains previous implementation of XVECTOR_SIZE instead of invoking XVECTOR_SIZE. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 0de83f02f65..842088f4e92 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4772,7 +4772,7 @@ Does not copy symbols. Copies strings without text properties. */) register EMACS_INT i; EMACS_INT size; - size = XVECTOR_SIZE (obj); + size = ASIZE (obj); if (size & PSEUDOVECTOR_FLAG) size &= PSEUDOVECTOR_SIZE_MASK; vec = XVECTOR (make_pure_vector (size)); -- cgit v1.2.1 From 8ac068ac0c00afa85bc4df54032b7a855c639312 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 29 Apr 2011 00:54:43 -0700 Subject: Prefer intptr_t/uintptr_t for integers the same widths as pointers. This removes an assumption that EMACS_INT and long are the same width as pointers. The assumption is true for Emacs porting targets now, but we want to make other targets possible. * lisp.h: Include , for INTPTR_MAX, UINTPTR_MAX. (EMACS_INTPTR, EMACS_UINTPTR): New macros. In the rest of the code, change types of integers that hold casted pointers to EMACS_INTPTR and EMACS_UINTPTR, systematically replacing EMACS_INT, long, EMACS_UINT, and unsigned long. (XTYPE): Don't cast arg to EMACS_UINT; normally is not needed. (XSET): Cast type of XTYPE arg to EMACS_INTPTR; it is needed here. No need to cast type when ORing. (XPNTR): Return a value of type EMACS_INTPTR or EMACS_UINTPTR. * alloc.c (lisp_align_malloc): Remove a no-longer-needed cast. * doc.c (store_function_docstring): Use EMACS_INTPTR, so as not to assume EMACS_INT is the same width as char *. * gtkutil.c (xg_gtk_scroll_destroy, xg_tool_bar_button_cb): (xg_tool_bar_callback, xg_tool_bar_help_callback, xg_make_tool_item): Remove no-longer-needed casts. (xg_create_scroll_bar, xg_tool_bar_button_cb, xg_tool_bar_callback): (xg_tool_bar_help_callback, xg_make_tool_item): Use EMACS_INTPTR to hold an integer that will be cast to void *; this can avoid a GCC warning if EMACS_INT is not the same width as void *. * menu.c (find_and_call_menu_selection): Remove no-longer-needed cast. * xdisp.c (display_echo_area_1, resize_mini_window_1): (current_message_1, set_message_1): Use a local to convert to proper width without a cast. * xmenu.c (dialog_selection_callback): Likewise. --- src/alloc.c | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 842088f4e92..591d8264295 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -438,7 +438,7 @@ static POINTER_TYPE *pure_alloc (size_t, int); ALIGNMENT must be a power of 2. */ #define ALIGN(ptr, ALIGNMENT) \ - ((POINTER_TYPE *) ((((EMACS_UINT)(ptr)) + (ALIGNMENT) - 1) \ + ((POINTER_TYPE *) ((((EMACS_UINTPTR) (ptr)) + (ALIGNMENT) - 1) \ & ~((ALIGNMENT) - 1))) @@ -876,7 +876,7 @@ struct ablocks #define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING) #define ABLOCK_ABASE(block) \ - (((unsigned long) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \ + (((EMACS_UINTPTR) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \ ? (struct ablocks *)(block) \ : (block)->abase) @@ -888,7 +888,7 @@ struct ablocks #define ABLOCKS_BASE(abase) (abase) #else #define ABLOCKS_BASE(abase) \ - (1 & (long) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1]) + (1 & (EMACS_INTPTR) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1]) #endif /* The list of free ablock. */ @@ -914,7 +914,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) if (!free_ablock) { int i; - EMACS_INT aligned; /* int gets warning casting to 64-bit pointer. */ + EMACS_INTPTR aligned; /* int gets warning casting to 64-bit pointer. */ #ifdef DOUG_LEA_MALLOC /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed @@ -977,17 +977,18 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) abase->blocks[i].x.next_free = free_ablock; free_ablock = &abase->blocks[i]; } - ABLOCKS_BUSY (abase) = (struct ablocks *) (long) aligned; + ABLOCKS_BUSY (abase) = (struct ablocks *) aligned; - eassert (0 == ((EMACS_UINT)abase) % BLOCK_ALIGN); + eassert (0 == ((EMACS_UINTPTR) abase) % BLOCK_ALIGN); eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */ eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase); eassert (ABLOCKS_BASE (abase) == base); - eassert (aligned == (long) ABLOCKS_BUSY (abase)); + eassert (aligned == (EMACS_INTPTR) ABLOCKS_BUSY (abase)); } abase = ABLOCK_ABASE (free_ablock); - ABLOCKS_BUSY (abase) = (struct ablocks *) (2 + (long) ABLOCKS_BUSY (abase)); + ABLOCKS_BUSY (abase) = + (struct ablocks *) (2 + (EMACS_INTPTR) ABLOCKS_BUSY (abase)); val = free_ablock; free_ablock = free_ablock->x.next_free; @@ -1000,7 +1001,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) if (!val && nbytes) memory_full (); - eassert (0 == ((EMACS_UINT)val) % BLOCK_ALIGN); + eassert (0 == ((EMACS_UINTPTR) val) % BLOCK_ALIGN); return val; } @@ -1018,11 +1019,12 @@ lisp_align_free (POINTER_TYPE *block) ablock->x.next_free = free_ablock; free_ablock = ablock; /* Update busy count. */ - ABLOCKS_BUSY (abase) = (struct ablocks *) (-2 + (long) ABLOCKS_BUSY (abase)); + ABLOCKS_BUSY (abase) = + (struct ablocks *) (-2 + (EMACS_INTPTR) ABLOCKS_BUSY (abase)); - if (2 > (long) ABLOCKS_BUSY (abase)) + if (2 > (EMACS_INTPTR) ABLOCKS_BUSY (abase)) { /* All the blocks are free. */ - int i = 0, aligned = (long) ABLOCKS_BUSY (abase); + int i = 0, aligned = (EMACS_INTPTR) ABLOCKS_BUSY (abase); struct ablock **tem = &free_ablock; struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1]; @@ -1039,7 +1041,7 @@ lisp_align_free (POINTER_TYPE *block) eassert ((aligned & 1) == aligned); eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1)); #ifdef USE_POSIX_MEMALIGN - eassert ((unsigned long)ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0); + eassert ((EMACS_UINTPTR) ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0); #endif free (ABLOCKS_BASE (abase)); } @@ -1772,7 +1774,7 @@ check_string_free_list (void) s = string_free_list; while (s != NULL) { - if ((unsigned long)s < 1024) + if ((EMACS_UINTPTR) s < 1024) abort(); s = NEXT_FREE_LISP_STRING (s); } @@ -2432,10 +2434,10 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) &= ~(1 << ((n) % (sizeof(int) * CHAR_BIT))) #define FLOAT_BLOCK(fptr) \ - ((struct float_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1))) + ((struct float_block *) (((EMACS_UINTPTR) (fptr)) & ~(BLOCK_ALIGN - 1))) #define FLOAT_INDEX(fptr) \ - ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float)) + ((((EMACS_UINTPTR) (fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float)) struct float_block { @@ -2544,10 +2546,10 @@ make_float (double float_value) / (sizeof (struct Lisp_Cons) * CHAR_BIT + 1)) #define CONS_BLOCK(fptr) \ - ((struct cons_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1))) + ((struct cons_block *) ((EMACS_UINTPTR) (fptr) & ~(BLOCK_ALIGN - 1))) #define CONS_INDEX(fptr) \ - ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons)) + (((EMACS_UINTPTR) (fptr) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons)) struct cons_block { @@ -4021,7 +4023,7 @@ mark_maybe_pointer (void *p) struct mem_node *m; /* Quickly rule out some values which can't point to Lisp data. */ - if ((EMACS_INT) p % + if ((EMACS_INTPTR) p % #ifdef USE_LSB_TAG 8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */ #else @@ -6072,7 +6074,7 @@ We divide the value by 1024 to make sure it fits in a Lisp integer. */) { Lisp_Object end; - XSETINT (end, (EMACS_INT) (char *) sbrk (0) / 1024); + XSETINT (end, (EMACS_INTPTR) (char *) sbrk (0) / 1024); return end; } -- cgit v1.2.1 From d01a78266d12561b46777a2156914d12d8099c4f Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 29 Apr 2011 10:56:27 -0700 Subject: * lisp.h (EMACS_INTPTR): Remove. All uses changed to intptr_t. (EMACS_UINTPTR): Likewise, with uintptr_t. --- src/alloc.c | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 591d8264295..0bce83bfae7 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -438,7 +438,7 @@ static POINTER_TYPE *pure_alloc (size_t, int); ALIGNMENT must be a power of 2. */ #define ALIGN(ptr, ALIGNMENT) \ - ((POINTER_TYPE *) ((((EMACS_UINTPTR) (ptr)) + (ALIGNMENT) - 1) \ + ((POINTER_TYPE *) ((((uintptr_t) (ptr)) + (ALIGNMENT) - 1) \ & ~((ALIGNMENT) - 1))) @@ -876,7 +876,7 @@ struct ablocks #define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING) #define ABLOCK_ABASE(block) \ - (((EMACS_UINTPTR) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \ + (((uintptr_t) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \ ? (struct ablocks *)(block) \ : (block)->abase) @@ -888,7 +888,7 @@ struct ablocks #define ABLOCKS_BASE(abase) (abase) #else #define ABLOCKS_BASE(abase) \ - (1 & (EMACS_INTPTR) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1]) + (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1]) #endif /* The list of free ablock. */ @@ -914,7 +914,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) if (!free_ablock) { int i; - EMACS_INTPTR aligned; /* int gets warning casting to 64-bit pointer. */ + intptr_t aligned; /* int gets warning casting to 64-bit pointer. */ #ifdef DOUG_LEA_MALLOC /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed @@ -979,16 +979,16 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) } ABLOCKS_BUSY (abase) = (struct ablocks *) aligned; - eassert (0 == ((EMACS_UINTPTR) abase) % BLOCK_ALIGN); + eassert (0 == ((uintptr_t) abase) % BLOCK_ALIGN); eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */ eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase); eassert (ABLOCKS_BASE (abase) == base); - eassert (aligned == (EMACS_INTPTR) ABLOCKS_BUSY (abase)); + eassert (aligned == (intptr_t) ABLOCKS_BUSY (abase)); } abase = ABLOCK_ABASE (free_ablock); ABLOCKS_BUSY (abase) = - (struct ablocks *) (2 + (EMACS_INTPTR) ABLOCKS_BUSY (abase)); + (struct ablocks *) (2 + (intptr_t) ABLOCKS_BUSY (abase)); val = free_ablock; free_ablock = free_ablock->x.next_free; @@ -1001,7 +1001,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) if (!val && nbytes) memory_full (); - eassert (0 == ((EMACS_UINTPTR) val) % BLOCK_ALIGN); + eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN); return val; } @@ -1020,11 +1020,11 @@ lisp_align_free (POINTER_TYPE *block) free_ablock = ablock; /* Update busy count. */ ABLOCKS_BUSY (abase) = - (struct ablocks *) (-2 + (EMACS_INTPTR) ABLOCKS_BUSY (abase)); + (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase)); - if (2 > (EMACS_INTPTR) ABLOCKS_BUSY (abase)) + if (2 > (intptr_t) ABLOCKS_BUSY (abase)) { /* All the blocks are free. */ - int i = 0, aligned = (EMACS_INTPTR) ABLOCKS_BUSY (abase); + int i = 0, aligned = (intptr_t) ABLOCKS_BUSY (abase); struct ablock **tem = &free_ablock; struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1]; @@ -1041,7 +1041,7 @@ lisp_align_free (POINTER_TYPE *block) eassert ((aligned & 1) == aligned); eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1)); #ifdef USE_POSIX_MEMALIGN - eassert ((EMACS_UINTPTR) ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0); + eassert ((uintptr_t) ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0); #endif free (ABLOCKS_BASE (abase)); } @@ -1774,7 +1774,7 @@ check_string_free_list (void) s = string_free_list; while (s != NULL) { - if ((EMACS_UINTPTR) s < 1024) + if ((uintptr_t) s < 1024) abort(); s = NEXT_FREE_LISP_STRING (s); } @@ -2434,10 +2434,10 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) &= ~(1 << ((n) % (sizeof(int) * CHAR_BIT))) #define FLOAT_BLOCK(fptr) \ - ((struct float_block *) (((EMACS_UINTPTR) (fptr)) & ~(BLOCK_ALIGN - 1))) + ((struct float_block *) (((uintptr_t) (fptr)) & ~(BLOCK_ALIGN - 1))) #define FLOAT_INDEX(fptr) \ - ((((EMACS_UINTPTR) (fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float)) + ((((uintptr_t) (fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float)) struct float_block { @@ -2546,10 +2546,10 @@ make_float (double float_value) / (sizeof (struct Lisp_Cons) * CHAR_BIT + 1)) #define CONS_BLOCK(fptr) \ - ((struct cons_block *) ((EMACS_UINTPTR) (fptr) & ~(BLOCK_ALIGN - 1))) + ((struct cons_block *) ((uintptr_t) (fptr) & ~(BLOCK_ALIGN - 1))) #define CONS_INDEX(fptr) \ - (((EMACS_UINTPTR) (fptr) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons)) + (((uintptr_t) (fptr) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons)) struct cons_block { @@ -4023,7 +4023,7 @@ mark_maybe_pointer (void *p) struct mem_node *m; /* Quickly rule out some values which can't point to Lisp data. */ - if ((EMACS_INTPTR) p % + if ((intptr_t) p % #ifdef USE_LSB_TAG 8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */ #else @@ -6074,7 +6074,7 @@ We divide the value by 1024 to make sure it fits in a Lisp integer. */) { Lisp_Object end; - XSETINT (end, (EMACS_INTPTR) (char *) sbrk (0) / 1024); + XSETINT (end, (intptr_t) (char *) sbrk (0) / 1024); return end; } -- cgit v1.2.1 From cb93f9bef01e95b17b3d7b8786c103505355d98c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 15 May 2011 18:11:54 -0700 Subject: * alloc.c (string_overflow): New function. (Fmake_string): Use it. This doesn't change behavior, but saves a few bytes and will simplify future changes. * character.c (string_escape_byte8): Likewise. * lisp.h (string_overflow): New decl. --- src/alloc.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 0bce83bfae7..71ab54bcab5 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2174,6 +2174,11 @@ compact_small_strings (void) current_sblock = tb; } +void +string_overflow (void) +{ + error ("Maximum string size exceeded"); +} DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, doc: /* Return a newly created string of length LENGTH, with INIT in each element. @@ -2206,7 +2211,7 @@ INIT must be an integer that represents a character. */) EMACS_INT string_len = XINT (length); if (string_len > MOST_POSITIVE_FIXNUM / len) - error ("Maximum string size exceeded"); + string_overflow (); nbytes = len * string_len; val = make_uninit_multibyte_string (string_len, nbytes); p = SDATA (val); -- cgit v1.2.1 From c11285dca1ee2896b487fe03408a4c7c356b6d5b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 22 May 2011 17:31:35 -0700 Subject: * alloc.c (make_event_array): Use XINT, not XUINT. There's no need for unsigned here. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 71ab54bcab5..3f7bed571c7 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3244,7 +3244,7 @@ make_event_array (register int nargs, Lisp_Object *args) are characters that are in 0...127, after discarding the meta bit and all the bits above it. */ if (!INTEGERP (args[i]) - || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200) + || (XINT (args[i]) & ~(-CHAR_META)) >= 0200) return Fvector (nargs, args); /* Since the loop exited, we know that all the things in it are -- cgit v1.2.1 From 55d4c1b248e84d347ae73278faff623741f52691 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 28 May 2011 15:39:39 -0700 Subject: [ChangeLog] Use 'inline', not 'INLINE'. * configure.in, autogen/config.in (INLINE): Remove. [lib-src/ChangeLog] Use 'inline', not 'INLINE'. * etags.c (hash): Now inline unconditionally. * make-docfile.c (put_char): inline, not INLINE. [nt/ChangeLog] Use 'inline', not 'INLINE'. * config.nt (INLINE): Remove. [src/ChangeLog] Use 'inline', not 'INLINE'. * alloc.c, fontset.c (INLINE): Remove. * alloc.c, bidi.c, charset.c, coding.c, dispnew.c, fns.c, image.c: * intervals.c, keyboard.c, process.c, syntax.c, textprop.c, w32term.c: * xdisp.c, xfaces.c, xterm.c: Replace all uses of INLINE with inline. * gmalloc.c (register_heapinfo): Use inline unconditionally. * lisp.h (LISP_MAKE_RVALUE): Use inline, not __inline__. --- src/alloc.c | 26 +++++++++++--------------- 1 file changed, 11 insertions(+), 15 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 3f7bed571c7..f62ae125408 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -22,10 +22,6 @@ along with GNU Emacs. If not, see . */ #include /* For CHAR_BIT. */ #include -#ifdef ALLOC_DEBUG -#undef INLINE -#endif - #include #ifdef HAVE_GTK_AND_PTHREAD @@ -408,7 +404,7 @@ static void mem_rotate_left (struct mem_node *); static void mem_rotate_right (struct mem_node *); static void mem_delete (struct mem_node *); static void mem_delete_fixup (struct mem_node *); -static INLINE struct mem_node *mem_find (void *); +static inline struct mem_node *mem_find (void *); #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS @@ -3376,7 +3372,7 @@ mem_init (void) /* Value is a pointer to the mem_node containing START. Value is MEM_NIL if there is no node in the tree containing START. */ -static INLINE struct mem_node * +static inline struct mem_node * mem_find (void *start) { struct mem_node *p; @@ -3752,7 +3748,7 @@ mem_delete_fixup (struct mem_node *x) /* Value is non-zero if P is a pointer to a live Lisp string on the heap. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_string_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_STRING) @@ -3775,7 +3771,7 @@ live_string_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live Lisp cons on the heap. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_cons_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_CONS) @@ -3801,7 +3797,7 @@ live_cons_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live Lisp symbol on the heap. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_symbol_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_SYMBOL) @@ -3827,7 +3823,7 @@ live_symbol_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live Lisp float on the heap. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_float_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_FLOAT) @@ -3851,7 +3847,7 @@ live_float_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live Lisp Misc on the heap. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_misc_p (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_MISC) @@ -3877,7 +3873,7 @@ live_misc_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live vector-like object. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_vector_p (struct mem_node *m, void *p) { return (p == m->start && m->type == MEM_TYPE_VECTORLIKE); @@ -3887,7 +3883,7 @@ live_vector_p (struct mem_node *m, void *p) /* Value is non-zero if P is a pointer to a live buffer. M is a pointer to the mem_block for P. */ -static INLINE int +static inline int live_buffer_p (struct mem_node *m, void *p) { /* P must point to the start of the block, and the buffer @@ -3953,7 +3949,7 @@ DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "", /* Mark OBJ if we can prove it's a Lisp_Object. */ -static INLINE void +static inline void mark_maybe_object (Lisp_Object obj) { void *po; @@ -4022,7 +4018,7 @@ mark_maybe_object (Lisp_Object obj) /* If P points to Lisp data, mark that as live if it isn't already marked. */ -static INLINE void +static inline void mark_maybe_pointer (void *p) { struct mem_node *m; -- cgit v1.2.1 From 3687c2efb7e7a5b6afbf87588a248431ccc8dd65 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 30 May 2011 09:09:29 -0700 Subject: * alloc.c (lisp_align_malloc): Omit unnecessary val==NULL tests. --- src/alloc.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 3f7bed571c7..8215cc53cd3 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -993,13 +993,11 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) free_ablock = free_ablock->x.next_free; #if GC_MARK_STACK && !defined GC_MALLOC_CHECK - if (val && type != MEM_TYPE_NON_LISP) + if (type != MEM_TYPE_NON_LISP) mem_insert (val, (char *) val + nbytes, type); #endif MALLOC_UNBLOCK_INPUT; - if (!val && nbytes) - memory_full (); eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN); return val; -- cgit v1.2.1 From 531b01656f89e093b9fa35959fa41e534b025320 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 30 May 2011 09:47:35 -0700 Subject: [ChangeLog] Malloc failure behavior now depends on size of allocation. * lib/allocator.h (struct allocator.die): New size arg. * lib/careadlinkat.c (careadlinkat): Pass size to 'die' function. If the actual problem is an ssize_t limitation, not a size_t or malloc failure, fail with errno == ENAMETOOLONG instead of calling 'die'. [src/ChangeLog] Malloc failure behavior now depends on size of allocation. * alloc.c (buffer_memory_full, memory_full): New arg NBYTES. * lisp.h: Change signatures accordingly. * alloc.c, buffer.c, editfns.c, menu.c, minibuf.c, xterm.c: All callers changed. --- src/alloc.c | 78 ++++++++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 51 insertions(+), 27 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 8215cc53cd3..be045be2ab4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -471,7 +471,7 @@ display_malloc_warning (void) /* Called if we can't allocate relocatable space for a buffer. */ void -buffer_memory_full (void) +buffer_memory_full (EMACS_INT nbytes) { /* If buffers use the relocating allocator, no need to free spare_memory, because we may have plenty of malloc space left @@ -481,7 +481,7 @@ buffer_memory_full (void) malloc. */ #ifndef REL_ALLOC - memory_full (); + memory_full (nbytes); #endif /* This used to call error, but if we've run out of memory, we could @@ -677,7 +677,7 @@ xmalloc (size_t size) MALLOC_UNBLOCK_INPUT; if (!val && size) - memory_full (); + memory_full (size); return val; } @@ -698,7 +698,8 @@ xrealloc (POINTER_TYPE *block, size_t size) val = (POINTER_TYPE *) realloc (block, size); MALLOC_UNBLOCK_INPUT; - if (!val && size) memory_full (); + if (!val && size) + memory_full (size); return val; } @@ -791,7 +792,7 @@ lisp_malloc (size_t nbytes, enum mem_type type) MALLOC_UNBLOCK_INPUT; if (!val && nbytes) - memory_full (); + memory_full (nbytes); return val; } @@ -938,7 +939,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) if (base == 0) { MALLOC_UNBLOCK_INPUT; - memory_full (); + memory_full (ABLOCKS_BYTES); } aligned = (base == abase); @@ -964,7 +965,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) lisp_malloc_loser = base; free (base); MALLOC_UNBLOCK_INPUT; - memory_full (); + memory_full (SIZE_MAX); } } #endif @@ -3270,35 +3271,58 @@ make_event_array (register int nargs, Lisp_Object *args) ************************************************************************/ -/* Called if malloc returns zero. */ +/* Called if malloc (NBYTES) returns zero. If NBYTES == SIZE_MAX, + there may have been size_t overflow so that malloc was never + called, or perhaps malloc was invoked successfully but the + resulting pointer had problems fitting into a tagged EMACS_INT. In + either case this counts as memory being full even though malloc did + not fail. */ void -memory_full (void) +memory_full (size_t nbytes) { - int i; + /* Do not go into hysterics merely because a large request failed. */ + int enough_free_memory = 0; + if (SPARE_MEMORY < nbytes) + { + void *p = malloc (SPARE_MEMORY); + if (p) + { + if (spare_memory[0]) + free (p); + else + spare_memory[0] = p; + enough_free_memory = 1; + } + } - Vmemory_full = Qt; + if (! enough_free_memory) + { + int i; - memory_full_cons_threshold = sizeof (struct cons_block); + Vmemory_full = Qt; - /* The first time we get here, free the spare memory. */ - for (i = 0; i < sizeof (spare_memory) / sizeof (char *); i++) - if (spare_memory[i]) - { - if (i == 0) - free (spare_memory[i]); - else if (i >= 1 && i <= 4) - lisp_align_free (spare_memory[i]); - else - lisp_free (spare_memory[i]); - spare_memory[i] = 0; - } + memory_full_cons_threshold = sizeof (struct cons_block); + + /* The first time we get here, free the spare memory. */ + for (i = 0; i < sizeof (spare_memory) / sizeof (char *); i++) + if (spare_memory[i]) + { + if (i == 0) + free (spare_memory[i]); + else if (i >= 1 && i <= 4) + lisp_align_free (spare_memory[i]); + else + lisp_free (spare_memory[i]); + spare_memory[i] = 0; + } - /* Record the space now used. When it decreases substantially, - we can refill the memory reserve. */ + /* Record the space now used. When it decreases substantially, + we can refill the memory reserve. */ #if !defined SYSTEM_MALLOC && !defined SYNC_INPUT - bytes_used_when_full = BYTES_USED; + bytes_used_when_full = BYTES_USED; #endif + } /* This used to call error, but if we've run out of memory, we could get infinite recursion trying to build the string. */ -- cgit v1.2.1 From 0de4bb688da4961269edab53dc0e0d5a30c01a44 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 30 May 2011 23:05:00 -0700 Subject: Remove arbitrary limit of 2**31 entries in hash tables. * category.c (hash_get_category_set): Use 'EMACS_UINT' and 'EMACS_INT' for hashes and hash indexes, instead of 'unsigned' and 'int'. * ccl.c (ccl_driver): Likewise. * charset.c (Fdefine_charset_internal): Likewise. * charset.h (struct charset.hash_index): Likewise. * composite.c (get_composition_id, gstring_lookup_cache): (composition_gstring_put_cache): Likewise. * composite.h (struct composition.hash_index): Likewise. * dispextern.h (struct image.hash): Likewise. * fns.c (next_almost_prime, larger_vector, cmpfn_eql): (cmpfn_equal, cmpfn_user_defined, hashfn_eq, hashfn_eql): (hashfn_equal, hashfn_user_defined, make_hash_table): (maybe_resize_hash_table, hash_lookup, hash_put): (hash_remove_from_table, hash_clear, sweep_weak_table, SXHASH_COMBINE): (sxhash_string, sxhash_list, sxhash_vector, sxhash_bool_vector): (Fsxhash, Fgethash, Fputhash, Fmaphash): Likewise. * image.c (make_image, search_image_cache, lookup_image): (xpm_put_color_table_h): Likewise. * lisp.h (struct Lisp_Hash_Table): Likewise, for 'count', 'cmpfn', and 'hashfn' members. * minibuf.c (Ftry_completion, Fall_completions, Ftest_completion): Likewise. * print.c (print): Likewise. * alloc.c (allocate_vectorlike): Check for overflow in vector size calculations. * ccl.c (ccl_driver): Check for overflow when converting EMACS_INT to int. * fns.c, image.c: Remove unnecessary static decls that would otherwise need to be updated by these changes. * fns.c (make_hash_table, maybe_resize_hash_table): Check for integer overflow with large hash tables. (make_hash_table, maybe_resize_hash_table, Fmake_hash_table): Prefer the faster XFLOAT_DATA to XFLOATINT where either will do. (SXHASH_REDUCE): New macro. (sxhash_string, sxhash_list, sxhash_vector, sxhash_bool_vector): Use it instead of discarding useful hash info with large hash values. (sxhash_float): New function. (sxhash): Use it. No more need for "& INTMASK" due to above changes. * lisp.h (FIXNUM_BITS): New macro, useful for SXHASH_REDUCE etc. (MOST_NEGATIVE_FIXNUM, MOST_POSITIVE_FIXNUM, INTMASK): Rewrite to use FIXNUM_BITS, as this simplifies things. (next_almost_prime, larger_vector, sxhash, hash_lookup, hash_put): Adjust signatures to match updated version of code. (consing_since_gc): Now EMACS_INT, since a single hash table can use more than INT_MAX bytes. --- src/alloc.c | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index e627af6c071..8fcc6f91df9 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -157,7 +157,7 @@ struct emacs_globals globals; /* Number of bytes of consing done since the last gc. */ -int consing_since_gc; +EMACS_INT consing_since_gc; /* Similar minimum, computed from Vgc_cons_percentage. */ @@ -2788,6 +2788,11 @@ allocate_vectorlike (EMACS_INT len) { struct Lisp_Vector *p; size_t nbytes; + int header_size = offsetof (struct Lisp_Vector, contents); + int word_size = sizeof p->contents[0]; + + if ((SIZE_MAX - header_size) / word_size < len) + memory_full (); MALLOC_BLOCK_INPUT; @@ -2801,8 +2806,7 @@ allocate_vectorlike (EMACS_INT len) /* This gets triggered by code which I haven't bothered to fix. --Stef */ /* eassert (!handling_signal); */ - nbytes = (offsetof (struct Lisp_Vector, contents) - + len * sizeof p->contents[0]); + nbytes = header_size + len * word_size; p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); #ifdef DOUG_LEA_MALLOC -- cgit v1.2.1 From 7f5efba80e3643683eb050205054b7896342aa2d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 2 Jun 2011 01:35:28 -0700 Subject: * alloc.c (allocate_vectorlike): Adjust to memory_full API change. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 4449dd989de..0c18fca1755 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2793,7 +2793,7 @@ allocate_vectorlike (EMACS_INT len) int word_size = sizeof p->contents[0]; if ((SIZE_MAX - header_size) / word_size < len) - memory_full (); + memory_full (SIZE_MAX); MALLOC_BLOCK_INPUT; -- cgit v1.2.1 From 4d09bcf621ec32e17fdb8dd2ea08344486f7aeef Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 5 Jun 2011 21:54:23 -0700 Subject: * alloc.c (memory_full) [SYSTEM_MALLOC]: Port to MacO). Fixes: debbugs:8800 --- src/alloc.c | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 0c18fca1755..8d0fdd125dc 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -196,6 +196,12 @@ static char *spare_memory[7]; #define SPARE_MEMORY (1 << 14) #endif +#ifdef SYSTEM_MALLOC +# define LARGE_REQUEST (1 << 14) +#else +# define LARGE_REQUEST SPARE_MEMORY +#endif + /* Number of extra blocks malloc should get when it needs more core. */ static int malloc_hysteresis; @@ -3283,15 +3289,12 @@ memory_full (size_t nbytes) { /* Do not go into hysterics merely because a large request failed. */ int enough_free_memory = 0; - if (SPARE_MEMORY < nbytes) + if (LARGE_REQUEST < nbytes) { - void *p = malloc (SPARE_MEMORY); + void *p = malloc (LARGE_REQUEST); if (p) { - if (spare_memory[0]) - free (p); - else - spare_memory[0] = p; + free (p); enough_free_memory = 1; } } -- cgit v1.2.1 From d1f3d2afe1057a99b9dec6d1bd5b57bfee81fdff Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 5 Jun 2011 23:16:12 -0700 Subject: Check for buffer and string overflow more precisely. * buffer.h (BUF_BYTES_MAX): New macro. * lisp.h (STRING_BYTES_MAX): New macro. * alloc.c (Fmake_string): * character.c (string_escape_byte8): * coding.c (coding_alloc_by_realloc): * doprnt.c (doprnt): * editfns.c (Fformat): * eval.c (verror): Use STRING_BYTES_MAX, not MOST_POSITIVE_FIXNUM, since they may not be the same number. * editfns.c (Finsert_char): * fileio.c (Finsert_file_contents): Likewise for BUF_BYTES_MAX. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 8d0fdd125dc..d9e00c3aeb4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2211,7 +2211,7 @@ INIT must be an integer that represents a character. */) int len = CHAR_STRING (c, str); EMACS_INT string_len = XINT (length); - if (string_len > MOST_POSITIVE_FIXNUM / len) + if (string_len > STRING_BYTES_MAX / len) string_overflow (); nbytes = len * string_len; val = make_uninit_multibyte_string (string_len, nbytes); -- cgit v1.2.1 From 2b6148e42e0d0c246575212e264104d17a746d0b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 6 Jun 2011 09:41:21 -0700 Subject: * alloc.c: Simplify handling of large-request failures (Bug#8800). (SPARE_MEMORY): Always define. (LARGE_REQUEST): Remove. (memory_full): Use SPARE_MEMORY rather than LARGE_REQUEST. --- src/alloc.c | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 8d0fdd125dc..453286836fd 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -190,17 +190,10 @@ static int total_free_floats, total_floats; static char *spare_memory[7]; -#ifndef SYSTEM_MALLOC -/* Amount of spare memory to keep in large reserve block. */ +/* Amount of spare memory to keep in large reserve block, or to see + whether this much is available when malloc fails on a larger request. */ #define SPARE_MEMORY (1 << 14) -#endif - -#ifdef SYSTEM_MALLOC -# define LARGE_REQUEST (1 << 14) -#else -# define LARGE_REQUEST SPARE_MEMORY -#endif /* Number of extra blocks malloc should get when it needs more core. */ @@ -3289,9 +3282,9 @@ memory_full (size_t nbytes) { /* Do not go into hysterics merely because a large request failed. */ int enough_free_memory = 0; - if (LARGE_REQUEST < nbytes) + if (SPARE_MEMORY < nbytes) { - void *p = malloc (LARGE_REQUEST); + void *p = malloc (SPARE_MEMORY); if (p) { free (p); -- cgit v1.2.1 From 2bccce07c2b7d1aadbe6bd5a630540c7e4b252e2 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 6 Jun 2011 22:32:27 -0700 Subject: * alloc.c (Fmake_string): Check for out-of-range init. --- src/alloc.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index cfbb79b2e61..db1744bc7cc 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2186,9 +2186,9 @@ INIT must be an integer that represents a character. */) EMACS_INT nbytes; CHECK_NATNUM (length); - CHECK_NUMBER (init); + CHECK_CHARACTER (init); - c = XINT (init); + c = XFASTINT (init); if (ASCII_CHAR_P (c)) { nbytes = XINT (length); -- cgit v1.2.1 From c9d624c605059127505b6d4baec8f07d6ff731d9 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 8 Jun 2011 10:22:24 -0700 Subject: * alloc.c: Catch some string size overflows that we were missing. (XMALLOC_OVERRUN_CHECK_SIZE) [!XMALLOC_OVERRUN_CHECK]: Define to 0, for convenience in STRING_BYTES_MAX. (STRING_BYTES_MAX): New macro, superseding the old one in lisp.h. The definition here is exact; the one in lisp.h was approximate. (allocate_string_data): Check for string overflow. This catches some instances we weren't catching before. Also, it catches size_t overflow on (unusual) hosts where SIZE_MAX <= min (PTRDIFF_MAX, MOST_POSITIVE_FIXNUM), e.g., when size_t is 32 bits and ptrdiff_t and EMACS_INT are both 64 bits. * character.c, coding.c, doprnt.c, editfns.c, eval.c: All uses of STRING_BYTES_MAX replaced by STRING_BYTES_BOUND. * lisp.h (STRING_BYTES_BOUND): Renamed from STRING_BYTES_MAX. --- src/alloc.c | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index db1744bc7cc..fa4f1d38130 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -485,7 +485,9 @@ buffer_memory_full (EMACS_INT nbytes) } -#ifdef XMALLOC_OVERRUN_CHECK +#ifndef XMALLOC_OVERRUN_CHECK +#define XMALLOC_OVERRUN_CHECK_SIZE 0 +#else /* Check for overrun in malloc'ed buffers by wrapping a 16 byte header and a 16 byte trailer around each block. @@ -1659,6 +1661,18 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = #define GC_STRING_EXTRA (GC_STRING_OVERRUN_COOKIE_SIZE) +/* Exact bound on the number of bytes in a string, not counting the + terminating null. A string cannot contain more bytes than + STRING_BYTES_BOUND, nor can it be so long that the size_t + arithmetic in allocate_string_data would overflow while it is + calculating a value to be passed to malloc. */ +#define STRING_BYTES_MAX \ + min (STRING_BYTES_BOUND, \ + ((SIZE_MAX - XMALLOC_OVERRUN_CHECK_SIZE - GC_STRING_EXTRA \ + - offsetof (struct sblock, first_data) \ + - SDATA_DATA_OFFSET) \ + & ~(sizeof (EMACS_INT) - 1))) + /* Initialize string allocation. Called from init_alloc_once. */ static void @@ -1858,6 +1872,9 @@ allocate_string_data (struct Lisp_String *s, struct sblock *b; EMACS_INT needed, old_nbytes; + if (STRING_BYTES_MAX < nbytes) + string_overflow (); + /* Determine the number of bytes needed to store NBYTES bytes of string data. */ needed = SDATA_SIZE (nbytes); -- cgit v1.2.1 From c78baabfc2e52a99d85d2e28f8f67d75e4d93778 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 8 Jun 2011 10:43:47 -0700 Subject: * alloc.c (Fmake_bool_vector): Don't assume vector size fits in int. --- src/alloc.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index fa4f1d38130..88542e86c48 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2246,7 +2246,6 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) { register Lisp_Object val; struct Lisp_Bool_Vector *p; - int real_init, i; EMACS_INT length_in_chars, length_in_elts; int bits_per_value; @@ -2268,9 +2267,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) p = XBOOL_VECTOR (val); p->size = XFASTINT (length); - real_init = (NILP (init) ? 0 : -1); - for (i = 0; i < length_in_chars ; i++) - p->data[i] = real_init; + memset (p->data, NILP (init) ? 0 : -1, length_in_chars); /* Clear the extraneous bits in the last byte. */ if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR) -- cgit v1.2.1 From 86f61a158aea8dead5a0836a919a0ce501d3bcf7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 8 Jun 2011 10:48:26 -0700 Subject: * alloc.c (allocate_vectorlike): Check for ptrdiff_t overflow. --- src/alloc.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 88542e86c48..2dbaef9b00b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2802,10 +2802,11 @@ allocate_vectorlike (EMACS_INT len) { struct Lisp_Vector *p; size_t nbytes; + ptrdiff_t nbytes_max = min (PTRDIFF_MAX, SIZE_MAX); int header_size = offsetof (struct Lisp_Vector, contents); int word_size = sizeof p->contents[0]; - if ((SIZE_MAX - header_size) / word_size < len) + if ((nbytes_max - header_size) / word_size < len) memory_full (SIZE_MAX); MALLOC_BLOCK_INPUT; -- cgit v1.2.1 From b643996157ced5daf45752d37ac5bee3a4f4389f Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 8 Jun 2011 10:54:58 -0700 Subject: * alloc.c (mark_vectorlike, mark_char_table, mark_object): Avoid EMACS_UINT when a (possibly-narrower) signed value would do just as well. We prefer using signed arithmetic, to avoid comparison confusion. --- src/alloc.c | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 2dbaef9b00b..1307ad60234 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5265,8 +5265,8 @@ static size_t mark_object_loop_halt; static void mark_vectorlike (struct Lisp_Vector *ptr) { - register EMACS_UINT size = ptr->header.size; - register EMACS_UINT i; + EMACS_INT size = ptr->header.size; + EMACS_INT i; eassert (!VECTOR_MARKED_P (ptr)); VECTOR_MARK (ptr); /* Else mark it */ @@ -5288,8 +5288,8 @@ mark_vectorlike (struct Lisp_Vector *ptr) static void mark_char_table (struct Lisp_Vector *ptr) { - register EMACS_UINT size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; - register EMACS_UINT i; + int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; + int i; eassert (!VECTOR_MARKED_P (ptr)); VECTOR_MARK (ptr); @@ -5417,12 +5417,11 @@ mark_object (Lisp_Object arg) recursion there. */ { register struct Lisp_Vector *ptr = XVECTOR (obj); - register EMACS_UINT size = ptr->header.size; - register EMACS_UINT i; + int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; + int i; CHECK_LIVE (live_vector_p); VECTOR_MARK (ptr); /* Else mark it */ - size &= PSEUDOVECTOR_SIZE_MASK; for (i = 0; i < size; i++) /* and then mark its elements */ { if (i != COMPILED_CONSTANTS) -- cgit v1.2.1 From c0c5c8ae3686b2fced5aed6e2e15d8222382c4b7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 8 Jun 2011 11:43:44 -0700 Subject: * alloc.c: Use EMACS_INT, not int, to count objects. (total_conses, total_markers, total_symbols, total_vector_size) (total_free_conses, total_free_markers, total_free_symbols) (total_free_floats, total_floats, total_free_intervals, total_intervals) (total_strings, total_free_strings): Now EMACS_INT, not int. All uses changed. (Fgarbage_collect): Compute overall total using a double, so that integer overflow is less likely to be a problem. Check for overflow when converting back to an integer. --- src/alloc.c | 34 ++++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 14 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 1307ad60234..0bfc4c10e74 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -180,9 +180,9 @@ int abort_on_gc; /* Number of live and free conses etc. */ -static int total_conses, total_markers, total_symbols, total_vector_size; -static int total_free_conses, total_free_markers, total_free_symbols; -static int total_free_floats, total_floats; +static EMACS_INT total_conses, total_markers, total_symbols, total_vector_size; +static EMACS_INT total_free_conses, total_free_markers, total_free_symbols; +static EMACS_INT total_free_floats, total_floats; /* Points to memory space allocated as "spare", to be freed if we run out of memory. We keep one large block, four cons-blocks, and @@ -1338,7 +1338,7 @@ static int interval_block_index; /* Number of free and live intervals. */ -static int total_free_intervals, total_intervals; +static EMACS_INT total_free_intervals, total_intervals; /* List of free intervals. */ @@ -1593,7 +1593,7 @@ static struct Lisp_String *string_free_list; /* Number of live and free Lisp_Strings. */ -static int total_strings, total_free_strings; +static EMACS_INT total_strings, total_free_strings; /* Number of bytes used by live strings. */ @@ -5118,9 +5118,10 @@ returns nil, because real GC can't be done. */) if (gc_cons_threshold < 10000) gc_cons_threshold = 10000; + gc_relative_threshold = 0; if (FLOATP (Vgc_cons_percentage)) { /* Set gc_cons_combined_threshold. */ - EMACS_INT tot = 0; + double tot = 0; tot += total_conses * sizeof (struct Lisp_Cons); tot += total_symbols * sizeof (struct Lisp_Symbol); @@ -5131,10 +5132,15 @@ returns nil, because real GC can't be done. */) tot += total_intervals * sizeof (struct interval); tot += total_strings * sizeof (struct Lisp_String); - gc_relative_threshold = tot * XFLOAT_DATA (Vgc_cons_percentage); + tot *= XFLOAT_DATA (Vgc_cons_percentage); + if (0 < tot) + { + if (tot < TYPE_MAXIMUM (EMACS_INT)) + gc_relative_threshold = tot; + else + gc_relative_threshold = TYPE_MAXIMUM (EMACS_INT); + } } - else - gc_relative_threshold = 0; if (garbage_collection_messages) { @@ -5748,7 +5754,7 @@ gc_sweep (void) register struct cons_block *cblk; struct cons_block **cprev = &cons_block; register int lim = cons_block_index; - register int num_free = 0, num_used = 0; + EMACS_INT num_free = 0, num_used = 0; cons_free_list = 0; @@ -5826,7 +5832,7 @@ gc_sweep (void) register struct float_block *fblk; struct float_block **fprev = &float_block; register int lim = float_block_index; - register int num_free = 0, num_used = 0; + EMACS_INT num_free = 0, num_used = 0; float_free_list = 0; @@ -5873,7 +5879,7 @@ gc_sweep (void) register struct interval_block *iblk; struct interval_block **iprev = &interval_block; register int lim = interval_block_index; - register int num_free = 0, num_used = 0; + EMACS_INT num_free = 0, num_used = 0; interval_free_list = 0; @@ -5923,7 +5929,7 @@ gc_sweep (void) register struct symbol_block *sblk; struct symbol_block **sprev = &symbol_block; register int lim = symbol_block_index; - register int num_free = 0, num_used = 0; + EMACS_INT num_free = 0, num_used = 0; symbol_free_list = NULL; @@ -5988,7 +5994,7 @@ gc_sweep (void) register struct marker_block *mblk; struct marker_block **mprev = &marker_block; register int lim = marker_block_index; - register int num_free = 0, num_used = 0; + EMACS_INT num_free = 0, num_used = 0; marker_free_list = 0; -- cgit v1.2.1 From 5a25e253b46a4f0def2361b1f34ff6c556f138ba Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 8 Jun 2011 11:51:02 -0700 Subject: * alloc.c: (n_interval_blocks, n_string_blocks, n_float_blocks, n_cons_blocks) (n_vectors, n_symbol_blocks, n_marker_blocks): Remove. These were 'int' variables that could overflow on 64-bit hosts; they were never used, so remove them instead of repairing them. --- src/alloc.c | 47 +---------------------------------------------- 1 file changed, 1 insertion(+), 46 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 0bfc4c10e74..1a7d729b29a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1344,10 +1344,6 @@ static EMACS_INT total_free_intervals, total_intervals; static INTERVAL interval_free_list; -/* Total number of interval blocks now in use. */ - -static int n_interval_blocks; - /* Initialize interval allocation. */ @@ -1357,7 +1353,6 @@ init_intervals (void) interval_block = NULL; interval_block_index = INTERVAL_BLOCK_SIZE; interval_free_list = 0; - n_interval_blocks = 0; } @@ -1389,7 +1384,6 @@ make_interval (void) newi->next = interval_block; interval_block = newi; interval_block_index = 0; - n_interval_blocks++; } val = &interval_block->intervals[interval_block_index++]; } @@ -1582,10 +1576,9 @@ static struct sblock *oldest_sblock, *current_sblock; static struct sblock *large_sblocks; -/* List of string_block structures, and how many there are. */ +/* List of string_block structures. */ static struct string_block *string_blocks; -static int n_string_blocks; /* Free-list of Lisp_Strings. */ @@ -1681,7 +1674,6 @@ init_strings (void) total_strings = total_free_strings = total_string_size = 0; oldest_sblock = current_sblock = large_sblocks = NULL; string_blocks = NULL; - n_string_blocks = 0; string_free_list = NULL; empty_unibyte_string = make_pure_string ("", 0, 0, 0); empty_multibyte_string = make_pure_string ("", 0, 0, 1); @@ -1813,7 +1805,6 @@ allocate_string (void) memset (b, 0, sizeof *b); b->next = string_blocks; string_blocks = b; - ++n_string_blocks; for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i) { @@ -2042,7 +2033,6 @@ sweep_strings (void) && total_free_strings > STRING_BLOCK_SIZE) { lisp_free (b); - --n_string_blocks; string_free_list = free_list_before; } else @@ -2477,10 +2467,6 @@ static struct float_block *float_block; static int float_block_index; -/* Total number of float blocks now in use. */ - -static int n_float_blocks; - /* Free-list of Lisp_Floats. */ static struct Lisp_Float *float_free_list; @@ -2494,7 +2480,6 @@ init_float (void) float_block = NULL; float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block. */ float_free_list = 0; - n_float_blocks = 0; } @@ -2528,7 +2513,6 @@ make_float (double float_value) memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); float_block = new; float_block_index = 0; - n_float_blocks++; } XSETFLOAT (val, &float_block->floats[float_block_index]); float_block_index++; @@ -2593,10 +2577,6 @@ static int cons_block_index; static struct Lisp_Cons *cons_free_list; -/* Total number of cons blocks now in use. */ - -static int n_cons_blocks; - /* Initialize cons allocation. */ @@ -2606,7 +2586,6 @@ init_cons (void) cons_block = NULL; cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block. */ cons_free_list = 0; - n_cons_blocks = 0; } @@ -2650,7 +2629,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, new->next = cons_block; cons_block = new; cons_block_index = 0; - n_cons_blocks++; } XSETCONS (val, &cons_block->conses[cons_block_index]); cons_block_index++; @@ -2789,10 +2767,6 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, static struct Lisp_Vector *all_vectors; -/* Total number of vector-like objects now in use. */ - -static int n_vectors; - /* Value is a pointer to a newly allocated Lisp_Vector structure with room for LEN Lisp_Objects. */ @@ -2837,7 +2811,6 @@ allocate_vectorlike (EMACS_INT len) MALLOC_UNBLOCK_INPUT; - ++n_vectors; return p; } @@ -3033,10 +3006,6 @@ static int symbol_block_index; static struct Lisp_Symbol *symbol_free_list; -/* Total number of symbol blocks now in use. */ - -static int n_symbol_blocks; - /* Initialize symbol allocation. */ @@ -3046,7 +3015,6 @@ init_symbol (void) symbol_block = NULL; symbol_block_index = SYMBOL_BLOCK_SIZE; symbol_free_list = 0; - n_symbol_blocks = 0; } @@ -3079,7 +3047,6 @@ Its value and function definition are void, and its property list is nil. */) new->next = symbol_block; symbol_block = new; symbol_block_index = 0; - n_symbol_blocks++; } XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); symbol_block_index++; @@ -3127,17 +3094,12 @@ static int marker_block_index; static union Lisp_Misc *marker_free_list; -/* Total number of marker blocks now in use. */ - -static int n_marker_blocks; - static void init_marker (void) { marker_block = NULL; marker_block_index = MARKER_BLOCK_SIZE; marker_free_list = 0; - n_marker_blocks = 0; } /* Return a newly allocated Lisp_Misc object, with no substructure. */ @@ -3166,7 +3128,6 @@ allocate_misc (void) new->next = marker_block; marker_block = new; marker_block_index = 0; - n_marker_blocks++; total_free_markers += MARKER_BLOCK_SIZE; } XSETMISC (val, &marker_block->markers[marker_block_index]); @@ -5815,7 +5776,6 @@ gc_sweep (void) /* Unhook from the free list. */ cons_free_list = cblk->conses[0].u.chain; lisp_align_free (cblk); - n_cons_blocks--; } else { @@ -5862,7 +5822,6 @@ gc_sweep (void) /* Unhook from the free list. */ float_free_list = fblk->floats[0].u.chain; lisp_align_free (fblk); - n_float_blocks--; } else { @@ -5912,7 +5871,6 @@ gc_sweep (void) /* Unhook from the free list. */ interval_free_list = INTERVAL_PARENT (&iblk->intervals[0]); lisp_free (iblk); - n_interval_blocks--; } else { @@ -5976,7 +5934,6 @@ gc_sweep (void) /* Unhook from the free list. */ symbol_free_list = sblk->symbols[0].next; lisp_free (sblk); - n_symbol_blocks--; } else { @@ -6033,7 +5990,6 @@ gc_sweep (void) /* Unhook from the free list. */ marker_free_list = mblk->markers[0].u_free.chain; lisp_free (mblk); - n_marker_blocks--; } else { @@ -6083,7 +6039,6 @@ gc_sweep (void) all_vectors = vector->header.next.vector; next = vector->header.next.vector; lisp_free (vector); - n_vectors--; vector = next; } -- cgit v1.2.1 From 211a0b2a705753ca0d3f8040f177f0d788298bb6 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 8 Jun 2011 12:01:08 -0700 Subject: * alloc.c (nzombies, ngcs, max_live, max_zombies): Now EMACS_INT, not 'int'. --- src/alloc.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 1a7d729b29a..dd2e5f4b6ad 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3905,11 +3905,11 @@ static Lisp_Object zombies[MAX_ZOMBIES]; /* Number of zombie objects. */ -static int nzombies; +static EMACS_INT nzombies; /* Number of garbage collections. */ -static int ngcs; +static EMACS_INT ngcs; /* Average percentage of zombies per collection. */ @@ -3917,7 +3917,7 @@ static double avg_zombies; /* Max. number of live and zombie objects. */ -static int max_live, max_zombies; +static EMACS_INT max_live, max_zombies; /* Average number of live objects per GC. */ @@ -3928,7 +3928,7 @@ DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "", (void) { Lisp_Object args[8], zombie_list = Qnil; - int i; + EMACS_INT i; for (i = 0; i < nzombies; i++) zombie_list = Fcons (zombies[i], zombie_list); args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d\nzombies: %S"); @@ -4255,7 +4255,7 @@ dump_zombies (void) { int i; - fprintf (stderr, "\nZombies kept alive = %d:\n", nzombies); + fprintf (stderr, "\nZombies kept alive = %"pI":\n", nzombies); for (i = 0; i < min (MAX_ZOMBIES, nzombies); ++i) { fprintf (stderr, " %d = ", i); -- cgit v1.2.1 From 6349ae4d9c0e2a2986e2800dcea6a029fbc60d23 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 8 Jun 2011 12:07:55 -0700 Subject: * alloc.c (inhibit_garbage_collection): Set gc_cons_threshold to max value. Previously, this ceilinged at INT_MAX, but that doesn't work on 64-bit machines. --- src/alloc.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index dd2e5f4b6ad..e04f60baf03 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4827,9 +4827,8 @@ int inhibit_garbage_collection (void) { int count = SPECPDL_INDEX (); - int nbits = min (VALBITS, BITS_PER_INT); - specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1)); + specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM)); return count; } -- cgit v1.2.1 From e46bb31a9f62b157947257b444fb44b1f9a42db6 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 8 Jun 2011 12:18:46 -0700 Subject: * alloc.c (allocate_pseudovector): Don't use EMACS_INT when int would do. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index e04f60baf03..4530e0a7377 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2832,7 +2832,7 @@ struct Lisp_Vector * allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag) { struct Lisp_Vector *v = allocate_vectorlike (memlen); - EMACS_INT i; + int i; /* Only the first lisplen slots will be traced normally by the GC. */ for (i = 0; i < lisplen; ++i) -- cgit v1.2.1 From 9c4c5f81ceb3fb3100a6a81adffcf764b843363c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 8 Jun 2011 12:54:32 -0700 Subject: * lisp.h (SAFE_ALLOCA_LISP): Check for integer overflow. (struct Lisp_Save_Value): Use ptrdiff_t, not int, for 'integer' member. * alloc.c (make_save_value): Integer argument is now of type ptrdiff_t, not int. (mark_object): Use ptrdiff_t, not int. * lisp.h (pD): New macro. * print.c (print_object): Use it. --- src/alloc.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 4530e0a7377..fd2884af1c3 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3160,7 +3160,7 @@ free_misc (Lisp_Object misc) The unwind function can get the C values back using XSAVE_VALUE. */ Lisp_Object -make_save_value (void *pointer, int integer) +make_save_value (void *pointer, ptrdiff_t integer) { register Lisp_Object val; register struct Lisp_Save_Value *p; @@ -5514,7 +5514,7 @@ mark_object (Lisp_Object arg) if (ptr->dogc) { Lisp_Object *p = (Lisp_Object *) ptr->pointer; - int nelt; + ptrdiff_t nelt; for (nelt = ptr->integer; nelt > 0; nelt--, p++) mark_maybe_object (*p); } -- cgit v1.2.1 From f66c7cf8f794d6f7fd9ccb8794ffc519e4e89795 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 14 Jun 2011 11:57:19 -0700 Subject: Variadic C functions now count arguments with ptrdiff_t. This partly undoes my 2011-03-30 change, which replaced int with size_t. Back then I didn't know that the Emacs coding style prefers signed int. Also, in the meantime I found a few more instances where arguments were being counted with int, which may truncate counts on 64-bit machines, or EMACS_INT, which may be unnecessarily wide. * lisp.h (struct Lisp_Subr.function.aMANY) (DEFUN_ARGS_MANY, internal_condition_case_n, safe_call): Arg counts are now ptrdiff_t, not size_t. All variadic functions and their callers changed accordingly. (struct gcpro.nvars): Now size_t, not size_t. All uses changed. * bytecode.c (exec_byte_code): Check maxdepth for overflow, to avoid potential buffer overrun. Don't assume arg counts fit in 'int'. * callint.c (Fcall_interactively): Check arg count for overflow, to avoid potential buffer overrun. Use signed char, not 'int', for 'varies' array, so that we needn't bother to check its size calculation for overflow. * editfns.c (Fformat): Use ptrdiff_t, not EMACS_INT, to count args. * eval.c (apply_lambda): * fns.c (Fmapconcat): Use XFASTINT, not XINT, to get args length. (struct textprop_rec.argnum): Now ptrdiff_t, not int. All uses changed. (mapconcat): Use ptrdiff_t, not int and EMACS_INT, to count args. --- src/alloc.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index fd2884af1c3..56e8eb4d465 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2697,7 +2697,7 @@ DEFUN ("list", Flist, Slist, 0, MANY, 0, doc: /* Return a newly created list with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (list &rest OBJECTS) */) - (size_t nargs, register Lisp_Object *args) + (ptrdiff_t nargs, Lisp_Object *args) { register Lisp_Object val; val = Qnil; @@ -2913,10 +2913,10 @@ DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (vector &rest OBJECTS) */) - (register size_t nargs, Lisp_Object *args) + (ptrdiff_t nargs, Lisp_Object *args) { register Lisp_Object len, val; - register size_t i; + ptrdiff_t i; register struct Lisp_Vector *p; XSETFASTINT (len, nargs); @@ -2944,15 +2944,15 @@ argument to catch the left-over arguments. If such an integer is used, the arguments will not be dynamically bound but will be instead pushed on the stack before executing the byte-code. usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) - (register size_t nargs, Lisp_Object *args) + (ptrdiff_t nargs, Lisp_Object *args) { register Lisp_Object len, val; - register size_t i; + ptrdiff_t i; register struct Lisp_Vector *p; XSETFASTINT (len, nargs); if (!NILP (Vpurify_flag)) - val = make_pure_vector ((EMACS_INT) nargs); + val = make_pure_vector (nargs); else val = Fmake_vector (len, Qnil); @@ -4238,7 +4238,7 @@ static void check_gcpros (void) { struct gcpro *p; - size_t i; + ptrdiff_t i; for (p = gcprolist; p; p = p->next) for (i = 0; i < p->nvars; ++i) @@ -4848,7 +4848,7 @@ returns nil, because real GC can't be done. */) { register struct specbinding *bind; char stack_top_variable; - register size_t i; + ptrdiff_t i; int message_p; Lisp_Object total[8]; int count = SPECPDL_INDEX (); -- cgit v1.2.1 From dd0b0efbabfc187be6810a0e41b4ac5fdda667af Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 14 Jun 2011 14:30:16 -0700 Subject: * alloc.c: Check that resized vectors' lengths fit in fixnums. (header_size, word_size): New constants. (allocate_vectorlike): Don't check size overflow here. (allocate_vector): Check it here instead, since this is the only caller of allocate_vectorlike that could cause overflow. Check that the new vector's length is representable as a fixnum. --- src/alloc.c | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) (limited to 'src/alloc.c') diff --git a/src/alloc.c b/src/alloc.c index 56e8eb4d465..00d330c1b6a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2767,6 +2767,12 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, static struct Lisp_Vector *all_vectors; +/* Handy constants for vectorlike objects. */ +enum + { + header_size = offsetof (struct Lisp_Vector, contents), + word_size = sizeof (Lisp_Object) + }; /* Value is a pointer to a newly allocated Lisp_Vector structure with room for LEN Lisp_Objects. */ @@ -2776,12 +2782,6 @@ allocate_vectorlike (EMACS_INT len) { struct Lisp_Vector *p; size_t nbytes; - ptrdiff_t nbytes_max = min (PTRDIFF_MAX, SIZE_MAX); - int header_size = offsetof (struct Lisp_Vector, contents); - int word_size = sizeof p->contents[0]; - - if ((nbytes_max - header_size) / word_size < len) - memory_full (SIZE_MAX); MALLOC_BLOCK_INPUT; @@ -2815,13 +2815,18 @@ allocate_vectorlike (EMACS_INT len) } -/* Allocate a vector with NSLOTS slots. */ +/* Allocate a vector with LEN slots. */ struct Lisp_Vector * -allocate_vector (EMACS_INT nslots) +allocate_vector (EMACS_INT len) { - struct Lisp_Vector *v = allocate_vectorlike (nslots); - v->header.size = nslots; + struct Lisp_Vector *v; + ptrdiff_t nbytes_max = min (PTRDIFF_MAX, SIZE_MAX); + + if (min ((nbytes_max - header_size) / word_size, MOST_POSITIVE_FIXNUM) < len) + memory_full (SIZE_MAX); + v = allocate_vectorlike (len); + v->header.size = len; return v; } -- cgit v1.2.1