diff --git a/assembly/ppc/arith.lisp b/assembly/ppc/arith.lisp
index ad082676e8fee1b349945de9f2b43d8345fb7b25..5632f9d22250003a00c227e8156058368428191c 100644
--- a/assembly/ppc/arith.lisp
+++ b/assembly/ppc/arith.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/arith.lisp,v 1.2 2003/08/03 11:27:51 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/arith.lisp,v 1.3 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -39,6 +39,8 @@
    (:temp flag non-descriptor-reg nl3-offset)
    (:temp lra descriptor-reg lra-offset)
    (:temp nargs any-reg nargs-offset)
+   #-PPC-FUN-HACK
+   (:temp lip interior-reg lip-offset)
    (:temp ocfp any-reg ocfp-offset))
   
   ; Clear the damned "sticky overflow" bit in :cr0 and :xer
@@ -54,15 +56,24 @@
   (inst add temp2 temp2 temp)
   (with-fixed-allocation (res flag temp bignum-type (1+ bignum-digits-offset))
     (storew temp2 res bignum-digits-offset other-pointer-type))
+  #+PPC-FUN-HACK
   (lisp-return lra :offset 2)
+  #-PPC-FUN-HACK
+  (lisp-return lra lip :offset 2)
 
   DO-STATIC-FUN
