Allow inlining more calls to INVOKE-WITH-SAVED-FP-AND-PC during XC.

  * The INVOKE-WITH-SAVED-FP-AND-PC mechanism was defined in
ALIENCOMP, which occurs well after the first uses of ALIEN-FUNCALL,
thus preventing it from being inlined when used during XC (by
default, only on x86).

  * Fix, by relocating the mechanism from SB!C to
SB!ALIEN-INTERNALS and from COMPILER;ALIENCOMP to
CODE;EARLY-ALIENEVAL.

  * Also relocate and publish symbols for all of the magic from
SB!ALIEN-INTERNALS.

diff --git a/NEWS b/NEWS
index dd3a55d..fa8ce46 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -28,6 +28,8 @@ changes relative to sbcl-1.1.7:
     code for type checks for types known at compile time that are smaller
     than (SIGNED-BYTE 64) or (UNSIGNED-BYTE 64) and larger than FIXNUM, and
     their COMPLEX variants.
+  * optimization: On x86 targets, more uses of ALIEN-FUNCALL during cross
+    compilation now inline the INVOKE-WITH-SAVED-FP-AND-PC dance.
 
 changes in sbcl-1.1.7 relative to sbcl-1.1.6:
   * enhancement: TRACE :PRINT-ALL handles multiple-valued forms.

diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index 0bab9bc..f15a238 100644 (file)
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -119,7 +119,7 @@
  ("src/code/parse-defmacro")   ; on host for PARSE-DEFMACRO
  ("src/compiler/deftype")      ; on host for SB!XC:DEFTYPE
  ("src/compiler/defconstant")
- ("src/code/early-alieneval")  ; for vars needed both at build and run time
+ ("src/code/early-alieneval")  ; for funs and vars needed at build and run time
 
  ("src/code/specializable-array")
 

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 00c4dec..2731792 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -76,7 +76,8 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
                "%DEREF-ADDR" "%HEAP-ALIEN" "%HEAP-ALIEN-ADDR"
                "%LOCAL-ALIEN-ADDR" "%LOCAL-ALIEN-FORCED-TO-MEMORY-P" "%SAP-ALIEN"
                "%SET-DEREF" "%SET-HEAP-ALIEN" "%SET-LOCAL-ALIEN" "%SET-SLOT"
-               "%SLOT-ADDR" "*VALUES-TYPE-OKAY*" "ALIEN-ARRAY-TYPE"
+               "%SLOT-ADDR" "*SAVED-FP-AND-PCS*" "*VALUES-TYPE-OKAY*"
+               "ALIEN-ARRAY-TYPE"
                "ALIEN-ARRAY-TYPE-DIMENSIONS" "ALIEN-ARRAY-TYPE-ELEMENT-TYPE"
                "ALIEN-ARRAY-TYPE-P" "ALIEN-BOOLEAN-TYPE" "ALIEN-BOOLEAN-TYPE-P"
                "ALIEN-CALLBACK"
@@ -112,8 +113,10 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
                "DEPORT" "DEPORT-ALLOC"
                "DISPOSE-LOCAL-ALIEN"
                "*ENTER-ALIEN-CALLBACK*" "ENTER-ALIEN-CALLBACK"
+               "FIND-SAVED-FP-AND-PC"
                "HEAP-ALIEN-INFO" "HEAP-ALIEN-INFO-P" "HEAP-ALIEN-INFO-SAP-FORM"
-               "HEAP-ALIEN-INFO-TYPE" "INVOKE-ALIEN-TYPE-METHOD" "LOCAL-ALIEN"
+               "HEAP-ALIEN-INFO-TYPE" "INVOKE-ALIEN-TYPE-METHOD"
+               "INVOKE-WITH-SAVED-FP-AND-PC" "LOCAL-ALIEN"
                "LOCAL-ALIEN-INFO" "LOCAL-ALIEN-INFO-FORCE-TO-MEMORY-P"
                "LOCAL-ALIEN-INFO-P" "LOCAL-ALIEN-INFO-TYPE"
                "MAKE-ALIEN-FUN-TYPE" "MAKE-ALIEN-POINTER-TYPE"
@@ -275,7 +278,6 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
                "PHYSENV-DEBUG-LIVE-TN" "PHYSENV-LIVE-TN"
                "FAST-SYMBOL-VALUE"
                "FAST-SYMBOL-GLOBAL-VALUE"
