From: Nikodemus Siivola Date: Thu, 7 Apr 2005 08:00:03 +0000 (+0000) Subject: 0.8.21.21: fix & share EXTERN-ALIEN-NAME logic (fixes bug #373) X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a2ff6543c79752bfe42578f794bda1c28167fd10;p=sbcl.git 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. --- diff --git a/BUGS b/BUGS index bc3eebd..a04ad72 100644 --- a/BUGS +++ b/BUGS @@ -2042,18 +2042,6 @@ WORKAROUND: #.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: diff --git a/NEWS b/NEWS index af69764..2637cb8 100644 --- a/NEWS +++ b/NEWS @@ -11,6 +11,8 @@ changes in sbcl-0.8.22 relative to sbcl-0.8.21: *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) diff --git a/contrib/sb-posix/macros.lisp b/contrib/sb-posix/macros.lisp index cd722e3..7d388ac 100644 --- a/contrib/sb-posix/macros.lisp +++ b/contrib/sb-posix/macros.lisp @@ -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) diff --git a/make-config.sh b/make-config.sh index 09b059a..3dcbe1e 100644 --- a/make-config.sh +++ b/make-config.sh @@ -95,13 +95,14 @@ ln -s $sbcl_arch-arch.h target-arch.h 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 @@ case `uname` in # 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 @@ case `uname` in 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 @@ case `uname` in 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 @@ case `uname` in ln -s Config.$sbcl_arch-darwin Config ;; SunOS) + printf ' :elf' >> $ltf printf ' :sunos' >> $ltf sbcl_os="sunos" ln -s Config.$sbcl_arch-sunos Config diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 551f6fc..418a9a9 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1840,6 +1840,7 @@ SB-KERNEL) have been undone, but probably more remain." "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 @@ structure representations" "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" diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index 5896e81..23ece5c 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -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*)) diff --git a/src/code/foreign-load.lisp b/src/code/foreign-load.lisp index 694fc27..95a9ecf 100644 --- a/src/code/foreign-load.lisp +++ b/src/code/foreign-load.lisp @@ -145,14 +145,17 @@ SB-EXT:SAVE-LISP-AND-DIE for details." (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 @@ SB-EXT:SAVE-LISP-AND-DIE for details." (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) diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp index d383754..c7268ac 100644 --- a/src/code/foreign.lisp +++ b/src/code/foreign.lisp @@ -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 () diff --git a/src/compiler/alpha/vm.lisp b/src/compiler/alpha/vm.lisp index 43e8987..89a44b3 100644 --- a/src/compiler/alpha/vm.lisp +++ b/src/compiler/alpha/vm.lisp @@ -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)))))) + + diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 624f8b2..ba452c3 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1474,7 +1474,7 @@ core and return a descriptor to it." 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 @@ core and return a descriptor to it." (/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 () diff --git a/src/compiler/hppa/vm.lisp b/src/compiler/hppa/vm.lisp index 46a2882..af4b0df 100644 --- a/src/compiler/hppa/vm.lisp +++ b/src/compiler/hppa/vm.lisp @@ -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)))))) + diff --git a/src/compiler/mips/vm.lisp b/src/compiler/mips/vm.lisp index 78448a3..631e039 100644 --- a/src/compiler/mips/vm.lisp +++ b/src/compiler/mips/vm.lisp @@ -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)))))) + diff --git a/src/compiler/ppc/alloc.lisp b/src/compiler/ppc/alloc.lisp index 7fdcdca..5bb91bf 100644 --- a/src/compiler/ppc/alloc.lisp +++ b/src/compiler/ppc/alloc.lisp @@ -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)))) diff --git a/src/compiler/ppc/c-call.lisp b/src/compiler/ppc/c-call.lisp index 1942ef5..07f6b02 100644 --- a/src/compiler/ppc/c-call.lisp +++ b/src/compiler/ppc/c-call.lisp @@ -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) diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp index ddb3c2f..428b0b6 100644 --- a/src/compiler/ppc/cell.lisp +++ b/src/compiler/ppc/cell.lisp @@ -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))) diff --git a/src/compiler/ppc/print.lisp b/src/compiler/ppc/print.lisp deleted file mode 100644 index 083824b..0000000 --- a/src/compiler/ppc/print.lisp +++ /dev/null @@ -1,28 +0,0 @@ -;;; Written by William Lott. - -(in-package "SB!VM") - - -(define-vop (print) - (:args (object :scs (descriptor-reg any-reg) :target nl0)) - (:results (result :scs (descriptor-reg))) - (:save-p t) - (:temporary (:sc any-reg :offset nl0-offset :from (:argument 0)) nl0) - (:temporary (:sc any-reg :offset cfunc-offset) cfunc) - (:temporary (:sc interior-reg :offset lip-offset) lip) - (:temporary (:scs (non-descriptor-reg)) temp) - (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save) - (:vop-var vop) - (:generator 100 - (let ((cur-nfp (current-nfp-tn vop))) - (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 mr lip temp) - (inst mtctr lip) - (inst lr cfunc (make-fixup (extern-alien-name "debug_print") :foreign)) - (inst bctrl) - (when cur-nfp - (load-stack-tn cur-nfp nfp-save)) - (move result nl0)))) diff --git a/src/compiler/ppc/show.lisp b/src/compiler/ppc/show.lisp index 083824b..526b1c2 100644 --- a/src/compiler/ppc/show.lisp +++ b/src/compiler/ppc/show.lisp @@ -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)) diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp index c52ddfe..1a7c61b 100644 --- a/src/compiler/ppc/vm.lisp +++ b/src/compiler/ppc/vm.lisp @@ -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))))))) + diff --git a/src/compiler/sparc/alloc.lisp b/src/compiler/sparc/alloc.lisp index bfdf74b..4564b25 100644 --- a/src/compiler/sparc/alloc.lisp +++ b/src/compiler/sparc/alloc.lisp @@ -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)))) diff --git a/src/compiler/sparc/c-call.lisp b/src/compiler/sparc/c-call.lisp index bcb126c..83b5e8c 100644 --- a/src/compiler/sparc/c-call.lisp +++ b/src/compiler/sparc/c-call.lisp @@ -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 diff --git a/src/compiler/sparc/cell.lisp b/src/compiler/sparc/cell.lisp index 18405a3..3cad61b 100644 --- a/src/compiler/sparc/cell.lisp +++ b/src/compiler/sparc/cell.lisp @@ -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))) diff --git a/src/compiler/sparc/show.lisp b/src/compiler/sparc/show.lisp index a4f99ae..c334943 100644 --- a/src/compiler/sparc/show.lisp +++ b/src/compiler/sparc/show.lisp @@ -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 diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp index 2a93b22..5ee30a8 100644 --- a/src/compiler/sparc/vm.lisp +++ b/src/compiler/sparc/vm.lisp @@ -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)))))) diff --git a/src/compiler/x86-64/alloc.lisp b/src/compiler/x86-64/alloc.lisp index 3a5624c..1e53f95 100644 --- a/src/compiler/x86-64/alloc.lisp +++ b/src/compiler/x86-64/alloc.lisp @@ -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. ;; diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp index da3c82c..fe5502b 100644 --- a/src/compiler/x86-64/c-call.lisp +++ b/src/compiler/x86-64/c-call.lisp @@ -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)) diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 87c5e9c..8e4eabb 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -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))) diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 62d00c9..a02c756 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -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)) diff --git a/src/compiler/x86-64/show.lisp b/src/compiler/x86-64/show.lisp index f0e0201..47fb589 100644 --- a/src/compiler/x86-64/show.lisp +++ b/src/compiler/x86-64/show.lisp @@ -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))) diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp index fd8b94b..44a68b1 100644 --- a/src/compiler/x86-64/vm.lisp +++ b/src/compiler/x86-64/vm.lisp @@ -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))) diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp index bcf3483..03f9b9e 100644 --- a/src/compiler/x86/alloc.lisp +++ b/src/compiler/x86/alloc.lisp @@ -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) diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index 0672d53..627fc83 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -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. diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index efb56a5..63a74ef 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -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))) diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index a054404..d252203 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -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)) diff --git a/src/compiler/x86/show.lisp b/src/compiler/x86/show.lisp index b52d6a5..cdc1d11 100644 --- a/src/compiler/x86/show.lisp +++ b/src/compiler/x86/show.lisp @@ -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))) diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index 377b196..a56b5a3 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -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)))))) diff --git a/tests/smoke.impure.lisp b/tests/smoke.impure.lisp index a627d06..a7130a7 100644 --- a/tests/smoke.impure.lisp +++ b/tests/smoke.impure.lisp @@ -31,7 +31,6 @@ (assert (typep (in-package :cl-user) 'package)) ;;; PROFILE should run without obvious breakage -#-darwin (progn (defun profiled-fun () (random 1d0)) diff --git a/version.lisp-expr b/version.lisp-expr index 085a0ce..76b87c0 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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" +