comparison src/eval.c @ 1318:b531bf8658e9

[xemacs-hg @ 2003-02-21 06:56:46 by ben] redisplay fixes et al. PROBLEMS: Add comment about Cygwin, unexec and sysmalloc. Move some non-general stuff out of general. Make a section for x86. configure.in: Add check for broken alloca in funcalls. mule/mule-cmds.el: Alias file-name to native not vice-versa. Do set EOL of native but not of process output to fix various problems and be consistent with code-init.el. code-cmds.el: Return a name not a coding system. code-init.el: Reindent. Remove `file-name' since it should always be the same as native. unicode.el: Rename to load-unicode-mapping-table as suggested by the anonymous (but rather Turnbullian) comment in unicode.c. xemacs.dsp: Add /k to default build. alloc.c: Make gc_currently_forbidden static. config.h.in, lisp.h: Move some stuff to lisp.h. console-gtk.h, console-impl.h, console-msw.h, console-x.h, event-Xt.c, event-msw.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, gtk-xemacs.c: Remove duplicated code to redraw exposed area. Add deadbox method needed by the generalized redraw code. Defer redrawing if already in redisplay. frame-msw.c, event-stream.c, frame.c: Add comments about calling Lisp. debug.c, general-slots.h: Move generalish symbols to general-slots.h. doprnt.c: reindent. lisp.h, dynarr.c: Add debug code for locking a dynarr to catch invalid mods. Use in redisplay.c. eval.c: file-coding.c: Define file-name as alias for native not vice-versa. frame-gtk.c, frame-x.c: Move Qwindow_id to general-slots. dialog-msw.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, gui.c, gui.h, menubar-msw.c, menubar.c: Ensure that various glyph functions that eval within redisplay protect the evals. Same for calls to internal_equal(). Modify various functions, e.g. gui_item_*(), to protect evals within redisplay, taking an in_redisplay parameter if it's possible for them to be called both inside and outside of redisplay. gutter.c: Defer specifier-changed updating till after redisplay, if necessary, since we need to enter redisplay to do it. gutter.c: Do nothing if in redisplay. lisp.h: Add version of alloca() for use in function calls. lisp.h: Add XCAD[D+]R up to 6 D's, and aliases X1ST, X2ND, etc. frame.c, frame.h, redisplay.c, redisplay.h, signal.c, toolbar.c: Redo critical-section code and move from frame.c to redisplay.c. Require that every place inside of redisplay catch errors itself, not at the edge of the critical section (thereby bypassing the rest of redisplay and leaving things in an inconsistent state). Introduce separate means of holding frame-size changes without entering a complete critical section. Introduce "post-redisplay" methods for deferring things till after redisplay. Abort if we enter redisplay reentrantly. Disable all quit checking in redisplay since it's too dangerous. Ensure that all calls to QUIT trigger an abort if unprotected. redisplay.c, scrollbar-gtk.c, scrollbar-x.c, scrollbar.c: Create enter/exit_redisplay_critical_section_maybe() for code that needs to ensure it's in a critical section but doesn't interfere with an existing critical section. sysdep.c: Use _wexecve() when under Windows NT for Unicode correctness. text.c, text.h: Add new_dfc() functions, which return an alloca()ed value rather than requiring an lvalue. (Not really used yet; used in another workspace, to come.) Add some macros for SIZED_EXTERNAL. Update the encoding aliases after involved scrutinization of the X manual. unicode.c: Answer the anonymous but suspiciously Turnbullian questions. Rename parse-unicode-translation-table to load-unicode-mapping-table, as suggested.
author ben
date Fri, 21 Feb 2003 06:57:21 +0000
parents 671b65f2b075
children 0e48d8b45bdb
comparison
equal deleted inserted replaced
1317:d9d08dc5e617 1318:b531bf8658e9
402 /* Used for error catching purposes by throw_or_bomb_out */ 402 /* Used for error catching purposes by throw_or_bomb_out */
403 static int throw_level; 403 static int throw_level;
404 #endif 404 #endif
405 405
406 static int warning_will_be_discarded (Lisp_Object level); 406 static int warning_will_be_discarded (Lisp_Object level);
407 static void check_proper_critical_section_nonlocal_exit_protection (void);
408 407
409 408
410 /************************************************************************/ 409 /************************************************************************/
411 /* The subr object type */ 410 /* The subr object type */
412 /************************************************************************/ 411 /************************************************************************/
1440 1439
1441 /************************************************************************/ 1440 /************************************************************************/
1442 /* Non-local exits */ 1441 /* Non-local exits */
1443 /************************************************************************/ 1442 /************************************************************************/
1444 1443
1444 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS
1445
1446 int
1447 proper_redisplay_wrapping_in_place (void)
1448 {
1449 return !in_display
1450 || ((get_inhibit_flags () & INTERNAL_INHIBIT_ERRORS)
1451 && (get_inhibit_flags () & INTERNAL_INHIBIT_THROWS));
1452 }
1453
1454 static void
1455 check_proper_critical_section_nonlocal_exit_protection (void)
1456 {
1457 assert_with_message
1458 (proper_redisplay_wrapping_in_place (),
1459 "Attempted non-local exit from within redisplay without being properly wrapped");
1460 }
1461
1462 static void
1463 check_proper_critical_section_lisp_protection (void)
1464 {
1465 assert_with_message
1466 (proper_redisplay_wrapping_in_place (),
1467 "Attempt to call Lisp code from within redisplay without being properly wrapped");
1468 }
1469
1470 #endif /* ERROR_CHECK_TRAPPING_PROBLEMS */
1471
1445 DEFUN ("catch", Fcatch, 1, UNEVALLED, 0, /* 1472 DEFUN ("catch", Fcatch, 1, UNEVALLED, 0, /*
1446 \(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'. 1473 \(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'.
1447 TAG is evalled to get the tag to use. Then the BODY is executed. 1474 TAG is evalled to get the tag to use. Then the BODY is executed.
1448 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'. 1475 Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
1449 If no throw happens, `catch' returns the value of the last BODY form. 1476 If no throw happens, `catch' returns the value of the last BODY form.
1611 /* die if we recurse more than is reasonable */ 1638 /* die if we recurse more than is reasonable */
1612 if (++throw_level > 20) 1639 if (++throw_level > 20)
1613 abort (); 1640 abort ();
1614 #endif 1641 #endif
1615 1642
1643 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS
1616 check_proper_critical_section_nonlocal_exit_protection (); 1644 check_proper_critical_section_nonlocal_exit_protection ();
1645 #endif
1617 1646
1618 /* If bomb_out_p is t, this is being called from Fsignal as a 1647 /* If bomb_out_p is t, this is being called from Fsignal as a
1619 "last resort" when there is no handler for this error and 1648 "last resort" when there is no handler for this error and
1620 the debugger couldn't be invoked, so we are throwing to 1649 the debugger couldn't be invoked, so we are throwing to
1621 'top-level. If this tag doesn't exist (happens during the 1650 'top-level. If this tag doesn't exist (happens during the
2133 "Returning a value from an error is no longer supported", 2162 "Returning a value from an error is no longer supported",
2134 Qunbound); 2163 Qunbound);
2135 #endif 2164 #endif
2136 } 2165 }
2137 2166
2138 extern int in_display;
2139 extern int gc_currently_forbidden;
2140
2141 2167
2142 /************************************************************************/ 2168 /************************************************************************/
2143 /* the workhorse error-signaling function */ 2169 /* the workhorse error-signaling function */
2144 /************************************************************************/ 2170 /************************************************************************/
2145 2171
2151 void signal_1 (void); 2177 void signal_1 (void);
2152 2178
2153 void 2179 void
2154 signal_1 (void) 2180 signal_1 (void)
2155 { 2181 {
2156 }
2157
2158 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS
2159
2160 static void
2161 check_proper_critical_section_gc_protection (void)
2162 {
2163 assert_with_message
2164 (!in_display || gc_currently_forbidden,
2165 "Potential GC from within redisplay without being properly wrapped");
2166 }
2167
2168 #endif /* ERROR_CHECK_TRAPPING_PROBLEMS */
2169
2170 static void
2171 check_proper_critical_section_nonlocal_exit_protection (void)
2172 {
2173 assert_with_message
2174 (!in_display
2175 || ((get_inhibit_flags () & INTERNAL_INHIBIT_ERRORS)
2176 && (get_inhibit_flags () & INTERNAL_INHIBIT_THROWS)),
2177 "Attempted non-local exit from within redisplay without being properly wrapped");
2178 } 2182 }
2179 2183
2180 /* #### This function has not been synched with FSF. It diverges 2184 /* #### This function has not been synched with FSF. It diverges
2181 significantly. */ 2185 significantly. */
2182 2186
2232 /* We abort if in_display and we are not protected, as garbage 2236 /* We abort if in_display and we are not protected, as garbage
2233 collections and non-local exits will invariably be fatal, but in 2237 collections and non-local exits will invariably be fatal, but in
2234 messy, difficult-to-debug ways. See enter_redisplay_critical_section(). 2238 messy, difficult-to-debug ways. See enter_redisplay_critical_section().
2235 */ 2239 */
2236 2240
2241 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS
2237 check_proper_critical_section_nonlocal_exit_protection (); 2242 check_proper_critical_section_nonlocal_exit_protection ();
2243 #endif
2238 2244
2239 conditions = Fget (error_symbol, Qerror_conditions, Qnil); 2245 conditions = Fget (error_symbol, Qerror_conditions, Qnil);
2240 2246
2241 for (handlers = Vcondition_handlers; 2247 for (handlers = Vcondition_handlers;
2242 CONSP (handlers); 2248 CONSP (handlers);
3462 /* This function can GC */ 3468 /* This function can GC */
3463 Lisp_Object fun, val, original_fun, original_args; 3469 Lisp_Object fun, val, original_fun, original_args;
3464 int nargs; 3470 int nargs;
3465 struct backtrace backtrace; 3471 struct backtrace backtrace;
3466 3472
3473 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS
3474 check_proper_critical_section_lisp_protection ();
3475 #endif
3476
3467 /* I think this is a pretty safe place to call Lisp code, don't you? */ 3477 /* I think this is a pretty safe place to call Lisp code, don't you? */
3468 while (!in_warnings && !NILP (Vpending_warnings) 3478 while (!in_warnings && !NILP (Vpending_warnings)
3469 /* well, perhaps not so safe after all! */ 3479 /* well, perhaps not so safe after all! */
3470 && !(inhibit_flags & INHIBIT_ANY_CHANGE_AFFECTING_REDISPLAY)) 3480 && !(inhibit_flags & INHIBIT_ANY_CHANGE_AFFECTING_REDISPLAY))
3471 { 3481 {
3503 else 3513 else
3504 return form; 3514 return form;
3505 } 3515 }
3506 3516
3507 QUIT; 3517 QUIT;
3508 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS
3509 check_proper_critical_section_gc_protection ();
3510 #endif
3511 if (need_to_garbage_collect) 3518 if (need_to_garbage_collect)
3512 { 3519 {
3513 struct gcpro gcpro1; 3520 struct gcpro gcpro1;
3514 GCPRO1 (form); 3521 GCPRO1 (form);
3515 garbage_collect_1 (); 3522 garbage_collect_1 ();
3757 struct backtrace backtrace; 3764 struct backtrace backtrace;
3758 int fun_nargs = nargs - 1; 3765 int fun_nargs = nargs - 1;
3759 Lisp_Object *fun_args = args + 1; 3766 Lisp_Object *fun_args = args + 1;
3760 Lisp_Object orig_fun; 3767 Lisp_Object orig_fun;
3761 3768
3769 /* QUIT will check for proper redisplay wrapping */
3770
3762 QUIT; 3771 QUIT;
3763 3772
3764 if (funcall_allocation_flag) 3773 if (funcall_allocation_flag)
3765 { 3774 {
3766 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS
3767 check_proper_critical_section_gc_protection ();
3768 #endif
3769 if (need_to_garbage_collect) 3775 if (need_to_garbage_collect)
3770 /* Callers should gcpro lexpr args */ 3776 /* Callers should gcpro lexpr args */
3771 garbage_collect_1 (); 3777 garbage_collect_1 ();
3772 if (need_to_check_c_alloca) 3778 if (need_to_check_c_alloca)
3773 { 3779 {
4874 { 4880 {
4875 return call_with_condition_handler (flagged_a_squirmer, opaque, 4881 return call_with_condition_handler (flagged_a_squirmer, opaque,
4876 call_trapping_problems_2, opaque); 4882 call_trapping_problems_2, opaque);
4877 } 4883 }
4878 4884
4885 /* Turn on the trapping flags in FLAGS -- see call_trapping_problems().
4886 This cannot handle INTERNAL_INHIBIT_THROWS() or INTERNAL_INHIBIT_ERRORS
4887 (because they ultimately boil down to a setjmp()!) -- you must directly
4888 use call_trapping_problems() for that. Turn the flags off with
4889 unbind_to(). Returns the "canonicalized" flags (particularly in the
4890 case of INHIBIT_ANY_CHANGE_AFFECTING_REDISPLAY, which is shorthand for
4891 various other flags). */
4892
4893 int
4894 set_trapping_problems_flags (int flags)
4895 {
4896 int new_inhibit_flags;
4897
4898 if (flags & INHIBIT_ANY_CHANGE_AFFECTING_REDISPLAY)
4899 flags |= INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION
4900 | INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION
4901 | INHIBIT_ENTERING_DEBUGGER
4902 | INHIBIT_WARNING_ISSUE
4903 | INHIBIT_GC;
4904
4905 new_inhibit_flags = inhibit_flags | flags;
4906 if (new_inhibit_flags != inhibit_flags)
4907 internal_bind_int (&inhibit_flags, new_inhibit_flags);
4908
4909 if (flags & INHIBIT_QUIT)
4910 specbind (Qinhibit_quit, Qt);
4911
4912 if (flags & UNINHIBIT_QUIT)
4913 begin_do_check_for_quit ();
4914
4915 if (flags & INHIBIT_GC)
4916 begin_gc_forbidden ();
4917
4918 /* #### If we have nested calls to call_trapping_problems(), and the
4919 inner one creates some buffers/etc., should the outer one be able
4920 to delete them? I think so, but it means we need to combine rather
4921 than just reset the value. */
4922 if (flags & INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION)
4923 internal_bind_lisp_object (&Vdeletable_permanent_display_objects, Qnil);
4924
4925 if (flags & INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION)
4926 internal_bind_lisp_object (&Vmodifiable_buffers, Qnil);
4927
4928 return flags;
4929 }
4930
4879 /* This is equivalent to (*fun) (arg), except that various conditions 4931 /* This is equivalent to (*fun) (arg), except that various conditions
4880 can be trapped or inhibited, according to FLAGS. 4932 can be trapped or inhibited, according to FLAGS.
4881 4933
4882 If FLAGS does not contain NO_INHIBIT_ERRORS, when an error occurs, 4934 If FLAGS does not contain NO_INHIBIT_ERRORS, when an error occurs,
4883 the error is caught and a warning is issued, specifying the 4935 the error is caught and a warning is issued, specifying the
5008 int flags, 5060 int flags,
5009 struct call_trapping_problems_result *problem, 5061 struct call_trapping_problems_result *problem,
5010 Lisp_Object (*fun) (void *), 5062 Lisp_Object (*fun) (void *),
5011 void *arg) 5063 void *arg)
5012 { 5064 {
5013 int speccount = specpdl_depth(); 5065 int speccount = specpdl_depth ();
5014 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 5066 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
5015 struct call_trapping_problems package; 5067 struct call_trapping_problems package;
5016 Lisp_Object opaque, thrown_tag, tem; 5068 Lisp_Object opaque, thrown_tag, tem;
5017 int thrown = 0; 5069 int thrown = 0;
5018 5070
5031 Qnil; 5083 Qnil;
5032 package.error_conditions = Qnil; 5084 package.error_conditions = Qnil;
5033 package.data = Qnil; 5085 package.data = Qnil;
5034 package.backtrace = Qnil; 5086 package.backtrace = Qnil;
5035 5087
5036 if (flags & INHIBIT_ANY_CHANGE_AFFECTING_REDISPLAY) 5088 flags = set_trapping_problems_flags (flags);
5037 flags |= INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION
5038 | INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION
5039 | INHIBIT_ENTERING_DEBUGGER
5040 | INHIBIT_WARNING_ISSUE
5041 | INHIBIT_GC;
5042
5043 {
5044 int new_inhibit_flags = inhibit_flags | flags;
5045 if (new_inhibit_flags != inhibit_flags)
5046 internal_bind_int (&inhibit_flags, new_inhibit_flags);
5047 }
5048
5049 if (flags & INHIBIT_QUIT)
5050 specbind (Qinhibit_quit, Qt);
5051
5052 if (flags & UNINHIBIT_QUIT)
5053 begin_do_check_for_quit ();
5054
5055 if (flags & INHIBIT_GC)
5056 begin_gc_forbidden ();
5057
5058 /* #### If we have nested calls to call_trapping_problems(), and the
5059 inner one creates some buffers/etc., should the outer one be able
5060 to delete them? I think so, but it means we need to combine rather
5061 than just reset the value. */
5062 if (flags & INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION)
5063 internal_bind_lisp_object (&Vdeletable_permanent_display_objects, Qnil);
5064
5065 if (flags & INHIBIT_EXISTING_BUFFER_TEXT_MODIFICATION)
5066 internal_bind_lisp_object (&Vmodifiable_buffers, Qnil);
5067 5089
5068 if (flags & (INTERNAL_INHIBIT_THROWS | INTERNAL_INHIBIT_ERRORS)) 5090 if (flags & (INTERNAL_INHIBIT_THROWS | INTERNAL_INHIBIT_ERRORS))
5069 opaque = make_opaque_ptr (&package); 5091 opaque = make_opaque_ptr (&package);
5070 else 5092 else
5071 opaque = Qnil; 5093 opaque = Qnil;