xemacs-beta: src/fns.c comparison

comparison src/fns.c @ 434:9d177e8d4150 r21-2-25

Import from CVS: tag r21-2-25

author	cvs
date	Mon, 13 Aug 2007 11:30:53 +0200
parents	3ecd8885ac67
children	84b14dcb0985

comparison

equal deleted inserted replaced

-:892ca416f0fb
+:9d177e8d4150
 if (nil_means_not_present && NILP (v)) continue;
 for (i = 0; i < fill; i++)
 	{
 	  if (!laxp ? EQ (k, keys [i]) : internal_equal (k, keys [i], depth))
 	    {
-	      if ((eqp
+	      if (eqp
-		   /* We narrowly escaped being Ebolified here. */
+		  /* We narrowly escaped being Ebolified here. */
-		   ? !EQ_WITH_EBOLA_NOTICE (v, vals [i])
+		  ? !EQ_WITH_EBOLA_NOTICE (v, vals [i])
-		   : !internal_equal (v, vals [i], depth)))
+		  : !internal_equal (v, vals [i], depth))
 		/* a property in B has a different value than in A */
 		goto MISMATCH;
 	      flags [i] = 1;
 	      break;
 	    }
 return internal_old_equal (obj1, obj2, 0) ? Qt : Qnil;
 }
 DEFUN ("fillarray", Ffillarray, 2, 2, 0, /*
-Store each element of ARRAY with ITEM.
+Destructively modify ARRAY by replacing each element with ITEM.
 ARRAY is a vector, bit vector, or string.
 */
 (array, item))
 {
 retry:
 if (STRINGP (array))
 {
-Emchar charval;
 struct Lisp_String *s = XSTRING (array);
-Charcount len = string_char_length (s);
+Bytecount old_bytecount = string_length (s);
-Charcount i;
+Bytecount new_bytecount;
+Bytecount item_bytecount;
+Bufbyte item_buf[MAX_EMCHAR_LEN];
+Bufbyte *p;
+Bufbyte *end;
 CHECK_CHAR_COERCE_INT (item);
 CHECK_LISP_WRITEABLE (array);
-charval = XCHAR (item);
-for (i = 0; i < len; i++)
+item_bytecount = set_charptr_emchar (item_buf, XCHAR (item));
-	set_string_char (s, i, charval);
+new_bytecount = item_bytecount * string_char_length (s);
+resize_string (s, -1, new_bytecount - old_bytecount);
+for (p = string_data (s), end = p + new_bytecount;
+	   p < end;
+	   p += item_bytecount)
+	memcpy (p, item_buf, item_bytecount);
+*p = '\0';
 bump_string_modiff (array);
 }
 else if (VECTORP (array))
 {
 Lisp_Object *p = XVECTOR_DATA (array);
 }
 RETURN_UNGCPRO (Qnil);  /* No non-nil args provided. */
 }
-/* This is the guts of all mapping functions.
+/* This is the guts of several mapping functions.
-Apply fn to each element of seq, one by one,
+Apply FUNCTION to each element of SEQUENCE, one by one,
-storing the results into elements of vals, a C vector of Lisp_Objects.
+storing the results into elements of VALS, a C vector of Lisp_Objects.
-leni is the length of vals, which should also be the length of seq.
+LENI is the length of VALS, which should also be the length of SEQUENCE.
 If VALS is a null pointer, do not accumulate the results. */
 static void
-mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
+mapcar1 (size_t leni, Lisp_Object *vals,
+	 Lisp_Object function, Lisp_Object sequence)
 {
 Lisp_Object result;
 Lisp_Object args[2];
 int i;
 struct gcpro gcpro1;
 {
 GCPRO1 (vals[0]);
 gcpro1.nvars = 0;
 }
-args[0] = fn;
+args[0] = function;
-if (LISTP (seq))
+if (LISTP (sequence))
 {
-for (i = 0; i < leni; i++)
+/* A devious `function' could either:
-	{
+	 - insert garbage into the list in front of us, causing XCDR to crash
-	  args[1] = XCAR (seq);
+	 - amputate the list behind us using (setcdr), causing the remaining
-	  seq = XCDR (seq);
+	   elts to lose their GCPRO status.
-	  result = Ffuncall (2, args);
-	  if (vals) vals[gcpro1.nvars++] = result;
+	 if (vals != 0) we avoid this by copying the elts into the
-	}
+	 `vals' array.  By a stroke of luck, `vals' is exactly large
-}
+	 enough to hold the elts left to be traversed as well as the
-else if (VECTORP (seq))
+	 results computed so far.
-{
-Lisp_Object *objs = XVECTOR_DATA (seq);
+	 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. */
+if (vals)
+	{
+	  Lisp_Object *val = vals;
+	  Lisp_Object elt;
+	  LIST_LOOP_2 (elt, sequence)
+	      *val++ = elt;
+	  gcpro1.nvars = leni;
+	  for (i = 0; i < leni; i++)
+	    {
+	      args[1] = vals[i];
+	      vals[i] = Ffuncall (2, args);
+	    }
+	}
+else
+	{
+	  Lisp_Object elt, tail;
+	  struct gcpro ngcpro1;
+	  NGCPRO1 (tail);
+	  {
+	    EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
+	      {
+		args[1] = elt;
+		Ffuncall (2, args);
+	      }
+	  }
+	  NUNGCPRO;
+	}
+}
+else if (VECTORP (sequence))
+{
+Lisp_Object *objs = XVECTOR_DATA (sequence);
 for (i = 0; i < leni; i++)
 	{
 	  args[1] = *objs++;
 	  result = Ffuncall (2, args);
 	  if (vals) vals[gcpro1.nvars++] = result;
 	}
 }
-else if (STRINGP (seq))
+else if (STRINGP (sequence))
 {
-Bufbyte *p = XSTRING_DATA (seq);
+/* The string data of `sequence' might be relocated during GC. */
-for (i = 0; i < leni; i++)
+Bytecount slen = XSTRING_LENGTH (sequence);
+Bufbyte *p = alloca_array (Bufbyte, slen);
+Bufbyte *end = p + slen;
+memcpy (p, XSTRING_DATA (sequence), slen);
+while (p < end)
 	{
 	  args[1] = make_char (charptr_emchar (p));
 	  INC_CHARPTR (p);
 	  result = Ffuncall (2, args);
 	  if (vals) vals[gcpro1.nvars++] = result;
 	}
 }
-else if (BIT_VECTORP (seq))
+else if (BIT_VECTORP (sequence))
 {
-struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq);
+struct Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
 for (i = 0; i < leni; i++)
 	{
 	  args[1] = make_int (bit_vector_bit (v, i));
 	  result = Ffuncall (2, args);
 	  if (vals) vals[gcpro1.nvars++] = result;
 	}
 }
 else
