Steel Bank Common Lisp

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

Modified Files:
	typetran.lisp 
Log Message:
0.8.21.22:
	Maybe make two-dimensional array type testing faster.


Index: typetran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/typetran.lisp,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -d -r1.45 -r1.46
--- typetran.lisp	3 Mar 2005 00:10:10 -0000	1.45
+++ typetran.lisp	7 Apr 2005 12:32:56 -0000	1.46
@@ -327,12 +327,13 @@
 
 ;;; Return forms to test that OBJ has the rank and dimensions
 ;;; specified by TYPE, where STYPE is the type we have checked against
-;;; (which is the same but for dimensions.)
+;;; (which is the same but for dimensions and element type).
 (defun test-array-dimensions (obj type stype)
   (declare (type array-type type stype))
   (let ((obj `(truly-the ,(type-specifier stype) ,obj))
 	(dims (array-type-dimensions type)))
-    (unless (eq dims '*)
+    (unless (or (eq dims '*)
+		(equal dims (array-type-dimensions stype)))
       (collect ((res))
 	(when (eq (array-type-dimensions stype) '*)
 	  (res `(= (array-rank ,obj) ,(length dims))))
@@ -344,6 +345,24 @@
 	      (res `(= (array-dimension ,obj ,i) ,dim)))))
 	(res)))))
 
+;;; Return forms to test that OBJ has the element-type specified by
+;;; type specified by TYPE, where STYPE is the type we have checked
+;;; against (which is the same but for dimensions and element type).
+(defun test-array-element-type (obj type stype)
+  (declare (type array-type type stype))
+  (let ((obj `(truly-the ,(type-specifier stype) ,obj))
+	(eltype (array-type-specialized-element-type type)))
+    (unless (type= eltype (array-type-specialized-element-type stype))
+      (with-unique-names (data)
+	`((do ((,data ,obj (%array-data-vector ,data)))
+	      ((not (array-header-p ,data))
+	       ;; KLUDGE: this isn't in fact maximally efficient,
+	       ;; because though we know that DATA is a (SIMPLE-ARRAY *
+	       ;; (*)), we will still check to see if the lowtag is
+	       ;; appropriate.
+	       (typep ,data
+		      '(simple-array ,(type-specifier eltype) (*))))))))))
+
 ;;; If we can find a type predicate that tests for the type without
 ;;; dimensions, then use that predicate and test for dimensions.
 ;;; Otherwise, just do %TYPEP.
@@ -354,12 +373,11 @@
 	     ;; not safe to assume here that it will eventually
 	     ;; have (UPGRADED-ARRAY-ELEMENT-TYPE type)=T, so punt.)
 	     (not (unknown-type-p (array-type-element-type type)))
-	     (type= (array-type-specialized-element-type stype)
-		    (array-type-specialized-element-type type))
 	     (eq (array-type-complexp stype) (array-type-complexp type)))
 	(once-only ((n-obj obj))
 	  `(and (,pred ,n-obj)
-		,@(test-array-dimensions n-obj type stype)))
+	        ,@(test-array-dimensions n-obj type stype)
+	        ,@(test-array-element-type n-obj type stype)))
 	`(%typep ,obj ',(type-specifier type)))))
 
 ;;; Transform a type test against some instance type. The type test is

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

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.21.22:
	Maybe make two-dimensional array type testing faster.


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.759
retrieving revision 1.760
diff -u -d -r1.759 -r1.760
--- NEWS	7 Apr 2005 08:00:05 -0000	1.759
+++ NEWS	7 Apr 2005 12:32:54 -0000	1.760
@@ -27,6 +27,7 @@
   * increased the maximimum compact environment size to allow
     purify on images with large amounts of functions. (thanks to Cyrus Harmon)
   * improvements to the x86-64 disassembler. (thanks to Lutz Euler)
+  * optimization: type testing for non-vector arrays should be faster.
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** MISC.549 and similar: late transformation of unsafe type
        assertions into derived types caused unexpected code

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2073
retrieving revision 1.2074
diff -u -d -r1.2073 -r1.2074
--- version.lisp-expr	7 Apr 2005 08:00:11 -0000	1.2073
+++ version.lisp-expr	7 Apr 2005 12:32:54 -0000	1.2074
@@ -17,5 +17,5 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.21.21"
+"0.8.21.22"

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1033/tests

Modified Files:
	smoke.impure.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: smoke.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/smoke.impure.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- smoke.impure.lisp	13 Feb 2005 14:27:11 -0000	1.10
+++ smoke.impure.lisp	7 Apr 2005 08:00:46 -0000	1.11
@@ -31,7 +31,6 @@
 (assert (typep (in-package :cl-user) 'package))
 
 ;;; PROFILE should run without obvious breakage
-#-darwin
 (progn
   (defun profiled-fun ()
     (random 1d0))

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

Modified Files:
	alloc.lisp c-call.lisp cell.lisp macros.lisp show.lisp vm.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: alloc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/alloc.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- alloc.lisp	8 Jan 2005 09:41:51 -0000	1.3
+++ alloc.lisp	7 Apr 2005 08:00:44 -0000	1.4
@@ -105,7 +105,7 @@
     (with-fixed-allocation (result fdefn-widetag fdefn-size node)
       (storew name result fdefn-name-slot other-pointer-lowtag)
       (storew nil-value result fdefn-fun-slot other-pointer-lowtag)
-      (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign)
+      (storew (make-fixup "undefined_tramp" :foreign)
 	      result fdefn-raw-addr-slot other-pointer-lowtag))))
 
 (define-vop (make-closure)
@@ -202,10 +202,10 @@
       ;; we might as well add in the object address here, too. (Adding entropy
       ;; is good, even if ANSI doesn't understand that.)
       (inst imul temp
-	    (make-fixup (extern-alien-name "fast_random_state") :foreign)
+	    (make-fixup "fast_random_state" :foreign)
 	    1103515245)
       (inst add temp 12345)
-      (inst mov (make-fixup (extern-alien-name "fast_random_state") :foreign)
+      (inst mov (make-fixup "fast_random_state" :foreign)
 	    temp)
       ;; We want a positive fixnum for the hash value, so discard the LS bits.
       ;;

Index: c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/c-call.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- c-call.lisp	17 Feb 2005 21:59:23 -0000	1.7
+++ c-call.lisp	7 Apr 2005 08:00:45 -0000	1.8
@@ -219,7 +219,7 @@
   (:results (res :scs (sap-reg)))
   (:result-types system-area-pointer)
   (:generator 2
-   (inst lea res (make-fixup (extern-alien-name foreign-symbol) :foreign))))
+   (inst lea res (make-fixup foreign-symbol :foreign))))
 
 #!+linkage-table
 (define-vop (foreign-symbol-dataref-address)
@@ -231,7 +231,7 @@
   (:results (res :scs (sap-reg)))
   (:result-types system-area-pointer)
   (:generator 2
-   (inst mov res (make-fixup (extern-alien-name foreign-symbol) :foreign-dataref))))
+   (inst mov res (make-fixup foreign-symbol :foreign-dataref))))
 
 (define-vop (call-out)
   (:args (function :scs (sap-reg))

Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/cell.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- cell.lisp	6 Jan 2005 12:48:02 -0000	1.2
+++ cell.lisp	7 Apr 2005 08:00:45 -0000	1.3
@@ -262,7 +262,7 @@
 			    fun-pointer-lowtag)))
     (inst cmp type simple-fun-header-widetag)
     (inst jmp :e normal-fn)
-    (inst lea raw (make-fixup (extern-alien-name "closure_tramp") :foreign))
+    (inst lea raw (make-fixup "closure_tramp" :foreign))
     NORMAL-FN
     (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
     (storew raw fdefn fdefn-raw-addr-slot other-pointer-lowtag)
@@ -275,7 +275,7 @@
   (:results (result :scs (descriptor-reg)))
   (:generator 38
     (storew nil-value fdefn fdefn-fun-slot other-pointer-lowtag)
-    (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign)
+    (storew (make-fixup "undefined_tramp" :foreign)
 	    fdefn fdefn-raw-addr-slot other-pointer-lowtag)
     (move result fdefn)))
 

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/macros.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- macros.lisp	17 Mar 2005 22:51:45 -0000	1.3
+++ macros.lisp	7 Apr 2005 08:00:45 -0000	1.4
@@ -156,8 +156,7 @@
   (declare (ignore ignored))
   (inst push size)
   (inst lea r13-tn (make-ea :qword
-			    :disp (make-fixup (extern-alien-name "alloc_tramp")
-					      :foreign)))
+			    :disp (make-fixup "alloc_tramp" :foreign)))
   (inst call r13-tn)
   (inst pop alloc-tn)
   (values))
@@ -171,14 +170,12 @@
 	(free-pointer
 	 (make-ea :qword :disp 
 		  #!+sb-thread (* n-word-bytes thread-alloc-region-slot)
-		  #!-sb-thread (make-fixup (extern-alien-name "boxed_region")
-					   :foreign)
+		  #!-sb-thread (make-fixup "boxed_region" :foreign)
 		  :scale 1))		; thread->alloc_region.free_pointer
 	(end-addr 
 	 (make-ea :qword :disp
 		  #!+sb-thread (* n-word-bytes (1+ thread-alloc-region-slot))
-		  #!-sb-thread (make-fixup (extern-alien-name "boxed_region")
-					   :foreign 8)
+		  #!-sb-thread (make-fixup "boxed_region" :foreign 8)
 		  :scale 1)))		; thread->alloc_region.end_addr
     (cond (in-elsewhere
 	   (allocation-tramp alloc-tn size))
@@ -208,8 +205,7 @@
   (declare (ignore ignored))
   (inst push size)
   (inst lea r13-tn (make-ea :qword
-			    :disp (make-fixup (extern-alien-name "alloc_tramp")
-					      :foreign)))
+			    :disp (make-fixup "alloc_tramp" :foreign)))
   (inst call r13-tn)
   (inst pop alloc-tn)
   (values))

Index: show.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/show.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- show.lisp	6 Jan 2005 12:48:03 -0000	1.2
+++ show.lisp	7 Apr 2005 08:00:45 -0000	1.3
@@ -27,11 +27,10 @@
   (:save-p t)
   (:generator 100
     (inst push object)
-    (inst lea rax (make-fixup (extern-alien-name "debug_print") :foreign))
+    (inst lea rax (make-fixup "debug_print" :foreign))
     (inst lea call-target
 	  (make-ea :qword
-		   :disp (make-fixup (extern-alien-name "call_into_c")
-				     :foreign)))
+		   :disp (make-fixup "call_into_c" :foreign)))
     (inst call call-target)
     (inst add rsp-tn n-word-bytes)
     (move result rax)))

Index: vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/vm.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- vm.lisp	6 Jan 2005 12:48:03 -0000	1.3
+++ vm.lisp	7 Apr 2005 08:00:46 -0000	1.4
@@ -466,21 +466,6 @@
       (noise (symbol-name (sc-name sc))))))
 ;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
 
-
-;;; The loader uses this to convert alien names to the form they need in
-;;; the symbol table (for example, prepending an underscore).
-
-;;; The loader uses this to convert alien names to the form they need in
-;;; the symbol table (for example, prepending an underscore).
-(defun extern-alien-name (name)
-  (declare (type string name))
-  ;; ELF ports currently don't need any prefix
-  (typecase name
-    (simple-base-string name)
-    (base-string (coerce name 'simple-base-string))
-    (t (handler-case (coerce name 'simple-base-string)
-	 (type-error () (error "invalid external alien name: ~S" name))))))
-
 (defun dwords-for-quad (value)
   (let* ((lo (logand value (1- (ash 1 32))))
 	 (hi (ash value -32)))

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

Modified Files:
	vm.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/vm.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- vm.lisp	5 Apr 2005 11:03:32 -0000	1.10
+++ vm.lisp	7 Apr 2005 08:00:16 -0000	1.11
@@ -350,15 +350,5 @@
       (non-descriptor-stack (format nil "NS~D" offset))
       (constant (format nil "Const~D" offset))
       (immediate-constant "Immed"))))
-
-;;; The loader uses this to convert alien names to the form they
-;;; occure in the symbol table (for example, prepending an
-;;; underscore). 
-(defun extern-alien-name (name)
-  (declare (type string name))
-  ;; ELF ports currently don't need any prefix
-  (typecase name
-    (simple-base-string name)
-    (base-string (coerce name 'simple-base-string))
-    (t (handler-case (coerce name 'simple-base-string)
-	 (type-error () (error "invalid external alien name: ~S" name))))))
+
+

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

Modified Files:
	early-fasl.lisp foreign-load.lisp foreign.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: early-fasl.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-fasl.lisp,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -d -r1.52 -r1.53
--- early-fasl.lisp	22 Mar 2005 22:09:21 -0000	1.52
+++ early-fasl.lisp	7 Apr 2005 08:00:15 -0000	1.53
@@ -76,7 +76,7 @@
 ;;; versions which break binary compatibility. But it certainly should
 ;;; be incremented for release versions which break binary
 ;;; compatibility.
-(def!constant +fasl-file-version+ 54)
+(def!constant +fasl-file-version+ 55)
 ;;; (record of versions before 2003 deleted in 2003-04-26/0.pre8.107 or so)
 ;;; 38: (2003-01-05) changed names of internal SORT machinery
 ;;; 39: (2003-02-20) in 0.7.12.1 a slot was added to
@@ -117,6 +117,8 @@
 ;;; 54: (2005-03-22) At least "0.8.20.6: Make FILE-STREAM and STRING-STREAM
 ;;;     potential mixins in CLOS" and "0.8.20.21: Add immediate single-floats
 ;;;     on x86-64."
+;;; 55: (2005-04-06) EXTERN-ALIEN-NAME logic moved from fixups to
+;;;     FIND-FOREIGN-SYMBOL-IN-TABLE &co.
 
 ;;; the conventional file extension for our fasl files
 (declaim (type simple-string *fasl-file-type*))

Index: foreign-load.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/foreign-load.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- foreign-load.lisp	13 Feb 2005 14:27:08 -0000	1.8
+++ foreign-load.lisp	7 Apr 2005 08:00:16 -0000	1.9
@@ -145,14 +145,17 @@
     (dlerror)				; clear old errors
     (unless *runtime-dlhandle*
       (bug "Cannot resolve foreign symbol: lost *runtime-dlhandle*"))
-    (let* ((result (sap-int (dlsym *runtime-dlhandle* symbol)))
+    ;; On real ELF & dlsym platforms the EXTERN-ALIEN-NAME is a no-op,
+    ;; but on platforms where dlsym is simulated we use the mangled name.
+    (let* ((extern (extern-alien-name symbol))
+	   (result (sap-int (dlsym *runtime-dlhandle* extern)))
            (err (dlerror))
            (addr (if (or (not (zerop result)) (not err))
                      result
                      (dolist (obj *shared-objects*)
                        (let ((sap (shared-object-sap obj)))
                          (when sap
-                           (setf result (sap-int (dlsym sap symbol))
+                           (setf result (sap-int (dlsym sap extern))
                                  err (dlerror))
                            (when (or (not (zerop result)) (not err))
                              (return result))))))))
@@ -163,7 +166,7 @@
 	      (if datap
 		  undefined-alien-address
 		  (foreign-symbol-address-as-integer 
-		   (sb!vm:extern-alien-name "undefined_alien_function"))))
+		   "undefined_alien_function")))
              (addr
               (pushnew symbol symbols :test #'equal)
               (remove symbol undefineds :test #'equal)

Index: foreign.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/foreign.lisp,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- foreign.lisp	13 Feb 2005 14:27:08 -0000	1.30
+++ foreign.lisp	7 Apr 2005 08:00:16 -0000	1.31
@@ -11,6 +11,16 @@
 
 (in-package "SB!IMPL")
 
+#!-(or elf mach-o)
+(error "Not an ELF or Mach-O platform?")
+
+(defun extern-alien-name (name)
+  (handler-case
+      #!+elf (coerce name 'base-string)
+      #!+mach-o (concatenate 'base-string "_" name)
+    (error ()
+      (error "invalid external alien name: ~S" name))))
+
 ;;; *STATIC-FOREIGN-SYMBOLS* are static as opposed to "dynamic" (not
 ;;; as opposed to C's "extern"). The table contains symbols known at
 ;;; the time that the program was built, but not symbols defined in
@@ -19,9 +29,9 @@
 (defvar *static-foreign-symbols* (make-hash-table :test 'equal))
 
 (defun find-foreign-symbol-in-table (name table)
-  (some (lambda (prefix)
-	  (gethash (concatenate 'string prefix name) table))
-	#("" "ldso_stub__")))
+  (let ((extern (extern-alien-name name)))
+    (or (gethash extern table)
+	(gethash (concatenate 'base-string "ldso_stub__" extern) table))))
 
 (defun foreign-symbol-address-as-integer-or-nil (name &optional datap)
   (declare (ignorable datap))
@@ -41,19 +51,18 @@
 
 (defun foreign-symbol-address (symbol &optional datap)
   (declare (ignorable datap))
-  (let ((name (sb!vm:extern-alien-name symbol)))
-    #!-linkage-table
-    (int-sap (foreign-symbol-address-as-integer name))
-    #!+linkage-table
-    (multiple-value-bind (addr sharedp)
-        (foreign-symbol-address-as-integer name datap)
-      #+sb-xc-host
-      (aver (not sharedp))
-      ;; If the address is from linkage-table and refers to data
-      ;; we need to do a bit of juggling.
-      (if (and sharedp datap)
-          (int-sap (sap-ref-word (int-sap addr) 0))
-          (int-sap addr)))))
+  #!-linkage-table
+  (int-sap (foreign-symbol-address-as-integer symbol))
+  #!+linkage-table
+  (multiple-value-bind (addr sharedp)
+      (foreign-symbol-address-as-integer symbol datap)
+    #+sb-xc-host
+    (aver (not sharedp))
+    ;; If the address is from linkage-table and refers to data
+    ;; we need to do a bit of juggling.
+    (if (and sharedp datap)
+	(int-sap (sap-ref-word (int-sap addr) 0))
+	(int-sap addr))))
 
 #-sb-xc-host
 (defun foreign-reinit ()

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

Modified Files:
	alloc.lisp c-call.lisp cell.lisp macros.lisp show.lisp vm.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: alloc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/alloc.lisp,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- alloc.lisp	8 Jan 2005 09:41:50 -0000	1.14
+++ alloc.lisp	7 Apr 2005 08:00:41 -0000	1.15
@@ -110,7 +110,7 @@
     (with-fixed-allocation (result fdefn-widetag fdefn-size node)
       (storew name result fdefn-name-slot other-pointer-lowtag)
       (storew nil-value result fdefn-fun-slot other-pointer-lowtag)
-      (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign)
+      (storew (make-fixup "undefined_tramp" :foreign)
 	      result fdefn-raw-addr-slot other-pointer-lowtag))))
 
 (define-vop (make-closure)

Index: c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/c-call.lisp,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- c-call.lisp	1 Nov 2004 12:36:07 -0000	1.23
+++ c-call.lisp	7 Apr 2005 08:00:42 -0000	1.24
@@ -190,7 +190,7 @@
   (:results (res :scs (sap-reg)))
   (:result-types system-area-pointer)
   (:generator 2
-   (inst lea res (make-fixup (extern-alien-name foreign-symbol) :foreign))))
+   (inst lea res (make-fixup foreign-symbol :foreign))))
 
 #!+linkage-table
 (define-vop (foreign-symbol-dataref-address)
@@ -202,7 +202,7 @@
   (:results (res :scs (sap-reg)))
   (:result-types system-area-pointer)
   (:generator 2
-   (inst mov res (make-fixup (extern-alien-name foreign-symbol) :foreign-dataref))))
+   (inst mov res (make-fixup foreign-symbol :foreign-dataref))))
 
 (define-vop (call-out)
   (:args (function :scs (sap-reg))
@@ -221,7 +221,7 @@
   (:generator 0
     (cond ((policy node (> space speed))
 	   (move eax function)
-	   (inst call (make-fixup (extern-alien-name "call_into_c") :foreign)))
+	   (inst call (make-fixup "call_into_c" :foreign)))
 	  (t
 	   ;; Setup the NPX for C; all the FP registers need to be
 	   ;; empty; pop them all.

Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/cell.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- cell.lisp	27 Oct 2004 16:40:01 -0000	1.15
+++ cell.lisp	7 Apr 2005 08:00:42 -0000	1.16
@@ -265,7 +265,7 @@
 			    fun-pointer-lowtag)))
     (inst cmp type simple-fun-header-widetag)
     (inst jmp :e normal-fn)
-    (inst lea raw (make-fixup (extern-alien-name "closure_tramp") :foreign))
+    (inst lea raw (make-fixup "closure_tramp" :foreign))
     NORMAL-FN
     (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
     (storew raw fdefn fdefn-raw-addr-slot other-pointer-lowtag)
@@ -278,7 +278,7 @@
   (:results (result :scs (descriptor-reg)))
   (:generator 38
     (storew nil-value fdefn fdefn-fun-slot other-pointer-lowtag)
-    (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign)
+    (storew (make-fixup "undefined_tramp" :foreign)
 	    fdefn fdefn-raw-addr-slot other-pointer-lowtag)
     (move result fdefn)))
 

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/macros.lisp,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- macros.lisp	13 Sep 2004 05:40:31 -0000	1.23
+++ macros.lisp	7 Apr 2005 08:00:43 -0000	1.24
@@ -174,10 +174,9 @@
     (unless (or (eql size 8) (eql size 16))
       (unless (and (tn-p size) (location= alloc-tn size))
 	(inst mov alloc-tn size)))
-    (inst call (make-fixup (extern-alien-name 
-			    (concatenate 'string
+    (inst call (make-fixup (concatenate 'string
 					 "alloc_" size-text
-					 "to_" tn-text))
+					 "to_" tn-text)
 			   :foreign))))
 
 (defun allocation-inline (alloc-tn size)
@@ -185,14 +184,12 @@
 	(free-pointer
 	 (make-ea :dword :disp 
 		  #!+sb-thread (* n-word-bytes thread-alloc-region-slot)
-		  #!-sb-thread (make-fixup (extern-alien-name "boxed_region")
-					    :foreign)
+		  #!-sb-thread (make-fixup "boxed_region" :foreign)
 		  :scale 1)) ; thread->alloc_region.free_pointer
 	(end-addr 
 	 (make-ea :dword :disp
 		  #!+sb-thread (* n-word-bytes (1+ thread-alloc-region-slot))
-		  #!-sb-thread (make-fixup (extern-alien-name "boxed_region")
-					   :foreign 4)
+		  #!-sb-thread (make-fixup "boxed_region" :foreign 4)
 		  :scale 1)))	; thread->alloc_region.end_addr
     (unless (and (tn-p size) (location= alloc-tn size))
       (inst mov alloc-tn size))
@@ -208,7 +205,7 @@
 		 (#.ebx-offset "alloc_overflow_ebx")
 		 (#.esi-offset "alloc_overflow_esi")
 		 (#.edi-offset "alloc_overflow_edi"))))
-      (inst call (make-fixup (extern-alien-name dst) :foreign)))
+      (inst call (make-fixup dst :foreign)))
     (emit-label ok)
     #!+sb-thread (inst fs-segment-prefix)
     (inst xchg free-pointer alloc-tn))

Index: show.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/show.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- show.lisp	11 Oct 2001 14:05:26 -0000	1.3
+++ show.lisp	7 Apr 2005 08:00:43 -0000	1.4
@@ -26,7 +26,7 @@
   (:save-p t)
   (:generator 100
     (inst push object)
-    (inst lea eax (make-fixup (extern-alien-name "debug_print") :foreign))
-    (inst call (make-fixup (extern-alien-name "call_into_c") :foreign))
+    (inst lea eax (make-fixup "debug_print" :foreign))
+    (inst call (make-fixup "call_into_c" :foreign))
     (inst add esp-tn n-word-bytes)
     (move result eax)))

Index: vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/vm.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- vm.lisp	2 Nov 2004 08:37:55 -0000	1.21
+++ vm.lisp	7 Apr 2005 08:00:44 -0000	1.22
@@ -449,15 +449,3 @@
       (immediate-constant "Immed")
       (noise (symbol-name (sc-name sc))))))
 ;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
-
-
-;;; The loader uses this to convert alien names to the form they need in
-;;; the symbol table (for example, prepending an underscore).
-(defun extern-alien-name (name)
-  (declare (type string name))
-  ;; ELF ports currently don't need any prefix
-  (typecase name
-    (simple-base-string name)
-    (base-string (coerce name 'simple-base-string))
-    (t (handler-case (coerce name 'simple-base-string)
-	 (type-error () (error "invalid external alien name: ~S" name))))))

Update of /cvsroot/sbcl/sbcl/contrib/sb-posix
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1033/contrib/sb-posix

Modified Files:
	macros.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-posix/macros.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- macros.lisp	26 Sep 2004 22:37:48 -0000	1.10
+++ macros.lisp	7 Apr 2005 08:00:15 -0000	1.11
@@ -48,8 +48,7 @@
 
 (defmacro define-call-internally (lisp-name c-name return-type error-predicate
 				  &rest arguments)
-  (if (sb-sys:foreign-symbol-address-as-integer-or-nil
-       (sb-vm:extern-alien-name c-name))
+  (if (sb-sys:foreign-symbol-address-as-integer-or-nil c-name)
       `(progn
 	(declaim (inline ,lisp-name))
 	(defun ,lisp-name ,(mapcar #'car arguments)

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

Modified Files:
	alloc.lisp c-call.lisp cell.lisp show.lisp vm.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: alloc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/alloc.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- alloc.lisp	8 Jan 2005 09:41:50 -0000	1.3
+++ alloc.lisp	7 Apr 2005 08:00:39 -0000	1.4
@@ -107,7 +107,7 @@
   (:translate make-fdefn)
   (:generator 37
     (with-fixed-allocation (result temp fdefn-widetag fdefn-size)
-      (inst li temp (make-fixup (extern-alien-name "undefined_tramp") :foreign))
+      (inst li temp (make-fixup "undefined_tramp" :foreign))
       (storew name result fdefn-name-slot other-pointer-lowtag)
       (storew null-tn result fdefn-fun-slot other-pointer-lowtag)
       (storew temp result fdefn-raw-addr-slot other-pointer-lowtag))))

Index: c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/c-call.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- c-call.lisp	9 Sep 2004 12:10:15 -0000	1.4
+++ c-call.lisp	7 Apr 2005 08:00:39 -0000	1.5
@@ -192,8 +192,7 @@
   (:results (res :scs (sap-reg)))
   (:result-types system-area-pointer)
   (:generator 2
-    (inst li res (make-fixup (extern-alien-name foreign-symbol) 
-                             :foreign))))
+    (inst li res (make-fixup foreign-symbol :foreign))))
 
 #!+linkage-table
 (define-vop (foreign-symbol-dataref-address)
@@ -206,8 +205,7 @@
   (:result-types system-area-pointer)
   (:temporary (:scs (non-descriptor-reg)) addr)
   (:generator 2
-    (inst li addr (make-fixup (extern-alien-name foreign-symbol) 
-                              :foreign-dataref))
+    (inst li addr (make-fixup foreign-symbol :foreign-dataref))
     (loadw res addr)))
 
 (define-vop (call-out)
@@ -227,7 +225,7 @@
       (when cur-nfp
 	(store-stack-tn nfp-save cur-nfp))
       (move cfunc function)
-      (inst li temp (make-fixup (extern-alien-name "call_into_c") :foreign))
+      (inst li temp (make-fixup "call_into_c" :foreign))
       (inst jal lip temp)
       (inst nop)
       (when cur-nfp

Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/cell.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- cell.lisp	21 May 2004 12:17:49 -0000	1.3
+++ cell.lisp	7 Apr 2005 08:00:40 -0000	1.4
@@ -125,7 +125,7 @@
       (inst cmp type simple-fun-header-widetag)
       (inst b :eq normal-fn)
       (inst move lip function)
-      (inst li lip (make-fixup (extern-alien-name "closure_tramp") :foreign))
+      (inst li lip (make-fixup "closure_tramp" :foreign))
       (emit-label normal-fn)
       (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
       (storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag)
@@ -139,7 +139,7 @@
   (:results (result :scs (descriptor-reg)))
   (:generator 38
     (storew null-tn fdefn fdefn-fun-slot other-pointer-lowtag)
-    (inst li temp (make-fixup (extern-alien-name "undefined_tramp") :foreign))
+    (inst li temp (make-fixup "undefined_tramp" :foreign))
     (storew temp fdefn fdefn-raw-addr-slot other-pointer-lowtag)
     (move result fdefn)))
 

Index: show.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/show.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- show.lisp	15 Feb 2002 17:10:02 -0000	1.1
+++ show.lisp	7 Apr 2005 08:00:40 -0000	1.2
@@ -26,8 +26,8 @@
       (when cur-nfp
 	(store-stack-tn nfp-save cur-nfp))
       (move nl0 object)
-      (inst li cfunc (make-fixup (extern-alien-name "debug_print") :foreign))
-      (inst li temp (make-fixup (extern-alien-name "call_into_c") :foreign))
+      (inst li cfunc (make-fixup "debug_print" :foreign))
+      (inst li temp (make-fixup "call_into_c" :foreign))
       (inst jal lip temp)
       (inst nop)
       (when cur-nfp

Index: vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/vm.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- vm.lisp	5 Apr 2005 11:03:35 -0000	1.9
+++ vm.lisp	7 Apr 2005 08:00:40 -0000	1.10
@@ -368,15 +368,3 @@
       (constant (format nil "Const~D" offset))
       (immediate-constant "Immed"))))
 
