Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 343:8bec6624d99b r21-1-1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-1-1
author cvs
date Mon, 13 Aug 2007 10:52:53 +0200
parents fbbf69b4e8a7
children 7347b34c275b
comparison
equal deleted inserted replaced
342:b036ce23deaa 343:8bec6624d99b
1893 #endif 1893 #endif
1894 p->name = XSTRING (str); 1894 p->name = XSTRING (str);
1895 p->plist = Qnil; 1895 p->plist = Qnil;
1896 p->value = Qunbound; 1896 p->value = Qunbound;
1897 p->function = Qunbound; 1897 p->function = Qunbound;
1898 p->obarray = Qnil; 1898 p->obarray_flags = 0;
1899 symbol_next (p) = 0; 1899 symbol_next (p) = 0;
1900 XSETSYMBOL (val, p); 1900 XSETSYMBOL (val, p);
1901 return val; 1901 return val;
1902 } 1902 }
1903 1903
1904 1904
2907 else if (FLOATP (obj)) 2907 else if (FLOATP (obj))
2908 return make_pure_float (float_data (XFLOAT (obj))); 2908 return make_pure_float (float_data (XFLOAT (obj)));
2909 #endif /* LISP_FLOAT_TYPE */ 2909 #endif /* LISP_FLOAT_TYPE */
2910 else if (SYMBOLP (obj)) 2910 else if (SYMBOLP (obj))
2911 { 2911 {
2912 int mask = XSYMBOL_OBARRAY_FLAGS (obj);
2912 /* 2913 /*
2913 * Symbols can't be made pure (and thus read-only), 2914 * Symbols can't be made pure (and thus read-only),
2914 * because assigning to their function, value or plist 2915 * because assigning to their function, value or plist
2915 * slots would produced a SEGV in the dumped XEmacs. So 2916 * slots would produce a SEGV in the dumped XEmacs. So
2916 * we previously would just return the symbol unchanged. 2917 * we previously would just return the symbol unchanged.
2917 * 2918 *
2918 * But purified aggregate objects like lists and vectors 2919 * But purified aggregate objects like lists and vectors
2919 * can contain uninterned symbols. If there are no 2920 * can contain uninterned symbols. If there are no
2920 * other non-pure references to the symbol, then the 2921 * other non-pure references to the symbol, then the
2925 * that is referenced by a pure object. All such 2926 * that is referenced by a pure object. All such
2926 * symbols are stored in the hashtable pointed to by 2927 * symbols are stored in the hashtable pointed to by
2927 * Vpure_uninterned_symbol_table, which is itself 2928 * Vpure_uninterned_symbol_table, which is itself
2928 * staticpro'd. 2929 * staticpro'd.
2929 */ 2930 */
2930 if (!NILP (XSYMBOL (obj)->obarray)) 2931 if (!(mask & 1))
2931 return obj; 2932 /* Symbol is not interned anywhere. Keep a reference to the
2932 Fputhash (obj, Qnil, Vpure_uninterned_symbol_table); 2933 end of time. */
2934 Fputhash (obj, Qnil, Vpure_uninterned_symbol_table);
2935
2936 /* Mark symbol as being referenced by a pure structure.
2937 Funintern() will recognize this mark and place the symbol to
2938 Vpure_uninterned_symbol_table at the time of uninterning. */
2939 XSYMBOL (obj)->obarray_flags = mask | 4;
2940
2933 return obj; 2941 return obj;
2934 } 2942 }
2935 else 2943 else
2936 signal_simple_error ("Can't purecopy %S", obj); 2944 signal_simple_error ("Can't purecopy %S", obj);
2937 } 2945 }