#.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:
*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)
(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)
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
;;
# 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
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
;;
esac
;;
Darwin)
+ printf ' :mach-o' >> $ltf
printf ' :bsd' >> $ltf
sbcl_os="darwin"
ln -s $sbcl_arch-darwin-os.h target-arch-os.h
ln -s Config.$sbcl_arch-darwin Config
;;
SunOS)
+ printf ' :elf' >> $ltf
printf ' :sunos' >> $ltf
sbcl_os="sunos"
ln -s Config.$sbcl_arch-sunos Config
"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"
"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"
;;; 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
;;; 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*))
(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))))))))
(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)
(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
(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))
(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 ()
(non-descriptor-stack (format nil "NS~D" offset))
(constant (format nil "Const~D" offset))
(immediate-constant "Immed"))))
-\f
-;;; 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))))))
+
+
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
(/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 ()
(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))))))
+
(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))))))
+
(: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))))
(: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)
(: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)
(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)
(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)
(: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)))
+++ /dev/null
-;;; 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))))
(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))
(non-descriptor-stack (format nil "NS~D" offset))
(constant (format nil "Const~D" offset))
(immediate-constant "Immed"))))
-\f
-;;; 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)))))))
+
(: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))))
(: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)
(: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)
(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
(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)
(: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)))
(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
(constant (format nil "Const~D" offset))
(immediate-constant "Immed"))))
-\f
-;;; 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))))))
(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)
;; 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.
;;
(: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)
(: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))
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)
(: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)))
\f
(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))
(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))
(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))
(: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)))
(noise (symbol-name (sc-name sc))))))
;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
-\f
-;;; The loader uses this to convert alien names to the form they need in
-;;; the symbol table (for example, prepending an underscore).
-\f
-;;; 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)))
(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)
(: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)
(: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))
(: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.
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)
(: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)))
\f
(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)
(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))
(#.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))
(: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)))
(immediate-constant "Immed")
(noise (symbol-name (sc-name sc))))))
;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
-
-\f
-;;; 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))))))
(assert (typep (in-package :cl-user) 'package))
;;; PROFILE should run without obvious breakage
-#-darwin
(progn
(defun profiled-fun ()
(random 1d0))
;;; 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"
+
projects / sbcl.git / commitdiff