-
-;;; The loader uses this to convert alien names to the form they
-;;; occure in the symbol table (for example, prepending an
-;;; underscore).  On the SPARC, we don't prepend an underscore.
-(defun extern-alien-name (name)
-  (declare (type string name))
-  ;; ELF ports currently don't need any prefix
-  (typecase name
-    (simple-base-string name)
-    (base-string (coerce name 'simple-base-string))
-    (t (handler-case (coerce name 'simple-base-string)
-	 (type-error () (error "invalid external alien name: ~S" name))))))

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

Modified Files:
	alloc.lisp c-call.lisp cell.lisp show.lisp vm.lisp 
Removed Files:
	print.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: alloc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/alloc.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- alloc.lisp	8 Jan 2005 09:41:50 -0000	1.4
+++ alloc.lisp	7 Apr 2005 08:00:37 -0000	1.5
@@ -101,7 +101,7 @@
   (:translate make-fdefn)
   (:generator 37
     (with-fixed-allocation (result pa-flag temp fdefn-widetag fdefn-size)
-      (inst lr temp  (make-fixup (extern-alien-name "undefined_tramp") :foreign))
+      (inst lr temp  (make-fixup "undefined_tramp" :foreign))
       (storew name result fdefn-name-slot other-pointer-lowtag)
       (storew null-tn result fdefn-fun-slot other-pointer-lowtag)
       (storew temp result fdefn-raw-addr-slot other-pointer-lowtag))))

Index: c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/c-call.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- c-call.lisp	30 Dec 2004 13:44:29 -0000	1.7
+++ c-call.lisp	7 Apr 2005 08:00:37 -0000	1.8
@@ -308,7 +308,7 @@
   (:results (res :scs (sap-reg)))
   (:result-types system-area-pointer)
   (:generator 2
-    (inst lr res  (make-fixup (extern-alien-name foreign-symbol) :foreign))))
+    (inst lr res  (make-fixup foreign-symbol :foreign))))
 
 #!+linkage-table
 (define-vop (foreign-symbol-dataref-address)
@@ -321,8 +321,7 @@
   (:result-types system-area-pointer)
   (:temporary (:scs (non-descriptor-reg)) addr)
   (:generator 2
-    (inst lr addr (make-fixup (extern-alien-name foreign-symbol)
-                              :foreign-dataref))
+    (inst lr addr (make-fixup foreign-symbol :foreign-dataref))
     (loadw res addr)))
 
 (define-vop (call-out)
@@ -340,7 +339,7 @@
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
 	(store-stack-tn nfp-save cur-nfp))
