Compute freevars in cconv-analyse.
authorStefan Monnier <monnier@iro.umontreal.ca>
Sat, 26 Feb 2011 15:19:08 +0000 (10:19 -0500)
committerStefan Monnier <monnier@iro.umontreal.ca>
Sat, 26 Feb 2011 15:19:08 +0000 (10:19 -0500)
* lisp/emacs-lisp/cconv.el: Compute freevars in cconv-analyse.
(cconv-mutated, cconv-captured): Remove.
(cconv-captured+mutated, cconv-lambda-candidates): Don't give them
a global value.
(cconv-freevars-alist): New var.
(cconv-freevars): Remove.
(cconv--lookup-let): Remove.
(cconv-closure-convert-function): Extract from cconv-closure-convert-rec.
(cconv-closure-convert-rec): Adjust to above changes.
(fboundp): New function.
(cconv-analyse-function, form): Rewrite.
* lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
Handle declare-function here.
(byte-compile-obsolete): Remove.
(byte-compile-arglist-warn): Check late defsubst here.
(byte-compile-file-form): Simplify.
(byte-compile-file-form-defsubst): Remove.
(byte-compile-macroexpand-declare-function): Rename from
byte-compile-declare-function, turn it into a macro-expander.
(byte-compile-normal-call): Check obsolescence.
(byte-compile-quote-form): Remove.
(byte-compile-defmacro): Revert to trunk's definition which seems to
work just as well and handles `declare'.
* lisp/emacs-lisp/byte-run.el (make-obsolete): Don't modify byte-compile.
* lisp/Makefile.in (BIG_STACK_DEPTH): Increase to 1200.
(compile-onefile): Pass $(BIG_STACK_OPTS) before "-l bytecomp".
* lisp/emacs-lisp/macroexp.el: Use lexbind.
(macroexpand-all-1): Check macro obsolescence.
* lisp/vc/diff-mode.el: Use lexbind.
* lisp/follow.el (follow-calc-win-end): Simplify.

lisp/ChangeLog
lisp/Makefile.in
lisp/emacs-lisp/byte-run.el
lisp/emacs-lisp/bytecomp.el
lisp/emacs-lisp/cconv.el
lisp/emacs-lisp/debug.el
lisp/emacs-lisp/macroexp.el
lisp/follow.el
lisp/vc/diff-mode.el
src/bytecode.c

index ee6944d..1b5e940 100644 (file)
@@ -1,3 +1,36 @@
+2011-02-26  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * emacs-lisp/cconv.el: Compute freevars in cconv-analyse.
+       (cconv-mutated, cconv-captured): Remove.
+       (cconv-captured+mutated, cconv-lambda-candidates): Don't give them
+       a global value.
+       (cconv-freevars-alist): New var.
+       (cconv-freevars): Remove.
+       (cconv--lookup-let): Remove.
+       (cconv-closure-convert-function): Extract from cconv-closure-convert-rec.
+       (cconv-closure-convert-rec): Adjust to above changes.
+       (fboundp): New function.
+       (cconv-analyse-function, form): Rewrite.
+       * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
+       Handle declare-function here.
+       (byte-compile-obsolete): Remove.
+       (byte-compile-arglist-warn): Check late defsubst here.
+       (byte-compile-file-form): Simplify.
+       (byte-compile-file-form-defsubst): Remove.
+       (byte-compile-macroexpand-declare-function): Rename from
+       byte-compile-declare-function, turn it into a macro-expander.
+       (byte-compile-normal-call): Check obsolescence.
+       (byte-compile-quote-form): Remove.
+       (byte-compile-defmacro): Revert to trunk's definition which seems to
+       work just as well and handles `declare'.
+       * emacs-lisp/byte-run.el (make-obsolete): Don't modify byte-compile.
+       * Makefile.in (BIG_STACK_DEPTH): Increase to 1200.
+       (compile-onefile): Pass $(BIG_STACK_OPTS) before "-l bytecomp".
+       * emacs-lisp/macroexp.el: Use lexbind.
+       (macroexpand-all-1): Check macro obsolescence.
+       * vc/diff-mode.el: Use lexbind.
+       * follow.el (follow-calc-win-end): Simplify.
+
 2011-02-25  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle new form of
index 389d5b1..0182b7f 100644 (file)
@@ -74,7 +74,7 @@ AUTOGENEL = loaddefs.el \
 # During bootstrapping the byte-compiler is run interpreted when compiling
 # itself, and uses more stack than usual.
 #
-BIG_STACK_DEPTH = 1000
+BIG_STACK_DEPTH = 1200
 BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
 
 # Files to compile before others during a bootstrap.  This is done to
@@ -205,8 +205,8 @@ compile-onefile:
        @echo Compiling $(THEFILE)
        @# Use byte-compile-refresh-preloaded to try and work around some of
        @# the most common bootstrapping problems.
-       $(emacs) -l bytecomp.el -f byte-compile-refresh-preloaded \
-               $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \
+       @$(emacs) $(BIG_STACK_OPTS) -l bytecomp $(BYTE_COMPILE_EXTRA_FLAGS) \
+               -f byte-compile-refresh-preloaded \
                -f batch-byte-compile $(THEFILE)
 
 # Files MUST be compiled one by one. If we compile several files in a
@@ -222,7 +222,7 @@ compile-onefile:
 # cannot have prerequisites.
 .el.elc:
        @echo Compiling $<
