From aa7dac899804727875cdb8fe267d37adcbe9705a Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 19 Nov 2015 20:09:11 -0800 Subject: [PATCH] Simplify push_handler and profile its malloc * src/lisp.h (PUSH_HANDLER): Remove. All callers changed to use push_handler directly. * src/eval.c (internal_condition_case) (internal_condition_case_1, internal_condition_case_2) (internal_condition_case_n): Use same pattern as for other invokers of push_handler. (push_handler, push_handler_nosignal): Use call-by-value instead of call-by-reference. All uses changed. (push_handler): Simplify by rewriting in terms of push_handler_nosignal. (push_handler_nosignal): Profile any newly allocated memory. --- src/bytecode.c | 14 ++--- src/emacs-module.c | 4 +- src/eval.c | 147 +++++++++++++++++++-------------------------- src/lisp.h | 14 +---- 4 files changed, 71 insertions(+), 108 deletions(-) diff --git a/src/bytecode.c b/src/bytecode.c index 864db1a0be..464adc633a 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1067,17 +1067,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, type = CATCHER; goto pushhandler; CASE (Bpushconditioncase): /* New in 24.4. */ + type = CONDITION_CASE; + pushhandler: { - struct handler *c; - Lisp_Object tag; - int dest; + Lisp_Object tag = POP; + int dest = FETCH2; - type = CONDITION_CASE; - pushhandler: - tag = POP; - dest = FETCH2; - - PUSH_HANDLER (c, tag, type); + struct handler *c = push_handler (tag, type); c->bytecode_dest = dest; c->bytecode_top = top; diff --git a/src/emacs-module.c b/src/emacs-module.c index f611c8ba60..e885af5de8 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -194,8 +194,8 @@ static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object); #define MODULE_SETJMP_1(handlertype, handlerfunc, retval, c, dummy) \ do { \ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); \ - struct handler *c; \ - if (!push_handler_nosignal (&c, Qt, handlertype)) \ + struct handler *c = push_handler_nosignal (Qt, handlertype); \ + if (!c) \ { \ module_out_of_memory (env); \ return retval; \ diff --git a/src/eval.c b/src/eval.c index 22ee4d1afd..023c2ef6aa 100644 --- a/src/eval.c +++ b/src/eval.c @@ -226,9 +226,8 @@ init_eval (void) { /* Put a dummy catcher at top-level so that handlerlist is never NULL. This is important since handlerlist->nextfree holds the freelist which would otherwise leak every time we unwind back to top-level. */ - struct handler *c; handlerlist = handlerlist_sentinel.nextfree = &handlerlist_sentinel; - PUSH_HANDLER (c, Qunbound, CATCHER); + struct handler *c = push_handler (Qunbound, CATCHER); eassert (c == &handlerlist_sentinel); handlerlist_sentinel.nextfree = NULL; handlerlist_sentinel.next = NULL; @@ -1059,18 +1058,16 @@ usage: (catch TAG BODY...) */) This is how catches are done from within C code. */ Lisp_Object -internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) +internal_catch (Lisp_Object tag, + Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) { /* This structure is made part of the chain `catchlist'. */ - struct handler *c; - - /* Fill in the components of c, and put it on the list. */ - PUSH_HANDLER (c, tag, CATCHER); + struct handler *c = push_handler (tag, CATCHER); /* Call FUNC. */ if (! sys_setjmp (c->jmp)) { - Lisp_Object val = (*func) (arg); + Lisp_Object val = func (arg); clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; return val; @@ -1147,7 +1144,7 @@ Both TAG and VALUE are evalled. */ { if (c->type == CATCHER_ALL) unwind_to_catch (c, Fcons (tag, value)); - if (c->type == CATCHER && EQ (c->tag_or_ch, tag)) + if (c->type == CATCHER && EQ (c->tag_or_ch, tag)) unwind_to_catch (c, value); } xsignal2 (Qno_catch, tag, value); @@ -1213,7 +1210,6 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, Lisp_Object handlers) { Lisp_Object val; - struct handler *c; struct handler *oldhandlerlist = handlerlist; int clausenb = 0; @@ -1248,7 +1244,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, Lisp_Object condition = XCAR (clause); if (!CONSP (condition)) condition = Fcons (condition, Qnil); - PUSH_HANDLER (c, condition, CONDITION_CASE); + struct handler *c = push_handler (condition, CONDITION_CASE); if (sys_setjmp (c->jmp)) { ptrdiff_t count = SPECPDL_INDEX (); @@ -1296,46 +1292,45 @@ Lisp_Object internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object)) { - Lisp_Object val; - struct handler *c; - - PUSH_HANDLER (c, handlers, CONDITION_CASE); + struct handler *c = push_handler (handlers, CONDITION_CASE); if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; - return (*hfun) (val); + return hfun (val); + } + else + { + Lisp_Object val = bfun (); + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; + return val; } - - val = (*bfun) (); - clobbered_eassert (handlerlist == c); - handlerlist = handlerlist->next; - return val; } /* Like internal_condition_case but call BFUN with ARG as its argument. */ Lisp_Object internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg, - Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object)) + Lisp_Object handlers, + Lisp_Object (*hfun) (Lisp_Object)) { - Lisp_Object val; - struct handler *c; - - PUSH_HANDLER (c, handlers, CONDITION_CASE); + struct handler *c = push_handler (handlers, CONDITION_CASE); if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; - return (*hfun) (val); + return hfun (val); + } + else + { + Lisp_Object val = bfun (arg); + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; + return val; } - - val = (*bfun) (arg); - clobbered_eassert (handlerlist == c); - handlerlist = handlerlist->next; - return val; } /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as @@ -1348,22 +1343,21 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object), Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object)) { - Lisp_Object val; - struct handler *c; - - PUSH_HANDLER (c, handlers, CONDITION_CASE); + struct handler *c = push_handler (handlers, CONDITION_CASE); if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; - return (*hfun) (val); + return hfun (val); + } + else + { + Lisp_Object val = bfun (arg1, arg2); + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; + return val; } - - val = (*bfun) (arg1, arg2); - clobbered_eassert (handlerlist == c); - handlerlist = handlerlist->next; - return val; } /* Like internal_condition_case but call BFUN with NARGS as first, @@ -1378,64 +1372,46 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), ptrdiff_t nargs, Lisp_Object *args)) { - Lisp_Object val; - struct handler *c; - - PUSH_HANDLER (c, handlers, CONDITION_CASE); + struct handler *c = push_handler (handlers, CONDITION_CASE); if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; - return (*hfun) (val, nargs, args); + return hfun (val, nargs, args); } - - val = (*bfun) (nargs, args); - clobbered_eassert (handlerlist == c); - handlerlist = handlerlist->next; - return val; -} - -static void init_handler (struct handler *c, Lisp_Object tag_ch_val, - enum handlertype handlertype); - -void -push_handler (struct handler **c, Lisp_Object tag_ch_val, - enum handlertype handlertype) -{ - if (handlerlist->nextfree) - *c = handlerlist->nextfree; else { - *c = xmalloc (sizeof (struct handler)); - (*c)->nextfree = NULL; - handlerlist->nextfree = *c; + Lisp_Object val = bfun (nargs, args); + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; + return val; } - init_handler (*c, tag_ch_val, handlertype); } -bool -push_handler_nosignal (struct handler **c, Lisp_Object tag_ch_val, - enum handlertype handlertype) +struct handler * +push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype) { - if (handlerlist->nextfree) - *c = handlerlist->nextfree; - else - { - struct handler *h = malloc (sizeof (struct handler)); - if (! h) return false; - *c = h; - h->nextfree = NULL; - handlerlist->nextfree = h; - } - init_handler (*c, tag_ch_val, handlertype); - return true; + struct handler *c = push_handler_nosignal (tag_ch_val, handlertype); + if (!c) + memory_full (sizeof *c); + return c; } -static void -init_handler (struct handler *c, Lisp_Object tag_ch_val, - enum handlertype handlertype) +struct handler * +push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) { + struct handler *c = handlerlist->nextfree; + if (!c) + { + c = malloc (sizeof *c); + if (!c) + return c; + if (profiler_memory_running) + malloc_probe (sizeof *c); + c->nextfree = NULL; + handlerlist->nextfree = c; + } c->type = handlertype; c->tag_or_ch = tag_ch_val; c->val = Qnil; @@ -1446,6 +1422,7 @@ init_handler (struct handler *c, Lisp_Object tag_ch_val, c->interrupt_input_blocked = interrupt_input_blocked; c->byte_stack = byte_stack_list; handlerlist = c; + return c; } diff --git a/src/lisp.h b/src/lisp.h index 3b7bb40caa..71dca7201d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3183,18 +3183,6 @@ struct handler 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) \ - push_handler(&(c), (tag_ch_val), (handlertype)) - -extern void push_handler (struct handler **c, Lisp_Object tag_ch_val, - enum handlertype handlertype); - -/* Like push_handler, but don't signal if the handler could not be - allocated. Instead return false in that case. */ -extern bool push_handler_nosignal (struct handler **c, Lisp_Object tag_ch_val, - enum handlertype handlertype); - extern Lisp_Object memory_signal_data; /* An address near the bottom of the stack. @@ -3880,6 +3868,8 @@ extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); +extern struct handler *push_handler (Lisp_Object, enum handlertype); +extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); extern void record_unwind_protect_ptr (void (*) (void *), void *); -- 2.39.2