-      (inst lr temp (make-fixup (extern-alien-name "call_into_c") :foreign))
+      (inst lr temp (make-fixup "call_into_c" :foreign))
       (inst mtctr temp)
       (move cfunc function)
       (inst bctrl)

Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/cell.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- cell.lisp	22 May 2004 22:36:33 -0000	1.4
+++ cell.lisp	7 Apr 2005 08:00:37 -0000	1.5
@@ -127,7 +127,7 @@
       (inst addi lip function
 	    (- (ash simple-fun-code-offset word-shift) fun-pointer-lowtag))
       (inst beq normal-fn)
-      (inst lr lip  (make-fixup (extern-alien-name "closure_tramp") :foreign))
+      (inst lr lip  (make-fixup "closure_tramp" :foreign))
       (emit-label normal-fn)
       (storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag)
       (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
@@ -141,7 +141,7 @@
   (:results (result :scs (descriptor-reg)))
   (:generator 38
     (storew null-tn fdefn fdefn-fun-slot other-pointer-lowtag)
-    (inst lr temp  (make-fixup (extern-alien-name "undefined_tramp") :foreign))
+    (inst lr temp  (make-fixup "undefined_tramp" :foreign))
     (storew temp fdefn fdefn-raw-addr-slot other-pointer-lowtag)
     (move result fdefn)))
 