-abort(); /* cannot get here since Flength(seq) did not get an error */
+abort(); /* cannot get here since Flength(sequence) did not get an error */
 if (vals)
 UNGCPRO;
 }
 DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /*
-Apply FN to each element of SEQ, and concat the results as strings.
+Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.
-In between each pair of results, stick in SEP.
+In between each pair of results, insert SEPARATOR.  Thus, using " " as
-Thus, " " as SEP results in spaces between the values returned by FN.
+SEPARATOR results in spaces between the values returned by FUNCTION.
-*/
+SEQUENCE may be a list, a vector, a bit vector, or a string.
-(fn, seq, sep))
+*/
-{
+(function, sequence, separator))
-size_t len = XINT (Flength (seq));
+{
+size_t len = XINT (Flength (sequence));
 Lisp_Object *args;
 int i;
 struct gcpro gcpro1;
 int nargs = len + len - 1;
 if (nargs < 0) return build_string ("");
 args = alloca_array (Lisp_Object, nargs);
-GCPRO1 (sep);
+GCPRO1 (separator);
-mapcar1 (len, args, fn, seq);
+mapcar1 (len, args, function, sequence);
 UNGCPRO;
 for (i = len - 1; i >= 0; i--)
 args[i + i] = args[i];
 for (i = 1; i < nargs; i += 2)
-args[i] = sep;
+args[i] = separator;
 return Fconcat (nargs, args);
 }
 DEFUN ("mapcar", Fmapcar, 2, 2, 0, /*
-Apply FUNCTION to each element of SEQUENCE, and make a list of the results.
+Apply FUNCTION to each element of SEQUENCE; return a list of the results.
-The result is a list just as long as SEQUENCE.
+The result is a list of the same length as SEQUENCE.
 SEQUENCE may be a list, a vector, a bit vector, or a string.
 */
-(fn, seq))
+(function, sequence))
 {
-size_t len = XINT (Flength (seq));
+size_t len = XINT (Flength (sequence));
 Lisp_Object *args = alloca_array (Lisp_Object, len);
-mapcar1 (len, args, fn, seq);
+mapcar1 (len, args, function, sequence);
 return Flist (len, args);
 }
 DEFUN ("mapvector", Fmapvector, 2, 2, 0, /*
-Apply FUNCTION to each element of SEQUENCE, making a vector of the results.
+Apply FUNCTION to each element of SEQUENCE; return a vector of the results.
 The result is a vector of the same length as SEQUENCE.
-SEQUENCE may be a list, a vector or a string.
+SEQUENCE may be a list, a vector, a bit vector, or a string.
 */
-(fn, seq))
+(function, sequence))
 {
-size_t len = XINT (Flength (seq));
+size_t len = XINT (Flength (sequence));
 Lisp_Object result = make_vector (len, Qnil);
 struct gcpro gcpro1;
 GCPRO1 (result);
-mapcar1 (len, XVECTOR_DATA (result), fn, seq);
+mapcar1 (len, XVECTOR_DATA (result), function, sequence);
 UNGCPRO;
 return result;
 }
 which is more efficient if you do not use the results.
 The difference between this and `mapc' is that `mapc' supports all
 the spiffy Common Lisp arguments.  You should normally use `mapc'.
 */
-(fn, seq))
+(function, sequence))
 {
-mapcar1 (XINT (Flength (seq)), 0, fn, seq);
+mapcar1 (XINT (Flength (sequence)), 0, function, sequence);
-return seq;
+return sequence;
 }
 /* #### this function doesn't belong in this file! */

Mercurial > hg > xemacs-beta

comparison src/fns.c @ 434:9d177e8d4150 r21-2-25