diff --git a/compiler/ppc/arith.lisp b/compiler/ppc/arith.lisp
index 0f991a931c325275954a29c7f5fcb90e68bfa974..8f41e2e69c0a04f8184a781ca450a9578118f018 100644
--- a/compiler/ppc/arith.lisp
+++ b/compiler/ppc/arith.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/arith.lisp,v 1.1 2001/02/11 14:22:04 dtc Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/arith.lisp,v 1.2 2001/02/11 16:43:18 dtc Exp $
 ;;;
 ;;;    This file contains the VM definition arithmetic VOPs for the MIPS.
 ;;;
@@ -227,7 +227,7 @@
 
 ;;; Special case fixnum + and - that trap on overflow.  Useful when we
 ;;; don't know that the output type is a fixnum.
-
+;;;
 (define-vop (+/fixnum fast-+/fixnum=>fixnum)
   (:policy :safe)
   (:results (r :scs (any-reg descriptor-reg)))
@@ -238,18 +238,10 @@
       (inst mcrxr :cr0)
       (inst addo. r x y)
       (inst bns no-overflow)
-      (inst unimp (logior (ash (reg-tn-encoding r) 5) fixnum-additive-overflow-trap))
+      (inst unimp (logior (ash (reg-tn-encoding r) 5)
+			  fixnum-additive-overflow-trap))
       (emit-label no-overflow))))
 
-#|
-(define-vop (+-c/fixnum fast-+-c/fixnum=>fixnum)
-  (:policy :safe)
-  (:results (r :scs (any-reg descriptor-reg)))
-  (:result-types tagged-num)
-  (:note "safe inline fixnum arithmetic")
-  (:generator 3
-    (inst taddcctv r x (fixnum y))))
-|#
 
 (define-vop (-/fixnum fast--/fixnum=>fixnum)
   (:policy :safe)
@@ -261,27 +253,58 @@
       (inst mcrxr :cr0)
       (inst subo. r x y)
       (inst bns no-overflow)
-      (inst unimp (logior (ash (reg-tn-encoding r) 5) fixnum-additive-overflow-trap))
+      (inst unimp (logior (ash (reg-tn-encoding r) 5)
+			  fixnum-additive-overflow-trap))
       (emit-label no-overflow))))
 
-#|
-(define-vop (--c/fixnum fast---c/fixnum=>fixnum)
-  (:policy :safe)
-  (:results (r :scs (any-reg descriptor-reg)))
-  (:result-types tagged-num)
-  (:note "safe inline fixnum arithmetic")
-  (:generator 3
-    (inst tsubcctv r x (fixnum y))))
-|#
+
 ;;; Shifting
 
-(define-vop (fast-ash)
+(define-vop (fast-ash/unsigned=>unsigned)
+  (:note "inline ASH")
+  (:args (number :scs (unsigned-reg) :to :save)
+	 (amount :scs (signed-reg immediate)))
+  (:arg-types (:or unsigned-num) signed-num)
+  (:results (result :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:translate ash)
+  (:policy :fast-safe)
+  (:temporary (:sc non-descriptor-reg) ndesc)
+  (:generator 3
+    (sc-case amount
+      (signed-reg
+       (let ((positive (gen-label))
+	     (done (gen-label)))
+	 (inst cmpwi amount 0)
+	 (inst neg ndesc amount)
+	 (inst bge positive)
+	 (inst cmpwi ndesc 31)
+	 (inst srw result number ndesc)
+	 (inst ble done)
+	 (inst srwi result number 31)
+	 (inst b done)
+
+	 (emit-label positive)
+	 ;; The result-type assures us that this shift will not overflow.
+	 (inst slw result number amount)
+
+	 (emit-label done)))
+
+      (immediate
+       (let ((amount (tn-value amount)))
+	 (if (minusp amount)
+	     (let ((amount (min 31 (- amount))))
+	       (inst srwi result number amount))
+	     (inst slwi result number amount)))))))
+
+
+(define-vop (fast-ash/signed=>signed)
   (:note "inline ASH")
-  (:args (number :scs (signed-reg unsigned-reg) :to :save)
+  (:args (number :scs (signed-reg) :to :save)
 	 (amount :scs (signed-reg immediate)))
-  (:arg-types (:or signed-num unsigned-num) signed-num)
-  (:results (result :scs (signed-reg unsigned-reg)))
-  (:result-types (:or signed-num unsigned-num))
+  (:arg-types (:or signed-num) signed-num)
+  (:results (result :scs (signed-reg)))
+  (:result-types (:or signed-num))
   (:translate ash)
   (:policy :fast-safe)
   (:temporary (:sc non-descriptor-reg) ndesc)
@@ -294,13 +317,9 @@
 	 (inst neg ndesc amount)
 	 (inst bge positive)
 	 (inst cmpwi ndesc 31)
-	 (sc-case number
-	   (signed-reg (inst sraw result number ndesc))
-	   (unsigned-reg (inst srw result number ndesc)))
+	 (inst sraw result number ndesc)
 	 (inst ble done)
-	 (sc-case number
-	   (signed-reg (inst srawi result number 31))
-	   (unsigned-reg (inst srwi result number 31)))
+	 (inst srawi result number 31)
 	 (inst b done)
 
 	 (emit-label positive)
@@ -313,11 +332,7 @@
        (let ((amount (tn-value amount)))
 	 (if (minusp amount)
 	     (let ((amount (min 31 (- amount))))
-	       (sc-case number
-		 (unsigned-reg
-		  (inst srwi result number amount))
-		 (signed-reg
-		  (inst srawi result number amount))))
+	       (inst srawi result number amount))
 	     (inst slwi result number amount)))))))
 
 