Index: show.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/show.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- show.lisp	29 Jul 2003 13:01:56 -0000	1.2
+++ show.lisp	7 Apr 2005 08:00:38 -0000	1.3
@@ -18,10 +18,10 @@
       (when cur-nfp
 	(store-stack-tn nfp-save cur-nfp))
       (move nl0 object)
-      (inst lr temp  (make-fixup (extern-alien-name "call_into_c") :foreign))
+      (inst lr temp  (make-fixup "call_into_c" :foreign))
       (inst mr lip temp)
       (inst mtctr lip)
-      (inst lr cfunc (make-fixup (extern-alien-name "debug_print") :foreign))
+      (inst lr cfunc (make-fixup "debug_print" :foreign))
       (inst bctrl)
       (when cur-nfp
 	(load-stack-tn cur-nfp nfp-save))

Index: vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/vm.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- vm.lisp	5 Apr 2005 11:03:34 -0000	1.10
+++ vm.lisp	7 Apr 2005 08:00:38 -0000	1.11
@@ -331,21 +331,4 @@
       (non-descriptor-stack (format nil "NS~D" offset))
       (constant (format nil "Const~D" offset))
       (immediate-constant "Immed"))))
-
-;;; The loader uses this to convert alien names to the form they
-;;; occur in the symbol table.
 
