X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f619ad4ca2ce943d53589469c010e451afab97dd..876c194cbac17a6220dbf406b0a602325978011c:/lisp/emacs-lisp/bytecomp.el

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 8892a27b29..6bc2b3b561 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -794,10 +794,13 @@ CONST2 may be evaulated multiple times."
                ;; goto
                (byte-compile-push-bytecodes opcode nil (cdr off) bytes pc)
                (push bytes patchlist)) 
-              ((and (consp off)
-                    ;; Variable or constant reference
-                    (progn (setq off (cdr off))
-                           (eq op 'byte-constant)))
+              ((or (and (consp off)
+                        ;; Variable or constant reference
+                        (progn
+                          (setq off (cdr off))
+                          (eq op 'byte-constant)))
+                   (and (eq op 'byte-constant) ;; 'byte-closed-var
+                        (integerp off)))
                ;; constant ref
                (if (< off byte-constant-limit)
                    (byte-compile-push-bytecodes (+ byte-constant off)
@@ -1480,6 +1483,7 @@ symbol itself."
 	 ((byte-compile-const-symbol-p ,form))))
 
 (defmacro byte-compile-close-variables (&rest body)
+  (declare (debug t))
   (cons 'let
 	(cons '(;;
 		;; Close over these variables to encapsulate the
@@ -1510,6 +1514,7 @@ symbol itself."
 	      body)))
 
 (defmacro displaying-byte-compile-warnings (&rest body)
+  (declare (debug t))
   `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body))
 	  (warning-series-started
 	   (and (markerp warning-series)
@@ -1930,7 +1935,7 @@ With argument ARG, insert value in current buffer after the form."
               (byte-compile-warn "!! The file uses old-style backquotes !!
 This functionality has been obsolete for more than 10 years already
 and will be removed soon.  See (elisp)Backquote in the manual."))
-	    (byte-compile-file-form form)))
+	    (byte-compile-toplevel-file-form form)))
 	;; Compile pending forms at end of file.
 	(byte-compile-flush-pending)
 	;; Make warnings about unresolved functions
@@ -2041,8 +2046,8 @@ Call from the source buffer."
   ;; defalias calls are output directly by byte-compile-file-form-defmumble;
   ;; it does not pay to first build the defalias in defmumble and then parse
   ;; it here.
-  (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst autoload
-				   custom-declare-variable))
+  (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst
+                                    autoload custom-declare-variable))
 	   (stringp (nth 3 form)))
       (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
 				   (memq (car form)
@@ -2182,12 +2187,17 @@ list that represents a doc string reference.
 	      byte-compile-maxdepth 0
 	      byte-compile-output nil))))
 
-(defun byte-compile-file-form (form)
-  (let ((byte-compile-current-form nil)	; close over this for warnings.
-	bytecomp-handler)
+;; byte-hunk-handlers cannot call this!
+(defun byte-compile-toplevel-file-form (form)
+  (let ((byte-compile-current-form nil))	; close over this for warnings.
     (setq form (macroexpand-all form byte-compile-macro-environment))
     (if lexical-binding
         (setq form (cconv-closure-convert form)))
+    (byte-compile-file-form form)))
+
+;; 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))
@@ -2541,7 +2551,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
              (if lexical-binding
                  (setq fun (cconv-closure-convert fun)))
 	     ;; Get rid of the `function' quote added by the `lambda' macro.
-	     (setq fun (cadr fun))
+	     (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
 	     (setq fun (if macro
 			   (cons 'macro (byte-compile-lambda fun))
 			 (byte-compile-lambda fun)))
@@ -2654,7 +2664,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; of the list FUN and `byte-compile-set-symbol-position' is not called.
 ;; Use this feature to avoid calling `byte-compile-set-symbol-position'
 ;; for symbols generated by the byte compiler itself.
-(defun byte-compile-lambda (bytecomp-fun &optional add-lambda)
+(defun byte-compile-lambda (bytecomp-fun &optional add-lambda reserved-csts)
   (if add-lambda
       (setq bytecomp-fun (cons 'lambda bytecomp-fun))
     (unless (eq 'lambda (car-safe bytecomp-fun))
@@ -2702,14 +2712,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	     (byte-compile-warn "malformed interactive spec: %s"
 				(prin1-to-string bytecomp-int)))))
     ;; Process the body.
-    (let* ((byte-compile-lexical-environment
-	    ;; If doing lexical binding, push a new lexical environment
-	    ;; containing just the args (since lambda expressions
-	    ;; should be closed by now).
-	    (and lexical-binding
-		 (byte-compile-make-lambda-lexenv bytecomp-fun)))
-	   (compiled
-	    (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda)))
+    (let* ((compiled
+	    (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda
+                                    ;; If doing lexical binding, push a new
+                                    ;; lexical environment containing just the
+                                    ;; args (since lambda expressions should be
+                                    ;; closed by now).
+                                    (and lexical-binding
+                                         (byte-compile-make-lambda-lexenv
+                                          bytecomp-fun))
+                                    reserved-csts)))
       ;; Build the actual byte-coded function.
       (if (eq 'byte-code (car-safe compiled))
           (apply 'make-byte-code
@@ -2740,6 +2752,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
     ;; A simple lambda is just a constant.
     (byte-compile-constant code)))
 
+(defvar byte-compile-reserved-constants 0)
+
 (defun byte-compile-constants-vector ()
   ;; Builds the constants-vector from the current variables and constants.
   ;;   This modifies the constants from (const . nil) to (const . offset).
@@ -2748,7 +2762,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   ;;   Next up to byte-constant-limit are constants, still with one-byte codes.
   ;;   Next variables again, to get 2-byte codes for variable lookup.
   ;;   The rest of the constants and variables need 3-byte byte-codes.
-  (let* ((i -1)
+  (let* ((i (1- byte-compile-reserved-constants))
 	 (rest (nreverse byte-compile-variables)) ; nreverse because the first
 	 (other (nreverse byte-compile-constants)) ; vars often are used most.
 	 ret tmp
@@ -2759,11 +2773,15 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	 limit)
     (while (or rest other)
       (setq limit (car limits))
-      (while (and rest (not (eq i limit)))
-	(if (setq tmp (assq (car (car rest)) ret))
-	    (setcdr (car rest) (cdr tmp))
+      (while (and rest (< i limit))
+	(cond
+	 ((numberp (car rest))
+	  (assert (< (car rest) byte-compile-reserved-constants)))
+	 ((setq tmp (assq (car (car rest)) ret))
+	  (setcdr (car rest) (cdr tmp)))
+	 (t
 	  (setcdr (car rest) (setq i (1+ i)))
-	  (setq ret (cons (car rest) ret)))
+	  (setq ret (cons (car rest) ret))))
 	(setq rest (cdr rest)))
       (setq limits (cdr limits)
 	    rest (prog1 other
@@ -2772,7 +2790,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 ;; Given an expression FORM, compile it and return an equivalent byte-code
 ;; expression (a call to the function byte-code).
-(defun byte-compile-top-level (form &optional for-effect output-type)
+(defun byte-compile-top-level (form &optional for-effect output-type
+                                    lexenv reserved-csts)
   ;; OUTPUT-TYPE advises about how form is expected to be used:
   ;;	'eval or nil	-> a single form,
   ;;	'progn or t	-> a list of forms,
@@ -2783,9 +2802,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	(byte-compile-tag-number 0)
 	(byte-compile-depth 0)
 	(byte-compile-maxdepth 0)
-        (byte-compile-lexical-environment
-         (when (eq output-type 'lambda)
-           byte-compile-lexical-environment))
+        (byte-compile-lexical-environment lexenv)
+        (byte-compile-reserved-constants (or reserved-csts 0))
 	(byte-compile-output nil))
     (if (memq byte-optimize '(t source))
 	(setq form (byte-optimize-form form for-effect)))
@@ -2904,6 +2922,8 @@ 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)
@@ -2950,12 +2970,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 		(memq bytecomp-fn byte-compile-interactive-only-functions)
 		(byte-compile-warn "`%s' used from Lisp code\n\
 That command is designed for interactive use only" bytecomp-fn))
-	   (when (byte-compile-warning-enabled-p 'callargs)
-	     (if (memq bytecomp-fn
-		       '(custom-declare-group custom-declare-variable
-					      custom-declare-face))
-                 (byte-compile-nogroup-warn form))
-	     (byte-compile-callargs-warn form))
            (if (and (fboundp (car form))
                     (eq (car-safe (symbol-function (car form))) 'macro))
                (byte-compile-report-error
@@ -2985,6 +2999,13 @@ That command is designed for interactive use only" bytecomp-fn))
       (byte-compile-discard)))
 
 (defun byte-compile-normal-call (form)
+  (when (and (byte-compile-warning-enabled-p 'callargs)
+             (symbolp (car form)))
+    (if (memq (car form)
+              '(custom-declare-group custom-declare-variable
+                                     custom-declare-face))
+        (byte-compile-nogroup-warn form))
+    (byte-compile-callargs-warn form))
   (if byte-compile-generate-call-tree
       (byte-compile-annotate-call-tree form))
   (when (and for-effect (eq (car form) 'mapcar)
@@ -3037,7 +3058,7 @@ If BINDING is non-nil, VAR is being bound."
 		  (boundp var)
 		  (memq var byte-compile-bound-variables)
 		  (memq var byte-compile-free-references))
-	(byte-compile-warn "reference to free variable `%s'" var)
+	(byte-compile-warn "reference to free variable `%S'" var)
 	(push var byte-compile-free-references))
       (byte-compile-dynamic-variable-op 'byte-varref var))))
 
@@ -3082,26 +3103,6 @@ If BINDING is non-nil, VAR is being bound."
 (defun byte-compile-push-constant (const)
   (let ((for-effect nil))
     (inline (byte-compile-constant const))))
-
-(defun byte-compile-push-unknown-constant (&optional id)
-  "Generate code to push a `constant' who's value isn't known yet.
-A tag is returned which may then later be passed to
-`byte-compile-resolve-unknown-constant' to finalize the value.
-The optional argument ID is a tag returned by an earlier call to
-`byte-compile-push-unknown-constant', in which case the same constant is
-pushed again."
-  (unless id
-    (setq id (list (make-symbol "unknown")))
-    (push id byte-compile-constants))
-  (byte-compile-out 'byte-constant id)
-  id)
-
-(defun byte-compile-resolve-unknown-constant (id value)
-  "Give an `unknown constant' a value.
-ID is the tag returned by `byte-compile-push-unknown-constant'.  and VALUE
-is the value it should have."
-  (setcar id value))
-
 
 ;; Compile those primitive ordinary functions
 ;; which have special byte codes just for speed.
@@ -3339,6 +3340,29 @@ discarding."
   "Output byte codes to store the top-of-stack value at position STACK-POS in the stack."
   (byte-compile-out 'byte-stack-set (- byte-compile-depth (1+ stack-pos))))
 
+(byte-defop-compiler-1 internal-make-closure byte-compile-make-closure)
+(byte-defop-compiler-1 internal-get-closed-var byte-compile-get-closed-var)
+
+(defconst byte-compile--env-var (make-symbol "env"))
+
+(defun byte-compile-make-closure (form)
+  (if for-effect (setq for-effect nil)
+    (let* ((vars (nth 1 form))
+           (env (nth 2 form))
+           (body (nthcdr 3 form))
+           (fun
+            (byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
+      (assert (byte-code-function-p fun))
+      (byte-compile-form `(make-byte-code
+                           ',(aref fun 0) ',(aref fun 1)
+                           (vconcat (vector . ,env) ',(aref fun 2))
+                           ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun)))))))
+    
+
+(defun byte-compile-get-closed-var (form)
+  (if for-effect (setq for-effect nil)
+    (byte-compile-out 'byte-constant ;; byte-closed-var
+                      (nth 1 form))))
 
 ;; Compile a function that accepts one or more args and is right-associative.
 ;; We do it by left-associativity so that the operations