[Sbcl-commits] CVS: sbcl/src/compiler/x86 c-call.lisp,1.21,1.21.4.1 vm.lisp,1.18.4.2,1.18.4.3

[Christophe R. <cr...@us...>]

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

Modified Files:
      Tag: character_branch
	c-call.lisp vm.lisp 
Log Message:
0.8.13.77:
	"Go to your room, young man"

	Fix (for x86) the base-string/string interactions in 
	EXTERN-ALIEN-NAME/FOREIGN-SYMBOL-ADDRESS.
	... and remove the #.(coerce "foo" 'base-string) monstrosities
		that were introduced to deal with this.
	... some remain, because they're there to deal with 
		SB-UNIX:UNIX-FOO requiring base strings.


Index: c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/c-call.lisp,v
retrieving revision 1.21
retrieving revision 1.21.4.1
diff -u -d -r1.21 -r1.21.4.1
--- c-call.lisp	10 Jun 2004 13:33:18 -0000	1.21
+++ c-call.lisp	7 Sep 2004 10:15:23 -0000	1.21.4.1
@@ -188,7 +188,7 @@
   (:translate foreign-symbol-address)
   (:policy :fast-safe)
   (:args)
-  (:arg-types (:constant simple-base-string))
+  (:arg-types (:constant simple-string))
   (:info foreign-symbol)
   (:results (res :scs (sap-reg)))
   (:result-types system-area-pointer)

Index: vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/vm.lisp,v
retrieving revision 1.18.4.2
retrieving revision 1.18.4.3
diff -u -d -r1.18.4.2 -r1.18.4.3
--- vm.lisp	25 Aug 2004 20:26:27 -0000	1.18.4.2
+++ vm.lisp	7 Sep 2004 10:15:23 -0000	1.18.4.3
@@ -450,6 +450,10 @@
 ;;; 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 simple-string name))
+  (declare (type string name))
   ;; ELF ports currently don't need any prefix
-  (coerce name 'simple-base-string))
+  (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))))))