-(defun extern-alien-name (name)
-  (declare (type string name))
-  ;; Darwin is non-ELF, and needs a _ prefix. The other (ELF) ports
-  ;; currently don't need any prefix.
-  (flet ((maybe-prefix (name)
-            #!+darwin (concatenate 'simple-base-string "_" name)
-            #!-darwin name))
-    (typecase name
-      (simple-base-string (maybe-prefix name))
-      (base-string (coerce (maybe-prefix name) 'simple-base-string))
-      (t
-       (handler-case (coerce (maybe-prefix name) 'simple-base-string)
-        (type-error ()
-          (error "invalid external alien name: ~S" name)))))))

--- print.lisp DELETED ---

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

Modified Files:
	vm.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/hppa/vm.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- vm.lisp	5 Apr 2005 11:03:32 -0000	1.6
+++ vm.lisp	7 Apr 2005 08:00:18 -0000	1.7
@@ -347,14 +347,4 @@
       (constant (format nil "Const~D" offset))
       (immediate-constant "Immed"))))
 
-;;; The loader uses this to convert alien names to the form they
-;;; occure in the symbol table (for example, prepending an
-;;; underscore).  On the HPPA we just leave it alone.
-(defun extern-alien-name (name)
-  (declare (type string name))
-  ;; ELF ports currently don't need any prefix
-  (typecase name
-    (simple-base-string name)
-    (base-string (coerce name 'simple-base-string))
-    (t (handler-case (coerce name 'simple-base-string)
-	 (type-error () (error "invalid external alien name: ~S" name))))))
+

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

Modified Files:
	genesis.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: genesis.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/genesis.lisp,v
retrieving revision 1.101
retrieving revision 1.102
diff -u -d -r1.101 -r1.102
--- genesis.lisp	14 Mar 2005 17:39:37 -0000	1.101
+++ genesis.lisp	7 Apr 2005 08:00:17 -0000	1.102
@@ -1474,7 +1474,7 @@
 			       sb!vm:fdefn-raw-addr-slot
 			       (make-random-descriptor
 				(cold-foreign-symbol-address-as-integer
-				 (sb!vm:extern-alien-name "undefined_tramp")))))
+				 "undefined_tramp"))))
 	  fdefn))))
 
 ;;; Handle the at-cold-init-time, fset-for-static-linkage operation
