;; 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)
((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
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)
(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
;; 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)
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))
(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)))
;; 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))
(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
;; 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).
;; 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
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
;; 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,
(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)))
(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)
(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
(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)
(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))))
(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))
-
\f
;; Compile those primitive ordinary functions
;; which have special byte codes just for speed.
"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