X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Ffopcompile.lisp;h=3162a8abbf3cdabd26708938a583c08e31f14d75;hb=e60863045b4bc5b7c09d54f745d5d7ecc215f477;hp=74272179f55deb0b47cd611a9c50891b035d89a0;hpb=017a0b4491fd9f211d6563909b42dc10d925a1d2;p=sbcl.git diff --git a/src/compiler/fopcompile.lisp b/src/compiler/fopcompile.lisp index 7427217..3162a8a 100644 --- a/src/compiler/fopcompile.lisp +++ b/src/compiler/fopcompile.lisp @@ -11,6 +11,11 @@ (in-package "SB!C") +;;; True if the current contour of FOPCOMPILABLE-P has a LET or LET* +;;; with a non-nil bindings list, false otherwise. The effect of this +;;; variable is to +(defvar *fop-complex-lexenv-p* nil) + ;;; SBCL has no proper byte compiler (having ditched the rather ;;; ambitious and slightly flaky byte compiler inherited from CMU CL) ;;; but its FOPs are a sort of byte code which is expressive enough @@ -48,6 +53,9 @@ ;; Punt on :ALIEN variables (let ((kind (info :variable :kind form))) (or (eq kind :special) + ;; Not really a global, but a variable for + ;; which no information exists. + (eq kind :global) (eq kind :constant)))))) (and (listp form) (ignore-errors (list-length form)) @@ -69,7 +77,16 @@ ;; are not fopcompileable as such, but we can compile ;; the lambdas with the real compiler, and the rest ;; of the expression with the fop-compiler. - (or (lambda-form-p (car args)) + (or (and (lambda-form-p (car args)) + ;; The lambda might be closing over some + ;; variable, punt. As a further improvement, + ;; we could analyze the lambda body to + ;; see whether it really closes over any + ;; variables. One place where even simple + ;; analysis would be useful are the PCL + ;; slot-definition type-check-functions + ;; -- JES, 2007-01-13 + (not *fop-complex-lexenv-p*)) ;; #'FOO, #'(SETF FOO), etc (legal-fun-name-p (car args))))) ((if) @@ -97,16 +114,36 @@ eval)) nil) (every #'fopcompilable-p (cdr args)))) - ;; A LET or LET* that introduces no bindings or - ;; declarations is trivially fopcompilable. Forms - ;; with no bindings but with declarations could also - ;; be handled, but we're currently punting on any - ;; lexenv manipulation. + ;; A LET or LET* that introduces only lexical + ;; bindings might be fopcompilable, depending on + ;; whether something closes over the bindings. + ;; (And whether there are declarations in the body, + ;; see below) ((let let*) (and (>= (length args) 1) - (null (car args)) - (every #'fopcompilable-p (cdr args)))) - ;; Likewise for LOCALLY + (loop for binding in (car args) + for complexp = *fop-complex-lexenv-p* then + (if (eq operator 'let) + complexp + t) + for name = (if (consp binding) + (first binding) + binding) + for value = (if (consp binding) + (second binding) + nil) + ;; Only allow binding lexicals, + ;; since special bindings can't be + ;; easily expressed with fops. + always (and (eq (info :variable :kind name) + :global) + (let ((*fop-complex-lexenv-p* + complexp)) + (fopcompilable-p value)))) + (let ((*fop-complex-lexenv-p* + (or *fop-complex-lexenv-p* + (not (null (car args)))))) + (every #'fopcompilable-p (cdr args))))) ((locally) (every #'fopcompilable-p args)) (otherwise @@ -196,7 +233,11 @@ (declare (ignore init-form)) (case creation-form (:sb-just-dump-it-normally - (fasl-validate-structure constant *compile-object*) + ;; FIXME: Why is this needed? If the constant + ;; is deemed fopcompilable, then when we dump + ;; it we bind *dump-only-valid-structures* to + ;; NIL. + (fasl-validate-structure value *compile-object*) (dotimes (i (- (%instance-length value) (layout-n-untagged-slots (%instance-ref value 0)))) @@ -209,6 +250,9 @@ (grovel constant)) t)) +;;; An alist mapping lexical varible names to FOP table handles. +(defvar *fop-lexenv* nil) + ;;; FOR-VALUE-P is true if the value will be used (i.e., pushed onto ;;; FOP stack), or NIL if any value will be discarded. FOPCOMPILABLE-P ;;; has already ensured that the form can be fopcompiled. @@ -221,8 +265,24 @@ (if macroexpanded-p ;; Symbol macro (fopcompile macroexpansion path for-value-p) - ;; Special variable - (fopcompile `(symbol-value ',form) path for-value-p)))) + (let ((kind (info :variable :kind form))) + (if (member kind '(:special :constant)) + ;; Special variable + (fopcompile `(symbol-value ',form) path for-value-p) + ;; Lexical + (when for-value-p + (let ((handle (cdr (assoc form *fop-lexenv*)))) + (if handle + (sb!fasl::dump-push handle + *compile-object*) + (progn + ;; Undefined variable. Signal a warning, and + ;; treat it as a special variable reference, + ;; like the real compiler does. + (note-undefined-reference form :variable) + (fopcompile `(symbol-value ',form) + path + for-value-p)))))))))) ((listp form) (multiple-value-bind (macroexpansion macroexpanded-p) (macroexpand form) @@ -273,24 +333,57 @@ (fopcompile (cons 'progn body) path for-value-p) (fopcompile nil path for-value-p)))) ((let let*) - (fopcompile (cons 'progn (cdr args)) path for-value-p)) + (let ((orig-lexenv *fop-lexenv*) + (*fop-lexenv* *fop-lexenv*)) + (loop for binding in (car args) + for name = (if (consp binding) + (first binding) + binding) + for value = (if (consp binding) + (second binding) + nil) + do (let ((*fop-lexenv* + (if (eql operator 'let) + orig-lexenv + *fop-lexenv*))) + (fopcompile value path t)) + do (push (cons name + (sb!fasl::dump-pop + *compile-object*)) + *fop-lexenv*)) + (fopcompile (cons 'progn (cdr args)) path for-value-p))) ;; Otherwise it must be an ordinary funcall. (otherwise - (fopcompile-constant operator t) - (dolist (arg args) - (fopcompile arg path t)) - (if for-value-p - (sb!fasl::dump-fop 'sb!fasl::fop-funcall - *compile-object*) - (sb!fasl::dump-fop 'sb!fasl::fop-funcall-for-effect - *compile-object*)) - (let ((n-args (length args))) - ;; stub: FOP-FUNCALL isn't going to be usable - ;; to compile more than this, since its count - ;; is a single byte. Maybe we should just punt - ;; to the ordinary compiler in that case? - (aver (<= n-args 255)) - (sb!fasl::dump-byte n-args *compile-object*)))))))) + (cond + ;; Special hack: there's already a fop for + ;; find-undeleted-package-or-lose, so use it. + ;; (We could theoretically do the same for + ;; other operations, but I don't see any good + ;; candidates in a quick read-through of + ;; src/code/fop.lisp.) + ((and (eq operator + 'sb!int:find-undeleted-package-or-lose) + (= 1 (length args)) + for-value-p) + (fopcompile (first args) path t) + (sb!fasl::dump-fop 'sb!fasl::fop-package + *compile-object*)) + (t + (fopcompile-constant operator t) + (dolist (arg args) + (fopcompile arg path t)) + (if for-value-p + (sb!fasl::dump-fop 'sb!fasl::fop-funcall + *compile-object*) + (sb!fasl::dump-fop 'sb!fasl::fop-funcall-for-effect + *compile-object*)) + (let ((n-args (length args))) + ;; stub: FOP-FUNCALL isn't going to be usable + ;; to compile more than this, since its count + ;; is a single byte. Maybe we should just punt + ;; to the ordinary compiler in that case? + (aver (<= n-args 255)) + (sb!fasl::dump-byte n-args *compile-object*)))))))))) (t (bug "looks unFOPCOMPILEable: ~S" form)))) @@ -301,17 +394,11 @@ (cond ;; Lambda forms are compiled with the real compiler ((lambda-form-p form) - ;; We wrap the real lambda inside another one to ensure - ;; that the compiler doesn't e.g. let convert it, thinking - ;; that there are no external references. - (let* ((handle (%compile `(lambda () ,form) + (let* ((handle (%compile form *compile-object* :path path))) (when for-value-p - (sb!fasl::dump-push handle *compile-object*) - ;; And then call the wrapper function when loading the FASL - (sb!fasl::dump-fop 'sb!fasl::fop-funcall *compile-object*) - (sb!fasl::dump-byte 0 *compile-object*)))) + (sb!fasl::dump-push handle *compile-object*)))) ;; While function names are translated to a call to FDEFINITION. ((legal-fun-name-p form) (dump-fdefinition form)) @@ -359,5 +446,9 @@ (defun fopcompile-constant (form for-value-p) (when for-value-p + ;; FIXME: Without this binding the dumper chokes on unvalidated + ;; structures: CONSTANT-FOPCOMPILABLE-P validates the structure + ;; about to be dumped, not its load-form. Compare and contrast + ;; with EMIT-MAKE-LOAD-FORM. (let ((sb!fasl::*dump-only-valid-structures* nil)) (dump-object form *compile-object*))))