Mercurial > hg > xemacs-beta
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; |