+  #+PPC-FUN-HACK
   (inst lwz code-tn null-tn (static-function-offset 'two-arg-+))
+  #-PPC-FUN-HACK
+  (inst lwz lip null-tn (static-function-offset 'two-arg-+))
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
   (inst mr cfp-tn csp-tn)
+  #+PPC-FUN-HACK
   (inst j code-tn
 	(- (* function-code-offset word-bytes) function-pointer-type))
+  #-PPC-FUN-HACK
+  (inst j lip 0)
 
   DONE
   (move res temp))
@@ -85,6 +96,8 @@
    (:temp flag non-descriptor-reg nl3-offset)
    (:temp lra descriptor-reg lra-offset)
    (:temp nargs any-reg nargs-offset)
+   #-PPC-FUN-HACK
+   (:temp lip interior-reg lip-offset)
    (:temp ocfp any-reg ocfp-offset))
 
   ; Clear the damned "sticky overflow" bit in :cr0
@@ -102,15 +115,24 @@
   (inst sub temp2 temp temp2)
   (with-fixed-allocation (res flag temp bignum-type (1+ bignum-digits-offset))
     (storew temp2 res bignum-digits-offset other-pointer-type))
+  #+PPC-FUN-HACK
   (lisp-return lra :offset 2)
+  #-PPC-FUN-HACK
+  (lisp-return lra lip :offset 2)
 
   DO-STATIC-FUN
+  #+PPC-FUN-HACK
   (inst lwz code-tn null-tn (static-function-offset 'two-arg--))
+  #-PPC-FUN-HACK
+  (inst lwz lip null-tn (static-function-offset 'two-arg--))
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
   (inst mr cfp-tn csp-tn)
+  #+PPC-FUN-HACK
   (inst j code-tn
 	(- (* function-code-offset word-bytes) function-pointer-type))
+  #-PPC-FUN-HACK
+  (inst j lip 0)
 
   DONE
   (move res temp))
@@ -136,6 +158,8 @@
    (:temp lo non-descriptor-reg nl1-offset)
    (:temp hi non-descriptor-reg nl2-offset)
    (:temp pa-flag non-descriptor-reg nl3-offset)
+   #-PPC-FUN-HACK
+   (:temp lip interior-reg lip-offset)
    (:temp lra descriptor-reg lra-offset)
    (:temp nargs any-reg nargs-offset)
    (:temp ocfp any-reg ocfp-offset))
@@ -182,15 +206,24 @@
       (storew lo res bignum-digits-offset other-pointer-type)))
   ;; Out of here
   GO-HOME
+  #+PPC-FUN-HACK
   (lisp-return lra :offset 2)
+  #-PPC-FUN-HACK
+  (lisp-return lra lip :offset 2)
 
   DO-STATIC-FUN
+  #+PPC-FUN-HACK
   (inst lwz code-tn null-tn (static-function-offset 'two-arg-*))
+  #-PPC-FUN-HACK
+  (inst lwz lip null-tn (static-function-offset 'two-arg-*))
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
   (inst mr cfp-tn csp-tn)
+  #+PPC-FUN-HACK
   (inst j code-tn
 	(- (* function-code-offset word-bytes) function-pointer-type))
+  #-PPC-FUN-HACK
+  (inst j lip 0)
 
   LOW-FITS-IN-FIXNUM
   (move res lo))
@@ -308,6 +341,8 @@
            
            (:res res descriptor-reg a0-offset)
            
+	   #-PPC-FUN-HACK
+	   (:temp lip interior-reg lip-offset)
            (:temp nargs any-reg nargs-offset)
            (:temp ocfp any-reg ocfp-offset))
                           
@@ -317,12 +352,18 @@
           (inst beq DO-COMPARE)
 	  
 	  DO-STATIC-FN
+	  #+PPC-FUN-HACK
 	  (inst lwz code-tn null-tn (static-function-offset ',static-fn))
+	  #-PPC-FUN-HACK
+	  (inst lwz lip null-tn (static-function-offset ',static-fn))
 	  (inst li nargs (fixnumize 2))
 	  (inst mr ocfp cfp-tn)
 	  (inst mr cfp-tn csp-tn)
+	  #+PPC-FUN-HACK
 	  (inst j code-tn
 		(- (* function-code-offset word-bytes) function-pointer-type))
+	  #-PPC-FUN-HACK
+	  (inst j lip 0)
 	  
 	  DO-COMPARE
 	  (load-symbol res t)
@@ -348,6 +389,8 @@
 			  (:res res descriptor-reg a0-offset)
 
 			  (:temp lra descriptor-reg lra-offset)
+			  #-PPC-FUN-HACK
+			  (:temp lip interior-reg lip-offset)
 			  (:temp nargs any-reg nargs-offset)
 			  (:temp ocfp any-reg ocfp-offset))
   (inst cmpw :cr1 x y)
@@ -359,15 +402,24 @@
 
   RETURN-NIL
   (inst mr res null-tn)
+  #+PPC-FUN-HACK
   (lisp-return lra :offset 2)
+  #-PPC-FUN-HACK
+  (lisp-return lra lip :offset 2)
 
   DO-STATIC-FN
+  #+PPC-FUN-HACK
   (inst lwz code-tn null-tn (static-function-offset 'eql))
+  #-PPC-FUN-HACK
+  (inst lwz lip null-tn (static-function-offset 'eql))
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
   (inst mr cfp-tn csp-tn)
+  #+PPC-FUN-HACK
   (inst j code-tn
 	(- (* function-code-offset word-bytes) function-pointer-type))
+  #-PPC-FUN-HACK
+  (inst j lip 0)
 
   RETURN-T
   (load-symbol res t))
@@ -385,6 +437,8 @@
    (:res res descriptor-reg a0-offset)
    
    (:temp lra descriptor-reg lra-offset)
+   #-PPC-FUN-HACK
+   (:temp lip interior-reg lip-offset)
    (:temp nargs any-reg nargs-offset)
    (:temp ocfp any-reg ocfp-offset))
 
@@ -395,15 +449,24 @@
   (inst beq :cr1 RETURN-T)
 
   (inst mr res null-tn)
+  #+PPC-FUN-HACK
   (lisp-return lra :offset 2)
+  #-PPC-FUN-HACK
+  (lisp-return lra lip :offset 2)
 
   DO-STATIC-FN
+  #+PPC-FUN-HACK
   (inst lwz code-tn null-tn (static-function-offset 'two-arg-=))
+  #-PPC-FUN-HACK
+  (inst lwz lip null-tn (static-function-offset 'two-arg-=))
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
   (inst mr cfp-tn csp-tn)
+  #+PPC-FUN-HACK
   (inst j code-tn
 	(- (* function-code-offset word-bytes) function-pointer-type))
+  #-PPC-FUN-HACK
+  (inst j lip 0)
 
   RETURN-T
   (load-symbol res t))
@@ -420,6 +483,8 @@
 			  (:res res descriptor-reg a0-offset)
 
 			  (:temp lra descriptor-reg lra-offset)
+			  #-PPC-FUN-HACK
+			  (:temp lip interior-reg lip-offset)
 			  (:temp nargs any-reg nargs-offset)
 			  (:temp ocfp any-reg ocfp-offset))
   (inst or nargs x y)
@@ -429,14 +494,23 @@
   (inst beq :cr1 RETURN-NIL)
 
   (load-symbol res t)
+  #+PPC-FUN-HACK
   (lisp-return lra :offset 2)
+  #-PPC-FUN-HACK
+  (lisp-return lra lip :offset 2)
 
   DO-STATIC-FN
+  #+PPC-FUN-HACK
   (inst lwz code-tn null-tn (static-function-offset 'two-arg-=))
+  #-PPC-FUN-HACK
+  (inst lwz lip null-tn (static-function-offset 'two-arg-=))
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
+  #+PPC-FUN-HACK
   (inst j code-tn
 	(- (* function-code-offset word-bytes) function-pointer-type))
+  #-PPC-FUN-HACK
+  (inst j lip 0)
   (inst mr cfp-tn csp-tn)
 
   RETURN-NIL
diff --git a/assembly/ppc/assem-rtns.lisp b/assembly/ppc/assem-rtns.lisp
index 7d890ce7f733adf80a96c751e35471a43a4687da..654149ead6475fca2853887bfa475863f47fef60 100644
--- a/assembly/ppc/assem-rtns.lisp
+++ b/assembly/ppc/assem-rtns.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/assem-rtns.lisp,v 1.2 2003/08/03 11:27:51 gerd Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/assem-rtns.lisp,v 1.3 2004/07/25 18:15:52 pmai Exp $
 ;;;
 ;;;
 (in-package "PPC")
@@ -27,6 +27,8 @@
      (:temp lra descriptor-reg lra-offset)
 
      ;; These are just needed to facilitate the transfer
+     #-PPC-FUN-HACK
+     (:temp lip interior-reg lip-offset)
      (:temp count any-reg nl2-offset)
      (:temp src any-reg nl3-offset)
      (:temp dst any-reg cfunc-offset)
@@ -83,7 +85,10 @@
   (inst add csp-tn ocfp-tn nvals)
   
   ;; Return.
-  (lisp-return lra))
+  #+PPC-FUN-HACK
+  (lisp-return lra)
+  #-PPC-FUN-HACK
+  (lisp-return lra lip))
 
 
 
@@ -106,6 +111,8 @@
      (:temp dst any-reg nl2-offset)
      (:temp count any-reg nl3-offset)
      (:temp temp descriptor-reg l0-offset)
+     #-PPC-FUN-HACK
+     (:temp lip interior-reg lip-offset)
 
      ;; These are needed so we can get at the register args.
      (:temp a0 descriptor-reg a0-offset)
@@ -142,7 +149,10 @@
   DONE
   ;; We are done.  Do the jump.
   (loadw temp lexenv vm:closure-function-slot vm:function-pointer-type)
-  (lisp-jump temp))
+  #+PPC-FUN-HACK
+  (lisp-jump temp)
+  #-PPC-FUN-HACK
+  (lisp-jump temp lip))
 
 
 
@@ -156,6 +166,8 @@
 			  (:arg start (any-reg descriptor-reg) ocfp-offset)
 			  (:arg count (any-reg descriptor-reg) nargs-offset)
 			  (:temp lra descriptor-reg lra-offset)
+			  #-PPC-FUN-HACK
+			  (:temp lip interior-reg lip-offset)
 			  (:temp cur-uwp any-reg nl0-offset)
 			  (:temp next-uwp any-reg nl1-offset)
 			  (:temp target-uwp any-reg nl2-offset))
@@ -177,7 +189,10 @@
   (loadw cfp-tn cur-uwp vm:unwind-block-current-cont-slot)
   (loadw code-tn cur-uwp vm:unwind-block-current-code-slot)
   (loadw lra cur-uwp vm:unwind-block-entry-pc-slot)
+  #+PPC-FUN-HACK
   (lisp-return lra :frob-code nil)
+  #-PPC-FUN-HACK
+  (lisp-return lra lip :frob-code nil)
 
   DO-UWP
 
diff --git a/assembly/ppc/support.lisp b/assembly/ppc/support.lisp
index 0f7f1224ee141294920e86bad1a1a9600366b052..bc234b6e5d127a0f6009d0571d42f0ad3cb8de30 100644
--- a/assembly/ppc/support.lisp
+++ b/assembly/ppc/support.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/support.lisp,v 1.1 2001/02/11 14:21:52 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/support.lisp,v 1.2 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -61,5 +61,9 @@
      `((lisp-return (make-random-tn :kind :normal
 				    :sc (sc-or-lose 'descriptor-reg *backend*)
 				    :offset lra-offset)
+		    #-PPC-FUN-HACK
+		    (make-random-tn :kind :normal
+		                    :sc (sc-or-lose 'interior-reg *backend*)
+				    :offset lip-offset)
 		    :offset 2)))
     (:none)))
diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp
index 721e47f8f42d5b675f2fc97eb8b50e248e73d6a1..17ad721b6beb063b1d615dfd66aca50bdaf94fc0 100644
--- a/compiler/generic/new-genesis.lisp
+++ b/compiler/generic/new-genesis.lisp
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.69 2004/07/08 04:44:15 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.70 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -917,7 +917,8 @@
 		   (ecase type
 		     (#.vm:function-header-type
 		      (if (or (c:backend-featurep :sparc)
-			      (c:backend-featurep :ppc))
+			      (and (c:backend-featurep :ppc)
+			           (c:backend-featurep :ppc-fun-hack)))
 			  defn
 			  (make-random-descriptor
 			   (+ (logandc2 (descriptor-bits defn) vm:lowtag-mask)
@@ -1938,6 +1939,9 @@
 	((and #+linkage-table nil
 	      (or linux-p freebsd4-p)
 	      (lookup-sym (concatenate 'string "PVE_stub_" name))))
+	((and #+linkage-table nil
+	      (c:backend-featurep :darwin)
+	      (lookup-sym (concatenate 'string "ldso_stub__" name))))
 	;; Non-linux case
 	(#-irix
 	 (lookup-sym name)
@@ -2200,15 +2204,19 @@
        (ecase kind
 	 (:ba
  	  (setf (sap-ref-32 sap 0)
- 		(dpb (ash value -2) (byte 24 2) (sap-ref-32 sap 0))))
+ 		(maybe-byte-swap
+		 (dpb (ash value -2) (byte 24 2)
+		      (maybe-byte-swap (sap-ref-32 sap 0))))))
  	 (:ha
  	  (let* ((h (ldb (byte 16 16) value))
  		 (l (ldb (byte 16 0) value)))
  	    (setf (sap-ref-16 sap 2)
- 		  (if (logbitp 15 l) (ldb (byte 16 0) (1+ h)) h))))
+ 		  (maybe-byte-swap-short
+		   (if (logbitp 15 l) (ldb (byte 16 0) (1+ h)) h)))))
  	 (:l
   	  (setf (sap-ref-16 sap 2)
-  		(ldb (byte 16 0) value)))))))
+	        (maybe-byte-swap-short
+  		 (ldb (byte 16 0) value))))))))
   (undefined-value))
 
 (defun linkage-info-to-core ()
diff --git a/compiler/generic/objdef.lisp b/compiler/generic/objdef.lisp
index cce95f8d46560c53a890b677cefac7678d589907..2fba6103c8ef15eebe88bddc88a15c5ad60327f5 100644
--- a/compiler/generic/objdef.lisp
+++ b/compiler/generic/objdef.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.56 2004/05/24 23:12:30 cwang Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.57 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -96,11 +96,11 @@
 ;;; 
 (defenum (:suffix -type)
   even-fixnum
-  #-ppc function-pointer #+ppc instance-pointer
+  #-PPC-FUN-HACK function-pointer #+PPC-FUN-HACK instance-pointer
   other-immediate-0
   list-pointer
   odd-fixnum
-  #-ppc instance-pointer #+ppc function-pointer
+  #-PPC-FUN-HACK instance-pointer #+PPC-FUN-HACK function-pointer
   other-immediate-1
   other-pointer)
 
@@ -303,7 +303,7 @@
 (define-primitive-object (function :type function
 				   :lowtag function-pointer-type
 				   :header function-header-type)
-  #+ppc (jump-insn)
+  #+PPC-FUN-HACK (jump-insn)
   #-gengc (self :ref-trans %function-self :set-trans (setf %function-self))
   #+gengc (entry-point :c-type "char *")
   (next :type (or function null)
@@ -331,7 +331,7 @@
 
 (define-primitive-object (closure :lowtag function-pointer-type
 				  :header closure-header-type)
-  #+ppc (jump-insn)
+  #+PPC-FUN-HACK (jump-insn)
   #-gengc (function :init :arg :ref-trans %closure-function)
   #+gengc (entry-point :c-type "char *")
   (info :rest-p t))
@@ -340,7 +340,7 @@
 			  :lowtag function-pointer-type
 			  :header funcallable-instance-header-type
 			  :alloc-trans %make-funcallable-instance)
-  #+ppc (jump-insn)
+  #+PPC-FUN-HACK (jump-insn)
   #-gengc
   (function
    :ref-known (flushable) :ref-trans %funcallable-instance-function
diff --git a/compiler/ppc/alloc.lisp b/compiler/ppc/alloc.lisp
index 26ea125a103ae96a7fca1cd25033dc2504308f92..e773f04b7b6362941e09432a01ba662e19445a30 100644
--- a/compiler/ppc/alloc.lisp
+++ b/compiler/ppc/alloc.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/alloc.lisp,v 1.4 2003/08/25 20:50:58 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/alloc.lisp,v 1.5 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -130,7 +130,7 @@
   (:translate make-fdefn)
   (:generator 37
     (with-fixed-allocation (result pa-flag temp fdefn-type fdefn-size)
-      (inst lr temp  (make-fixup "undefined_tramp" :foreign))
+      (inst lr temp  (make-fixup (extern-alien-name "undefined_tramp") :foreign))
       (storew name result fdefn-name-slot other-pointer-type)
       (storew null-tn result fdefn-function-slot other-pointer-type)
       (storew temp result fdefn-raw-addr-slot other-pointer-type))))
@@ -150,7 +150,9 @@
 	(inst ori result result function-pointer-type)
 	(inst lr temp (logior (ash (1- size) type-bits) closure-header-type))
 	(storew temp result 0 function-pointer-type)))
+    #+PPC-FUN-HACK
     (inst lis temp (ash 18 10))
+    #+PPC-FUN-HACK
     (storew temp result closure-jump-insn-slot function-pointer-type)
     (storew function result closure-function-slot function-pointer-type)))
 
diff --git a/compiler/ppc/arith.lisp b/compiler/ppc/arith.lisp
index 4a7ad4474f2f1b0cdb51d4ac09b59721bd3a06db..3edde59ba744a3c4c744308961d156075ba6da75 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.3 2003/08/03 11:27:47 gerd Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/arith.lisp,v 1.4 2004/07/25 18:15:52 pmai Exp $
 ;;;
 ;;;    This file contains the VM definition arithmetic VOPs for the MIPS.
 ;;;
@@ -92,7 +92,6 @@
   (:result-types signed-num)
   (:note "inline (signed-byte 32) arithmetic"))
 
-
 (define-vop (fast-fixnum-binop-c fast-safe-arith-op)
   (:args (x :target r :scs (any-reg zero)))
   (:info y)
@@ -235,7 +234,7 @@
   (:note "safe inline fixnum arithmetic")
   (:generator 4
     (let* ((no-overflow (gen-label)))
-      (inst mcrxr :cr0)
+      (inst mtxer zero-tn)
       (inst addo. r x y)
       (inst bns no-overflow)
       (inst unimp (logior (ash (reg-tn-encoding r) 5)
@@ -250,7 +249,7 @@
   (:note "safe inline fixnum arithmetic")
   (:generator 4
     (let* ((no-overflow (gen-label)))
-      (inst mcrxr :cr0)
+      (inst mtxer zero-tn)
       (inst subo. r x y)
       (inst bns no-overflow)
       (inst unimp (logior (ash (reg-tn-encoding r) 5)
@@ -281,7 +280,7 @@
 	 (inst cmpwi ndesc 31)
 	 (inst srw result number ndesc)
 	 (inst ble done)
-	 (inst srwi result number 31)
+	 (move result zero-tn)
 	 (inst b done)
 
 	 (emit-label positive)
@@ -289,14 +288,12 @@
 	 (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)))))))
-
+	 (cond
+	  ((and (minusp amount) (< amount -31)) (move result zero-tn))
+	  ((minusp amount) (inst srwi result number (- amount)))
+	  (t (inst slwi result number amount))))))))
 
 (define-vop (fast-ash/signed=>signed)
   (:note "inline ASH")
@@ -792,11 +789,11 @@
 (define-vop (bignum-mult)
   (:translate bignum::%multiply)
   (:policy :fast-safe)
-  (:args (x :scs (unsigned-reg) :to (:result 1))
-	 (y :scs (unsigned-reg) :to (:result 1)))
+  (:args (x :scs (unsigned-reg) :to (:eval 1))
+	 (y :scs (unsigned-reg) :to (:eval 1)))
   (:arg-types unsigned-num unsigned-num)
-  (:results (hi :scs (unsigned-reg))
-	    (lo :scs (unsigned-reg)))
+  (:results (hi :scs (unsigned-reg) :from (:eval 1))
+	    (lo :scs (unsigned-reg) :from (:eval 0)))
   (:result-types unsigned-num unsigned-num)
   (:generator 40
     (inst mullw lo x y)
diff --git a/compiler/ppc/array.lisp b/compiler/ppc/array.lisp
index 3c7fc5e74b0f6dc80ac64401104dd19d40804509..99b26f7e1d8a56f2d89c093ff8522c05550b939c 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.3 2003/08/03 11:27:47 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/array.lisp,v 1.4 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -207,8 +207,7 @@
 		      (inst lr temp offset)
 		      (inst lwzx result object temp))))
 	     (unless (zerop extra)
-	       (inst srwi result result
-		     (logxor (* extra ,bits) ,(1- elements-per-word))))
+	       (inst srwi result result (* ,bits extra)))
 	     (unless (= extra ,(1- elements-per-word))
 	       (inst andi. result result ,(1- (ash 1 bits)))))))
        (define-vop (,(symbolicate 'data-vector-set/ type))
diff --git a/compiler/ppc/c-call.lisp b/compiler/ppc/c-call.lisp
index 49cd23ff5d3c5541277e4da9df9266c755b51f32..81bf490c4483fc9dcd83694070d2bd189931c7d0 100644
--- a/compiler/ppc/c-call.lisp
+++ b/compiler/ppc/c-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/c-call.lisp,v 1.3 2003/07/20 13:53:11 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/c-call.lisp,v 1.4 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -18,6 +18,18 @@
 ;;;
 (in-package "PPC")
 
+;;; Return the number of bytes needed for the current non-descriptor
+;;; stack frame.  Non-descriptor stack frames must be multiples of 16
+;;; bytes under the PPC SVr4 ABI (though the EABI may be less
+;;; restrictive).  On linux, two words are reserved for the stack
+;;; backlink and saved LR (see SB!VM::NUMBER-STACK-DISPLACEMENT).
+
+(defconstant +stack-alignment-bytes+
+  ;; Duh.  PPC Linux (and VxWorks) adhere to the EABI.
+  #-darwin 7
+  ;; But Darwin doesn't
+  #+darwin 15)
+
 (defun my-make-wired-tn (prim-type-name sc-name offset)
   (make-wired-tn (primitive-type-or-lose prim-type-name *backend*)
 		 (sc-number-or-lose sc-name *backend*)
@@ -26,8 +38,13 @@
 (defstruct arg-state
   (gpr-args 0)
   (fpr-args 0)
-  ;SVR4 [a]abi wants two words on stack (callee saved lr, backpointer).
-  (stack-frame-size 2))
+  ;; SVR4 [a]abi wants two words on stack (callee saved lr, backpointer).
+  #-darwin
+  (stack-frame-size 2)
+  ;; PowerOpen ABI wants 8 words on the stack corresponding to GPR3-10
+  ;; in addition to the 6 words of link area (see number-stack-displacement)
+  #+darwin
+  (stack-frame-size (+ 8 6)))
 
 (defun int-arg (state prim-type reg-sc stack-sc)
   (let ((reg-args (arg-state-gpr-args state)))
@@ -48,10 +65,11 @@
   (declare (ignore type))
   (int-arg state 'system-area-pointer 'sap-reg 'sap-stack))
 
-; If a single-float arg has to go on the stack, it's promoted to
-; double.  That way, C programs can get subtle rounding errors
-; when unrelated arguments are introduced.
+;;; If a single-float arg has to go on the stack, it's promoted to
+;;; double.  That way, C programs can get subtle rounding errors
+;;; when unrelated arguments are introduced.
 
+#-darwin
 (def-alien-type-method (single-float :arg-tn) (type state)
   (declare (ignore type))
   (let* ((fprs (arg-state-fpr-args state)))
@@ -66,6 +84,36 @@
 	     (setf (arg-state-stack-frame-size state) (+ stack-offset 2))
 	     (my-make-wired-tn 'double-float 'double-stack stack-offset))))))
 
+#+darwin
+(def-alien-type-method (single-float :arg-tn) (type state)
+  (declare (ignore type))
+  (let* ((fprs (arg-state-fpr-args state))
+	 (gprs (arg-state-gpr-args state)))
+    (cond ((< gprs 8) ; and by implication also (< fprs 13)
+	   ;; Corresponding GPR is kept empty for functions with fixed args
+	   (incf (arg-state-gpr-args state))
+	   (incf (arg-state-fpr-args state))
+	   ;; Assign outgoing FPRs starting at FP1
+	   (my-make-wired-tn 'single-float 'single-reg (1+ fprs)))
+	  ((< fprs 13)
+	   ;; According to PowerOpen ABI, we need to pass those both in the
+	   ;; FPRs _and_ the stack.  However empiric testing on OS X/gcc
+	   ;; shows they are only passed in FPRs, AFAICT.
+	   ;;
+	   ;; "I" in "AFAICT" probably refers to PRM.  -- CSR, still
+	   ;; reverse-engineering comments in 2003 :-)
+	   ;;
+	   ;; Yes, it does -- me :)
+	   (incf (arg-state-fpr-args state))
+	   (incf (arg-state-stack-frame-size state))
+	   (my-make-wired-tn 'single-float 'single-reg (1+ fprs)))
+	  (t
+	   ;; Pass on stack only
+	   (let ((stack-offset (arg-state-stack-frame-size state)))
+	     (incf (arg-state-stack-frame-size state))
+	     (my-make-wired-tn 'single-float 'single-stack stack-offset))))))
+
+#-darwin
 (def-alien-type-method (double-float :arg-tn) (type state)
   (declare (ignore type))
   (let* ((fprs (arg-state-fpr-args state)))
@@ -80,27 +128,71 @@
 	     (setf (arg-state-stack-frame-size state) (+ stack-offset 2))
 	     (my-make-wired-tn 'double-float 'double-stack stack-offset))))))
 	   
-(def-alien-type-method (integer :result-tn) (type)
-  (if (alien-integer-type-signed type)
-      (my-make-wired-tn 'signed-byte-32 'signed-reg nl0-offset)
-      (my-make-wired-tn 'unsigned-byte-32 'unsigned-reg nl0-offset)))
+#+darwin
+(def-alien-type-method (double-float :arg-tn) (type state)
+  (declare (ignore type))
+  (let ((fprs (arg-state-fpr-args state))
+	(gprs (arg-state-gpr-args state)))
+    (cond ((< gprs 8) ; and by implication also (< fprs 13)
+	   ;; Corresponding GPRs are also kept empty
+	   (incf (arg-state-gpr-args state) 2)
+	   (when (> (arg-state-gpr-args state) 8)
+	     ;; Spill one word to stack
+	     (decf (arg-state-gpr-args state))
+	     (incf (arg-state-stack-frame-size state)))
+	   (incf (arg-state-fpr-args state))
+	   ;; Assign outgoing FPRs starting at FP1
+	   (my-make-wired-tn 'double-float 'double-reg (1+ fprs)))
+	  ((< fprs 13)
+	   ;; According to PowerOpen ABI, we need to pass those both in the
+	   ;; FPRs _and_ the stack.  However empiric testing on OS X/gcc
+	   ;; shows they are only passed in FPRs, AFAICT.
+	   (incf (arg-state-stack-frame-size state) 2)
+	   (incf (arg-state-fpr-args state))
+	   (my-make-wired-tn 'double-float 'double-reg (1+ fprs)))
+	  (t
+	   ;; Pass on stack only
+	   (let ((stack-offset (arg-state-stack-frame-size state)))
+	     (incf (arg-state-stack-frame-size state) 2)
+	     (my-make-wired-tn 'double-float 'double-stack stack-offset))))))
 
+;;; Result state handling
 
-(def-alien-type-method (system-area-pointer :result-tn) (type)
-  (declare (ignore type))
-  (my-make-wired-tn 'system-area-pointer 'sap-reg nl0-offset))
+(defstruct result-state
+  (num-results 0))
 
-(def-alien-type-method (single-float :result-tn) (type)
+(defun generate-result-reg-offset (state)
+  (let ((slot (result-state-num-results state)))
+    (incf (result-state-num-results state))
+    (ecase slot
+      (0 nl0-offset)
+      (1 nl1-offset))))
+
+(def-alien-type-method (integer :result-tn) (type state)
+  (let ((offset (generate-result-reg-offset state)))
+    (if (alien-integer-type-signed type)
+        (my-make-wired-tn 'signed-byte-32 'signed-reg offset)
+        (my-make-wired-tn 'unsigned-byte-32 'unsigned-reg offset))))
+
+
+(def-alien-type-method (system-area-pointer :result-tn) (type state)
   (declare (ignore type))
+  (my-make-wired-tn 'system-area-pointer 'sap-reg
+                    (generate-result-reg-offset state)))
+
+(def-alien-type-method (single-float :result-tn) (type state)
+  (declare (ignore type state))
   (my-make-wired-tn 'single-float 'single-reg 1))
 
-(def-alien-type-method (double-float :result-tn) (type)
-  (declare (ignore type))
+(def-alien-type-method (double-float :result-tn) (type state)
+  (declare (ignore type state))
   (my-make-wired-tn 'double-float 'double-reg 1))
 
-(def-alien-type-method (values :result-tn) (type)
+(def-alien-type-method (values :result-tn) (type state)
+  (when (> (length (alien-values-type-values type)) 2)
+    (error "Too many result values from c-call."))
   (mapcar #'(lambda (type)
-	      (invoke-alien-type-method :result-tn type))
+	      (invoke-alien-type-method :result-tn type state))
 	  (alien-values-type-values type)))
 
 
@@ -115,7 +207,62 @@
 	      (arg-tns)
 	      (invoke-alien-type-method
 	       :result-tn
-	       (alien-function-type-result-type type))))))
+	       (alien-function-type-result-type type)
+	       (make-result-state))))))
+
+(deftransform %alien-funcall ((function type &rest args))
+  (assert (c::constant-continuation-p type))
+  (let* ((type (c::continuation-value type))
+	 (arg-types (alien-function-type-arg-types type))
+	 (result-type (alien-function-type-result-type type)))
+    (assert (= (length arg-types) (length args)))
+    (if (or (some #'(lambda (type)
+		      (and (alien-integer-type-p type)
+			   (> (alien::alien-integer-type-bits type) 32)))
+		  arg-types)
+	    (and (alien-integer-type-p result-type)
+		 (> (alien::alien-integer-type-bits result-type) 32)))
+	(collect ((new-args) (lambda-vars) (new-arg-types))
+	  (dolist (type arg-types)
+	    (let ((arg (gensym)))
+	      (lambda-vars arg)
+	      (cond ((and (alien-integer-type-p type)
+			  (> (alien::alien-integer-type-bits type) 32))
+		     (new-args `(ash ,arg -32))
+		     (new-args `(logand ,arg #xffffffff))
+		     (if (alien-integer-type-signed type)
+			 (new-arg-types (parse-alien-type '(signed 32)))
+			 (new-arg-types (parse-alien-type '(unsigned 32))))
+		     (new-arg-types (parse-alien-type '(unsigned 32))))
+		    (t
+		     (new-args arg)
+		     (new-arg-types type)))))
+	  (cond ((and (alien-integer-type-p result-type)
+		      (> (alien::alien-integer-type-bits result-type) 32))
+		 (let ((new-result-type
+			(let ((alien::*values-type-okay* t))
+			  (parse-alien-type
+			   (if (alien-integer-type-signed result-type)
+			       '(values (signed 32) (unsigned 32))
+			       '(values (unsigned 32) (unsigned 32)))))))
+		   `(lambda (function type ,@(lambda-vars))
+		      (declare (ignore type))
+		      (multiple-value-bind (high low)
+			  (%alien-funcall function
+					  ',(make-alien-function-type
+					     :arg-types (new-arg-types)
+					     :result-type new-result-type)
+					  ,@(new-args))
+			(logior low (ash high 32))))))
+		(t
+		 `(lambda (function type ,@(lambda-vars))
+		    (declare (ignore type))
+		    (%alien-funcall function
+				    ',(make-alien-function-type
+				       :arg-types (new-arg-types)
+				       :result-type result-type)
+				    ,@(new-args))))))
+	(c::give-up))))
 
 
 (define-vop (foreign-symbol-address)
@@ -127,7 +274,7 @@
   (:results (res :scs (sap-reg)))
   (:result-types system-area-pointer)
   (:generator 2
-    (inst lr res  (make-fixup foreign-symbol :foreign))))
+    (inst lr res  (make-fixup (extern-alien-name foreign-symbol) :foreign))))
 
 (define-vop (call-out)
   (:args (function :scs (sap-reg) :target cfunc)
@@ -144,7 +291,7 @@
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
 	(store-stack-tn nfp-save cur-nfp))
-      (inst lr temp (make-fixup "call_into_c" :foreign))
+      (inst lr temp (make-fixup (extern-alien-name "call_into_c") :foreign))
       (inst mtctr temp)
       (move cfunc function)
       (inst bctrl)
@@ -158,7 +305,9 @@
   (:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
   (:generator 0
     (unless (zerop amount)
-      (let ((delta (- (logandc2 (+ amount 8 7) 7))))
+      (let ((delta (- (logandc2 (+ amount number-stack-displacement
+                                   +stack-alignment-bytes+)
+				+stack-alignment-bytes+))))
 	(cond ((>= delta (ash -1 16))
 	       (inst stwu nsp-tn nsp-tn delta))
 	      (t
@@ -175,7 +324,9 @@
   (:policy :fast-safe)
   (:generator 0
     (unless (zerop amount)
-      (let ((delta (logandc2 (+ amount 8 7) 7)))
+      (let ((delta (logandc2 (+ amount number-stack-displacement
+                                +stack-alignment-bytes+)
+			     +stack-alignment-bytes+)))
 	(cond ((< delta (ash 1 16))
 	       (inst addi nsp-tn nsp-tn delta))
 	      (t
diff --git a/compiler/ppc/call.lisp b/compiler/ppc/call.lisp
index cdab3cd4580c7e8ce963f2fede276e8af8906c90..e99502e5a10c574ef823b784ae78d5f9450f39b4 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.4 2003/08/05 15:51:35 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/call.lisp,v 1.5 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -141,11 +141,11 @@
 ;;; are reserved for the stack backlink and saved LR (see PPC::NUMBER-STACK-
 ;;; DISPLACEMENT.)
 ;;;
-;;; Duh.  PPC Linux (and VxWorks) adhere to the EABI.
+;;; Duh.  PPC Linux (and VxWorks) adhere to the EABI, but Darwin doesn't.
 (defun bytes-needed-for-non-descriptor-stack-frame ()
-  (logandc2 (+ 7 number-stack-displacement
+  (logandc2 (+ +stack-alignment-bytes+ number-stack-displacement
 	       (* (sb-allocated-size 'non-descriptor-stack) vm:word-bytes))
-	    7))
+	    +stack-alignment-bytes+))
 
 
 ;;; Used for setting up the Old-FP in local call.
@@ -178,16 +178,26 @@
     (align vm:lowtag-bits)
     (trace-table-entry trace-table-function-prologue)
     (emit-label start-lab)
+    #+PPC-FUN-HACK
     (let* ((entry-label (gen-label)))
       ;; Allocate function header.
       (inst function-header-word)
       (inst b entry-label)
       (dotimes (i (1- (1- vm:function-code-offset)))
 	(inst word 0))
-      (emit-label entry-label))
-    ;; The start of the actual code.
-    ;; Fix CODE, cause the function object was passed in.
-    (inst compute-code-from-fn code-tn code-tn start-lab temp)
+      (emit-label entry-label)
+      ;; The start of the actual code.
+      ;; Fix CODE, cause the function object was passed in.
+      (inst compute-code-from-fn code-tn code-tn start-lab temp))
+    #-PPC-FUN-HACK
+    (let* ((entry-label (gen-label)))
+      ;; Allocate function header.
+      (inst function-header-word)
+      (dotimes (i (1- vm:function-code-offset))
+	(inst word 0))
+      (emit-label entry-label)
+      ;; The start of the actual code.
+      (inst compute-code-from-fn code-tn lip-tn entry-label temp))
     ;; Build our stack frames.
     (inst addi csp-tn cfp-tn
 	  (* vm:word-bytes (sb-allocated-size 'control-stack)))
@@ -358,9 +368,8 @@ default-value-8
 		      ((null remaining))
 		    (let ((def (car remaining)))
 		      (emit-label (car def))
-		      (when (null (cdr remaining))
-			(inst b defaulting-done))
 		      (store-stack-tn (cdr def) null-tn)))
+		  (inst b defaulting-done)
 		  (trace-table-entry trace-table-normal))))))
 
 	(inst compute-code-from-lra code-tn code-tn lra-label temp)))
@@ -697,7 +706,8 @@ default-value-8
 		 return-pc-pass)
 
      ,(if named
-	  `(:temporary (:sc descriptor-reg :offset cname-offset
+	  `(:temporary (:sc descriptor-reg :offset #+PPC-FUN-HACK cname-offset
+	                                           #-PPC-FUN-HACK fdefn-offset
 			    :from (:argument ,(if (eq return :tail) 0 1))
 			    :to :eval)
 		       name-pass)
@@ -725,6 +735,8 @@ default-value-8
 	 '((:temporary (:scs (non-descriptor-reg)) temp)
 	   (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)))
 
+     (:temporary (:sc interior-reg :offset lip-offset) entry-point)
+
      (:generator ,(+ (if named 5 0)
 		     (if variable 19 1)
 		     (if (eq return :tail) 0 10)
@@ -807,8 +819,12 @@ default-value-8
 		      (loadw name-pass code-tn (tn-offset name)
 			     vm:other-pointer-type)
 		      (do-next-filler)))
+		   #+PPC-FUN-HACK
 		   (loadw function name-pass fdefn-raw-addr-slot
 			  other-pointer-type)
+		   #-PPC-FUN-HACK
+		   (loadw entry-point name-pass fdefn-raw-addr-slot
+			  other-pointer-type)
 		   (do-next-filler))
 		 `((sc-case arg-fun
 		     (descriptor-reg (move lexenv arg-fun))
@@ -821,15 +837,19 @@ default-value-8
 		      (do-next-filler)))
 		   (loadw function lexenv vm:closure-function-slot
 			  vm:function-pointer-type)
-		   (do-next-filler)))
+		   (do-next-filler)
+		   #-PPC-FUN-HACK
+		   (inst addi entry-point function
+			      (- (ash vm:function-code-offset vm:word-shift)
+			         vm:function-pointer-type))))
 	   (loop
 	     (if filler
 		 (do-next-filler)
 		 (return)))
 	   
 	   (note-this-location vop :call-site)
-	   (inst mtctr function)
-	   (inst mr code-tn function)
+	   (inst mtctr #+PPC-FUN-HACK function #-PPC-FUN-HACK entry-point)
+	   #+PPC-FUN-HACK-MAYBE (inst mr code-tn function)
 	   (inst bctr)
 	   #|
 	   (inst j function
@@ -914,6 +934,8 @@ default-value-8
 	 (return-pc :scs (descriptor-reg))
 	 (value))
   (:ignore value)
+  #-PPC-FUN-HACK
+  (:temporary (:scs (interior-reg)) lip)
   (:vop-var vop)
   (:generator 6
     (trace-table-entry trace-table-function-epilogue)
@@ -927,7 +949,10 @@ default-value-8
     (move csp-tn cfp-tn)
     (move cfp-tn old-fp)
     ;; Out of here.
+    #+PPC-FUN-HACK
     (lisp-return return-pc :offset 2)
+    #-PPC-FUN-HACK
+    (lisp-return return-pc lip :offset 2)
     (trace-table-entry trace-table-normal)))
 
 ;;; Do unknown-values return of a fixed number of values.  The Values are
@@ -956,6 +981,8 @@ default-value-8
   (:temporary (:sc descriptor-reg :offset a3-offset :from (:eval 0)) a3)
   (:temporary (:sc any-reg :offset nargs-offset) nargs)
   (:temporary (:sc any-reg :offset ocfp-offset) val-ptr)
+  #-PPC-FUN-HACK
+  (:temporary (:scs (interior-reg)) lip)
   (:vop-var vop)
   (:generator 6
     (trace-table-entry trace-table-function-epilogue)
@@ -970,7 +997,10 @@ default-value-8
 	   (move csp-tn cfp-tn)
 	   (move cfp-tn old-fp)
 	   ;; Out of here.
-	   (lisp-return return-pc :offset 2))
+	   #+PPC-FUN-HACK
+	   (lisp-return return-pc :offset 2)
+	   #-PPC-FUN-HACK
+	   (lisp-return return-pc lip :offset 2))
 	  (t
 	   ;; Establish the values pointer and values count.
 	   (move val-ptr cfp-tn)
@@ -984,7 +1014,10 @@ default-value-8
 	     (dolist (reg (subseq (list a0 a1 a2 a3) nvals))
 	       (move reg null-tn)))
 	   ;; And away we go.
-	   (lisp-return return-pc)))
+	   #+PPC-FUN-HACK
+	   (lisp-return return-pc)
+	   #-PPC-FUN-HACK
+	   (lisp-return return-pc lip)))
     (trace-table-entry trace-table-normal)))
 
 ;;; Do unknown-values return of an arbitrary number of values (passed on the
@@ -1004,6 +1037,8 @@ default-value-8
   (:temporary (:sc any-reg :offset nl0-offset :from (:argument 2)) vals)
   (:temporary (:sc any-reg :offset nargs-offset :from (:argument 3)) nvals)
   (:temporary (:sc descriptor-reg :offset a0-offset) a0)
+  #-PPC-FUN-HACK
+  (:temporary (:scs (interior-reg)) lip)
 
 
   (:vop-var vop)
@@ -1026,7 +1061,10 @@ default-value-8
       ;; Return with one value.
       (move csp-tn cfp-tn)
       (move cfp-tn old-fp-arg)
+      #+PPC-FUN-HACK
       (lisp-return lra-arg :offset 2)
+      #-PPC-FUN-HACK
+      (lisp-return lra-arg lip :offset 2)
 		
       ;; Nope, not the single case.
       (emit-label not-single)
diff --git a/compiler/ppc/cell.lisp b/compiler/ppc/cell.lisp
index 2595f5a403e6c632afb502d7c4f8f5e64299e05b..6400cc650b2936880ac7995f3a97d1d556e0bcdf 100644
--- a/compiler/ppc/cell.lisp
+++ b/compiler/ppc/cell.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/cell.lisp,v 1.1 2001/02/11 14:22:04 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/cell.lisp,v 1.2 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -123,10 +123,16 @@
     (let ((normal-fn (gen-label)))
       (load-type type function (- function-pointer-type))
       (inst cmpwi type function-header-type)
+      #+PPC-FUN-HACK
       (inst mr lip function)
+      #-PPC-FUN-HACK
+      (inst addi lip function
+                 (- (ash vm:function-code-offset vm:word-shift)
+		    function-pointer-type))
       (inst beq normal-fn)
-      (inst lr lip  (make-fixup "closure_tramp" :foreign))
+      (inst lr lip  (make-fixup (extern-alien-name "closure_tramp") :foreign))
       (emit-label normal-fn)
+      ;;PRM:FIXME? Order of following stores is reversed in SBCL
       (storew function fdefn fdefn-function-slot other-pointer-type)
       (storew lip fdefn fdefn-raw-addr-slot other-pointer-type)
       (move result function))))
