Mercurial > hg > xemacs-beta
comparison src/alloc.c @ 171:929b76928fce r20-3b12
Import from CVS: tag r20-3b12
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:47:52 +0200 |
parents | 15872534500d |
children | 8eaf7971accc |
comparison
equal
deleted
inserted
replaced
170:98a42ee61975 | 171:929b76928fce |
---|---|
179 /* Index in pure at which next pure object will be allocated. */ | 179 /* Index in pure at which next pure object will be allocated. */ |
180 static long pureptr; | 180 static long pureptr; |
181 | 181 |
182 #define PURIFIED(ptr) \ | 182 #define PURIFIED(ptr) \ |
183 ((uintptr_t) (ptr) < \ | 183 ((uintptr_t) (ptr) < \ |
184 (uintptr_t) (PUREBEG + PURESIZE) && \ | 184 (uintptr_t) (PUREBEG + get_PURESIZE()) && \ |
185 (uintptr_t) (ptr) >= \ | 185 (uintptr_t) (ptr) >= \ |
186 (uintptr_t) PUREBEG) | 186 (uintptr_t) PUREBEG) |
187 | 187 |
188 /* Non-zero if pureptr > PURESIZE; accounts for excess purespace needs. */ | 188 /* Non-zero if pureptr > get_PURESIZE(); accounts for excess purespace needs. */ |
189 static long pure_lossage; | 189 static long pure_lossage; |
190 | 190 |
191 #ifdef ERROR_CHECK_TYPECHECK | 191 #ifdef ERROR_CHECK_TYPECHECK |
192 | 192 |
193 Error_behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN; | 193 Error_behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN; |
214 if (pure_lossage) | 214 if (pure_lossage) |
215 { | 215 { |
216 pure_lossage += size; | 216 pure_lossage += size; |
217 return (0); | 217 return (0); |
218 } | 218 } |
219 else if (pureptr + size > PURESIZE) | 219 else if (pureptr + size > get_PURESIZE()) |
220 { | 220 { |
221 /* This can cause recursive bad behavior, we'll yell at the end */ | 221 /* This can cause recursive bad behavior, we'll yell at the end */ |
222 /* when we're done. */ | 222 /* when we're done. */ |
223 /* message ("\nERROR: Pure Lisp storage exhausted!\n"); */ | 223 /* message ("\nERROR: Pure Lisp storage exhausted!\n"); */ |
224 pure_lossage = size; | 224 pure_lossage = size; |
2518 void * | 2518 void * |
2519 alloc_pure_lrecord (int size, struct lrecord_implementation *implementation) | 2519 alloc_pure_lrecord (int size, struct lrecord_implementation *implementation) |
2520 { | 2520 { |
2521 struct lrecord_header *header = (void *) (PUREBEG + pureptr); | 2521 struct lrecord_header *header = (void *) (PUREBEG + pureptr); |
2522 | 2522 |
2523 if (pureptr + size > PURESIZE) | 2523 if (pureptr + size > get_PURESIZE()) |
2524 pure_storage_exhausted (); | 2524 pure_storage_exhausted (); |
2525 | 2525 |
2526 set_lheader_implementation (header, implementation); | 2526 set_lheader_implementation (header, implementation); |
2527 header->next = 0; | 2527 header->next = 0; |
2528 return (header); | 2528 return (header); |
2627 CONST long report_round = 5000; | 2627 CONST long report_round = 5000; |
2628 | 2628 |
2629 message ("\n****\tPure Lisp storage exhausted!\n" | 2629 message ("\n****\tPure Lisp storage exhausted!\n" |
2630 "\tPurespace usage: %ld of %ld\n" | 2630 "\tPurespace usage: %ld of %ld\n" |
2631 "****", | 2631 "****", |
2632 PURESIZE+pure_lossage, (long) PURESIZE); | 2632 get_PURESIZE()+pure_lossage, (long) get_PURESIZE()); |
2633 if (die_if_pure_storage_exceeded) { | 2633 if (die_if_pure_storage_exceeded) { |
2634 PURESIZE_h(PURESIZE + pure_lossage); | 2634 PURESIZE_h(get_PURESIZE() + pure_lossage); |
2635 rc = -1; | 2635 rc = -1; |
2636 } | 2636 } |
2637 } | 2637 } |
2638 else | 2638 else |
2639 { | 2639 { |
2640 int lost = (PURESIZE - pureptr) / 1024; | 2640 int lost = (get_PURESIZE() - pureptr) / 1024; |
2641 char buf[200]; | 2641 char buf[200]; |
2642 | 2642 |
2643 sprintf (buf, "Purespace usage: %ld of %ld (%d%%", | 2643 sprintf (buf, "Purespace usage: %ld of %ld (%d%%", |
2644 pureptr, (long) PURESIZE, | 2644 pureptr, (long) get_PURESIZE(), |
2645 (int) (pureptr / (PURESIZE / 100.0) + 0.5)); | 2645 (int) (pureptr / (get_PURESIZE() / 100.0) + 0.5)); |
2646 if (lost > 2) { | 2646 if (lost > 2) { |
2647 sprintf (buf + strlen (buf), " -- %dk wasted", lost); | 2647 sprintf (buf + strlen (buf), " -- %dk wasted", lost); |
2648 if (die_if_pure_storage_exceeded) { | 2648 if (die_if_pure_storage_exceeded) { |
2649 PURESIZE_h(pureptr + 16); | 2649 PURESIZE_h(pureptr + 16); |
2650 rc = -1; | 2650 rc = -1; |
2737 (void)unlink("SATISFIED"); | 2737 (void)unlink("SATISFIED"); |
2738 /* Current build process on NT does */ | 2738 /* Current build process on NT does */ |
2739 /* not know how to restart itself. */ | 2739 /* not know how to restart itself. */ |
2740 /* --marcpa */ | 2740 /* --marcpa */ |
2741 #ifndef WINDOWSNT | 2741 #ifndef WINDOWSNT |
2742 fatal ("Pure size adjusted, will restart `make'"); | 2742 fatal ("Pure size adjusted, Don't Panic! I will restart the `make'"); |
2743 #endif | 2743 #endif |
2744 } else if (pure_lossage && die_if_pure_storage_exceeded) { | 2744 } else if (pure_lossage && die_if_pure_storage_exceeded) { |
2745 fatal ("Pure storage exhausted"); | 2745 fatal ("Pure storage exhausted"); |
2746 } | 2746 } |
2747 } | 2747 } |
3915 disksave_object_finalization_1 (); | 3915 disksave_object_finalization_1 (); |
3916 | 3916 |
3917 /* Zero out the unused portion of purespace */ | 3917 /* Zero out the unused portion of purespace */ |
3918 if (!pure_lossage) | 3918 if (!pure_lossage) |
3919 memset ( (char *) (PUREBEG + pureptr), 0, | 3919 memset ( (char *) (PUREBEG + pureptr), 0, |
3920 (((char *) (PUREBEG + PURESIZE)) - | 3920 (((char *) (PUREBEG + get_PURESIZE())) - |
3921 ((char *) (PUREBEG + pureptr)))); | 3921 ((char *) (PUREBEG + pureptr)))); |
3922 | 3922 |
3923 /* Zero out the uninitialized (really, unused) part of the containers | 3923 /* Zero out the uninitialized (really, unused) part of the containers |
3924 for the live strings. */ | 3924 for the live strings. */ |
3925 { | 3925 { |