From 903edb2a6d4a102645eb094786f52290f0ef9b07 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Sun, 11 Dec 2005 18:30:51 +0000
Subject: [PATCH] Make ppc port look a little more like sparc by making
 fdefn-raw-addr-slot actually hold a tagged pointer instead of the raw
 address.  Not sure if this is good or not, but making it like sparc makes ppc
 a little easier.

Might need a cross-compile; the 2005-12-1-ppc cross-compile script
works fine.

assembly/ppc/arith.lisp:
o Static functions are now tagged, so need to adjust address before
  branching to them.

compiler/generic/new-genesis.lisp:
o Fill fdefn-raw-addr-slot with the tagged address instead of
  converting to untagged.

compiler/ppc/call.lisp:
o fdefn-raw-addr-slot is tagged, so need to adjust it before branching
  to function.

compiler/ppc/cell.lisp:
o No need to adjust function address before storing it in the
  fdefn-raw-addr-slot.

compiler/ppc/static-fn.lisp:
o Static functions are tagged, so need to adjust address before
  branching to them.

lisp/gc.c:
o Don't need scav_fdefn, because the fdefn is a tagged object now.

lisp/ppc-assem.S:
o Make undefined_tramp and closure_tramp be tagged instead of
  untagged.

lisp/purify.c
o RAW_ADDR_OFFSET is 0 now, like sparc.
---
 assembly/ppc/arith.lisp           | 26 +++++++++++++++++---------
 compiler/generic/new-genesis.lisp |  4 ++--
 compiler/ppc/call.lisp            |  9 ++++++---
 compiler/ppc/cell.lisp            |  4 +++-
 compiler/ppc/static-fn.lisp       |  7 +++++--
 lisp/gc.c                         |  6 +++---
 lisp/ppc-assem.S                  | 22 ++++++++++++++++++++++
 lisp/purify.c                     |  4 ++--
 8 files changed, 60 insertions(+), 22 deletions(-)

diff --git a/assembly/ppc/arith.lisp b/assembly/ppc/arith.lisp
index 6c775c897..7f1c8841e 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.5 2005/04/08 04:11:01 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/arith.lisp,v 1.6 2005/12/11 18:30:45 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -62,7 +62,8 @@
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
   (inst mr cfp-tn csp-tn)
-  (inst j lip 0)
+  ;; (inst j lip 0)
+  (inst j lip (- (* function-code-offset word-bytes) function-pointer-type))
 
   DONE
   (move res temp))
@@ -110,7 +111,8 @@
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
   (inst mr cfp-tn csp-tn)
-  (inst j lip 0)
+  ;;(inst j lip 0)
+  (inst j lip (- (* function-code-offset word-bytes) function-pointer-type))
 
   DONE
   (move res temp))
@@ -187,8 +189,9 @@
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
   (inst mr cfp-tn csp-tn)
-  (inst j lip 0)
-
+  ;;(inst j lip 0)
+  (inst j lip (- (* function-code-offset word-bytes) function-pointer-type))
+  
   LOW-FITS-IN-FIXNUM
   (move res lo))
 
@@ -319,7 +322,9 @@
 	  (inst li nargs (fixnumize 2))
 	  (inst mr ocfp cfp-tn)
 	  (inst mr cfp-tn csp-tn)
-	  (inst j lip 0)
+	  ;;(inst j lip 0)
+	  (inst j lip
+	        (- (* function-code-offset word-bytes) function-pointer-type)) 
 	  
 	  DO-COMPARE
 	  (load-symbol res t)
@@ -364,7 +369,8 @@
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
   (inst mr cfp-tn csp-tn)
-  (inst j lip 0)
+  ;;(inst j lip 0)
+  (inst j lip (- (* function-code-offset word-bytes) function-pointer-type))
 
   RETURN-T
   (load-symbol res t))
@@ -400,7 +406,8 @@
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
   (inst mr cfp-tn csp-tn)
-  (inst j lip 0)
+  ;;(inst j lip 0)
+  (inst j lip (- (* function-code-offset word-bytes) function-pointer-type))
 
   RETURN-T
   (load-symbol res t))