@@ -139,7 +145,7 @@
   (:results (result :scs (descriptor-reg)))
   (:generator 38
     (storew null-tn fdefn fdefn-function-slot other-pointer-type)
-    (inst lr temp  (make-fixup "undefined_tramp" :foreign))
+    (inst lr temp  (make-fixup (extern-alien-name "undefined_tramp") :foreign))
     (storew temp fdefn fdefn-raw-addr-slot other-pointer-type)
     (move result fdefn)))
 
@@ -256,6 +262,7 @@
   (:translate %instance-ref)
   (:arg-types instance (:constant index)))
 
+;;PRM:FIXME? Commented out in SBCL
 (define-vop (instance-set slot-set)
   (:policy :fast-safe)
   (:translate %instance-set)
diff --git a/compiler/ppc/float.lisp b/compiler/ppc/float.lisp
index 2a6ff2276a715da99fa06f9399217fe87c189ca1..9436f3d03eef56662eaf4c0ce156bbac3baccbe6 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.2 2001/02/11 16:43:18 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/float.lisp,v 1.3 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -139,7 +139,7 @@
 		  :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)))
+		  :offset (1+ (tn-offset x))))
 
 
 (define-move-function (load-complex-single 2) (vop x y)
@@ -510,8 +510,7 @@
 		(:args (x :scs (,from-sc) :target temp))
 		(:temporary (:from (:argument 0) :sc single-reg) temp)
 		(:temporary (:scs (double-stack)) stack-temp)
-		(:results (y :scs (signed-reg)
-			     :load-if (not (sc-is y signed-stack))))
+		(:results (y :scs (signed-reg)))
 		(:arg-types ,from-type)
 		(:result-types signed-num)
 		(:translate ,trans)
@@ -522,15 +521,10 @@
 		(:generator 5
 		  (note-this-location vop :internal-error)
 		  (inst ,inst temp x)
-		  (sc-case y
-		    (signed-stack
-		     (inst stfd temp (current-nfp-tn vop)
-			   (* (tn-offset y) vm:word-bytes)))
-		    (signed-reg
-		     (inst stfd temp (current-nfp-tn vop)
-			   (* (tn-offset stack-temp) vm:word-bytes))
-		     (inst lwz y (current-nfp-tn vop)
-			   (+ 4 (* (tn-offset stack-temp) vm:word-bytes)))))))))
+		  (inst stfd temp (current-nfp-tn vop)
+			(* (tn-offset stack-temp) vm:word-bytes))
+		  (inst lwz y (current-nfp-tn vop)
+			(+ 4 (* (tn-offset stack-temp) vm:word-bytes)))))))
   (frob %unary-truncate single-reg single-float fctiwz)
   (frob %unary-truncate double-reg double-float fctiwz)
   (frob %unary-round single-reg single-float fctiw)
