X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Ffns.c;h=3162a1a6936857e762ea57b5b2557423025f8a54;hp=d5f5ae3fe83f484ca9f109b360bb24873e3709ed;hb=59eec5f21669e81977b5b1fe9bf717cab49cf7fb;hpb=3e447015251ce6dcde843cbed10d9033d5538622 diff --git a/src/fns.c b/src/fns.c index d5f5ae3..3162a1a 100644 --- a/src/fns.c +++ b/src/fns.c @@ -36,10 +36,7 @@ Boston, MA 02111-1307, USA. */ #include "lisp.h" -#ifdef HAVE_UNISTD_H -#include -#endif -#include +#include "sysfile.h" #include "buffer.h" #include "bytecode.h" @@ -115,8 +112,8 @@ static size_t size_bit_vector (const void *lheader) { Lisp_Bit_Vector *v = (Lisp_Bit_Vector *) lheader; - return offsetof (Lisp_Bit_Vector, - bits[BIT_VECTOR_LONG_STORAGE (bit_vector_length (v))]); + return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, + BIT_VECTOR_LONG_STORAGE (bit_vector_length (v))); } static const struct lrecord_description bit_vector_description[] = { @@ -713,6 +710,7 @@ concat (int nargs, Lisp_Object *args, string_result_ptr = string_result; break; default: + val = Qnil; abort (); } } @@ -992,7 +990,11 @@ are copied to the new string. return result; } else - abort (); /* unreachable, since Flength (sequence) did not get an error */ + { + abort (); /* unreachable, since Flength (sequence) did not get + an error */ + return Qnil; + } } @@ -1218,7 +1220,6 @@ The value is actually the tail of LIST whose car is ELT. */ (elt, list)) { - Lisp_Object list_elt, tail; EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) { if (internal_equal (elt, list_elt, 0)) @@ -1235,7 +1236,6 @@ Do not use it. */ (elt, list)) { - Lisp_Object list_elt, tail; EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) { if (internal_old_equal (elt, list_elt, 0)) @@ -1250,7 +1250,6 @@ The value is actually the tail of LIST whose car is ELT. */ (elt, list)) { - Lisp_Object list_elt, tail; EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) { if (EQ_WITH_EBOLA_NOTICE (elt, list_elt)) @@ -1267,7 +1266,6 @@ Do not use it. */ (elt, list)) { - Lisp_Object list_elt, tail; EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) { if (HACKEQ_UNSAFE (elt, list_elt)) @@ -1279,7 +1277,6 @@ Do not use it. Lisp_Object memq_no_quit (Lisp_Object elt, Lisp_Object list) { - Lisp_Object list_elt, tail; LIST_LOOP_3 (list_elt, list, tail) { if (EQ_WITH_EBOLA_NOTICE (elt, list_elt)) @@ -1295,7 +1292,6 @@ The value is actually the element of LIST whose car equals KEY. (key, list)) { /* This function can GC. */ - Lisp_Object elt, elt_car, elt_cdr; EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) { if (internal_equal (key, elt_car, 0)) @@ -1311,7 +1307,6 @@ The value is actually the element of LIST whose car equals KEY. (key, list)) { /* This function can GC. */ - Lisp_Object elt, elt_car, elt_cdr; EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) { if (internal_old_equal (key, elt_car, 0)) @@ -1335,7 +1330,6 @@ Elements of LIST that are not conses are ignored. */ (key, list)) { - Lisp_Object elt, elt_car, elt_cdr; EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) { if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) @@ -1353,7 +1347,6 @@ Do not use it. */ (key, list)) { - Lisp_Object elt, elt_car, elt_cdr; EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) { if (HACKEQ_UNSAFE (key, elt_car)) @@ -1369,7 +1362,6 @@ Lisp_Object assq_no_quit (Lisp_Object key, Lisp_Object list) { /* This cannot GC. */ - Lisp_Object elt; LIST_LOOP_2 (elt, list) { Lisp_Object elt_car = XCAR (elt); @@ -1385,7 +1377,6 @@ The value is actually the element of LIST whose cdr equals KEY. */ (key, list)) { - Lisp_Object elt, elt_car, elt_cdr; EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) { if (internal_equal (key, elt_cdr, 0)) @@ -1400,7 +1391,6 @@ The value is actually the element of LIST whose cdr equals KEY. */ (key, list)) { - Lisp_Object elt, elt_car, elt_cdr; EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) { if (internal_old_equal (key, elt_cdr, 0)) @@ -1415,7 +1405,6 @@ The value is actually the element of LIST whose cdr is KEY. */ (key, list)) { - Lisp_Object elt, elt_car, elt_cdr; EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) { if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr)) @@ -1430,7 +1419,6 @@ The value is actually the element of LIST whose cdr is KEY. */ (key, list)) { - Lisp_Object elt, elt_car, elt_cdr; EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) { if (HACKEQ_UNSAFE (key, elt_cdr)) @@ -1444,7 +1432,6 @@ The value is actually the element of LIST whose cdr is KEY. Lisp_Object rassq_no_quit (Lisp_Object key, Lisp_Object list) { - Lisp_Object elt; LIST_LOOP_2 (elt, list) { Lisp_Object elt_cdr = XCDR (elt); @@ -1465,7 +1452,6 @@ Also see: `remove'. */ (elt, list)) { - Lisp_Object list_elt; EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, (internal_equal (elt, list_elt, 0))); return list; @@ -1480,7 +1466,6 @@ of changing the value of `foo'. */ (elt, list)) { - Lisp_Object list_elt; EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, (internal_old_equal (elt, list_elt, 0))); return list; @@ -1495,7 +1480,6 @@ changing the value of `foo'. */ (elt, list)) { - Lisp_Object list_elt; EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); return list; @@ -1510,7 +1494,6 @@ changing the value of `foo'. */ (elt, list)) { - Lisp_Object list_elt; EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, (HACKEQ_UNSAFE (elt, list_elt))); return list; @@ -1522,7 +1505,6 @@ changing the value of `foo'. Lisp_Object delq_no_quit (Lisp_Object elt, Lisp_Object list) { - Lisp_Object list_elt; LIST_LOOP_DELETE_IF (list_elt, list, (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); return list; @@ -1572,7 +1554,6 @@ the value of `foo'. */ (key, list)) { - Lisp_Object elt; EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, (CONSP (elt) && internal_equal (key, XCAR (elt), 0))); @@ -1596,7 +1577,6 @@ the value of `foo'. */ (key, list)) { - Lisp_Object elt; EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, (CONSP (elt) && EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); @@ -1608,7 +1588,6 @@ the value of `foo'. Lisp_Object remassq_no_quit (Lisp_Object key, Lisp_Object list) { - Lisp_Object elt; LIST_LOOP_DELETE_IF (elt, list, (CONSP (elt) && EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); @@ -1624,7 +1603,6 @@ the value of `foo'. */ (value, list)) { - Lisp_Object elt; EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, (CONSP (elt) && internal_equal (value, XCDR (elt), 0))); @@ -1640,7 +1618,6 @@ the value of `foo'. */ (value, list)) { - Lisp_Object elt; EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, (CONSP (elt) && EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); @@ -1651,7 +1628,6 @@ the value of `foo'. Lisp_Object remrassq_no_quit (Lisp_Object value, Lisp_Object list) { - Lisp_Object elt; LIST_LOOP_DELETE_IF (elt, list, (CONSP (elt) && EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); @@ -1691,7 +1667,6 @@ See also the function `nreverse', which is used more often. (list)) { Lisp_Object reversed_list = Qnil; - Lisp_Object elt; EXTERNAL_LIST_LOOP_2 (elt, list) { reversed_list = Fcons (elt, reversed_list); @@ -2093,8 +2068,6 @@ static Lisp_Object bad_bad_turtle (Lisp_Object *plist, Lisp_Object *badplace, Error_behavior errb) { if (ERRB_EQ (errb, ERROR_ME)) - /* #### Eek, this will probably result in another error - when PLIST is printed out */ return Fsignal (Qcircular_property_list, list1 (*plist)); else { @@ -2957,12 +2930,11 @@ mapcar1 (size_t leni, Lisp_Object *vals, if (vals == 0) we don't have any free space available and don't want to eat up any more stack with alloca(). - So we use EXTERNAL_LIST_LOOP_3 and GCPRO the tail. */ + So we use EXTERNAL_LIST_LOOP_3_NO_DECLARE and GCPRO the tail. */ if (vals) { Lisp_Object *val = vals; - Lisp_Object elt; LIST_LOOP_2 (elt, sequence) *val++ = elt; @@ -2978,12 +2950,13 @@ mapcar1 (size_t leni, Lisp_Object *vals, else { Lisp_Object elt, tail; + EMACS_INT len_unused; struct gcpro ngcpro1; NGCPRO1 (tail); { - EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len_unused) { args[1] = elt; Ffuncall (2, args); @@ -3115,8 +3088,59 @@ the spiffy Common Lisp arguments. You should normally use `mapc'. } + + +DEFUN ("replace-list", Freplace_list, 2, 2, 0, /* +Destructively replace the list OLD with NEW. +This is like (copy-sequence NEW) except that it reuses the +conses in OLD as much as possible. If OLD and NEW are the same +length, no consing will take place. +*/ + (old, new)) +{ + Lisp_Object tail, oldtail = old, prevoldtail = Qnil; + + EXTERNAL_LIST_LOOP (tail, new) + { + if (!NILP (oldtail)) + { + CHECK_CONS (oldtail); + XCAR (oldtail) = XCAR (tail); + } + else if (!NILP (prevoldtail)) + { + XCDR (prevoldtail) = Fcons (XCAR (tail), Qnil); + prevoldtail = XCDR (prevoldtail); + } + else + old = oldtail = Fcons (XCAR (tail), Qnil); + + if (!NILP (oldtail)) + { + prevoldtail = oldtail; + oldtail = XCDR (oldtail); + } + } + + if (!NILP (prevoldtail)) + XCDR (prevoldtail) = Qnil; + else + old = Qnil; + + return old; +} + + /* #### this function doesn't belong in this file! */ +#ifdef HAVE_GETLOADAVG +#ifdef HAVE_SYS_LOADAVG_H +#include +#endif +#else +int getloadavg (double loadavg[], int nelem); /* Defined in getloadavg.c */ +#endif + DEFUN ("load-average", Fload_average, 0, 1, 0, /* Return list of 1 minute, 5 minute and 15 minute load averages. Each of the three load averages is multiplied by 100, @@ -3186,10 +3210,13 @@ Examples: (featurep '(or (and xemacs 19.15) (and emacs 19.34))) => ; Non-nil on XEmacs 19.15 and later, or FSF Emacs 19.34 and later. + (featurep '(and xemacs 21.02)) + => ; Non-nil on XEmacs 21.2 and later. + NOTE: The advanced arguments of this function (anything other than a symbol) are not yet supported by FSF Emacs. If you feel they are useful for supporting multiple Emacs variants, lobby Richard Stallman at -. +. */ (fexp)) { @@ -3719,6 +3746,8 @@ Lisp_Object Qyes_or_no_p; void syms_of_fns (void) { + INIT_LRECORD_IMPLEMENTATION (bit_vector); + defsymbol (&Qstring_lessp, "string-lessp"); defsymbol (&Qidentity, "identity"); defsymbol (&Qyes_or_no_p, "yes-or-no-p"); @@ -3798,6 +3827,7 @@ syms_of_fns (void) DEFSUBR (Fmapvector); DEFSUBR (Fmapc_internal); DEFSUBR (Fmapconcat); + DEFSUBR (Freplace_list); DEFSUBR (Fload_average); DEFSUBR (Ffeaturep); DEFSUBR (Frequire);