--- a/lisp/ChangeLog	Sat Feb 06 04:27:47 2010 -0600
+++ b/lisp/ChangeLog	Sat Feb 06 12:28:19 2010 +0000
@@ -4,6 +4,14 @@
 	* unicode.el (for):
 	Convert file to utf-8.
 
+2010-02-03  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-extra.el (some, every):
+	Move these functions to C.
+	* cl-macs.el (notany, notevery): Add compiler macros for these
+	functions, no longer proclaim them inline (which would involve
+	specbinding that's not necessary with the compiler macros).
+
 2010-02-06  Ben Wing  <ben@xemacs.org>
 
 	* code-init.el:
@@ -310,6 +318,27 @@
 	Upper and lowercase mappings were reversed for some old-Cyrillic
 	chars.
 
+2010-01-31  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl.el (mapcar*): Delete; this is now in fns.c.
+	Use #'mapc, not #'mapc-internal in a couple of places.
+	* cl-macs.el (mapc, mapcar*, map): Delete these compiler macros
+	now the corresponding functions are in fns.c; there's no run-time
+	advantage to the macros.
+	* cl-extra.el (coerce): Extend the possible conversions here a
+	little; it's not remotely comprehensive yet, though it does allow
+	running slightly more Common Lisp code than previously.
+	(cl-mapcar-many): Delete.
+	(map, maplist, mapc, mapl, mapcan, mapcon): Move these to fns.c.
+	* bytecomp.el (byte-compile-maybe-mapc):
+	Use #'mapc itself, not #'mapc-internal, now the former is in C.
+	(mapcar*): Use #'byte-compile-maybe-mapc as this function's
+	byte-compile method, now a #'mapc that can take more than one
+	sequence is in C.
+	* obsolete.el (cl-mapc): Move this compatibility alias to this file.
+	* update-elc.el (do-autoload-commands): Use #'mapc, not
+	#'mapc-internal here. 
+	
 2010-01-26  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* mule/vietnamese.el (viscii): Correct the mapping here, #xA6 is

--- a/lisp/bytecomp.el	Sat Feb 06 04:27:47 2010 -0600
+++ b/lisp/bytecomp.el	Sat Feb 06 12:28:19 2010 +0000
@@ -3563,7 +3563,7 @@
 	   (byte-compile-warn
 	    "Discarding the result of #'%s; maybe you meant #'mapc?"
 	    (car form)))
