Commit 694b6c97 authored by Dmitry Antipov's avatar Dmitry Antipov
Browse files

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.
parent ca1302a4
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> 2012-07-27 Dmitry Antipov <dmantipov@yandex.ru>
   
Fast save_excursion_save and save_excursion_restore. Fast save_excursion_save and save_excursion_restore.
......
...@@ -2811,6 +2811,38 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, L ...@@ -2811,6 +2811,38 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, L
Fcons (arg5, Qnil))))); 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, DEFUN ("list", Flist, Slist, 0, MANY, 0,
doc: /* Return a newly created list with specified arguments as elements. doc: /* Return a newly created list with specified arguments as elements.
...@@ -6649,18 +6681,15 @@ Frames, windows, buffers, and subprocesses count as vectors ...@@ -6649,18 +6681,15 @@ Frames, windows, buffers, and subprocesses count as vectors
(but the contents of a buffer's text do not count here). */) (but the contents of a buffer's text do not count here). */)
(void) (void)
{ {
Lisp_Object consed[8]; return listn (HEAP, 8,
bounded_number (cons_cells_consed),
consed[0] = bounded_number (cons_cells_consed); bounded_number (floats_consed),
consed[1] = bounded_number (floats_consed); bounded_number (vector_cells_consed),
consed[2] = bounded_number (vector_cells_consed); bounded_number (symbols_consed),
consed[3] = bounded_number (symbols_consed); bounded_number (string_chars_consed),
consed[4] = bounded_number (string_chars_consed); bounded_number (misc_objects_consed),
consed[5] = bounded_number (misc_objects_consed); bounded_number (intervals_consed),
consed[6] = bounded_number (intervals_consed); bounded_number (strings_consed));
consed[7] = bounded_number (strings_consed);
return Flist (8, consed);
} }
/* Find at most FIND_MAX symbols which have OBJ as their value or /* 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. */); ...@@ -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 /* 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. */ not be able to allocate the memory to hold it. */
Vmemory_signal_data Vmemory_signal_data
= pure_cons (Qerror, = listn (PURE, 2, Qerror,
pure_cons (build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil)); build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
DEFVAR_LISP ("memory-full", Vmemory_full, DEFVAR_LISP ("memory-full", Vmemory_full,
doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
......
...@@ -5212,7 +5212,7 @@ syms_of_buffer (void) ...@@ -5212,7 +5212,7 @@ syms_of_buffer (void)
DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions"); DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
Fput (Qprotected_field, Qerror_conditions, Fput (Qprotected_field, Qerror_conditions,
pure_cons (Qprotected_field, pure_cons (Qerror, Qnil))); listn (PURE, 2, Qprotected_field, Qerror));
Fput (Qprotected_field, Qerror_message, Fput (Qprotected_field, Qerror_message,
build_pure_c_string ("Attempt to modify a protected field")); build_pure_c_string ("Attempt to modify a protected field"));
......
...@@ -888,10 +888,11 @@ syms_of_callint (void) ...@@ -888,10 +888,11 @@ syms_of_callint (void)
callint_message = Qnil; callint_message = Qnil;
staticpro (&callint_message); staticpro (&callint_message);
preserved_fns = pure_cons (intern_c_string ("region-beginning"), preserved_fns = listn (PURE, 4,
pure_cons (intern_c_string ("region-end"), intern_c_string ("region-beginning"),
pure_cons (intern_c_string ("point"), intern_c_string ("region-end"),
pure_cons (intern_c_string ("mark"), Qnil)))); intern_c_string ("point"),
intern_c_string ("mark"));
DEFSYM (Qlist, "list"); DEFSYM (Qlist, "list");
DEFSYM (Qlet, "let"); DEFSYM (Qlet, "let");
......
...@@ -1257,7 +1257,6 @@ define_charset_internal (Lisp_Object name, ...@@ -1257,7 +1257,6 @@ define_charset_internal (Lisp_Object name,
{ {
const unsigned char *code_space = (const unsigned char *) code_space_chars; const unsigned char *code_space = (const unsigned char *) code_space_chars;
Lisp_Object args[charset_arg_max]; Lisp_Object args[charset_arg_max];
Lisp_Object plist[14];
Lisp_Object val; Lisp_Object val;
int i; int i;
...@@ -1283,22 +1282,22 @@ define_charset_internal (Lisp_Object name, ...@@ -1283,22 +1282,22 @@ define_charset_internal (Lisp_Object name,
args[charset_arg_superset] = Qnil; args[charset_arg_superset] = Qnil;
args[charset_arg_unify_map] = Qnil; args[charset_arg_unify_map] = Qnil;
plist[0] = intern_c_string (":name"); args[charset_arg_plist] =
plist[1] = args[charset_arg_name]; listn (HEAP, 14,
plist[2] = intern_c_string (":dimension"); intern_c_string (":name"),
plist[3] = args[charset_arg_dimension]; args[charset_arg_name],
plist[4] = intern_c_string (":code-space"); intern_c_string (":dimension"),
plist[5] = args[charset_arg_code_space]; args[charset_arg_dimension],
plist[6] = intern_c_string (":iso-final-char"); intern_c_string (":code-space"),
plist[7] = args[charset_arg_iso_final]; args[charset_arg_code_space],
plist[8] = intern_c_string (":emacs-mule-id"); intern_c_string (":iso-final-char"),
plist[9] = args[charset_arg_emacs_mule_id]; args[charset_arg_iso_final],
plist[10] = intern_c_string (":ascii-compatible-p"); intern_c_string (":emacs-mule-id"),
plist[11] = args[charset_arg_ascii_compatible_p]; args[charset_arg_emacs_mule_id],
plist[12] = intern_c_string (":code-offset"); intern_c_string (":ascii-compatible-p"),
plist[13] = args[charset_arg_code_offset]; args[charset_arg_ascii_compatible_p],
intern_c_string (":code-offset"),
args[charset_arg_plist] = Flist (14, plist); args[charset_arg_code_offset]);
Fdefine_charset_internal (charset_arg_max, args); Fdefine_charset_internal (charset_arg_max, args);
return XINT (CHARSET_SYMBOL_ID (name)); return XINT (CHARSET_SYMBOL_ID (name));
......
...@@ -10411,7 +10411,7 @@ syms_of_coding (void) ...@@ -10411,7 +10411,7 @@ syms_of_coding (void)
DEFSYM (Qcoding_system_error, "coding-system-error"); DEFSYM (Qcoding_system_error, "coding-system-error");
Fput (Qcoding_system_error, Qerror_conditions, 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, Fput (Qcoding_system_error, Qerror_message,
build_pure_c_string ("Invalid coding system")); build_pure_c_string ("Invalid coding system"));
......
...@@ -3702,13 +3702,12 @@ syms_of_keymap (void) ...@@ -3702,13 +3702,12 @@ syms_of_keymap (void)
Fset (intern_c_string ("ctl-x-map"), control_x_map); Fset (intern_c_string ("ctl-x-map"), control_x_map);
Ffset (intern_c_string ("Control-X-prefix"), control_x_map); Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
exclude_keys exclude_keys = listn (PURE, 5,
= pure_cons (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")), 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 (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 (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 (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")),
pure_cons (pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")), pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")));
Qnil)))));
staticpro (&exclude_keys); staticpro (&exclude_keys);
DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands, DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands,
...@@ -3761,16 +3760,16 @@ be preferred. */); ...@@ -3761,16 +3760,16 @@ be preferred. */);
where_is_preferred_modifier = 0; where_is_preferred_modifier = 0;
staticpro (&Vmouse_events); staticpro (&Vmouse_events);
Vmouse_events = pure_cons (intern_c_string ("menu-bar"), Vmouse_events = listn (PURE, 9,
pure_cons (intern_c_string ("tool-bar"), intern_c_string ("menu-bar"),
pure_cons (intern_c_string ("header-line"), intern_c_string ("tool-bar"),
pure_cons (intern_c_string ("mode-line"), intern_c_string ("header-line"),
pure_cons (intern_c_string ("mouse-1"), intern_c_string ("mode-line"),
pure_cons (intern_c_string ("mouse-2"), intern_c_string ("mouse-1"),
pure_cons (intern_c_string ("mouse-3"), intern_c_string ("mouse-2"),
pure_cons (intern_c_string ("mouse-4"), intern_c_string ("mouse-3"),
pure_cons (intern_c_string ("mouse-5"), intern_c_string ("mouse-4"),
Qnil))))))))); intern_c_string ("mouse-5"));
DEFSYM (Qsingle_key_description, "single-key-description"); DEFSYM (Qsingle_key_description, "single-key-description");
DEFSYM (Qkey_description, "key-description"); DEFSYM (Qkey_description, "key-description");
......
...@@ -2685,6 +2685,8 @@ extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object); ...@@ -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 list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, extern Lisp_Object list5 (Lisp_Object, 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 _Noreturn void string_overflow (void);
extern Lisp_Object make_string (const char *, ptrdiff_t); extern Lisp_Object make_string (const char *, ptrdiff_t);
extern Lisp_Object make_formatted_string (char *, const char *, ...) extern Lisp_Object make_formatted_string (char *, const char *, ...)
......
...@@ -3054,12 +3054,12 @@ syms_of_search (void) ...@@ -3054,12 +3054,12 @@ syms_of_search (void)
DEFSYM (Qinvalid_regexp, "invalid-regexp"); DEFSYM (Qinvalid_regexp, "invalid-regexp");
Fput (Qsearch_failed, Qerror_conditions, Fput (Qsearch_failed, Qerror_conditions,
pure_cons (Qsearch_failed, pure_cons (Qerror, Qnil))); listn (PURE, 2, Qsearch_failed, Qerror));
Fput (Qsearch_failed, Qerror_message, Fput (Qsearch_failed, Qerror_message,
build_pure_c_string ("Search failed")); build_pure_c_string ("Search failed"));
Fput (Qinvalid_regexp, Qerror_conditions, Fput (Qinvalid_regexp, Qerror_conditions,
pure_cons (Qinvalid_regexp, pure_cons (Qerror, Qnil))); listn (PURE, 2, Qinvalid_regexp, Qerror));
Fput (Qinvalid_regexp, Qerror_message, Fput (Qinvalid_regexp, Qerror_message,
build_pure_c_string ("Invalid regexp")); build_pure_c_string ("Invalid regexp"));
......
...@@ -3473,7 +3473,7 @@ syms_of_syntax (void) ...@@ -3473,7 +3473,7 @@ syms_of_syntax (void)
DEFSYM (Qscan_error, "scan-error"); DEFSYM (Qscan_error, "scan-error");
Fput (Qscan_error, Qerror_conditions, Fput (Qscan_error, Qerror_conditions,
pure_cons (Qscan_error, pure_cons (Qerror, Qnil))); listn (PURE, 2, Qscan_error, Qerror));
Fput (Qscan_error, Qerror_message, Fput (Qscan_error, Qerror_message,
build_pure_c_string ("Scan error")); build_pure_c_string ("Scan error"));
......
...@@ -1722,13 +1722,11 @@ init_environment (char ** argv) ...@@ -1722,13 +1722,11 @@ init_environment (char ** argv)
dwType = REG_EXPAND_SZ; dwType = REG_EXPAND_SZ;
dont_free = 1; dont_free = 1;
if (!strcmp (env_vars[i].name, "HOME") && !appdata) if (!strcmp (env_vars[i].name, "HOME") && !appdata)
{ Vdelayed_warnings_list
Lisp_Object warning[2]; = Fcons (listn (HEAP, 2,
warning[0] = intern ("initialization"); intern ("initialization");
warning[1] = build_string ("Setting HOME to C:\\ by default is deprecated"); build_string ("Setting HOME to C:\\ by default is deprecated")),
Vdelayed_warnings_list = Fcons (Flist (2, warning), Vdelayed_warnings_list);
Vdelayed_warnings_list);
}
} }
if (lpval) if (lpval)
......
...@@ -6470,7 +6470,6 @@ The following %-sequences are provided: ...@@ -6470,7 +6470,6 @@ The following %-sequences are provided:
{ {
Lisp_Object line_status, battery_status, battery_status_symbol; Lisp_Object line_status, battery_status, battery_status_symbol;
Lisp_Object load_percentage, seconds, minutes, hours, remain; Lisp_Object load_percentage, seconds, minutes, hours, remain;
Lisp_Object sequences[8];
long seconds_left = (long) system_status.BatteryLifeTime; long seconds_left = (long) system_status.BatteryLifeTime;
...@@ -6544,16 +6543,16 @@ The following %-sequences are provided: ...@@ -6544,16 +6543,16 @@ The following %-sequences are provided:
_snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60); _snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
remain = build_string (buffer); remain = build_string (buffer);
} }
sequences[0] = Fcons (make_number ('L'), line_status);
sequences[1] = Fcons (make_number ('B'), battery_status); status = listn (HEAP, 8,
sequences[2] = Fcons (make_number ('b'), battery_status_symbol); Fcons (make_number ('L'), line_status),
sequences[3] = Fcons (make_number ('p'), load_percentage); Fcons (make_number ('B'), battery_status),
sequences[4] = Fcons (make_number ('s'), seconds); Fcons (make_number ('b'), battery_status_symbol),
sequences[5] = Fcons (make_number ('m'), minutes); Fcons (make_number ('p'), load_percentage),
sequences[6] = Fcons (make_number ('h'), hours); Fcons (make_number ('s'), seconds),
sequences[7] = Fcons (make_number ('t'), remain); Fcons (make_number ('m'), minutes),
Fcons (make_number ('h'), hours),
status = Flist (8, sequences); Fcons (make_number ('t'), remain));
} }
return status; return status;
} }
...@@ -6795,7 +6794,7 @@ syms_of_w32fns (void) ...@@ -6795,7 +6794,7 @@ syms_of_w32fns (void)
Fput (Qundefined_color, Qerror_conditions, Fput (Qundefined_color, Qerror_conditions,
pure_cons (Qundefined_color, pure_cons (Qerror, Qnil))); listn (PURE, 2, Qundefined_color, Qerror);
Fput (Qundefined_color, Qerror_message, Fput (Qundefined_color, Qerror_message,
build_pure_c_string ("Undefined color")); build_pure_c_string ("Undefined color"));
......
...@@ -28932,14 +28932,14 @@ and is used only on frames for which no explicit name has been set ...@@ -28932,14 +28932,14 @@ and is used only on frames for which no explicit name has been set
\(see `modify-frame-parameters'). */); \(see `modify-frame-parameters'). */);
Vicon_title_format Vicon_title_format
= Vframe_title_format = Vframe_title_format
= pure_cons (intern_c_string ("multiple-frames"), = listn (PURE, 3,
pure_cons (build_pure_c_string ("%b"), intern_c_string ("multiple-frames"),
pure_cons (pure_cons (empty_unibyte_string, build_pure_c_string ("%b"),
pure_cons (intern_c_string ("invocation-name"), listn (PURE, 4,
pure_cons (build_pure_c_string ("@"), empty_unibyte_string,
pure_cons (intern_c_string ("system-name"), intern_c_string ("invocation-name"),
Qnil)))), build_pure_c_string ("@"),
Qnil))); intern_c_string ("system-name")));
   
DEFVAR_LISP ("message-log-max", Vmessage_log_max, DEFVAR_LISP ("message-log-max", Vmessage_log_max,
doc: /* Maximum number of lines to keep in the message log buffer. doc: /* Maximum number of lines to keep in the message log buffer.
......
...@@ -5822,7 +5822,7 @@ syms_of_xfns (void) ...@@ -5822,7 +5822,7 @@ syms_of_xfns (void)
/* This is the end of symbol initialization. */ /* This is the end of symbol initialization. */
Fput (Qundefined_color, Qerror_conditions, Fput (Qundefined_color, Qerror_conditions,
pure_cons (Qundefined_color, pure_cons (Qerror, Qnil))); listn (PURE, 2, Qundefined_color, Qerror));
Fput (Qundefined_color, Qerror_message, Fput (Qundefined_color, Qerror_message,
build_pure_c_string ("Undefined color")); build_pure_c_string ("Undefined color"));
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment