From 6a4fd3c3a56d8fe45962ee1e8b1ff6969d0ddc14 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Sun, 6 Feb 2005 19:43:15 +0000
Subject: [PATCH] Initial support for linkage-tables on PPC/Darwin.  This is a
 relatively straightforward port of the sparc version of linkage-tables.  Some
 refinements are probably still needed, as well as some testing.

Use boot-2005-02-ppc-linkage.lisp to bootstrap this change from the
2005-02 snapshot.

* code/ppc-vm.lisp
  o Add appropriate FOREIGN-SYMBOL-ADDRESS-AUX and FIND-FOREIGN-SYMBOL
    functions for linkage-table.

* compiler/generic/new-genesis.lisp
  o Basically do the same as the sparc port for linkage-tables.
  o need to extern-alien-name on the cold linkages since they C names
    depend on the backend conventions.

* compiler/ppc/alloc.lisp
  o Load "undefined_tramp" appropriately for linkage-tables.

* compiler/ppc/c-call.lisp
  o Define new vops (FOREIGN-SYMBOL-CODE-ADDRESS,
    FOREIGN-SYMBOL-DATA-ADDRESS) for linkage-tables so we can access
    correctly.

* compiler/ppc/cell.lisp
  o Load "closure_tramp" appropriately for linkage-tables
  o Load "undefined_tramp" appropriately for linkage-tables

* compiler/ppc/parms.lisp
  o Put the foreign linkage space start at the end of the static space
    to make it easier to bootstrap.  (We need already mapped memory.)
    We can move this later.
  o Correct TARGET-FOREIGN-LINKAGE-ENTRY-SIZE.
  o Add new static-symbol *linkage-table-data*
  o While were at it, add SPARE-9 and SPARE-0 static symbols so we
    have 10 spares.

* lisp/Config.ppc_darwin
  o Add -DLINKAGE_TABLE to CFLAGS/ASFLAGS if we have linkage-table
    support.

* lisp/Darwin-os.c
  o Add os_dlsym to support linkage-tables.  (This nees a little
    refactoring because we just copied the #defines for dlopen modes.)

* lisp/os-common.c
  o The checking of the linkage tables that is done for sparc almost
    works for ppc, but not quite.  Implement one for ppc.

* lisp/ppc-arch.c
  o Add PPC version of arch_make_jump_entry, arch_make_linkage_entry,
    arch_linkage_entry.

* lisp/ppc-assem.S
  o Add lazy_resolve_linkage to support linkage-tables.  This needs
    some more work.
  o Add undefined_foreign_symbol_trap.  This probably needs work, and
    definitely needs testing.

* lisp/ppc-validate.h
  o Define the start of the linkage space and size.
---
 code/ppc-vm.lisp                  |  18 +++-
 compiler/generic/new-genesis.lisp |  18 ++--
 compiler/ppc/alloc.lisp           |  12 ++-
 compiler/ppc/c-call.lisp          |  31 +++++-
 compiler/ppc/cell.lisp            |  18 +++-
 compiler/ppc/parms.lisp           |  15 ++-
 lisp/Config.ppc_darwin            |   9 +-
 lisp/Darwin-os.c                  |  33 ++++++-
 lisp/os-common.c                  |  14 ++-
 lisp/ppc-arch.c                   | 153 +++++++++++++++++++++++++++++-
 lisp/ppc-assem.S                  | 117 +++++++++++++++++++++++
 lisp/ppc-validate.h               |  23 ++++-
 12 files changed, 433 insertions(+), 28 deletions(-)

diff --git a/code/ppc-vm.lisp b/code/ppc-vm.lisp
index c0da2d5af..a532c362b 100644
--- a/code/ppc-vm.lisp
+++ b/code/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/code/ppc-vm.lisp,v 1.4 2004/07/30 01:05:59 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ppc-vm.lisp,v 1.5 2005/02/06 19:43:13 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -293,6 +293,7 @@
   #-darwin
   (concatenate 'string "" name))
 
+#-linkage-table
 (defun lisp::foreign-symbol-address-aux (name flavor)
   (declare (ignore flavor))
   (multiple-value-bind (value found)
@@ -310,6 +311,21 @@
                   (error "Unknown foreign symbol: ~S" name))
                 value))))))
 