diff --git a/compiler/ppc/array.lisp b/compiler/ppc/array.lisp
index 909f54cc7a66cb7f712dd5a32f96ef075f096f6a..493cca663e44f056df07b1b82def38d81b403e38 100644
--- a/compiler/ppc/array.lisp
+++ b/compiler/ppc/array.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/array.lisp,v 1.1 2001/02/11 14:22:04 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/array.lisp,v 1.2 2001/02/11 16:43:18 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -148,10 +148,8 @@
 (def-data-vector-frobs simple-array-unsigned-byte-32 word-index
   unsigned-num unsigned-reg)
 
-#+signed-array
 (def-data-vector-frobs simple-array-signed-byte-30 word-index
   tagged-num any-reg)
-#+signed-array
 (def-data-vector-frobs simple-array-signed-byte-32 word-index
   signed-num signed-reg)
 
@@ -372,7 +370,7 @@
   (:generator 7
     (inst slwi offset index 1)
     (inst addi offset offset (- (* vm:vector-data-offset vm:word-bytes)
-			vm:other-pointer-type))
+				vm:other-pointer-type))
     (inst lfdx value object offset)))
 
 (define-vop (data-vector-set/simple-array-double-float)
@@ -394,6 +392,107 @@
     (unless (location= result value)
       (inst fmr result value))))
 
+
+;;; Complex float arrays.
+
+(define-vop (data-vector-ref/simple-array-complex-single-float)
+  (:note "inline array access")
+  (:translate data-vector-ref)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg))
+	 (index :scs (any-reg)))
+  (:arg-types simple-array-complex-single-float positive-fixnum)
+  (:results (value :scs (complex-single-reg)))
+  (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
+  (:result-types complex-single-float)
+  (:generator 5
+    (let ((real-tn (complex-single-reg-real-tn value)))
+      (inst slwi offset index 1)
+      (inst addi offset offset (- (* vm:vector-data-offset vm:word-bytes)
+				  vm:other-pointer-type))
+      (inst lfsx real-tn object offset))
+    (let ((imag-tn (complex-single-reg-imag-tn value)))
+      (inst addi offset offset vm:word-bytes)
+      (inst lfsx imag-tn object offset))))
+
+(define-vop (data-vector-set/simple-array-complex-single-float)
+  (:note "inline array store")
+  (:translate data-vector-set)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg))
+	 (index :scs (any-reg))
+	 (value :scs (complex-single-reg) :target result))
+  (:arg-types simple-array-complex-single-float positive-fixnum
+	      complex-single-float)
+  (:results (result :scs (complex-single-reg)))
+  (:result-types complex-single-float)
+  (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
+  (:generator 5
+    (let ((value-real (complex-single-reg-real-tn value))
+	  (result-real (complex-single-reg-real-tn result)))
+      (inst slwi offset index 1)
+      (inst addi offset offset (- (* vm:vector-data-offset vm:word-bytes)
+				  vm:other-pointer-type))
+      (inst stfsx value-real object offset)
+      (unless (location= result-real value-real)
+	(inst frsp result-real value-real)))
+    (let ((value-imag (complex-single-reg-imag-tn value))
+	  (result-imag (complex-single-reg-imag-tn result)))
+      (inst addi offset offset vm:word-bytes)
+      (inst stfsx value-imag object offset)
+      (unless (location= result-imag value-imag)
+	(inst frsp result-imag value-imag)))))
+
+
+(define-vop (data-vector-ref/simple-array-complex-double-float)
+  (:note "inline array access")
+  (:translate data-vector-ref)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg) :to :result)
+	 (index :scs (any-reg)))
+  (:arg-types simple-array-complex-double-float positive-fixnum)
+  (:results (value :scs (complex-double-reg)))
+  (:result-types complex-double-float)
+  (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
+  (:generator 7
+    (let ((real-tn (complex-double-reg-real-tn value)))
+      (inst slwi offset index 2)
+      (inst addi offset offset (- (* vm:vector-data-offset vm:word-bytes)
+				  vm:other-pointer-type))
+      (inst lfdx real-tn object offset))
+    (let ((imag-tn (complex-double-reg-imag-tn value)))
+      (inst addi offset offset (* 2 vm:word-bytes))
+      (inst lfdx imag-tn object offset))))
+
+(define-vop (data-vector-set/simple-array-complex-double-float)
+  (:note "inline array store")
+  (:translate data-vector-set)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg) :to :result)
+	 (index :scs (any-reg))
+	 (value :scs (complex-double-reg) :target result))
+  (:arg-types simple-array-complex-double-float positive-fixnum
+	      complex-double-float)
+  (:results (result :scs (complex-double-reg)))
+  (:result-types complex-double-float)
+  (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
+  (:generator 20
+    (let ((value-real (complex-double-reg-real-tn value))
+	  (result-real (complex-double-reg-real-tn result)))
+      (inst slwi offset index 2)
+      (inst addi offset offset (- (* vm:vector-data-offset vm:word-bytes)
+				  vm:other-pointer-type))
+      (inst stfdx value-real object offset)
+      (unless (location= result-real value-real)
+	(inst fmr result-real value-real)))
+    (let ((value-imag (complex-double-reg-imag-tn value))
+	  (result-imag (complex-double-reg-imag-tn result)))
+      (inst addi offset offset (* 2 vm:word-bytes))
+      (inst stfdx value-imag object offset)
+      (unless (location= result-imag value-imag)
+	(inst fmr result-imag value-imag)))))
+
+
 ;;; These VOPs are used for implementing float slots in structures (whose raw
 ;;; data is an unsigned-32 vector.
 ;;;
@@ -413,6 +512,28 @@
   (:translate %raw-set-double)
   (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float))
 