@@ -1501,7 +1501,7 @@
 			  (/show0 "/static-fset (closure)")
 			  (make-random-descriptor
 			   (cold-foreign-symbol-address-as-integer
-			    (sb!vm:extern-alien-name "closure_tramp"))))))
+			    "closure_tramp")))))
     fdefn))
 
 (defun initialize-static-fns ()

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

Modified Files:
	vm.lisp 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/vm.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- vm.lisp	5 Apr 2005 11:03:33 -0000	1.7
+++ vm.lisp	7 Apr 2005 08:00:36 -0000	1.8
@@ -351,11 +351,4 @@
       (constant (format nil "Const~D" offset))
       (immediate-constant "Immed"))))
 
-(defun extern-alien-name (name)
-  (declare (type string name))
-  ;; ELF ports currently don't need any prefix
-  (typecase name
-    (simple-base-string name)
-    (base-string (coerce name 'simple-base-string))
-    (t (handler-case (coerce name 'simple-base-string)
-	 (type-error () (error "invalid external alien name: ~S" name))))))
+

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

Modified Files:
	BUGS NEWS make-config.sh package-data-list.lisp-expr 
	version.lisp-expr 
Log Message:
0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373)
 * move e-a-n from SB-VM to SB-SYS, and from target/vm.lisp
    to foreign.lisp.
 * move all e-a-n calls to FIND-FOREIGN-SYMBOL-IN-TABLE and
    GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS.
 * reader conditionalize e-a-n behaviour on :ELF and :MACH-O; explicitly
    add the relevant feature for each OS in make-config.sh.
 * delete unused file ppc/print.lisp (duplicates ppc/show.lisp).
 * increment fasl-format number.

 note: affects all backends; tested on ppc/darwin, x86/freebsd, and
  sparc/sunos.


Index: BUGS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/BUGS,v
retrieving revision 1.450
retrieving revision 1.451
diff -u -d -r1.450 -r1.451
--- BUGS	27 Mar 2005 18:34:42 -0000	1.450
+++ BUGS	7 Apr 2005 08:00:03 -0000	1.451
@@ -2042,18 +2042,6 @@
  #.SB-EXT:SINGLE/DOUBLE-FLOAT-POSITIVE-INFINITY. These tests have been
  disabled on Darwin for now.
 
-373: profiling issues on ppc/darwin
- The following bit from smoke.impure.lisp fails on ppc/darwin:
-    (progn
-      (defun profiled-fun ()
-        (random 1d0))
-      (profile profiled-fun)
-      (loop repeat 100000 do (profiled-fun))
-      (report))
- dropping into the debugger with a TYPE-ERROR:
-    The value -1073741382 is not of type UNSIGNED-BYTE.
- The test has been disabled on Darwin till the bug is fixed.
-
 374: BIT-AND problem on ppc/darwin:
   The BIT-AND test in bit-vector.impure-cload.lisp results in
     fatal error encountered in SBCL pid 8356:

Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.758
retrieving revision 1.759
diff -u -d -r1.758 -r1.759
--- NEWS	6 Apr 2005 01:47:35 -0000	1.758
+++ NEWS	7 Apr 2005 08:00:05 -0000	1.759
@@ -11,6 +11,8 @@
     *ERROR-OUTPUT*, not *STANDARD-OUTPUT*.
   * fixed inference of the upper bound of an iteration variable.
     (reported by Rajat Datta).
+  * fixed bug 373: caused by erronous compilation of references to alien
+    variables in the runtime on ppc/darwin.
   * fixed bug 376: CONJUGATE type deriver.
   * fixed infinite looping of ALIEN-FUNCALL, compiled with high DEBUG.
     (reported by Baughn on #lisp)

Index: make-config.sh
===================================================================
RCS file: /cvsroot/sbcl/sbcl/make-config.sh,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -d -r1.44 -r1.45
--- make-config.sh	5 Apr 2005 16:38:15 -0000	1.44
+++ make-config.sh	7 Apr 2005 08:00:08 -0000	1.45
@@ -95,13 +95,14 @@
 ln -s $sbcl_arch-lispregs.h target-lispregs.h
 case `uname` in 
     Linux)
+	printf ' :elf' >> $ltf
 	printf ' :linux' >> $ltf
 	sbcl_os="linux"
-       if [ $sbcl_arch = "x86-64" ]; then
-           ln -s Config.x86_64-linux Config                                    
-       else                                                                    
-           ln -s Config.$sbcl_arch-linux Config                                
-       fi 
+	if [ $sbcl_arch = "x86-64" ]; then
+            ln -s Config.x86_64-linux Config                                    
+	else                                                                    
+            ln -s Config.$sbcl_arch-linux Config                                
+	fi 
 	ln -s $sbcl_arch-linux-os.h target-arch-os.h
 	ln -s linux-os.h target-os.h
 	;;
@@ -109,6 +110,7 @@
         # it's changed name twice since it was called OSF/1: clearly
         # the marketers forgot to tell the engineers about Digital Unix
         # _or_ OSF/1 ...
+	printf ' :elf' >> $ltf
 	printf ' :osf1' >> $ltf
 	sbcl_os="osf1"
         ln -s Config.$sbcl_arch-osf1 Config
@@ -121,17 +123,20 @@
 	ln -s bsd-os.h target-os.h
 	case `uname` in
 	    FreeBSD)
+		printf ' :elf' >> $ltf
 		printf ' :freebsd' >> $ltf
 		sbcl_os="freebsd"
 		ln -s Config.$sbcl_arch-freebsd Config
 		;;
 	    OpenBSD)
