mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-28 10:56:36 +00:00
Miscellanous cleanups in preparation for the merge.
* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove debug statement. * lisp/emacs-lisp/bytecomp.el (byte-compile-single-version) (byte-compile-version-cond, byte-compile-delay-out) (byte-compile-delayed-out): Remove, unused. * src/bytecode.c (Fbyte_code): Revert to old calling convention. * src/lisp.h (COMPILED_PUSH_ARGS): Remove, unused.
This commit is contained in:
Stefan Monnier
parent
40d83b412f
commit
7200d79c65
@ -1137,7 +1137,7 @@ by @code{funcall}, and they are represented by a cons cell whose @code{car} is
|
||||
the symbol @code{closure}.
|
||||
|
||||
@menu
|
||||
* Converting to Lexical Binding:: How to start using lexical scoping
|
||||
* Converting to Lexical Binding:: How to start using lexical scoping
|
||||
@end menu
|
||||
|
||||
@node Converting to Lexical Binding
|
||||
|
||||
@ -17,7 +17,7 @@ It is typically set via file-local variables, in which case it applies to
|
||||
all the code in that file.
|
||||
|
||||
** Lexically scoped interpreted functions are represented with a new form
|
||||
of function value which looks like (closure ENV lambda ARGS &rest BODY).
|
||||
of function value which looks like (closure ENV ARGS &rest BODY).
|
||||
** New macro `letrec' to define recursive local functions.
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
@ -1,3 +1,12 @@
|
||||
2011-04-01 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/bytecomp.el (byte-compile-single-version)
|
||||
(byte-compile-version-cond, byte-compile-delay-out)
|
||||
(byte-compile-delayed-out): Remove, unused.
|
||||
|
||||
* emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
|
||||
Remove debug statement.
|
||||
|
||||
2011-03-30 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* subr.el (apply-partially): Use a non-nil static environment.
|
||||
|
||||
@ -206,8 +206,8 @@ compile-onefile:
|
||||
@echo Compiling $(THEFILE)
|
||||
@# Use byte-compile-refresh-preloaded to try and work around some of
|
||||
@# the most common bootstrapping problems.
|
||||
@$(emacs) $(BYTE_COMPILE_FLAGS) -l bytecomp \
|
||||
-f byte-compile-refresh-preloaded \
|
||||
@$(emacs) $(BYTE_COMPILE_FLAGS) \
|
||||
-l bytecomp -f byte-compile-refresh-preloaded \
|
||||
-f batch-byte-compile $(THEFILE)
|
||||
|
||||
# Files MUST be compiled one by one. If we compile several files in a
|
||||
@ -292,7 +292,7 @@ compile-always: doit
|
||||
compile-calc:
|
||||
for el in $(lisp)/calc/*.el; do \
|
||||
echo Compiling $$el; \
|
||||
$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \
|
||||
$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1;\
|
||||
done
|
||||
|
||||
# Backup compiled Lisp files in elc.tar.gz. If that file already
|
||||
|
||||
@ -3484,6 +3484,9 @@ Automatically called by the Emacs Lisp byte compiler as a
|
||||
(macroexpand-all
|
||||
(wisent-automaton-lisp-form (eval form)))))
|
||||
|
||||
;; FIXME: We shouldn't use a `byte-compile' handler. Maybe using a hash-table
|
||||
;; instead of an obarray would work around the problem that obarrays
|
||||
;; aren't printable. Then (put 'wisent-compile-grammar 'side-effect-free t).
|
||||
(put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar)
|
||||
|
||||
(defun wisent-automaton-lisp-form (automaton)
|
||||
|
||||
@ -534,7 +534,6 @@
|
||||
(cons fn (mapcar #'byte-optimize-form (cdr form))))
|
||||
|
||||
((not (symbolp fn))
|
||||
(debug)
|
||||
(byte-compile-warn "`%s' is a malformed function"
|
||||
(prin1-to-string fn))
|
||||
form)
|
||||
@ -1455,8 +1454,7 @@
|
||||
byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
|
||||
byte-point-min byte-following-char byte-preceding-char
|
||||
byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
|
||||
byte-current-buffer byte-stack-ref ;; byte-closed-var
|
||||
))
|
||||
byte-current-buffer byte-stack-ref))
|
||||
|
||||
(defconst byte-compile-side-effect-free-ops
|
||||
(nconc
|
||||
@ -2029,7 +2027,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
|
||||
(+ (cdr lap0) (cdr lap1))))
|
||||
(setq lap (delq lap0 lap))
|
||||
(setcdr lap1 (+ (cdr lap1) (cdr lap0))))
|
||||
|
||||
|
||||
;;
|
||||
;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos
|
||||
;; stack-set-M [discard/discardN ...] --> discardN
|
||||
@ -2053,10 +2051,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
|
||||
(setq lap (delq lap0 lap))
|
||||
(setcar lap1
|
||||
(if (= tmp2 tmp3)
|
||||
;; The value stored is the new TOS, so pop
|
||||
;; one more value (to get rid of the old
|
||||
;; value) using the TOS-preserving
|
||||
;; discard operator.
|
||||
;; The value stored is the new TOS, so pop one more
|
||||
;; value (to get rid of the old value) using the
|
||||
;; TOS-preserving discard operator.
|
||||
'byte-discardN-preserve-tos
|
||||
;; Otherwise, the value stored is lost, so just use a
|
||||
;; normal discard.
|
||||
@ -2071,8 +2068,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
|
||||
;; discardN-(X+Y)
|
||||
;;
|
||||
((and (memq (car lap0)
|
||||
'(byte-discard
|
||||
byte-discardN
|
||||
'(byte-discard byte-discardN
|
||||
byte-discardN-preserve-tos))
|
||||
(memq (car lap1) '(byte-discard byte-discardN)))
|
||||
(setq lap (delq lap0 lap))
|
||||
|
||||
@ -128,10 +128,6 @@
|
||||
|
||||
;; The feature of compiling in a specific target Emacs version
|
||||
;; has been turned off because compile time options are a bad idea.
|
||||
(defmacro byte-compile-single-version () nil)
|
||||
(defmacro byte-compile-version-cond (cond) cond)
|
||||
|
||||
|
||||
(defgroup bytecomp nil
|
||||
"Emacs Lisp byte-compiler."
|
||||
:group 'lisp)
|
||||
@ -404,9 +400,7 @@ specify different fields to sort on."
|
||||
:type '(choice (const name) (const callers) (const calls)
|
||||
(const calls+callers) (const nil)))
|
||||
|
||||
(defvar byte-compile-debug t)
|
||||
(setq debug-on-error t)
|
||||
|
||||
(defvar byte-compile-debug nil)
|
||||
(defvar byte-compile-constants nil
|
||||
"List of all constants encountered during compilation of this form.")
|
||||
(defvar byte-compile-variables nil
|
||||
@ -465,7 +459,7 @@ Used for warnings about calling a function that is defined during compilation
|
||||
but won't necessarily be defined when the compiled file is loaded.")
|
||||
|
||||
;; Variables for lexical binding
|
||||
(defvar byte-compile-lexical-environment nil
|
||||
(defvar byte-compile--lexical-environment nil
|
||||
"The current lexical environment.")
|
||||
|
||||
(defvar byte-compile-tag-number 0)
|
||||
@ -586,6 +580,7 @@ Each element is (INDEX . VALUE)")
|
||||
(byte-defop 114 0 byte-save-current-buffer
|
||||
"To make a binding to record the current buffer")
|
||||
(byte-defop 115 0 byte-set-mark-OBSOLETE)
|
||||
;; (byte-defop 116 1 byte-interactive-p) ;Let's not use it any more.
|
||||
|
||||
;; These ops are new to v19
|
||||
(byte-defop 117 0 byte-forward-char)
|
||||
@ -621,6 +616,8 @@ otherwise pop it")
|
||||
|
||||
(byte-defop 138 0 byte-save-excursion
|
||||
"to make a binding to record the buffer, point and mark")
|
||||
;; (byte-defop 139 0 byte-save-window-excursion ; Obsolete: It's a macro now.
|
||||
;; "to make a binding to record entire window configuration")
|
||||
(byte-defop 140 0 byte-save-restriction
|
||||
"to make a binding to record the current buffer clipping restrictions")
|
||||
(byte-defop 141 -1 byte-catch
|
||||
@ -632,16 +629,8 @@ otherwise pop it")
|
||||
;; an expression for the body, and a list of clauses.
|
||||
(byte-defop 143 -2 byte-condition-case)
|
||||
|
||||
;; For entry to with-output-to-temp-buffer.
|
||||
;; Takes, on stack, the buffer name.
|
||||
;; Binds standard-output and does some other things.
|
||||
;; Returns with temp buffer on the stack in place of buffer name.
|
||||
;; Obsolete: `with-output-to-temp-buffer' is a macro now.
|
||||
;; (byte-defop 144 0 byte-temp-output-buffer-setup)
|
||||
|
||||
;; For exit from with-output-to-temp-buffer.
|
||||
;; Expects the temp buffer on the stack underneath value to return.
|
||||
;; Pops them both, then pushes the value back on.
|
||||
;; Unbinds standard-output and makes the temp buffer visible.
|
||||
;; (byte-defop 145 -1 byte-temp-output-buffer-show)
|
||||
|
||||
;; these ops are new to v19
|
||||
@ -675,15 +664,14 @@ otherwise pop it")
|
||||
(byte-defop 168 0 byte-integerp)
|
||||
|
||||
;; unused: 169-174
|
||||
|
||||
(byte-defop 175 nil byte-listN)
|
||||
(byte-defop 176 nil byte-concatN)
|
||||
(byte-defop 177 nil byte-insertN)
|
||||
|
||||
(byte-defop 178 -1 byte-stack-set) ; stack offset in following one byte
|
||||
(byte-defop 179 -1 byte-stack-set2) ; stack offset in following two bytes
|
||||
(byte-defop 178 -1 byte-stack-set) ; Stack offset in following one byte.
|
||||
(byte-defop 179 -1 byte-stack-set2) ; Stack offset in following two bytes.
|
||||
|
||||
;; if (following one byte & 0x80) == 0
|
||||
;; If (following one byte & 0x80) == 0
|
||||
;; discard (following one byte & 0x7F) stack entries
|
||||
;; else
|
||||
;; discard (following one byte & 0x7F) stack entries _underneath_ TOS
|
||||
@ -776,12 +764,6 @@ CONST2 may be evaulated multiple times."
|
||||
(error "Non-symbolic opcode `%s'" op))
|
||||
((eq op 'TAG)
|
||||
(setcar off pc))
|
||||
((null op)
|
||||
;; a no-op added by `byte-compile-delay-out'
|
||||
(unless (zerop off)
|
||||
(error
|
||||
"Placeholder added by `byte-compile-delay-out' not filled in.")
|
||||
))
|
||||
(t
|
||||
(setq opcode
|
||||
(if (eq op 'byte-discardN-preserve-tos)
|
||||
@ -793,13 +775,13 @@ CONST2 may be evaulated multiple times."
|
||||
(cond ((memq op byte-goto-ops)
|
||||
;; goto
|
||||
(byte-compile-push-bytecodes opcode nil (cdr off) bytes pc)
|
||||
(push bytes patchlist))
|
||||
(push bytes patchlist))
|
||||
((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
|
||||
(and (eq op 'byte-constant)
|
||||
(integerp off)))
|
||||
;; constant ref
|
||||
(if (< off byte-constant-limit)
|
||||
@ -847,10 +829,9 @@ CONST2 may be evaulated multiple times."
|
||||
bytes pc))))))
|
||||
;;(if (not (= pc (length bytes)))
|
||||
;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes)))
|
||||
|
||||
;; Patch tag PCs into absolute jumps
|
||||
;; Patch tag PCs into absolute jumps.
|
||||
(dolist (bytes-tail patchlist)
|
||||
(setq pc (caar bytes-tail)) ; Pick PC from goto's tag
|
||||
(setq pc (caar bytes-tail)) ; Pick PC from goto's tag.
|
||||
(setcar (cdr bytes-tail) (logand pc 255))
|
||||
(setcar bytes-tail (lsh pc -8))
|
||||
;; FIXME: Replace this by some workaround.
|
||||
@ -1861,10 +1842,10 @@ With argument ARG, insert value in current buffer after the form."
|
||||
|
||||
;; Dynamically bound in byte-compile-from-buffer.
|
||||
;; NB also used in cl.el and cl-macs.el.
|
||||
(defvar byte-compile-outbuffer)
|
||||
(defvar byte-compile--outbuffer)
|
||||
|
||||
(defun byte-compile-from-buffer (inbuffer)
|
||||
(let (byte-compile-outbuffer
|
||||
(let (byte-compile--outbuffer
|
||||
(byte-compile-current-buffer inbuffer)
|
||||
(byte-compile-read-position nil)
|
||||
(byte-compile-last-position nil)
|
||||
@ -1893,7 +1874,8 @@ With argument ARG, insert value in current buffer after the form."
|
||||
)
|
||||
(byte-compile-close-variables
|
||||
(with-current-buffer
|
||||
(setq byte-compile-outbuffer (get-buffer-create " *Compiler Output*"))
|
||||
(setq byte-compile--outbuffer
|
||||
(get-buffer-create " *Compiler Output*"))
|
||||
(set-buffer-multibyte t)
|
||||
(erase-buffer)
|
||||
;; (emacs-lisp-mode)
|
||||
@ -1902,7 +1884,7 @@ With argument ARG, insert value in current buffer after the form."
|
||||
(with-current-buffer inbuffer
|
||||
(and byte-compile-current-file
|
||||
(byte-compile-insert-header byte-compile-current-file
|
||||
byte-compile-outbuffer))
|
||||
byte-compile--outbuffer))
|
||||
(goto-char (point-min))
|
||||
;; Should we always do this? When calling multiple files, it
|
||||
;; would be useful to delay this warning until all have been
|
||||
@ -1935,9 +1917,9 @@ and will be removed soon. See (elisp)Backquote in the manual."))
|
||||
;; Fix up the header at the front of the output
|
||||
;; if the buffer contains multibyte characters.
|
||||
(and byte-compile-current-file
|
||||
(with-current-buffer byte-compile-outbuffer
|
||||
(with-current-buffer byte-compile--outbuffer
|
||||
(byte-compile-fix-header byte-compile-current-file)))))
|
||||
byte-compile-outbuffer))
|
||||
byte-compile--outbuffer))
|
||||
|
||||
(defun byte-compile-fix-header (filename)
|
||||
"If the current buffer has any multibyte characters, insert a version test."
|
||||
@ -2046,8 +2028,8 @@ Call from the source buffer."
|
||||
(print-gensym t)
|
||||
(print-circle ; handle circular data structures
|
||||
(not byte-compile-disable-print-circle)))
|
||||
(princ "\n" byte-compile-outbuffer)
|
||||
(prin1 form byte-compile-outbuffer)
|
||||
(princ "\n" byte-compile--outbuffer)
|
||||
(prin1 form byte-compile--outbuffer)
|
||||
nil)))
|
||||
|
||||
(defvar print-gensym-alist) ;Used before print-circle existed.
|
||||
@ -2067,7 +2049,7 @@ list that represents a doc string reference.
|
||||
;; We need to examine byte-compile-dynamic-docstrings
|
||||
;; in the input buffer (now current), not in the output buffer.
|
||||
(let ((dynamic-docstrings byte-compile-dynamic-docstrings))
|
||||
(with-current-buffer byte-compile-outbuffer
|
||||
(with-current-buffer byte-compile--outbuffer
|
||||
(let (position)
|
||||
|
||||
;; Insert the doc string, and make it a comment with #@LENGTH.
|
||||
@ -2091,7 +2073,7 @@ list that represents a doc string reference.
|
||||
(if preface
|
||||
(progn
|
||||
(insert preface)
|
||||
(prin1 name byte-compile-outbuffer)))
|
||||
(prin1 name byte-compile--outbuffer)))
|
||||
(insert (car info))
|
||||
(let ((print-escape-newlines t)
|
||||
(print-quoted t)
|
||||
@ -2106,7 +2088,7 @@ list that represents a doc string reference.
|
||||
(print-continuous-numbering t)
|
||||
print-number-table
|
||||
(index 0))
|
||||
(prin1 (car form) byte-compile-outbuffer)
|
||||
(prin1 (car form) byte-compile--outbuffer)
|
||||
(while (setq form (cdr form))
|
||||
(setq index (1+ index))
|
||||
(insert " ")
|
||||
@ -2129,21 +2111,22 @@ list that represents a doc string reference.
|
||||
(setq position (- (position-bytes position)
|
||||
(point-min) -1))
|
||||
(princ (format "(#$ . %d) nil" position)
|
||||
byte-compile-outbuffer)
|
||||
byte-compile--outbuffer)
|
||||
(setq form (cdr form))
|
||||
(setq index (1+ index))))
|
||||
((= index (nth 1 info))
|
||||
(if position
|
||||
(princ (format (if quoted "'(#$ . %d)" "(#$ . %d)")
|
||||
position)
|
||||
byte-compile-outbuffer)
|
||||
byte-compile--outbuffer)
|
||||
(let ((print-escape-newlines nil))
|
||||
(goto-char (prog1 (1+ (point))
|
||||
(prin1 (car form) byte-compile-outbuffer)))
|
||||
(prin1 (car form)
|
||||
byte-compile--outbuffer)))
|
||||
(insert "\\\n")
|
||||
(goto-char (point-max)))))
|
||||
(t
|
||||
(prin1 (car form) byte-compile-outbuffer)))))
|
||||
(prin1 (car form) byte-compile--outbuffer)))))
|
||||
(insert (nth 2 info)))))
|
||||
nil)
|
||||
|
||||
@ -2428,7 +2411,7 @@ by side-effects."
|
||||
;; Remove declarations from the body of the macro definition.
|
||||
(when macrop
|
||||
(dolist (decl (byte-compile-defmacro-declaration form))
|
||||
(prin1 decl byte-compile-outbuffer)))
|
||||
(prin1 decl byte-compile--outbuffer)))
|
||||
|
||||
(let* ((code (byte-compile-lambda (nthcdr 2 form) t)))
|
||||
(if this-one
|
||||
@ -2458,7 +2441,7 @@ by side-effects."
|
||||
(and (atom code) byte-compile-dynamic
|
||||
1)
|
||||
nil))
|
||||
(princ ")" byte-compile-outbuffer)
|
||||
(princ ")" byte-compile--outbuffer)
|
||||
nil)))
|
||||
|
||||
;; Print Lisp object EXP in the output file, inside a comment,
|
||||
@ -2466,13 +2449,13 @@ by side-effects."
|
||||
;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
|
||||
(defun byte-compile-output-as-comment (exp quoted)
|
||||
(let ((position (point)))
|
||||
(with-current-buffer byte-compile-outbuffer
|
||||
(with-current-buffer byte-compile--outbuffer
|
||||
|
||||
;; Insert EXP, and make it a comment with #@LENGTH.
|
||||
(insert " ")
|
||||
(if quoted
|
||||
(prin1 exp byte-compile-outbuffer)
|
||||
(princ exp byte-compile-outbuffer))
|
||||
(prin1 exp byte-compile--outbuffer)
|
||||
(princ exp byte-compile--outbuffer))
|
||||
(goto-char position)
|
||||
;; Quote certain special characters as needed.
|
||||
;; get_doc_string in doc.c does the unquoting.
|
||||
@ -2732,7 +2715,7 @@ 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 lexenv)
|
||||
(byte-compile--lexical-environment lexenv)
|
||||
(byte-compile-reserved-constants (or reserved-csts 0))
|
||||
(byte-compile-output nil))
|
||||
(if (memq byte-optimize '(t source))
|
||||
@ -2743,7 +2726,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
||||
(when (and lexical-binding (eq output-type 'lambda))
|
||||
;; See how many arguments there are, and set the current stack depth
|
||||
;; accordingly.
|
||||
(setq byte-compile-depth (length byte-compile-lexical-environment))
|
||||
(setq byte-compile-depth (length byte-compile--lexical-environment))
|
||||
;; If there are args, output a tag to record the initial
|
||||
;; stack-depth for the optimizer.
|
||||
(when (> byte-compile-depth 0)
|
||||
@ -2789,7 +2772,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
||||
;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
|
||||
;; file -> as progn, but takes both quotes and atoms, and longer forms.
|
||||
(let (rest
|
||||
(byte-compile--for-effect for-effect) ;FIXME: Probably unused!
|
||||
(maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
|
||||
tmp body)
|
||||
(cond
|
||||
@ -2975,6 +2957,7 @@ That command is designed for interactive use only" fn))
|
||||
(byte-compile-out-tag endtag)))
|
||||
|
||||
(defun byte-compile-unfold-bcf (form)
|
||||
"Inline call to byte-code-functions."
|
||||
(let* ((byte-compile-bound-variables byte-compile-bound-variables)
|
||||
(fun (car form))
|
||||
(fargs (aref fun 0))
|
||||
@ -3056,7 +3039,7 @@ If BINDING is non-nil, VAR is being bound."
|
||||
(defun byte-compile-variable-ref (var)
|
||||
"Generate code to push the value of the variable VAR on the stack."
|
||||
(byte-compile-check-variable var)
|
||||
(let ((lex-binding (assq var byte-compile-lexical-environment)))
|
||||
(let ((lex-binding (assq var byte-compile--lexical-environment)))
|
||||
(if lex-binding
|
||||
;; VAR is lexically bound
|
||||
(byte-compile-stack-ref (cdr lex-binding))
|
||||
@ -3072,7 +3055,7 @@ If BINDING is non-nil, VAR is being bound."
|
||||
(defun byte-compile-variable-set (var)
|
||||
"Generate code to set the variable VAR from the top-of-stack value."
|
||||
(byte-compile-check-variable var)
|
||||
(let ((lex-binding (assq var byte-compile-lexical-environment)))
|
||||
(let ((lex-binding (assq var byte-compile--lexical-environment)))
|
||||
(if lex-binding
|
||||
;; VAR is lexically bound
|
||||
(byte-compile-stack-set (cdr lex-binding))
|
||||
@ -3181,6 +3164,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
|
||||
(byte-defop-compiler bobp 0)
|
||||
(byte-defop-compiler current-buffer 0)
|
||||
;;(byte-defop-compiler read-char 0) ;; obsolete
|
||||
;; (byte-defop-compiler interactive-p 0) ;; Obsolete.
|
||||
(byte-defop-compiler widen 0)
|
||||
(byte-defop-compiler end-of-line 0-1)
|
||||
(byte-defop-compiler forward-char 0-1)
|
||||
@ -3355,6 +3339,7 @@ discarding."
|
||||
(defconst byte-compile--env-var (make-symbol "env"))
|
||||
|
||||
(defun byte-compile-make-closure (form)
|
||||
"Byte-compile the special `internal-make-closure' form."
|
||||
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
|
||||
(let* ((vars (nth 1 form))
|
||||
(env (nth 2 form))
|
||||
@ -3366,12 +3351,11 @@ discarding."
|
||||
',(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)
|
||||
"Byte-compile the special `internal-get-closed-var' form."
|
||||
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
|
||||
(byte-compile-out 'byte-constant ;; byte-closed-var
|
||||
(nth 1 form))))
|
||||
(byte-compile-out 'byte-constant (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
|
||||
@ -3856,7 +3840,7 @@ Return the offset in the form (VAR . OFFSET)."
|
||||
(keywordp var)))
|
||||
|
||||
(defun byte-compile-bind (var init-lexenv)
|
||||
"Emit byte-codes to bind VAR and update `byte-compile-lexical-environment'.
|
||||
"Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'.
|
||||
INIT-LEXENV should be a lexical-environment alist describing the
|
||||
positions of the init value that have been pushed on the stack.
|
||||
Return non-nil if the TOS value was popped."
|
||||
@ -3866,7 +3850,7 @@ Return non-nil if the TOS value was popped."
|
||||
(cond ((not (byte-compile-not-lexical-var-p var))
|
||||
;; VAR is a simple stack-allocated lexical variable
|
||||
(push (assq var init-lexenv)
|
||||
byte-compile-lexical-environment)
|
||||
byte-compile--lexical-environment)
|
||||
nil)
|
||||
((eq var (caar init-lexenv))
|
||||
;; VAR is dynamic and is on the top of the
|
||||
@ -3898,7 +3882,7 @@ binding slots have been popped."
|
||||
(let ((num-dynamic-bindings 0))
|
||||
(dolist (clause clauses)
|
||||
(unless (assq (if (consp clause) (car clause) clause)
|
||||
byte-compile-lexical-environment)
|
||||
byte-compile--lexical-environment)
|
||||
(setq num-dynamic-bindings (1+ num-dynamic-bindings))))
|
||||
(unless (zerop num-dynamic-bindings)
|
||||
(byte-compile-out 'byte-unbind num-dynamic-bindings)))
|
||||
@ -3918,7 +3902,8 @@ binding slots have been popped."
|
||||
(push (byte-compile-push-binding-init var) init-lexenv)))
|
||||
;; New scope.
|
||||
(let ((byte-compile-bound-variables byte-compile-bound-variables)
|
||||
(byte-compile-lexical-environment byte-compile-lexical-environment))
|
||||
(byte-compile--lexical-environment
|
||||
byte-compile--lexical-environment))
|
||||
;; Bind the variables.
|
||||
;; For `let', do it in reverse order, because it makes no
|
||||
;; semantic difference, but it is a lot more efficient since the
|
||||
@ -3969,7 +3954,6 @@ binding slots have been popped."
|
||||
"Compiler error: `%s' has no `byte-compile-negated-op' property"
|
||||
(car form)))
|
||||
(cdr form))))
|
||||
|
||||
|
||||
;;; other tricky macro-like special-forms
|
||||
|
||||
@ -3979,6 +3963,8 @@ binding slots have been popped."
|
||||
(byte-defop-compiler-1 save-excursion)
|
||||
(byte-defop-compiler-1 save-current-buffer)
|
||||
(byte-defop-compiler-1 save-restriction)
|
||||
;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro.
|
||||
;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro.
|
||||
(byte-defop-compiler-1 track-mouse)
|
||||
|
||||
(defun byte-compile-catch (form)
|
||||
@ -4286,7 +4272,7 @@ OP and OPERAND are as passed to `byte-compile-out'."
|
||||
;; that take OPERAND values off the stack and push a result, for
|
||||
;; a total of 1 - OPERAND
|
||||
(- 1 operand))))
|
||||
|
||||
|
||||
(defun byte-compile-out (op &optional operand)
|
||||
(push (cons op operand) byte-compile-output)
|
||||
(if (eq op 'byte-return)
|
||||
@ -4298,50 +4284,6 @@ OP and OPERAND are as passed to `byte-compile-out'."
|
||||
(setq byte-compile-maxdepth (max byte-compile-depth byte-compile-maxdepth))
|
||||
;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
|
||||
))
|
||||
|
||||
(defun byte-compile-delay-out (&optional stack-used stack-adjust)
|
||||
"Add a placeholder to the output, which can be used to later add byte-codes.
|
||||
Return a position tag that can be passed to `byte-compile-delayed-out'
|
||||
to add the delayed byte-codes. STACK-USED is the maximum amount of
|
||||
stack-spaced used by the delayed byte-codes (defaulting to 0), and
|
||||
STACK-ADJUST is the amount by which the later-added code will adjust the
|
||||
stack (defaulting to 0); the byte-codes added later _must_ adjust the
|
||||
stack by this amount! If STACK-ADJUST is 0, then it's not necessary to
|
||||
actually add anything later; the effect as if nothing was added at all."
|
||||
;; We just add a no-op to `byte-compile-output', and return a pointer to
|
||||
;; the tail of the list; `byte-compile-delayed-out' uses list surgery
|
||||
;; to add the byte-codes.
|
||||
(when stack-used
|
||||
(setq byte-compile-maxdepth
|
||||
(max byte-compile-depth (+ byte-compile-depth (or stack-used 0)))))
|
||||
(when stack-adjust
|
||||
(setq byte-compile-depth
|
||||
(+ byte-compile-depth stack-adjust)))
|
||||
(push (cons nil (or stack-adjust 0)) byte-compile-output))
|
||||
|
||||
(defun byte-compile-delayed-out (position op &optional operand)
|
||||
"Add at POSITION the byte-operation OP, with optional numeric arg OPERAND.
|
||||
POSITION should a position returned by `byte-compile-delay-out'.
|
||||
Return a new position, which can be used to add further operations."
|
||||
(unless (null (caar position))
|
||||
(error "Bad POSITION arg to `byte-compile-delayed-out'"))
|
||||
;; This is kind of like `byte-compile-out', but we splice into the list
|
||||
;; where POSITION is. We don't bother updating `byte-compile-maxdepth'
|
||||
;; because that was already done by `byte-compile-delay-out', but we do
|
||||
;; update the relative operand stored in the no-op marker currently at
|
||||
;; POSITION; since we insert before that marker, this means that if the
|
||||
;; caller doesn't insert a sequence of byte-codes that matches the expected
|
||||
;; operand passed to `byte-compile-delay-out', then the nop will still have
|
||||
;; a non-zero operand when `byte-compile-lapcode' is called, which will
|
||||
;; cause an error to be signaled.
|
||||
|
||||
;; Adjust the cumulative stack-adjustment stored in the cdr of the no-op
|
||||
(setcdr (car position)
|
||||
(- (cdar position) (byte-compile-stack-adjustment op operand)))
|
||||
;; Add the new operation onto the list tail at POSITION
|
||||
(setcdr position (cons (cons op operand) (cdr position)))
|
||||
position)
|
||||
|
||||
|
||||
;;; call tree stuff
|
||||
|
||||
|
||||
@ -67,15 +67,23 @@
|
||||
|
||||
;; TODO: (not just for cconv but also for the lexbind changes in general)
|
||||
;; - let (e)debug find the value of lexical variables from the stack.
|
||||
;; - make eval-region do the eval-sexp-add-defvars danse.
|
||||
;; - byte-optimize-form should be applied before cconv.
|
||||
;; OTOH, the warnings emitted by cconv-analyze need to come before optimize
|
||||
;; since afterwards they can because obnoxious (warnings about an "unused
|
||||
;; variable" should not be emitted when the variable use has simply been
|
||||
;; optimized away).
|
||||
;; - turn defun and defmacro into macros (and remove special handling of
|
||||
;; `declare' afterwards).
|
||||
;; - let macros specify that some let-bindings come from the same source,
|
||||
;; so the unused warning takes all uses into account.
|
||||
;; - let interactive specs return a function to build the args (to stash into
|
||||
;; command-history).
|
||||
;; - canonize code in macro-expand so we don't have to handle (let (var) body)
|
||||
;; and other oddities.
|
||||
;; - new byte codes for unwind-protect, catch, and condition-case so that
|
||||
;; closures aren't needed at all.
|
||||
;; - inline source code of different binding mode by first compiling it.
|
||||
;; - a reference to a var that is known statically to always hold a constant
|
||||
;; should be turned into a byte-constant rather than a byte-stack-ref.
|
||||
;; Hmm... right, that's called constant propagation and could be done here,
|
||||
|
||||
@ -282,7 +282,7 @@ Not documented
|
||||
;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist
|
||||
;;;;;; do* do loop return-from return block etypecase typecase ecase
|
||||
;;;;;; case load-time-value eval-when destructuring-bind function*
|
||||
;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "c4734fbda33043d967624d39d80c3304")
|
||||
;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "fe8a5acbe14e32846a77578b2165fab5")
|
||||
;;; Generated autoloads from cl-macs.el
|
||||
|
||||
(autoload 'gensym "cl-macs" "\
|
||||
|
||||
@ -497,7 +497,7 @@ The result of the body appears to the compiler as a quoted constant."
|
||||
(symbol-function 'byte-compile-file-form)))
|
||||
(list 'byte-compile-file-form (list 'quote set))
|
||||
'(byte-compile-file-form form)))
|
||||
(print set (symbol-value 'byte-compile-outbuffer)))
|
||||
(print set (symbol-value 'byte-compile--outbuffer)))
|
||||
(list 'symbol-value (list 'quote temp)))
|
||||
(list 'quote (eval form))))
|
||||
|
||||
|
||||
@ -278,9 +278,9 @@ definitions to shadow the loaded ones for use in file byte-compilation.
|
||||
(defvar cl-compiling-file nil)
|
||||
(defun cl-compiling-file ()
|
||||
(or cl-compiling-file
|
||||
(and (boundp 'byte-compile-outbuffer)
|
||||
(bufferp (symbol-value 'byte-compile-outbuffer))
|
||||
(equal (buffer-name (symbol-value 'byte-compile-outbuffer))
|
||||
(and (boundp 'byte-compile--outbuffer)
|
||||
(bufferp (symbol-value 'byte-compile--outbuffer))
|
||||
(equal (buffer-name (symbol-value 'byte-compile--outbuffer))
|
||||
" *Compiler Output*"))))
|
||||
|
||||
(defvar cl-proclaims-deferred nil)
|
||||
|
||||
@ -72,7 +72,6 @@ redefine OBJECT if it is a symbol."
|
||||
(let ((macro 'nil)
|
||||
(name 'nil)
|
||||
(doc 'nil)
|
||||
(lexical-binding nil)
|
||||
args)
|
||||
(while (symbolp obj)
|
||||
(setq name obj
|
||||
|
||||
@ -3640,7 +3640,7 @@ Return the result of the last expression."
|
||||
(eval (if (bound-and-true-p cl-debug-env)
|
||||
(cl-macroexpand-all edebug-expr cl-debug-env)
|
||||
edebug-expr)
|
||||
lexical-binding)) ;; FIXME: lexbind.
|
||||
lexical-binding))
|
||||
|
||||
(defun edebug-safe-eval (edebug-expr)
|
||||
;; Evaluate EXPR safely.
|
||||
|
||||
@ -96,6 +96,7 @@ default setting for optimization purposes.")
|
||||
"Non-nil means to optimize the method dispatch on primary methods.")
|
||||
|
||||
;; State Variables
|
||||
;; FIXME: These two constants below should have an `eieio-' prefix added!!
|
||||
(defvar this nil
|
||||
"Inside a method, this variable is the object in question.
|
||||
DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots.
|
||||
@ -122,7 +123,7 @@ execute a `call-next-method'. DO NOT SET THIS YOURSELF!")
|
||||
;; while it is being built itself.
|
||||
(defvar eieio-default-superclass nil)
|
||||
|
||||
;; FIXME: The constants below should have a `eieio-' prefix added!!
|
||||
;; FIXME: The constants below should have an `eieio-' prefix added!!
|
||||
(defconst class-symbol 1 "Class's symbol (self-referencing.).")
|
||||
(defconst class-parent 2 "Class parent slot.")
|
||||
(defconst class-children 3 "Class children class slot.")
|
||||
|
||||
@ -745,7 +745,7 @@ POS specifies the starting position where EXP was found and defaults to point."
|
||||
(unless (special-variable-p var)
|
||||
(push var vars))))
|
||||
`(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
|
||||
|
||||
|
||||
(defun eval-last-sexp (eval-last-sexp-arg-internal)
|
||||
"Evaluate sexp before point; print value in minibuffer.
|
||||
Interactively, with prefix argument, print output into current buffer.
|
||||
|
||||
@ -1,3 +1,8 @@
|
||||
2011-04-01 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* bytecode.c (Fbyte_code): Revert to old calling convention.
|
||||
* lisp.h (COMPILED_PUSH_ARGS): Remove, unused.
|
||||
|
||||
2011-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* image.c (parse_image_spec): Use Ffunctionp.
|
||||
|
||||
@ -51,7 +51,7 @@ by Hallvard:
|
||||
*
|
||||
* define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
|
||||
*/
|
||||
#define BYTE_CODE_SAFE 1
|
||||
/* #define BYTE_CODE_SAFE */
|
||||
/* #define BYTE_CODE_METER */
|
||||
|
||||
|
||||
@ -160,7 +160,7 @@ extern Lisp_Object Qand_optional, Qand_rest;
|
||||
#ifdef BYTE_CODE_SAFE
|
||||
#define Bset_mark 0163 /* this loser is no longer generated as of v18 */
|
||||
#endif
|
||||
#define Binteractive_p 0164 /* Obsolete. */
|
||||
#define Binteractive_p 0164 /* Obsolete since Emacs-24.1. */
|
||||
|
||||
#define Bforward_char 0165
|
||||
#define Bforward_word 0166
|
||||
@ -185,16 +185,16 @@ extern Lisp_Object Qand_optional, Qand_rest;
|
||||
#define Bdup 0211
|
||||
|
||||
#define Bsave_excursion 0212
|
||||
#define Bsave_window_excursion 0213 /* Obsolete. */
|
||||
#define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1. */
|
||||
#define Bsave_restriction 0214
|
||||
#define Bcatch 0215
|
||||
|
||||
#define Bunwind_protect 0216
|
||||
#define Bcondition_case 0217
|
||||
#define Btemp_output_buffer_setup 0220 /* Obsolete. */
|
||||
#define Btemp_output_buffer_show 0221 /* Obsolete. */
|
||||
#define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1. */
|
||||
#define Btemp_output_buffer_show 0221 /* Obsolete since Emacs-24.1. */
|
||||
|
||||
#define Bunbind_all 0222 /* Obsolete. */
|
||||
#define Bunbind_all 0222 /* Obsolete. Never used. */
|
||||
|
||||
#define Bset_marker 0223
|
||||
#define Bmatch_beginning 0224
|
||||
@ -413,24 +413,15 @@ unmark_byte_stack (void)
|
||||
} while (0)
|
||||
|
||||
|
||||
DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, MANY, 0,
|
||||
DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
|
||||
doc: /* Function used internally in byte-compiled code.
|
||||
The first argument, BYTESTR, is a string of byte code;
|
||||
the second, VECTOR, a vector of constants;
|
||||
the third, MAXDEPTH, the maximum stack depth used in this function.
|
||||
If the third argument is incorrect, Emacs may crash.
|
||||
|
||||
If ARGS-TEMPLATE is specified, it is an argument list specification,
|
||||
according to which any remaining arguments are pushed on the stack
|
||||
before executing BYTESTR.
|
||||
|
||||
usage: (byte-code BYTESTR VECTOR MAXDEP &optional ARGS-TEMPLATE &rest ARGS) */)
|
||||
(size_t nargs, Lisp_Object *args)
|
||||
If the third argument is incorrect, Emacs may crash. */)
|
||||
(Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
|
||||
{
|
||||
Lisp_Object args_tmpl = nargs >= 4 ? args[3] : Qnil;
|
||||
int pnargs = nargs >= 4 ? nargs - 4 : 0;
|
||||
Lisp_Object *pargs = nargs >= 4 ? args + 4 : 0;
|
||||
return exec_byte_code (args[0], args[1], args[2], args_tmpl, pnargs, pargs);
|
||||
return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
|
||||
}
|
||||
|
||||
/* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and
|
||||
@ -810,7 +801,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
||||
AFTER_POTENTIAL_GC ();
|
||||
break;
|
||||
|
||||
case Bunbind_all: /* Obsolete. */
|
||||
case Bunbind_all: /* Obsolete. Never used. */
|
||||
/* To unbind back to the beginning of this frame. Not used yet,
|
||||
but will be needed for tail-recursion elimination. */
|
||||
BEFORE_POTENTIAL_GC ();
|
||||
@ -938,12 +929,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
||||
save_excursion_save ());
|
||||
break;
|
||||
|
||||
case Bsave_current_buffer: /* Obsolete. */
|
||||
case Bsave_current_buffer: /* Obsolete since ??. */
|
||||
case Bsave_current_buffer_1:
|
||||
record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
|
||||
break;
|
||||
|
||||
case Bsave_window_excursion: /* Obsolete. */
|
||||
case Bsave_window_excursion: /* Obsolete since 24.1. */
|
||||
{
|
||||
register int count = SPECPDL_INDEX ();
|
||||
record_unwind_protect (Fset_window_configuration,
|
||||
@ -985,7 +976,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
||||
break;
|
||||
}
|
||||
|
||||
case Btemp_output_buffer_setup: /* Obsolete. */
|
||||
case Btemp_output_buffer_setup: /* Obsolete since 24.1. */
|
||||
BEFORE_POTENTIAL_GC ();
|
||||
CHECK_STRING (TOP);
|
||||
temp_output_buffer_setup (SSDATA (TOP));
|
||||
@ -993,7 +984,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
||||
TOP = Vstandard_output;
|
||||
break;
|
||||
|
||||
case Btemp_output_buffer_show: /* Obsolete. */
|
||||
case Btemp_output_buffer_show: /* Obsolete since 24.1. */
|
||||
{
|
||||
Lisp_Object v1;
|
||||
BEFORE_POTENTIAL_GC ();
|
||||
@ -1465,7 +1456,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
||||
AFTER_POTENTIAL_GC ();
|
||||
break;
|
||||
|
||||
case Binteractive_p: /* Obsolete. */
|
||||
case Binteractive_p: /* Obsolete since 24.1. */
|
||||
PUSH (Finteractive_p ());
|
||||
break;
|
||||
|
||||
|
||||
@ -171,8 +171,8 @@ static void
|
||||
fix_command (Lisp_Object input, Lisp_Object values)
|
||||
{
|
||||
/* FIXME: Instead of this ugly hack, we should provide a way for an
|
||||
interactive spec to return an expression that will re-build the args
|
||||
without user intervention. */
|
||||
interactive spec to return an expression/function that will re-build the
|
||||
args without user intervention. */
|
||||
if (CONSP (input))
|
||||
{
|
||||
Lisp_Object car;
|
||||
|
||||
15
src/eval.c
15
src/eval.c
@ -117,10 +117,10 @@ Lisp_Object Vsignaling_function;
|
||||
|
||||
int handling_signal;
|
||||
|
||||
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
|
||||
static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object *);
|
||||
static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
|
||||
static int interactive_p (int);
|
||||
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
|
||||
|
||||
void
|
||||
init_eval_once (void)
|
||||
@ -684,7 +684,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
|
||||
tail = Fcons (lambda_list, tail);
|
||||
else
|
||||
tail = Fcons (lambda_list, Fcons (doc, tail));
|
||||
|
||||
|
||||
defn = Fcons (Qlambda, tail);
|
||||
if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */
|
||||
defn = Ffunction (Fcons (defn, Qnil));
|
||||
@ -1012,11 +1012,8 @@ usage: (let* VARLIST BODY...) */)
|
||||
|
||||
varlist = XCDR (varlist);
|
||||
}
|
||||
|
||||
UNGCPRO;
|
||||
|
||||
val = Fprogn (Fcdr (args));
|
||||
|
||||
return unbind_to (count, val);
|
||||
}
|
||||
|
||||
@ -2083,7 +2080,8 @@ then strings and vectors are not accepted. */)
|
||||
return Qnil;
|
||||
funcar = XCAR (fun);
|
||||
if (EQ (funcar, Qclosure))
|
||||
return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
|
||||
return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))))
|
||||
? Qt : if_prop);
|
||||
else if (EQ (funcar, Qlambda))
|
||||
return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
|
||||
else if (EQ (funcar, Qautoload))
|
||||
@ -2898,7 +2896,7 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
|
||||
/* The caller should GCPRO all the elements of ARGS. */
|
||||
|
||||
DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
|
||||
doc: /* Return non-nil if OBJECT is a type of object that can be called as a function. */)
|
||||
doc: /* Non-nil if OBJECT is a function. */)
|
||||
(Lisp_Object object)
|
||||
{
|
||||
if (SYMBOLP (object) && !NILP (Ffboundp (object)))
|
||||
@ -3220,7 +3218,7 @@ funcall_lambda (Lisp_Object fun, size_t nargs,
|
||||
xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
|
||||
else
|
||||
val = Qnil;
|
||||
|
||||
|
||||
/* Bind the argument. */
|
||||
if (!NILP (lexenv) && SYMBOLP (next))
|
||||
/* Lexically bind NEXT by adding it to the lexenv alist. */
|
||||
@ -3501,7 +3499,6 @@ context where binding is lexical by default. */)
|
||||
}
|
||||
|
||||
|
||||
|
||||
DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
|
||||
doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
|
||||
The debugger is entered when that frame exits, if the flag is non-nil. */)
|
||||
|
||||
@ -1483,7 +1483,6 @@ typedef unsigned char UCHAR;
|
||||
#define COMPILED_STACK_DEPTH 3
|
||||
#define COMPILED_DOC_STRING 4
|
||||
#define COMPILED_INTERACTIVE 5
|
||||
#define COMPILED_PUSH_ARGS 6
|
||||
|
||||
/* Flag bits in a character. These also get used in termhooks.h.
|
||||
Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
|
||||
@ -3264,7 +3263,7 @@ extern int read_bytecode_char (int);
|
||||
|
||||
/* Defined in bytecode.c */
|
||||
extern Lisp_Object Qbytecode;
|
||||
EXFUN (Fbyte_code, MANY);
|
||||
EXFUN (Fbyte_code, 3);
|
||||
extern void syms_of_bytecode (void);
|
||||
extern struct byte_stack *byte_stack_list;
|
||||
#ifdef BYTE_MARK_STACK
|
||||
|
||||
33
src/lread.c
33
src/lread.c
@ -796,16 +796,16 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
|
||||
} beg_end_state = NOMINAL;
|
||||
int in_file_vars = 0;
|
||||
|
||||
#define UPDATE_BEG_END_STATE(ch) \
|
||||
if (beg_end_state == NOMINAL) \
|
||||
beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
|
||||
else if (beg_end_state == AFTER_FIRST_DASH) \
|
||||
beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
|
||||
else if (beg_end_state == AFTER_ASTERIX) \
|
||||
{ \
|
||||
if (ch == '-') \
|
||||
in_file_vars = !in_file_vars; \
|
||||
beg_end_state = NOMINAL; \
|
||||
#define UPDATE_BEG_END_STATE(ch) \
|
||||
if (beg_end_state == NOMINAL) \
|
||||
beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
|
||||
else if (beg_end_state == AFTER_FIRST_DASH) \
|
||||
beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
|
||||
else if (beg_end_state == AFTER_ASTERIX) \
|
||||
{ \
|
||||
if (ch == '-') \
|
||||
in_file_vars = !in_file_vars; \
|
||||
beg_end_state = NOMINAL; \
|
||||
}
|
||||
|
||||
/* Skip until we get to the file vars, if any. */
|
||||
@ -834,7 +834,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
|
||||
UPDATE_BEG_END_STATE (ch);
|
||||
ch = READCHAR;
|
||||
}
|
||||
|
||||
|
||||
while (var_end > var
|
||||
&& (var_end[-1] == ' ' || var_end[-1] == '\t'))
|
||||
var_end--;
|
||||
@ -880,7 +880,6 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
|
||||
return rv;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Value is a version number of byte compiled code if the file
|
||||
associated with file descriptor FD is a compiled Lisp file that's
|
||||
@ -1275,7 +1274,6 @@ Return t if the file exists and loads successfully. */)
|
||||
specbind (Qinhibit_file_name_operation, Qnil);
|
||||
load_descriptor_list
|
||||
= Fcons (make_number (fileno (stream)), load_descriptor_list);
|
||||
|
||||
specbind (Qload_in_progress, Qt);
|
||||
|
||||
instream = stream;
|
||||
@ -1863,11 +1861,9 @@ This function preserves the position of point. */)
|
||||
|
||||
specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
|
||||
specbind (Qstandard_output, tem);
|
||||
specbind (Qlexical_binding, Qnil);
|
||||
record_unwind_protect (save_excursion_restore, save_excursion_save ());
|
||||
BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
|
||||
if (lisp_file_lexically_bound_p (buf))
|
||||
Fset (Qlexical_binding, Qt);
|
||||
specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil);
|
||||
readevalloop (buf, 0, filename,
|
||||
!NILP (printflag), unibyte, Qnil, Qnil, Qnil);
|
||||
unbind_to (count, Qnil);
|
||||
@ -3336,7 +3332,6 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
|
||||
for (i = 0; i < size; i++)
|
||||
{
|
||||
item = Fcar (tem);
|
||||
|
||||
/* If `load-force-doc-strings' is t when reading a lazily-loaded
|
||||
bytecode object, the docstring containing the bytecode and
|
||||
constants values must be treated as unibyte and passed to
|
||||
@ -3394,7 +3389,6 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
|
||||
tem = Fcdr (tem);
|
||||
free_cons (otem);
|
||||
}
|
||||
|
||||
return vector;
|
||||
}
|
||||
|
||||
@ -4024,7 +4018,6 @@ defvar_lisp (struct Lisp_Objfwd *o_fwd,
|
||||
staticpro (address);
|
||||
}
|
||||
|
||||
|
||||
/* Similar but define a variable whose value is the Lisp Object stored
|
||||
at a particular offset in the current kboard object. */
|
||||
|
||||
@ -4470,7 +4463,7 @@ to load. See also `load-dangerous-libraries'. */);
|
||||
doc: /* If non-nil, use lexical binding when evaluating code.
|
||||
This only applies to code evaluated by `eval-buffer' and `eval-region'.
|
||||
This variable is automatically set from the file variables of an interpreted
|
||||
lisp file read using `load'. */);
|
||||
Lisp file read using `load'. */);
|
||||
Fmake_variable_buffer_local (Qlexical_binding);
|
||||
|
||||
DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list,
|
||||
|
||||
@ -3649,6 +3649,7 @@ displaying that buffer. */)
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
temp_output_buffer_show (register Lisp_Object buf)
|
||||
{
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
;; Copyright (C) 2011 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;; Keywords:
|
||||
;; Keywords:
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
@ -20,7 +20,7 @@
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user