Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 396:6719134a07c2 r21-2-13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-13
author cvs
date Mon, 13 Aug 2007 11:12:05 +0200
parents 1f50e6fe4f3f
children 74fd4e045ea6
comparison
equal deleted inserted replaced
395:de2c2a7459d2 396:6719134a07c2
633 633
634 634
635 /************************************************************************/ 635 /************************************************************************/
636 /* Debugger support */ 636 /* Debugger support */
637 /************************************************************************/ 637 /************************************************************************/
638 /* Give gdb/dbx enough information to decode Lisp Objects. 638 /* Give gdb/dbx enough information to decode Lisp Objects. We make
639 We make sure certain symbols are defined, so gdb doesn't complain 639 sure certain symbols are always defined, so gdb doesn't complain
640 about expressions in src/gdbinit. Values are randomly chosen. 640 about expressions in src/gdbinit. See src/gdbinit or src/dbxrc to
641 See src/gdbinit or src/dbxrc to see how this is used. */ 641 see how this is used. */
642 642
643 enum dbg_constants
644 {
645 #ifdef USE_MINIMAL_TAGBITS 643 #ifdef USE_MINIMAL_TAGBITS
646 dbg_valmask = (EMACS_INT) (((1UL << VALBITS) - 1) << GCBITS), 644 EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS;
647 dbg_typemask = (EMACS_INT) ((1UL << GCTYPEBITS) - 1), 645 EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1;
648 dbg_USE_MINIMAL_TAGBITS = 1, 646 unsigned char dbg_USE_MINIMAL_TAGBITS = 1;
649 dbg_Lisp_Type_Int = 100, 647 unsigned char Lisp_Type_Int = 100;
650 #else /* ! USE_MIMIMAL_TAGBITS */ 648 #else
651 dbg_valmask = (EMACS_INT) ((1UL << VALBITS) - 1), 649 EMACS_UINT dbg_valmask = (1UL << VALBITS) - 1;
652 dbg_typemask = (EMACS_INT) (((1UL << GCTYPEBITS) - 1) << (VALBITS + GCMARKBITS)), 650 EMACS_UINT dbg_typemask = ((1UL << GCTYPEBITS) - 1) << (VALBITS + GCMARKBITS);
653 dbg_USE_MINIMAL_TAGBITS = 0, 651 unsigned char dbg_USE_MINIMAL_TAGBITS = 0;
654 dbg_Lisp_Type_Int = Lisp_Type_Int, 652 #endif
655 #endif /* ! USE_MIMIMAL_TAGBITS */
656 653
657 #ifdef USE_UNION_TYPE 654 #ifdef USE_UNION_TYPE
658 dbg_USE_UNION_TYPE = 1, 655 unsigned char dbg_USE_UNION_TYPE = 1;
659 #else 656 #else
660 dbg_USE_UNION_TYPE = 0, 657 unsigned char dbg_USE_UNION_TYPE = 0;
661 #endif 658 #endif
662 659
663 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION 660 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
664 dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1, 661 unsigned char dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1;
665 #else 662 #else
666 dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 0, 663 unsigned char dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 0;
667 #endif 664 #endif
668 665
669 dbg_Lisp_Type_Char = Lisp_Type_Char,
670 dbg_Lisp_Type_Record = Lisp_Type_Record,
671 #ifdef LRECORD_CONS 666 #ifdef LRECORD_CONS
672 dbg_Lisp_Type_Cons = 101, 667 unsigned char Lisp_Type_Cons = 101;
673 #else 668 #else
674 dbg_Lisp_Type_Cons = Lisp_Type_Cons, 669 unsigned char lrecord_cons;
675 lrecord_cons = 201, 670 #endif
676 #endif 671
677 #ifdef LRECORD_STRING 672 #ifdef LRECORD_STRING
678 dbg_Lisp_Type_String = 102, 673 unsigned char Lisp_Type_String = 102;
679 #else 674 #else
680 dbg_Lisp_Type_String = Lisp_Type_String, 675 unsigned char lrecord_string;
681 lrecord_string = 202, 676 #endif
682 #endif 677
683 #ifdef LRECORD_VECTOR 678 #ifdef LRECORD_VECTOR
684 dbg_Lisp_Type_Vector = 103, 679 unsigned char Lisp_Type_Vector = 103;
685 #else 680 #else
686 dbg_Lisp_Type_Vector = Lisp_Type_Vector, 681 unsigned char lrecord_vector;
687 lrecord_vector = 203, 682 #endif
688 #endif 683
689 #ifdef LRECORD_SYMBOL 684 #ifdef LRECORD_SYMBOL
690 dbg_Lisp_Type_Symbol = 104, 685 unsigned char Lisp_Type_Symbol = 104;
691 #else 686 #else
692 dbg_Lisp_Type_Symbol = Lisp_Type_Symbol, 687 unsigned char lrecord_symbol;
693 lrecord_symbol = 204, 688 #endif
694 #endif 689
695 #ifndef MULE 690 #ifndef MULE
696 lrecord_char_table_entry = 205, 691 unsigned char lrecord_char_table_entry;
697 lrecord_charset = 206, 692 unsigned char lrecord_charset;
698 lrecord_coding_system = 207, 693 #ifndef FILE_CODING
699 #endif 694 unsigned char lrecord_coding_system;
695 #endif
696 #endif
697
700 #ifndef HAVE_TOOLBARS 698 #ifndef HAVE_TOOLBARS
701 lrecord_toolbar_button = 208, 699 unsigned char lrecord_toolbar_button;
702 #endif 700 #endif
703 #ifndef HAVE_TOOLTALK 701
704 lrecord_tooltalk_message = 210, 702 #ifndef TOOLTALK
705 lrecord_tooltalk_pattern = 211, 703 unsigned char lrecord_tooltalk_message;
706 #endif 704 unsigned char lrecord_tooltalk_pattern;
705 #endif
706
707 #ifndef HAVE_DATABASE 707 #ifndef HAVE_DATABASE
708 lrecord_database = 212, 708 unsigned char lrecord_database;
709 #endif 709 #endif
710 dbg_valbits = VALBITS, 710
711 dbg_gctypebits = GCTYPEBITS 711 unsigned char dbg_valbits = VALBITS;
712 /* If we don't have an actual object of this enum, pgcc (and perhaps 712 unsigned char dbg_gctypebits = GCTYPEBITS;
713 other compilers) might optimize away the entire type declaration :-( */ 713
714 } dbg_dummy; 714 /* Macros turned into functions for ease of debugging.
715
716 /* A few macros turned into functions for ease of debugging.
717 Debuggers don't know about macros! */ 715 Debuggers don't know about macros! */
718 int dbg_eq (Lisp_Object obj1, Lisp_Object obj2); 716 int dbg_eq (Lisp_Object obj1, Lisp_Object obj2);
719 int 717 int
720 dbg_eq (Lisp_Object obj1, Lisp_Object obj2) 718 dbg_eq (Lisp_Object obj1, Lisp_Object obj2)
721 { 719 {
4246 Vdoc_directory = Qnil; 4244 Vdoc_directory = Qnil;
4247 Vconfigure_info_directory = Qnil; 4245 Vconfigure_info_directory = Qnil;
4248 Vexec_path = Qnil; 4246 Vexec_path = Qnil;
4249 Vload_path = Qnil; 4247 Vload_path = Qnil;
4250 /* Vdump_load_path = Qnil; */ 4248 /* Vdump_load_path = Qnil; */
4249 /* Release hash tables for locate_file */
4250 Fset (intern ("early-package-load-path"), Qnil);
4251 Fset (intern ("late-package-load-path"), Qnil);
4252 Fset (intern ("last-package-load-path"), Qnil);
4251 uncache_home_directory(); 4253 uncache_home_directory();
4252 4254
4253 #if defined(LOADHIST) && !(defined(LOADHIST_DUMPED) || \ 4255 #if defined(LOADHIST) && !(defined(LOADHIST_DUMPED) || \
4254 defined(LOADHIST_BUILTIN)) 4256 defined(LOADHIST_BUILTIN))
4255 Vload_history = Qnil; 4257 Vload_history = Qnil;
4306 { 4308 {
4307 #if MAX_SAVE_STACK > 0 4309 #if MAX_SAVE_STACK > 0
4308 char stack_top_variable; 4310 char stack_top_variable;
4309 extern char *stack_bottom; 4311 extern char *stack_bottom;
4310 #endif 4312 #endif
4311 int i;
4312 struct frame *f; 4313 struct frame *f;
4313 int speccount; 4314 int speccount;
4314 int cursor_changed; 4315 int cursor_changed;
4315 Lisp_Object pre_gc_cursor; 4316 Lisp_Object pre_gc_cursor;
4316 struct gcpro gcpro1; 4317 struct gcpro gcpro1;
4423 /* #### generalize this? */ 4424 /* #### generalize this? */
4424 clear_event_resource (); 4425 clear_event_resource ();
4425 cleanup_specifiers (); 4426 cleanup_specifiers ();
4426 4427
4427 /* Mark all the special slots that serve as the roots of accessibility. */ 4428 /* Mark all the special slots that serve as the roots of accessibility. */
4428 { 4429
4430 { /* staticpro() */
4431 int i;
4432 for (i = 0; i < staticidx; i++)
4433 mark_object (*(staticvec[i]));
4434 }
4435
4436 { /* GCPRO() */
4429 struct gcpro *tail; 4437 struct gcpro *tail;
4430 struct catchtag *catch; 4438 int i;
4431 struct backtrace *backlist; 4439 for (tail = gcprolist; tail; tail = tail->next)
4440 for (i = 0; i < tail->nvars; i++)
4441 mark_object (tail->var[i]);
4442 }
4443
4444 { /* specbind() */
4432 struct specbinding *bind; 4445 struct specbinding *bind;
4433
4434 for (i = 0; i < staticidx; i++)
4435 {
4436 mark_object (*(staticvec[i]));
4437 }
4438
4439 for (tail = gcprolist; tail; tail = tail->next)
4440 {
4441 for (i = 0; i < tail->nvars; i++)
4442 mark_object (tail->var[i]);
4443 }
4444
4445 for (bind = specpdl; bind != specpdl_ptr; bind++) 4446 for (bind = specpdl; bind != specpdl_ptr; bind++)
4446 { 4447 {
4447 mark_object (bind->symbol); 4448 mark_object (bind->symbol);
4448 mark_object (bind->old_value); 4449 mark_object (bind->old_value);
4449 } 4450 }
4450 4451 }
4452
4453 {
4454 struct catchtag *catch;
4451 for (catch = catchlist; catch; catch = catch->next) 4455 for (catch = catchlist; catch; catch = catch->next)
4452 { 4456 {
4453 mark_object (catch->tag); 4457 mark_object (catch->tag);
4454 mark_object (catch->val); 4458 mark_object (catch->val);
4455 } 4459 }
4456 4460 }
4461
4462 {
4463 struct backtrace *backlist;
4457 for (backlist = backtrace_list; backlist; backlist = backlist->next) 4464 for (backlist = backtrace_list; backlist; backlist = backlist->next)
4458 { 4465 {
4459 int nargs = backlist->nargs; 4466 int nargs = backlist->nargs;
4467 int i;
4460 4468
4461 mark_object (*backlist->function); 4469 mark_object (*backlist->function);
4462 if (nargs == UNEVALLED || nargs == MANY) 4470 if (nargs == UNEVALLED || nargs == MANY)
4463 mark_object (backlist->args[0]); 4471 mark_object (backlist->args[0]);
4464 else 4472 else
4465 for (i = 0; i < nargs; i++) 4473 for (i = 0; i < nargs; i++)
4466 mark_object (backlist->args[i]); 4474 mark_object (backlist->args[i]);
4467 } 4475 }
4468
4469 mark_redisplay (mark_object);
4470 mark_profiling_info (mark_object);
4471 } 4476 }
4477
4478 mark_redisplay (mark_object);
4479 mark_profiling_info (mark_object);
4472 4480
4473 /* OK, now do the after-mark stuff. This is for things that 4481 /* OK, now do the after-mark stuff. This is for things that
4474 are only marked when something else is marked (e.g. weak hash tables). 4482 are only marked when something else is marked (e.g. weak hash tables).
4475 There may be complex dependencies between such objects -- e.g. 4483 There may be complex dependencies between such objects -- e.g.
4476 a weak hash table might be unmarked, but after processing a later 4484 a weak hash table might be unmarked, but after processing a later