Mercurial > hg > xemacs-beta

comparison src/gc.c @ 3267:a0de8be91f1b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2006-03-02 17:11:45 by crestani] 2006-03-02 Marcus Crestani <crestani@xemacs.org> * gc.c (show_gc_cursor_and_message): New. * gc.c (remove_gc_cursor_and_message): New. * gc.c (gc_prepare): Move mouse pointer code to show_gc_cursor_and_message. * gc.c (gc_finish): Move mouse pointer code to remove_gc_cursor_and_message. * gc.c (gc): Call show/remove_gc_cursor_and_message. * gc.c (garbage_collect_1): Call show/remove_gc_cursor_and_message.
author crestani
date Thu, 02 Mar 2006 17:11:47 +0000
parents d674024a8674
children 509d2981ffea
comparison
equal deleted inserted replaced
3266:d19f5a0af6d6 3267:a0de8be91f1b
1497 #ifndef MAX_SAVE_STACK 1497 #ifndef MAX_SAVE_STACK
1498 #define MAX_SAVE_STACK 0 /* 16000 */ 1498 #define MAX_SAVE_STACK 0 /* 16000 */
1499 #endif 1499 #endif
1500 1500
1501 void 1501 void
1502 gc_prepare (void) 1502 show_gc_cursor_and_message (void)
1503 { 1503 {
1504 #if MAX_SAVE_STACK > 0 1504 /* Now show the GC cursor/message. */
1505 char stack_top_variable; 1505 pre_gc_cursor = Qnil;
1506 extern char *stack_bottom; 1506 cursor_changed = 0;
1507 #endif
1508
1509 #ifdef NEW_GC
1510 GC_STAT_START_NEW_GC;
1511 GC_SET_PHASE (INIT_GC);
1512 #endif /* NEW_GC */
1513
1514 do_backtrace = profiling_active || backtrace_with_internal_sections;
1515
1516 assert (!gc_in_progress);
1517 assert (!in_display || gc_currently_forbidden);
1518
1519 PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection);
1520 1507
1521 /* We used to call selected_frame() here. 1508 /* We used to call selected_frame() here.
1522 1509
1523 The following functions cannot be called inside GC 1510 The following functions cannot be called inside GC
1524 so we move to after the above tests. */ 1511 so we move to after the above tests. */
1531 if (NILP (frame)) 1518 if (NILP (frame))
1532 invalid_state ("No frames exist on device", device); 1519 invalid_state ("No frames exist on device", device);
1533 f = XFRAME (frame); 1520 f = XFRAME (frame);
1534 } 1521 }
1535 1522
1536 pre_gc_cursor = Qnil;
1537 cursor_changed = 0;
1538
1539 need_to_signal_post_gc = 0;
1540 recompute_funcall_allocation_flag ();
1541
1542 if (!gc_hooks_inhibited)
1543 run_hook_trapping_problems
1544 (Qgarbage_collecting, Qpre_gc_hook,
1545 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
1546
1547 /* Now show the GC cursor/message. */
1548 if (!noninteractive) 1523 if (!noninteractive)
1549 { 1524 {
1550 if (FRAME_WIN_P (f)) 1525 if (FRAME_WIN_P (f))
1551 { 1526 {
1552 Lisp_Object frame = wrap_frame (f); 1527 Lisp_Object frame = wrap_frame (f);
1576 echo_area_message (f, (Ibyte *) 0, whole_msg, 0, -1, 1551 echo_area_message (f, (Ibyte *) 0, whole_msg, 0, -1,
1577 Qgarbage_collecting); 1552 Qgarbage_collecting);
1578 } 1553 }
1579 } 1554 }
1580 } 1555 }
1581 1556 }
1582 /***** Now we actually start the garbage collection. */ 1557
1583 1558 void
1584 gc_in_progress = 1; 1559 remove_gc_cursor_and_message (void)
1585 #ifndef NEW_GC 1560 {
1586 inhibit_non_essential_conversion_operations = 1;
1587 #endif /* not NEW_GC */
1588
1589 #if MAX_SAVE_STACK > 0
1590
1591 /* Save a copy of the contents of the stack, for debugging. */
1592 if (!purify_flag)
1593 {
1594 /* Static buffer in which we save a copy of the C stack at each GC. */
1595 static char *stack_copy;
1596 static Bytecount stack_copy_size;
1597
1598 ptrdiff_t stack_diff = &stack_top_variable - stack_bottom;
1599 Bytecount stack_size = (stack_diff > 0 ? stack_diff : -stack_diff);
1600 if (stack_size < MAX_SAVE_STACK)
1601 {
1602 if (stack_copy_size < stack_size)
1603 {
1604 stack_copy = (char *) xrealloc (stack_copy, stack_size);
1605 stack_copy_size = stack_size;
1606 }
1607
1608 memcpy (stack_copy,
1609 stack_diff > 0 ? stack_bottom : &stack_top_variable,
1610 stack_size);
1611 }
1612 }
1613 #endif /* MAX_SAVE_STACK > 0 */
1614
1615 /* Do some totally ad-hoc resource clearing. */
1616 /* #### generalize this? */
1617 clear_event_resource ();
1618 cleanup_specifiers ();
1619 cleanup_buffer_undo_lists ();
1620 }
1621
1622 void
1623 gc_mark_root_set (
1624 #ifdef NEW_GC
1625 enum gc_phase phase
1626 #else /* not NEW_GC */
1627 void
1628 #endif /* not NEW_GC */
1629 )
1630 {
1631 #ifdef NEW_GC
1632 GC_SET_PHASE (phase);
1633 #endif /* NEW_GC */
1634
1635 /* Mark all the special slots that serve as the roots of accessibility. */
1636
1637 #ifdef USE_KKCC
1638 # define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1)
1639 #endif /* USE_KKCC */
1640
1641 { /* staticpro() */
1642 Lisp_Object **p = Dynarr_begin (staticpros);
1643 Elemcount count;
1644 for (count = Dynarr_length (staticpros); count; count--)
1645 /* Need to check if the pointer in the staticpro array is not
1646 NULL. A gc can occur after variable is added to the staticpro
1647 array and _before_ it is correctly initialized. In this case
1648 its value is NULL, which we have to catch here. */
1649 if (*p)
1650 mark_object (**p++);
1651 else
1652 **p++;
1653 }
1654
1655 { /* staticpro_nodump() */
1656 Lisp_Object **p = Dynarr_begin (staticpros_nodump);
1657 Elemcount count;
1658 for (count = Dynarr_length (staticpros_nodump); count; count--)
1659 /* Need to check if the pointer in the staticpro array is not
1660 NULL. A gc can occur after variable is added to the staticpro
1661 array and _before_ it is correctly initialized. In this case
1662 its value is NULL, which we have to catch here. */
1663 if (*p)
1664 mark_object (**p++);
1665 else
1666 **p++;
1667 }
1668
1669 #ifdef NEW_GC
1670 { /* mcpro () */
1671 Lisp_Object *p = Dynarr_begin (mcpros);
1672 Elemcount count;
1673 for (count = Dynarr_length (mcpros); count; count--)
1674 mark_object (*p++);
1675 }
1676 #endif /* NEW_GC */
1677
1678 { /* GCPRO() */
1679 struct gcpro *tail;
1680 int i;
1681 for (tail = gcprolist; tail; tail = tail->next)
1682 for (i = 0; i < tail->nvars; i++)
1683 mark_object (tail->var[i]);
1684 }
1685
1686 { /* specbind() */
1687 struct specbinding *bind;
1688 for (bind = specpdl; bind != specpdl_ptr; bind++)
1689 {
1690 mark_object (bind->symbol);
1691 mark_object (bind->old_value);
1692 }
1693 }
1694
1695 {
1696 struct catchtag *c;
1697 for (c = catchlist; c; c = c->next)
1698 {
1699 mark_object (c->tag);
1700 mark_object (c->val);
1701 mark_object (c->actual_tag);
1702 mark_object (c->backtrace);
1703 }
1704 }
1705
1706 {
1707 struct backtrace *backlist;
1708 for (backlist = backtrace_list; backlist; backlist = backlist->next)
1709 {
1710 int nargs = backlist->nargs;
1711 int i;
1712
1713 mark_object (*backlist->function);
1714 if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */
1715 /* might be fake (internal profiling entry) */
1716 && backlist->args)
1717 mark_object (backlist->args[0]);
1718 else
1719 for (i = 0; i < nargs; i++)
1720 mark_object (backlist->args[i]);
1721 }
1722 }
1723
1724 mark_profiling_info ();
1725 #ifdef USE_KKCC
1726 # undef mark_object
1727 #endif
1728 }
1729
1730 void
1731 gc_finish_mark (void)
1732 {
1733 #ifdef NEW_GC
1734 GC_SET_PHASE (FINISH_MARK);
1735 #endif /* NEW_GC */
1736 init_marking_ephemerons ();
1737
1738 while (finish_marking_weak_hash_tables () > 0 ||
1739 finish_marking_weak_lists () > 0 ||
1740 continue_marking_ephemerons () > 0)
1741 #ifdef USE_KKCC
1742 {
1743 kkcc_marking (0);
1744 }
1745 #else /* not USE_KKCC */
1746 ;
1747 #endif /* not USE_KKCC */
1748
1749 /* At this point, we know which objects need to be finalized: we
1750 still need to resurrect them */
1751
1752 while (finish_marking_ephemerons () > 0 ||
1753 finish_marking_weak_lists () > 0 ||
1754 finish_marking_weak_hash_tables () > 0)
1755 #ifdef USE_KKCC
1756 {
1757 kkcc_marking (0);
1758 }
1759 #else /* not USE_KKCC */
1760 ;
1761 #endif /* not USE_KKCC */
1762
1763 /* And prune (this needs to be called after everything else has been
1764 marked and before we do any sweeping). */
1765 /* #### this is somewhat ad-hoc and should probably be an object
1766 method */
1767 prune_weak_hash_tables ();
1768 prune_weak_lists ();
1769 prune_specifiers ();
1770 prune_syntax_tables ();
1771
1772 prune_ephemerons ();
1773 prune_weak_boxes ();
1774 }
1775
1776 #ifdef NEW_GC
1777 void
1778 gc_finalize (void)
1779 {
1780 GC_SET_PHASE (FINALIZE);
1781 register_for_finalization ();
1782 }
1783
1784 void
1785 gc_sweep (void)
1786 {
1787 GC_SET_PHASE (SWEEP);
1788 mc_sweep ();
1789 }
1790 #endif /* NEW_GC */
1791
1792
1793 void
1794 gc_finish (void)
1795 {
1796 #ifdef NEW_GC
1797 GC_SET_PHASE (FINISH_GC);
1798 #endif /* NEW_GC */
1799 consing_since_gc = 0;
1800 #ifndef DEBUG_XEMACS
1801 /* Allow you to set it really fucking low if you really want ... */
1802 if (gc_cons_threshold < 10000)
1803 gc_cons_threshold = 10000;
1804 #endif
1805 recompute_need_to_garbage_collect ();
1806
1807 #ifndef NEW_GC
1808 inhibit_non_essential_conversion_operations = 0;
1809 #endif /* not NEW_GC */
1810 gc_in_progress = 0;
1811
1812 run_post_gc_actions ();
1813
1814 /******* End of garbage collection ********/
1815
1816 /* Now remove the GC cursor/message */ 1561 /* Now remove the GC cursor/message */
1817 if (!noninteractive) 1562 if (!noninteractive)
1818 { 1563 {
1819 if (cursor_changed) 1564 if (cursor_changed)
1820 Fset_frame_pointer (wrap_frame (f), pre_gc_cursor); 1565 Fset_frame_pointer (wrap_frame (f), pre_gc_cursor);
1836 Qgarbage_collecting); 1581 Qgarbage_collecting);
1837 } 1582 }
1838 } 1583 }
1839 } 1584 }
1840 } 1585 }
1586 }
1587
1588 void
1589 gc_prepare (void)
1590 {
1591 #if MAX_SAVE_STACK > 0
1592 char stack_top_variable;
1593 extern char *stack_bottom;
1594 #endif
1595
1596 #ifdef NEW_GC
1597 GC_STAT_START_NEW_GC;
1598 GC_SET_PHASE (INIT_GC);
1599 #endif /* NEW_GC */
1600
1601 do_backtrace = profiling_active || backtrace_with_internal_sections;
1602
1603 assert (!gc_in_progress);
1604 assert (!in_display || gc_currently_forbidden);
1605
1606 PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection);
1607
1608 need_to_signal_post_gc = 0;
1609 recompute_funcall_allocation_flag ();
1610
1611 if (!gc_hooks_inhibited)
1612 run_hook_trapping_problems
1613 (Qgarbage_collecting, Qpre_gc_hook,
1614 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
1615
1616 /***** Now we actually start the garbage collection. */
1617
1618 gc_in_progress = 1;
1619 #ifndef NEW_GC
1620 inhibit_non_essential_conversion_operations = 1;
1621 #endif /* not NEW_GC */
1622
1623 #if MAX_SAVE_STACK > 0
1624
1625 /* Save a copy of the contents of the stack, for debugging. */
1626 if (!purify_flag)
1627 {
1628 /* Static buffer in which we save a copy of the C stack at each GC. */
1629 static char *stack_copy;
1630 static Bytecount stack_copy_size;
1631
1632 ptrdiff_t stack_diff = &stack_top_variable - stack_bottom;
1633 Bytecount stack_size = (stack_diff > 0 ? stack_diff : -stack_diff);
1634 if (stack_size < MAX_SAVE_STACK)
1635 {
1636 if (stack_copy_size < stack_size)
1637 {
1638 stack_copy = (char *) xrealloc (stack_copy, stack_size);
1639 stack_copy_size = stack_size;
1640 }
1641
1642 memcpy (stack_copy,
1643 stack_diff > 0 ? stack_bottom : &stack_top_variable,
1644 stack_size);
1645 }
1646 }
1647 #endif /* MAX_SAVE_STACK > 0 */
1648
1649 /* Do some totally ad-hoc resource clearing. */
1650 /* #### generalize this? */
1651 clear_event_resource ();
1652 cleanup_specifiers ();
1653 cleanup_buffer_undo_lists ();
1654 }
1655
1656 void
1657 gc_mark_root_set (
1658 #ifdef NEW_GC
1659 enum gc_phase phase
1660 #else /* not NEW_GC */
1661 void
1662 #endif /* not NEW_GC */
1663 )
1664 {
1665 #ifdef NEW_GC
1666 GC_SET_PHASE (phase);
1667 #endif /* NEW_GC */
1668
1669 /* Mark all the special slots that serve as the roots of accessibility. */
1670
1671 #ifdef USE_KKCC
1672 # define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1)
1673 #endif /* USE_KKCC */
1674
1675 { /* staticpro() */
1676 Lisp_Object **p = Dynarr_begin (staticpros);
1677 Elemcount count;
1678 for (count = Dynarr_length (staticpros); count; count--)
1679 /* Need to check if the pointer in the staticpro array is not
1680 NULL. A gc can occur after variable is added to the staticpro
1681 array and _before_ it is correctly initialized. In this case
1682 its value is NULL, which we have to catch here. */
1683 if (*p)
1684 mark_object (**p++);
1685 else
1686 **p++;
1687 }
1688
1689 { /* staticpro_nodump() */
1690 Lisp_Object **p = Dynarr_begin (staticpros_nodump);
1691 Elemcount count;
1692 for (count = Dynarr_length (staticpros_nodump); count; count--)
1693 /* Need to check if the pointer in the staticpro array is not
1694 NULL. A gc can occur after variable is added to the staticpro
1695 array and _before_ it is correctly initialized. In this case
1696 its value is NULL, which we have to catch here. */
1697 if (*p)
1698 mark_object (**p++);
1699 else
1700 **p++;
1701 }
1702
1703 #ifdef NEW_GC
1704 { /* mcpro () */
1705 Lisp_Object *p = Dynarr_begin (mcpros);
1706 Elemcount count;
1707 for (count = Dynarr_length (mcpros); count; count--)
1708 mark_object (*p++);
1709 }
1710 #endif /* NEW_GC */
1711
1712 { /* GCPRO() */
1713 struct gcpro *tail;
1714 int i;
1715 for (tail = gcprolist; tail; tail = tail->next)
1716 for (i = 0; i < tail->nvars; i++)
1717 mark_object (tail->var[i]);
1718 }
1719
1720 { /* specbind() */
1721 struct specbinding *bind;
1722 for (bind = specpdl; bind != specpdl_ptr; bind++)
1723 {
1724 mark_object (bind->symbol);
1725 mark_object (bind->old_value);
1726 }
1727 }
1728
1729 {
1730 struct catchtag *c;
1731 for (c = catchlist; c; c = c->next)
1732 {
1733 mark_object (c->tag);
1734 mark_object (c->val);
1735 mark_object (c->actual_tag);
1736 mark_object (c->backtrace);
1737 }
1738 }
1739
1740 {
1741 struct backtrace *backlist;
1742 for (backlist = backtrace_list; backlist; backlist = backlist->next)
1743 {
1744 int nargs = backlist->nargs;
1745 int i;
1746
1747 mark_object (*backlist->function);
1748 if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */
1749 /* might be fake (internal profiling entry) */
1750 && backlist->args)
1751 mark_object (backlist->args[0]);
1752 else
1753 for (i = 0; i < nargs; i++)
1754 mark_object (backlist->args[i]);
1755 }
1756 }
1757
1758 mark_profiling_info ();
1759 #ifdef USE_KKCC
1760 # undef mark_object
1761 #endif
1762 }
1763
1764 void
1765 gc_finish_mark (void)
1766 {
1767 #ifdef NEW_GC
1768 GC_SET_PHASE (FINISH_MARK);
1769 #endif /* NEW_GC */
1770 init_marking_ephemerons ();
1771
1772 while (finish_marking_weak_hash_tables () > 0 ||
1773 finish_marking_weak_lists () > 0 ||
1774 continue_marking_ephemerons () > 0)
1775 #ifdef USE_KKCC
1776 {
1777 kkcc_marking (0);
1778 }
1779 #else /* not USE_KKCC */
1780 ;
1781 #endif /* not USE_KKCC */
1782
1783 /* At this point, we know which objects need to be finalized: we
1784 still need to resurrect them */
1785
1786 while (finish_marking_ephemerons () > 0 ||
1787 finish_marking_weak_lists () > 0 ||
1788 finish_marking_weak_hash_tables () > 0)
1789 #ifdef USE_KKCC
1790 {
1791 kkcc_marking (0);
1792 }
1793 #else /* not USE_KKCC */
1794 ;
1795 #endif /* not USE_KKCC */
1796
1797 /* And prune (this needs to be called after everything else has been
1798 marked and before we do any sweeping). */
1799 /* #### this is somewhat ad-hoc and should probably be an object
1800 method */
1801 prune_weak_hash_tables ();
1802 prune_weak_lists ();
1803 prune_specifiers ();
1804 prune_syntax_tables ();
1805
1806 prune_ephemerons ();
1807 prune_weak_boxes ();
1808 }
1809
1810 #ifdef NEW_GC
1811 void
1812 gc_finalize (void)
1813 {
1814 GC_SET_PHASE (FINALIZE);
1815 register_for_finalization ();
1816 }
1817
1818 void
1819 gc_sweep (void)
1820 {
1821 GC_SET_PHASE (SWEEP);
1822 mc_sweep ();
1823 }
1824 #endif /* NEW_GC */
1825
1826
1827 void
1828 gc_finish (void)
1829 {
1830 #ifdef NEW_GC
1831 GC_SET_PHASE (FINISH_GC);
1832 #endif /* NEW_GC */
1833 consing_since_gc = 0;
1834 #ifndef DEBUG_XEMACS
1835 /* Allow you to set it really fucking low if you really want ... */
1836 if (gc_cons_threshold < 10000)
1837 gc_cons_threshold = 10000;
1838 #endif
1839 recompute_need_to_garbage_collect ();
1840
1841 #ifndef NEW_GC
1842 inhibit_non_essential_conversion_operations = 0;
1843 #endif /* not NEW_GC */
1844 gc_in_progress = 0;
1845
1846 run_post_gc_actions ();
1847
1848 /******* End of garbage collection ********/
1841 1849
1842 #ifndef NEW_GC 1850 #ifndef NEW_GC
1843 if (!breathing_space) 1851 if (!breathing_space)
1844 { 1852 {
1845 breathing_space = malloc (4096 - MALLOC_OVERHEAD); 1853 breathing_space = malloc (4096 - MALLOC_OVERHEAD);
1982 /* Very important to prevent GC during any of the following 1990 /* Very important to prevent GC during any of the following
1983 stuff that might run Lisp code; otherwise, we'll likely 1991 stuff that might run Lisp code; otherwise, we'll likely
1984 have infinite GC recursion. */ 1992 have infinite GC recursion. */
1985 speccount = begin_gc_forbidden (); 1993 speccount = begin_gc_forbidden ();
1986 1994
1995 show_gc_cursor_and_message ();
1996
1987 gc_1 (incremental); 1997 gc_1 (incremental);
1998
1999 remove_gc_cursor_and_message ();
1988 2000
1989 /* now stop inhibiting GC */ 2001 /* now stop inhibiting GC */
1990 unbind_to (speccount); 2002 unbind_to (speccount);
1991 } 2003 }
1992 2004
2043 /* Very important to prevent GC during any of the following 2055 /* Very important to prevent GC during any of the following
2044 stuff that might run Lisp code; otherwise, we'll likely 2056 stuff that might run Lisp code; otherwise, we'll likely
2045 have infinite GC recursion. */ 2057 have infinite GC recursion. */
2046 speccount = begin_gc_forbidden (); 2058 speccount = begin_gc_forbidden ();
2047 2059
2060 show_gc_cursor_and_message ();
2061
2048 gc_prepare (); 2062 gc_prepare ();
2049 #ifdef USE_KKCC 2063 #ifdef USE_KKCC
2050 kkcc_gc_stack_init(); 2064 kkcc_gc_stack_init();
2051 #ifdef DEBUG_XEMACS 2065 #ifdef DEBUG_XEMACS
2052 kkcc_bt_init (); 2066 kkcc_bt_init ();
2063 kkcc_bt_free (); 2077 kkcc_bt_free ();
2064 #endif 2078 #endif
2065 #endif /* USE_KKCC */ 2079 #endif /* USE_KKCC */
2066 gc_sweep_1 (); 2080 gc_sweep_1 ();
2067 gc_finish (); 2081 gc_finish ();
2082
2083 remove_gc_cursor_and_message ();
2068 2084
2069 /* now stop inhibiting GC */ 2085 /* now stop inhibiting GC */
2070 unbind_to (speccount); 2086 unbind_to (speccount);
2071 } 2087 }
2072 #endif /* not NEW_GC */ 2088 #endif /* not NEW_GC */