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 {