@@ -632,68 +626,50 @@
 (define-vop (double-float-high-bits)
   (:args (float :scs (double-reg descriptor-reg)
 		:load-if (not (sc-is float double-stack))))
-  (:results (hi-bits :scs (signed-reg)
-		     :load-if (or (sc-is float descriptor-reg double-stack)
-				  (not (sc-is hi-bits signed-stack)))))
-  (:temporary (:scs (signed-stack)) stack-temp)
+  (:results (hi-bits :scs (signed-reg)))
+  (:temporary (:scs (double-stack)) stack-temp)
   (:arg-types double-float)
   (:result-types signed-num)
   (:translate double-float-high-bits)
   (:policy :fast-safe)
   (:vop-var vop)
   (:generator 5
-    (sc-case hi-bits
-      (signed-reg
-       (sc-case float
-	 (double-reg
-	  (inst stfd float (current-nfp-tn vop)
-		(* (tn-offset stack-temp) vm:word-bytes))
-	  (inst lwz hi-bits (current-nfp-tn vop)
-		(* (tn-offset stack-temp) vm:word-bytes)))
-	 (double-stack
-	  (inst lwz hi-bits (current-nfp-tn vop)
-		(* (tn-offset float) vm:word-bytes)))
-	 (descriptor-reg
-	  (loadw hi-bits float vm:double-float-value-slot
-		 vm:other-pointer-type))))
-      (signed-stack
-       (sc-case float
-	 (double-reg
-	  (inst stfd float (current-nfp-tn vop)
-		(* (tn-offset hi-bits) vm:word-bytes))))))))
+    (sc-case float
+      (double-reg
+       (inst stfd float (current-nfp-tn vop)
+	     (* (tn-offset stack-temp) vm:word-bytes))
+       (inst lwz hi-bits (current-nfp-tn vop)
+	     (* (tn-offset stack-temp) vm:word-bytes)))
+      (double-stack
+       (inst lwz hi-bits (current-nfp-tn vop)
+	     (* (tn-offset float) vm:word-bytes)))
+      (descriptor-reg
+       (loadw hi-bits float vm:double-float-value-slot
+	      vm:other-pointer-type)))))
 
 (define-vop (double-float-low-bits)
   (:args (float :scs (double-reg descriptor-reg)
 		:load-if (not (sc-is float double-stack))))
-  (:results (lo-bits :scs (unsigned-reg)
-		     :load-if (or (sc-is float descriptor-reg double-stack)
-				  (not (sc-is lo-bits unsigned-stack)))))
-  (:temporary (:scs (unsigned-stack)) stack-temp)
+  (:results (lo-bits :scs (unsigned-reg)))
+  (:temporary (:scs (double-stack)) stack-temp)
   (:arg-types double-float)
   (:result-types unsigned-num)
   (:translate double-float-low-bits)
   (:policy :fast-safe)
   (:vop-var vop)
   (:generator 5
-    (sc-case lo-bits
-      (unsigned-reg
-       (sc-case float
-	 (double-reg
-	  (inst stfd float (current-nfp-tn vop)
-		(* (tn-offset stack-temp) vm:word-bytes))
-	  (inst lwz lo-bits (current-nfp-tn vop)
-		(* (1+ (tn-offset stack-temp)) vm:word-bytes)))
-	 (double-stack
-	  (inst lwz lo-bits (current-nfp-tn vop)
-		(* (1+ (tn-offset float)) vm:word-bytes)))
-	 (descriptor-reg
-	  (loadw lo-bits float (1+ vm:double-float-value-slot)
-		 vm:other-pointer-type))))
-      (unsigned-stack
-       (sc-case float
-	 (double-reg
-	  (inst stfd float (current-nfp-tn vop)
-		(* (tn-offset lo-bits) vm:word-bytes))))))))
+    (sc-case float
+      (double-reg
+       (inst stfd float (current-nfp-tn vop)
+	     (* (tn-offset stack-temp) vm:word-bytes))
+       (inst lwz lo-bits (current-nfp-tn vop)
+	     (* (1+ (tn-offset stack-temp)) vm:word-bytes)))
+      (double-stack
+       (inst lwz lo-bits (current-nfp-tn vop)
+	     (* (1+ (tn-offset float)) vm:word-bytes)))
+      (descriptor-reg
+       (loadw lo-bits float (1+ vm:double-float-value-slot)
+	      vm:other-pointer-type)))))
 
 
 ;;;; Float mode hackery:
