X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/938d65136b6d8c4ea91313216c873d2084be4240..21d1f8b85eec8fc1f87bb30398e449f6b20b6ecc:/src/fns.c diff --git a/src/fns.c b/src/fns.c index e891fdbf1d..4c7095133e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1,6 +1,6 @@ /* Random utility Lisp functions. -Copyright (C) 1985-1987, 1993-1995, 1997-2014 Free Software Foundation, +Copyright (C) 1985-1987, 1993-1995, 1997-2015 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -41,22 +41,13 @@ along with GNU Emacs. If not, see . */ #include "xterm.h" #endif -Lisp_Object Qstring_lessp; -static Lisp_Object Qstring_collate_lessp, Qstring_collate_equalp; -static Lisp_Object Qprovide, Qrequire; -static Lisp_Object Qyes_or_no_p_history; -Lisp_Object Qcursor_in_echo_area; -static Lisp_Object Qwidget_type; -static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; - -static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512; - static void sort_vector_copy (Lisp_Object, ptrdiff_t, Lisp_Object [restrict], Lisp_Object [restrict]); static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, - doc: /* Return the argument unchanged. */) + doc: /* Return the argument unchanged. */ + attributes: const) (Lisp_Object arg) { return arg; @@ -449,21 +440,14 @@ static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object concat2 (Lisp_Object s1, Lisp_Object s2) { - Lisp_Object args[2]; - args[0] = s1; - args[1] = s2; - return concat (2, args, Lisp_String, 0); + return concat (2, ((Lisp_Object []) {s1, s2}), Lisp_String, 0); } /* ARGSUSED */ Lisp_Object concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3) { - Lisp_Object args[3]; - args[0] = s1; - args[1] = s2; - args[2] = s3; - return concat (3, args, Lisp_String, 0); + return concat (3, ((Lisp_Object []) {s1, s2, s3}), Lisp_String, 0); } DEFUN ("append", Fappend, Sappend, 0, MANY, 0, @@ -2264,12 +2248,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, if (depth > 200) error ("Stack overflow in equal"); if (NILP (ht)) - { - Lisp_Object args[2]; - args[0] = QCtest; - args[1] = Qeq; - ht = Fmake_hash_table (2, args); - } + ht = CALLN (Fmake_hash_table, QCtest, Qeq); switch (XTYPE (o1)) { case Lisp_Cons: case Lisp_Misc: case Lisp_Vectorlike: @@ -2473,10 +2452,7 @@ This makes STRING unibyte and may change its length. */) Lisp_Object nconc2 (Lisp_Object s1, Lisp_Object s2) { - Lisp_Object args[2]; - args[0] = s1; - args[1] = s2; - return Fnconc (2, args); + return CALLN (Fnconc, s1, s2); } DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0, @@ -2526,16 +2502,14 @@ usage: (nconc &rest LISTS) */) static void mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) { - register Lisp_Object tail; - Lisp_Object dummy; - register EMACS_INT i; + Lisp_Object tail, dummy; + EMACS_INT i; struct gcpro gcpro1, gcpro2, gcpro3; if (vals) { /* Don't let vals contain any garbage when GC happens. */ - for (i = 0; i < leni; i++) - vals[i] = Qnil; + memclear (vals, leni * word_size); GCPRO3 (dummy, fn, seq); gcpro1.var = vals; @@ -2726,7 +2700,7 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) } AUTO_STRING (yes_or_no, "(yes or no) "); - prompt = Fconcat (2, (Lisp_Object []) {prompt, yes_or_no}); + prompt = CALLN (Fconcat, prompt, yes_or_no); GCPRO1 (prompt); while (1) @@ -2788,8 +2762,6 @@ advisable. */) return ret; } -static Lisp_Object Qsubfeatures; - DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0, doc: /* Return t if FEATURE is present in this Emacs. @@ -2808,8 +2780,6 @@ SUBFEATURE can be used to check a specific subfeature of FEATURE. */) return (NILP (tem)) ? Qnil : Qt; } -static Lisp_Object Qfuncall; - DEFUN ("provide", Fprovide, Sprovide, 1, 2, 0, doc: /* Announce that FEATURE is a feature of the current Emacs. The optional argument SUBFEATURES should be a list of symbols listing @@ -3010,15 +2980,13 @@ usage: (widget-apply WIDGET PROPERTY &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { /* This function can GC. */ - Lisp_Object newargs[3]; struct gcpro gcpro1, gcpro2; - Lisp_Object result; - - newargs[0] = Fwidget_get (args[0], args[1]); - newargs[1] = args[0]; - newargs[2] = Flist (nargs - 2, args + 2); - GCPRO2 (newargs[0], newargs[2]); - result = Fapply (3, newargs); + Lisp_Object widget = args[0]; + Lisp_Object property = args[1]; + Lisp_Object propval = Fwidget_get (widget, property); + Lisp_Object trailing_args = Flist (nargs - 2, args + 2); + GCPRO2 (propval, trailing_args); + Lisp_Object result = CALLN (Fapply, propval, widget, trailing_args); UNGCPRO; return result; } @@ -3596,14 +3564,6 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, static struct Lisp_Hash_Table *weak_hash_tables; -/* Various symbols. */ - -static Lisp_Object Qhash_table_p; -static Lisp_Object Qkey, Qvalue, Qeql; -Lisp_Object Qeq, Qequal; -Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; -static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; - /*********************************************************************** Utilities @@ -3709,7 +3669,7 @@ Lisp_Object larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) { struct Lisp_Vector *v; - ptrdiff_t i, incr, incr_max, old_size, new_size; + ptrdiff_t incr, incr_max, old_size, new_size; ptrdiff_t C_language_max = min (PTRDIFF_MAX, SIZE_MAX) / sizeof *v->contents; ptrdiff_t n_max = (0 <= nitems_max && nitems_max < C_language_max ? nitems_max : C_language_max); @@ -3723,8 +3683,7 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) new_size = old_size + incr; v = allocate_vector (new_size); memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents); - for (i = old_size; i < new_size; ++i) - v->contents[i] = Qnil; + memclear (v->contents + old_size, incr * word_size); XSETVECTOR (vec, v); return vec; } @@ -3774,12 +3733,7 @@ cmpfn_user_defined (struct hash_table_test *ht, Lisp_Object key1, Lisp_Object key2) { - Lisp_Object args[3]; - - args[0] = ht->user_cmp_function; - args[1] = key1; - args[2] = key2; - return !NILP (Ffuncall (3, args)); + return !NILP (call2 (ht->user_cmp_function, key1, key2)); } @@ -3827,14 +3781,19 @@ hashfn_equal (struct hash_table_test *ht, Lisp_Object key) static EMACS_UINT hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key) { - Lisp_Object args[2], hash; - - args[0] = ht->user_hash_function; - args[1] = key; - hash = Ffuncall (2, args); + Lisp_Object hash = call1 (ht->user_hash_function, key); return hashfn_eq (ht, hash); } +/* Allocate basically initialized hash table. */ + +static struct Lisp_Hash_Table * +allocate_hash_table (void) +{ + return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, + count, PVEC_HASH_TABLE); +} + /* An upper bound on the size of a hash table index. It must fit in ptrdiff_t and be a valid Emacs fixnum. */ #define INDEX_SIZE_BOUND \ @@ -3995,9 +3954,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) #ifdef ENABLE_CHECKING if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) - Fmessage (2, ((Lisp_Object []) - { build_string ("Growing hash table to: %d"), - make_number (new_size) })); + CALLN (Fmessage, build_string ("Growing hash table to: %d"), + make_number (new_size)); #endif set_hash_key_and_value (h, larger_vector (h->key_and_value, @@ -4774,17 +4732,10 @@ FUNCTION is called with two arguments, KEY and VALUE. (Lisp_Object function, Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); - Lisp_Object args[3]; - ptrdiff_t i; - for (i = 0; i < HASH_TABLE_SIZE (h); ++i) + for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) if (!NILP (HASH_HASH (h, i))) - { - args[0] = function; - args[1] = HASH_KEY (h, i); - args[2] = HASH_VALUE (h, i); - Ffuncall (3, args); - } + call2 (function, HASH_KEY (h, i), HASH_VALUE (h, i)); return Qnil; } @@ -4926,11 +4877,9 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, if (NILP (coding_system) && !NILP (Fbuffer_file_name (object))) { /* Check file-coding-system-alist. */ - Lisp_Object args[4], val; - - args[0] = Qwrite_region; args[1] = start; args[2] = end; - args[3] = Fbuffer_file_name (object); - val = Ffind_operation_coding_system (4, args); + Lisp_Object val = CALLN (Ffind_operation_coding_system, + Qwrite_region, start, end, + Fbuffer_file_name (object)); if (CONSP (val) && !NILP (XCDR (val))) coding_system = XCDR (val); }