-       (setq form (cons 'mapc-internal (cdr form))))
+       (setq form (cons 'mapc (cdr form))))
   (byte-compile-funarg form))
 
 (defun byte-compile-maplist (form)
@@ -3768,7 +3768,7 @@
 (byte-defop-compiler-1 map-plist byte-compile-funarg)
 (byte-defop-compiler-1 map-range-table byte-compile-funarg)
 (byte-defop-compiler-1 map-syntax-table byte-compile-funarg)
-(byte-defop-compiler-1 mapcar* byte-compile-funarg)
+(byte-defop-compiler-1 mapcar* byte-compile-maybe-mapc)
 
 (byte-defop-compiler-1 remove-if byte-compile-funarg)
 (byte-defop-compiler-1 remove-if-not byte-compile-funarg)

--- a/lisp/cl-extra.el	Sat Feb 06 04:27:47 2010 -0600
+++ b/lisp/cl-extra.el	Sat Feb 06 12:28:19 2010 +0000
@@ -75,14 +75,27 @@
 	   (memq type '(integer ratio bigfloat))
 	   (coerce-number x type)))
 	;; XEmacs addition: bit-vector coercion
-	((eq type 'bit-vector) (if (bit-vector-p x) x
-				 (apply 'bit-vector (append x nil))))
+	((or (eq type 'bit-vector)
+	     (eq type 'simple-bit-vector))
+	 (if (bit-vector-p x) x (apply 'bit-vector (append x nil))))
 	;; XEmacs addition: weak-list coercion
 	((eq type 'weak-list)
 	 (if (weak-list-p x) x
 	   (let ((wl (make-weak-list)))
 	     (set-weak-list-list wl (if (listp x) x (append x nil)))
 	     wl)))
+	((and
+	  (consp type)
+	  (or (eq (car type) 'vector)
+	      (eq (car type) 'simple-array)
+	      (eq (car type) 'simple-vector))
+	  (cond
+	   ((equal (cdr-safe type) '(*))
+	    (coerce x 'vector))
+	   ((equal (cdr-safe type) '(bit))
+	    (coerce x 'bit-vector))
+	   ((equal (cdr-safe type) '(character))
+	    (coerce x 'string)))))
 	((typep x type) x)
 	(t (error "Can't coerce %s to type %s" x type))))
 
@@ -212,120 +225,8 @@
 ;;		      (and (equal "" y) (equal #* x)))))
 ;;		 (t (equal x y)))))))
 
-;;; Control structures.
-
-(defun cl-mapcar-many (cl-func cl-seqs)
-  (if (cdr (cdr cl-seqs))
-      (let* ((cl-res nil)
-	     (cl-n (apply 'min (mapcar 'length cl-seqs)))
-	     (cl-i 0)
-	     (cl-args (copy-sequence cl-seqs))
-	     cl-p1 cl-p2)
-	(setq cl-seqs (copy-sequence cl-seqs))
-	(while (< cl-i cl-n)
-	  (setq cl-p1 cl-seqs cl-p2 cl-args)
-	  (while cl-p1
-	    (setcar cl-p2
-		    (if (consp (car cl-p1))
-			(prog1 (car (car cl-p1))
-			  (setcar cl-p1 (cdr (car cl-p1))))
-		      (aref (car cl-p1) cl-i)))
-	    (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))
-	  (push (apply cl-func cl-args) cl-res)
-	  (setq cl-i (1+ cl-i)))
-	(nreverse cl-res))
-    (let ((cl-res nil)
-	  (cl-x (car cl-seqs))
-	  (cl-y (nth 1 cl-seqs)))
-      (let ((cl-n (min (length cl-x) (length cl-y)))
-	    (cl-i -1))
-	(while (< (setq cl-i (1+ cl-i)) cl-n)
-	  (push (funcall cl-func
-			    (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
-			    (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
-		   cl-res)))
-      (nreverse cl-res))))
-
-(defun map (cl-type cl-func cl-seq &rest cl-rest)
-  "Map a function across one or more sequences, returning a sequence.
-TYPE is the sequence type to return, FUNC is the function, and SEQS
-are the argument sequences."
-  (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest)))
-    (and cl-type (coerce cl-res cl-type))))
-
-(defun maplist (cl-func cl-list &rest cl-rest)
-  "Map FUNC to each sublist of LIST or LISTS.
-Like `mapcar', except applies to lists and their cdr's rather than to
-the elements themselves."
-  (if cl-rest
-      (let ((cl-res nil)
-	    (cl-args (cons cl-list (copy-sequence cl-rest)))
-	    cl-p)
-	(while (not (memq nil cl-args))
-	  (push (apply cl-func cl-args) cl-res)
-	  (setq cl-p cl-args)
-	  (while cl-p (setcar cl-p (cdr (pop cl-p)) )))
-	(nreverse cl-res))
-    (let ((cl-res nil))
-      (while cl-list
-	(push (funcall cl-func cl-list) cl-res)
-	(setq cl-list (cdr cl-list)))
-      (nreverse cl-res))))
-
-;; XEmacs change: in Emacs, this function is named cl-mapc.
-(defun mapc (cl-func cl-seq &rest cl-rest)
-  "Like `mapcar', but does not accumulate values returned by the function."
-  (if cl-rest
-      (apply 'map nil cl-func cl-seq cl-rest)
-    ;; XEmacs change: in the simplest case we call mapc-internal,
-    ;; which really doesn't accumulate any results.
-    (mapc-internal cl-func cl-seq))
-  cl-seq)
-
-;; XEmacs addition: FSF compatibility
-(defalias 'cl-mapc 'mapc)
-
-(defun mapl (cl-func cl-list &rest cl-rest)
-  "Like `maplist', but does not accumulate values returned by the function."
-  (if cl-rest
-      (apply 'maplist cl-func cl-list cl-rest)
-    (let ((cl-p cl-list))
-      (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p)))))
-  cl-list)
-
-(defun mapcan (cl-func cl-seq &rest cl-rest)
-  "Like `mapcar', but nconc's together the values returned by the function."
-  (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest)))
-
-(defun mapcon (cl-func cl-list &rest cl-rest)
-  "Like `maplist', but nconc's together the values returned by the function."
-  (apply 'nconc (apply 'maplist cl-func cl-list cl-rest)))
-
-(defun some (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is true of any element of SEQ or SEQs.
-If so, return the true (non-nil) value returned by PREDICATE."
-  (if (or cl-rest (nlistp cl-seq))
-      (catch 'cl-some
-	(apply 'map nil
-	       (function (lambda (&rest cl-x)
-			   (let ((cl-res (apply cl-pred cl-x)))
-			     (if cl-res (throw 'cl-some cl-res)))))
-	       cl-seq cl-rest) nil)
-    (let ((cl-x nil))
-      (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq))))))
-      cl-x)))
-
-(defun every (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is true of every element of SEQ or SEQs."
-  (if (or cl-rest (nlistp cl-seq))
-      (catch 'cl-every
-	(apply 'map nil
-	       (function (lambda (&rest cl-x)
-			   (or (apply cl-pred cl-x) (throw 'cl-every nil))))
-	       cl-seq cl-rest) t)
-    (while (and cl-seq (funcall cl-pred (car cl-seq)))
-      (setq cl-seq (cdr cl-seq)))
-    (null cl-seq)))
+;; XEmacs; #'map, #'mapc, #'mapl, #'maplist, #'mapcon, #'some and #'every
+;; are now in C, together with #'map-into, which was never in this file.
 
 (defun notany (cl-pred cl-seq &rest cl-rest)
   "Return true if PREDICATE is false of every element of SEQ or SEQs."

--- a/lisp/cl-macs.el	Sat Feb 06 04:27:47 2010 -0600
+++ b/lisp/cl-macs.el	Sat Feb 06 12:28:19 2010 +0000
@@ -3337,18 +3337,6 @@
           (t
            form))))
 
-;; XEmacs change, the GNU mapc doesn't accept the Common Lisp args, so this
-;; change isn't helpful.
-(define-compiler-macro mapc (&whole form cl-func cl-seq &rest cl-rest)
-  (if cl-rest
-      form
-    (cons 'mapc-internal (cdr form))))
-
-(define-compiler-macro mapcar* (&whole form cl-func cl-x &rest cl-rest)
-  (if cl-rest
-      form
-    (cons 'mapcar (cdr form))))
-
 ;; XEmacs; it's perfectly reasonable, and often much clearer to those
 ;; reading the code, to call regexp-quote on a constant string, which is
 ;; something we can optimise here easily.
@@ -3557,28 +3545,11 @@
 ;;	  ;; byte-optimize.el).
 ;;	  (t form)))))
 
-(define-compiler-macro map (&whole form cl-type cl-func cl-seq
-                            &rest cl-rest)
-  "If CL-TYPE is a constant expression that we know how to handle, transform
-the call to `map' to a more efficient expression."
-  (cond
-   ;; The first two here rely on the compiler macros for mapc and mapcar*,
-   ;; to convert to mapc-internal and mapcar, where appropriate (that is, in
-   ;; the absence of cl-rest.)
-   ((null cl-type)
-    `(prog1 nil (mapc ,@(nthcdr 2 form))))
-   ((equal '(quote list) cl-type)
-    (cons 'mapcar* (nthcdr 2 form)))
-   ((or (equal '(quote vector) cl-type)
-        (equal '(quote array) cl-type))
-    (if cl-rest
-        `(vconcat (mapcar* ,@(nthcdr 2 form)))
-      (cons 'mapvector (nthcdr 2 form))))
-   ((equal '(quote string) cl-type)
-    `(concat (mapcar* ,@(nthcdr 2 form))))
-   ((equal '(quote bit-vector) cl-type)
-    `(bvconcat (mapcar* ,@(nthcdr 2 form))))
-   (t form)))
+(define-compiler-macro notany (&whole form &rest cl-rest)
+  (cons 'not (cons 'some (cdr cl-rest))))
+
+(define-compiler-macro notevery (&whole form &rest cl-rest)
+  (cons 'not (cons 'every (cdr cl-rest))))
 
 (mapc
  #'(lambda (y)
@@ -3607,7 +3578,7 @@
    (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr)))
 
 ;;; Things that are inline.
-(proclaim '(inline acons map concatenate notany notevery
+(proclaim '(inline acons map concatenate
 ;; XEmacs omission: gethash is builtin
 		   cl-set-elt revappend nreconc))
 

--- a/lisp/cl.el	Sat Feb 06 04:27:47 2010 -0600
+++ b/lisp/cl.el	Sat Feb 06 12:28:19 2010 +0000
@@ -366,21 +366,6 @@
 
 (defalias 'copy-seq 'copy-sequence)
 
-(defun mapcar* (cl-func cl-x &rest cl-rest)
-  "Apply FUNCTION to each element of SEQ, and make a list of the results.
-If there are several SEQs, FUNCTION is called with that many arguments,
-and mapping stops as soon as the shortest list runs out.  With just one
-SEQ, this is like `mapcar'.  With several, it is like the Common Lisp
-`mapcar' function extended to arbitrary sequence types."
-  (if cl-rest
-      (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
-	  (cl-mapcar-many cl-func (cons cl-x cl-rest))
-	(let ((cl-res nil) (cl-y (car cl-rest)))
-	  (while (and cl-x cl-y)
-	    (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
-	  (nreverse cl-res)))
-    (mapcar cl-func cl-x)))
-
 (defalias 'svref 'aref)
 
 ;;; List functions.
@@ -638,9 +623,9 @@
 ;; XEmacs change: omit the autoload rules; we handle those a different way
 
 ;;; Define data for indentation and edebug.
-(mapc-internal
+(mapc
  #'(lambda (entry)
-     (mapc-internal
+     (mapc
       #'(lambda (func)
 	  (put func 'lisp-indent-function (nth 1 entry))
 	  (put func 'lisp-indent-hook (nth 1 entry))

--- a/lisp/obsolete.el	Sat Feb 06 04:27:47 2010 -0600
+++ b/lisp/obsolete.el	Sat Feb 06 12:28:19 2010 +0000
@@ -411,5 +411,7 @@
  'obsolete-throw
  "it says `obsolete' in the name, you know you shouldn't be using this.")
 
+(define-compatible-function-alias 'cl-mapc 'mapc)
+
 (provide 'obsolete)
 ;;; obsolete.el ends here

--- a/lisp/update-elc.el	Sat Feb 06 04:27:47 2010 -0600
+++ b/lisp/update-elc.el	Sat Feb 06 12:28:19 2010 +0000
@@ -382,7 +382,7 @@
 				(append '("-f" "batch-byte-compile-one-file")
 					(list arg))))
 			  bootstrap-other))))
-	     (mapc-internal
+	     (mapc
 	      #'(lambda (arg)
 		  (setq update-elc-files-to-compile
 			(delete arg update-elc-files-to-compile)))

--- a/src/ChangeLog	Sat Feb 06 04:27:47 2010 -0600
+++ b/src/ChangeLog	Sat Feb 06 12:28:19 2010 +0000
@@ -2,6 +2,19 @@
 
 	* mule-wnnfns.c:
 	Convert file to utf-8.
+	
+2010-02-03  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (mapcarX):
+	Accept a new argument, indicating whether the function is being
+	called from #'some or #'every. Implement it.
+	Discard any multiple values where that is appropriate.
+	(Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap)
+	(Fmap_into):
+	Pass the new flag to mapcarX.
+	(Fsome, Fevery): Move these functions here from cl-extra.el;
+	implement them in terms of mapcarX.
+	(maplist): Discard multiple values where appropriate.
 
 2010-02-06  Ben Wing  <ben@xemacs.org>
 
@@ -1274,6 +1287,51 @@
 	has case information (or, equivalently, if one of its case
 	equivalents would contain repeated Ibytes).
 
+2010-01-31  Aidan Kehoe  <kehoea@parhasard.net>
+
+	Move #'mapcar*, #'mapcan, #'mapc, #'map, #'mapl, #'mapcon to C;
+	extend #'mapvector, #'mapconcat, #'mapcar to support more
+	SEQUENCES; have them all error with circular lists.
+
+	* fns.c (Fsubseq): Call CHECK_SEQUENCE here; Flength can return
+	from the debugger if it errors with a non-sequence, leading to a
+	crash in Fsubseq if sequence really is *not* a sequence.
+	(mapcarX): Rename mapcar1 to mapcarX; rework it comprehensively to
+	take an optional lisp output argument, and a varying number of
+	sequences.
+	Special-case a single list argument, as we used to, saving its
+	elements in the stack space for the results before calling
+	FUNCTION, so FUNCTION can corrupt the list all it
+	wants. dead_wrong_type_argument() in the other cases if we
+	encounter a non-cons where we expected a cons.
+	(Fmapconcat):
+	Accept further SEQUENCES after separator here. Special-case
+	the idiom (mapconcat 'identity SEQUENCE), don't even funcall.
+	(FmapcarX): Rename this from Fmapcar. Accept optional SEQUENCES.
+	(Fmapvector): Accept optional SEQUENCES.
+	(Fmapcan, Fmapc, Fmap): Move these here from cl-extra.el.
+	(Fmap_into): New function, as specified by Common Lisp.
+	(maplist): New function, the guts of the implementation of
+	Fmaplist and Fmapl. 
+	(Fmaplist, Fmapl, Fmapcon): Move these from cl-extra.el.
+	(syms_of_fns):
+	Add a few needed symbols here, for the type tests
+	used by #'map. Add the new subrs, with aliases for #'mapc-internal
+	and #'mapcar.
+
+	* general-slots.h: Declare Qcoerce here, now it's used in both
+	indent.c and fns.c
+	* indent.c (syms_of_indent): Qcoerce is gone from here.
+
+	* lisp.h: Add ARRAYP(), SEQUENCEP(), and the corresponding CHECK_*
+	macros. Declare Fbit_vector, Fstring, FmapcarX, now other files
+	need to use them.
+	* data.c (Farrayp, Fsequencep): Use ARRAYP and SEQUENCEP, just
+	added to lisp.h
+
+	* buffer.c (Fbuffer_list): Now Fmapcar has been renamed FmapcarX
+	and takes MANY arguments, update this function to reflect that.
+
 2010-01-28  Jerry James  <james@xemacs.org>
 
 	* Makefile.in.in: Remove internationalization rules, since the

--- a/src/buffer.c	Sat Feb 06 04:27:47 2010 -0600
+++ b/src/buffer.c	Sat Feb 06 12:28:19 2010 +0000
@@ -374,9 +374,11 @@
 */
        (frame))
 {
-  return Fmapcar (Qcdr,
-		  EQ (frame, Qt) ? Vbuffer_alist :
-		  decode_frame (frame)->buffer_alist);
+  Lisp_Object args[2];
+  args[0] = Qcdr;
+  args[1] = EQ (frame, Qt) ?
+    Vbuffer_alist : decode_frame (frame)->buffer_alist;
+  return FmapcarX (countof (args), args);
 }
 
 Lisp_Object

--- a/src/data.c	Sat Feb 06 04:27:47 2010 -0600
+++ b/src/data.c	Sat Feb 06 12:28:19 2010 +0000
@@ -297,10 +297,7 @@
 */
        (object))
 {
-  return (VECTORP	(object) ||
-	  STRINGP	(object) ||
-	  BIT_VECTORP	(object))
-    ? Qt : Qnil;
+  return ARRAYP (object) ? Qt : Qnil;
 }
 
 DEFUN ("sequencep", Fsequencep, 1, 1, 0, /*
@@ -308,11 +305,7 @@
 */
        (object))
 {
-  return (LISTP		(object) ||
-	  VECTORP	(object) ||
-	  STRINGP	(object) ||
-	  BIT_VECTORP	(object))
-    ? Qt : Qnil;
+  return SEQUENCEP (object) ? Qt : Qnil;
 }
 
 DEFUN ("markerp", Fmarkerp, 1, 1, 0, /*

--- a/src/fns.c	Sat Feb 06 04:27:47 2010 -0600
+++ b/src/fns.c	Sat Feb 06 12:28:19 2010 +0000
@@ -56,6 +56,7 @@
 
 Lisp_Object Qstring_lessp;
 Lisp_Object Qidentity;
+Lisp_Object Qvector, Qarray, Qstring, Qlist, Qbit_vector;
 
 Lisp_Object Qbase64_conversion_error;
 
@@ -982,6 +983,8 @@
 {
   EMACS_INT len, s, e;
 
+  CHECK_SEQUENCE (sequence);
+
   if (STRINGP (sequence))
     return Fsubstring (sequence, start, end);
 
@@ -1043,8 +1046,8 @@
     }
   else
     {
-      ABORT (); /* unreachable, since Flength (sequence) did not get
-                   an error */
+      ABORT (); /* unreachable, since CHECK_SEQUENCE (sequence) did not
+                   error */
       return Qnil;
     }
 }
@@ -3223,204 +3226,762 @@
 
 
 /* This is the guts of several mapping functions.
-   Apply FUNCTION to each element of SEQUENCE, 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 SEQUENCE.
-
-   If VALS is a null pointer, do not accumulate the results. */
+
+   Call FUNCTION CALL_COUNT times, with NSEQUENCES arguments each time,
+   taking the elements from SEQUENCES.  If VALS is non-NULL, store the
+   results into VALS, a C array of Lisp_Objects; else, if LISP_VALS is
+   non-nil, store the results into LISP_VALS, a sequence with sufficient
+   room for CALL_COUNT results. Else, do not accumulate any result.
+
+   If VALS is non-NULL, NSEQUENCES is one, and SEQUENCES[0] is a cons,
+   mapcarX will store the elements of SEQUENCES[0] in stack and GCPRO them,
+   so FUNCTION cannot insert a non-cons into SEQUENCES[0] and throw off
+   mapcarX.
+
+   Otherwise, mapcarX signals a wrong-type-error if it encounters a
+   non-cons, non-array when traversing SEQUENCES.  Common Lisp specifies in
+   MAPPING-DESTRUCTIVE-INTERACTION that it is an error when FUNCTION
+   destructively modifies SEQUENCES in a way that might affect the ongoing
+   traversal operation.
+
+   If SOME_OR_EVERY is SOME_OR_EVERY_SOME, return the (possibly multiple)
+   values given by FUNCTION the first time it is non-nil, and abandon the
+   iterations.  LISP_VALS in this case must be an object created by
+   make_opaque_ptr, dereferenced as pointing to a Lisp object. If
+   SOME_OR_EVERY is SOME_OR_EVERY_EVERY, store Qnil at the Lisp_Object
+   pointer address provided by LISP_VALS if FUNCTION gives nil; otherwise
+   leave it alone. */
+
+#define SOME_OR_EVERY_NEITHER 0
+#define SOME_OR_EVERY_SOME    1
+#define SOME_OR_EVERY_EVERY   2
 
 static void
-mapcar1 (Elemcount leni, Lisp_Object *vals,
-	 Lisp_Object function, Lisp_Object sequence)
+mapcarX (Elemcount call_count, Lisp_Object *vals, Lisp_Object lisp_vals,
+	 Lisp_Object function, int nsequences, Lisp_Object *sequences, 
+	 int some_or_every)
 {
-  Lisp_Object result;
-  Lisp_Object args[2];
-  struct gcpro gcpro1;
-
-  if (vals)
-    {
-      GCPRO1 (vals[0]);
-      gcpro1.nvars = 0;
-    }
-
+  Lisp_Object called, *args;
+  struct gcpro gcpro1, gcpro2;
+  int i, j;
+  enum lrecord_type lisp_vals_type;
+
+  assert (LRECORDP (lisp_vals));
+  lisp_vals_type = XRECORD_LHEADER (lisp_vals)->type;
+
+  args = alloca_array (Lisp_Object, nsequences + 1);
   args[0] = function;
-
-  if (LISTP (sequence))
+  for (i = 1; i <= nsequences; ++i)
     {
-      /* A devious `function' could either:
-	 - insert garbage into the list in front of us, causing XCDR to crash
-	 - amputate the list behind us using (setcdr), causing the remaining
-	   elts to lose their GCPRO status.
-
-	 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
-	 results computed so far.
-
-	 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_NO_DECLARE and GCPRO the tail. */
-
-      if (vals)
-	{
-	  Lisp_Object *val = vals;
-	  Elemcount i;
-
-	  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
+      args[i] = Qnil;
+    }
+
+  if (vals != NULL)
+    {
+      GCPRO2 (args[0], vals[0]);
+      gcpro1.nvars = nsequences + 1;
+      gcpro2.nvars = 0;
+    }
+  else
+    {
+      GCPRO1 (args[0]);
+      gcpro1.nvars = nsequences + 1;
+    }
+
+  /* Be extra nice in the event that we've been handed one list and one
+     only; make it possible for FUNCTION to set cdrs not yet processed to
+     non-cons, non-nil objects without ill-effect, if we have been handed
+     the stack space to do that. */
+  if (vals != NULL && 1 == nsequences && CONSP (sequences[0]))
+    {
+      Lisp_Object lst = sequences[0];
+      Lisp_Object *val = vals;
+      for (i = 0; i < call_count; ++i)
 	{
-	  Lisp_Object elt, tail;
-	  EMACS_INT len_unused;
-	  struct gcpro ngcpro1;
-
-	  NGCPRO1 (tail);
-
-	  {
-	    EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len_unused)
-	      {
-		args[1] = elt;
-		Ffuncall (2, args);
-	      }
-	  }
-
-	  NUNGCPRO;
-	}
-    }
-  else if (VECTORP (sequence))
-    {
-      Lisp_Object *objs = XVECTOR_DATA (sequence);
-      Elemcount i;
-      for (i = 0; i < leni; i++)
-	{
-	  args[1] = *objs++;
-	  result = Ffuncall (2, args);
-	  if (vals) vals[gcpro1.nvars++] = result;
+	  *val++ = XCAR (lst);
+	  lst = XCDR (lst);
 	}
-    }
-  else if (STRINGP (sequence))
-    {
-      /* The string data of `sequence' might be relocated during GC. */
-      Bytecount slen = XSTRING_LENGTH (sequence);
-      Ibyte *p = alloca_ibytes (slen);
-      Ibyte *end = p + slen;
-
-      memcpy (p, XSTRING_DATA (sequence), slen);
-
-      while (p < end)
+      gcpro2.nvars = call_count;
+
+      for (i = 0; i < call_count; ++i)
 	{
-	  args[1] = make_char (itext_ichar (p));
-	  INC_IBYTEPTR (p);
-	  result = Ffuncall (2, args);
-	  if (vals) vals[gcpro1.nvars++] = result;
-	}
-    }
-  else if (BIT_VECTORP (sequence))
-    {
-      Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
-      Elemcount i;
-      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;
+	  args[1] = vals[i];
+	  vals[i] = Ffuncall (nsequences + 1, args);
 	}
     }
   else
-    ABORT (); /* unreachable, since Flength (sequence) did not get an error */
-
-  if (vals)
-    UNGCPRO;
+    {
+      Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
+      for (j = 0; j < nsequences; ++j)
+	{
+	  sequence_types[j] = XRECORD_LHEADER (sequences[j])->type;
+	}
+
+      for (i = 0; i < call_count; ++i)
+	{
+	  for (j = 0; j < nsequences; ++j)
+	    {
+	      switch (sequence_types[j])
+		{
+		case lrecord_type_cons:
+		  {
+		    if (!CONSP (sequences[j]))
+		      {
+			/* This means FUNCTION has probably messed
+			   around with a cons in one of the sequences,
+			   since we checked the type
+			   (CHECK_SEQUENCE()) and the length and
+			   structure (with Flength()) correctly in our
+			   callers. */
+			dead_wrong_type_argument (Qconsp, sequences[j]);
+		      }
+		    args[j + 1] = XCAR (sequences[j]);
+		    sequences[j] = XCDR (sequences[j]);
+		    break;
+		  }
+		case lrecord_type_vector:
+		  {
+		    args[j + 1] = XVECTOR_DATA (sequences[j])[i];
+		    break;
+		  }
+		case lrecord_type_string:
+		  {
+		    args[j + 1] = make_char (string_ichar (sequences[j], i));
+		    break;
+		  }
+		case lrecord_type_bit_vector:
+		  {
+		    args[j + 1]
+		      = make_int (bit_vector_bit (XBIT_VECTOR (sequences[j]),
+						  i));
+		    break;
+		  }
+		default:
+		  ABORT();
+		}
+	    }
+	  called = Ffuncall (nsequences + 1, args);
+	  if (vals != NULL)
+	    {
+	      vals[i] = IGNORE_MULTIPLE_VALUES (called);
+	      gcpro2.nvars += 1;
+	    }
+	  else
+	    {
+	      switch (lisp_vals_type)
+		{
+		case lrecord_type_symbol:
+		  break;
+		case lrecord_type_cons:
+		  {
+		    if (SOME_OR_EVERY_NEITHER == some_or_every)
+		      {
+			called = IGNORE_MULTIPLE_VALUES (called);
+			if (!CONSP (lisp_vals))
+			  {
+			    /* If FUNCTION has inserted a non-cons non-nil
+			       cdr into the list before we've processed the
+			       relevant part, error. */
+			    dead_wrong_type_argument (Qconsp, lisp_vals);
+			  }
+
+			XSETCAR (lisp_vals, called);
+			lisp_vals = XCDR (lisp_vals);
+			break;
+		      }
+
+		    if (SOME_OR_EVERY_SOME == some_or_every)
+		      {
+			if (!NILP (IGNORE_MULTIPLE_VALUES (called)))
+			  {
+			    XCAR (lisp_vals) = called;
+			    UNGCPRO;
+			    return;
+			  }
+			break;
+		      }
+
+		    if (SOME_OR_EVERY_EVERY == some_or_every)
+		      {
+			called = IGNORE_MULTIPLE_VALUES (called);
+			if (NILP (called))
+			  {
+			    XCAR (lisp_vals) = Qnil;
+			    UNGCPRO;
+			    return;
+			  }
+			break;
+		      }
+
+		    goto bad_show_or_every_flag;
+		  }
+		case lrecord_type_vector:
+		  {
+		    called = IGNORE_MULTIPLE_VALUES (called);
+		    i < XVECTOR_LENGTH (lisp_vals) ?
+		      (XVECTOR_DATA (lisp_vals)[i] = called) :
+		      /* Let #'aset error. */
+		      Faset (lisp_vals, make_int (i), called);
+		    break;
+		  }
+		case lrecord_type_string:
+		  {
+		    /* If this ever becomes a code hotspot, we can keep
+		       around pointers into the data of the string, checking
+		       each time that it hasn't been relocated. */
+		    called = IGNORE_MULTIPLE_VALUES (called);
+		    Faset (lisp_vals, make_int (i), called);
+		    break;
+		  }
+		case lrecord_type_bit_vector:
+		  {
+		    called = IGNORE_MULTIPLE_VALUES (called);
+		    (BITP (called) &&
+		     i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ?
+		      set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i,
+					  XINT (called)) :
+		      Faset (lisp_vals, make_int (i), called);
+		    break;
+		  }
+		bad_show_or_every_flag:
+		default:
+		  {
+		    ABORT();
+		    break;
+		  }
+		}
+	    }
+	}
+    }
+  UNGCPRO;
 }
 
-DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /*
-Apply FUNCTION to each element of SEQUENCE, and concat the results to a string.
+DEFUN ("mapconcat", Fmapconcat, 3, MANY, 0, /*
+Call FUNCTION on each element of SEQUENCE, and concat results to a string.
 Between each pair of results, insert SEPARATOR.
 
 Each result, and SEPARATOR, should be strings.  Thus, using " " as SEPARATOR
 results in spaces between the values returned by FUNCTION.  SEQUENCE itself
 may be a list, a vector, a bit vector, or a string.
+
+With optional SEQUENCES, call FUNCTION each time with as many arguments as
+there are SEQUENCES, plus one for the element from SEQUENCE.  One element
+from each sequence will be used each time FUNCTION is called, and
+`mapconcat' will give up once the shortest sequence is exhausted.
+
+arguments: (FUNCTION SEQUENCE SEPARATOR &rest SEQUENCES)
 */
-       (function, sequence, separator))
+       (int nargs, Lisp_Object *args))
 {
-  EMACS_INT len = XINT (Flength (sequence));
-  Lisp_Object *args;
-  EMACS_INT i;
-  EMACS_INT nargs = len + len - 1;
+  Lisp_Object function = args[0];
+  Lisp_Object sequence = args[1];
+  Lisp_Object separator = args[2];
+  Elemcount len = EMACS_INT_MAX;
+  Lisp_Object *args0;
+  EMACS_INT i, nargs0;
+
+  args[2] = sequence;
+  args[1] = separator;
+
+  for (i = 2; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
 
   if (len == 0) return build_ascstring ("");
 
-  args = alloca_array (Lisp_Object, nargs);
-
-  mapcar1 (len, args, function, sequence);
+  nargs0 = len + len - 1;
+  args0 = alloca_array (Lisp_Object, nargs0);
+
+  /* Special-case this, it's very common and doesn't require any
+     funcalls. Upside of doing it here, instead of cl-macs.el: no consing,
+     apart from the final string, we allocate everything on the stack. */
+  if (EQ (function, Qidentity) && 3 == nargs && CONSP (sequence))
+    {
+      for (i = 0; i < len; ++i)
+	{
+	  args0[i] = XCAR (sequence);
+	  sequence = XCDR (sequence);
+	}
+    }
+  else
+    {
+      mapcarX (len, args0, Qnil, function, nargs - 2, args + 2,
+	       SOME_OR_EVERY_NEITHER);
+    }
 
   for (i = len - 1; i >= 0; i--)
-    args[i + i] = args[i];
-
-  for (i = 1; i < nargs; i += 2)
-    args[i] = separator;
-
-  return Fconcat (nargs, args);
+    args0[i + i] = args0[i];
+
+  for (i = 1; i < nargs0; i += 2)
+    args0[i] = separator;
+
+  return Fconcat (nargs0, args0);
 }
 
-DEFUN ("mapcar", Fmapcar, 2, 2, 0, /*
-Apply FUNCTION to each element of SEQUENCE; return a list of the results.
+DEFUN ("mapcar*", FmapcarX, 2, MANY, 0, /*
+Call FUNCTION on each element of SEQUENCE; return a list of the results.
 The result is a list of the same length as SEQUENCE.
 SEQUENCE may be a list, a vector, a bit vector, or a string.
+
+With optional SEQUENCES, call FUNCTION each time with as many arguments as
+there are SEQUENCES, plus one for the element from SEQUENCE.  One element
+from each sequence will be used each time FUNCTION is called, and `mapcar'
+stops calling FUNCTION once the shortest sequence is exhausted.
+
+arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
 */
-       (function, sequence))
+       (int nargs, Lisp_Object *args))
 {
-  Elemcount len = XINT (Flength (sequence));
-  Lisp_Object *args = alloca_array (Lisp_Object, len);
-
-  mapcar1 (len, args, function, sequence);
-
-  return Flist ((int) len, args);
+  Lisp_Object function = args[0];
+  Elemcount len = EMACS_INT_MAX;
+  Lisp_Object *args0;
+  int i;
+
+  for (i = 1; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
+
+  args0 = alloca_array (Lisp_Object, len);
+  mapcarX (len, args0, Qnil, function, nargs - 1, args + 1,
+	   SOME_OR_EVERY_NEITHER);
+
+  return Flist ((int) len, args0);
 }
 
-DEFUN ("mapvector", Fmapvector, 2, 2, 0, /*
-Apply FUNCTION to each element of SEQUENCE; return a vector of the results.
+DEFUN ("mapvector", Fmapvector, 2, MANY, 0, /*
+Call FUNCTION on 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, a bit vector, or a string.
+
+With optional SEQUENCES, call FUNCTION each time with as many arguments as
+there are SEQUENCES, plus one for the element from SEQUENCE.  One element
+from each sequence will be used each time FUNCTION is called, and
+`mapvector' stops calling FUNCTION once the shortest sequence is exhausted.
+
+arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
 */
-       (function, sequence))
+       (int nargs, Lisp_Object *args))
 {
-  Elemcount len = XINT (Flength (sequence));
-  Lisp_Object result = make_vector (len, Qnil);
+  Lisp_Object function = args[0];
+  Elemcount len = EMACS_INT_MAX;
+  Lisp_Object result;
   struct gcpro gcpro1;
-
+  int i;
+
+  for (i = 1; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
+
+  result = make_vector (len, Qnil);
   GCPRO1 (result);
-  mapcar1 (len, XVECTOR_DATA (result), function, sequence);
+  /* Don't pass result as the lisp_object argument, we want mapcarX to protect 
+     a single list argument's elements from being garbage-collected. */
+  mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1,
+	   SOME_OR_EVERY_NEITHER);
   UNGCPRO;
 
   return result;
 }
 
-DEFUN ("mapc-internal", Fmapc_internal, 2, 2, 0, /*
-Apply FUNCTION to each element of SEQUENCE.
+DEFUN ("mapcan", Fmapcan, 2, MANY, 0, /*
+Call FUNCTION on each element of SEQUENCE; chain the results together.
+
+FUNCTION must normally return a list; the results will be concatenated
+together using `nconc'.
+
+With optional SEQUENCES, call FUNCTION each time with as many arguments as
+there are SEQUENCES, plus one for the element from SEQUENCE.  One element
+from each sequence will be used each time FUNCTION is called, and
+`mapcan' stops calling FUNCTION once the shortest sequence is exhausted.
+
+arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
+*/
+       (int nargs, Lisp_Object *args))
+{
+  Lisp_Object function = args[0], nconcing;
+  Elemcount len = EMACS_INT_MAX;
+  Lisp_Object *args0;
+  struct gcpro gcpro1;
+  int i;
+
+  for (i = 1; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
+
+  args0 = alloca_array (Lisp_Object, len + 1);
+  mapcarX (len, args0 + 1, Qnil, function, nargs - 1, args + 1,
+	   SOME_OR_EVERY_NEITHER);
+
+  if (len < 2)
+    {
+      return len ? args0[1] : Qnil;
+    }
+
+  /* bytecode_nconc2 can signal and return, we need to GCPRO the args, since
+     mapcarX is no longer doing this for us. */
+  args0[0] = Fcons (Qnil, Qnil);
+  GCPRO1 (args0[0]);
+  gcpro1.nvars = len + 1;
+
+  for (i = 0; i < len; ++i)
+    {
+      nconcing = bytecode_nconc2 (args0 + i);
+      args0[i + 1] = nconcing;
+    }
+
+  RETURN_UNGCPRO (XCDR (nconcing));
+}
+
+DEFUN ("mapc", Fmapc, 2, MANY, 0, /*
+Call FUNCTION on each element of SEQUENCE.
+
 SEQUENCE may be a list, a vector, a bit vector, or a string.
 This function is like `mapcar' but does not accumulate the results,
 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'.
+With optional SEQUENCES, call FUNCTION each time with as many arguments as
+there are SEQUENCES, plus one for the elements from SEQUENCE.  One element
+from each sequence will be used each time FUNCTION is called, and
+`mapc' stops calling FUNCTION once the shortest sequence is exhausted.
+
+Return SEQUENCE.
+
+arguments: (FUNCTION SEQUENCE &rest SEQUENCES)
+*/
+       (int nargs, Lisp_Object *args))
+{
+  Elemcount len = EMACS_INT_MAX;
+  Lisp_Object sequence = args[1];
+  struct gcpro gcpro1;
+  int i;
+
+  for (i = 1; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
+
+  /* We need to GCPRO sequence, because mapcarX will modify the
+     elements of the args array handed to it, and this may involve
+     elements of sequence getting garbage collected. */
+  GCPRO1 (sequence);
+  mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1,
+	   SOME_OR_EVERY_NEITHER);
+  RETURN_UNGCPRO (sequence);
+}
+
+DEFUN ("map", Fmap, 3, MANY, 0, /*
+Map FUNCTION across one or more sequences, returning a sequence.
+
+TYPE is the sequence type to return, FUNCTION is the function, SEQUENCE is
+the first argument sequence, SEQUENCES are the other argument sequences.
+
+FUNCTION will be called with (1+ (length SEQUENCES)) arguments, and must be
+capable of accepting this number of arguments.
+
+Certain TYPEs are recognised internally by `map', but others are not, and
+`coerce' may throw an error on an attempt to convert to a TYPE it does not
+understand.  A null TYPE means do not accumulate any values.
+
+arguments: (TYPE FUNCTION SEQUENCE &rest SEQUENCES)
 */
-       (function, sequence))
+       (int nargs, Lisp_Object *args))
+{
+  Lisp_Object type = args[0];
+  Lisp_Object function = args[1];
+  Lisp_Object result = Qnil;
+  Lisp_Object *args0 = NULL;
+  Elemcount len = EMACS_INT_MAX;
+  int i;
+  struct gcpro gcpro1;
+
+  for (i = 2; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
+
+  if (!NILP (type))
+    {
+      args0 = alloca_array (Lisp_Object, len);
+    }
+
+  mapcarX (len, args0, Qnil, function, nargs - 2, args + 2,
+	   SOME_OR_EVERY_NEITHER);
+
+  if (EQ (type, Qnil))
+    {
+      return result;
+    }
+
+  if (EQ (type, Qvector) || EQ (type, Qarray))
+    {
+      result = Fvector (len, args0);
+    }
+  else if (EQ (type, Qstring))
+    {
+      result = Fstring (len, args0);
+    }
+  else if (EQ (type, Qlist))
+    {
+      result = Flist (len, args0);
+    }
+  else if (EQ (type, Qbit_vector))
+    {
+      result = Fbit_vector (len, args0);
+    }
+  else
+    {
+      result = Flist (len, args0);
+      GCPRO1 (result);
+      result = call2 (Qcoerce, result, type);
+      UNGCPRO;
+    }
+
+  return result;
+}
+
+DEFUN ("map-into", Fmap_into, 2, MANY, 0, /*
+Modify RESULT-SEQUENCE using the return values of FUNCTION on SEQUENCES.
+
+RESULT-SEQUENCE and SEQUENCES can be lists or arrays.
+
+FUNCTION must accept at least as many arguments as there are SEQUENCES
+\(possibly zero).  If RESULT-SEQUENCE and the elements of SEQUENCES are not
+the same length, stop when the shortest is exhausted; any elements of
+RESULT-SEQUENCE beyond that are unmodified.
+
+Return RESULT-SEQUENCE.
+
+arguments: (RESULT-SEQUENCE FUNCTION &rest SEQUENCES)
+*/
+       (int nargs, Lisp_Object *args))
+{
+  Elemcount len = EMACS_INT_MAX;
+  Lisp_Object result_sequence = args[0];
+  Lisp_Object function = args[1];
+  int i;
+
+  args[0] = function;
+  args[1] = result_sequence;
+
+  for (i = 1; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
+
+  mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2,
+	   SOME_OR_EVERY_NEITHER);
+
+  return result_sequence;
+}
+
+DEFUN ("some", Fsome, 2, MANY, 0, /* 
+Return true if PREDICATE gives non-nil for an element of SEQUENCE.
+
+If so, return the value (possibly multiple) given by PREDICATE.
+
+With optional SEQUENCES, call PREDICATE each time with as many arguments as
+there are SEQUENCES (plus one for the element from SEQUENCE).
+
+arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
+*/
+       (int nargs, Lisp_Object *args))
 {
-  mapcar1 (XINT (Flength (sequence)), 0, function, sequence);
-
-  return sequence;
+  Lisp_Object result_box = Fcons (Qnil, Qnil);
+  struct gcpro gcpro1;
+  Elemcount len = EMACS_INT_MAX;
+  int i;
+
+  GCPRO1 (result_box);
+
+  for (i = 1; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
+
+  mapcarX (len, NULL, result_box, args[0], nargs - 1, args +1,
+	   SOME_OR_EVERY_SOME);
+
+  RETURN_UNGCPRO (XCAR (result_box));
+}
+
+DEFUN ("every", Fevery, 2, MANY, 0, /* 
+Return true if PREDICATE is true of every element of SEQUENCE.
+
+With optional SEQUENCES, call PREDICATE each time with as many arguments as
+there are SEQUENCES (plus one for the element from SEQUENCE).
+
+In contrast to `some', `every' never returns multiple values.
+
+arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
+*/
+       (int nargs, Lisp_Object *args))
+{
+  Lisp_Object result_box = Fcons (Qt, Qnil);
+  struct gcpro gcpro1;
+  Elemcount len = EMACS_INT_MAX;
+  int i;
+
+  GCPRO1 (result_box);
+
+  for (i = 1; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
+
+  mapcarX (len, NULL, result_box, args[0], nargs - 1, args +1,
+	   SOME_OR_EVERY_EVERY);
+
+  RETURN_UNGCPRO (XCAR (result_box));
 }
-
+
+/* Call FUNCTION with NLISTS arguments repeatedly, each Nth argument
+   corresponding to the result of calling (nthcdr ITERATION-COUNT LISTS[N]),
+   until that #'nthcdr expression gives nil for some element of LISTS.
+
+   If MAPLP is zero, return LISTS[0]. Otherwise, return a list of the return
+   values from FUNCTION; if NCONCP is non-zero, nconc them together.
+
+   In contrast to mapcarX, we don't require our callers to check LISTS for
+   well-formedness, we signal wrong-type-argument if it's not a list, or
+   circular-list if it's circular. */
+
+static Lisp_Object
+maplist (Lisp_Object function, int nlists, Lisp_Object *lists, int maplp,
+	 int nconcp)
+{
+  Lisp_Object result = maplp ? lists[0] : Fcons (Qnil, Qnil), funcalled;
+  Lisp_Object nconcing[2], accum = result, *args;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  int i, j, continuing = (nlists > 0), called_count = 0;
+
+  args = alloca_array (Lisp_Object, nlists + 1);
+  args[0] = function;
+  for (i = 1; i <= nlists; ++i)
+    {
+      args[i] = Qnil;
+    }
+
+  if (nconcp)
+    {
+      nconcing[0] = result;
+      nconcing[1] = Qnil;
+      GCPRO3 (args[0], nconcing[0], result);
+      gcpro1.nvars = 1;
+      gcpro2.nvars = 2;
+    }
+  else
+    {
+      GCPRO2 (args[0], result);
+      gcpro1.nvars = 1;
+    }
+
+  while (continuing)
+    {
+      for (j = 0; j < nlists; ++j)
+	{
+	  if (CONSP (lists[j]))
+	    {
+	      args[j + 1] = lists[j];
+	      lists[j] = XCDR (lists[j]);
+	    }
+	  else if (NILP (lists[j]))
+	    {
+	      continuing = 0;
+	      break;
+	    }
+	  else
+	    {
+	      dead_wrong_type_argument (Qlistp, lists[j]);
+	    }
+	}
+      if (!continuing) break;
+      funcalled = IGNORE_MULTIPLE_VALUES (Ffuncall (nlists + 1, args));
+      if (!maplp)
+	{
+	  if (nconcp)
+	    {
+	      /* This order of calls means we check that each list is
+		 well-formed once and once only. The last result does
+		 not have to be a list. */
+	      nconcing[1] = funcalled;
+	      nconcing[0] = bytecode_nconc2 (nconcing);
+	    }
+	  else
+	    {
+	      /* Add to the end, avoiding the need to call nreverse
+		 once we're done: */
+	      XSETCDR (accum, Fcons (funcalled, Qnil));
+	      accum = XCDR (accum);
+	    }
+	}
+
+      if (++called_count % CIRCULAR_LIST_SUSPICION_LENGTH) continue;
+
+      for (j = 0; j < nlists; ++j)
+	{
+	  EXTERNAL_LIST_LOOP_1 (lists[j])
+	    {
+	      /* Just check the lists aren't circular, using the
+		 EXTERNAL_LIST_LOOP_1 macro. */
+	    }
+	}
+    }
+
+  if (!maplp)
+    {
+      result = XCDR (result);
+    }
+
+  RETURN_UNGCPRO (result);
+}
+
+DEFUN ("maplist", Fmaplist, 2, MANY, 0, /*
+Call FUNCTION on each sublist of LIST and LISTS.
+Like `mapcar', except applies to lists and their cdr's rather than to
+the elements themselves."
+
+arguments: (FUNCTION LIST &rest LISTS)
+*/
+       (int nargs, Lisp_Object *args))
+{
+  return maplist (args[0], nargs - 1, args + 1, 0, 0);
+}
+
+DEFUN ("mapl", Fmapl, 2, MANY, 0, /*
+Like `maplist', but do not accumulate values returned by the function.
+
+arguments: (FUNCTION LIST &rest LISTS)
+*/
+       (int nargs, Lisp_Object *args))
+{
+  return maplist (args[0], nargs - 1, args + 1, 1, 0);
+}
+
+DEFUN ("mapcon", Fmapcon, 2, MANY, 0, /*
+Like `maplist', but chains together the values returned by FUNCTION.
+
+FUNCTION must return a list (unless it happens to be the last
+iteration); the results will be concatenated together using `nconc'.
+
+arguments: (FUNCTION LIST &rest LISTS)
+*/
+       (int nargs, Lisp_Object *args))
+{
+  return maplist (args[0], nargs - 1, args + 1, 0, 1);
+}
 
 /* Extra random functions */
 
@@ -3464,6 +4025,7 @@
   return old;
 }
 
+
 Lisp_Object
 add_suffix_to_symbol (Lisp_Object symbol, const Ascbyte *ascii_string)
 {
@@ -4102,6 +4664,12 @@
 
   DEFSYMBOL (Qstring_lessp);
   DEFSYMBOL (Qidentity);
+  DEFSYMBOL (Qvector);
+  DEFSYMBOL (Qarray);
+  DEFSYMBOL (Qstring);
+  DEFSYMBOL (Qlist);
+  DEFSYMBOL (Qbit_vector);
+
   DEFSYMBOL (Qyes_or_no_p);
 
   DEFERROR_STANDARD (Qbase64_conversion_error, Qconversion_error);
@@ -4179,10 +4747,21 @@
   DEFSUBR (Fold_equal);
   DEFSUBR (Ffillarray);
   DEFSUBR (Fnconc);
-  DEFSUBR (Fmapcar);
+  DEFSUBR (FmapcarX);
   DEFSUBR (Fmapvector);
-  DEFSUBR (Fmapc_internal);
+  DEFSUBR (Fmapcan);
+  DEFSUBR (Fmapc);
   DEFSUBR (Fmapconcat);
+  DEFSUBR (Fmap);
+  DEFSUBR (Fmap_into);
+  DEFSUBR (Fsome);
+  DEFSUBR (Fevery);
+  Ffset (intern ("mapc-internal"), Fsymbol_function (intern ("mapc")));
+  Ffset (intern ("mapcar"), Fsymbol_function (intern ("mapcar*")));
+  DEFSUBR (Fmaplist);
+  DEFSUBR (Fmapl);
+  DEFSUBR (Fmapcon);
+
   DEFSUBR (Freplace_list);
   DEFSUBR (Fload_average);
   DEFSUBR (Ffeaturep);

--- a/src/general-slots.h	Sat Feb 06 04:27:47 2010 -0600
+++ b/src/general-slots.h	Sat Feb 06 12:28:19 2010 +0000
@@ -83,6 +83,7 @@
 SYMBOL (Qchars);
 SYMBOL (Qcode_page);
 SYMBOL (Qcoding_system);
+SYMBOL (Qcoerce);
 SYMBOL (Qcolor);
 SYMBOL (Qcolumns);
 SYMBOL (Qcommand);

--- a/src/indent.c	Sat Feb 06 04:27:47 2010 -0600
+++ b/src/indent.c	Sat Feb 06 12:28:19 2010 +0000
@@ -41,8 +41,6 @@
 #endif
 #include "window.h"
 
-Lisp_Object Qcoerce;
-
 /* Indentation can insert tabs if this is non-zero;
    otherwise always uses spaces */
 int indent_tabs_mode;
@@ -937,8 +935,6 @@
 #endif
   DEFSUBR (Fvertical_motion);
   DEFSUBR (Fvertical_motion_pixels);
-
-  DEFSYMBOL (Qcoerce);
 }
 
 void

--- a/src/lisp.h	Sat Feb 06 04:27:47 2010 -0600
+++ b/src/lisp.h	Sat Feb 06 12:28:19 2010 +0000
@@ -3033,6 +3033,31 @@
   Elemcount size;						\
   unsigned long bits[BIT_VECTOR_LONG_STORAGE(numbits)];		\
 }
+/*---------------------- array, sequence -----------------------------*/
+
+#define ARRAYP(x) (VECTORP (x) || STRINGP (x) || BIT_VECTORP (x))
+
+#define CHECK_ARRAY(x) do {			\
+  if (!ARRAYP (x))				\
+    dead_wrong_type_argument (Qarrayp, x);	\
+} while (0)
+
+#define CONCHECK_ARRAY(x) do {			\
+  if (!ARRAYP (x))				\
+    x = wrong_type_argument (Qarrayp, x);	\
+} while (0)
+
+#define SEQUENCEP(x) (LISTP (x) || ARRAYP (x))
+
+#define CHECK_SEQUENCE(x) do {			\
+  if (!SEQUENCEP (x))				\
+    dead_wrong_type_argument (Qsequencep, x);	\
+} while (0)
+
+#define CONCHECK_SEQUENCE(x) do {		\
+  if (!SEQUENCEP (x))				\
+    x = wrong_type_argument (Qsequencep, x);	\
+} while (0)
 
 /*------------------------------ symbol --------------------------------*/
 
@@ -4379,9 +4404,11 @@
 /* Defined in alloc.c */
 MODULE_API EXFUN (Fcons, 2);
 MODULE_API EXFUN (Flist, MANY);
+EXFUN (Fbit_vector, MANY);
 EXFUN (Fmake_byte_code, MANY);
 MODULE_API EXFUN (Fmake_list, 2);
 MODULE_API EXFUN (Fmake_string, 2);
+EXFUN (Fstring, MANY);
 MODULE_API EXFUN (Fmake_symbol, 1);
 MODULE_API EXFUN (Fmake_vector, 2);
 MODULE_API EXFUN (Fvector, MANY);
@@ -5225,7 +5252,7 @@
 EXFUN (Flax_plist_get, 3);
 EXFUN (Flax_plist_remprop, 2);
 MODULE_API EXFUN (Flength, 1);
-EXFUN (Fmapcar, 2);
+EXFUN (FmapcarX, MANY);
 EXFUN (Fmember, 2);
 EXFUN (Fmemq, 2);
 EXFUN (Fnconc, MANY);