diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 19 | ||||
| -rw-r--r-- | src/alloc.c | 57 | ||||
| -rw-r--r-- | src/buffer.c | 2 | ||||
| -rw-r--r-- | src/callint.c | 9 | ||||
| -rw-r--r-- | src/charset.c | 33 | ||||
| -rw-r--r-- | src/coding.c | 2 | ||||
| -rw-r--r-- | src/keymap.c | 33 | ||||
| -rw-r--r-- | src/lisp.h | 2 | ||||
| -rw-r--r-- | src/search.c | 4 | ||||
| -rw-r--r-- | src/syntax.c | 2 | ||||
| -rw-r--r-- | src/w32.c | 12 | ||||
| -rw-r--r-- | src/w32fns.c | 23 | ||||
| -rw-r--r-- | src/xdisp.c | 16 | ||||
| -rw-r--r-- | src/xfns.c | 2 |
14 files changed, 131 insertions, 85 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index e78a0365288..e1d0ef8e90e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,24 @@ 2012-07-27 Dmitry Antipov <dmantipov@yandex.ru> + Utility function to make a list from specified amount of objects. + * lisp.h (enum constype): New datatype. + (listn): New prototype. + * alloc.c (listn): New function. + (Fmemory_use_count, syms_of_alloc): Use it. + * buffer.c (syms_of_buffer): Likewise. + * callint.c (syms_of_callint): Likewise. + * charset.c (define_charset_internal): Likewise. + * coding.c (syms_of_coding): Likewise. + * keymap.c (syms_of_keymap): Likewise. + * search.c (syms_of_search): Likewise. + * syntax.c (syms_of_syntax): Likewise. + * w32.c (init_environment): Likewise. + * w32fns.c (Fw32_battery_status, syms_of_w32fns): Likewise. + * xdisp.c (syms_of_xdisp): Likewise. + * xfns.c (syms_of_xfns): Likewise. + +2012-07-27 Dmitry Antipov <dmantipov@yandex.ru> + Fast save_excursion_save and save_excursion_restore. * lisp.h (struct Lisp_Excursion): New data type. (PVEC_EXCURSION): New pseudovector type. diff --git a/src/alloc.c b/src/alloc.c index 5377b27e329..3d8b7a54d06 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2811,6 +2811,38 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, L Fcons (arg5, Qnil))))); } +/* Make a list of COUNT Lisp_Objects, where ARG is the + first one. Allocate conses from pure space if TYPE + is PURE, or allocate as usual if type is HEAP. */ + +Lisp_Object +listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...) +{ + va_list ap; + ptrdiff_t i; + Lisp_Object val, *objp; + + /* Change to SAFE_ALLOCA if you hit this eassert. */ + eassert (count <= MAX_ALLOCA / sizeof (Lisp_Object)); + + objp = alloca (count * sizeof (Lisp_Object)); + objp[0] = arg; + va_start (ap, arg); + for (i = 1; i < count; i++) + objp[i] = va_arg (ap, Lisp_Object); + va_end (ap); + + for (i = 0, val = Qnil; i < count; i++) + { + if (type == PURE) + val = pure_cons (objp[i], val); + else if (type == HEAP) + val = Fcons (objp[i], val); + else + abort (); + } + return val; +} DEFUN ("list", Flist, Slist, 0, MANY, 0, doc: /* Return a newly created list with specified arguments as elements. @@ -6649,18 +6681,15 @@ Frames, windows, buffers, and subprocesses count as vectors (but the contents of a buffer's text do not count here). */) (void) { - Lisp_Object consed[8]; - - consed[0] = bounded_number (cons_cells_consed); - consed[1] = bounded_number (floats_consed); - consed[2] = bounded_number (vector_cells_consed); - consed[3] = bounded_number (symbols_consed); - consed[4] = bounded_number (string_chars_consed); - consed[5] = bounded_number (misc_objects_consed); - consed[6] = bounded_number (intervals_consed); - consed[7] = bounded_number (strings_consed); - - return Flist (8, consed); + return listn (HEAP, 8, + bounded_number (cons_cells_consed), + bounded_number (floats_consed), + bounded_number (vector_cells_consed), + bounded_number (symbols_consed), + bounded_number (string_chars_consed), + bounded_number (misc_objects_consed), + bounded_number (intervals_consed), + bounded_number (strings_consed)); } /* Find at most FIND_MAX symbols which have OBJ as their value or @@ -6841,8 +6870,8 @@ do hash-consing of the objects allocated to pure space. */); /* We build this in advance because if we wait until we need it, we might not be able to allocate the memory to hold it. */ Vmemory_signal_data - = pure_cons (Qerror, - pure_cons (build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil)); + = listn (PURE, 2, Qerror, + build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs")); DEFVAR_LISP ("memory-full", Vmemory_full, doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); diff --git a/src/buffer.c b/src/buffer.c index 06d385110c6..c2afd7f4a5e 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5212,7 +5212,7 @@ syms_of_buffer (void) DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions"); Fput (Qprotected_field, Qerror_conditions, - pure_cons (Qprotected_field, pure_cons (Qerror, Qnil))); + listn (PURE, 2, Qprotected_field, Qerror)); Fput (Qprotected_field, Qerror_message, build_pure_c_string ("Attempt to modify a protected field")); diff --git a/src/callint.c b/src/callint.c index 58e1a5be2f4..4454b1fdb16 100644 --- a/src/callint.c +++ b/src/callint.c @@ -888,10 +888,11 @@ syms_of_callint (void) callint_message = Qnil; staticpro (&callint_message); - preserved_fns = pure_cons (intern_c_string ("region-beginning"), - pure_cons (intern_c_string ("region-end"), - pure_cons (intern_c_string ("point"), - pure_cons (intern_c_string ("mark"), Qnil)))); + preserved_fns = listn (PURE, 4, + intern_c_string ("region-beginning"), + intern_c_string ("region-end"), + intern_c_string ("point"), + intern_c_string ("mark")); DEFSYM (Qlist, "list"); DEFSYM (Qlet, "let"); diff --git a/src/charset.c b/src/charset.c index 4c47ba45fb6..ae822544006 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1257,7 +1257,6 @@ define_charset_internal (Lisp_Object name, { const unsigned char *code_space = (const unsigned char *) code_space_chars; Lisp_Object args[charset_arg_max]; - Lisp_Object plist[14]; Lisp_Object val; int i; @@ -1283,22 +1282,22 @@ define_charset_internal (Lisp_Object name, args[charset_arg_superset] = Qnil; args[charset_arg_unify_map] = Qnil; - plist[0] = intern_c_string (":name"); - plist[1] = args[charset_arg_name]; - plist[2] = intern_c_string (":dimension"); - plist[3] = args[charset_arg_dimension]; - plist[4] = intern_c_string (":code-space"); - plist[5] = args[charset_arg_code_space]; - plist[6] = intern_c_string (":iso-final-char"); - plist[7] = args[charset_arg_iso_final]; - plist[8] = intern_c_string (":emacs-mule-id"); - plist[9] = args[charset_arg_emacs_mule_id]; - plist[10] = intern_c_string (":ascii-compatible-p"); - plist[11] = args[charset_arg_ascii_compatible_p]; - plist[12] = intern_c_string (":code-offset"); - plist[13] = args[charset_arg_code_offset]; - - args[charset_arg_plist] = Flist (14, plist); + args[charset_arg_plist] = + listn (HEAP, 14, + intern_c_string (":name"), + args[charset_arg_name], + intern_c_string (":dimension"), + args[charset_arg_dimension], + intern_c_string (":code-space"), + args[charset_arg_code_space], + intern_c_string (":iso-final-char"), + args[charset_arg_iso_final], + intern_c_string (":emacs-mule-id"), + args[charset_arg_emacs_mule_id], + intern_c_string (":ascii-compatible-p"), + args[charset_arg_ascii_compatible_p], + intern_c_string (":code-offset"), + args[charset_arg_code_offset]); Fdefine_charset_internal (charset_arg_max, args); return XINT (CHARSET_SYMBOL_ID (name)); diff --git a/src/coding.c b/src/coding.c index 212eb8275fe..8b858aa218e 100644 --- a/src/coding.c +++ b/src/coding.c @@ -10411,7 +10411,7 @@ syms_of_coding (void) DEFSYM (Qcoding_system_error, "coding-system-error"); Fput (Qcoding_system_error, Qerror_conditions, - pure_cons (Qcoding_system_error, pure_cons (Qerror, Qnil))); + listn (PURE, 2, Qcoding_system_error, Qerror)); Fput (Qcoding_system_error, Qerror_message, build_pure_c_string ("Invalid coding system")); diff --git a/src/keymap.c b/src/keymap.c index feaf0cfd961..d86a4cd74de 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -3702,13 +3702,12 @@ syms_of_keymap (void) Fset (intern_c_string ("ctl-x-map"), control_x_map); Ffset (intern_c_string ("Control-X-prefix"), control_x_map); - exclude_keys - = pure_cons (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")), - pure_cons (pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")), - pure_cons (pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")), - pure_cons (pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")), - pure_cons (pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")), - Qnil))))); + exclude_keys = listn (PURE, 5, + pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")), + pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")), + pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")), + pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")), + pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" "))); staticpro (&exclude_keys); DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands, @@ -3761,16 +3760,16 @@ be preferred. */); where_is_preferred_modifier = 0; staticpro (&Vmouse_events); - Vmouse_events = pure_cons (intern_c_string ("menu-bar"), - pure_cons (intern_c_string ("tool-bar"), - pure_cons (intern_c_string ("header-line"), - pure_cons (intern_c_string ("mode-line"), - pure_cons (intern_c_string ("mouse-1"), - pure_cons (intern_c_string ("mouse-2"), - pure_cons (intern_c_string ("mouse-3"), - pure_cons (intern_c_string ("mouse-4"), - pure_cons (intern_c_string ("mouse-5"), - Qnil))))))))); + Vmouse_events = listn (PURE, 9, + intern_c_string ("menu-bar"), + intern_c_string ("tool-bar"), + intern_c_string ("header-line"), + intern_c_string ("mode-line"), + intern_c_string ("mouse-1"), + intern_c_string ("mouse-2"), + intern_c_string ("mouse-3"), + intern_c_string ("mouse-4"), + intern_c_string ("mouse-5")); DEFSYM (Qsingle_key_description, "single-key-description"); DEFSYM (Qkey_description, "key-description"); diff --git a/src/lisp.h b/src/lisp.h index 55a4a297a39..c217b946e81 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2685,6 +2685,8 @@ extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); +enum constype {HEAP, PURE}; +extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...); extern _Noreturn void string_overflow (void); extern Lisp_Object make_string (const char *, ptrdiff_t); extern Lisp_Object make_formatted_string (char *, const char *, ...) diff --git a/src/search.c b/src/search.c index 118cec4af48..c4329dcdf3e 100644 --- a/src/search.c +++ b/src/search.c @@ -3054,12 +3054,12 @@ syms_of_search (void) DEFSYM (Qinvalid_regexp, "invalid-regexp"); Fput (Qsearch_failed, Qerror_conditions, - pure_cons (Qsearch_failed, pure_cons (Qerror, Qnil))); + listn (PURE, 2, Qsearch_failed, Qerror)); Fput (Qsearch_failed, Qerror_message, build_pure_c_string ("Search failed")); Fput (Qinvalid_regexp, Qerror_conditions, - pure_cons (Qinvalid_regexp, pure_cons (Qerror, Qnil))); + listn (PURE, 2, Qinvalid_regexp, Qerror)); Fput (Qinvalid_regexp, Qerror_message, build_pure_c_string ("Invalid regexp")); diff --git a/src/syntax.c b/src/syntax.c index 69c2789ed39..1e57c00e512 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3473,7 +3473,7 @@ syms_of_syntax (void) DEFSYM (Qscan_error, "scan-error"); Fput (Qscan_error, Qerror_conditions, - pure_cons (Qscan_error, pure_cons (Qerror, Qnil))); + listn (PURE, 2, Qscan_error, Qerror)); Fput (Qscan_error, Qerror_message, build_pure_c_string ("Scan error")); diff --git a/src/w32.c b/src/w32.c index e8c48a50a97..6f7cc9506ec 100644 --- a/src/w32.c +++ b/src/w32.c @@ -1722,13 +1722,11 @@ init_environment (char ** argv) dwType = REG_EXPAND_SZ; dont_free = 1; if (!strcmp (env_vars[i].name, "HOME") && !appdata) - { - Lisp_Object warning[2]; - warning[0] = intern ("initialization"); - warning[1] = build_string ("Setting HOME to C:\\ by default is deprecated"); - Vdelayed_warnings_list = Fcons (Flist (2, warning), - Vdelayed_warnings_list); - } + Vdelayed_warnings_list + = Fcons (listn (HEAP, 2, + intern ("initialization"); + build_string ("Setting HOME to C:\\ by default is deprecated")), + Vdelayed_warnings_list); } if (lpval) diff --git a/src/w32fns.c b/src/w32fns.c index 06938e3124b..0dd5379cf01 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -6470,7 +6470,6 @@ The following %-sequences are provided: { Lisp_Object line_status, battery_status, battery_status_symbol; Lisp_Object load_percentage, seconds, minutes, hours, remain; - Lisp_Object sequences[8]; long seconds_left = (long) system_status.BatteryLifeTime; @@ -6544,16 +6543,16 @@ The following %-sequences are provided: _snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60); remain = build_string (buffer); } - sequences[0] = Fcons (make_number ('L'), line_status); - sequences[1] = Fcons (make_number ('B'), battery_status); - sequences[2] = Fcons (make_number ('b'), battery_status_symbol); - sequences[3] = Fcons (make_number ('p'), load_percentage); - sequences[4] = Fcons (make_number ('s'), seconds); - sequences[5] = Fcons (make_number ('m'), minutes); - sequences[6] = Fcons (make_number ('h'), hours); - sequences[7] = Fcons (make_number ('t'), remain); - - status = Flist (8, sequences); + + status = listn (HEAP, 8, + Fcons (make_number ('L'), line_status), + Fcons (make_number ('B'), battery_status), + Fcons (make_number ('b'), battery_status_symbol), + Fcons (make_number ('p'), load_percentage), + Fcons (make_number ('s'), seconds), + Fcons (make_number ('m'), minutes), + Fcons (make_number ('h'), hours), + Fcons (make_number ('t'), remain)); } return status; } @@ -6795,7 +6794,7 @@ syms_of_w32fns (void) Fput (Qundefined_color, Qerror_conditions, - pure_cons (Qundefined_color, pure_cons (Qerror, Qnil))); + listn (PURE, 2, Qundefined_color, Qerror); Fput (Qundefined_color, Qerror_message, build_pure_c_string ("Undefined color")); diff --git a/src/xdisp.c b/src/xdisp.c index 1d3de61c5a3..aac34d35ef4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -28932,14 +28932,14 @@ and is used only on frames for which no explicit name has been set \(see `modify-frame-parameters'). */); Vicon_title_format = Vframe_title_format - = pure_cons (intern_c_string ("multiple-frames"), - pure_cons (build_pure_c_string ("%b"), - pure_cons (pure_cons (empty_unibyte_string, - pure_cons (intern_c_string ("invocation-name"), - pure_cons (build_pure_c_string ("@"), - pure_cons (intern_c_string ("system-name"), - Qnil)))), - Qnil))); + = listn (PURE, 3, + intern_c_string ("multiple-frames"), + build_pure_c_string ("%b"), + listn (PURE, 4, + empty_unibyte_string, + intern_c_string ("invocation-name"), + build_pure_c_string ("@"), + intern_c_string ("system-name"))); DEFVAR_LISP ("message-log-max", Vmessage_log_max, doc: /* Maximum number of lines to keep in the message log buffer. diff --git a/src/xfns.c b/src/xfns.c index e431651d93a..cd29dabc71a 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5822,7 +5822,7 @@ syms_of_xfns (void) /* This is the end of symbol initialization. */ Fput (Qundefined_color, Qerror_conditions, - pure_cons (Qundefined_color, pure_cons (Qerror, Qnil))); + listn (PURE, 2, Qundefined_color, Qerror)); Fput (Qundefined_color, Qerror_message, build_pure_c_string ("Undefined color")); |