From 746f87ccd17e482b4f47d0990fbfa4ffdf386662 Mon Sep 17 00:00:00 2001 From: Charles Zhang Date: Mon, 2 May 2022 00:36:51 -0700 Subject: [PATCH] Don't try to fold named constant references inside backquote anymore The gain for doing so was fairly marginal. The thing that really mattered with the change adding the folding was telling the difference between a named constant and anonymous constant inside the backq constant folder, for the sake of sane load form semantics. Not backq-constant-folding named constant references removes a load-form hack which also just doesn't work with deferred TLF processing, as the load form may get evaluated for value before the constant definition for the named constant is evaluated. --- src/compiler/generic/vm-ir2tran.lisp | 5 ++- src/compiler/seqtran.lisp | 48 +++++++++--------------- tests/backq-const-fold.impure-cload.lisp | 2 +- tests/block-compile.impure.lisp | 17 +++++++++ 4 files changed, 39 insertions(+), 33 deletions(-) diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index 887e33158..601ed26d0 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -297,7 +297,10 @@ ;; Nonetheless it's far better than it was. In all other scenarios, don't pass ;; a constant TN, because we don't know that generated code is better. (cond #+x86-64 ; still moar cringe - ((and (or bit-vector-p simple-vector-p) (constant-lvar-p value)) + ((and (or bit-vector-p simple-vector-p) (constant-lvar-p value) + ;; check for constant named-ness to not + ;; trigger load form processing. + (not (leaf-has-source-name-p (nth-value 1 (lvar-value value))))) (funcall setter (tnify i) (emit-constant (lvar-value value)))) (t ;; FIXME: for simple-vector, fixnums should get stored via an ANY-REG diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index bf2d6d911..0db4b348c 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -2579,41 +2579,25 @@ (define-trimmer-transform string-trim t t)) -;;; We use this structure to facilitate named constant reference dumping inside -;;; constant folded backquoted structures. -#-sb-xc-host -(defstruct (named-constant-reference - (:constructor make-named-constant-reference (name))) - (name (missing-arg) :type symbol :read-only t)) -#-sb-xc-host -(defmethod make-load-form ((object named-constant-reference) &optional environment) - (declare (ignore environment)) - (named-constant-reference-name object)) - -;;; Wrap the value of lvar-value if it comes from a named -;;; reference. For bootstrap reasons we don't do this during -;;; cross-compile. -(defun maybe-wrapped-lvar-value (lvar) - #+sb-xc-host - (lvar-value lvar) - #-sb-xc-host - (multiple-value-bind (value leaf) - (lvar-value lvar) - (if (leaf-has-source-name-p leaf) - (make-named-constant-reference (leaf-source-name leaf)) - value))) - -;;; Pop constant values from the end, list/list* them if any, and link -;;; the remainder with list* at runtime. +;;; Pop anonymous constant values from the end, list/list* them if +;;; any, and link the remainder with list* at runtime. We don't try to +;;; fold named constant references, because while theoretically +;;; possible, in addition to needing to make a load form for a +;;; structure recording the constant name which wraps the constant +;;; value, the dumper would have to learn how to patch constant values +;;; into list structure, to deal with the load form potentially being +;;; evaluated for value earlier than the constant definition is +;;; loaded. (defun transform-backq-list-or-list* (function values) (let ((gensyms (make-gensym-list (length values))) (reverse (reverse values)) (constants '())) (loop while (and reverse - (constant-lvar-p (car reverse))) - do (push (maybe-wrapped-lvar-value (pop reverse)) - constants)) + (constant-lvar-p (car reverse)) + (not (leaf-has-source-name-p + (nth-value 1 (lvar-value (car reverse)))))) + do (push (lvar-value (pop reverse)) constants)) (if (null constants) `(lambda ,gensyms (,function ,@gensyms)) @@ -2644,8 +2628,10 @@ ;; might avoid consing intermediate lists if ,@ is involved ;; though I doubt it would provide benefit to many real-world scenarios. (dolist (elt elts) - (cond ((constant-lvar-p elt) - (push (maybe-wrapped-lvar-value elt) constants)) + (cond ((and (constant-lvar-p elt) + (not (leaf-has-source-name-p + (print (nth-value 1 (lvar-value elt)))))) + (push (lvar-value elt) constants)) (t (setq constants :fail) (return)))) diff --git a/tests/backq-const-fold.impure-cload.lisp b/tests/backq-const-fold.impure-cload.lisp index ea3f51ff4..f08f90d1f 100644 --- a/tests/backq-const-fold.impure-cload.lisp +++ b/tests/backq-const-fold.impure-cload.lisp @@ -9,7 +9,7 @@ (make-instance 'foo))) ;;; The `(,+foo+) expression was being compile-time-folded to (#). Consequently it is unclear whether the # inside that +;;; xxxx>). Consequently it was unclear whether the # inside that ;;; list should require a load-form. We now track whether something ;;; comes from a named constant reference and dump the constant ;;; appropriately. diff --git a/tests/block-compile.impure.lisp b/tests/block-compile.impure.lisp index e5b636d1d..eb3dad01d 100644 --- a/tests/block-compile.impure.lisp +++ b/tests/block-compile.impure.lisp @@ -106,3 +106,20 @@ :block-compile t :load t) (assert (eq (bar) (symbol-value 'testconstant4)))) + + +(with-test (:name :block-defconstant-hairy-backq-dumping-test) + (ctu:file-compile + `((defconstant +stuff+ + (if (boundp '+stuff+) + (symbol-value '+stuff+) + '(0 0))) + + (defvar *backq-stuff* + `((0 ,(random 10)) + (,@+stuff+ 1 2 (3 . 4)) + (5 6 ,+stuff+)))) + :block-compile t + :before-load (lambda () (unintern (find-symbol "+STUFF+"))) + :load t) + (assert (= 0 (first (third (third (symbol-value '*backq-stuff*)))))))