comparison src/alloc.c @ 249:83b3d10dcba9 r20-5b23

Import from CVS: tag r20-5b23
author cvs
date Mon, 13 Aug 2007 10:19:09 +0200
parents e70b3a057e12
children 677f6a0ee643
comparison
equal deleted inserted replaced
248:ad40ac2754d8 249:83b3d10dcba9
2792 * we previously would just return the symbol unchanged. 2792 * we previously would just return the symbol unchanged.
2793 * 2793 *
2794 * But purified aggregate objects like lists and vectors 2794 * But purified aggregate objects like lists and vectors
2795 * can contain uninterned symbols. If there are no 2795 * can contain uninterned symbols. If there are no
2796 * other non-pure references to the symbol, then the 2796 * other non-pure references to the symbol, then the
2797 * symbol is not proteted from garabge colelction 2797 * symbol is not protected from garbage collection
2798 * because the collector does not mark the contents of 2798 * because the collector does not mark the contents of
2799 * purified objects. So to protect the symbols, an impure 2799 * purified objects. So to protect the symbols, an impure
2800 * reference has to be kept for each uninterned symbol 2800 * reference has to be kept for each uninterned symbol
2801 * that is referenced by a pure object. All such 2801 * that is referenced by a pure object. All such
2802 * symbols are stored in the hashtable pointed to by 2802 * symbols are stored in the hashtable pointed to by
2803 * Vpure_uninterened_symbol_table, which is itself 2803 * Vpure_uninterned_symbol_table, which is itself
2804 * staticpro'd. 2804 * staticpro'd.
2805 */ 2805 */
2806 if (EQ (XSYMBOL (obj)->obarray, Vobarray)) 2806 if (EQ (XSYMBOL (obj)->obarray, Vobarray))
2807 return obj; 2807 return obj;
2808 Fputhash (obj, obj, Vpure_uninterned_symbol_table); 2808 Fputhash (obj, obj, Vpure_uninterned_symbol_table);
2856 int lost = (get_PURESIZE() - pureptr) / 1024; 2856 int lost = (get_PURESIZE() - pureptr) / 1024;
2857 char buf[200]; 2857 char buf[200];
2858 extern Lisp_Object Vemacs_beta_version; 2858 extern Lisp_Object Vemacs_beta_version;
2859 /* This used to be NILP(Vemacs_beta_version) ? 512 : 4; */ 2859 /* This used to be NILP(Vemacs_beta_version) ? 512 : 4; */
2860 #ifndef PURESIZE_SLOP 2860 #ifndef PURESIZE_SLOP
2861 #define PURESIZE_SLOP 4 2861 #define PURESIZE_SLOP 0
2862 #endif 2862 #endif
2863 int slop = PURESIZE_SLOP; 2863 int slop = PURESIZE_SLOP;
2864 2864
2865 sprintf (buf, "Purespace usage: %ld of %ld (%d%%", 2865 sprintf (buf, "Purespace usage: %ld of %ld (%d%%",
2866 pureptr, (long) get_PURESIZE(), 2866 pureptr, (long) get_PURESIZE(),
2867 (int) (pureptr / (get_PURESIZE() / 100.0) + 0.5)); 2867 (int) (pureptr / (get_PURESIZE() / 100.0) + 0.5));
2868 if (lost > 2) { 2868 if (lost > ((slop ? slop : 1) / 1024)) {
2869 sprintf (buf + strlen (buf), " -- %dk wasted", lost); 2869 sprintf (buf + strlen (buf), " -- %dk wasted", lost);
2870 if (die_if_pure_storage_exceeded) { 2870 if (die_if_pure_storage_exceeded) {
2871 puresize_adjust_h (pureptr + slop); 2871 puresize_adjust_h (pureptr + slop);
2872 rc = -1; 2872 rc = -1;
2873 } 2873 }
4220 garbage_collect_1 (); 4220 garbage_collect_1 ();
4221 4221
4222 /* Run the disksave finalization methods of all live objects. */ 4222 /* Run the disksave finalization methods of all live objects. */
4223 disksave_object_finalization_1 (); 4223 disksave_object_finalization_1 ();
4224 4224
4225 #if 0 /* I don't see any point in this. The purespace starts out all 0's */
4225 /* Zero out the unused portion of purespace */ 4226 /* Zero out the unused portion of purespace */
4226 if (!pure_lossage) 4227 if (!pure_lossage)
4227 memset ( (char *) (PUREBEG + pureptr), 0, 4228 memset ( (char *) (PUREBEG + pureptr), 0,
4228 (((char *) (PUREBEG + get_PURESIZE())) - 4229 (((char *) (PUREBEG + get_PURESIZE())) -
4229 ((char *) (PUREBEG + pureptr)))); 4230 ((char *) (PUREBEG + pureptr))));
4231 #endif
4230 4232
4231 /* Zero out the uninitialized (really, unused) part of the containers 4233 /* Zero out the uninitialized (really, unused) part of the containers
4232 for the live strings. */ 4234 for the live strings. */
4233 { 4235 {
4234 struct string_chars_block *scb; 4236 struct string_chars_block *scb;
4235 for (scb = first_string_chars_block; scb; scb = scb->next) 4237 for (scb = first_string_chars_block; scb; scb = scb->next)
4236 /* from the block's fill ptr to the end */ 4238 {
4237 memset ((scb->string_chars + scb->pos), 0, 4239 int count = sizeof (scb->string_chars) - scb->pos;
4238 sizeof (scb->string_chars) - scb->pos); 4240
4241 assert (count >= 0 && count < STRING_CHARS_BLOCK_SIZE);
4242 if (count != 0) {
4243 /* from the block's fill ptr to the end */
4244 memset ((scb->string_chars + scb->pos), 0, count);
4245 }
4246 }
4239 } 4247 }
4240 4248
4241 /* There, that ought to be enough... */ 4249 /* There, that ought to be enough... */
4242 4250
4243 } 4251 }