+(define-vop (raw-ref-complex-single
+	     data-vector-ref/simple-array-complex-single-float)
+  (:translate %raw-ref-complex-single)
+  (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+;;;
+(define-vop (raw-set-complex-single
+	     data-vector-set/simple-array-complex-single-float)
+  (:translate %raw-set-complex-single)
+  (:arg-types simple-array-unsigned-byte-32 positive-fixnum
+	      complex-single-float))
+;;;
+(define-vop (raw-ref-complex-double
+	     data-vector-ref/simple-array-complex-double-float)
+  (:translate %raw-ref-complex-double)
+  (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+;;;
+(define-vop (raw-set-complex-double
+	     data-vector-set/simple-array-complex-double-float)
+  (:translate %raw-set-complex-double)
+  (:arg-types simple-array-unsigned-byte-32 positive-fixnum
+	      complex-double-float))
+
 
 ;;; These vops are useful for accessing the bits of a vector irrespective of
 ;;; what type of vector it is.
@@ -454,7 +575,7 @@
 
 
 ;;;
-#+signed-array
+
 (define-vop (data-vector-ref/simple-array-signed-byte-8 signed-byte-index-ref)
   (:note "inline array access")
   (:variant vm:vector-data-offset vm:other-pointer-type)
@@ -462,7 +583,7 @@
   (:arg-types simple-array-signed-byte-8 positive-fixnum)
   (:results (value :scs (signed-reg)))
   (:result-types tagged-num))
-#+signed-array
+
 (define-vop (data-vector-set/simple-array-signed-byte-8 byte-index-set)
   (:note "inline array store")
   (:variant vm:vector-data-offset vm:other-pointer-type)
@@ -474,7 +595,6 @@
   (:results (result :scs (signed-reg)))
   (:result-types tagged-num))
 
-#+signed-array
 (define-vop (data-vector-ref/simple-array-signed-byte-16
 	     signed-halfword-index-ref)
   (:note "inline array access")
@@ -483,7 +603,7 @@
   (:arg-types simple-array-signed-byte-16 positive-fixnum)
   (:results (value :scs (signed-reg)))
   (:result-types tagged-num))
-#+signed-array
+
 (define-vop (data-vector-set/simple-array-signed-byte-16 halfword-index-set)
   (:note "inline array store")
   (:variant vm:vector-data-offset vm:other-pointer-type)
diff --git a/compiler/ppc/call.lisp b/compiler/ppc/call.lisp
index 05259e0749cdcc7fd0f539d9f45b15b369d62f43..dba443d0711adc5f793185b8884b37887ab4fd11 100644
--- a/compiler/ppc/call.lisp
+++ b/compiler/ppc/call.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/call.lisp,v 1.1 2001/02/11 14:22:04 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/call.lisp,v 1.2 2001/02/11 16:43:18 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -168,7 +168,8 @@
 
 
 (define-vop (xep-allocate-frame)
-  (:info start-lab)
+  (:info start-lab copy-more-arg-follows)
+  (:ignore copy-more-arg-follows)
   (:vop-var vop)
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 1
diff --git a/compiler/ppc/float.lisp b/compiler/ppc/float.lisp
index eacc2d604d674569df94243a411dd19df23bccff..2a6ff2276a715da99fa06f9399217fe87c189ca1 100644
--- a/compiler/ppc/float.lisp
+++ b/compiler/ppc/float.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/float.lisp,v 1.1 2001/02/11 14:22:04 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/float.lisp,v 1.2 2001/02/11 16:43:18 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -124,8 +124,238 @@
   (frob move-double-float-argument double-reg double-stack t))
 
 
+
+;;;; Complex float move functions
+
+(defun complex-single-reg-real-tn (x)
+  (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg *backend*)
+		  :offset (tn-offset x)))
+(defun complex-single-reg-imag-tn (x)
+  (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg *backend*)
+		  :offset (1+ (tn-offset x))))
+
+(defun complex-double-reg-real-tn (x)
+  (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg *backend*)
+		  :offset (tn-offset x)))
+(defun complex-double-reg-imag-tn (x)
+  (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg *backend*)
+		  :offset (+ (tn-offset x) 2)))
+
+
+(define-move-function (load-complex-single 2) (vop x y)
+  ((complex-single-stack) (complex-single-reg))
+  (let ((nfp (current-nfp-tn vop))
+	(offset (* (tn-offset x) vm:word-bytes)))
+    (let ((real-tn (complex-single-reg-real-tn y)))
+      (inst lfs real-tn nfp offset))
+    (let ((imag-tn (complex-single-reg-imag-tn y)))
+      (inst lfs imag-tn nfp (+ offset vm:word-bytes)))))
+
+(define-move-function (store-complex-single 2) (vop x y)
+  ((complex-single-reg) (complex-single-stack))
+  (let ((nfp (current-nfp-tn vop))
+	(offset (* (tn-offset y) vm:word-bytes)))
+    (let ((real-tn (complex-single-reg-real-tn x)))
+      (inst stfs real-tn nfp offset))
+    (let ((imag-tn (complex-single-reg-imag-tn x)))
+      (inst stfs imag-tn nfp (+ offset vm:word-bytes)))))
+
+
+(define-move-function (load-complex-double 4) (vop x y)
+  ((complex-double-stack) (complex-double-reg))
+  (let ((nfp (current-nfp-tn vop))
+	(offset (* (tn-offset x) vm:word-bytes)))
+    (let ((real-tn (complex-double-reg-real-tn y)))
+      (inst lfd real-tn nfp offset))
+    (let ((imag-tn (complex-double-reg-imag-tn y)))
+      (inst lfd imag-tn nfp (+ offset (* 2 vm:word-bytes))))))
+
+(define-move-function (store-complex-double 4) (vop x y)
+  ((complex-double-reg) (complex-double-stack))
+  (let ((nfp (current-nfp-tn vop))
+	(offset (* (tn-offset y) vm:word-bytes)))
+    (let ((real-tn (complex-double-reg-real-tn x)))
+      (inst stfd real-tn nfp offset))
+    (let ((imag-tn (complex-double-reg-imag-tn x)))
+      (inst stfd imag-tn nfp (+ offset (* 2 vm:word-bytes))))))
+
+
+;;;
+;;; Complex float register to register moves.
+;;;
+(define-vop (complex-single-move)
+  (:args (x :scs (complex-single-reg) :target y
+	    :load-if (not (location= x y))))
+  (:results (y :scs (complex-single-reg) :load-if (not (location= x y))))
+  (:note "complex single float move")
+  (:generator 0
+     (unless (location= x y)
+       ;; Note the complex-float-regs are aligned to every second
+       ;; float register so there is not need to worry about overlap.
+       (let ((x-real (complex-single-reg-real-tn x))
+	     (y-real (complex-single-reg-real-tn y)))
+	 (inst fmr y-real x-real))
+       (let ((x-imag (complex-single-reg-imag-tn x))
+	     (y-imag (complex-single-reg-imag-tn y)))
+	 (inst fmr y-imag x-imag)))))
+;;;
+(define-move-vop complex-single-move :move
+  (complex-single-reg) (complex-single-reg))
+
+(define-vop (complex-double-move)
+  (:args (x :scs (complex-double-reg)
+	    :target y :load-if (not (location= x y))))
+  (:results (y :scs (complex-double-reg) :load-if (not (location= x y))))
+  (:note "complex double float move")
+  (:generator 0
+     (unless (location= x y)
+       ;; Note the complex-float-regs are aligned to every second
+       ;; float register so there is not need to worry about overlap.
+       (let ((x-real (complex-double-reg-real-tn x))
+	     (y-real (complex-double-reg-real-tn y)))
+	 (inst fmr y-real x-real))
+       (let ((x-imag (complex-double-reg-imag-tn x))
+	     (y-imag (complex-double-reg-imag-tn y)))
+	 (inst fmr y-imag x-imag)))))
+;;;
+(define-move-vop complex-double-move :move
+  (complex-double-reg) (complex-double-reg))
+
+
+;;;
+;;; Move from a complex float to a descriptor register allocating a
+;;; new complex float object in the process.
+;;;
+(define-vop (move-from-complex-single)
+  (:args (x :scs (complex-single-reg) :to :save))
+  (:results (y :scs (descriptor-reg)))
+  (:temporary (:scs (non-descriptor-reg)) ndescr)
+  (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
+  (:note "complex single float to pointer coercion")
+  (:generator 13
+     (with-fixed-allocation (y pa-flag ndescr vm:complex-single-float-type
+			       vm:complex-single-float-size))
+     (let ((real-tn (complex-single-reg-real-tn x)))
+       (inst stfs real-tn y (- (* vm:complex-single-float-real-slot
+				  vm:word-bytes)
+			       vm:other-pointer-type)))
+     (let ((imag-tn (complex-single-reg-imag-tn x)))
+       (inst stfs imag-tn y (- (* vm:complex-single-float-imag-slot
+				  vm:word-bytes)
+			       vm:other-pointer-type)))))
+;;;
+(define-move-vop move-from-complex-single :move
+  (complex-single-reg) (descriptor-reg))
+
+(define-vop (move-from-complex-double)
+  (:args (x :scs (complex-double-reg) :to :save))
+  (:results (y :scs (descriptor-reg)))
+  (:temporary (:scs (non-descriptor-reg)) ndescr)
+  (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
+  (:note "complex double float to pointer coercion")
+  (:generator 13
+     (with-fixed-allocation (y pa-flag ndescr vm:complex-double-float-type
+			       vm:complex-double-float-size))
+     (let ((real-tn (complex-double-reg-real-tn x)))
+       (inst stfd real-tn y (- (* vm:complex-double-float-real-slot
+				  vm:word-bytes)
+			       vm:other-pointer-type)))
+     (let ((imag-tn (complex-double-reg-imag-tn x)))
+       (inst stfd imag-tn y (- (* vm:complex-double-float-imag-slot
+				  vm:word-bytes)
+			       vm:other-pointer-type)))))
+;;;
+(define-move-vop move-from-complex-double :move
+  (complex-double-reg) (descriptor-reg))
+
+
+;;;
+;;; Move from a descriptor to a complex float register
+;;;
+(define-vop (move-to-complex-single)
+  (:args (x :scs (descriptor-reg)))
+  (:results (y :scs (complex-single-reg)))
+  (:note "pointer to complex float coercion")
+  (:generator 2
+    (let ((real-tn (complex-single-reg-real-tn y)))
+      (inst lfs real-tn x (- (* complex-single-float-real-slot word-bytes)
+			     other-pointer-type)))
+    (let ((imag-tn (complex-single-reg-imag-tn y)))
+      (inst lfs imag-tn x (- (* complex-single-float-imag-slot word-bytes)
+			     other-pointer-type)))))
+(define-move-vop move-to-complex-single :move
+  (descriptor-reg) (complex-single-reg))
+
+(define-vop (move-to-complex-double)
+  (:args (x :scs (descriptor-reg)))
+  (:results (y :scs (complex-double-reg)))
+  (:note "pointer to complex float coercion")
+  (:generator 2
+    (let ((real-tn (complex-double-reg-real-tn y)))
+      (inst lfd real-tn x (- (* complex-double-float-real-slot word-bytes)
+			     other-pointer-type)))
+    (let ((imag-tn (complex-double-reg-imag-tn y)))
+      (inst lfd imag-tn x (- (* complex-double-float-imag-slot word-bytes)
+			     other-pointer-type)))))
+(define-move-vop move-to-complex-double :move
+  (descriptor-reg) (complex-double-reg))
+
+
+;;;
+;;; Complex float move-argument vop
+;;;
+(define-vop (move-complex-single-float-argument)
+  (:args (x :scs (complex-single-reg) :target y)
+	 (nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg))))
+  (:results (y))
+  (:note "complex single-float argument move")
+  (:generator 1
+    (sc-case y
+      (complex-single-reg
+       (unless (location= x y)
+	 (let ((x-real (complex-single-reg-real-tn x))
+	       (y-real (complex-single-reg-real-tn y)))
+	   (inst fmr y-real x-real))
+	 (let ((x-imag (complex-single-reg-imag-tn x))
+	       (y-imag (complex-single-reg-imag-tn y)))
+	   (inst fmr y-imag x-imag))))
+      (complex-single-stack
+       (let ((offset (* (tn-offset y) word-bytes)))
+	 (let ((real-tn (complex-single-reg-real-tn x)))
+	   (inst stfs real-tn nfp offset))
+	 (let ((imag-tn (complex-single-reg-imag-tn x)))
+	   (inst stfs imag-tn nfp (+ offset word-bytes))))))))
+(define-move-vop move-complex-single-float-argument :move-argument
+  (complex-single-reg descriptor-reg) (complex-single-reg))
+
+(define-vop (move-complex-double-float-argument)
+  (:args (x :scs (complex-double-reg) :target y)
+	 (nfp :scs (any-reg) :load-if (not (sc-is y complex-double-reg))))
+  (:results (y))
+  (:note "complex double-float argument move")
+  (:generator 2
+    (sc-case y
+      (complex-double-reg
+       (unless (location= x y)
+	 (let ((x-real (complex-double-reg-real-tn x))
+	       (y-real (complex-double-reg-real-tn y)))
+	   (inst fmr y-real x-real))
+	 (let ((x-imag (complex-double-reg-imag-tn x))
+	       (y-imag (complex-double-reg-imag-tn y)))
+	   (inst fmr y-imag x-imag))))
+      (complex-double-stack
+       (let ((offset (* (tn-offset y) word-bytes)))
+	 (let ((real-tn (complex-double-reg-real-tn x)))
+	   (inst stfd real-tn nfp offset))
+	 (let ((imag-tn (complex-double-reg-imag-tn x)))
+	   (inst stfd imag-tn nfp (+ offset (* 2 word-bytes)))))))))
+(define-move-vop move-complex-double-float-argument :move-argument
+  (complex-double-reg descriptor-reg) (complex-double-reg))
+
+
 (define-move-vop move-argument :move-argument
-  (single-reg double-reg) (descriptor-reg))
+  (single-reg double-reg complex-single-reg complex-double-reg)
+  (descriptor-reg))
 
 
 ;;;; Arithmetic VOPs:
@@ -503,3 +733,129 @@
       (inst lfd fp-temp nfp (* word-bytes (tn-offset temp)))
       (inst mtfsf 255 fp-temp)
       (move res new))))
+
+
+;;;; Complex float VOPs
+
+(define-vop (make-complex-single-float)
+  (:translate complex)
+  (:args (real :scs (single-reg) :target r
+	       :load-if (not (location= real r)))
+	 (imag :scs (single-reg) :to :save))
+  (:arg-types single-float single-float)
+  (:results (r :scs (complex-single-reg) :from (:argument 0)
+	       :load-if (not (sc-is r complex-single-stack))))
+  (:result-types complex-single-float)
+  (:note "inline complex single-float creation")
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 5
+    (sc-case r
+      (complex-single-reg
+       (let ((r-real (complex-single-reg-real-tn r)))
+	 (unless (location= real r-real)
+	   (inst fmr r-real real)))
+       (let ((r-imag (complex-single-reg-imag-tn r)))
+	 (unless (location= imag r-imag)
+	   (inst fmr r-imag imag))))
+      (complex-single-stack
+       (let ((nfp (current-nfp-tn vop))
+	     (offset (* (tn-offset r) vm:word-bytes)))
+	 (unless (location= real r)
+	   (inst stfs real nfp offset))
+	 (inst stfs imag nfp (+ offset vm:word-bytes)))))))
+
+(define-vop (make-complex-double-float)
+  (:translate complex)
+  (:args (real :scs (double-reg) :target r
+	       :load-if (not (location= real r)))
+	 (imag :scs (double-reg) :to :save))
+  (:arg-types double-float double-float)
+  (:results (r :scs (complex-double-reg) :from (:argument 0)
+	       :load-if (not (sc-is r complex-double-stack))))
+  (:result-types complex-double-float)
+  (:note "inline complex double-float creation")
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 5
+    (sc-case r
+      (complex-double-reg
+       (let ((r-real (complex-double-reg-real-tn r)))
+	 (unless (location= real r-real)
+	   (inst fmr r-real real)))
+       (let ((r-imag (complex-double-reg-imag-tn r)))
+	 (unless (location= imag r-imag)
+	   (inst fmr r-imag imag))))
+      (complex-double-stack
+       (let ((nfp (current-nfp-tn vop))
+	     (offset (* (tn-offset r) vm:word-bytes)))
+	 (unless (location= real r)
+	   (inst stfd real nfp offset))
+	 (inst stfd imag nfp (+ offset (* 2 vm:word-bytes))))))))
+
+
+(define-vop (complex-single-float-value)
+  (:args (x :scs (complex-single-reg) :target r
+	    :load-if (not (sc-is x complex-single-stack))))
+  (:arg-types complex-single-float)
+  (:results (r :scs (single-reg)))
+  (:result-types single-float)
+  (:variant-vars slot)
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 3
+    (sc-case x
+      (complex-single-reg
+       (let ((value-tn (ecase slot
+			 (:real (complex-single-reg-real-tn x))
+			 (:imag (complex-single-reg-imag-tn x)))))
+	 (unless (location= value-tn r)
+	   (inst fmr r value-tn))))
+      (complex-single-stack
+       (inst lfs r (current-nfp-tn vop) (* (+ (ecase slot (:real 0) (:imag 1))
+					      (tn-offset x))
+					   vm:word-bytes))))))
+
+(define-vop (realpart/complex-single-float complex-single-float-value)
+  (:translate realpart)
+  (:note "complex single float realpart")
+  (:variant :real))
+
+(define-vop (imagpart/complex-single-float complex-single-float-value)
+  (:translate imagpart)
+  (:note "complex single float imagpart")
+  (:variant :imag))
+
+(define-vop (complex-double-float-value)
+  (:args (x :scs (complex-double-reg) :target r
+	    :load-if (not (sc-is x complex-double-stack))))
+  (:arg-types complex-double-float)
+  (:results (r :scs (double-reg)))
+  (:result-types double-float)
+  (:variant-vars slot)
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 3
+    (sc-case x
+      (complex-double-reg
+       (let ((value-tn (ecase slot
+			 (:real (complex-double-reg-real-tn x))
+			 (:imag (complex-double-reg-imag-tn x)))))
+	 (unless (location= value-tn r)
+	   (inst fmr r value-tn))))
+      (complex-double-stack
+       (inst lfd r (current-nfp-tn vop) (* (+ (ecase slot (:real 0) (:imag 2))
+					      (tn-offset x))
+					   vm:word-bytes))))))
+
+(define-vop (realpart/complex-double-float complex-double-float-value)
+  (:translate realpart)
+  (:note "complex double float realpart")
+  (:variant :real))
+
+(define-vop (imagpart/complex-double-float complex-double-float-value)
+  (:translate imagpart)
+  (:note "complex double float imagpart")
+  (:variant :imag))
+
+
diff --git a/compiler/ppc/insts.lisp b/compiler/ppc/insts.lisp
index a7a97cc617017d658a2bbc934cdbd7e7b630e487..5d554c0e32a9568b27edc28676500e1f0d84e444 100644
--- a/compiler/ppc/insts.lisp
+++ b/compiler/ppc/insts.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/insts.lisp,v 1.1 2001/02/11 14:22:04 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/insts.lisp,v 1.2 2001/02/11 16:43:19 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -498,7 +498,7 @@
 
 ;;;;
 