-       $(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \
+       @$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \
                -f batch-byte-compile $<
 
 .PHONY: compile-first compile-main compile compile-always
index 524f4f1..3fb3d84 100644 (file)
@@ -123,12 +123,10 @@ If CURRENT-NAME is a string, that is the `use instead' message
 If provided, WHEN should be a string indicating when the function
 was first made obsolete, for example a date or a release number."
   (interactive "aMake function obsolete: \nxObsoletion replacement: ")
-  (let ((handler (get obsolete-name 'byte-compile)))
-    (if (eq 'byte-compile-obsolete handler)
-       (setq handler (nth 1 (get obsolete-name 'byte-obsolete-info)))
-      (put obsolete-name 'byte-compile 'byte-compile-obsolete))
-    (put obsolete-name 'byte-obsolete-info
-        (list (purecopy current-name) handler (purecopy when))))
+  (put obsolete-name 'byte-obsolete-info
+       ;; The second entry used to hold the `byte-compile' handler, but
+       ;; is not used any more nowadays.
+       (list (purecopy current-name) nil (purecopy when)))
   obsolete-name)
 (set-advertised-calling-convention
  ;; New code should always provide the `when' argument.
index 6bc2b3b..4a53fae 100644 (file)
@@ -424,6 +424,7 @@ This list lives partly on the stack.")
   '(
 ;;     (byte-compiler-options . (lambda (&rest forms)
 ;;                            (apply 'byte-compiler-options-handler forms)))
+    (declare-function . byte-compile-macroexpand-declare-function)
     (eval-when-compile . (lambda (&rest body)
                           (list
                            'quote
@@ -1140,13 +1141,6 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
   (byte-compile-log-warning
    (error-message-string error-info)
    nil :error))
-
-;;; Used by make-obsolete.
-(defun byte-compile-obsolete (form)
-  (byte-compile-set-symbol-position (car form))
-  (byte-compile-warn-obsolete (car form))
-  (funcall (or (cadr (get (car form) 'byte-obsolete-info)) ; handler
-              'byte-compile-normal-call) form))
 \f
 ;;; sanity-checking arglists
 
@@ -1328,7 +1322,8 @@ extra args."
 ;; Warn if the function or macro is being redefined with a different
 ;; number of arguments.
 (defun byte-compile-arglist-warn (form macrop)
-  (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))
+  (let* ((name (nth 1 form))
+         (old (byte-compile-fdefinition name macrop)))
     (if (and old (not (eq old t)))
        (progn
          (and (eq 'macro (car-safe old))
@@ -1342,36 +1337,39 @@ extra args."
                          (t '(&rest def)))))
                (sig2 (byte-compile-arglist-signature (nth 2 form))))
            (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
-             (byte-compile-set-symbol-position (nth 1 form))
+             (byte-compile-set-symbol-position name)
              (byte-compile-warn
               "%s %s used to take %s %s, now takes %s"
               (if (eq (car form) 'defun) "function" "macro")
-              (nth 1 form)
+              name
               (byte-compile-arglist-signature-string sig1)
               (if (equal sig1 '(1 . 1)) "argument" "arguments")
               (byte-compile-arglist-signature-string sig2)))))
       ;; This is the first definition.  See if previous calls are compatible.
-      (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
+      (let ((calls (assq name byte-compile-unresolved-functions))
            nums sig min max)
-       (if calls
-           (progn
-             (setq sig (byte-compile-arglist-signature (nth 2 form))
-                   nums (sort (copy-sequence (cdr calls)) (function <))
-                   min (car nums)
-                   max (car (nreverse nums)))
-             (when (or (< min (car sig))
-                     (and (cdr sig) (> max (cdr sig))))
-               (byte-compile-set-symbol-position (nth 1 form))
-               (byte-compile-warn
-                "%s being defined to take %s%s, but was previously called with %s"
-                (nth 1 form)
-                (byte-compile-arglist-signature-string sig)
-                (if (equal sig '(1 . 1)) " arg" " args")
-                (byte-compile-arglist-signature-string (cons min max))))
-
-             (setq byte-compile-unresolved-functions
-                   (delq calls byte-compile-unresolved-functions)))))
-      )))
+       (when calls
+          (when (and (symbolp name)
+                     (eq (get name 'byte-optimizer)
+                         'byte-compile-inline-expand))
+            (byte-compile-warn "defsubst `%s' was used before it was defined"
+                      name))
+          (setq sig (byte-compile-arglist-signature (nth 2 form))
+                nums (sort (copy-sequence (cdr calls)) (function <))
+                min (car nums)
+                max (car (nreverse nums)))
+          (when (or (< min (car sig))
+                    (and (cdr sig) (> max (cdr sig))))
+            (byte-compile-set-symbol-position name)
+            (byte-compile-warn
+             "%s being defined to take %s%s, but was previously called with %s"
+             name
+             (byte-compile-arglist-signature-string sig)
+             (if (equal sig '(1 . 1)) " arg" " args")
+             (byte-compile-arglist-signature-string (cons min max))))
+
+          (setq byte-compile-unresolved-functions
+                (delq calls byte-compile-unresolved-functions)))))))
 
 (defvar byte-compile-cl-functions nil
   "List of functions defined in CL.")
