Mercurial > hg > xemacs-beta
comparison src/alloc.c @ 161:28f395d8dc7a r20-3b7
Import from CVS: tag r20-3b7
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:42:26 +0200 |
parents | 7d55a9ba150c |
children | 0132846995bd |
comparison
equal
deleted
inserted
replaced
160:1c55655d6702 | 161:28f395d8dc7a |
---|---|
3954 garbage_collect_1 (void) | 3954 garbage_collect_1 (void) |
3955 { | 3955 { |
3956 char stack_top_variable; | 3956 char stack_top_variable; |
3957 extern char *stack_bottom; | 3957 extern char *stack_bottom; |
3958 int i; | 3958 int i; |
3959 struct frame *f = selected_frame (); | |
3960 int speccount = specpdl_depth (); | 3959 int speccount = specpdl_depth (); |
3961 Lisp_Object pre_gc_cursor = Qnil; | 3960 Lisp_Object pre_gc_cursor = Qnil; |
3961 Lisp_Object changed_frames = Qnil; | |
3962 struct gcpro gcpro1; | 3962 struct gcpro gcpro1; |
3963 | 3963 |
3964 int cursor_changed = 0; | 3964 int cursor_changed_selected_frame = 0; |
3965 | 3965 |
3966 if (gc_in_progress != 0) | 3966 if (gc_in_progress != 0) |
3967 return; | 3967 return; |
3968 | 3968 |
3969 if (gc_currently_forbidden || in_display) | 3969 if (gc_currently_forbidden || in_display) |
3970 return; | 3970 return; |
3971 | 3971 |
3972 if (preparing_for_armageddon) | 3972 if (preparing_for_armageddon) |
3973 return; | 3973 return; |
3974 | 3974 |
3975 GCPRO1 (pre_gc_cursor); | 3975 GCPRO1 (changed_frames); |
3976 | 3976 |
3977 /* Very important to prevent GC during any of the following | 3977 /* Very important to prevent GC during any of the following |
3978 stuff that might run Lisp code; otherwise, we'll likely | 3978 stuff that might run Lisp code; otherwise, we'll likely |
3979 have infinite GC recursion. */ | 3979 have infinite GC recursion. */ |
3980 record_unwind_protect (restore_gc_inhibit, | 3980 record_unwind_protect (restore_gc_inhibit, |
3985 run_hook_trapping_errors ("Error in pre-gc-hook", Qpre_gc_hook); | 3985 run_hook_trapping_errors ("Error in pre-gc-hook", Qpre_gc_hook); |
3986 | 3986 |
3987 /* Now show the GC cursor/message. */ | 3987 /* Now show the GC cursor/message. */ |
3988 if (!noninteractive) | 3988 if (!noninteractive) |
3989 { | 3989 { |
3990 if (FRAME_WIN_P (f)) | 3990 /* No need to gcpro this; gc won't catch us now. */ |
3991 Lisp_Object frmcons, devcons, concons; | |
3992 Lisp_Object selframe = make_frame (selected_frame ()); | |
3993 | |
3994 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) | |
3991 { | 3995 { |
3992 Lisp_Object frame = make_frame (f); | 3996 struct frame *f = XFRAME (XCAR (frmcons)); |
3993 Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph, | 3997 int cursor_changed; |
3994 FRAME_SELECTED_WINDOW (f), | 3998 |
3995 ERROR_ME_NOT, 1); | 3999 if (FRAME_WIN_P (f)) |
3996 pre_gc_cursor = f->pointer; | |
3997 if (POINTER_IMAGE_INSTANCEP (cursor) | |
3998 /* don't change if we don't know how to change back. */ | |
3999 && POINTER_IMAGE_INSTANCEP (pre_gc_cursor)) | |
4000 { | 4000 { |
4001 cursor_changed = 1; | 4001 Lisp_Object frame = XCAR (frmcons); |
4002 Fset_frame_pointer (frame, cursor); | 4002 Lisp_Object cursor = |
4003 glyph_image_instance (Vgc_pointer_glyph, | |
4004 FRAME_SELECTED_WINDOW (f), | |
4005 ERROR_ME_NOT, 1); | |
4006 pre_gc_cursor = f->pointer; | |
4007 if (POINTER_IMAGE_INSTANCEP (cursor) | |
4008 /* don't change if we don't know how to change back. */ | |
4009 && POINTER_IMAGE_INSTANCEP (pre_gc_cursor)) | |
4010 { | |
4011 Fset_frame_pointer (frame, cursor); | |
4012 /* Add the frame to the list. */ | |
4013 changed_frames = Fcons (pre_gc_cursor, changed_frames); | |
4014 changed_frames = Fcons (XCAR (frmcons), changed_frames); | |
4015 if (EQ (XCAR (frmcons), selframe)) | |
4016 cursor_changed_selected_frame = 1; | |
4017 } | |
4003 } | 4018 } |
4004 } | 4019 } |
4005 | 4020 /* Now handle the plain old message. */ |
4006 /* Don't print messages to the stream device. */ | 4021 { |
4007 if (!cursor_changed && !FRAME_STREAM_P (f)) | 4022 struct frame *f = XFRAME (selframe); |
4008 { | 4023 /* Don't print messages to the stream device. */ |
4009 char *msg = (STRINGP (Vgc_message) | 4024 if (!cursor_changed_selected_frame && !FRAME_STREAM_P (f)) |
4010 ? GETTEXT ((char *) XSTRING_DATA (Vgc_message)) | 4025 { |
4011 : 0); | 4026 char *msg = (STRINGP (Vgc_message) |
4012 Lisp_Object args[2], whole_msg; | 4027 ? GETTEXT ((char *) XSTRING_DATA (Vgc_message)) |
4013 args[0] = build_string (msg ? msg : | 4028 : 0); |
4014 GETTEXT ((CONST char *) gc_default_message)); | 4029 Lisp_Object args[2], whole_msg; |
4015 args[1] = build_string ("..."); | 4030 args[0] = |
4016 whole_msg = Fconcat (2, args); | 4031 build_string (msg ? msg : |
4017 echo_area_message (f, (Bufbyte *) 0, whole_msg, 0, -1, | 4032 GETTEXT ((CONST char *) gc_default_message)); |
4018 Qgarbage_collecting); | 4033 args[1] = build_string ("..."); |
4019 } | 4034 whole_msg = Fconcat (2, args); |
4035 echo_area_message (f, (Bufbyte *) 0, whole_msg, 0, -1, | |
4036 Qgarbage_collecting); | |
4037 } | |
4038 } | |
4020 } | 4039 } |
4021 | 4040 |
4022 /***** Now we actually start the garbage collection. */ | 4041 /***** Now we actually start the garbage collection. */ |
4023 | 4042 |
4024 gc_in_progress = 1; | 4043 gc_in_progress = 1; |
4150 run_hook_trapping_errors ("Error in post-gc-hook", Qpost_gc_hook); | 4169 run_hook_trapping_errors ("Error in post-gc-hook", Qpost_gc_hook); |
4151 | 4170 |
4152 /* Now remove the GC cursor/message */ | 4171 /* Now remove the GC cursor/message */ |
4153 if (!noninteractive) | 4172 if (!noninteractive) |
4154 { | 4173 { |
4155 if (cursor_changed) | 4174 Lisp_Object tail = changed_frames; |
4156 Fset_frame_pointer (make_frame (f), pre_gc_cursor); | 4175 while (CONSP (tail) && CONSP (XCDR (tail))) |
4157 else if (!FRAME_STREAM_P (f)) | 4176 { |
4177 Fset_frame_pointer (XCAR (tail), XCAR (XCDR (tail))); | |
4178 tail = XCDR (XCDR (tail)); | |
4179 } | |
4180 if (!cursor_changed_selected_frame && !FRAME_STREAM_P (selected_frame ())) | |
4158 { | 4181 { |
4159 char *msg = (STRINGP (Vgc_message) | 4182 char *msg = (STRINGP (Vgc_message) |
4160 ? GETTEXT ((char *) XSTRING_DATA (Vgc_message)) | 4183 ? GETTEXT ((char *) XSTRING_DATA (Vgc_message)) |
4161 : 0); | 4184 : 0); |
4162 | 4185 |