Now on revision 114506. ------------------------------------------------------------ revno: 114506 committer: Paul Eggert branch nick: trunk timestamp: Wed 2013-10-02 23:31:06 -0700 message: * eval.c (clobbered_eassert): New macro. (internal_catch, internal_condition_case) (internal_condition_case_1, internal_condition_case_2) (internal_condition_case_n): Use it instead of eassert when the argument contains locals clobbered by longjmp. Don't use clobbered locals outside of clobbered_eassert. (internal_lisp_condition_case): Use a volatile variable to work around a local variable's getting clobbered. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-03 04:58:56 +0000 +++ src/ChangeLog 2013-10-03 06:31:06 +0000 @@ -1,3 +1,14 @@ +2013-10-03 Paul Eggert + + * eval.c (clobbered_eassert): New macro. + (internal_catch, internal_condition_case) + (internal_condition_case_1, internal_condition_case_2) + (internal_condition_case_n): Use it instead of eassert + when the argument contains locals clobbered by longjmp. + Don't use clobbered locals outside of clobbered_eassert. + (internal_lisp_condition_case): Use a volatile variable + to work around a local variable's getting clobbered. + 2013-10-03 Stefan Monnier * lisp.h (struct handler): Merge struct handler and struct catchtag. === modified file 'src/eval.c' --- src/eval.c 2013-10-03 04:58:56 +0000 +++ src/eval.c 2013-10-03 06:31:06 +0000 @@ -1072,6 +1072,12 @@ return internal_catch (tag, Fprogn, XCDR (args)); } +/* Assert that E is true, as a comment only. Use this instead of + eassert (E) when E contains variables that might be clobbered by a + longjmp. */ + +#define clobbered_eassert(E) ((void) 0) + /* Set up a catch, then call C function FUNC on argument ARG. FUNC should return a Lisp_Object. This is how catches are done from within C code. */ @@ -1089,14 +1095,14 @@ if (! sys_setjmp (c->jmp)) { Lisp_Object val = (*func) (arg); - eassert (handlerlist == c); - handlerlist = c->next; + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; return val; } else { /* Throw works by a longjmp that comes right here. */ Lisp_Object val = handlerlist->val; - eassert (handlerlist == c); + clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; return val; } @@ -1252,6 +1258,7 @@ be added to handlerlist last. So we build in `clauses' a table that contains `handlers' but in reverse order. */ Lisp_Object *clauses = alloca (clausenb * sizeof (Lisp_Object *)); + Lisp_Object *volatile clauses_volatile = clauses; int i = clausenb; for (val = handlers; CONSP (val); val = XCDR (val)) clauses[--i] = XCAR (val); @@ -1266,7 +1273,7 @@ { ptrdiff_t count = SPECPDL_INDEX (); Lisp_Object val = handlerlist->val; - Lisp_Object *chosen_clause = clauses; + Lisp_Object *chosen_clause = clauses_volatile; for (c = handlerlist->next; c != oldhandlerlist; c = c->next) chosen_clause++; handlerlist = oldhandlerlist; @@ -1316,14 +1323,14 @@ if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; - eassert (handlerlist == c); + clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; return (*hfun) (val); } val = (*bfun) (); - eassert (handlerlist == c); - handlerlist = c->next; + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; return val; } @@ -1340,14 +1347,14 @@ if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; - eassert (handlerlist == c); + clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; return (*hfun) (val); } val = (*bfun) (arg); - eassert (handlerlist == c); - handlerlist = c->next; + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; return val; } @@ -1368,14 +1375,14 @@ if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; - eassert (handlerlist == c); + clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; return (*hfun) (val); } val = (*bfun) (arg1, arg2); - eassert (handlerlist == c); - handlerlist = c->next; + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; return val; } @@ -1398,14 +1405,14 @@ if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; - eassert (handlerlist == c); + clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; return (*hfun) (val, nargs, args); } val = (*bfun) (nargs, args); - eassert (handlerlist == c); - handlerlist = c->next; + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; return val; } ------------------------------------------------------------ revno: 114505 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2013-10-03 00:58:56 -0400 message: Introduce new bytecodes for efficient catch/condition-case in lexbind. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Optimize under `condition-case' and `catch' if byte-compile--use-old-handlers is nil. (disassemble-offset): Handle new bytecodes. * lisp/emacs-lisp/bytecomp.el (byte-pushcatch, byte-pushconditioncase) (byte-pophandler): New byte codes. (byte-goto-ops): Adjust accordingly. (byte-compile--use-old-handlers): New var. (byte-compile-catch): Use new byte codes depending on byte-compile--use-old-handlers. (byte-compile-condition-case--old): Rename from byte-compile-condition-case. (byte-compile-condition-case--new): New function. (byte-compile-condition-case): New function that dispatches depending on byte-compile--use-old-handlers. (byte-compile-unwind-protect): Pass a function to byte-unwind-protect when we can. * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): Adjust for the new compilation scheme using the new byte-codes. * src/alloc.c (Fgarbage_collect): Merge scans of handlerlist and catchlist, and make them unconditional now that they're heap-allocated. * src/bytecode.c (BYTE_CODES): Add Bpushcatch, Bpushconditioncase and Bpophandler. (bcall0): New function. (exec_byte_code): Add corresponding cases. Improve error message when encountering an invalid byte-code. Let Bunwind_protect accept a function (rather than a list of expressions) as argument. * src/eval.c (catchlist): Remove (merge with handlerlist). (handlerlist, lisp_eval_depth): Not static any more. (internal_catch, internal_condition_case, internal_condition_case_1) (internal_condition_case_2, internal_condition_case_n): Use PUSH_HANDLER. (unwind_to_catch, Fthrow, Fsignal): Adjust to merged handlerlist/catchlist. (internal_lisp_condition_case): Use PUSH_HANDLER. Adjust to new handlerlist which can only handle a single condition-case handler at a time. (find_handler_clause): Simplify since we only a single branch here any more. * src/lisp.h (struct handler): Merge struct handler and struct catchtag. (PUSH_HANDLER): New macro. (catchlist): Remove. (handlerlist): Always declare. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-03 04:41:23 +0000 +++ lisp/ChangeLog 2013-10-03 04:58:56 +0000 @@ -1,5 +1,29 @@ 2013-10-03 Stefan Monnier + * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): Adjust for + the new compilation scheme using the new byte-codes. + + * emacs-lisp/bytecomp.el (byte-pushcatch, byte-pushconditioncase) + (byte-pophandler): New byte codes. + (byte-goto-ops): Adjust accordingly. + (byte-compile--use-old-handlers): New var. + (byte-compile-catch): Use new byte codes depending on + byte-compile--use-old-handlers. + (byte-compile-condition-case--old): Rename from + byte-compile-condition-case. + (byte-compile-condition-case--new): New function. + (byte-compile-condition-case): New function that dispatches depending + on byte-compile--use-old-handlers. + (byte-compile-unwind-protect): Pass a function to byte-unwind-protect + when we can. + + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): + Optimize under `condition-case' and `catch' if + byte-compile--use-old-handlers is nil. + (disassemble-offset): Handle new bytecodes. + +2013-10-03 Stefan Monnier + * subr.el (error): Use `declare'. (decode-char, encode-char): Use advertised-calling-convention instead of the docstring to discourage use of the `restriction' arg. === modified file 'lisp/emacs-lisp/byte-opt.el' --- lisp/emacs-lisp/byte-opt.el 2013-09-05 03:46:34 +0000 +++ lisp/emacs-lisp/byte-opt.el 2013-10-03 04:58:56 +0000 @@ -488,11 +488,22 @@ (prin1-to-string form)) nil) - ((memq fn '(function condition-case)) - ;; These forms are compiled as constants or by breaking out + ((eq fn 'function) + ;; This forms is compiled as constant or by breaking out ;; all the subexpressions and compiling them separately. form) + ((eq fn 'condition-case) + (if byte-compile--use-old-handlers + ;; Will be optimized later. + form + `(condition-case ,(nth 1 form) ;Not evaluated. + ,(byte-optimize-form (nth 2 form) for-effect) + ,@(mapcar (lambda (clause) + `(,(car clause) + ,@(byte-optimize-body (cdr clause) for-effect))) + (nthcdr 3 form))))) + ((eq fn 'unwind-protect) ;; the "protected" part of an unwind-protect is compiled (and thus ;; optimized) as a top-level form, so don't do it here. But the @@ -504,13 +515,14 @@ (cdr (cdr form))))) ((eq fn 'catch) - ;; the body of a catch is compiled (and thus optimized) as a - ;; top-level form, so don't do it here. The tag is never - ;; for-effect. The body should have the same for-effect status - ;; as the catch form itself, but that isn't handled properly yet. (cons fn (cons (byte-optimize-form (nth 1 form) nil) - (cdr (cdr form))))) + (if byte-compile--use-old-handlers + ;; The body of a catch is compiled (and thus + ;; optimized) as a top-level form, so don't do it + ;; here. + (cdr (cdr form)) + (byte-optimize-body (cdr form) for-effect))))) ((eq fn 'ignore) ;; Don't treat the args to `ignore' as being @@ -1292,7 +1304,7 @@ "Don't call this!" ;; Fetch and return the offset for the current opcode. ;; Return nil if this opcode has no offset. - (cond ((< bytedecomp-op byte-nth) + (cond ((< bytedecomp-op byte-pophandler) (let ((tem (logand bytedecomp-op 7))) (setq bytedecomp-op (logand bytedecomp-op 248)) (cond ((eq tem 6) @@ -1311,7 +1323,9 @@ (setq bytedecomp-op byte-constant))) ((or (and (>= bytedecomp-op byte-constant2) (<= bytedecomp-op byte-goto-if-not-nil-else-pop)) - (= bytedecomp-op byte-stack-set2)) + (memq bytedecomp-op (eval-when-compile + (list byte-stack-set2 byte-pushcatch + byte-pushconditioncase)))) ;; Offset in next 2 bytes. (setq bytedecomp-ptr (1+ bytedecomp-ptr)) (+ (aref bytes bytedecomp-ptr) === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2013-08-30 17:40:39 +0000 +++ lisp/emacs-lisp/bytecomp.el 2013-10-03 04:58:56 +0000 @@ -535,7 +535,13 @@ (byte-defop 40 0 byte-unbind "for unbinding special bindings") ;; codes 8-47 are consumed by the preceding opcodes -;; unused: 48-55 +;; New (in Emacs-24.4) bytecodes for more efficient handling of non-local exits +;; (especially useful in lexical-binding code). +(byte-defop 48 0 byte-pophandler) +(byte-defop 50 -1 byte-pushcatch) +(byte-defop 49 -1 byte-pushconditioncase) + +;; unused: 51-55 (byte-defop 56 -1 byte-nth) (byte-defop 57 0 byte-symbolp) @@ -707,7 +713,8 @@ (defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop - byte-goto-if-not-nil-else-pop) + byte-goto-if-not-nil-else-pop + byte-pushcatch byte-pushconditioncase) "List of byte-codes whose offset is a pc.") (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil)) @@ -4028,23 +4035,35 @@ ;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro. (byte-defop-compiler-1 track-mouse) +(defvar byte-compile--use-old-handlers t + "If nil, use new byte codes introduced in Emacs-24.4.") + (defun byte-compile-catch (form) (byte-compile-form (car (cdr form))) - (pcase (cddr form) - (`(:fun-body ,f) - (byte-compile-form `(list 'funcall ,f))) - (body - (byte-compile-push-constant - (byte-compile-top-level (cons 'progn body) byte-compile--for-effect)))) - (byte-compile-out 'byte-catch 0)) + (if (not byte-compile--use-old-handlers) + (let ((endtag (byte-compile-make-tag))) + (byte-compile-goto 'byte-pushcatch endtag) + (byte-compile-body (cddr form) nil) + (byte-compile-out 'byte-pophandler) + (byte-compile-out-tag endtag)) + (pcase (cddr form) + (`(:fun-body ,f) + (byte-compile-form `(list 'funcall ,f))) + (body + (byte-compile-push-constant + (byte-compile-top-level (cons 'progn body) byte-compile--for-effect)))) + (byte-compile-out 'byte-catch 0))) (defun byte-compile-unwind-protect (form) (pcase (cddr form) (`(:fun-body ,f) - (byte-compile-form `(list (list 'funcall ,f)))) + (byte-compile-form + (if byte-compile--use-old-handlers `(list (list 'funcall ,f)) f))) (handlers - (byte-compile-push-constant - (byte-compile-top-level-body handlers t)))) + (if byte-compile--use-old-handlers + (byte-compile-push-constant + (byte-compile-top-level-body handlers t)) + (byte-compile-form `#'(lambda () ,@handlers))))) (byte-compile-out 'byte-unwind-protect 0) (byte-compile-form-do-effect (car (cdr form))) (byte-compile-out 'byte-unbind 1)) @@ -4056,6 +4075,11 @@ (_ `(eval '(track-mouse ,@(byte-compile-top-level-body (cdr form)))))))) (defun byte-compile-condition-case (form) + (if byte-compile--use-old-handlers + (byte-compile-condition-case--old form) + (byte-compile-condition-case--new form))) + +(defun byte-compile-condition-case--old (form) (let* ((var (nth 1 form)) (fun-bodies (eq var :fun-body)) (byte-compile-bound-variables @@ -4106,6 +4130,62 @@ (byte-compile-push-constant compiled-clauses))) (byte-compile-out 'byte-condition-case 0))) +(defun byte-compile-condition-case--new (form) + (let* ((var (nth 1 form)) + (body (nth 2 form)) + (depth byte-compile-depth) + (clauses (mapcar (lambda (clause) + (cons (byte-compile-make-tag) clause)) + (nthcdr 3 form))) + (endtag (byte-compile-make-tag))) + (byte-compile-set-symbol-position 'condition-case) + (unless (symbolp var) + (byte-compile-warn + "`%s' is not a variable-name or nil (in condition-case)" var)) + + (dolist (clause (reverse clauses)) + (let ((condition (nth 1 clause))) + (unless (consp condition) (setq condition (list condition))) + (dolist (c condition) + (unless (and c (symbolp c)) + (byte-compile-warn + "`%S' is not a condition name (in condition-case)" c)) + ;; In reality, the `error-conditions' property is only required + ;; for the argument to `signal', not to `condition-case'. + ;;(unless (consp (get c 'error-conditions)) + ;; (byte-compile-warn + ;; "`%s' is not a known condition name (in condition-case)" + ;; c)) + ) + (byte-compile-push-constant condition)) + (byte-compile-goto 'byte-pushconditioncase (car clause))) + + (byte-compile-form body) ;; byte-compile--for-effect + (dolist (_ clauses) (byte-compile-out 'byte-pophandler)) + (byte-compile-goto 'byte-goto endtag) + + (while clauses + (let ((clause (pop clauses)) + (byte-compile-bound-variables byte-compile-bound-variables) + (byte-compile--lexical-environment + byte-compile--lexical-environment)) + (setq byte-compile-depth (1+ depth)) + (byte-compile-out-tag (pop clause)) + (dolist (_ clauses) (byte-compile-out 'byte-pophandler)) + (cond + ((null var) (byte-compile-discard)) + (lexical-binding + (push (cons var (1- byte-compile-depth)) + byte-compile--lexical-environment)) + (t (byte-compile-dynamic-variable-bind var))) + (byte-compile-body (cdr clause)) ;; byte-compile--for-effect + (cond + ((null var) nil) + (lexical-binding (byte-compile-discard 1 'preserve-tos)) + (t (byte-compile-out 'byte-unbind 1))) + (byte-compile-goto 'byte-goto endtag))) + + (byte-compile-out-tag endtag))) (defun byte-compile-save-excursion (form) (if (and (eq 'set-buffer (car-safe (car-safe (cdr form)))) === modified file 'lisp/emacs-lisp/cconv.el' --- lisp/emacs-lisp/cconv.el 2013-09-05 03:05:44 +0000 +++ lisp/emacs-lisp/cconv.el 2013-10-03 04:58:56 +0000 @@ -79,8 +79,7 @@ ;; 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. +;; - new byte codes for unwind-protect so that closures aren't needed at all. ;; - 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, @@ -421,18 +420,42 @@ forms))) ;condition-case - (`(condition-case ,var ,protected-form . ,handlers) + ((and `(condition-case ,var ,protected-form . ,handlers) + (guard byte-compile--use-old-handlers)) (let ((newform (cconv--convert-function () (list protected-form) env form))) `(condition-case :fun-body ,newform - ,@(mapcar (lambda (handler) + ,@(mapcar (lambda (handler) (list (car handler) (cconv--convert-function (list (or var cconv--dummy-var)) (cdr handler) env form))) handlers)))) - (`(,(and head (or `catch `unwind-protect)) ,form . ,body) + ; condition-case with new byte-codes. + (`(condition-case ,var ,protected-form . ,handlers) + `(condition-case ,var + ,(cconv-convert protected-form env extend) + ,@(let* ((cm (and var (member (cons (list var) form) + cconv-captured+mutated))) + (newenv + (cond (cm (cons `(,var . (car-save ,var)) env)) + ((assq var env) (cons `(,var) env)) + (t env)))) + (mapcar + (lambda (handler) + `(,(car handler) + ,@(let ((body + (mapcar (lambda (form) + (cconv-convert form newenv extend)) + (cdr handler)))) + (if (not cm) body + `((let ((,var (list ,var))) ,@body)))))) + handlers)))) + + (`(,(and head (or (and `catch (guard byte-compile--use-old-handlers)) + `unwind-protect)) + ,form . ,body) `(,head ,(cconv-convert form env extend) :fun-body ,(cconv--convert-function () body env form))) @@ -491,7 +514,7 @@ (`(,func . ,forms) ;; First element is function or whatever function-like forms are: or, and, - ;; if, progn, prog1, prog2, while, until + ;; if, catch, progn, prog1, prog2, while, until `(,func . ,(mapcar (lambda (form) (cconv-convert form env extend)) forms))) @@ -646,16 +669,32 @@ (`(quote . ,_) nil) ; quote form (`(function . ,_) nil) ; same as quote - (`(condition-case ,var ,protected-form . ,handlers) + ((and `(condition-case ,var ,protected-form . ,handlers) + (guard byte-compile--use-old-handlers)) ;; FIXME: The bytecode for condition-case forces us to wrap the - ;; form and handlers in closures (for handlers, it's understandable - ;; but not for the protected form). + ;; form and handlers in closures. (cconv--analyse-function () (list protected-form) env form) (dolist (handler handlers) - (cconv--analyse-function (if var (list var)) (cdr handler) env form))) - - ;; FIXME: The bytecode for catch forces us to wrap the body. - (`(,(or `catch `unwind-protect) ,form . ,body) + (cconv--analyse-function (if var (list var)) (cdr handler) + env form))) + + (`(condition-case ,var ,protected-form . ,handlers) + (cconv-analyse-form protected-form env) + (when (and var (symbolp var) (byte-compile-not-lexical-var-p var)) + (byte-compile-log-warning + (format "Lexical variable shadows the dynamic variable %S" var))) + (let* ((varstruct (list var nil nil nil nil))) + (if var (push varstruct env)) + (dolist (handler handlers) + (dolist (form (cdr handler)) + (cconv-analyse-form form env))) + (if var (cconv--analyse-use (cons (list var) (cdr varstruct)) + form "variable")))) + + ;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind. + (`(,(or (and `catch (guard byte-compile--use-old-handlers)) + `unwind-protect) + ,form . ,body) (cconv-analyse-form form env) (cconv--analyse-function () body env form)) === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-03 04:41:23 +0000 +++ src/ChangeLog 2013-10-03 04:58:56 +0000 @@ -1,5 +1,35 @@ 2013-10-03 Stefan Monnier + * lisp.h (struct handler): Merge struct handler and struct catchtag. + (PUSH_HANDLER): New macro. + (catchlist): Remove. + (handlerlist): Always declare. + + * eval.c (catchlist): Remove (merge with handlerlist). + (handlerlist, lisp_eval_depth): Not static any more. + (internal_catch, internal_condition_case, internal_condition_case_1) + (internal_condition_case_2, internal_condition_case_n): + Use PUSH_HANDLER. + (unwind_to_catch, Fthrow, Fsignal): Adjust to merged + handlerlist/catchlist. + (internal_lisp_condition_case): Use PUSH_HANDLER. Adjust to new + handlerlist which can only handle a single condition-case handler at + a time. + (find_handler_clause): Simplify since we only a single branch here + any more. + + * bytecode.c (BYTE_CODES): Add Bpushcatch, Bpushconditioncase + and Bpophandler. + (bcall0): New function. + (exec_byte_code): Add corresponding cases. Improve error message when + encountering an invalid byte-code. Let Bunwind_protect accept + a function (rather than a list of expressions) as argument. + + * alloc.c (Fgarbage_collect): Merge scans of handlerlist and catchlist, + and make them unconditional now that they're heap-allocated. + +2013-10-03 Stefan Monnier + * charset.c (Fdecode_char, Fencode_char): Remove description of `restriction' arg. now that it's hidden by advertised-calling-convention. === modified file 'src/alloc.c' --- src/alloc.c 2013-09-26 03:46:47 +0000 +++ src/alloc.c 2013-10-03 04:58:56 +0000 @@ -5370,23 +5370,15 @@ mark_object (tail->var[i]); } mark_byte_stack (); +#endif { - struct catchtag *catch; struct handler *handler; - - for (catch = catchlist; catch; catch = catch->next) - { - mark_object (catch->tag); - mark_object (catch->val); - } - for (handler = handlerlist; handler; handler = handler->next) - { - mark_object (handler->handler); - mark_object (handler->var); - } + for (handler = handlerlist; handler; handler = handler->next) + { + mark_object (handler->tag_or_ch); + mark_object (handler->val); + } } -#endif - #ifdef HAVE_WINDOW_SYSTEM mark_fringe_data (); #endif === modified file 'src/bytecode.c' --- src/bytecode.c 2013-09-24 06:43:20 +0000 +++ src/bytecode.c 2013-10-03 04:58:56 +0000 @@ -141,6 +141,10 @@ DEFINE (Bunbind6, 056) \ DEFINE (Bunbind7, 057) \ \ +DEFINE (Bpophandler, 060) \ +DEFINE (Bpushconditioncase, 061) \ +DEFINE (Bpushcatch, 062) \ + \ DEFINE (Bnth, 070) \ DEFINE (Bsymbolp, 071) \ DEFINE (Bconsp, 072) \ @@ -478,6 +482,12 @@ return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); } +static void +bcall0 (Lisp_Object f) +{ + Ffuncall (1, &f); +} + /* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect, emacs may crash!). If ARGS_TEMPLATE is non-nil, it should be a lisp @@ -506,6 +516,7 @@ struct byte_stack stack; Lisp_Object *top; Lisp_Object result; + enum handlertype type; #if 0 /* CHECK_FRAME_FONT */ { @@ -1078,7 +1089,7 @@ save_restriction_save ()); NEXT; - CASE (Bcatch): /* FIXME: ill-suited for lexbind. */ + CASE (Bcatch): /* Obsolete since 24.4. */ { Lisp_Object v1; BEFORE_POTENTIAL_GC (); @@ -1088,11 +1099,56 @@ NEXT; } + CASE (Bpushcatch): /* New in 24.4. */ + type = CATCHER; + goto pushhandler; + CASE (Bpushconditioncase): /* New in 24.4. */ + { + extern EMACS_INT lisp_eval_depth; + extern int poll_suppress_count; + extern int interrupt_input_blocked; + struct handler *c; + Lisp_Object tag; + int dest; + + type = CONDITION_CASE; + pushhandler: + tag = POP; + dest = FETCH2; + + PUSH_HANDLER (c, tag, type); + c->bytecode_dest = dest; + c->bytecode_top = top; + if (sys_setjmp (c->jmp)) + { + struct handler *c = handlerlist; + top = c->bytecode_top; + int dest = c->bytecode_dest; + handlerlist = c->next; + PUSH (c->val); + CHECK_RANGE (dest); + stack.pc = stack.byte_string_start + dest; + } + NEXT; + } + + CASE (Bpophandler): /* New in 24.4. */ + { + handlerlist = handlerlist->next; + NEXT; + } + CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */ - record_unwind_protect (unwind_body, POP); - NEXT; + { + Lisp_Object handler = POP; + /* Support for a function here is new in 24.4. */ + record_unwind_protect (NILP (Ffunctionp (handler)) + ? unwind_body : bcall0, + handler); + NEXT; + } - CASE (Bcondition_case): /* FIXME: ill-suited for lexbind. */ + CASE (Bcondition_case): /* Obsolete since 24.4. */ { Lisp_Object handlers, body; handlers = POP; @@ -1884,7 +1940,10 @@ /* Actually this is Bstack_ref with offset 0, but we use Bdup for that instead. */ /* CASE (Bstack_ref): */ - error ("Invalid byte opcode"); + call3 (intern ("error"), + build_string ("Invalid byte opcode: op=%s, ptr=%d"), + make_number (op), + make_number ((stack.pc - 1) - stack.byte_string_start)); /* Handy byte-codes for lexical binding. */ CASE (Bstack_ref1): @@ -1957,11 +2016,11 @@ /* Binds and unbinds are supposed to be compiled balanced. */ if (SPECPDL_INDEX () != count) -#ifdef BYTE_CODE_SAFE - error ("binding stack not balanced (serious byte compiler bug)"); -#else - emacs_abort (); -#endif + { + if (SPECPDL_INDEX () > count) + unbind_to (count, Qnil); + error ("binding stack not balanced (serious byte compiler bug)"); + } return result; } === modified file 'src/eval.c' --- src/eval.c 2013-09-10 15:30:10 +0000 +++ src/eval.c 2013-10-03 04:58:56 +0000 @@ -32,20 +32,8 @@ #include "xterm.h" #endif -#if !BYTE_MARK_STACK -static -#endif -struct catchtag *catchlist; - -/* Chain of condition handlers currently in effect. - The elements of this chain are contained in the stack frames - of Fcondition_case and internal_condition_case. - When an error is signaled (by calling Fsignal, below), - this chain is searched for an element that applies. */ - -#if !BYTE_MARK_STACK -static -#endif +/* Chain of condition and catch handlers currently in effect. */ + struct handler *handlerlist; #ifdef DEBUG_GCPRO @@ -92,7 +80,7 @@ /* Depth in Lisp evaluations and function calls. */ -static EMACS_INT lisp_eval_depth; +EMACS_INT lisp_eval_depth; /* The value of num_nonmacro_input_events as of the last time we started to enter the debugger. If we decide to enter the debugger @@ -253,8 +241,7 @@ init_eval (void) { specpdl_ptr = specpdl; - catchlist = 0; - handlerlist = 0; + handlerlist = NULL; Vquit_flag = Qnil; debug_on_next_call = 0; lisp_eval_depth = 0; @@ -1093,28 +1080,26 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) { /* This structure is made part of the chain `catchlist'. */ - struct catchtag c; + struct handler *c; /* Fill in the components of c, and put it on the list. */ - c.next = catchlist; - c.tag = tag; - c.val = Qnil; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; - c.pdlcount = SPECPDL_INDEX (); - c.poll_suppress_count = poll_suppress_count; - c.interrupt_input_blocked = interrupt_input_blocked; - c.gcpro = gcprolist; - c.byte_stack = byte_stack_list; - catchlist = &c; + PUSH_HANDLER (c, tag, CATCHER); /* Call FUNC. */ - if (! sys_setjmp (c.jmp)) - c.val = (*func) (arg); - - /* Throw works by a longjmp that comes right here. */ - catchlist = c.next; - return c.val; + if (! sys_setjmp (c->jmp)) + { + Lisp_Object val = (*func) (arg); + eassert (handlerlist == c); + handlerlist = c->next; + return val; + } + else + { /* Throw works by a longjmp that comes right here. */ + Lisp_Object val = handlerlist->val; + eassert (handlerlist == c); + handlerlist = handlerlist->next; + return val; + } } /* Unwind the specbind, catch, and handler stacks back to CATCH, and @@ -1134,7 +1119,7 @@ This is used for correct unwinding in Fthrow and Fsignal. */ static _Noreturn void -unwind_to_catch (struct catchtag *catch, Lisp_Object value) +unwind_to_catch (struct handler *catch, Lisp_Object value) { bool last_time; @@ -1148,16 +1133,17 @@ do { - last_time = catchlist == catch; - /* Unwind the specpdl stack, and then restore the proper set of handlers. */ - unbind_to (catchlist->pdlcount, Qnil); - handlerlist = catchlist->handlerlist; - catchlist = catchlist->next; + unbind_to (handlerlist->pdlcount, Qnil); + last_time = handlerlist == catch; + if (! last_time) + handlerlist = handlerlist->next; } while (! last_time); + eassert (handlerlist == catch); + byte_stack_list = catch->byte_stack; gcprolist = catch->gcpro; #ifdef DEBUG_GCPRO @@ -1173,12 +1159,12 @@ Both TAG and VALUE are evalled. */) (register Lisp_Object tag, Lisp_Object value) { - register struct catchtag *c; + struct handler *c; if (!NILP (tag)) - for (c = catchlist; c; c = c->next) + for (c = handlerlist; c; c = c->next) { - if (EQ (c->tag, tag)) + if (c->type == CATCHER && EQ (c->tag_or_ch, tag)) unwind_to_catch (c, value); } xsignal2 (Qno_catch, tag, value); @@ -1244,15 +1230,16 @@ Lisp_Object handlers) { Lisp_Object val; - struct catchtag c; - struct handler h; + struct handler *c; + struct handler *oldhandlerlist = handlerlist; + int clausenb = 0; CHECK_SYMBOL (var); for (val = handlers; CONSP (val); val = XCDR (val)) { - Lisp_Object tem; - tem = XCAR (val); + Lisp_Object tem = XCAR (val); + clausenb++; if (! (NILP (tem) || (CONSP (tem) && (SYMBOLP (XCAR (tem)) @@ -1261,39 +1248,50 @@ SDATA (Fprin1_to_string (tem, Qt))); } - c.tag = Qnil; - c.val = Qnil; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; - c.pdlcount = SPECPDL_INDEX (); - c.poll_suppress_count = poll_suppress_count; - c.interrupt_input_blocked = interrupt_input_blocked; - c.gcpro = gcprolist; - c.byte_stack = byte_stack_list; - if (sys_setjmp (c.jmp)) - { - if (!NILP (h.var)) - specbind (h.var, c.val); - val = Fprogn (Fcdr (h.chosen_clause)); - - /* Note that this just undoes the binding of h.var; whoever - longjumped to us unwound the stack to c.pdlcount before - throwing. */ - unbind_to (c.pdlcount, Qnil); - return val; + { /* The first clause is the one that should be checked first, so it should + be added to handlerlist last. So we build in `clauses' a table that + contains `handlers' but in reverse order. */ + Lisp_Object *clauses = alloca (clausenb * sizeof (Lisp_Object *)); + int i = clausenb; + for (val = handlers; CONSP (val); val = XCDR (val)) + clauses[--i] = XCAR (val); + for (i = 0; i < clausenb; i++) + { + Lisp_Object clause = clauses[i]; + Lisp_Object condition = XCAR (clause); + if (!CONSP (condition)) + condition = Fcons (condition, Qnil); + PUSH_HANDLER (c, condition, CONDITION_CASE); + if (sys_setjmp (c->jmp)) + { + ptrdiff_t count = SPECPDL_INDEX (); + Lisp_Object val = handlerlist->val; + Lisp_Object *chosen_clause = clauses; + for (c = handlerlist->next; c != oldhandlerlist; c = c->next) + chosen_clause++; + handlerlist = oldhandlerlist; + if (!NILP (var)) + { + if (!NILP (Vinternal_interpreter_environment)) + specbind (Qinternal_interpreter_environment, + Fcons (Fcons (var, val), + Vinternal_interpreter_environment)); + else + specbind (var, val); + } + val = Fprogn (XCDR (*chosen_clause)); + /* Note that this just undoes the binding of var; whoever + longjumped to us unwound the stack to c.pdlcount before + throwing. */ + if (!NILP (var)) + unbind_to (count, Qnil); + return val; + } + } } - c.next = catchlist; - catchlist = &c; - - h.var = var; - h.handler = handlers; - h.next = handlerlist; - h.tag = &c; - handlerlist = &h; val = eval_sub (bodyform); - catchlist = c.next; - handlerlist = h.next; + handlerlist = oldhandlerlist; return val; } @@ -1312,33 +1310,20 @@ Lisp_Object (*hfun) (Lisp_Object)) { Lisp_Object val; - struct catchtag c; - struct handler h; + struct handler *c; - c.tag = Qnil; - c.val = Qnil; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; - c.pdlcount = SPECPDL_INDEX (); - c.poll_suppress_count = poll_suppress_count; - c.interrupt_input_blocked = interrupt_input_blocked; - c.gcpro = gcprolist; - c.byte_stack = byte_stack_list; - if (sys_setjmp (c.jmp)) + PUSH_HANDLER (c, handlers, CONDITION_CASE); + if (sys_setjmp (c->jmp)) { - return (*hfun) (c.val); + Lisp_Object val = handlerlist->val; + eassert (handlerlist == c); + handlerlist = handlerlist->next; + return (*hfun) (val); } - c.next = catchlist; - catchlist = &c; - h.handler = handlers; - h.var = Qnil; - h.next = handlerlist; - h.tag = &c; - handlerlist = &h; val = (*bfun) (); - catchlist = c.next; - handlerlist = h.next; + eassert (handlerlist == c); + handlerlist = c->next; return val; } @@ -1349,33 +1334,20 @@ Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object)) { Lisp_Object val; - struct catchtag c; - struct handler h; + struct handler *c; - c.tag = Qnil; - c.val = Qnil; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; - c.pdlcount = SPECPDL_INDEX (); - c.poll_suppress_count = poll_suppress_count; - c.interrupt_input_blocked = interrupt_input_blocked; - c.gcpro = gcprolist; - c.byte_stack = byte_stack_list; - if (sys_setjmp (c.jmp)) + PUSH_HANDLER (c, handlers, CONDITION_CASE); + if (sys_setjmp (c->jmp)) { - return (*hfun) (c.val); + Lisp_Object val = handlerlist->val; + eassert (handlerlist == c); + handlerlist = handlerlist->next; + return (*hfun) (val); } - c.next = catchlist; - catchlist = &c; - h.handler = handlers; - h.var = Qnil; - h.next = handlerlist; - h.tag = &c; - handlerlist = &h; val = (*bfun) (arg); - catchlist = c.next; - handlerlist = h.next; + eassert (handlerlist == c); + handlerlist = c->next; return val; } @@ -1390,33 +1362,20 @@ Lisp_Object (*hfun) (Lisp_Object)) { Lisp_Object val; - struct catchtag c; - struct handler h; + struct handler *c; - c.tag = Qnil; - c.val = Qnil; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; - c.pdlcount = SPECPDL_INDEX (); - c.poll_suppress_count = poll_suppress_count; - c.interrupt_input_blocked = interrupt_input_blocked; - c.gcpro = gcprolist; - c.byte_stack = byte_stack_list; - if (sys_setjmp (c.jmp)) + PUSH_HANDLER (c, handlers, CONDITION_CASE); + if (sys_setjmp (c->jmp)) { - return (*hfun) (c.val); + Lisp_Object val = handlerlist->val; + eassert (handlerlist == c); + handlerlist = handlerlist->next; + return (*hfun) (val); } - c.next = catchlist; - catchlist = &c; - h.handler = handlers; - h.var = Qnil; - h.next = handlerlist; - h.tag = &c; - handlerlist = &h; val = (*bfun) (arg1, arg2); - catchlist = c.next; - handlerlist = h.next; + eassert (handlerlist == c); + handlerlist = c->next; return val; } @@ -1433,33 +1392,20 @@ Lisp_Object *args)) { Lisp_Object val; - struct catchtag c; - struct handler h; + struct handler *c; - c.tag = Qnil; - c.val = Qnil; - c.handlerlist = handlerlist; - c.lisp_eval_depth = lisp_eval_depth; - c.pdlcount = SPECPDL_INDEX (); - c.poll_suppress_count = poll_suppress_count; - c.interrupt_input_blocked = interrupt_input_blocked; - c.gcpro = gcprolist; - c.byte_stack = byte_stack_list; - if (sys_setjmp (c.jmp)) + PUSH_HANDLER (c, handlers, CONDITION_CASE); + if (sys_setjmp (c->jmp)) { - return (*hfun) (c.val, nargs, args); + Lisp_Object val = handlerlist->val; + eassert (handlerlist == c); + handlerlist = handlerlist->next; + return (*hfun) (val, nargs, args); } - c.next = catchlist; - catchlist = &c; - h.handler = handlers; - h.var = Qnil; - h.next = handlerlist; - h.tag = &c; - handlerlist = &h; val = (*bfun) (nargs, args); - catchlist = c.next; - handlerlist = h.next; + eassert (handlerlist == c); + handlerlist = c->next; return val; } @@ -1551,7 +1497,9 @@ for (h = handlerlist; h; h = h->next) { - clause = find_handler_clause (h->handler, conditions); + if (h->type != CONDITION_CASE) + continue; + clause = find_handler_clause (h->tag_or_ch, conditions); if (!NILP (clause)) break; } @@ -1568,7 +1516,7 @@ && !NILP (Fmemq (Qdebug, XCAR (clause)))) /* Special handler that means "print a message and run debugger if requested". */ - || EQ (h->handler, Qerror))) + || EQ (h->tag_or_ch, Qerror))) { bool debugger_called = maybe_call_debugger (conditions, error_symbol, data); @@ -1583,12 +1531,11 @@ Lisp_Object unwind_data = (NILP (error_symbol) ? data : Fcons (error_symbol, data)); - h->chosen_clause = clause; - unwind_to_catch (h->tag, unwind_data); + unwind_to_catch (h, unwind_data); } else { - if (catchlist != 0) + if (handlerlist != 0) Fthrow (Qtop_level, Qt); } @@ -1774,29 +1721,8 @@ for (h = handlers; CONSP (h); h = XCDR (h)) { Lisp_Object handler = XCAR (h); - Lisp_Object condit, tem; - - if (!CONSP (handler)) - continue; - condit = XCAR (handler); - /* Handle a single condition name in handler HANDLER. */ - if (SYMBOLP (condit)) - { - tem = Fmemq (Fcar (handler), conditions); - if (!NILP (tem)) - return handler; - } - /* Handle a list of condition names in handler HANDLER. */ - else if (CONSP (condit)) - { - Lisp_Object tail; - for (tail = condit; CONSP (tail); tail = XCDR (tail)) - { - tem = Fmemq (XCAR (tail), conditions); - if (!NILP (tem)) - return handler; - } - } + if (!NILP (Fmemq (handler, conditions))) + return handlers; } return Qnil; === modified file 'src/lisp.h' --- src/lisp.h 2013-09-24 06:43:20 +0000 +++ src/lisp.h 2013-10-03 04:58:56 +0000 @@ -2635,11 +2635,9 @@ - The specpdl stack: keeps track of active unwind-protect and dynamic-let-bindings. Allocated from the `specpdl' array, a manually managed stack. - - The catch stack: keeps track of active catch tags. - Allocated on the C stack. This is where the setmp data is kept. - - The handler stack: keeps track of active condition-case handlers. - Allocated on the C stack. Every entry there also uses an entry in - the catch stack. */ + - The handler stack: keeps track of active catch tags and condition-case + handlers. Allocated in a manually managed stack implemented by a + doubly-linked list allocated via xmalloc and never freed. */ /* Structure for recording Lisp call stack for backtrace purposes. */ @@ -2709,46 +2707,16 @@ return specpdl_ptr - specpdl; } -/* Everything needed to describe an active condition case. - - Members are volatile if their values need to survive _longjmp when - a 'struct handler' is a local variable. */ -struct handler - { - /* The handler clauses and variable from the condition-case form. */ - /* For a handler set up in Lisp code, this is always a list. - For an internal handler set up by internal_condition_case*, - this can instead be the symbol t or `error'. - t: handle all conditions. - error: handle all conditions, and errors can run the debugger - or display a backtrace. */ - Lisp_Object handler; - - Lisp_Object volatile var; - - /* Fsignal stores here the condition-case clause that applies, - and Fcondition_case thus knows which clause to run. */ - Lisp_Object volatile chosen_clause; - - /* Used to effect the longjump out to the handler. */ - struct catchtag *tag; - - /* The next enclosing handler. */ - struct handler *next; - }; - -/* This structure helps implement the `catch' and `throw' control - structure. A struct catchtag contains all the information needed - to restore the state of the interpreter after a non-local jump. - - Handlers for error conditions (represented by `struct handler' - structures) just point to a catch tag to do the cleanup required - for their jumps. - - catchtag structures are chained together in the C calling stack; - the `next' member points to the next outer catchtag. - - A call like (throw TAG VAL) searches for a catchtag whose `tag' +/* This structure helps implement the `catch/throw' and `condition-case/signal' + control structures. A struct handler contains all the information needed to + restore the state of the interpreter after a non-local jump. + + handler structures are chained together in a doubly linked list; the `next' + member points to the next outer catchtag and the `nextfree' member points in + the other direction to the next inner element (which is typically the next + free element since we mostly use it on the deepest handler). + + A call like (throw TAG VAL) searches for a catchtag whose `tag_or_ch' member is TAG, and then unbinds to it. The `val' member is used to hold VAL while the stack is unwound; `val' is returned as the value of the catch form. @@ -2757,24 +2725,63 @@ state. Members are volatile if their values need to survive _longjmp when - a 'struct catchtag' is a local variable. */ -struct catchtag + a 'struct handler' is a local variable. */ + +enum handlertype { CATCHER, CONDITION_CASE }; + +struct handler { - Lisp_Object tag; - Lisp_Object volatile val; - struct catchtag *volatile next; + enum handlertype type; + Lisp_Object tag_or_ch; + Lisp_Object val; + struct handler *next; + struct handler *nextfree; + + /* The bytecode interpreter can have several handlers active at the same + time, so when we longjmp to one of them, it needs to know which handler + this was and what was the corresponding internal state. This is stored + here, and when we longjmp we make sure that handlerlist points to the + proper handler. */ + Lisp_Object *bytecode_top; + int bytecode_dest; + + /* Most global vars are reset to their value via the specpdl mechanism, + but a few others are handled by storing their value here. */ #if 1 /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but they're defined later. */ struct gcpro *gcpro; #endif sys_jmp_buf jmp; - struct handler *handlerlist; EMACS_INT lisp_eval_depth; - ptrdiff_t volatile pdlcount; + ptrdiff_t pdlcount; int poll_suppress_count; int interrupt_input_blocked; struct byte_stack *byte_stack; }; +/* Fill in the components of c, and put it on the list. */ +#define PUSH_HANDLER(c, tag_ch_val, handlertype) \ + if (handlerlist && handlerlist->nextfree) \ + (c) = handlerlist->nextfree; \ + else \ + { \ + (c) = xmalloc (sizeof (struct handler)); \ + (c)->nextfree = NULL; \ + if (handlerlist) \ + handlerlist->nextfree = (c); \ + } \ + (c)->type = (handlertype); \ + (c)->tag_or_ch = (tag_ch_val); \ + (c)->val = Qnil; \ + (c)->next = handlerlist; \ + (c)->lisp_eval_depth = lisp_eval_depth; \ + (c)->pdlcount = SPECPDL_INDEX (); \ + (c)->poll_suppress_count = poll_suppress_count; \ + (c)->interrupt_input_blocked = interrupt_input_blocked;\ + (c)->gcpro = gcprolist; \ + (c)->byte_stack = byte_stack_list; \ + handlerlist = (c); + + extern Lisp_Object memory_signal_data; /* An address near the bottom of the stack. @@ -3677,10 +3684,8 @@ extern Lisp_Object Vautoload_queue; extern Lisp_Object Vsignaling_function; extern Lisp_Object inhibit_lisp_code; -#if BYTE_MARK_STACK -extern struct catchtag *catchlist; extern struct handler *handlerlist; -#endif + /* To run a normal hook, use the appropriate function from the list below. The calling convention: ------------------------------------------------------------ revno: 114504 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2013-10-03 00:41:23 -0400 message: * lisp/subr.el (decode-char, encode-char): Use advertised-calling-convention instead of the docstring to discourage use of the `restriction' arg. (error): Use `declare'. * src/charset.c (Fdecode_char, Fencode_char): Remove description of `restriction' arg. now that it's hidden by advertised-calling-convention. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-03 01:29:17 +0000 +++ lisp/ChangeLog 2013-10-03 04:41:23 +0000 @@ -1,3 +1,9 @@ +2013-10-03 Stefan Monnier + + * subr.el (error): Use `declare'. + (decode-char, encode-char): Use advertised-calling-convention instead + of the docstring to discourage use of the `restriction' arg. + 2013-10-03 Daiki Ueno * epg.el (epg-verify-file): Add a comment saying that it does not === modified file 'lisp/subr.el' --- lisp/subr.el 2013-09-29 06:16:45 +0000 +++ lisp/subr.el 2013-10-03 04:41:23 +0000 @@ -301,9 +301,9 @@ In Emacs, the convention is that error messages start with a capital letter but *do not* end with a period. Please follow this convention for the sake of consistency." + (declare (advertised-calling-convention (string &rest args) "23.1")) (while t (signal 'error (list (apply 'format args))))) -(set-advertised-calling-convention 'error '(string &rest args) "23.1") (defun user-error (format &rest args) "Signal a pilot error, making error message by passing all args to `format'. @@ -1246,6 +1246,8 @@ 'all-completions '(string collection &optional predicate) "23.1") (set-advertised-calling-convention 'unintern '(name obarray) "23.3") (set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") +(set-advertised-calling-convention 'decode-char '(ch charset) "21.4") +(set-advertised-calling-convention 'encode-char '(ch charset) "21.4") ;;;; Obsolescence declarations for variables, and aliases. === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-02 18:52:34 +0000 +++ src/ChangeLog 2013-10-03 04:41:23 +0000 @@ -1,7 +1,12 @@ +2013-10-03 Stefan Monnier + + * charset.c (Fdecode_char, Fencode_char): Remove description of + `restriction' arg. now that it's hidden by advertised-calling-convention. + 2013-10-02 Jan Djärv - * macfont.m (mac_ctfont_create_preferred_family_for_attributes): Remove - unised variable (from mac-port). + * macfont.m (mac_ctfont_create_preferred_family_for_attributes): + Remove unused variable (from mac-port). (macfont_draw): Use s->ybase for correct y position. 2013-10-02 Dmitry Antipov @@ -52,7 +57,7 @@ (ns_term_init): Remove assignment of ns_selection_color, logic moved to ns_get_color. - * nsterm.h (NS_SELECTION_BG_COLOR_DEFAULT): Renamed from + * nsterm.h (NS_SELECTION_BG_COLOR_DEFAULT): Rename from NS_SELECTION_COLOR_DEFAULT. (NS_SELECTION_FG_COLOR_DEFAULT): New. @@ -240,8 +245,8 @@ (vroundup_ct): New macro. (vroundup): Assume argument >= 0; invoke vroundup_ct. * casetab.c (shuffle,set_identity): Change lint_assume to assume. - * composite.c (composition_gstring_put_cache): Change - lint_assume to assume. + * composite.c (composition_gstring_put_cache): + Change lint_assume to assume. * conf_post.h (assume): New macro. (lint_assume): Remove. * dispnew.c (update_frame_1): Change lint_assume to assume. === modified file 'src/charset.c' --- src/charset.c 2013-09-20 15:34:36 +0000 +++ src/charset.c 2013-10-03 04:41:23 +0000 @@ -1860,10 +1860,7 @@ doc: /* Decode the pair of CHARSET and CODE-POINT into a character. Return nil if CODE-POINT is not valid in CHARSET. -CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). - -Optional argument RESTRICTION specifies a way to map the pair of CCS -and CODE-POINT to a character. Currently not supported and just ignored. */) +CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). */) (Lisp_Object charset, Lisp_Object code_point, Lisp_Object restriction) { int c, id; @@ -1880,10 +1877,7 @@ DEFUN ("encode-char", Fencode_char, Sencode_char, 2, 3, 0, doc: /* Encode the character CH into a code-point of CHARSET. -Return nil if CHARSET doesn't include CH. - -Optional argument RESTRICTION specifies a way to map CH to a -code-point in CCS. Currently not supported and just ignored. */) +Return nil if CHARSET doesn't include CH. */) (Lisp_Object ch, Lisp_Object charset, Lisp_Object restriction) { int c, id; ------------------------------------------------------------ revno: 114503 committer: Daiki Ueno branch nick: trunk timestamp: Thu 2013-10-03 10:29:17 +0900 message: epg: doc improvement for verify functions * epg.el (epg-verify-file): Add a comment saying that it does not notify verification error as a return value nor a signal. (epg-verify-string): Ditto. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-02 23:33:48 +0000 +++ lisp/ChangeLog 2013-10-03 01:29:17 +0000 @@ -1,3 +1,9 @@ +2013-10-03 Daiki Ueno + + * epg.el (epg-verify-file): Add a comment saying that it does not + notify verification error as a return value nor a signal. + (epg-verify-string): Ditto. + 2013-10-02 Kevin Rodgers * progmodes/compile.el (compilation-start): Try globbing the arg to === modified file 'lisp/epg.el' --- lisp/epg.el 2013-09-06 15:37:01 +0000 +++ lisp/epg.el 2013-10-03 01:29:17 +0000 @@ -2219,7 +2219,17 @@ For a detached signature, both SIGNATURE and SIGNED-TEXT should be string. For a normal or a cleartext signature, SIGNED-TEXT should be nil. In the latter case, if PLAIN is specified, the plaintext is -stored into the file after successful verification." +stored into the file after successful verification. + +Note that this function does not return verification result as t +or nil, nor signal error on failure. That's a design decision to +handle the case where SIGNATURE has multiple signature. + +To check the verification results, use `epg-context-result-for' as follows: + +\(epg-context-result-for context 'verify) + +which will return a list of `epg-signature' object." (unwind-protect (progn (if plain @@ -2246,7 +2256,17 @@ For a detached signature, both SIGNATURE and SIGNED-TEXT should be string. For a normal or a cleartext signature, SIGNED-TEXT should be nil. In the latter case, this function returns the plaintext after -successful verification." +successful verification. + +Note that this function does not return verification result as t +or nil, nor signal error on failure. That's a design decision to +handle the case where SIGNATURE has multiple signature. + +To check the verification results, use `epg-context-result-for' as follows: + +\(epg-context-result-for context 'verify) + +which will return a list of `epg-signature' object." (let ((coding-system-for-write 'binary) input-file) (unwind-protect ------------------------------------------------------------ revno: 114502 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15417 author: Kevin Rodgers committer: Stefan Monnier branch nick: trunk timestamp: Wed 2013-10-02 19:33:48 -0400 message: * lisp/progmodes/compile.el (compilation-start): Try globbing the arg to `cd'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-02 13:48:20 +0000 +++ lisp/ChangeLog 2013-10-02 23:33:48 +0000 @@ -1,3 +1,8 @@ +2013-10-02 Kevin Rodgers + + * progmodes/compile.el (compilation-start): Try globbing the arg to + `cd' (bug#15417). + 2013-10-02 Michael Albinus Sync with Tramp 2.2.8. === modified file 'lisp/progmodes/compile.el' --- lisp/progmodes/compile.el 2013-08-13 07:56:43 +0000 +++ lisp/progmodes/compile.el 2013-10-02 23:33:48 +0000 @@ -1583,7 +1583,16 @@ "\\\\\\(.\\)" "\\1" (substring command (1+ (match-beginning 1)) (1- (match-end 1))))) - (t (substitute-env-vars (match-string 1 command))))) + ;; Try globbing as well (bug#15417). + (t (let* ((substituted-dir + (substitute-env-vars (match-string 1 command))) + ;; FIXME: This also tries to expand `*' that were + ;; introduced by the envvar expansion! + (expanded-dir + (file-expand-wildcards substituted-dir))) + (if (= (length expanded-dir) 1) + (car expanded-dir) + substituted-dir))))) (erase-buffer) ;; Select the desired mode. (if (not (eq mode t)) ------------------------------------------------------------ revno: 114501 committer: Jan D. branch nick: trunk timestamp: Wed 2013-10-02 20:52:34 +0200 message: * macfont.m (macfont_draw): Use s->ybase for correct y position. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-02 15:38:12 +0000 +++ src/ChangeLog 2013-10-02 18:52:34 +0000 @@ -1,3 +1,9 @@ +2013-10-02 Jan Djärv + + * macfont.m (mac_ctfont_create_preferred_family_for_attributes): Remove + unised variable (from mac-port). + (macfont_draw): Use s->ybase for correct y position. + 2013-10-02 Dmitry Antipov * frame.h (struct frame): Drop has_minibuffer member because... === modified file 'src/macfont.m' --- src/macfont.m 2013-10-02 03:26:29 +0000 +++ src/macfont.m 2013-10-02 18:52:34 +0000 @@ -2720,7 +2720,7 @@ CGFloat font_size = mac_font_get_size (macfont); CGAffineTransform atfm; CGFloat advance_delta = 0; - int y_draw = -y-FONT_BASE (s->font); + int y_draw = -s->ybase; int no_antialias_p = (macfont_info->antialias == MACFONT_ANTIALIAS_OFF || (macfont_info->antialias == MACFONT_ANTIALIAS_DEFAULT @@ -3321,10 +3321,8 @@ CFStringRef result = NULL; CFStringRef charset_string = CFDictionaryGetValue (attributes, MAC_FONT_CHARACTER_SET_STRING_ATTRIBUTE); - CFIndex length; - if (charset_string - && (length = CFStringGetLength (charset_string)) > 0) + if (charset_string && CFStringGetLength (charset_string) > 0) { CFAttributedStringRef attr_string = NULL; CTLineRef ctline = NULL; ------------------------------------------------------------ revno: 114500 committer: Dmitry Antipov branch nick: trunk timestamp: Wed 2013-10-02 19:38:12 +0400 message: * frame.h (struct frame): Drop has_minibuffer member because... (FRAME_HAS_MINIBUF_P): ...this macro can be implemented without it. * frame.c (make_frame, make_minibuffer_frame): Adjust users. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-02 12:08:27 +0000 +++ src/ChangeLog 2013-10-02 15:38:12 +0000 @@ -1,5 +1,11 @@ 2013-10-02 Dmitry Antipov + * frame.h (struct frame): Drop has_minibuffer member because... + (FRAME_HAS_MINIBUF_P): ...this macro can be implemented without it. + * frame.c (make_frame, make_minibuffer_frame): Adjust users. + +2013-10-02 Dmitry Antipov + * window.h (struct window): Prefer enum text_cursor_kinds to int for phys_cursor_type member. Move the latter, phys_cursor_width, phys_cursor_ascent and phys_cursor_height under HAVE_WINDOW_SYSTEM. === modified file 'src/frame.c' --- src/frame.c 2013-09-29 10:21:58 +0000 +++ src/frame.c 2013-10-02 15:38:12 +0000 @@ -339,7 +339,6 @@ initialize enum members explicitly even if their values are zero. */ f->wants_modeline = 1; f->garbaged = 1; - f->has_minibuffer = mini_p; f->vertical_scroll_bar_type = vertical_scroll_bar_none; f->column_width = 1; /* !FRAME_WINDOW_P value */ f->line_height = 1; /* !FRAME_WINDOW_P value */ @@ -489,7 +488,6 @@ f->auto_lower = 0; f->no_split = 1; f->wants_modeline = 0; - f->has_minibuffer = 1; /* Now label the root window as also being the minibuffer. Avoid infinite looping on the window chain by marking next pointer === modified file 'src/frame.h' --- src/frame.h 2013-09-23 09:50:47 +0000 +++ src/frame.h 2013-10-02 15:38:12 +0000 @@ -355,10 +355,6 @@ /* Nonzero if this frame should be redrawn. */ unsigned garbaged : 1; - /* True if frame actually has a minibuffer window on it. - 0 if using a minibuffer window that isn't on this frame. */ - unsigned has_minibuffer : 1; - /* 0 means, if this frame has just one window, show no modeline for that window. */ unsigned wants_modeline : 1; @@ -657,9 +653,11 @@ #define FRAME_MINIBUF_ONLY_P(f) \ EQ (FRAME_ROOT_WINDOW (f), FRAME_MINIBUF_WINDOW (f)) -/* Nonzero if frame F contains a minibuffer window. - (If this is 0, F must use some other minibuffer window.) */ -#define FRAME_HAS_MINIBUF_P(f) ((f)->has_minibuffer) +/* Nonzero if frame F contains it's own minibuffer window. Frame always has + minibuffer window, but it could use minibuffer window of another frame. */ +#define FRAME_HAS_MINIBUF_P(f) \ + (WINDOWP (f->minibuffer_window) \ + && XFRAME (XWINDOW (f->minibuffer_window)->frame) == f) /* Pixel height of frame F, including non-toolkit menu bar and non-toolkit tool bar lines. */