@@ -1470,7 +1468,7 @@ symbol itself."
       (if any-value
          (or (memq symbol byte-compile-const-variables)
              ;; FIXME: We should provide a less intrusive way to find out
-             ;; is a variable is "constant".
+             ;; if a variable is "constant".
              (and (boundp symbol)
                   (condition-case nil
                       (progn (set symbol (symbol-value symbol)) nil)
@@ -2198,9 +2196,8 @@ list that represents a doc string reference.
 ;; byte-hunk-handlers can call this.
 (defun byte-compile-file-form (form)
   (let (bytecomp-handler)
-    (cond ((not (consp form))
-          (byte-compile-keep-pending form))
-         ((and (symbolp (car form))
+    (cond ((and (consp form)
+                (symbolp (car form))
                (setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
           (cond ((setq form (funcall bytecomp-handler form))
                  (byte-compile-flush-pending)
@@ -2212,16 +2209,6 @@ list that represents a doc string reference.
 ;; so make-docfile can recognise them.  Most other things can be output
 ;; as byte-code.
 
-(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
-(defun byte-compile-file-form-defsubst (form)
-  (when (assq (nth 1 form) byte-compile-unresolved-functions)
-    (setq byte-compile-current-form (nth 1 form))
-    (byte-compile-warn "defsubst `%s' was used before it was defined"
-                      (nth 1 form)))
-  (byte-compile-file-form form)
-  ;; Return nil so the form is not output twice.
-  nil)
-
 (put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
 (defun byte-compile-file-form-autoload (form)
   (and (let ((form form))
@@ -2914,7 +2901,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 ;; Given BYTECOMP-BODY, compile it and return a new body.
 (defun byte-compile-top-level-body (bytecomp-body &optional for-effect)
-  ;; FIXME: lexbind.  Check all callers!
   (setq bytecomp-body
        (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t))
   (cond ((eq (car-safe bytecomp-body) 'progn)
@@ -2922,20 +2908,18 @@ If FORM is a lambda or a macro, byte-compile it as a function."
        (bytecomp-body
         (list bytecomp-body))))
 
-;; FIXME: Like defsubst's, this hunk-handler won't be called any more
-;; because the macro is expanded away before we see it.
-(put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function)
-(defun byte-compile-declare-function (form)
-  (push (cons (nth 1 form)
-              (if (and (> (length form) 3)
-                       (listp (nth 3 form)))
-                  (list 'declared (nth 3 form))
+;; Special macro-expander used during byte-compilation.
+(defun byte-compile-macroexpand-declare-function (fn file &rest args)
+  (push (cons fn
+              (if (and (consp args) (listp (car args)))
+                  (list 'declared (car args))
                 t))                     ; arglist not specified
         byte-compile-function-environment)
   ;; We are stating that it _will_ be defined at runtime.
   (setq byte-compile-noruntime-functions
-        (delq (nth 1 form) byte-compile-noruntime-functions))
-  nil)
+        (delq fn byte-compile-noruntime-functions))
+  ;; Delegate the rest to the normal macro definition.
+  (macroexpand `(declare-function ,fn ,file ,@args)))
 
 \f
 ;; This is the recursive entry point for compiling each subform of an
@@ -3005,6 +2989,8 @@ That command is designed for interactive use only" bytecomp-fn))
               '(custom-declare-group custom-declare-variable
                                      custom-declare-face))
         (byte-compile-nogroup-warn form))
+    (when (get (car form) 'byte-obsolete-info)
+      (byte-compile-warn-obsolete (car form)))
     (byte-compile-callargs-warn form))
   (if byte-compile-generate-call-tree
       (byte-compile-annotate-call-tree form))
@@ -3562,7 +3548,6 @@ discarding."
 (byte-defop-compiler-1 setq)
 (byte-defop-compiler-1 setq-default)
 (byte-defop-compiler-1 quote)
-(byte-defop-compiler-1 quote-form)
 
 (defun byte-compile-setq (form)
   (let ((bytecomp-args (cdr form)))
@@ -3606,10 +3591,6 @@ discarding."
 
 (defun byte-compile-quote (form)
   (byte-compile-constant (car (cdr form))))
-
-(defun byte-compile-quote-form (form)
-  (byte-compile-constant (byte-compile-top-level (nth 1 form))))
-
 \f
 ;;; control structures
 
@@ -3845,6 +3826,7 @@ Return the offset in the form (VAR . OFFSET)."
         (byte-compile-push-constant nil)))))
 
 (defun byte-compile-not-lexical-var-p (var)
+  ;; FIXME: this doesn't catch defcustoms!
   (or (not (symbolp var))
       (special-variable-p var)
       (memq var byte-compile-bound-variables)
@@ -4097,15 +4079,16 @@ binding slots have been popped."
 
 (defun byte-compile-defmacro (form)
   ;; This is not used for file-level defmacros with doc strings.
-  ;; FIXME handle decls, use defalias?
-  (let ((decls (byte-compile-defmacro-declaration form))
-       (code (byte-compile-lambda (cdr (cdr form)) t))
-       (for-effect nil))
-    (byte-compile-push-constant (nth 1 form))
-    (byte-compile-push-constant (cons 'macro code))
-    (byte-compile-out 'byte-fset)
-    (byte-compile-discard))
-  (byte-compile-constant (nth 1 form)))
+  (byte-compile-body-do-effect
+   (let ((decls (byte-compile-defmacro-declaration form))
+         (code (byte-compile-byte-code-maker
+                (byte-compile-lambda (cdr (cdr form)) t))))
+     `((defalias ',(nth 1 form)
+         ,(if (eq (car-safe code) 'make-byte-code)
+              `(cons 'macro ,code)
+            `'(macro . ,(eval code))))
+       ,@decls
+       ',(nth 1 form)))))
 
 (defun byte-compile-defvar (form)
   ;; This is not used for file-level defvar/consts with doc strings.
@@ -4153,7 +4136,7 @@ binding slots have been popped."
              `(if (not (default-boundp ',var)) (setq-default ,var ,value))))
        (when (eq fun 'defconst)
          ;; This will signal an appropriate error at runtime.
-         `(eval ',form)))              ;FIXME: lexbind
+         `(eval ',form)))
       `',var))))
 
 (defun byte-compile-autoload (form)
index bc7ecb1..0e4b5d3 100644 (file)
 (defconst cconv-liftwhen 3
   "Try to do lambda lifting if the number of arguments + free variables
 is less than this number.")
-(defvar cconv-mutated nil
-  "List of mutated variables in current form")
-(defvar cconv-captured nil
-  "List of closure captured variables in current form")
-(defvar cconv-captured+mutated nil
-  "An intersection between cconv-mutated and cconv-captured lists.")
-(defvar cconv-lambda-candidates nil
-  "List of candidates for lambda lifting.
-Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).")
-
-(defun cconv-freevars (form &optional fvrs)
-  "Find all free variables of given form.
-Arguments:
--- FORM is a piece of Elisp code after macroexpansion.
--- FVRS(optional) is a list of variables already found.  Used for recursive tree
-traversal
-
-Returns a list of free variables."
-  ;; If a leaf in the tree is a symbol, but it is not a global variable, not a
-  ;; keyword, not 'nil or 't we consider this leaf as a variable.
-  ;; Free variables are the variables that are not declared above in this tree.
-  ;; For example free variables of (lambda (a1 a2 ..) body-forms) are
-  ;; free variables of body-forms excluding a1, a2 ..
-  ;; Free variables of (let ((v1 ..) (v2) ..)) body-forms) are
-  ;; free variables of body-forms excluding v1, v2 ...
-  ;; and so on.
-
-  ;; A list of free variables already found(FVRS) is passed in parameter
-  ;; to try to use cons or push where possible, and to minimize the usage
-  ;; of append.
-
-  ;; This function can return duplicates (because we use 'append instead
-  ;; of union of two sets - for performance reasons).
-  (pcase form
-    (`(let ,varsvalues . ,body-forms)   ; let special form
-     (let ((fvrs-1 '()))
-       (dolist (exp body-forms)
-         (setq fvrs-1 (cconv-freevars exp fvrs-1)))
-       (dolist (elm varsvalues)
-         (setq fvrs-1 (delq (if (consp elm) (car elm) elm) fvrs-1)))
-       (setq fvrs (nconc fvrs-1 fvrs))
-       (dolist (exp varsvalues)
-         (when (consp exp) (setq fvrs (cconv-freevars (cadr exp) fvrs))))
-       fvrs))
-
-    (`(let* ,varsvalues . ,body-forms)  ; let* special form
-     (let ((vrs '())
-           (fvrs-1 '()))
-       (dolist (exp varsvalues)
-         (if (consp exp)
-             (progn
-               (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1))
-               (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1)))
-               (push (car exp) vrs))
-           (progn
-             (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1)))
-             (push exp vrs))))
-       (dolist (exp body-forms)
-         (setq fvrs-1 (cconv-freevars exp fvrs-1)))
-       (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1)))
-       (append fvrs fvrs-1)))
-
-    (`((lambda . ,_) . ,_)             ; first element is lambda expression
-     (dolist (exp `((function ,(car form)) . ,(cdr form)))
-       (setq fvrs (cconv-freevars exp fvrs))) fvrs)
+;; List of all the variables that are both captured by a closure
+;; and mutated.  Each entry in the list takes the form
+;; (BINDER . PARENTFORM) where BINDER is the (VAR VAL) that introduces the
+;; variable (or is just (VAR) for variables not introduced by let).
+(defvar cconv-captured+mutated)
 
-    (`(cond . ,cond-forms)              ; cond special form
-     (dolist (exp1 cond-forms)
-       (dolist (exp2 exp1)
-         (setq fvrs (cconv-freevars exp2 fvrs)))) fvrs)
-
-    (`(quote . ,_) fvrs)                ; quote form
+;; List of candidates for lambda lifting.
+;; Each candidate has the form (BINDER . PARENTFORM).  A candidate
+;; is a variable that is only passed to `funcall' or `apply'.
+(defvar cconv-lambda-candidates)
 
-    (`(function . ((lambda ,vars . ,body-forms)))
-     (let ((functionform (cadr form)) (fvrs-1 '()))
-       (dolist (exp body-forms)
-         (setq fvrs-1 (cconv-freevars exp fvrs-1)))
-       (dolist (elm vars) (setq fvrs-1 (delq elm fvrs-1)))
-       (append fvrs fvrs-1)))           ; function form
-
-    (`(function . ,_) fvrs)             ; same as quote
-                                       ;condition-case
-    (`(condition-case ,var ,protected-form . ,conditions-bodies)
-     (let ((fvrs-1 '()))
-       (dolist (exp conditions-bodies)
-         (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1)))
-       (setq fvrs-1 (delq var fvrs-1))
-       (setq fvrs-1 (cconv-freevars protected-form fvrs-1))
-       (append fvrs fvrs-1)))
-
-    (`(,(and sym (or `defun `defconst `defvar)) . ,_)
-     ;; We call cconv-freevars only for functions(lambdas)
-     ;; defun, defconst, defvar are not allowed to be inside
-     ;; a function (lambda).
-     ;; (error "Invalid form: %s inside a function" sym)
-     (cconv-freevars `(progn ,@(cddr form)) fvrs))
-
-    (`(,_ . ,body-forms)    ; First element is (like) a function.
-     (dolist (exp body-forms)
-       (setq fvrs (cconv-freevars exp fvrs))) fvrs)
-
-    (_ (if (byte-compile-not-lexical-var-p form)
-           fvrs
-         (cons form fvrs)))))
+;; Alist associating to each function body the list of its free variables.
+(defvar cconv-freevars-alist)
 
 ;;;###autoload
 (defun cconv-closure-convert (form)
@@ -195,16 +104,12 @@ Returns a list of free variables."
 
 Returns a form where all lambdas don't have any free variables."
   ;; (message "Entering cconv-closure-convert...")
-  (let ((cconv-mutated '())
+  (let ((cconv-freevars-alist '())
        (cconv-lambda-candidates '())
-       (cconv-captured '())
        (cconv-captured+mutated '()))
     ;; Analyse form - fill these variables with new information.
-    (cconv-analyse-form form '() 0)
-    ;; Calculate an intersection of cconv-mutated and cconv-captured.
-    (dolist (mvr cconv-mutated)
-      (when (memq mvr cconv-captured)   ;
-        (push mvr cconv-captured+mutated)))
+    (cconv-analyse-form form '())
+    (setq cconv-freevars-alist (nreverse cconv-freevars-alist))
     (cconv-closure-convert-rec
      form                               ; the tree
      '()                                ;
@@ -213,15 +118,6 @@ Returns a form where all lambdas don't have any free variables."
      '()
      )))
 
-(defun cconv--lookup-let (table var binder form)
-  (let ((res nil))
-    (dolist (elem table)
-      (when (and (eq (nth 2 elem) binder)
-                 (eq (nth 3 elem) form))
-        (assert (eq (car elem) var))
-        (setq res elem)))
-    res))
-
 (defconst cconv--dummy-var (make-symbol "ignored"))
 
 (defun cconv--set-diff (s1 s2)
@@ -261,6 +157,57 @@ Returns a form where all lambdas don't have any free variables."
       (unless (memq (car b) s) (push b res)))
     (nreverse res)))
 
+(defun cconv-closure-convert-function (fvrs vars emvrs envs lmenvs body-forms
+                                            parentform)
+  (assert (equal body-forms (caar cconv-freevars-alist)))
+  (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs.
+         (fv (cdr (pop cconv-freevars-alist)))
+         (body-forms-new '())
+         (letbind '())
+         (envector nil))
+    (when fv
+      ;; Here we form our environment vector.
+
+      (dolist (elm fv)
+        (push
+         (cconv-closure-convert-rec
+          ;; Remove `elm' from `emvrs' for this call because in case
+          ;; `elm' is a variable that's wrapped in a cons-cell, we
+          ;; want to put the cons-cell itself in the closure, rather
+          ;; than just a copy of its current content.
+          elm (remq elm emvrs) fvrs envs lmenvs)
+         envector))                     ; Process vars for closure vector.
+      (setq envector (reverse envector))
+      (setq envs fv)
+      (setq fvrs-new fv))               ; Update substitution list.
+
+    (setq emvrs (cconv--set-diff emvrs vars))
+    (setq lmenvs (cconv--map-diff-set lmenvs vars))
+       
+    ;; The difference between envs and fvrs is explained
+    ;; in comment in the beginning of the function.
+    (dolist (var vars)
+      (when (member (cons (list var) parentform) cconv-captured+mutated)
+        (push var emvrs)
+        (push `(,var (list ,var)) letbind)))
+    (dolist (elm body-forms)            ; convert function body
+      (push (cconv-closure-convert-rec
+             elm emvrs fvrs-new envs lmenvs)
+            body-forms-new))
+
+    (setq body-forms-new
+          (if letbind `((let ,letbind . ,(reverse body-forms-new)))
+            (reverse body-forms-new)))
+
+    (cond
+                                       ;if no freevars - do nothing
+     ((null envector)
+      `(function (lambda ,vars . ,body-forms-new)))
+                                        ; 1 free variable - do not build vector
+     (t
+      `(internal-make-closure
+        ,vars ,envector . ,body-forms-new)))))
+
 (defun cconv-closure-convert-rec (form emvrs fvrs envs lmenvs)
   ;; This function actually rewrites the tree.
   "Eliminates all free variables of all lambdas in given forms.
@@ -303,15 +250,18 @@ Returns a form where all lambdas don't have any free variables."
        (dolist (binder binders)
          (let* ((value nil)
                 (var (if (not (consp binder))
-                         binder
+                         (prog1 binder (setq binder (list binder)))
                        (setq value (cadr binder))
                        (car binder)))
                 (new-val
                  (cond
                   ;; Check if var is a candidate for lambda lifting.
-                  ((cconv--lookup-let cconv-lambda-candidates var binder form)
-
-                   (let* ((fv (delete-dups (cconv-freevars value '())))
+                  ((member (cons binder form) cconv-lambda-candidates)
+                   (assert (and (eq (car value) 'function)
+                                (eq (car (cadr value)) 'lambda)))
+                   (assert (equal (cddr (cadr value))
+                                  (caar cconv-freevars-alist)))
+                   (let* ((fv (cdr (pop cconv-freevars-alist)))
                           (funargs (cadr (cadr value)))
                           (funcvars (append fv funargs))
                           (funcbodies (cddadr value)) ; function bodies
@@ -338,7 +288,7 @@ Returns a form where all lambdas don't have any free variables."
                                        ,(reverse funcbodies-new))))))))
 
                   ;; Check if it needs to be turned into a "ref-cell".
-                  ((cconv--lookup-let cconv-captured+mutated var binder form)
+                  ((member (cons binder form) cconv-captured+mutated)
                    ;; Declared variable is mutated and captured.
                    (prog1
                        `(list ,(cconv-closure-convert-rec
@@ -404,13 +354,12 @@ Returns a form where all lambdas don't have any free variables."
            ))                          ; end of dolist over binders
        (when (eq letsym 'let)
 
-         (let (var fvrs-1 emvrs-1 lmenvs-1)
-           ;; Here we update emvrs, fvrs and lmenvs lists
-           (setq fvrs (cconv--set-diff-map fvrs binders-new))
-           (setq emvrs (cconv--set-diff-map emvrs binders-new))
-           (setq emvrs (append emvrs emvrs-new))
-           (setq lmenvs (cconv--set-diff-map lmenvs binders-new))
-           (setq lmenvs (append lmenvs lmenvs-new)))
+         ;; Here we update emvrs, fvrs and lmenvs lists
+         (setq fvrs (cconv--set-diff-map fvrs binders-new))
+         (setq emvrs (cconv--set-diff-map emvrs binders-new))
+         (setq emvrs (append emvrs emvrs-new))
+         (setq lmenvs (cconv--set-diff-map lmenvs binders-new))
+         (setq lmenvs (append lmenvs lmenvs-new))
 
          ;; Here we do the same letbinding as for let* above
          ;; to avoid situation when a free variable of a lambda lifted
@@ -478,56 +427,8 @@ Returns a form where all lambdas don't have any free variables."
     (`(quote . ,_) form)
 
     (`(function (lambda ,vars . ,body-forms)) ; function form
-     (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs.
-           (fv (delete-dups (cconv-freevars form '())))
-            (leave fvrs-new) ; leave=non-nil if we should leave env unchanged.
-            (body-forms-new '())
-            (letbind '())
-            (mv nil)
-            (envector nil))
-       (when fv
-         ;; Here we form our environment vector.
-
-         (dolist (elm fv)
-           (push
-            (cconv-closure-convert-rec
-             ;; Remove `elm' from `emvrs' for this call because in case
-             ;; `elm' is a variable that's wrapped in a cons-cell, we
-             ;; want to put the cons-cell itself in the closure, rather
-             ;; than just a copy of its current content.
-             elm (remq elm emvrs) fvrs envs lmenvs)
-            envector))              ; Process vars for closure vector.
-         (setq envector (reverse envector))
-         (setq envs fv)
-         (setq fvrs-new fv))                ; Update substitution list.
-
-       (setq emvrs (cconv--set-diff emvrs vars))
-       (setq lmenvs (cconv--map-diff-set lmenvs vars))
-       
-       ;; The difference between envs and fvrs is explained
-       ;; in comment in the beginning of the function.
-       (dolist (elm cconv-captured+mutated) ; Find mutated arguments
-         (setq mv (car elm))                ; used in inner closures.
-         (when (and (memq mv vars) (eq form (caddr elm)))
-           (progn (push mv emvrs)
-                  (push `(,mv (list ,mv)) letbind))))
-       (dolist (elm body-forms)         ; convert function body
-         (push (cconv-closure-convert-rec
-                elm emvrs fvrs-new envs lmenvs)
-               body-forms-new))
-
-       (setq body-forms-new
-             (if letbind `((let ,letbind . ,(reverse body-forms-new)))
-               (reverse body-forms-new)))
-
-       (cond
-                                       ;if no freevars - do nothing
-        ((null envector)
-         `(function (lambda ,vars . ,body-forms-new)))
-                               ; 1 free variable - do not build vector
-        (t
-         `(internal-make-closure
-           ,vars ,envector . ,body-forms-new)))))
+     (cconv-closure-convert-function
+      fvrs vars emvrs envs lmenvs body-forms form))
 
     (`(internal-make-closure . ,_)
      (error "Internal byte-compiler error: cconv called twice"))
@@ -548,21 +449,21 @@ Returns a form where all lambdas don't have any free variables."
                                        ;defun, defmacro
     (`(,(and sym (or `defun `defmacro))
        ,func ,vars . ,body-forms)
+
+     ;; The freevar data was pushed onto cconv-freevars-alist
+     ;; but we don't need it.
+     (assert (equal body-forms (caar cconv-freevars-alist)))
+     (assert (null (cdar cconv-freevars-alist)))
+     (setq cconv-freevars-alist (cdr cconv-freevars-alist))
+
      (let ((body-new '())        ; The whole body.
            (body-forms-new '())   ; Body w\o docstring and interactive.
            (letbind '()))
                                        ; Find mutable arguments.
        (dolist (elm vars)
-         (let ((lmutated cconv-captured+mutated)
-              (ismutated nil))
-           (while (and lmutated (not ismutated))
-             (when (and (eq (caar lmutated) elm)
-                        (eq (caddar lmutated) form))
-               (setq ismutated t))
-             (setq lmutated (cdr lmutated)))
-           (when ismutated
-             (push elm letbind)
-             (push elm emvrs))))
+         (when (member (cons (list elm) form) cconv-captured+mutated)
+           (push elm letbind)
+           (push elm emvrs)))
                                             ;Transform body-forms.
        (when (stringp (car body-forms))     ; Treat docstring well.
          (push (car body-forms) body-new)
@@ -629,12 +530,13 @@ Returns a form where all lambdas don't have any free variables."
          (setq value
                (cconv-closure-convert-rec
                 (cadr forms) emvrs fvrs envs lmenvs))
-         (if (memq sym emvrs)
-             (push `(setcar ,sym-new ,value) prognlist)
-           (if (symbolp sym-new)
-               (push `(setq ,sym-new ,value) prognlist)
-            (debug)                   ;FIXME: When can this be right?
-             (push `(set ,sym-new ,value) prognlist)))
+         (cond
+          ((memq sym emvrs) (push `(setcar ,sym-new ,value) prognlist))
+          ((symbolp sym-new) (push `(setq ,sym-new ,value) prognlist))
+          ;; This should never happen, but for variables which are
+          ;; mutated+captured+unused, we may end up trying to `setq'
+          ;; on a closed-over variable, so just drop the setq.
+          (t (push value prognlist)))
          (setq forms (cddr forms)))
        (if (cdr prognlist)
            `(progn . ,(reverse prognlist))
@@ -697,54 +599,110 @@ Returns a form where all lambdas don't have any free variables."
              `(car ,form)              ; replace form => (car form)
            form))))))
 
-(defun cconv-analyse-function (args body env parentform inclosure)
-  (dolist (arg args)
-    (cond
-     ((byte-compile-not-lexical-var-p arg)
-      (byte-compile-report-error
-       (format "Argument %S is not a lexical variable" arg)))
-     ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
-     (t (push (list arg inclosure parentform) env)))) ;Push vrs to vars.
-  (dolist (form body)                   ;Analyse body forms.
-    (cconv-analyse-form form env inclosure)))
-
-(defun cconv-analyse-form (form env inclosure)
-  "Find mutated variables and variables captured by closure.  Analyse
-lambdas if they are suitable for lambda lifting.
+(unless (fboundp 'byte-compile-not-lexical-var-p)
+  ;; Only used to test the code in non-lexbind Emacs.
+  (defalias 'byte-compile-not-lexical-var-p 'boundp))
+
+(defun cconv-analyse-use (vardata form)
+  ;; use = `(,binder ,read ,mutated ,captured ,called)
+  (pcase vardata
+    (`(,binder nil ,_ ,_ nil)
+     ;; FIXME: Don't warn about unused fun-args.
+     ;; FIXME: Don't warn about uninterned vars or _ vars.
+     ;; FIXME: This gives warnings in the wrong order and with wrong line
+     ;; number and without function name info.
+     (byte-compile-log-warning (format "Unused variable %S" (car binder))))
+    ;; If it's unused, there's no point converting it into a cons-cell, even if
+    ;; it's captures and mutated.
+    (`(,binder ,_ t t ,_)
+     (push (cons binder form) cconv-captured+mutated))
+    (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t)
+     ;; This is very rare in typical Elisp code.  It's probably not really
+     ;; worth the trouble to try and use lambda-lifting in Elisp, but
+     ;; since we coded it up, we might as well use it.
+     (push (cons binder form) cconv-lambda-candidates))
+    (`(,_ ,_ ,_ ,_ ,_) nil)
+    (dontcare)))
+
+(defun cconv-analyse-function (args body env parentform)
+  (let* ((newvars nil)
+         (freevars (list body))
+         ;; We analyze the body within a new environment where all uses are
+         ;; nil, so we can distinguish uses within that function from uses
+         ;; outside of it.
+         (envcopy
+          (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
+         (newenv envcopy))
+    ;; Push it before recursing, so cconv-freevars-alist contains entries in
+    ;; the order they'll be used by closure-convert-rec.
+    (push freevars cconv-freevars-alist)
+    (dolist (arg args)
+      (cond
+       ((byte-compile-not-lexical-var-p arg)
+        (byte-compile-report-error
+         (format "Argument %S is not a lexical variable" arg)))
+       ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
+       (t (let ((varstruct (list arg nil nil nil nil)))
+            (push (cons (list arg) (cdr varstruct)) newvars)
+            (push varstruct newenv)))))
+    (dolist (form body)                   ;Analyse body forms.
+      (cconv-analyse-form form newenv))
+    ;; Summarize resulting data about arguments.
+    (dolist (vardata newvars)
+      (cconv-analyse-use vardata parentform))
+    ;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
+    ;; and compute free variables.
+    (while env
+      (assert (and envcopy (eq (caar env) (caar envcopy))))
+      (let ((free nil)
+            (x (cdr (car env)))
+            (y (cdr (car envcopy))))
+        (while x
+          (when (car y) (setcar x t) (setq free t))
+          (setq x (cdr x) y (cdr y)))
+        (when free
+          (push (caar env) (cdr freevars))
+          (setf (nth 3 (car env)) t))
+        (setq env (cdr env) envcopy (cdr envcopy))))))
+
+(defun cconv-analyse-form (form env)
+  "Find mutated variables and variables captured by closure.
+Analyse lambdas if they are suitable for lambda lifting.
 -- FORM is a piece of Elisp code after macroexpansion.
--- ENV is a list of variables visible in current lexical environment.
-  Each entry has the form (VAR INCLOSURE BINDER PARENTFORM)
-  for let-bound vars and (VAR INCLOSURE PARENTFORM) for function arguments.
--- INCLOSURE is the nesting level within lambdas."
+-- ENV is an alist mapping each enclosing lexical variable to its info.
+   I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)).
+This function does not return anything but instead fills the
+`cconv-captured+mutated' and `cconv-lambda-candidates' variables
+and updates the data stored in ENV."
   (pcase form
                                        ; let special form
     (`(,(and (or `let* `let) letsym) ,binders . ,body-forms)
 
      (let ((orig-env env)
+           (newvars nil)
            (var nil)
            (value nil))
        (dolist (binder binders)
          (if (not (consp binder))
              (progn
                (setq var binder)      ; treat the form (let (x) ...) well
+               (setq binder (list binder))
                (setq value nil))
            (setq var (car binder))
            (setq value (cadr binder))
 
-           (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)
-                               inclosure))
+           (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)))
 
          (unless (byte-compile-not-lexical-var-p var)
-           (let ((varstruct (list var inclosure binder form)))
-             (push varstruct env)       ; Push a new one.
+           (let ((varstruct (list var nil nil nil nil)))
+             (push (cons binder (cdr varstruct)) newvars)
+             (push varstruct env))))
 
-             (pcase value
-               (`(function (lambda . ,_))
-                ;; If var is a function push it to lambda list.
-                (push varstruct cconv-lambda-candidates)))))))
+       (dolist (form body-forms)          ; Analyse body forms.
+         (cconv-analyse-form form env))
 
-     (dolist (form body-forms)          ; Analyse body forms.
-       (cconv-analyse-form form env inclosure)))
+       (dolist (vardata newvars)
+         (cconv-analyse-use vardata form))))
 
                                        ; defun special form
     (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms)
@@ -753,33 +711,28 @@ lambdas if they are suitable for lambda lifting.
         (format "Function %S will ignore its context %S"
                 func (mapcar #'car env))
         t :warning))
-     (cconv-analyse-function vrs body-forms nil form 0))
+     (cconv-analyse-function vrs body-forms nil form))
 
     (`(function (lambda ,vrs . ,body-forms))
-     (cconv-analyse-function vrs body-forms env form (1+ inclosure)))
+     (cconv-analyse-function vrs body-forms env form))
      
     (`(setq . ,forms)
      ;; If a local variable (member of env) is modified by setq then
      ;; it is a mutated variable.
      (while forms
        (let ((v (assq (car forms) env))) ; v = non nil if visible
-         (when v
-           (push v cconv-mutated)
-           ;; Delete from candidate list for lambda lifting.
-           (setq cconv-lambda-candidates (delq v cconv-lambda-candidates))
-           (unless (eq inclosure (cadr v)) ;Bound in a different closure level.
-             (push v cconv-captured))))
-       (cconv-analyse-form (cadr forms) env inclosure)
+         (when v (setf (nth 2 v) t)))
+       (cconv-analyse-form (cadr forms) env)
        (setq forms (cddr forms))))
 
     (`((lambda . ,_) . ,_)             ; first element is lambda expression
      (dolist (exp `((function ,(car form)) . ,(cdr form)))
-       (cconv-analyse-form exp env inclosure)))
+       (cconv-analyse-form exp env)))
 
     (`(cond . ,cond-forms)              ; cond special form
      (dolist (forms cond-forms)
        (dolist (form forms)
-         (cconv-analyse-form form env inclosure))))
+         (cconv-analyse-form form env))))
 
     (`(quote . ,_) nil)                 ; quote form
     (`(function . ,_) nil)              ; same as quote
@@ -788,63 +741,44 @@ lambdas if they are suitable for lambda lifting.
      ;; FIXME: The bytecode for condition-case forces us to wrap the
      ;; form and handlers in closures (for handlers, it's probably
      ;; unavoidable, but not for the protected form).
-     (setq inclosure (1+ inclosure))
-     (cconv-analyse-form protected-form env inclosure)
-     (push (list var inclosure form) env)
+     (cconv-analyse-function () (list protected-form) env form)
      (dolist (handler handlers)
-       (dolist (form (cdr handler))
-         (cconv-analyse-form form env inclosure))))
+       (cconv-analyse-function (if var (list var)) (cdr handler) env form)))
 
     ;; FIXME: The bytecode for catch forces us to wrap the body.
     (`(,(or `catch `unwind-protect) ,form . ,body)
-     (cconv-analyse-form form env inclosure)
-     (setq inclosure (1+ inclosure))
-     (dolist (form body)
-       (cconv-analyse-form form env inclosure)))
+     (cconv-analyse-form form env)
+     (cconv-analyse-function () body env form))
 
     ;; FIXME: The bytecode for save-window-excursion and the lack of
     ;; bytecode for track-mouse forces us to wrap the body.
     (`(track-mouse . ,body)
-     (setq inclosure (1+ inclosure))
-     (dolist (form body)
-       (cconv-analyse-form form env inclosure)))
+     (cconv-analyse-function () body env form))
 
     (`(,(or `defconst `defvar) ,var ,value . ,_)
      (push var byte-compile-bound-variables)
-     (cconv-analyse-form value env inclosure))
+     (cconv-analyse-form value env))
 
     (`(,(or `funcall `apply) ,fun . ,args)
      ;; Here we ignore fun because funcall and apply are the only two
      ;; functions where we can pass a candidate for lambda lifting as
      ;; argument.  So, if we see fun elsewhere, we'll delete it from
      ;; lambda candidate list.
-     (if (symbolp fun)
-         (let ((lv (assq fun cconv-lambda-candidates)))
-           (when lv
-             (unless (eq (cadr lv) inclosure)
-               (push lv cconv-captured)
-               ;; If this funcall and the definition of fun are in
-               ;; different closures - we delete fun from candidate
-               ;; list, because it is too complicated to manage free
-               ;; variables in this case.
-               (setq cconv-lambda-candidates
-                     (delq lv cconv-lambda-candidates)))))
-       (cconv-analyse-form fun env inclosure))
+     (let ((fdata (and (symbolp fun) (assq fun env))))
+       (if fdata
+           (setf (nth 4 fdata) t)
+         (cconv-analyse-form fun env)))
      (dolist (form args)
-       (cconv-analyse-form form env inclosure)))
+       (cconv-analyse-form form env)))
 
     (`(,_ . ,body-forms)    ; First element is a function or whatever.
      (dolist (form body-forms)
-       (cconv-analyse-form form env inclosure)))
+       (cconv-analyse-form form env)))
 
     ((pred symbolp)
      (let ((dv (assq form env)))        ; dv = declared and visible
        (when dv
-         (unless (eq inclosure (cadr dv)) ; capturing condition
-           (push dv cconv-captured))
-         ;; Delete lambda if it is found here, since it escapes.
-         (setq cconv-lambda-candidates
-               (delq dv cconv-lambda-candidates)))))))
+         (setf (nth 1 dv) t))))))
 
 (provide 'cconv)
 ;;; cconv.el ends here
index 0b2ea81..0bdab91 100644 (file)
@@ -269,6 +269,7 @@ That buffer should be current already."
   (setq buffer-undo-list t)
   (let ((standard-output (current-buffer))
        (print-escape-newlines t)
+        (print-quoted t)                ;Doesn't seem to work :-(
        (print-level 1000)              ;8
        ;; (print-length 50)
         )
index 781195d..4377797 100644 (file)
@@ -1,4 +1,4 @@
-;;; macroexp.el --- Additional macro-expansion support
+;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*-
 ;;
 ;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
 ;;
@@ -108,7 +108,14 @@ Assumes the caller has bound `macroexpand-all-environment'."
       (macroexpand (macroexpand-all-forms form 1)
                   macroexpand-all-environment)
     ;; Normal form; get its expansion, and then expand arguments.
-    (setq form (macroexpand form macroexpand-all-environment))
+    (let ((new-form (macroexpand form macroexpand-all-environment)))
+      (when (and (not (eq form new-form)) ;It was a macro call.
+                 (car-safe form)
+                 (symbolp (car form))
+                 (get (car form) 'byte-obsolete-info)
+                 (fboundp 'byte-compile-warn-obsolete))
+        (byte-compile-warn-obsolete (car form)))
+      (setq form new-form))
     (pcase form
       (`(cond . ,clauses)
        (maybe-cons 'cond (macroexpand-all-clauses clauses) form))
index 7e6d4e7..7f4093d 100644 (file)
@@ -871,8 +871,7 @@ Returns (end-pos end-of-buffer-p)"
       ;; XEmacs can calculate the end of the window by using
       ;; the 'guarantee options. GOOD!
       (let ((end (window-end win t)))
-       (if (= end (funcall (symbol-function 'point-max)
-                           (window-buffer win)))
+       (if (= end (point-max (window-buffer win)))
            (list end t)
          (list (+ end 1) nil)))
     ;; Emacs: We have to calculate the end by ourselves.
index 13d10f0..59e442a 100644 (file)
@@ -1,4 +1,4 @@
-;;; diff-mode.el --- a mode for viewing/editing context diffs
+;;; diff-mode.el --- a mode for viewing/editing context diffs -*- lexical-binding: t -*-
 
 ;; Copyright (C) 1998-2011  Free Software Foundation, Inc.
 
@@ -1278,7 +1278,7 @@ a diff with \\[diff-reverse-direction].
     (add-hook 'after-change-functions 'diff-after-change-function nil t)
     (add-hook 'post-command-hook 'diff-post-command-hook nil t))
   ;; Neat trick from Dave Love to add more bindings in read-only mode:
-  (lexical-let ((ro-bind (cons 'buffer-read-only diff-mode-shared-map)))
+  (let ((ro-bind (cons 'buffer-read-only diff-mode-shared-map)))
     (add-to-list 'minor-mode-overriding-map-alist ro-bind)
     ;; Turn off this little trick in case the buffer is put in view-mode.
     (add-hook 'view-mode-hook
index 464bc3d..9693a5a 100644 (file)
@@ -51,7 +51,7 @@ by Hallvard:
  *
  * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
  */
-/* #define BYTE_CODE_SAFE */
+#define BYTE_CODE_SAFE 1
 /* #define BYTE_CODE_METER */
 
 \f