[Sbcl-commits] CVS: sbcl/src/compiler dump.lisp,1.43,1.44 fndb.lisp,1.95,1.96 saptran.lisp,1.7,1.8 target-disassem.lisp,1.43,1.44

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30526/src/compiler

Modified Files:
	dump.lisp fndb.lisp saptran.lisp target-disassem.lisp 
Log Message:
0.8.14.5: Join the foreign legion!
           * x86/FreeBSD, x86/Linux and Sparc/SunOS now have
              linkage-table support, allowing SAVE-LISP-AND-DIE to
              function properly in the presence of loaded shared
              objects.
           * As a related cleanup automate testing for dlopen
              support on the plaform, and conditionalize
              LOAD-SHARED-OBJECT support on the resulting
              :os-provides-dlopen feature.


Index: dump.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/dump.lisp,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- dump.lisp	8 Sep 2004 19:22:49 -0000	1.43
+++ dump.lisp	9 Sep 2004 12:10:14 -0000	1.44
@@ -1003,9 +1003,14 @@
 	   (dump-object name fasl-output))
 	 (dump-fop 'fop-maybe-cold-load fasl-output)
 	 (dump-fop 'fop-assembler-fixup fasl-output))
-	(:foreign
+	((:foreign :foreign-dataref)
 	 (aver (stringp name))
-	 (dump-fop 'fop-foreign-fixup fasl-output)
+	 (ecase flavor
+	   (:foreign
+	    (dump-fop 'fop-foreign-fixup fasl-output))
+	   #!+linkage-table
+	   (:foreign-dataref
+	    (dump-fop 'fop-foreign-dataref-fixup fasl-output)))
 	 (let ((len (length name)))
 	   (aver (< len 256)) ; (limit imposed by fop definition)
 	   (dump-byte len fasl-output)

Index: fndb.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/fndb.lisp,v
retrieving revision 1.95
retrieving revision 1.96
diff -u -d -r1.95 -r1.96
--- fndb.lisp	15 Jul 2004 09:38:13 -0000	1.95
+++ fndb.lisp	9 Sep 2004 12:10:14 -0000	1.96
@@ -1468,6 +1468,19 @@
 (defknown sb!vm::push-word-on-c-stack (system-area-pointer) (values) (unsafe))
 (defknown sb!vm::pop-words-from-c-stack (index) (values) ())
 
+#!+linkage-table
+(defknown foreign-symbol-dataref-address (simple-string)
+  system-area-pointer
+  (movable flushable))
+
+(defknown foreign-symbol-address (simple-string &optional boolean)
+  system-area-pointer
+  (movable flushable))
+
+(defknown foreign-symbol-address-as-integer (simple-string &optional boolean)
+  integer
+  (movable flushable))
+
 ;;;; miscellaneous internal utilities
 
 (defknown %fun-name (function) t (flushable))

Index: saptran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/saptran.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- saptran.lisp	15 Sep 2003 09:21:38 -0000	1.7
+++ saptran.lisp	9 Sep 2004 12:10:14 -0000	1.8
@@ -13,8 +13,29 @@
 
 ;;;; DEFKNOWNs
 
-(defknown foreign-symbol-address (simple-string) system-area-pointer
-  (movable flushable))
+#!+linkage-table
+(deftransform foreign-symbol-address-as-integer ((symbol &optional datap)
+						 (simple-string boolean))
+  (if (and (constant-lvar-p symbol) (constant-lvar-p datap))
+      `(sap-int (foreign-symbol-address symbol datap))
+      (give-up-ir1-transform)))
+
+(deftransform foreign-symbol-address ((symbol &optional datap)
+				      (simple-string &optional boolean))
+    #!-linkage-table
+    (if (null datap)
+	(give-up-ir1-transform)
+	`(foreign-symbol-address symbol))
+    #!+linkage-table
+    (if (and (constant-lvar-p symbol) (constant-lvar-p datap))
+	(let ((name (lvar-value symbol))
+	      (datap (lvar-value datap)))
+	  (if (or #+sb-xc-host t ; only static symbols on host
+                  (not datap)
+		  (find-foreign-symbol-in-table name *static-foreign-symbols*))
+	      `(foreign-symbol-address ,name) ; VOP
+	      `(foreign-symbol-dataref-address ,name))) ; VOP
+	(give-up-ir1-transform)))
 
 (defknown (sap< sap<= sap= sap>= sap>)
 	  (system-area-pointer system-area-pointer) boolean

Index: target-disassem.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/target-disassem.lisp,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- target-disassem.lisp	29 Oct 2003 12:54:50 -0000	1.43
+++ target-disassem.lisp	9 Sep 2004 12:10:15 -0000	1.44
@@ -1774,7 +1774,7 @@
     (setf *assembler-routines-by-addr*
 	  (invert-address-hash sb!fasl:*assembler-routines*))
     (setf *assembler-routines-by-addr*
-	  (invert-address-hash sb!fasl:*static-foreign-symbols*
+	  (invert-address-hash sb!sys:*static-foreign-symbols*
 			       *assembler-routines-by-addr*)))
   (gethash address *assembler-routines-by-addr*))
 
@@ -1907,7 +1907,10 @@
   (declare (type disassem-state dstate))
   (unless (typep address 'address)
     (return-from maybe-note-assembler-routine nil))
-  (let ((name (find-assembler-routine address)))
+  (let ((name (or
+	       #!+linkage-table
+	       (sb!sys:foreign-symbol-in-address (sb!sys:int-sap address))
+	       (find-assembler-routine address))))
     (unless (null name)
       (note (lambda (stream)
 	      (if note-address-p