Commit 7200d79c authored by Stefan Monnier's avatar Stefan Monnier

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.
parent 40d83b41
...@@ -1137,7 +1137,7 @@ by @code{funcall}, and they are represented by a cons cell whose @code{car} is ...@@ -1137,7 +1137,7 @@ by @code{funcall}, and they are represented by a cons cell whose @code{car} is
the symbol @code{closure}. the symbol @code{closure}.
@menu @menu
* Converting to Lexical Binding:: How to start using lexical scoping * Converting to Lexical Binding:: How to start using lexical scoping
@end menu @end menu
@node Converting to Lexical Binding @node Converting to Lexical Binding
......
...@@ -17,7 +17,7 @@ It is typically set via file-local variables, in which case it applies to ...@@ -17,7 +17,7 @@ It is typically set via file-local variables, in which case it applies to
all the code in that file. all the code in that file.
** Lexically scoped interpreted functions are represented with a new form ** 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. ** New macro `letrec' to define recursive local functions.
---------------------------------------------------------------------- ----------------------------------------------------------------------
......
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> 2011-03-30 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (apply-partially): Use a non-nil static environment. * subr.el (apply-partially): Use a non-nil static environment.
......
...@@ -206,8 +206,8 @@ compile-onefile: ...@@ -206,8 +206,8 @@ compile-onefile:
@echo Compiling $(THEFILE) @echo Compiling $(THEFILE)
@# Use byte-compile-refresh-preloaded to try and work around some of @# Use byte-compile-refresh-preloaded to try and work around some of
@# the most common bootstrapping problems. @# the most common bootstrapping problems.
@$(emacs) $(BYTE_COMPILE_FLAGS) -l bytecomp \ @$(emacs) $(BYTE_COMPILE_FLAGS) \
-f byte-compile-refresh-preloaded \ -l bytecomp -f byte-compile-refresh-preloaded \
-f batch-byte-compile $(THEFILE) -f batch-byte-compile $(THEFILE)
# Files MUST be compiled one by one. If we compile several files in a # Files MUST be compiled one by one. If we compile several files in a
...@@ -292,7 +292,7 @@ compile-always: doit ...@@ -292,7 +292,7 @@ compile-always: doit
compile-calc: compile-calc:
for el in $(lisp)/calc/*.el; do \ for el in $(lisp)/calc/*.el; do \
echo Compiling $$el; \ 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 done
# Backup compiled Lisp files in elc.tar.gz. If that file already # 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 ...@@ -3484,6 +3484,9 @@ Automatically called by the Emacs Lisp byte compiler as a
(macroexpand-all (macroexpand-all
(wisent-automaton-lisp-form (eval form))))) (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) (put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar)
(defun wisent-automaton-lisp-form (automaton) (defun wisent-automaton-lisp-form (automaton)
......
...@@ -534,7 +534,6 @@ ...@@ -534,7 +534,6 @@
(cons fn (mapcar #'byte-optimize-form (cdr form)))) (cons fn (mapcar #'byte-optimize-form (cdr form))))
((not (symbolp fn)) ((not (symbolp fn))
(debug)
(byte-compile-warn "`%s' is a malformed function" (byte-compile-warn "`%s' is a malformed function"
(prin1-to-string fn)) (prin1-to-string fn))
form) form)
...@@ -1455,8 +1454,7 @@ ...@@ -1455,8 +1454,7 @@
byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
byte-point-min byte-following-char byte-preceding-char byte-point-min byte-following-char byte-preceding-char
byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp 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 (defconst byte-compile-side-effect-free-ops
(nconc (nconc
...@@ -2029,7 +2027,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ...@@ -2029,7 +2027,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(+ (cdr lap0) (cdr lap1)))) (+ (cdr lap0) (cdr lap1))))
(setq lap (delq lap0 lap)) (setq lap (delq lap0 lap))
(setcdr lap1 (+ (cdr lap1) (cdr lap0)))) (setcdr lap1 (+ (cdr lap1) (cdr lap0))))
;; ;;
;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos
;; stack-set-M [discard/discardN ...] --> discardN ;; 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." ...@@ -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)) (setq lap (delq lap0 lap))
(setcar lap1 (setcar lap1
(if (= tmp2 tmp3) (if (= tmp2 tmp3)
;; The value stored is the new TOS, so pop ;; The value stored is the new TOS, so pop one more
;; one more value (to get rid of the old ;; value (to get rid of the old value) using the
;; value) using the TOS-preserving ;; TOS-preserving discard operator.
;; discard operator.
'byte-discardN-preserve-tos 'byte-discardN-preserve-tos
;; Otherwise, the value stored is lost, so just use a ;; Otherwise, the value stored is lost, so just use a
;; normal discard. ;; normal discard.
...@@ -2071,8 +2068,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ...@@ -2071,8 +2068,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;; discardN-(X+Y) ;; discardN-(X+Y)
;; ;;
((and (memq (car lap0) ((and (memq (car lap0)
'(byte-discard '(byte-discard byte-discardN
byte-discardN
byte-discardN-preserve-tos)) byte-discardN-preserve-tos))
(memq (car lap1) '(byte-discard byte-discardN))) (memq (car lap1) '(byte-discard byte-discardN)))
(setq lap (delq lap0 lap)) (setq lap (delq lap0 lap))
......
This diff is collapsed.
...@@ -67,15 +67,23 @@ ...@@ -67,15 +67,23 @@
;; TODO: (not just for cconv but also for the lexbind changes in general) ;; 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. ;; - 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. ;; - byte-optimize-form should be applied before cconv.
;; OTOH, the warnings emitted by cconv-analyze need to come before optimize ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize
;; since afterwards they can because obnoxious (warnings about an "unused ;; since afterwards they can because obnoxious (warnings about an "unused
;; variable" should not be emitted when the variable use has simply been ;; variable" should not be emitted when the variable use has simply been
;; optimized away). ;; 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) ;; - canonize code in macro-expand so we don't have to handle (let (var) body)
;; and other oddities. ;; and other oddities.
;; - new byte codes for unwind-protect, catch, and condition-case so that ;; - new byte codes for unwind-protect, catch, and condition-case so that
;; closures aren't needed at all. ;; 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 ;; - 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. ;; 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, ;; Hmm... right, that's called constant propagation and could be done here,
......
...@@ -282,7 +282,7 @@ Not documented ...@@ -282,7 +282,7 @@ Not documented
;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist
;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; do* do loop return-from return block etypecase typecase ecase
;;;;;; case load-time-value eval-when destructuring-bind function* ;;;;;; 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 ;;; Generated autoloads from cl-macs.el
(autoload 'gensym "cl-macs" "\ (autoload 'gensym "cl-macs" "\
......
...@@ -497,7 +497,7 @@ The result of the body appears to the compiler as a quoted constant." ...@@ -497,7 +497,7 @@ The result of the body appears to the compiler as a quoted constant."
(symbol-function 'byte-compile-file-form))) (symbol-function 'byte-compile-file-form)))
(list 'byte-compile-file-form (list 'quote set)) (list 'byte-compile-file-form (list 'quote set))
'(byte-compile-file-form form))) '(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 'symbol-value (list 'quote temp)))
(list 'quote (eval form)))) (list 'quote (eval form))))
......
...@@ -278,9 +278,9 @@ definitions to shadow the loaded ones for use in file byte-compilation. ...@@ -278,9 +278,9 @@ definitions to shadow the loaded ones for use in file byte-compilation.
(defvar cl-compiling-file nil) (defvar cl-compiling-file nil)
(defun cl-compiling-file () (defun cl-compiling-file ()
(or cl-compiling-file (or cl-compiling-file
(and (boundp 'byte-compile-outbuffer) (and (boundp 'byte-compile--outbuffer)
(bufferp (symbol-value 'byte-compile-outbuffer)) (bufferp (symbol-value 'byte-compile--outbuffer))
(equal (buffer-name (symbol-value 'byte-compile-outbuffer)) (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
" *Compiler Output*")))) " *Compiler Output*"))))
(defvar cl-proclaims-deferred nil) (defvar cl-proclaims-deferred nil)
......
...@@ -72,7 +72,6 @@ redefine OBJECT if it is a symbol." ...@@ -72,7 +72,6 @@ redefine OBJECT if it is a symbol."
(let ((macro 'nil) (let ((macro 'nil)
(name 'nil) (name 'nil)
(doc 'nil) (doc 'nil)
(lexical-binding nil)
args) args)
(while (symbolp obj) (while (symbolp obj)
(setq name obj (setq name obj
......
...@@ -3640,7 +3640,7 @@ Return the result of the last expression." ...@@ -3640,7 +3640,7 @@ Return the result of the last expression."
(eval (if (bound-and-true-p cl-debug-env) (eval (if (bound-and-true-p cl-debug-env)
(cl-macroexpand-all edebug-expr cl-debug-env) (cl-macroexpand-all edebug-expr cl-debug-env)
edebug-expr) edebug-expr)
lexical-binding)) ;; FIXME: lexbind. lexical-binding))
(defun edebug-safe-eval (edebug-expr) (defun edebug-safe-eval (edebug-expr)
;; Evaluate EXPR safely. ;; Evaluate EXPR safely.
......
...@@ -96,6 +96,7 @@ default setting for optimization purposes.") ...@@ -96,6 +96,7 @@ default setting for optimization purposes.")
"Non-nil means to optimize the method dispatch on primary methods.") "Non-nil means to optimize the method dispatch on primary methods.")
;; State Variables ;; State Variables
;; FIXME: These two constants below should have an `eieio-' prefix added!!
(defvar this nil (defvar this nil
"Inside a method, this variable is the object in question. "Inside a method, this variable is the object in question.
DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots. 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!") ...@@ -122,7 +123,7 @@ execute a `call-next-method'. DO NOT SET THIS YOURSELF!")
;; while it is being built itself. ;; while it is being built itself.
(defvar eieio-default-superclass nil) (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-symbol 1 "Class's symbol (self-referencing.).")
(defconst class-parent 2 "Class parent slot.") (defconst class-parent 2 "Class parent slot.")
(defconst class-children 3 "Class children class 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." ...@@ -745,7 +745,7 @@ POS specifies the starting position where EXP was found and defaults to point."
(unless (special-variable-p var) (unless (special-variable-p var)
(push var vars)))) (push var vars))))
`(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
(defun eval-last-sexp (eval-last-sexp-arg-internal) (defun eval-last-sexp (eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value in minibuffer. "Evaluate sexp before point; print value in minibuffer.
Interactively, with prefix argument, print output into current buffer. Interactively, with prefix argument, print output into current buffer.
......
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> 2011-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
* image.c (parse_image_spec): Use Ffunctionp. * image.c (parse_image_spec): Use Ffunctionp.
......
...@@ -51,7 +51,7 @@ by Hallvard: ...@@ -51,7 +51,7 @@ by Hallvard:
* *
* define BYTE_CODE_METER to enable generation of a byte-op usage histogram. * 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 */ /* #define BYTE_CODE_METER */
...@@ -160,7 +160,7 @@ extern Lisp_Object Qand_optional, Qand_rest; ...@@ -160,7 +160,7 @@ extern Lisp_Object Qand_optional, Qand_rest;
#ifdef BYTE_CODE_SAFE #ifdef BYTE_CODE_SAFE
#define Bset_mark 0163 /* this loser is no longer generated as of v18 */ #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
#endif #endif
#define Binteractive_p 0164 /* Obsolete. */ #define Binteractive_p 0164 /* Obsolete since Emacs-24.1. */
#define Bforward_char 0165 #define Bforward_char 0165
#define Bforward_word 0166 #define Bforward_word 0166
...@@ -185,16 +185,16 @@ extern Lisp_Object Qand_optional, Qand_rest; ...@@ -185,16 +185,16 @@ extern Lisp_Object Qand_optional, Qand_rest;
#define Bdup 0211 #define Bdup 0211
#define Bsave_excursion 0212 #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 Bsave_restriction 0214
#define Bcatch 0215 #define Bcatch 0215
#define Bunwind_protect 0216 #define Bunwind_protect 0216
#define Bcondition_case 0217 #define Bcondition_case 0217
#define Btemp_output_buffer_setup 0220 /* Obsolete. */ #define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1. */
#define Btemp_output_buffer_show 0221 /* Obsolete. */ #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 Bset_marker 0223
#define Bmatch_beginning 0224 #define Bmatch_beginning 0224
...@@ -413,24 +413,15 @@ unmark_byte_stack (void) ...@@ -413,24 +413,15 @@ unmark_byte_stack (void)
} while (0) } 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. doc: /* Function used internally in byte-compiled code.
The first argument, BYTESTR, is a string of byte code; The first argument, BYTESTR, is a string of byte code;
the second, VECTOR, a vector of constants; the second, VECTOR, a vector of constants;
the third, MAXDEPTH, the maximum stack depth used in this function. the third, MAXDEPTH, the maximum stack depth used in this function.
If the third argument is incorrect, Emacs may crash. If the third argument is incorrect, Emacs may crash. */)
(Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
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)
{ {
Lisp_Object args_tmpl = nargs >= 4 ? args[3] : Qnil; return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
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);
} }
/* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and /* 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, ...@@ -810,7 +801,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
AFTER_POTENTIAL_GC (); AFTER_POTENTIAL_GC ();
break; break;
case Bunbind_all: /* Obsolete. */ case Bunbind_all: /* Obsolete. Never used. */
/* To unbind back to the beginning of this frame. Not used yet, /* To unbind back to the beginning of this frame. Not used yet,
but will be needed for tail-recursion elimination. */ but will be needed for tail-recursion elimination. */
BEFORE_POTENTIAL_GC (); BEFORE_POTENTIAL_GC ();
...@@ -938,12 +929,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, ...@@ -938,12 +929,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
save_excursion_save ()); save_excursion_save ());
break; break;
case Bsave_current_buffer: /* Obsolete. */ case Bsave_current_buffer: /* Obsolete since ??. */
case Bsave_current_buffer_1: case Bsave_current_buffer_1:
record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
break; break;
case Bsave_window_excursion: /* Obsolete. */ case Bsave_window_excursion: /* Obsolete since 24.1. */
{ {
register int count = SPECPDL_INDEX (); register int count = SPECPDL_INDEX ();
record_unwind_protect (Fset_window_configuration, record_unwind_protect (Fset_window_configuration,
...@@ -985,7 +976,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, ...@@ -985,7 +976,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
break; break;
} }
case Btemp_output_buffer_setup: /* Obsolete. */ case Btemp_output_buffer_setup: /* Obsolete since 24.1. */
BEFORE_POTENTIAL_GC (); BEFORE_POTENTIAL_GC ();
CHECK_STRING (TOP); CHECK_STRING (TOP);
temp_output_buffer_setup (SSDATA (TOP)); temp_output_buffer_setup (SSDATA (TOP));
...@@ -993,7 +984,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, ...@@ -993,7 +984,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
TOP = Vstandard_output; TOP = Vstandard_output;
break; break;
case Btemp_output_buffer_show: /* Obsolete. */ case Btemp_output_buffer_show: /* Obsolete since 24.1. */
{ {
Lisp_Object v1; Lisp_Object v1;
BEFORE_POTENTIAL_GC (); BEFORE_POTENTIAL_GC ();
...@@ -1465,7 +1456,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, ...@@ -1465,7 +1456,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
AFTER_POTENTIAL_GC (); AFTER_POTENTIAL_GC ();
break; break;
case Binteractive_p: /* Obsolete. */ case Binteractive_p: /* Obsolete since 24.1. */
PUSH (Finteractive_p ()); PUSH (Finteractive_p ());
break; break;
......
...@@ -171,8 +171,8 @@ static void ...@@ -171,8 +171,8 @@ static void
fix_command (Lisp_Object input, Lisp_Object values) fix_command (Lisp_Object input, Lisp_Object values)
{ {
/* FIXME: Instead of this ugly hack, we should provide a way for an /* 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 interactive spec to return an expression/function that will re-build the
without user intervention. */ args without user intervention. */
if (CONSP (input)) if (CONSP (input))
{ {
Lisp_Object car; Lisp_Object car;
......
...@@ -117,10 +117,10 @@ Lisp_Object Vsignaling_function; ...@@ -117,10 +117,10 @@ Lisp_Object Vsignaling_function;
int handling_signal; 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 Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object *);
static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
static int interactive_p (int); static int interactive_p (int);
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
void void
init_eval_once (void) init_eval_once (void)
...@@ -684,7 +684,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) ...@@ -684,7 +684,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
tail = Fcons (lambda_list, tail); tail = Fcons (lambda_list, tail);
else else
tail = Fcons (lambda_list, Fcons (doc, tail)); tail = Fcons (lambda_list, Fcons (doc, tail));
defn = Fcons (Qlambda, tail); defn = Fcons (Qlambda, tail);
if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */
defn = Ffunction (Fcons (defn, Qnil)); defn = Ffunction (Fcons (defn, Qnil));
...@@ -1012,11 +1012,8 @@ usage: (let* VARLIST BODY...) */) ...@@ -1012,11 +1012,8 @@ usage: (let* VARLIST BODY...) */)
varlist = XCDR (varlist); varlist = XCDR (varlist);
} }
UNGCPRO; UNGCPRO;
val = Fprogn (Fcdr (args)); val = Fprogn (Fcdr (args));
return unbind_to (count, val); return unbind_to (count, val);
} }
...@@ -2083,7 +2080,8 @@ then strings and vectors are not accepted. */) ...@@ -2083,7 +2080,8 @@ then strings and vectors are not accepted. */)
return Qnil; return Qnil;
funcar = XCAR (fun); funcar = XCAR (fun);
if (EQ (funcar, Qclosure)) 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)) else if (EQ (funcar, Qlambda))
return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
else if (EQ (funcar, Qautoload)) else if (EQ (funcar, Qautoload))
...@@ -2898,7 +2896,7 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, ...@@ -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. */ /* The caller should GCPRO all the elements of ARGS. */
DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, 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) (Lisp_Object object)
{ {
if (SYMBOLP (object) && !NILP (Ffboundp (object))) if (SYMBOLP (object) && !NILP (Ffboundp (object)))
...@@ -3220,7 +3218,7 @@ funcall_lambda (Lisp_Object fun, size_t nargs, ...@@ -3220,7 +3218,7 @@ funcall_lambda (Lisp_Object fun, size_t nargs,
xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
else else
val = Qnil; val = Qnil;
/* Bind the argument. */ /* Bind the argument. */
if (!NILP (lexenv) && SYMBOLP (next)) if (!NILP (lexenv) && SYMBOLP (next))
/* Lexically bind NEXT by adding it to the lexenv alist. */ /* Lexically bind NEXT by adding it to the lexenv alist. */
...@@ -3501,7 +3499,6 @@ context where binding is lexical by default. */) ...@@ -3501,7 +3499,6 @@ context where binding is lexical by default. */)
} }
DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, 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. 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. */) The debugger is entered when that frame exits, if the flag is non-nil. */)
......
...@@ -1483,7 +1483,6 @@ typedef unsigned char UCHAR; ...@@ -1483,7 +1483,6 @@ typedef unsigned char UCHAR;
#define COMPILED_STACK_DEPTH 3 #define COMPILED_STACK_DEPTH 3
#define COMPILED_DOC_STRING 4 #define COMPILED_DOC_STRING 4
#define COMPILED_INTERACTIVE 5 #define COMPILED_INTERACTIVE 5
#define COMPILED_PUSH_ARGS 6
/* Flag bits in a character. These also get used in termhooks.h. /* Flag bits in a character. These also get used in termhooks.h.
Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
...@@ -3264,7 +3263,7 @@ extern int read_bytecode_char (int); ...@@ -3264,7 +3263,7 @@ extern int read_bytecode_char (int);
/* Defined in bytecode.c */ /* Defined in bytecode.c */
extern Lisp_Object Qbytecode; extern Lisp_Object Qbytecode;
EXFUN (Fbyte_code, MANY); EXFUN (Fbyte_code, 3);
extern void syms_of_bytecode (void); extern void syms_of_bytecode (void);
extern struct byte_stack *byte_stack_list; extern struct byte_stack *byte_stack_list;
#ifdef BYTE_MARK_STACK #ifdef BYTE_MARK_STACK
......
...@@ -796,16 +796,16 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) ...@@ -796,16 +796,16 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
} beg_end_state = NOMINAL; } beg_end_state = NOMINAL;
int in_file_vars = 0; int in_file_vars = 0;