(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
;; 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))
;; 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)
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 (cdr args)))
+ (every #'fopcompilable-p args))
(otherwise
;; ordinary function calls
(and (symbolp operator)
(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))))
(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.
(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)
(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))))
(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))
(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*))))
projects / sbcl.git / blobdiff