-(def-ppc-iformat (xfx 32)
+(def-ppc-iformat (xfx)
   rt spr (xo xo21-30))
 
 (def-ppc-iformat (xfx-fxm '(:name :tab fxm "," rs))
diff --git a/compiler/ppc/nlx.lisp b/compiler/ppc/nlx.lisp
index b1789435df71e83aa0a8781af92d842f210c11dc..40e99ac1445c16e173e2f099bb4bccf031cc6e1a 100644
--- a/compiler/ppc/nlx.lisp
+++ b/compiler/ppc/nlx.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/nlx.lisp,v 1.1 2001/02/11 14:22:05 dtc Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/nlx.lisp,v 1.2 2001/02/11 16:43:19 dtc Exp $
 ;;;
 ;;;    This file contains the definitions of VOPs used for non-local exit
 ;;; (throw, lexical exit, etc.)
@@ -25,6 +25,13 @@
    (make-representation-tn *fixnum-primitive-type* immediate-arg-scn)
    env))
 
+;;; Make-NLX-Entry-Argument-Start-Location  --  Interface
+;;;
+;;;    Make a TN for the argument count passing location for a
+;;; non-local entry.
+;;;
+(def-vm-support-routine make-nlx-entry-argument-start-location ()
+  (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
 
 
 ;;; Save and restore dynamic environment.
diff --git a/compiler/ppc/parms.lisp b/compiler/ppc/parms.lisp
index 511d8abdb7a2dfd8f34330f5ba73b36bd7c851f3..33fdf26e67147305e76131372563389f2f8a5697 100644
--- a/compiler/ppc/parms.lisp
+++ b/compiler/ppc/parms.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.1 2001/02/11 14:22:05 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.2 2001/02/11 16:43:19 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -36,7 +36,6 @@
 (setf (backend-register-save-penalty *target-backend*) 3)
 (setf (backend-byte-order *target-backend*) :big-endian)
 (setf (backend-page-size *target-backend*) 4096)
-(setf (c::backend-%features *target-backend*) '(:ppc :linux :new-assembler :new-random :signed-array))
 
 ); eval-when
 
@@ -199,6 +198,7 @@
     ;; The C startup code must fill these in.
     lisp::lisp-environment-list
     lisp::lisp-command-line-list
+    ext::*batch-mode*
     lisp::*initial-fdefn-objects*
 
     ;; Functions that the C code needs to call
diff --git a/compiler/ppc/sap.lisp b/compiler/ppc/sap.lisp
index 8b21fcfe8dd28af11d880d08a9a675fb7b37c730..0c686ca323201acb9a05af440b34911f3284f687 100644
--- a/compiler/ppc/sap.lisp
+++ b/compiler/ppc/sap.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/sap.lisp,v 1.1 2001/02/11 14:22:05 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/sap.lisp,v 1.2 2001/02/11 16:43:19 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -170,8 +170,8 @@
 	 (:translate ,ref-name)
 	 (:policy :fast-safe)
 	 (:args (sap :scs (sap-reg))
-		(offset :scs (unsigned-reg)))
-	 (:arg-types system-area-pointer unsigned-num)
+		(offset :scs (signed-reg)))
+	 (:arg-types system-area-pointer signed-num)
 	 (:results (result :scs (,sc)))
 	 (:result-types ,type)
 	 (:generator 5
@@ -206,9 +206,9 @@
 	 (:translate ,set-name)
 	 (:policy :fast-safe)
 	 (:args (sap :scs (sap-reg))
-		(offset :scs (unsigned-reg))
+		(offset :scs (signed-reg))
 		(value :scs (,sc) :target result))
-	 (:arg-types system-area-pointer unsigned-num ,type)
+	 (:arg-types system-area-pointer signed-num ,type)
 	 (:results (result :scs (,sc)))
 	 (:result-types ,type)
 	 (:generator 5
diff --git a/compiler/ppc/type-vops.lisp b/compiler/ppc/type-vops.lisp
index c2ebe168f2878f2747e359d54a615c9b682cb22c..f20f9edb2f91fcbcc3c0fced79b4a49ba691e58c 100644
--- a/compiler/ppc/type-vops.lisp
+++ b/compiler/ppc/type-vops.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/type-vops.lisp,v 1.1 2001/02/11 14:22:05 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/type-vops.lisp,v 1.2 2001/02/11 16:43:19 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;; 
@@ -113,7 +113,23 @@
   object-not-ratio-error vm:ratio-type)
 
 (def-type-vops complexp check-complex complex
-  object-not-complex-error vm:complex-type)
+  object-not-complex-error vm:complex-type
+  complex-single-float-type complex-double-float-type)
+
+(def-type-vops complex-rational-p check-complex-rational nil
+  object-not-complex-rational-error complex-type)
+
+(def-type-vops complex-float-p check-complex-float nil
+  object-not-complex-float-error
+  complex-single-float-type complex-double-float-type)
+
+(def-type-vops complex-single-float-p check-complex-single-float
+  complex-single-float object-not-complex-single-float-error
+  complex-single-float-type)
+
+(def-type-vops complex-double-float-p check-complex-double-float
+  complex-double-float object-not-complex-double-float-error
+  complex-double-float-type)
 
 (def-type-vops single-float-p check-single-float single-float
   object-not-single-float-error vm:single-float-type)
@@ -160,28 +176,24 @@
   object-not-simple-array-unsigned-byte-32-error
   vm:simple-array-unsigned-byte-32-type)
 
-#+signed-array
 (def-type-vops simple-array-signed-byte-8-p
   check-simple-array-signed-byte-8
   simple-array-signed-byte-8
   object-not-simple-array-signed-byte-8-error
   simple-array-signed-byte-8-type)
 
-#+signed-array
 (def-type-vops simple-array-signed-byte-16-p
   check-simple-array-signed-byte-16
   simple-array-signed-byte-16
   object-not-simple-array-signed-byte-16-error
   simple-array-signed-byte-16-type)
 
-#+signed-array
 (def-type-vops simple-array-signed-byte-30-p
   check-simple-array-signed-byte-30
   simple-array-signed-byte-30
   object-not-simple-array-signed-byte-30-error
   simple-array-signed-byte-30-type)
 
-#+signed-array
 (def-type-vops simple-array-signed-byte-32-p
   check-simple-array-signed-byte-32
   simple-array-signed-byte-32
@@ -196,6 +208,18 @@
   simple-array-double-float object-not-simple-array-double-float-error
   vm:simple-array-double-float-type)
 
+(def-type-vops simple-array-complex-single-float-p
+  check-simple-array-complex-single-float
+  simple-array-complex-single-float
+  object-not-simple-array-complex-single-float-error
+  simple-array-complex-single-float-type)
+
+(def-type-vops simple-array-complex-double-float-p
+  check-simple-array-complex-double-float
+  simple-array-complex-double-float
+  object-not-simple-array-complex-double-float-error
+  simple-array-complex-double-float-type)
+
 (def-type-vops base-char-p check-base-char base-char
   object-not-base-char-error vm:base-char-type)
 
@@ -234,32 +258,45 @@
   vm:simple-bit-vector-type vm:complex-bit-vector-type)
 
 (def-type-vops vectorp check-vector nil object-not-vector-error
-  vm:simple-string-type vm:simple-bit-vector-type vm:simple-vector-type
-  vm:simple-array-unsigned-byte-2-type vm:simple-array-unsigned-byte-4-type
-  vm:simple-array-unsigned-byte-8-type vm:simple-array-unsigned-byte-16-type
-  vm:simple-array-unsigned-byte-32-type vm:simple-array-single-float-type
-  vm:simple-array-double-float-type vm:complex-string-type
-  vm:complex-bit-vector-type vm:complex-vector-type)
+  simple-string-type simple-bit-vector-type simple-vector-type
+  simple-array-unsigned-byte-2-type simple-array-unsigned-byte-4-type
+  simple-array-unsigned-byte-8-type simple-array-unsigned-byte-16-type
+  simple-array-unsigned-byte-32-type
+  simple-array-signed-byte-8-type simple-array-signed-byte-16-type
+  simple-array-signed-byte-30-type simple-array-signed-byte-32-type
+  simple-array-single-float-type simple-array-double-float-type
+  simple-array-complex-single-float-type
+  simple-array-complex-double-float-type
+  complex-string-type complex-bit-vector-type complex-vector-type)
 
 (def-type-vops simple-array-p check-simple-array nil object-not-simple-array-error
-  vm:simple-array-type vm:simple-string-type vm:simple-bit-vector-type
-  vm:simple-vector-type vm:simple-array-unsigned-byte-2-type
-  vm:simple-array-unsigned-byte-4-type vm:simple-array-unsigned-byte-8-type
-  vm:simple-array-unsigned-byte-16-type vm:simple-array-unsigned-byte-32-type
-  vm:simple-array-single-float-type vm:simple-array-double-float-type)
+  simple-array-type simple-string-type simple-bit-vector-type
+  simple-vector-type simple-array-unsigned-byte-2-type
+  simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type
+  simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type
+  simple-array-signed-byte-8-type simple-array-signed-byte-16-type
+  simple-array-signed-byte-30-type simple-array-signed-byte-32-type
+  simple-array-single-float-type simple-array-double-float-type
+  simple-array-complex-single-float-type
+  simple-array-complex-double-float-type)
 
 (def-type-vops arrayp check-array nil object-not-array-error
-  vm:simple-array-type vm:simple-string-type vm:simple-bit-vector-type
-  vm:simple-vector-type vm:simple-array-unsigned-byte-2-type
-  vm:simple-array-unsigned-byte-4-type vm:simple-array-unsigned-byte-8-type
-  vm:simple-array-unsigned-byte-16-type vm:simple-array-unsigned-byte-32-type
-  vm:simple-array-single-float-type vm:simple-array-double-float-type
-  vm:complex-string-type vm:complex-bit-vector-type vm:complex-vector-type
-  vm:complex-array-type)
+  simple-array-type simple-string-type simple-bit-vector-type
+  simple-vector-type simple-array-unsigned-byte-2-type
+  simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type
+  simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type
+  simple-array-signed-byte-8-type simple-array-signed-byte-16-type
+  simple-array-signed-byte-30-type simple-array-signed-byte-32-type
+  simple-array-single-float-type simple-array-double-float-type
+  simple-array-complex-single-float-type
+  simple-array-complex-double-float-type
+  complex-string-type complex-bit-vector-type complex-vector-type
+  complex-array-type)
 
 (def-type-vops numberp check-number nil object-not-number-error
-  vm:even-fixnum-type vm:odd-fixnum-type vm:bignum-type vm:ratio-type
-  vm:single-float-type vm:double-float-type vm:complex-type)
+  even-fixnum-type odd-fixnum-type bignum-type ratio-type
+  single-float-type double-float-type complex-type
+  complex-single-float-type complex-double-float-type)
 
 (def-type-vops rationalp check-rational nil object-not-rational-error
   vm:even-fixnum-type vm:odd-fixnum-type vm:ratio-type vm:bignum-type)
