-;;; routines for call-out to C.
-;;;
-;;; Written by William Lott.
-;;;
+;;;; VOPs and other machine-specific support routines for call-out to C
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
(in-package "SB!VM")
-;;; Return the number of bytes needed for the current non-descriptor stack
-;;; frame. Non-descriptor stack frames must be multiples of 16 bytes under
-;;; the PPC SVr4 ABI (though the EABI may be less restrictive.) Two words
-;;; are reserved for the stack backlink and saved LR (see SB!VM::NUMBER-STACK-
-;;; DISPLACEMENT.)
-;;;
+;;; Return the number of bytes needed for the current non-descriptor
+;;; stack frame. Non-descriptor stack frames must be multiples of 16
+;;; bytes under the PPC SVr4 ABI (though the EABI may be less
+;;; restrictive). On linux, two words are reserved for the stack
+;;; backlink and saved LR (see SB!VM::NUMBER-STACK-DISPLACEMENT).
(defconstant +stack-alignment-bytes+
;; Duh. PPC Linux (and VxWorks) adhere to the EABI.
#!+darwin
(deftransform %alien-funcall ((function type &rest args))
- (assert (sb!c::constant-continuation-p type))
- (let* ((type (sb!c::continuation-value type))
+ (assert (sb!c::constant-lvar-p type))
+ (let* ((type (sb!c::lvar-value type))
(arg-types (alien-fun-type-arg-types type))
(result-type (alien-fun-type-result-type type)))
(assert (= (length arg-types) (length args)))
(: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)
+ (:generator 2
+ (inst lr res (make-fixup foreign-symbol :foreign))))
+
+#!+linkage-table
+(define-vop (foreign-symbol-dataref-address)
+ (:translate foreign-symbol-dataref-address)
+ (:policy :fast-safe)
+ (:args)
+ (:arg-types (:constant simple-string))
(:info foreign-symbol)
(:results (res :scs (sap-reg)))
(:result-types system-area-pointer)
+ (:temporary (:scs (non-descriptor-reg)) addr)
(:generator 2
- (inst lr res (make-fixup (extern-alien-name foreign-symbol) :foreign))))
+ (inst lr addr (make-fixup foreign-symbol :foreign-dataref))
+ (loadw res addr)))
(define-vop (call-out)
(:args (function :scs (sap-reg) :target cfunc)
(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)
(:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
(:generator 0
(unless (zerop amount)
- (let ((delta (- (logandc2 (+ amount 8 +stack-alignment-bytes+)
+ ;; FIXME: I don't understand why we seem to be adding
+ ;; NUMBER-STACK-DISPLACEMENT twice here. Weird. -- CSR,
+ ;; 2003-08-20
+ (let ((delta (- (logandc2 (+ amount number-stack-displacement
+ +stack-alignment-bytes+)
+stack-alignment-bytes+))))
(cond ((>= delta (ash -1 16))
(inst stwu nsp-tn nsp-tn delta))
(:policy :fast-safe)
(:generator 0
(unless (zerop amount)
- (let ((delta (logandc2 (+ amount 8 +stack-alignment-bytes+)
+ (let ((delta (logandc2 (+ amount number-stack-displacement
+ +stack-alignment-bytes+)
+stack-alignment-bytes+)))
(cond ((< delta (ash 1 16))
(inst addi nsp-tn nsp-tn delta))