comparison src/alloc.c @ 247:e70b3a057e12 r20-5b22

Import from CVS: tag r20-5b22
author cvs
date Mon, 13 Aug 2007 10:18:21 +0200
parents 51092a27c943
children 83b3d10dcba9
comparison
equal deleted inserted replaced
246:cf2a77a48c1c 247:e70b3a057e12
2781 #endif /* LRECORD_STRING */ 2781 #endif /* LRECORD_STRING */
2782 #ifdef LISP_FLOAT_TYPE 2782 #ifdef LISP_FLOAT_TYPE
2783 else if (FLOATP (obj)) 2783 else if (FLOATP (obj))
2784 return make_pure_float (float_data (XFLOAT (obj))); 2784 return make_pure_float (float_data (XFLOAT (obj)));
2785 #endif /* LISP_FLOAT_TYPE */ 2785 #endif /* LISP_FLOAT_TYPE */
2786 else if (!SYMBOLP (obj)) 2786 else if (SYMBOLP (obj))
2787 {
2788 /*
2789 * Symbols can't be made pure (and thus read-only),
2790 * because assigning to their function, value or plist
2791 * slots would produced a SEGV in the dumped XEmacs. So
2792 * we previously would just return the symbol unchanged.
2793 *
2794 * But purified aggregate objects like lists and vectors
2795 * can contain uninterned symbols. If there are no
2796 * other non-pure references to the symbol, then the
2797 * symbol is not proteted from garabge colelction
2798 * because the collector does not mark the contents of
2799 * purified objects. So to protect the symbols, an impure
2800 * reference has to be kept for each uninterned symbol
2801 * that is referenced by a pure object. All such
2802 * symbols are stored in the hashtable pointed to by
2803 * Vpure_uninterened_symbol_table, which is itself
2804 * staticpro'd.
2805 */
2806 if (EQ (XSYMBOL (obj)->obarray, Vobarray))
2807 return obj;
2808 Fputhash (obj, obj, Vpure_uninterned_symbol_table);
2809 return obj;
2810 }
2811 else
2787 signal_simple_error ("Can't purecopy %S", obj); 2812 signal_simple_error ("Can't purecopy %S", obj);
2788 } 2813 }
2789 } 2814 }
2790 return obj; 2815 return obj;
2791 } 2816 }
2829 else 2854 else
2830 { 2855 {
2831 int lost = (get_PURESIZE() - pureptr) / 1024; 2856 int lost = (get_PURESIZE() - pureptr) / 1024;
2832 char buf[200]; 2857 char buf[200];
2833 extern Lisp_Object Vemacs_beta_version; 2858 extern Lisp_Object Vemacs_beta_version;
2834 int slop = NILP(Vemacs_beta_version) ? 512 : 4; 2859 /* This used to be NILP(Vemacs_beta_version) ? 512 : 4; */
2860 #ifndef PURESIZE_SLOP
2861 #define PURESIZE_SLOP 4
2862 #endif
2863 int slop = PURESIZE_SLOP;
2835 2864
2836 sprintf (buf, "Purespace usage: %ld of %ld (%d%%", 2865 sprintf (buf, "Purespace usage: %ld of %ld (%d%%",
2837 pureptr, (long) get_PURESIZE(), 2866 pureptr, (long) get_PURESIZE(),
2838 (int) (pureptr / (get_PURESIZE() / 100.0) + 0.5)); 2867 (int) (pureptr / (get_PURESIZE() / 100.0) + 0.5));
2839 if (lost > 2) { 2868 if (lost > 2) {