From 34f08eca171fca180a1d75c35c86816acf20a375 Mon Sep 17 00:00:00 2001 From: Alastair Bridgewater Date: Thu, 9 May 2013 17:16:58 -0400 Subject: [PATCH] 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. --- NEWS | 2 ++ build-order.lisp-expr | 2 +- package-data-list.lisp-expr | 8 +++++--- src/code/debug-int.lisp | 3 ++- src/code/early-alieneval.lisp | 30 ++++++++++++++++++++++++++++++ src/compiler/aliencomp.lisp | 29 ----------------------------- 6 files changed, 40 insertions(+), 34 deletions(-) diff --git a/NEWS b/NEWS index dd3a55d..fa8ce46 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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) -- 1.7.10.4