diff --git a/compiler/ppc/vm.lisp b/compiler/ppc/vm.lisp
index 276050ba1371770e9c294c33e69046e1426d7b11..412f26304cf67cbe6c91180acb757a455c8dba6e 100644
--- a/compiler/ppc/vm.lisp
+++ b/compiler/ppc/vm.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/vm.lisp,v 1.1 2001/02/11 14:22:05 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/vm.lisp,v 1.2 2001/02/11 16:43:19 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -142,6 +142,8 @@
   (single-stack non-descriptor-stack) ; single-floats
   (double-stack non-descriptor-stack
 		:element-size 2 :alignment 2) ; double floats.
+  (complex-single-stack non-descriptor-stack :element-size 2)
+  (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
 
 
   ;; **** Things that can go in the integer registers.
@@ -201,7 +203,7 @@
 
   ;; Non-Descriptor single-floats.
   (single-reg float-registers
-   :locations (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31)
+   :locations #.(loop for i from 0 to 31 collect i)
    ;; ### Note: We really should have every location listed, but then we
    ;; would have to make load-tns work with element-sizes other than 1.
    :constant-scs ()
@@ -210,13 +212,26 @@
 
   ;; Non-Descriptor double-floats.
   (double-reg float-registers
-   :locations (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31)
+   :locations #.(loop for i from 0 to 31 collect i)
    ;; ### Note: load-tns don't work with an element-size other than 1.
    ;; :element-size 2 :alignment 2
    :constant-scs ()
    :save-p t
    :alternate-scs (double-stack))
 
+  (complex-single-reg float-registers
+   :locations #.(loop for i from 0 to 30 by 2 collect i)
+   :element-size 2
+   :constant-scs ()
+   :save-p t
+   :alternate-scs (complex-single-stack))
+
+  (complex-double-reg float-registers
+   :locations #.(loop for i from 0 to 30 by 2 collect i)
+   :element-size 2
+   :constant-scs ()
+   :save-p t
+   :alternate-scs (complex-double-stack))
 
   ;; A catch or unwind block.
   (catch-block control-stack :element-size vm:catch-block-size))