diff --git a/compiler/ppc/insts.lisp b/compiler/ppc/insts.lisp
index 7a393e1694bea5d8eb3807bb3ea87ed3f9ca0a85..ed6d8452c0208a34cf069ca64b1c5384a34b146e 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.3 2002/01/11 16:27:12 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/insts.lisp,v 1.4 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -249,16 +249,36 @@
          (lk-bit (if lk-p 1 0)))
     (if aa-p                            ; Not bloody likely, bwth.
       (emit-b-form-inst segment 16 bo bi target aa-bit lk-bit)
-      (emit-back-patch segment 4
-		       #'(lambda (segment posn)
-		           (emit-b-form-inst 
-                            segment
-                            16
-                            bo
-                            bi
-                            (ash (- (label-position target) posn) -2)
-                            aa-bit
-                            lk-bit))))))
+      ;; the target may be >+-8k away, in which case we have to invert the
+      ;; test and do an absolute branch
+      (emit-chooser
+       ;; We emit either 4 or 8 bytes, so I think we declare this as
+       ;; preserving 4 byte alignment.  If this gives us no joy, we can
+       ;; stick a nop in the long branch and then we will be
+       ;; preserving 8 byte alignment
+       segment 8 2 ; 2^2 is 4 byte alignment.  I think
+       #'(lambda (segment posn magic-value)
+	   (let ((delta (ash (- (label-position target posn magic-value) posn)
+			     -2)))
+	     (when (typep delta '(signed-byte 14))
+	       (emit-back-patch segment 4
+				#'(lambda (segment posn)
+				    (emit-b-form-inst 
+				     segment 16 bo bi
+				     (ash (- (label-position target) posn) -2)
+				     aa-bit lk-bit)))
+	       t)))
+       #'(lambda (segment posn)
+	   (let ((bo (logxor 8 bo))) ;; invert the test
+	     (emit-b-form-inst segment 16 bo bi
+			       2 ; skip over next instruction
+			       0 0)
+	     (emit-back-patch segment 4
+			      #'(lambda (segment posn)
+				  (emit-i-form-branch segment target lk-p)))))
+       ))))
+	     
+
 
 ; non-absolute I-form: B, BL.
 (defun emit-i-form-branch (segment target &optional lk-p)
@@ -1689,7 +1709,7 @@
 (define-instruction mffs. (segment frd)
   (:printer x-22 ((op 63)  (xo 583) (rc 1)))
   (:delay 1)
-  (:dependencies (reads :fpscr) (writes frd))
+  (:dependencies (reads :fpscr) (writes frd) (writes :ccr))
   (:emitter (emit-x-form-inst segment 
                           63 
                           (fp-reg-tn-encoding frd)
@@ -2028,6 +2048,7 @@
    (emit-compute-inst segment vop dst src label temp
 		      #'(lambda (label posn delta-if-after)
 			  (- other-pointer-type
+			     #+PPC-FUN-HACK-MAYBE
 			     function-pointer-type
 			     (label-position label posn delta-if-after)
 			     (component-header-length))))))
diff --git a/compiler/ppc/macros.lisp b/compiler/ppc/macros.lisp
index 35f7a64f4f9046656cc08a1959284cfb2684006b..78db756e0d5a1cda36b193bac146fa33552786f2 100644
--- a/compiler/ppc/macros.lisp
+++ b/compiler/ppc/macros.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/macros.lisp,v 1.1 2001/02/11 14:22:04 dtc Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/macros.lisp,v 1.2 2004/07/25 18:15:52 pmai Exp $
 ;;;
 ;;; This file contains various useful macros for generating PC code.
 ;;;
@@ -78,6 +78,7 @@
 ;;; Macros to handle the fact that we cannot use the machine native call and
 ;;; return instructions. 
 
+#+PPC-FUN-HACK
 (defmacro lisp-jump (function)
   "Jump to the lisp function FUNCTION."
   `(progn
@@ -85,6 +86,17 @@
      (move code-tn ,function)
      (inst bctr)))
 
+#-PPC-FUN-HACK
+(defmacro lisp-jump (function lip)
+  "Jump to the lisp function FUNCTION."
+  `(progn
+     (inst addi ,lip ,function (- (* vm:word-bytes vm:function-code-offset)
+                                  vm:function-pointer-type))
+     (inst mtctr ,lip)
+     (move code-tn ,function)
+     (inst bctr)))
+
+#+PPC-FUN-HACK
 (defmacro lisp-return (return-pc &key (offset 0) (frob-code t))
   "Return to RETURN-PC."
   `(progn
@@ -94,6 +106,16 @@
          `((move code-tn ,return-pc)))
      (inst blr)))
 
