diff src/fns.c @ 384:bbff43aa5eb7 r21-2-7

Import from CVS: tag r21-2-7
author cvs
date Mon, 13 Aug 2007 11:08:24 +0200
parents 8626e4521993
children 6719134a07c2
line wrap: on
line diff
--- a/src/fns.c	Mon Aug 13 11:07:40 2007 +0200
+++ b/src/fns.c	Mon Aug 13 11:08:24 2007 +0200
@@ -3037,7 +3037,9 @@
 
   while (argnum < nargs)
     {
-      Lisp_Object val = args[argnum];
+      Lisp_Object val;
+    retry:
+      val = args[argnum];
       if (CONSP (val))
 	{
 	  /* `val' is the first cons, which will be our return value.  */
@@ -3048,7 +3050,7 @@
 	  for (argnum++; argnum < nargs; argnum++)
 	    {
 	      Lisp_Object next = args[argnum];
-	    retry:
+	    retry_next:
 	      if (CONSP (next) || argnum == nargs -1)
 		{
 		  /* (setcdr (last val) next) */
@@ -3073,8 +3075,8 @@
 		}
 	      else
 		{
-		  next = wrong_type_argument (next, Qlistp);
-		  goto retry;
+		  next = wrong_type_argument (Qlistp, next);
+		  goto retry_next;
 		}
 	    }
 	  RETURN_UNGCPRO (val);
@@ -3084,51 +3086,67 @@
       else if (argnum == nargs - 1) /* last arg? */
 	RETURN_UNGCPRO (val);
       else
-	args[argnum] = wrong_type_argument (val, Qlistp);
+	{
+	  args[argnum] = wrong_type_argument (Qlistp, val);
+	  goto retry;
+	}
     }
   RETURN_UNGCPRO (Qnil);  /* No non-nil args provided. */
 }
 
 
 /* This is the guts of all mapping functions.
- Apply fn to each element of seq, one by one,
- 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.
-
- If VALS is a null pointer, do not accumulate the results. */
+   Apply fn to each element of seq, one by one,
+   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.
+
+   If VALS is a null pointer, do not accumulate the results. */
 
 static void
-mapcar1 (int leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
+mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
 {
-  Lisp_Object tail;
-  Lisp_Object dummy = Qnil;
+  Lisp_Object result;
+  Lisp_Object args[2];
   int i;
-  struct gcpro gcpro1, gcpro2, gcpro3;
-  Lisp_Object result;
-
-  GCPRO3 (dummy, fn, seq);
+  struct gcpro gcpro1;
 
   if (vals)
     {
-      /* Don't let vals contain any garbage when GC happens.  */
-      for (i = 0; i < leni; i++)
-	vals[i] = Qnil;
-      gcpro1.var = vals;
-      gcpro1.nvars = leni;
+      GCPRO1 (vals[0]);
+      gcpro1.nvars = 0;
     }
 
-  /* We need not explicitly protect `tail' because it is used only on
-    lists, and 1) lists are not relocated and 2) the list is marked
-    via `seq' so will not be freed */
-
-  if (VECTORP (seq))
+  args[0] = fn;
+
+  if (LISTP (seq))
     {
       for (i = 0; i < leni; i++)
 	{
-	  dummy = XVECTOR_DATA (seq)[i];
-	  result = call1 (fn, dummy);
-	  if (vals)
-	    vals[i] = result;
+	  args[1] = XCAR (seq);
+	  seq = XCDR (seq);
+	  result = Ffuncall (2, args);
+	  if (vals) vals[gcpro1.nvars++] = result;
+	}
+    }
+  else if (VECTORP (seq))
+    {
+      Lisp_Object *objs = XVECTOR_DATA (seq);
+      for (i = 0; i < leni; i++)
+	{
+	  args[1] = *objs++;
+	  result = Ffuncall (2, args);
+	  if (vals) vals[gcpro1.nvars++] = result;
+	}
+    }
+  else if (STRINGP (seq))
+    {
+      Bufbyte *p = XSTRING_DATA (seq);
+      for (i = 0; i < leni; i++)
+	{
+	  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))
@@ -3136,34 +3154,16 @@
       struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq);
       for (i = 0; i < leni; i++)
 	{
-	  XSETINT (dummy, bit_vector_bit (v, i));
-	  result = call1 (fn, dummy);
-	  if (vals)
-	    vals[i] = result;
+	  args[1] = make_int (bit_vector_bit (v, i));
+	  result = Ffuncall (2, args);
+	  if (vals) vals[gcpro1.nvars++] = result;
 	}
     }
-  else if (STRINGP (seq))
-    {
-      for (i = 0; i < leni; i++)
-	{
-	  result = call1 (fn, make_char (string_char (XSTRING (seq), i)));
-	  if (vals)
-	    vals[i] = result;
-	}
-    }
-  else   /* Must be a list, since Flength did not get an error */
-    {
-      tail = seq;
-      for (i = 0; i < leni; i++)
-	{
-	  result = call1 (fn, Fcar (tail));
-	  if (vals)
-	    vals[i] = result;
-	  tail = Fcdr (tail);
-	}
-    }
-
-  UNGCPRO;
+  else
+    abort(); /* cannot get here since Flength(seq) did not get an error */
+
+  if (vals)
+    UNGCPRO;
 }
 
 DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /*
@@ -3173,7 +3173,7 @@
 */
        (fn, seq, sep))
 {
-  int len = XINT (Flength (seq));
+  size_t len = XINT (Flength (seq));
   Lisp_Object *args;
   int i;
   struct gcpro gcpro1;
@@ -3203,7 +3203,7 @@
 */
        (fn, seq))
 {
-  int len = XINT (Flength (seq));
+  size_t len = XINT (Flength (seq));
   Lisp_Object *args = alloca_array (Lisp_Object, len);
 
   mapcar1 (len, args, fn, seq);
@@ -3218,9 +3218,7 @@
 */
        (fn, seq))
 {
-  int len = XINT (Flength (seq));
-  /* Ideally, this should call make_vector_internal, because we don't
-     need initialization.  */
+  size_t len = XINT (Flength (seq));
   Lisp_Object result = make_vector (len, Qnil);
   struct gcpro gcpro1;