+#+linkage-table
+(progn
+(defun lisp::foreign-symbol-address-aux (name flavor)
+  (let ((entry-num (lisp::register-foreign-linkage name flavor)))
+    (+ #.vm:target-foreign-linkage-space-start
+       (* entry-num vm:target-foreign-linkage-entry-size))))
+
+(defun lisp::find-foreign-symbol (addr)
+  (declare (type (unsigned-byte 32) addr))
+  (when (>= addr vm:target-foreign-linkage-space-start)
+    (let ((entry (/ (- addr vm:target-foreign-linkage-space-start)
+		    vm:target-foreign-linkage-entry-size)))
+      (when (< entry (lisp::foreign-linkage-symbols))
+	(lisp::foreign-linkage-entry entry)))))
+)
 
 
 ;;; SANCTIFY-FOR-EXECUTION -- Interface.
diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp
index 7a3a06e6f..633a065ad 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.74 2004/09/21 11:59:52 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.75 2005/02/06 19:43:13 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -898,7 +898,7 @@
 			   (make-random-descriptor
 			    (lookup-foreign-symbol
 			     (vm::extern-alien-name "undefined_tramp")
-			     #+sparc :data))))
+			     #+(or sparc ppc) :data))))
 	  fdefn))))
   
 (defun cold-fset (name defn)
@@ -919,7 +919,7 @@
 		      (make-random-descriptor
 		       (lookup-foreign-symbol
 		        (vm::extern-alien-name "closure_tramp")
-			#+sparc :data)))))
+			#+(or sparc ppc) :data)))))
     fdefn))
 
 (defun initialize-static-fns ()
@@ -1945,7 +1945,7 @@
 	   (when (and (numberp value) (zerop value))
 	     (warn "Not-really-defined foreign symbol: ~S" name))
 	   value)
-	 #+sparc
+	 #+(or sparc ppc)
 	 (let ((address (lookup-sym name)))
 	   ;; If the link-type is :data, need to lookup and return the
 	   ;; value, not the address of NAME in the linkage table.
@@ -1957,7 +1957,7 @@
 	   ;; routines.
 	   (if (eq link-type :code)
 	       address
-	       (sys:sap-ref-32 (sys:int-sap address) 0))))
+	     (sys:sap-ref-32 (sys:int-sap address) 0))))
 	;; Are those still necessary?
 	((and linux-p (lookup-sym (concatenate 'string "__libc_" name))))
 	((and linux-p (lookup-sym (concatenate 'string "__" name))))
@@ -1985,11 +1985,11 @@
   ;; os_foreign_linkage_init does!
   #+(or x86 amd64)
   (cold-register-foreign-linkage "resolve_linkage_tramp" :code)
-  #+sparc
+  #+(or sparc ppc)
   (progn
-    (cold-register-foreign-linkage "call_into_c" :code)
-    (cold-register-foreign-linkage "undefined_tramp" :data)
-    (cold-register-foreign-linkage "closure_tramp" :data)
+    (cold-register-foreign-linkage (vm::extern-alien-name "call_into_c") :code)
+    (cold-register-foreign-linkage (vm::extern-alien-name "undefined_tramp") :data)
+    (cold-register-foreign-linkage (vm::extern-alien-name "closure_tramp") :data)
     ))
 
 (defvar *cold-assembler-routines* nil)
diff --git a/compiler/ppc/alloc.lisp b/compiler/ppc/alloc.lisp
index 0ecd17018..755ec1cd3 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.8 2004/10/23 18:10:23 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/alloc.lisp,v 1.9 2005/02/06 19:43:14 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -130,7 +130,15 @@
   (:translate make-fdefn)
   (:generator 37
     (with-fixed-allocation (result pa-flag temp fdefn-type fdefn-size)
-      (inst lr temp  (make-fixup (extern-alien-name "undefined_tramp") :foreign))
+      ;; For the linkage-table stuff, we need to look up the address
+      ;; of undefined_tramp from the linkage table instead of using
+      ;; the address directly.
+      ()
+      (inst lr temp  (make-fixup (extern-alien-name "undefined_tramp")
+				 #-linkage-table :foreign
+				 #+linkage-table :foreign-data))
+      #+linkage-table
+      (loadw temp temp)
       (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))))
diff --git a/compiler/ppc/c-call.lisp b/compiler/ppc/c-call.lisp
index d96d32cd8..b131572d4 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.5 2004/10/24 16:58:53 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/c-call.lisp,v 1.6 2005/02/06 19:43:15 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -264,7 +264,7 @@
 				    ,@(new-args))))))
 	(c::give-up))))
 