+		printf ' :elf' >> $ltf
 		printf ' :openbsd' >> $ltf
 		sbcl_os="openbsd"
 		ln -s Config.$sbcl_arch-openbsd Config
 		;;
 	    NetBSD)
                 printf ' :netbsd' >> $ltf
+		printf ' :elf' >> $ltf
 		sbcl_os="netbsd"
 		ln -s Config.$sbcl_arch-netbsd Config
 		;;
@@ -142,6 +147,7 @@
 	esac
 	;;
     Darwin)
+	printf ' :mach-o' >> $ltf
 	printf ' :bsd' >> $ltf
 	sbcl_os="darwin"
 	ln -s $sbcl_arch-darwin-os.h target-arch-os.h
@@ -150,6 +156,7 @@
 	ln -s Config.$sbcl_arch-darwin Config
 	;;
     SunOS)
+	printf ' :elf' >> $ltf
         printf ' :sunos' >> $ltf
 	sbcl_os="sunos"
 	ln -s Config.$sbcl_arch-sunos Config

Index: package-data-list.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/package-data-list.lisp-expr,v
retrieving revision 1.313
retrieving revision 1.314
diff -u -d -r1.313 -r1.314
--- package-data-list.lisp-expr	6 Apr 2005 17:16:57 -0000	1.313
+++ package-data-list.lisp-expr	7 Apr 2005 08:00:08 -0000	1.314
@@ -1840,6 +1840,7 @@
                "DLOPEN-OR-LOSE"
 	       "FROB-DO-BODY"
 	       "ENABLE-INTERRUPT" "ENUMERATION"