-               "FIND-SAVED-FP-AND-PC"
                "FIXUP-NOTE-KIND"
                "FIXUP-NOTE-FIXUP"
                "FIXUP-NOTE-POSITION"

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index a39421c..e8a188d 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -632,7 +632,8 @@
     (setf (frame-number frame) number)))
 
 (defun find-saved-frame-down (fp up-frame)
-  (multiple-value-bind (saved-fp saved-pc) (sb!c:find-saved-fp-and-pc fp)
+  (multiple-value-bind (saved-fp saved-pc)
+      (sb!alien-internals:find-saved-fp-and-pc fp)
     (when saved-fp
       (compute-calling-frame (descriptor-sap saved-fp)
                              (descriptor-sap saved-pc)

diff --git a/src/code/early-alieneval.lisp b/src/code/early-alieneval.lisp
index 8043bbd..206baa4 100644 (file)
--- a/src/code/early-alieneval.lisp
+++ b/src/code/early-alieneval.lisp
@@ -28,3 +28,33 @@
 (defvar *values-type-okay* nil)
 
 (defvar *default-c-string-external-format* nil)
+
+;;; Frame pointer, program counter conses. In each thread it's bound
+;;; locally or not bound at all.
+(defvar *saved-fp-and-pcs*)
+
+#!+:c-stack-is-control-stack
+(declaim (inline invoke-with-saved-fp-and-pc))
+#!+:c-stack-is-control-stack
+(defun invoke-with-saved-fp-and-pc (fn)
+  (declare #-sb-xc-host (muffle-conditions compiler-note)
+           (optimize (speed 3)))
+  (let* ((fp-and-pc (cons (sb!kernel:%caller-frame)
+                          (sap-int (sb!kernel:%caller-pc)))))
+    (declare (truly-dynamic-extent fp-and-pc))
+    (let ((*saved-fp-and-pcs* (if (boundp '*saved-fp-and-pcs*)
+                                  (cons fp-and-pc *saved-fp-and-pcs*)
+                                  (list fp-and-pc))))
+      (declare (truly-dynamic-extent *saved-fp-and-pcs*))
+      (funcall fn))))
+
+(defun find-saved-fp-and-pc (fp)
+  (when (boundp '*saved-fp-and-pcs*)
+    (dolist (x *saved-fp-and-pcs*)
+      (when (#!+:stack-grows-downward-not-upward
+             sap>
+             #!-:stack-grows-downward-not-upward
+             sap<
+             (int-sap (get-lisp-obj-address (car x))) fp)
+        (return (values (car x) (cdr x)))))))
+

diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp
index 56903ce..be71829 100644 (file)
--- a/src/compiler/aliencomp.lisp
+++ b/src/compiler/aliencomp.lisp
@@ -610,35 +610,6 @@
     `(lambda (function ,@names)
        (alien-funcall (deref function) ,@names))))
 
-;;; Frame pointer, program counter conses. In each thread it's bound
-;;; locally or not bound at all.
-(defvar *saved-fp-and-pcs*)
-
-#!+:c-stack-is-control-stack
-(declaim (inline invoke-with-saved-fp-and-pc))
-#!+:c-stack-is-control-stack
-(defun invoke-with-saved-fp-and-pc (fn)
-  (declare #-sb-xc-host (muffle-conditions compiler-note)
-           (optimize (speed 3)))
-  (let* ((fp-and-pc (cons (%caller-frame)
-                          (sap-int (%caller-pc)))))
-    (declare (truly-dynamic-extent fp-and-pc))
-    (let ((*saved-fp-and-pcs* (if (boundp '*saved-fp-and-pcs*)
-                                  (cons fp-and-pc *saved-fp-and-pcs*)
-                                  (list fp-and-pc))))
-      (declare (truly-dynamic-extent *saved-fp-and-pcs*))
-      (funcall fn))))
-
-(defun find-saved-fp-and-pc (fp)
-  (when (boundp '*saved-fp-and-pcs*)
-    (dolist (x *saved-fp-and-pcs*)
-      (when (#!+:stack-grows-downward-not-upward
-             sap>
-             #!-:stack-grows-downward-not-upward
-             sap<
-             (int-sap (get-lisp-obj-address (car x))) fp)
-        (return (values (car x) (cdr x)))))))
-
 (deftransform alien-funcall ((function &rest args) * * :node node :important t)
   (let ((type (lvar-type function)))
     (unless (alien-type-type-p type)