@@ -433,8 +440,9 @@
   (inst lwz lip null-tn (static-function-offset 'two-arg-=))
   (inst li nargs (fixnumize 2))
   (inst mr ocfp cfp-tn)
-  (inst j lip 0)
+  ;;(inst j lip 0)
   (inst mr cfp-tn csp-tn)
+  (inst j lip (- (* function-code-offset word-bytes) function-pointer-type))
 
   RETURN-NIL
   (inst mr res null-tn))
diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp
index 633a065ad..4adc21ce8 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.75 2005/02/06 19:43:13 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.76 2005/12/11 18:30:47 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -910,7 +910,7 @@
 		     (#.vm:function-header-type
 		      (if (or (c:backend-featurep :sparc)
 			      (and (c:backend-featurep :ppc)
-			           (c:backend-featurep :ppc-fun-hack)))
+			           #+nil (c:backend-featurep :ppc-fun-hack)))
 			  defn
 			  (make-random-descriptor
 			   (+ (logandc2 (descriptor-bits defn) vm:lowtag-mask)
diff --git a/compiler/ppc/call.lisp b/compiler/ppc/call.lisp
index f05ba6937..17761842b 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.7 2005/04/08 04:11:02 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/call.lisp,v 1.8 2005/12/11 18:30:47 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -806,8 +806,11 @@ default-value-8
 		      (loadw name-pass code-tn (tn-offset name)
 			     vm:other-pointer-type)
 		      (do-next-filler)))
-		   (loadw entry-point name-pass fdefn-raw-addr-slot
-			  other-pointer-type)
+		   (loadw function name-pass fdefn-raw-addr-slot
+		          other-pointer-type)
+		   (inst addi entry-point function
+		         (- (ash vm:function-code-offset vm:word-shift)
+			    vm:function-pointer-type))
 		   (do-next-filler))
 		 `((sc-case arg-fun
 		     (descriptor-reg (move lexenv arg-fun))
diff --git a/compiler/ppc/cell.lisp b/compiler/ppc/cell.lisp
index 1be9eb76e..6cff635cc 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.5 2005/04/08 04:11:02 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/cell.lisp,v 1.6 2005/12/11 18:30:47 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -140,9 +140,11 @@
     (let ((normal-fn (gen-label)))
       (load-type type function (- function-pointer-type))
       (inst cmpwi type function-header-type)
+      #+nil
       (inst addi lip function
                  (- (ash vm:function-code-offset vm:word-shift)
 		    function-pointer-type))
+      (move lip function)
       (inst beq normal-fn)
       ;; For the linkage-table stuff, we need to look up the address
       ;; from the linkage table instead of using the address directly.
diff --git a/compiler/ppc/static-fn.lisp b/compiler/ppc/static-fn.lisp
index 16790f71a..bc3cf2d76 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.4 2005/04/08 04:11:02 rtoy Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/static-fn.lisp,v 1.5 2005/12/11 18:30:47 rtoy Rel $
 ;;;
 ;;; This file contains the VOPs and macro magic necessary to call static
 ;;; functions.
@@ -87,13 +87,16 @@
 	   (let ((lra-label (gen-label))
 		 (cur-nfp (current-nfp-tn vop)))
 	     ,@(moves (temp-names) (arg-names))
-	     (inst lwz entry-point null-tn (static-function-offset symbol))
+	     (inst lwz func null-tn (static-function-offset symbol))
 	     (inst lr nargs (fixnumize ,num-args))
 	     (when cur-nfp
 	       (store-stack-tn nfp-save cur-nfp))
 	     (inst mr old-fp cfp-tn)
 	     (inst mr cfp-tn csp-tn)
 	     (inst compute-lra-from-code lra code-tn lra-label temp)
+	     (inst addi entry-point func
+		   (- (ash function-code-offset word-shift)
+		      function-pointer-type))
 	     (note-this-location vop :call-site)
 	     (inst mtctr entry-point)
 	     (inst bctr)
diff --git a/lisp/gc.c b/lisp/gc.c
index dcb4009dc..a0a8cd69b 100644
--- a/lisp/gc.c
+++ b/lisp/gc.c
@@ -1,7 +1,7 @@
 /*
  * Stop and Copy GC based on Cheney's algorithm.
  *
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.23 2005/09/15 18:26:51 rtoy Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.24 2005/12/11 18:30:48 rtoy Exp $
  * 
  * Written by Christopher Hoover.
  */
@@ -1152,7 +1152,7 @@ size_boxed(lispobj * where)
 
 /* Note: on the sparc we don't have to do anything special for fdefns, */
 /* cause the raw-addr has a function lowtag. */
-#ifndef sparc
+#if !(defined(sparc) || defined(DARWIN))
 static int
 scav_fdefn(lispobj * where, lispobj object)
 {
@@ -2047,7 +2047,7 @@ gc_init(void)
     scavtab[type_UnboundMarker] = scav_immediate;
     scavtab[type_WeakPointer] = scav_weak_pointer;
     scavtab[type_InstanceHeader] = scav_boxed;
-#ifndef sparc
+#if !(defined(sparc) || defined(DARWIN))
     scavtab[type_Fdefn] = scav_fdefn;
 #else
     scavtab[type_Fdefn] = scav_boxed;
diff --git a/lisp/ppc-assem.S b/lisp/ppc-assem.S
index 433d00a3f..a7405b9de 100644
--- a/lisp/ppc-assem.S
+++ b/lisp/ppc-assem.S
@@ -408,6 +408,7 @@ lra:
 
 	GFUNCDEF(xundefined_tramp)
 	.globl _undefined_tramp
+#if 0	
 	.byte 0,0,0,type_FunctionHeader	/* Header */
 
 	.long _undefined_tramp	/* self slot */
@@ -416,6 +417,16 @@ lra:
 	.long NIL		/* arglist slot */
 	.long NIL		/* type slot */
 _undefined_tramp:	
+#else
+	.byte 0
+_undefined_tramp:	
+	.byte 0, 0, type_FunctionHeader
+	.long _undefined_tramp	/* self slot */
+	.long NIL		/* next slot */
+	.long NIL		/* name slot */
+	.long NIL		/* arglist slot */
+	.long NIL		/* type slot */
+#endif	
 	twllei reg_ZERO,trap_Cerror
         /* Number of argument bytes */
 	.byte 4
@@ -442,6 +453,7 @@ _undefined_tramp:
 
 	GFUNCDEF(xclosure_tramp)
 	.globl _closure_tramp
+#if 0
 	.byte 0,0,0,type_FunctionHeader	/* Header */
 	.long _closure_tramp
 	.long NIL 
@@ -449,6 +461,16 @@ _undefined_tramp:
 	.long NIL
 	.long NIL
 _closure_tramp:
+#else
+	.byte 0
+_closure_tramp:
+	.byte 0,0,type_FunctionHeader	/* Header */
+	.long _closure_tramp
+	.long NIL 
+	.long NIL
+	.long NIL
+	.long NIL
+#endif		
 	lwz reg_LEXENV,FDEFN_FUNCTION_OFFSET(reg_FDEFN)
 	lwz reg_CODE,CLOSURE_FUNCTION_OFFSET(reg_LEXENV)
 	la reg_LIP,FUNCTION_CODE_OFFSET(reg_CODE)
diff --git a/lisp/purify.c b/lisp/purify.c
index 10870a6af..819a695dc 100644
--- a/lisp/purify.c
+++ b/lisp/purify.c
@@ -10,7 +10,7 @@
    and x86/GENCGC stack scavenging, by Douglas Crosher, 1996, 1997,
    1998.
 
-   $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.34 2005/09/15 18:26:52 rtoy Exp $ 
+   $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.35 2005/12/11 18:30:51 rtoy Exp $ 
 
    */
 #include <stdio.h>
@@ -86,7 +86,7 @@ static int later_count = 0;
 #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
 
-#ifdef sparc
+#if defined(sparc) || defined(DARWIN)
 #define RAW_ADDR_OFFSET 0
 #else
 #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
-- 
GitLab