+	       "EXTERN-ALIEN-NAME"
 	       "FD-STREAM" "FD-STREAM-FD" "FD-STREAM-P" 
                "FIND-FOREIGN-SYMBOL-IN-TABLE"
 	       "FOREIGN-SYMBOL-ADDRESS" 
@@ -2078,7 +2079,7 @@
 	       "DOUBLE-INT-CARG-REG-SC-NUMBER" "DOUBLE-REG-SC-NUMBER"
 	       "DOUBLE-STACK-SC-NUMBER"
 	       "ERROR-TRAP" "EVEN-FIXNUM-LOWTAG"
-	       "EXPORTED-STATIC-SYMBOLS" "EXTERN-ALIEN-NAME"
+	       "EXPORTED-STATIC-SYMBOLS"
 	       "FDEFN-FUN-SLOT" "FDEFN-NAME-SLOT" "FDEFN-RAW-ADDR-SLOT"
 	       "FDEFN-SIZE" "FDEFN-WIDETAG" "FIXNUMIZE"
 	       "FIXNUM-TAG-MASK"

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2072
retrieving revision 1.2073
diff -u -d -r1.2072 -r1.2073
--- version.lisp-expr	6 Apr 2005 17:16:59 -0000	1.2072
+++ version.lisp-expr	7 Apr 2005 08:00:11 -0000	1.2073
@@ -17,4 +17,5 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.21.20"
+"0.8.21.21"
+