Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 163:0132846995bd r20-3b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b8
author cvs
date Mon, 13 Aug 2007 09:43:35 +0200
parents 28f395d8dc7a
children 5a88923fcbfe
comparison
equal deleted inserted replaced
162:4de2936b4e77 163:0132846995bd
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 ();
3959 int speccount = specpdl_depth (); 3960 int speccount = specpdl_depth ();
3960 Lisp_Object pre_gc_cursor = Qnil; 3961 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_selected_frame = 0; 3964 int cursor_changed = 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 (changed_frames); 3975 GCPRO1 (pre_gc_cursor);
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 /* No need to gcpro this; gc won't catch us now. */ 3990 if (FRAME_WIN_P (f))
3991 Lisp_Object frmcons, devcons, concons;
3992 Lisp_Object selframe = make_frame (selected_frame ());
3993
3994 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
3995 { 3991 {
3996 struct frame *f = XFRAME (XCAR (frmcons)); 3992 Lisp_Object frame = make_frame (f);
3997 int cursor_changed; 3993 Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph,
3998 3994 FRAME_SELECTED_WINDOW (f),
3999 if (FRAME_WIN_P (f)) 3995 ERROR_ME_NOT, 1);
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 Lisp_Object frame = XCAR (frmcons); 4001 cursor_changed = 1;
4002 Lisp_Object cursor = 4002 Fset_frame_pointer (frame, 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 }
4018 } 4003 }
4019 } 4004 }
4020 /* Now handle the plain old message. */ 4005
4021 { 4006 /* Don't print messages to the stream device. */
4022 struct frame *f = XFRAME (selframe); 4007 if (!cursor_changed && !FRAME_STREAM_P (f))
4023 /* Don't print messages to the stream device. */ 4008 {
4024 if (!cursor_changed_selected_frame && !FRAME_STREAM_P (f)) 4009 char *msg = (STRINGP (Vgc_message)
4025 { 4010 ? GETTEXT ((char *) XSTRING_DATA (Vgc_message))
4026 char *msg = (STRINGP (Vgc_message) 4011 : 0);
4027 ? GETTEXT ((char *) XSTRING_DATA (Vgc_message)) 4012 Lisp_Object args[2], whole_msg;
4028 : 0); 4013 args[0] = build_string (msg ? msg :
4029 Lisp_Object args[2], whole_msg; 4014 GETTEXT ((CONST char *) gc_default_message));
4030 args[0] = 4015 args[1] = build_string ("...");
4031 build_string (msg ? msg : 4016 whole_msg = Fconcat (2, args);
4032 GETTEXT ((CONST char *) gc_default_message)); 4017 echo_area_message (f, (Bufbyte *) 0, whole_msg, 0, -1,
4033 args[1] = build_string ("..."); 4018 Qgarbage_collecting);
4034 whole_msg = Fconcat (2, args); 4019 }
4035 echo_area_message (f, (Bufbyte *) 0, whole_msg, 0, -1,
4036 Qgarbage_collecting);
4037 }
4038 }
4039 } 4020 }
4040 4021
4041 /***** Now we actually start the garbage collection. */ 4022 /***** Now we actually start the garbage collection. */
4042 4023
4043 gc_in_progress = 1; 4024 gc_in_progress = 1;
4169 run_hook_trapping_errors ("Error in post-gc-hook", Qpost_gc_hook); 4150 run_hook_trapping_errors ("Error in post-gc-hook", Qpost_gc_hook);
4170 4151
4171 /* Now remove the GC cursor/message */ 4152 /* Now remove the GC cursor/message */
4172 if (!noninteractive) 4153 if (!noninteractive)
4173 { 4154 {
4174 Lisp_Object tail = changed_frames; 4155 if (cursor_changed)
4175 while (CONSP (tail) && CONSP (XCDR (tail))) 4156 Fset_frame_pointer (make_frame (f), pre_gc_cursor);
4176 { 4157 else if (!FRAME_STREAM_P (f))
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 ()))
4181 { 4158 {
4182 char *msg = (STRINGP (Vgc_message) 4159 char *msg = (STRINGP (Vgc_message)
4183 ? GETTEXT ((char *) XSTRING_DATA (Vgc_message)) 4160 ? GETTEXT ((char *) XSTRING_DATA (Vgc_message))
4184 : 0); 4161 : 0);
4185 4162