-
+#-linkage-table
 (define-vop (foreign-symbol-address)
   (:translate foreign-symbol-address)
   (:policy :fast-safe)
@@ -276,6 +276,33 @@
   (:generator 2
     (inst lr res  (make-fixup (extern-alien-name foreign-symbol) :foreign))))
 
+(define-vop (foreign-symbol-code-address)
+  (:translate #+linkage-table foreign-symbol-code-address
+	      #-linkage-table foreign-symbol-address)
+  (:policy :fast-safe)
+  (:args)
+  (:arg-types (:constant simple-string))
+  (:info foreign-symbol)
+  (:results (res :scs (sap-reg)))
+  (:result-types system-area-pointer)
+  (:generator 2
+    (inst lr res (make-fixup (extern-alien-name foreign-symbol)
+			     :foreign))))
+
+(define-vop (foreign-symbol-data-address)
+  (:translate foreign-symbol-data-address)
+  (:policy :fast-safe)
+  (:args)
+  (:arg-types (:constant simple-string))
+  (:info foreign-symbol)
+  (:results (res :scs (sap-reg)))
+  (:result-types system-area-pointer)
+  (:temporary (:scs (non-descriptor-reg)) addr)
+  (:generator 2
+    (inst lr addr (make-fixup (extern-alien-name foreign-symbol)
+			      :foreign-data))
+    (loadw res addr)))
+
 (define-vop (call-out)
   (:args (function :scs (sap-reg) :target cfunc)
 	 (args :more t))
diff --git a/compiler/ppc/cell.lisp b/compiler/ppc/cell.lisp
index 1dce59111..29c631199 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.3 2004/09/08 02:10:55 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/cell.lisp,v 1.4 2005/02/06 19:43:15 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -147,7 +147,13 @@
                  (- (ash vm:function-code-offset vm:word-shift)
 		    function-pointer-type))
       (inst beq normal-fn)
-      (inst lr lip  (make-fixup (extern-alien-name "closure_tramp") :foreign))
+      ;; For the linkage-table stuff, we need to look up the address
+      ;; from the linkage table instead of using the address directly.
+      (inst lr lip  (make-fixup (extern-alien-name "closure_tramp")
+				#-linkage-table :foreign
+				#+linkage-table :foreign-data))
+      #+linkage-table
+      (loadw lip lip)
       (emit-label normal-fn)
       ;;PRM:FIXME? Order of following stores is reversed in SBCL
       (storew function fdefn fdefn-function-slot other-pointer-type)
@@ -162,7 +168,13 @@
   (:results (result :scs (descriptor-reg)))
   (:generator 38
     (storew null-tn fdefn fdefn-function-slot other-pointer-type)
-    (inst lr temp  (make-fixup (extern-alien-name "undefined_tramp") :foreign))
+    ;; For the linkage-table stuff, we need to look up the address
+    ;; from the linkage table instead of using the address directly.
+    (inst lr temp  (make-fixup (extern-alien-name "undefined_tramp")
+			       #-linkage-table :foreign
+			       #+linkage-table :foreign-data))
+    #+linkage-table
+    (loadw temp temp)
     (storew temp fdefn fdefn-raw-addr-slot other-pointer-type)
     (move result fdefn)))
 
diff --git a/compiler/ppc/parms.lisp b/compiler/ppc/parms.lisp
index 020e086e7..8f3f5eed2 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.8 2004/10/20 11:30:43 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.9 2005/02/06 19:43:15 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -148,8 +148,11 @@
 (defparameter target-read-only-space-start #x01000000)
 (defparameter target-static-space-start    #x10000000)
 (defparameter target-dynamic-space-start   #x40000000)
-(defparameter target-foreign-linkage-space-start #x0fc00000)
-(defconstant target-foreign-linkage-entry-size 8) ;In bytes.  Duh.
+;; We're sticking this at the end of the static space for now for the
+;; first linkage-table build because it's mapped with the
+;; static-space.  We can move it later once linkage-table is built.
+(defparameter target-foreign-linkage-space-start #x17000000)
+(defconstant target-foreign-linkage-entry-size 32) ;In bytes.  Duh.
 
 
 
@@ -235,8 +238,13 @@
     lisp::*cmucl-lib*
     lisp::*cmucl-core-path*
       
+    ;; Foreign linkage stuff
+    #+linkage-table
+    lisp::*linkage-table-data*
+
     ;; Spare symbols.  Rename these when you need to add some static
     ;; symbols and don't want to do a cross-compile.
+    spare-9
     spare-8
     spare-7
     spare-6
@@ -245,6 +253,7 @@
     spare-3
     spare-2
     spare-1
+    spare-0
 
     #|kernel::*current-thread*|#
     ))
diff --git a/lisp/Config.ppc_darwin b/lisp/Config.ppc_darwin
index a0ebfb6b8..cba98dcdf 100644
--- a/lisp/Config.ppc_darwin
+++ b/lisp/Config.ppc_darwin
@@ -8,8 +8,13 @@ LD = ld
 NM = $(PATH1)/darwin-nm
 CPP = cpp -no-cpp-precomp
 DEPEND = $(CC) -MM
-CFLAGS = -g -O3 -no-cpp-precomp -DDARWIN -Dppc
-ASFLAGS = -g -O3 -no-cpp-precomp -DDARWIN -Dppc
+ifdef FEATURE_LINKAGE_TABLE
+LINKAGE = -DLINKAGE_TABLE
+endif
+
+CFLAGS = -g -O3 -no-cpp-precomp -DDARWIN -Dppc $(LINKAGE)
+ASFLAGS = -g -O3 -no-cpp-precomp -DDARWIN -Dppc $(LINKAGE)
+
 UNDEFSYMPATTERN = -Xlinker -u -Xlinker &
 ASSEM_SRC = ppc-assem.S linux-stubs.S
 ARCH_SRC = ppc-arch.c
diff --git a/lisp/Darwin-os.c b/lisp/Darwin-os.c
index 2b203da26..ef371e487 100644
--- a/lisp/Darwin-os.c
+++ b/lisp/Darwin-os.c
@@ -14,7 +14,7 @@
  * Frobbed for OpenBSD by Pierre R. Mai, 2001.
  * Frobbed for Darwin by Pierre R. Mai, 2003.
  *
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.c,v 1.1 2004/07/13 00:26:22 pmai Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.c,v 1.2 2005/02/06 19:43:15 rtoy Exp $
  *
  */
 
@@ -259,3 +259,34 @@ map_core_sections(char *exec_name)
 	fprintf(stderr,"Linked cores not supported for Darwin!\n");
 	exit(1);
 }
+
+#define RTLD_LAZY 1
+#define RTLD_NOW 2
+#define RTLD_GLOBAL 0x100
+
+
+void *os_dlsym(const char *sym_name, lispobj lib_list)
+{
+    static void *program_handle;
+    void *sym_addr = 0;
+
+    if (!program_handle)
+	program_handle = dlopen((void *)0, RTLD_LAZY | RTLD_GLOBAL);
+    if (lib_list != NIL) {
+	lispobj lib_list_head;
+
+	for (lib_list_head = lib_list;
+	     lib_list_head != NIL;
+	     lib_list_head = (CONS(lib_list_head))->cdr) {
+	    struct cons *lib_cons = CONS(CONS(lib_list_head)->car);
+	    struct sap *dlhandle = (struct sap *)PTR(lib_cons->car);
+
+	    sym_addr = dlsym((void *)dlhandle->pointer, sym_name);
+	    if (sym_addr)
+		return sym_addr;
+	}
+    }
+    sym_addr = dlsym(program_handle, sym_name);
+
+    return sym_addr;
+}
diff --git a/lisp/os-common.c b/lisp/os-common.c
index fdc4451c8..a358ea302 100644
--- a/lisp/os-common.c
+++ b/lisp/os-common.c
@@ -1,6 +1,6 @@
 /*
 
- $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.16 2004/07/07 22:22:59 rtoy Exp $
+ $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.17 2005/02/06 19:43:15 rtoy Exp $
 
  This code was written as part of the CMU Common Lisp project at
  Carnegie Mellon University, and has been placed in the public domain.
@@ -143,7 +143,7 @@ void os_foreign_linkage_init (void)
          * init-foreign-linkage in new-genesis does!
          */
 	if (i == 0) {
-#ifdef sparc
+#if defined(sparc)
 	    if (type != 1 || strcmp((char *)symbol_name->data,
 				    "call_into_c")) {
                 fprintf(stderr, "linkage_data is %s but expected call_into_c\n",
@@ -151,6 +151,14 @@ void os_foreign_linkage_init (void)
 		lose("First element of linkage_data is bogus.\n");
 	    }
 	    arch_make_linkage_entry(i, &call_into_c, 1);
+#elif defined(DARWIN)
+	    if (type != 1 || strcmp((char *)symbol_name->data,
+				    "_call_into_c")) {
+                fprintf(stderr, "linkage_data is %s but expected call_into_c\n",
+                        (char*)symbol_name->data);
+		lose("First element of linkage_data is bogus.\n");
+	    }
+	    arch_make_linkage_entry(i, &call_into_c, 1);
 #else
 	    if (type != 1 || strcmp((char *)symbol_name->data,
 				    "resolve_linkage_tramp")) {
@@ -242,7 +250,7 @@ unsigned long os_link_one_symbol(long entry)
     type = fixnum_value(data_vector->data[table_index + 1]);
     target_addr = os_dlsym((char *)symbol_name->data,
 			   data_vector->data[table_index + 2]);
-#if 0
+#if 1
     fprintf(stderr, "Looked up %s symbol %s at %lx\n",
             type == 1 ? "code" : "data",
             (char*) symbol_name->data, (unsigned long) target_addr);
diff --git a/lisp/ppc-arch.c b/lisp/ppc-arch.c
index 7074947b5..5d6774f61 100644
--- a/lisp/ppc-arch.c
+++ b/lisp/ppc-arch.c
@@ -1,6 +1,6 @@
 /*
 
- $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-arch.c,v 1.1 2004/07/13 00:26:22 pmai Exp $
+ $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-arch.c,v 1.2 2005/02/06 19:43:15 rtoy Exp $
 
  This code was written as part of the CMU Common Lisp project at
  Carnegie Mellon University, and has been placed in the public domain.
@@ -278,3 +278,154 @@ ppc_flush_icache(os_vm_address_t address, os_vm_size_t length)
     address += 32;
   }
 }
+
+#ifdef LINKAGE_TABLE
+/* Linkage tables for PowerPC
+ *
+ * Linkage entry size is 16, because we need at least 4 instructions to
+ * implement a jump.
+ */
+
+/*
+ * This had better match lisp::target-foreign-linkage-entry-size in
+ * ppco/parms.lisp!  Each entry is 6 instructions long, so at least
+ * 24 bytes.
+ */
+#ifndef LinkageEntrySize
+#define LinkageEntrySize (8*4)
+#endif
+
+/*
+ * Define the registers to use in the linkage jump table. Can be the
+ * same. Some care must be exercised when choosing these. It has to be
+ * a register that is not otherwise being used. reg_NFP is a good
+ * choice. call_into_c trashes reg_NFP without preserving it, so we can
+ * trash it in the linkage jump table.
+ */
+#define LINKAGE_TEMP_REG        reg_NFP
+#define LINKAGE_ADDR_REG        reg_A0
+
+/*
+ * Insert the necessary jump instructions at the given address.
+ */
+void
+arch_make_jump_entry(void* reloc_addr, void *target_addr)
+{
+  /*
+   * Make JMP to function entry.
+   *
+   * The instruction sequence is:
+   *
+   *        addis temp, 0, (hi part of reloc)
+   *        ori   temp, temp, (lo part of reloc)
+   *        addis addr, 0, (hi part of addr)
+   *        ori   addr, addr, (low part of addr)
+   *        mtctr addr
+   *        bctr
+   *        
+   */
+  int* inst_ptr;
+  unsigned long hi;                   /* Top 16 bits of address */
+  unsigned long lo;                   /* Low 16 bits of address */
+  unsigned int inst;
+
+  inst_ptr = (int*) reloc_addr;
+
+  /*
+   * Split the target address into hi and lo parts for the addis/ori
+   * instructions.
+   */
+  hi = (unsigned long) reloc_addr;
+  lo = hi & 0xffff;
+  hi >>= 16;
+
+  /*
+   * addis 3, 0, (hi part)
+   */
+  inst = (15 << 26) | (LINKAGE_ADDR_REG << 21) | (0 << 16) | hi;
+  *inst_ptr++ = inst;
+
+  /*
+   * ori 3, 3, (lo part)
+   */
+
+  inst = (24 << 26) | (LINKAGE_ADDR_REG << 21) | (LINKAGE_ADDR_REG << 16) | lo;
+  *inst_ptr++ = inst;
+      
+  /*
+   * Split the target address into hi and lo parts for the addis/ori
+   * instructions.
+   */
+
+  hi = (unsigned long) target_addr;
+  lo = hi & 0xffff;
+  hi >>= 16;
+
+  /*
+   * addis 13, 0, (hi part)
+   */
+      
+  inst = (15 << 26) | (LINKAGE_TEMP_REG << 21) | (0 << 16) | hi;
+  *inst_ptr++ = inst;
+
+  /*
+   * ori 13, 13, (lo part)
+   */
+
+  inst = (24 << 26) | (LINKAGE_TEMP_REG << 21) | (LINKAGE_TEMP_REG << 16) | lo;
+  *inst_ptr++ = inst;
+  
+  /*
+   * mtctr 13
+   */
+
+  inst = (31 << 26) | (LINKAGE_TEMP_REG << 21) | (9 << 16) | (467 << 1);
+  *inst_ptr++ = inst;
+
+  /*
+   * bctr
+   */
+
+  inst = (19 << 26) | (20 << 21) | (528 << 1);
+  *inst_ptr++ = inst;
+
+
+  *inst_ptr++ = inst;
+  
+  os_flush_icache((os_vm_address_t) reloc_addr, (char*) inst_ptr - (char*) reloc_addr);
+}
+
+void arch_make_linkage_entry(long linkage_entry, void *target_addr, long type)
+{
+  int *reloc_addr = (int *)(FOREIGN_LINKAGE_SPACE_START
+                            + linkage_entry * LinkageEntrySize);
+
+  if (type == 1)
+    {			/* code reference */
+      arch_make_jump_entry(reloc_addr, target_addr);
+    }
+  else if (type == 2)
+    {
+      *(unsigned long *)reloc_addr = (unsigned long)target_addr;
+    }
+}
+
+/* Make a the entry a jump to resolve_linkage_tramp. */
+
+extern void resolve_linkage_tramp(void);
+
+void arch_make_lazy_linkage(long linkage_entry)
+{
+  arch_make_linkage_entry(linkage_entry, (void*) resolve_linkage_tramp, 1);
+}
+
+/* Get linkage entry.  We're given the return address which should be
+   the address of the jmpl instruction (2nd word) of the linkage
+   entry.  Figure out which entry this address belong to. */
+
+long arch_linkage_entry(unsigned long retaddr)
+{
+  return (retaddr - (FOREIGN_LINKAGE_SPACE_START))
+    / LinkageEntrySize;
+}
+#endif
diff --git a/lisp/ppc-assem.S b/lisp/ppc-assem.S
index 9b46c538b..c6603ab7d 100644
--- a/lisp/ppc-assem.S
+++ b/lisp/ppc-assem.S
@@ -486,3 +486,120 @@ _closure_tramp:
 	blr
 	SET_SIZE(ppc_flush_cache_line)
 
+#ifdef LINKAGE_TABLE
+/*
+ * Call into C code to resolve a linkage entry.
+ *
+ * We get here by Lisp calling call_into_c with an address of the
+ * desired function which is contained in the register reg_CFUNC (aka
+ * %i4, aka %r28).  This is the address of the entry in the linkage
+ * table, which is what we need to figure out what function we really
+ * wanted.
+ *
+ * Note that because we get here from call_into_c, all necessary live
+ * registers have been saved, including FP registers.  Hence, no need
+ * to save them.
+ */
+	.globl _lazy_resolve_linkage
+	GFUNCDEF(resolve_linkage_tramp)
+	/*
+	 * We need to call lazy_resolve_linkage.  reg_A0 (= r24)
+	 * (see ppc-arch.c) contains the address of the linkage entry.  
+	 */
+	/*
+	 * Need to save all parameter regs to the stack because we 
+	 * need them for later.
+	 */
+	subi	r1, r1, 8*4+8
+	stw	r3, 0(r1)
+	stw	r4, 4(r1)
+	stw	r5, 8(r1)
+	stw	r6, 12(r1)
+	stw	r7, 16(r1)
+	stw	r8, 20(r1)
+	stw	r9, 24(r1)
+	stw	r10, 28(r1)
+	
+	mr	reg_NL0, reg_A0
+
+	stwu	r1, (-(24+4))(r1)
+	/*
+	 * At this point reg_NIL should be available to us.  
+	 * Call lazy_resolve_linkage to figure out the real function address.
+	 */
+	lis	reg_NULL, hi16(_lazy_resolve_linkage)
+	ori	reg_NULL, reg_NULL, lo16(_lazy_resolve_linkage)
+	mtctr	reg_NULL
+	mflr	reg_CODE
+	bctrl
+
+	addi	r1,r1,24+4
+	
+	/*
+	 * The desired function is in r3 (NL0), so save it
+	 * and restore the real arg parameters
+	 */
+
+	mtctr	reg_NL0
+	lwz	r3, 0(r1)
+	lwz	r4, 4(r1)
+	lwz	r5, 8(r1)
+	lwz	r6, 12(r1)
+	lwz	r7, 16(r1)
+	lwz	r8, 20(r1)
+	lwz	r9, 24(r1)
+	lwz	r10, 28(r1)
+
+	/*
+	 * Got it, so we can now jump directly to the desired function.
+	 * reg_NL0 contains the result.  Restore the stack and go!
+	 */
+
+	mtlr	reg_CODE
+	
+	/* Back to C */
+	/*	mtlr	reg_CODE*/
+	bctr
+	
+	SET_SIZE(resolve_linkage_tramp)
+	
+
+/*
+ * When we get called, r3 (reg_NL0) contains the address of the
+ * data_vector object which is a string naming the bad symbol.
+ */
+	GFUNCDEF(undefined_foreign_symbol_trap)
+
+	/*
+	   Need to restore all the global registers with the Lisp values that 
+	   were saved away in call_into_c.  (This routine is only called from 
+	   os_link_one_symbol, which is called from resolve_linkage_tramp, which 
+	   is called from call_into_c.)
+
+	   The global registers are volatile across function calls, so who
+	   knows what values have been they contain now!
+		
+	*/
+
+	load(reg_ALLOC, _current_dynamic_space_free_pointer)
+        load(reg_BSP, _current_binding_stack_pointer)
+        load(reg_CSP, _current_control_stack_pointer)
+        load(reg_CFP, _current_control_frame_pointer)
+
+	lis reg_NULL,hi16(NIL)
+	ori reg_NULL,reg_NULL,lo16(NIL)
+	/* And reg_ZERO */
+	li reg_ZERO,0
+
+	mr	reg_NL0, reg_A0			
+	twllei	reg_ZERO, trap_Error
+	.byte	4	/* Number of argument bytes */
+	.byte	UNDEFINED_FOREIGN_SYMBOL_ERROR
+        /* Escape to create 16bit number from following two bytes, in 
+	   little-endian order */
+        .byte	254
+	.byte	SC_OFFSET_LO(sc_DescriptorReg, reg_A0_NUM)
+	.byte	SC_OFFSET_HI(sc_DescriptorReg, reg_A0_NUM)
+	.align	4
+					
+#endif	
\ No newline at end of file
diff --git a/lisp/ppc-validate.h b/lisp/ppc-validate.h
index fa43c14f4..8c4fe2c1e 100644
--- a/lisp/ppc-validate.h
+++ b/lisp/ppc-validate.h
@@ -1,6 +1,6 @@
 /*
 
- $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-validate.h,v 1.4 2005/01/13 19:55:00 fgilham Exp $
+ $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-validate.h,v 1.5 2005/02/06 19:43:15 rtoy Exp $
 
  This code was written as part of the CMU Common Lisp project at
  Carnegie Mellon University, and has been placed in the public domain.
@@ -10,6 +10,27 @@
 #ifndef _PPC_VALIDATE_H_
 #define _PPC_VALIDATE_H_
 
+#ifdef LINKAGE_TABLE
+/*
+ * This space start better match the value of
+ * target-foreign-linkage-space-start defined in sparc/parms.lisp!
+ *
+ * See the notes there!
+ */
+
+#ifdef LinkageSpaceStart
+#define FOREIGN_LINKAGE_SPACE_START (LinkageSpaceStart)
+#else
+#define FOREIGN_LINKAGE_SPACE_START (0x17000000)
+#endif
+/*
+ * This allows for about 510K symbols (assuming each entry is 16 bytes
+ * long).  Hope that's enough!  Make sure this doesn't overlap the
+ * READ_ONLY_SPACE_START!
+ */
+#define FOREIGN_LINKAGE_SPACE_SIZE  (0x00800000) /* 8 MB */
+#endif
+
 /* 
  * The read-only space must be in low memory because the BA
  * instruction only has 26-bits to specify the address.  When this is
-- 
GitLab