aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorPaul Eggert2016-12-27 10:32:44 -0800
committerPaul Eggert2016-12-27 10:38:15 -0800
commita02ca7a231c3856efd57a502c6a73e6c251091e8 (patch)
treeaa5766c2c9f677ab0bfb81bcc3b920fabdc5305c /src
parente6161f648903d821865b9610b3b6aa0f82a5dcb7 (diff)
downloademacs-a02ca7a231c3856efd57a502c6a73e6c251091e8.tar.gz
emacs-a02ca7a231c3856efd57a502c6a73e6c251091e8.zip
Simplify prog1 implementation
Inspired by a suggestion from Chris Gregory in: http://lists.gnu.org/archive/html/emacs-devel/2016-12/msg00965.html On my platform, this generates exactly the same machine insns. * src/eval.c (prog_ignore): Rename from unwind_body, since it’s more general than that. All callers changed. (Fprog1): Simplify by using prog_ignore. (Fwhile): Clarify by using prog_ignore.
Diffstat (limited to 'src')
-rw-r--r--src/bytecode.c2
-rw-r--r--src/eval.c21
-rw-r--r--src/lisp.h2
3 files changed, 8 insertions, 17 deletions
diff --git a/src/bytecode.c b/src/bytecode.c
index d484dbb25c6..3bb96c2ed2d 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -809,7 +809,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
809 { 809 {
810 Lisp_Object handler = POP; 810 Lisp_Object handler = POP;
811 /* Support for a function here is new in 24.4. */ 811 /* Support for a function here is new in 24.4. */
812 record_unwind_protect (FUNCTIONP (handler) ? bcall0 : unwind_body, 812 record_unwind_protect (FUNCTIONP (handler) ? bcall0 : prog_ignore,
813 handler); 813 handler);
814 NEXT; 814 NEXT;
815 } 815 }
diff --git a/src/eval.c b/src/eval.c
index ddcccc285d3..e50e26a11d2 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -453,11 +453,10 @@ usage: (progn BODY...) */)
453 return val; 453 return val;
454} 454}
455 455
456/* Evaluate BODY sequentially, discarding its value. Suitable for 456/* Evaluate BODY sequentially, discarding its value. */
457 record_unwind_protect. */
458 457
459void 458void
460unwind_body (Lisp_Object body) 459prog_ignore (Lisp_Object body)
461{ 460{
462 Fprogn (body); 461 Fprogn (body);
463} 462}
@@ -469,16 +468,8 @@ whose values are discarded.
469usage: (prog1 FIRST BODY...) */) 468usage: (prog1 FIRST BODY...) */)
470 (Lisp_Object args) 469 (Lisp_Object args)
471{ 470{
472 Lisp_Object val; 471 Lisp_Object val = eval_sub (XCAR (args));
473 Lisp_Object args_left; 472 prog_ignore (XCDR (args));
474
475 args_left = args;
476 val = args;
477
478 val = eval_sub (XCAR (args_left));
479 while (CONSP (args_left = XCDR (args_left)))
480 eval_sub (XCAR (args_left));
481
482 return val; 473 return val;
483} 474}
484 475
@@ -988,7 +979,7 @@ usage: (while TEST BODY...) */)
988 while (!NILP (eval_sub (test))) 979 while (!NILP (eval_sub (test)))
989 { 980 {
990 QUIT; 981 QUIT;
991 Fprogn (body); 982 prog_ignore (body);
992 } 983 }
993 984
994 return Qnil; 985 return Qnil;
@@ -1191,7 +1182,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1191 Lisp_Object val; 1182 Lisp_Object val;
1192 ptrdiff_t count = SPECPDL_INDEX (); 1183 ptrdiff_t count = SPECPDL_INDEX ();
1193 1184
1194 record_unwind_protect (unwind_body, XCDR (args)); 1185 record_unwind_protect (prog_ignore, XCDR (args));
1195 val = eval_sub (XCAR (args)); 1186 val = eval_sub (XCAR (args));
1196 return unbind_to (count, val); 1187 return unbind_to (count, val);
1197} 1188}
diff --git a/src/lisp.h b/src/lisp.h
index dc2c7a60085..1a586cab0d0 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3867,7 +3867,7 @@ extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
3867extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); 3867extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
3868extern void init_eval (void); 3868extern void init_eval (void);
3869extern void syms_of_eval (void); 3869extern void syms_of_eval (void);
3870extern void unwind_body (Lisp_Object); 3870extern void prog_ignore (Lisp_Object);
3871extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t); 3871extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t);
3872extern void mark_specpdl (union specbinding *first, union specbinding *ptr); 3872extern void mark_specpdl (union specbinding *first, union specbinding *ptr);
3873extern void get_backtrace (Lisp_Object array); 3873extern void get_backtrace (Lisp_Object array);