+#-PPC-FUN-HACK
+(defmacro lisp-return (return-pc lip &key (offset 0) (frob-code t))
+  "Return to RETURN-PC."
+  `(progn
+     (inst addi ,lip ,return-pc (- (* (1+ ,offset) vm:word-bytes) vm:other-pointer-type))
+     (inst mtlr ,lip)
+     ,@(if frob-code
+         `((move code-tn ,return-pc)))
+     (inst blr)))
+
 (defmacro emit-return-pc (label)
   "Emit a return-pc header word.  LABEL is the label to use for this return-pc."
   `(progn
diff --git a/compiler/ppc/move.lisp b/compiler/ppc/move.lisp
index 56920f5856f870355a6de5facac33fa733cf04a8..30df3e00051c4a83d621af8a3916d94e2f520fd4 100644
--- a/compiler/ppc/move.lisp
+++ b/compiler/ppc/move.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/move.lisp,v 1.2 2003/08/03 11:27:47 gerd Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/move.lisp,v 1.3 2004/07/25 18:15:52 pmai Exp $
 ;;;
 ;;;    This file contains the SPARC VM definition of operand loading/saving and
 ;;; the Move VOP.
@@ -222,7 +222,7 @@
   (:generator 20
     (move x arg)
     (let ((done (gen-label)))
-      (inst mcrxr :cr0)                 ; clear sticky overflow bits in XER, CR0
+      (inst mtxer zero-tn)              ; clear sticky overflow bit in XER, CR0
       (inst addo temp x x)              ; set XER OV if top two bits differ
       (inst addo. temp temp temp)       ; set CR0 SO if any top three bits differ
       (inst slwi y x 2)                 ; assume fixnum (tagged ok, maybe lost some high bits)
diff --git a/compiler/ppc/parms.lisp b/compiler/ppc/parms.lisp
index b9015c801c73b14f4978bae882cc0691d37dbc7c..c5ef85a2fa467c22dcd0eee15ee6ca1ff693bd77 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.6 2003/09/26 15:37:11 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.7 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -116,9 +116,9 @@
 (defconstant float-round-to-negative 3)
 
 (defconstant float-rounding-mode (byte 2 0))	  ; RD 
-(defconstant float-sticky-bits (byte 10 19))
-(defconstant float-traps-byte (byte 6 3))	  ; 
-(defconstant float-exceptions-byte (byte 5 0))	  ; cexc
+(defconstant float-sticky-bits (byte 5 25))
+(defconstant float-traps-byte (byte 5 3))	  ; 
+(defconstant float-exceptions-byte (byte 5 25))	  ; cexc
 
 (defconstant float-fast-bit 2)		; Non-IEEE mode
 
@@ -131,7 +131,8 @@
 ;;; work.
 ;;; 
 (defconstant number-stack-displacement
-  (* 2 vm:word-bytes))
+  (* #-darwin 2
+     #+darwin 8 vm:word-bytes))
 
 
 ;;;; Description of the target address space.
@@ -145,8 +146,8 @@
 ;;; Where to put the different spaces.
 ;;; 
 (defparameter target-read-only-space-start #x01000000)
-(defparameter target-static-space-start    #x05000000)
-(defparameter target-dynamic-space-start   #x07000000)
+(defparameter target-static-space-start    #x08000000)
+(defparameter target-dynamic-space-start   #x40000000)
 (defparameter target-foreign-linkage-space-start #x0fc00000)
 (defconstant target-foreign-linkage-entry-size 8) ;In bytes.  Duh.
 
@@ -226,6 +227,25 @@
     unix::*interrupts-enabled*
     unix::*interrupt-pending*
 
+    ;; Make the ..slot-unbound.. symbol static to optimise the
+    ;; common slot unbound check.
+    pcl::..slot-unbound..
+
+    ;; These are filled in the C run-time.
+    lisp::*cmucl-lib*
+    lisp::*cmucl-core-path*
+      
+    ;; Spare symbols.  Rename these when you need to add some static
+    ;; symbols and don't want to do a cross-compile.
+    spare-8
+    spare-7
+    spare-6
+    spare-5
+    spare-4
+    spare-3
+    spare-2
+    spare-1
+
     #|kernel::*current-thread*|#
     ))
 
diff --git a/compiler/ppc/print.lisp b/compiler/ppc/print.lisp
index 74550a2591e80210843ef9ac4a53adc07729ca2f..b1e83f5dc54191ad37e118172acad34d463b9d00 100644
--- a/compiler/ppc/print.lisp
+++ b/compiler/ppc/print.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/print.lisp,v 1.1 2001/02/11 14:22:05 dtc Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/print.lisp,v 1.2 2004/07/25 18:15:52 pmai Rel $
 ;;;
 ;;; This file contains VOPs for things like printing during %initial-function
 ;;; before the world is initialized.
@@ -32,10 +32,10 @@
       (when cur-nfp
 	(store-stack-tn nfp-save cur-nfp))
       (move nl0 object)
-      (inst lr temp  (make-fixup "call_into_c" :foreign))
+      (inst lr temp  (make-fixup (extern-alien-name "call_into_c") :foreign))
       (inst mr lip temp)
       (inst mtctr lip)
-      (inst lr cfunc (make-fixup "debug_print" :foreign))
+      (inst lr cfunc (make-fixup (extern-alien-name "debug_print") :foreign))
       (inst bctrl)
       (when cur-nfp
 	(load-stack-tn cur-nfp nfp-save))
diff --git a/compiler/ppc/static-fn.lisp b/compiler/ppc/static-fn.lisp
index 2222b013d7c214a08b5933241f594e5bcaf8156c..870372a5499a0d17a47823621872081782bd0fae 100644
--- a/compiler/ppc/static-fn.lisp
+++ b/compiler/ppc/static-fn.lisp
@@ -7,7 +7,7 @@
 ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU)
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/static-fn.lisp,v 1.2 2003/08/03 11:27:47 gerd Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/static-fn.lisp,v 1.3 2004/07/25 18:15:52 pmai Exp $
 ;;;
 ;;; This file contains the VOPs and macro magic necessary to call static
 ;;; functions.
@@ -26,6 +26,8 @@
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:temporary (:scs (descriptor-reg)) move-temp)
   (:temporary (:sc descriptor-reg :offset lra-offset) lra)
+  #-PPC-FUN-HACK
+  (:temporary (:sc interior-reg :offset lip-offset) entry-point)
   (:temporary (:scs (descriptor-reg)) func)
   (:temporary (:sc any-reg :offset nargs-offset) nargs)
   (:temporary (:sc any-reg :offset ocfp-offset) old-fp)
@@ -86,7 +88,10 @@
 	   (let ((lra-label (gen-label))
 		 (cur-nfp (current-nfp-tn vop)))
 	     ,@(moves (temp-names) (arg-names))
+	     #+PPC-FUN-HACK
 	     (inst lwz func null-tn (static-function-offset symbol))
+	     #-PPC-FUN-HACK
+	     (inst lwz entry-point null-tn (static-function-offset symbol))
 	     (inst lr nargs (fixnumize ,num-args))
 	     (when cur-nfp
 	       (store-stack-tn nfp-save cur-nfp))
@@ -94,8 +99,12 @@
 	     (inst mr cfp-tn csp-tn)
 	     (inst compute-lra-from-code lra code-tn lra-label temp)
 	     (note-this-location vop :call-site)
+	     #+PPC-FUN-HACK-MAYBE
 	     (inst mr code-tn func)
+	     #+PPC-FUN-HACK
 	     (inst mtctr func)
+	     #-PPC-FUN-HACK
+	     (inst mtctr entry-point)
 	     (inst bctr)
 	     (emit-return-pc lra-label)
 	     ,(collect ((bindings) (links))
diff --git a/compiler/ppc/vm.lisp b/compiler/ppc/vm.lisp
index 412f26304cf67cbe6c91180acb757a455c8dba6e..f5e5faec95131e6b084efa654fba135a16c0ddc8 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.2 2001/02/11 16:43:19 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/vm.lisp,v 1.3 2004/07/25 18:15:52 pmai Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -52,10 +52,16 @@
 (defreg nl4 7)
 (defreg nl5 8)
 (defreg nl6 9)
-(defreg nl7 10)
+(defreg fdefn 10)
 (defreg nargs 11)
-(defreg nfp 12)
-(defreg cfunc 13)
+;;; The following two registers were originally reversed in the PPC Linux
+;;; port.  Putting the address of the called function in GPR12 is however
+;;; mandated by the OS X Mach-O ABI, in order to facilitate indirect
+;;; addressing of dynamically linked code, as described in the OS X Mach O
+;;; Runtime documentation.  Since swapping those two registers shouldn't
+;;; matter to PPC Linux, we swap them unconditionally.  -- PRM, 2003-12-28
+(defreg cfunc 12)
+(defreg nfp 13)
 (defreg bsp 14)
 (defreg cfp 15)
 (defreg csp 16)
@@ -76,10 +82,10 @@
 (defreg lip 31)
 
 (defregset non-descriptor-regs
-  nl0 nl1 nl2 nl3 nl4 nl5 nl6 nl7 cfunc nargs nfp)
+  nl0 nl1 nl2 nl3 nl4 nl5 nl6 cfunc nargs nfp)
 
 (defregset descriptor-regs
-  a0 a1 a2 a3  ocfp lra cname lexenv l0 l1 l2 )
+  fdefn a0 a1 a2 a3  ocfp lra cname lexenv l0 l1 l2 )
 
 (defregset register-arg-offsets
   a0 a1 a2 a3)