Back to index

plt-scheme  4.2.1
copy.c
Go to the documentation of this file.
00001 /*
00002   Precise GC for MzScheme
00003   Copyright (c) 2004-2009 PLT Scheme Inc.
00004   Copyright (c) 1999 Matthew Flatt
00005   All rights reserved.
00006 
00007   Please see the full copyright in the documentation.
00008 */
00009 
00010 /* This implementation is currently hard-wired for 4-byte words */
00011 
00012 #include <stdlib.h>
00013 #include <stdio.h>
00014 #include <string.h>
00015 
00016 #define USE_MMAP 1
00017 #define GROW_FACTOR 1.5
00018 
00019 #if defined(sparc) || defined(__sparc) || defined(__sparc__)
00020 # define ALIGN_DOUBLES 1
00021 #else
00022 # define ALIGN_DOUBLES 0
00023 #endif
00024 
00025 #if USE_MMAP
00026 /* For mmap: */
00027 # include <fcntl.h>
00028 # include <sys/types.h>
00029 # include <sys/mman.h>
00030 # include <errno.h>
00031 #endif
00032 
00033 typedef short Type_Tag;
00034 
00035 #include "gc2.h"
00036 
00037 #define TIME 0
00038 #define SEARCH 1
00039 #define SAFETY 1
00040 #define RECYCLE_HEAP 0
00041 #define KEEP_FROM_PTR 0
00042 
00043 #define GC_EVERY_ALLOC 0
00044 #define ALLOC_GC_PHASE 0
00045 #define SKIP_FORCED_GC 0
00046 
00047 #define CHECK_STACK_EVERY 5
00048 #define CHECK_STACK_START -1
00049 
00050 void (*GC_collect_start_callback)(void);
00051 void (*GC_collect_end_callback)(void);
00052 void (*GC_out_of_memory)(void);
00053 unsigned long (*GC_get_thread_stack_base)(void);
00054 
00055 void (*GC_mark_xtagged)(void *obj);
00056 void (*GC_fixup_xtagged)(void *obj);
00057 
00058 void **GC_variable_stack;
00059 
00060 Type_Tag weak_box_tag;
00061 
00062 #define gc_finalization_tag 256
00063 #define gc_finalization_weak_link_tag 257
00064 #define gc_weak_array_tag 258
00065 
00066 #define _num_tags_ 259
00067 
00068 Size_Proc size_table[_num_tags_];
00069 Mark_Proc mark_table[_num_tags_];
00070 Fixup_Proc fixup_table[_num_tags_];
00071 
00072 #define STARTING_PLACE ((void *)0x400000)
00073 
00074 void *GC_alloc_space = STARTING_PLACE, *GC_alloc_top;
00075 static long alloc_size, heap_size = 32000;
00076 static void **tagged_high = STARTING_PLACE, **untagged_low = STARTING_PLACE;
00077 static void **new_tagged_high, **new_untagged_low;
00078 
00079 static void *old_space;
00080 static long old_size;
00081 
00082 static char *alloc_bitmap;
00083 
00084 static char zero_sized[4];
00085 
00086 static void *park[2];
00087 
00088 static int cycle_count = 0;
00089 #if GC_EVERY_ALLOC
00090 static int alloc_cycle = ALLOC_GC_PHASE;
00091 static int skipped_first = !SKIP_FORCED_GC;
00092 #endif
00093 
00094 #if KEEP_FROM_PTR
00095 static void *mark_source;
00096 # define FROM_STACK ((void *)0xAAAA1)
00097 # define FROM_ROOT ((void *)0xAAAA3)
00098 # define FROM_FNL ((void *)0xAAAA5)
00099 # define FROM_NEW ((void *)0xAAAA7)
00100 # define FROM_IMM ((void *)0xAAAA7)
00101 #endif
00102 
00103 /******************************************************************************/
00104 
00105 #if USE_MMAP
00106 
00107 int fd, fd_created;
00108 
00109 #define PAGE_SIZE 4096
00110 
00111 void *malloc_pages(size_t len)
00112 {
00113   void *r;
00114 
00115   if (!fd_created) {
00116     fd_created = 1;
00117     fd = open("/dev/zero", O_RDWR);
00118   }
00119 
00120   if (len & (PAGE_SIZE - 1)) {
00121     len += PAGE_SIZE - (len & (PAGE_SIZE - 1));
00122   }
00123 
00124   r = mmap(NULL, len, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
00125 
00126   if (r  == (void *)-1) {
00127     printf("mmap failed: %s\n", strerror(errno));
00128     exit(-1);
00129   }
00130 
00131   return r;
00132 }
00133 
00134 void free_pages(void *p, size_t len)
00135 {
00136   munmap(p, len);
00137 }
00138 
00139 #endif
00140 
00141 /******************************************************************************/
00142 
00143 #if !USE_MMAP
00144 
00145 void *malloc_pages(size_t len)
00146 {
00147   return malloc(len);
00148 }
00149 
00150 void free_pages(void *p, size_t len)
00151 {
00152   free(p);
00153 }
00154 
00155 #endif
00156 
00157 /******************************************************************************/
00158 
00159 #define PTR_ALIGNMENT 4
00160 #define PTR_TO_INT(x) ((unsigned long)x)
00161 #define INT_TO_PTR(x) ((void *)x)
00162 
00163 static long roots_count;
00164 static long roots_size;
00165 static unsigned long *roots;
00166 
00167 static int compare_roots(const void *a, const void *b)
00168 {
00169   if (*(unsigned long *)a < *(unsigned long *)b)
00170     return -1;
00171   else
00172     return 1;
00173 }
00174 
00175 static void sort_and_merge_roots()
00176 {
00177   static int counter = 0;
00178   int i, offset, top;
00179 
00180   if (roots_count < 4)
00181     return;
00182 
00183   /* Only try this every 5 collections or so: */
00184   if (counter--)
00185     return;
00186   counter = 5;
00187 
00188   qsort(roots, roots_count >> 1, 2 * sizeof(unsigned long), compare_roots);
00189   offset = 0;
00190   top = roots_count;
00191   for (i = 2; i < top; i += 2) {
00192     if ((roots[i - 2 - offset] <= roots[i])
00193        && ((roots[i - 1 - offset] + (PTR_ALIGNMENT - 1)) >= roots[i])) {
00194       /* merge: */
00195       if (roots[i + 1] > roots[i - 1 - offset])
00196        roots[i - 1 - offset] = roots[i + 1];
00197       offset += 2;
00198       roots_count -= 2;
00199     } else if (roots[i] == roots[i + 1]) {
00200       /* Remove empty range: */
00201       offset += 2;
00202       roots_count -= 2;
00203     } else if (offset) {
00204       /* compact: */
00205       roots[i - offset] = roots[i];
00206       roots[i + 1 - offset] = roots[i + 1];
00207     }
00208   }
00209 }
00210 
00211 void GC_add_roots(void *start, void *end)
00212 {
00213   if (roots_count >= roots_size) {
00214     unsigned long *naya;
00215 
00216     roots_size = roots_size ? 2 * roots_size : 500;
00217     naya = (unsigned long *)malloc(sizeof(unsigned long) * (roots_size + 1));
00218 
00219     memcpy((void *)naya, (void *)roots, 
00220           sizeof(unsigned long) * roots_count);
00221 
00222     if (roots)
00223       free(roots);
00224 
00225     roots = naya;
00226   }
00227 
00228   roots[roots_count++] = PTR_TO_INT(start);
00229   roots[roots_count++] = PTR_TO_INT(end) - PTR_ALIGNMENT;
00230 }
00231 
00232 typedef struct ImmobileBox {
00233   void *p;
00234   struct ImmobileBox *next, *prev;
00235 } ImmobileBox;
00236 
00237 static ImmobileBox *immobile;
00238 
00239 void *GC_malloc_immobile_box(void *p)
00240 {
00241   ImmobileBox *ib;
00242 
00243   ib = (ImmobileBox *)malloc(sizeof(ImmobileBox));
00244   ib->p = p;
00245   ib->next = immobile;
00246   if (immobile)
00247     immobile->prev = ib;
00248   ib->prev = NULL;
00249 
00250   immobile = ib;
00251 
00252   return ib;
00253 }
00254 
00255 void GC_free_immobile_box(void *b)
00256 {
00257   ImmobileBox *ib = (ImmobileBox *)b;
00258 
00259   if (!ib)
00260     return;
00261 
00262   if (ib->prev)
00263     ib->prev->next = ib->next;
00264   else
00265     immobile = ib->next;
00266   if (ib->next)
00267     ib->next->prev = ib->prev;
00268 
00269   free(ib);
00270 }
00271 
00272 /******************************************************************************/
00273 
00274 typedef struct GC_Weak_Array {
00275   Type_Tag type;
00276   short keyex;
00277   long count;
00278   void *replace_val;
00279   struct GC_Weak_Array *next;
00280   void *data[1];
00281 } GC_Weak_Array;
00282 
00283 static GC_Weak_Array *weak_arrays;
00284 
00285 static int size_weak_array(void *p)
00286 {
00287   GC_Weak_Array *a = (GC_Weak_Array *)p;
00288 
00289   return gcBYTES_TO_WORDS(sizeof(GC_Weak_Array) 
00290                        + ((a->count - 1) * sizeof(void *)));
00291 }
00292 
00293 static int mark_weak_array(void *p)
00294 {
00295   /* Not used */
00296   return size_weak_array(p);
00297 }
00298 
00299 static int fixup_weak_array(void *p)
00300 {
00301   GC_Weak_Array *a = (GC_Weak_Array *)p;
00302 
00303   gcFIXUP(a->replace_val);
00304     
00305   a->next = weak_arrays;
00306   weak_arrays = a;
00307 
00308   return size_weak_array(p);
00309 }
00310 
00311 void *GC_malloc_weak_array(size_t size_in_bytes, void *replace_val)
00312 {
00313   GC_Weak_Array *w;
00314 
00315   /* Allcation might trigger GC, so we use park: */
00316   park[0] = replace_val;
00317 
00318   w = (GC_Weak_Array *)GC_malloc_one_tagged(size_in_bytes 
00319                                        + sizeof(GC_Weak_Array) 
00320                                        - sizeof(void *));
00321 
00322   replace_val = park[0];
00323   park[0] = NULL;
00324 
00325   w->type = gc_weak_array_tag;
00326   w->replace_val = replace_val;
00327   w->count = (size_in_bytes >> 2);
00328   
00329   return w;
00330 }
00331 
00332 typedef struct GC_Weak_Box {
00333   /* The first three fields are mandated by the GC spec: */
00334   Type_Tag type;
00335   short keyex;
00336   void *val;
00337   /* The rest is up to us: */
00338   void **secondary_erase;
00339   int soffset;
00340   struct GC_Weak_Box *next;
00341 } GC_Weak_Box;
00342 
00343 static GC_Weak_Box *weak_boxes;
00344 
00345 static int size_weak_box(void *p)
00346 {
00347   return gcBYTES_TO_WORDS(sizeof(GC_Weak_Box));
00348 }
00349 
00350 static int mark_weak_box(void *p)
00351 {
00352   /* Not used */
00353   return gcBYTES_TO_WORDS(sizeof(GC_Weak_Box));
00354 }
00355 
00356 static int fixup_weak_box(void *p)
00357 {
00358   GC_Weak_Box *wb = (GC_Weak_Box *)p;
00359   
00360   gcFIXUP(wb->secondary_erase);
00361   if (wb->val) {
00362     wb->next = weak_boxes;
00363     weak_boxes = wb;
00364   }
00365 
00366   return gcBYTES_TO_WORDS(sizeof(GC_Weak_Box));
00367 }
00368 
00369 void *GC_malloc_weak_box(void *p, void **secondary, int soffset)
00370 {
00371   GC_Weak_Box *w;
00372 
00373   /* Allcation might trigger GC, so we use park: */
00374   park[0] = p;
00375   park[1] = secondary;
00376 
00377   w = (GC_Weak_Box *)GC_malloc_one_tagged(sizeof(GC_Weak_Box));
00378 
00379   p = park[0];
00380   park[0] = NULL;
00381   secondary = (void **)park[1];
00382   park[1] = NULL;
00383   
00384   w->type = weak_box_tag;
00385   w->val = p;
00386   w->secondary_erase = secondary;
00387   w->soffset = soffset;
00388 
00389   return w;
00390 }
00391 
00392 /******************************************************************************/
00393 
00394 typedef struct Fnl {
00395   Type_Tag type;
00396   short eager_level;
00397   void *p;
00398   void (*f)(void *p, void *data);
00399   void *data;
00400   struct Fnl *next;
00401 } Fnl;
00402 
00403 static Fnl *fnls, *run_queue, *last_in_queue;
00404 
00405 static int size_finalizer(void *p)
00406 {
00407   return gcBYTES_TO_WORDS(sizeof(Fnl));
00408 }
00409 
00410 static int mark_finalizer(void *p)
00411 {
00412   /* Not used */
00413   return gcBYTES_TO_WORDS(sizeof(Fnl));
00414 }
00415 
00416 static int fixup_finalizer(void *p)
00417 {
00418   Fnl *fnl = (Fnl *)p;
00419   
00420   gcFIXUP(fnl->next);
00421   gcFIXUP(fnl->data);
00422   if (!fnl->eager_level) {
00423     /* Queued for run: */
00424     gcFIXUP(fnl->p);
00425   }
00426 
00427   return gcBYTES_TO_WORDS(sizeof(Fnl));
00428 }
00429 
00430 void GC_set_finalizer(void *p, int tagged, int level, void (*f)(void *p, void *data), 
00431                     void *data, void (**oldf)(void *p, void *data), 
00432                     void **olddata)
00433 {
00434   Fnl *fnl, *prev;
00435 
00436   if (((long)p & 0x1) || (p < GC_alloc_space) || (p > GC_alloc_top)) {
00437     /* Never collected. Don't finalize it. */
00438     if (oldf) *oldf = NULL;
00439     if (olddata) *olddata = NULL;
00440     return;
00441   }
00442 
00443   fnl = fnls;
00444   prev = NULL;
00445   while (fnl) {
00446     if (fnl->p == p) {
00447       if (oldf) *oldf = fnl->f;
00448       if (olddata) *olddata = fnl->data;
00449       if (f) {
00450        fnl->f = f;
00451        fnl->data = data;
00452        fnl->eager_level = level;
00453       } else {
00454        if (prev)
00455          prev->next = fnl->next;
00456        else
00457          fnls = fnl->next;
00458        return;
00459       }
00460       return;
00461     } else {
00462       prev = fnl;
00463       fnl = fnl->next;
00464     }
00465   }
00466   
00467   if (oldf) *oldf = NULL;
00468   if (olddata) *olddata = NULL;
00469 
00470   if (!f)
00471     return;
00472 
00473   /* Allcation might trigger GC, so we use park: */
00474   park[0] = p;
00475   park[1] = data;
00476 
00477   fnl = GC_malloc_one_tagged(sizeof(Fnl));
00478 
00479   p = park[0];
00480   park[0] = NULL;
00481   data = park[1];
00482   park[1] = NULL;
00483 
00484   fnl->type = gc_finalization_tag;
00485   fnl->next = fnls;
00486   fnl->p = p;
00487   fnl->f = f;
00488   fnl->data = data;
00489   fnl->eager_level = level;
00490 
00491   fnls = fnl;
00492 }
00493 
00494 typedef struct Fnl_Weak_Link {
00495   Type_Tag type;
00496   void *p;
00497   long offset; /* offset from beginning of block */
00498   void *saved;
00499   struct Fnl_Weak_Link *next;
00500 } Fnl_Weak_Link;
00501 
00502 static Fnl_Weak_Link *fnl_weaks;
00503 
00504 static int size_finalizer_weak_link(void *p)
00505 {
00506   return gcBYTES_TO_WORDS(sizeof(Fnl_Weak_Link));
00507 }
00508 
00509 static int mark_finalizer_weak_link(void *p)
00510 {
00511   /* Not used */
00512   return gcBYTES_TO_WORDS(sizeof(Fnl_Weak_Link));
00513 }
00514 
00515 static int fixup_finalizer_weak_link(void *p)
00516 {
00517   Fnl_Weak_Link *wl = (Fnl_Weak_Link *)p;
00518   
00519   gcFIXUP(wl->next);
00520 
00521   return gcBYTES_TO_WORDS(sizeof(Fnl_Weak_Link));
00522 }
00523 
00524 void GC_finalization_weak_ptr(void **p, int offset)
00525 {
00526   Fnl_Weak_Link *wl;
00527 
00528 #ifdef SAFETY
00529   if (((void *)p < GC_alloc_space) || (p >= GC_alloc_top)) {
00530     *(int *)0x0 = 1;
00531   }
00532 #endif
00533 
00534   /* Allcation might trigger GC, so we use park: */
00535   park[0] = p;
00536 
00537   wl = (Fnl_Weak_Link *)GC_malloc_one_tagged(sizeof(Fnl_Weak_Link));
00538 
00539   p = park[0];
00540   park[0] = NULL;
00541 
00542   wl->type = gc_finalization_weak_link_tag;
00543   wl->p = p;
00544   wl->offset = offset * sizeof(void*);
00545   wl->next = fnl_weaks;
00546 
00547   fnl_weaks = wl;
00548 }
00549 
00550 /******************************************************************************/
00551 
00552 static unsigned long stack_base;
00553 
00554 void GC_set_stack_base(void *base)
00555 {
00556   stack_base = (unsigned long)base;
00557 }
00558 
00559 unsigned long GC_get_stack_base(void)
00560 {
00561   return stack_base;
00562 }
00563 
00564 void GC_dump(void)
00565 {
00566   fprintf(stderr, "Memory use: %ld\n", GC_get_memory_use());
00567 }
00568 
00569 long GC_get_memory_use()
00570 {
00571   return (alloc_size - ((untagged_low - tagged_high) << 2));
00572 }
00573 
00574 void GC_init_type_tags(int count, int weakbox)
00575 {
00576   weak_box_tag = weakbox;
00577 }
00578 
00579 #define SKIP ((Type_Tag)0x7000)
00580 #define MOVED ((Type_Tag)0x3000)
00581 
00582 #if SEARCH
00583 void *search_for, *search_mark;
00584 long search_size;
00585 int detail_cycle;
00586 int atomic_detail_cycle;
00587 #endif
00588 
00589 #if SEARCH
00590 void stop()
00591 {
00592   printf("stopped\n");
00593 }
00594 #endif
00595 
00596 /* Only works during GC: */
00597 void *find_start(void *p)
00598 {
00599   long diff = ((char *)p - (char *)GC_alloc_space) >> 2;
00600 
00601   if (((long)p & 0x3) || !(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) {
00602     while (!(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) {
00603       diff--;
00604     }
00605       
00606     diff <<= 2;
00607 
00608     return (void *)((char *)GC_alloc_space + diff);
00609   } else
00610     return p;
00611 }
00612 
00613 #ifdef SAFETY
00614 static void middle(unsigned long p, long delta, unsigned long where)
00615 {
00616   fprintf(stderr, "Middle!: 0x%lx d: %ld at 0x%lx\n", p, delta, where);
00617 }
00618 
00619 static int check_count = CHECK_STACK_START;
00620 
00621 static void check_interior_pointer(void **pp)
00622 {
00623   void *p = *pp;
00624 
00625   if (check_count--)
00626     return;
00627   else
00628     check_count = CHECK_STACK_EVERY;
00629 
00630   if (!((long)p & 0x1)
00631       && (p >= GC_alloc_space)
00632       && (p <= GC_alloc_top)) {
00633     long diff = ((char *)p - (char *)GC_alloc_space) >> 2;
00634     
00635     if (((long)p & 0x3) || !(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) {
00636       long diff1 = ((char *)p - (char *)GC_alloc_space);
00637       
00638       while (!(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) {
00639        diff--;
00640       }
00641       
00642       diff <<= 2;
00643       
00644       if (((diff + (char *)GC_alloc_space) > (char *)tagged_high)
00645          && ((*(long *)(diff + (char *)GC_alloc_space - 4) & 0x20000000))) {
00646        /* Middle is ok. */
00647       } else {
00648        middle((unsigned long)p, diff1 - diff, (unsigned long)pp);
00649       }
00650     }
00651   }
00652 }
00653 #endif
00654 
00655 static void *mark(void *p)
00656 {
00657   long diff = ((char *)p - (char *)GC_alloc_space) >> 2;
00658 
00659 #if SEARCH
00660   if (p == search_mark)
00661     stop();
00662 #endif
00663 
00664   if (((long)p & 0x3) || !(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) {
00665     long diff1 = ((char *)p - (char *)GC_alloc_space);
00666       
00667     while (!(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) {
00668       diff--;
00669     }
00670       
00671     diff <<= 2;
00672 
00673 #ifdef SAFETY
00674     if (((diff + (char *)GC_alloc_space) > (char *)tagged_high)
00675        && ((*(long *)(diff + (char *)GC_alloc_space - 4) & 0x20000000)
00676            || (!(*(long *)(diff + (char *)GC_alloc_space - 4))
00677               && (*(long **)(diff + (char *)GC_alloc_space))[-1] & 0x20000000))) {
00678       /* Middle is ok. */
00679     } else {
00680       middle((unsigned long)p, diff1 - diff, 0);
00681     }
00682 #endif
00683 
00684     return (void *)((char *)mark(diff + (char *)GC_alloc_space) + (diff1 - diff));
00685   } else {
00686     if (p < (void *)tagged_high) {
00687       Type_Tag tag = *(Type_Tag *)p;
00688       long size;
00689       void *naya;
00690        
00691       if (tag == MOVED)
00692        return ((void **)p)[1];
00693 
00694 #if SAFETY    
00695       if ((tag < 0) || (tag >= _num_tags_) || !size_table[tag]) {
00696        *(int *)0x0 = 1;
00697       }
00698 #endif
00699        
00700       size = size_table[tag](p);
00701 #if ALIGN_DOUBLES
00702       if (!(size & 0x1)) {
00703        if ((long)new_tagged_high & 0x4) {
00704          ((Type_Tag *)new_tagged_high)[0] = SKIP;
00705          new_tagged_high += 1;
00706        }
00707       }
00708 #endif
00709        
00710 #if KEEP_FROM_PTR
00711       *new_tagged_high = mark_source;
00712       new_tagged_high++;
00713 #endif
00714 
00715       {
00716        int i;
00717        long *a, *b;
00718        a = (long *)new_tagged_high;
00719        b = (void *)p;
00720        for (i = size; i--; )
00721          *(a++) = *(b++);
00722       }
00723        
00724       naya = new_tagged_high;
00725       ((Type_Tag *)p)[0] = MOVED;
00726       ((void **)p)[1] = naya;
00727        
00728       new_tagged_high += size;
00729 #if SEARCH
00730       if (naya == search_for) {
00731        stop();
00732       }
00733 #endif
00734       return naya;
00735     } else {
00736       long size;
00737        
00738       p -= 4;
00739       size = ((*(long *)p) & 0x0FFFFFFF);
00740        
00741       if (!size)
00742        return ((void **)p)[1];
00743 
00744 #if ALIGN_DOUBLES
00745       if (!(size & 1)) {
00746        if (!((long)new_untagged_low & 0x4)) {
00747          new_untagged_low--;
00748          *(long *)new_untagged_low = 0;
00749        }
00750       }
00751 #endif
00752       size++;
00753 
00754       new_untagged_low -= size;
00755 
00756 #if SAFETY
00757       if ((unsigned long)new_untagged_low < (unsigned long)new_tagged_high) {
00758        *(int *)0x0 = 1;
00759       }
00760 #endif 
00761 
00762       {
00763        int i;
00764        long *a, *b;
00765        a = (long *)new_untagged_low;
00766        b = (void *)p;
00767        for (i = size; i--; )
00768          *(a++) = *(b++);
00769       }
00770       ((void **)p)[1] = new_untagged_low + 1;
00771       ((long *)p)[0] = 0;
00772        
00773 #if SEARCH
00774       if ((new_untagged_low + 1) == search_for) {
00775        stop();
00776       }
00777 #endif
00778 
00779 #if SEARCH
00780       if (atomic_detail_cycle == cycle_count) {
00781        printf("%ld at %lx\n", size, (long)new_untagged_low);
00782       }
00783 #endif
00784 
00785 #if KEEP_FROM_PTR
00786       --new_untagged_low;
00787       *new_untagged_low = mark_source;
00788       return new_untagged_low + 2;
00789 #else
00790       return new_untagged_low + 1;
00791 #endif
00792     }
00793   }
00794 }
00795 
00796 void GC_mark(const void *p)
00797 {
00798   /* Not used. */
00799 }
00800 
00801 void GC_fixup(void *_p)
00802 {
00803   void *p;
00804 
00805   p = *(void **)_p;
00806 
00807   if (!((long)p & 0x1)
00808       && (p >= GC_alloc_space)
00809       && (p <= GC_alloc_top))
00810     *(void **)_p = mark(p);
00811 }
00812 
00813 static void **o_var_stack, **oo_var_stack;
00814 
00815 void GC_mark_variable_stack(void **var_stack,
00816                          long delta,
00817                          void *limit)
00818 {
00819   /* Not used. */
00820 }
00821 
00822 void GC_trace_variable_stack(void **var_stack,
00823                           long delta,
00824                           void *limit,
00825                           int just_check)
00826 {
00827   int stack_depth;
00828 
00829   stack_depth = 0;
00830   while (var_stack) {
00831     long size;
00832     void ***p;
00833 
00834     var_stack = (void **)((char *)var_stack + delta);
00835     if (var_stack == limit)
00836       return;
00837 
00838     size = *(long *)(var_stack + 1);
00839 
00840     oo_var_stack = o_var_stack;
00841     o_var_stack = var_stack;
00842 
00843     p = (void ***)(var_stack + 2);
00844     
00845     while (size--) {
00846       if (!*p) {
00847        /* Array */
00848        long count = ((long *)p)[2];
00849        void **a = ((void ***)p)[1];
00850        p += 2;
00851        size -= 2;
00852        a = (void **)((char *)a + delta);
00853        while (count--) {
00854 #ifdef SAFETY
00855          if (just_check) {
00856            check_interior_pointer(a);
00857          } else 
00858 #endif
00859            { gcFIXUP(*a); }
00860          a++;
00861        }
00862       } else {
00863        void **a = *p;
00864        a = (void **)((char *)a + delta);
00865 #ifdef SAFETY
00866        if (just_check) {
00867          check_interior_pointer(a);
00868        } else
00869 #endif
00870          { gcFIXUP(*a); }
00871       }
00872       p++;
00873     }
00874 
00875 #if SAFETY
00876     if (*var_stack && ((unsigned long)*var_stack <= (unsigned long)var_stack))
00877       *(int *)0x0 = 1;
00878 #endif
00879 
00880     var_stack = *var_stack;
00881     stack_depth++;
00882   }
00883 }
00884 
00885 void GC_fixup_variable_stack(void **var_stack,
00886                           long delta,
00887                           void *limit)
00888 {
00889   GC_trace_variable_stack(var_stack, delta, limit, 0);
00890 }
00891 
00892 #if SAFETY
00893 void check_variable_stack()
00894 {
00895   void **limit, **var_stack;
00896 
00897   if (!alloc_bitmap)
00898     return;
00899 
00900   limit = (void **)(GC_get_thread_stack_base
00901                   ? GC_get_thread_stack_base()
00902                   : stack_base);
00903 
00904   var_stack = GC_variable_stack;
00905 
00906   GC_trace_variable_stack(var_stack, 0, limit, 1);
00907 }
00908 #endif
00909 
00910 #if 0
00911 # define GETTIME() ((long)scheme_get_milliseconds())
00912 #else
00913 # define GETTIME() ((long)scheme_get_process_milliseconds())
00914 #endif
00915 
00916 #if TIME
00917 # define PRINTTIME(x) fprintf x
00918 # define STDERR stderr
00919 static long started, rightnow, old;
00920 # define INITTIME() (started = GETTIME())
00921 # define GETTIMEREL() (rightnow = GETTIME(), old = started, started = rightnow, rightnow - old)
00922 #else
00923 # define INITTIME() /* empty */
00924 # define PRINTTIME(x) /* empty */
00925 #endif
00926 
00927 static int initialized;
00928 #if SAFETY
00929 static long *prev_ptr;
00930 static void **prev_var_stack;
00931 #endif
00932 
00933 void gcollect(int needsize)
00934 {
00935   /* Check old: */
00936   long *p, *top;
00937   void *new_space;
00938   long new_size;
00939   void **tagged_mark, **untagged_mark;
00940   char *bitmap;
00941   int i, did_fnls;
00942   long diff, iterations;
00943   ImmobileBox *ib;
00944   GC_Weak_Box *wb;
00945   GC_Weak_Array *wa;
00946 
00947   INITTIME();
00948   PRINTTIME((STDERR, "gc: start: %ld\n", GETTIMEREL()));
00949 
00950   cycle_count++;
00951 
00952   if (!initialized) {
00953     GC_register_traversers(weak_box_tag, size_weak_box, mark_weak_box, fixup_weak_box);
00954     GC_register_traversers(gc_weak_array_tag, size_weak_array, mark_weak_array, fixup_weak_array);
00955     GC_register_traversers(gc_finalization_tag, size_finalizer, mark_finalizer, fixup_finalizer);
00956     GC_register_traversers(gc_finalization_weak_link_tag, size_finalizer_weak_link, mark_finalizer_weak_link, fixup_finalizer_weak_link);
00957 
00958     GC_add_roots(&fnls, (char *)&fnls + sizeof(fnls) + 1);
00959     GC_add_roots(&fnl_weaks, (char *)&fnl_weaks + sizeof(fnl_weaks) + 1);
00960     GC_add_roots(&run_queue, (char *)&run_queue + sizeof(run_queue) + 1);
00961     GC_add_roots(&last_in_queue, (char *)&last_in_queue + sizeof(last_in_queue) + 1);
00962     GC_add_roots(&park, (char *)&park + sizeof(park) + 1);
00963     initialized = 1;
00964   }
00965 
00966   weak_boxes = NULL;
00967   weak_arrays = NULL;
00968   did_fnls = 0;
00969 
00970   if (GC_collect_start_callback)
00971     GC_collect_start_callback();
00972 
00973   sort_and_merge_roots();
00974 
00975   new_size = (heap_size * GROW_FACTOR);
00976   if (new_size < alloc_size)
00977     new_size = alloc_size;
00978 
00979   new_size += needsize;
00980 
00981   /* word-aligned: */
00982   new_size = (new_size + 3) & 0xFFFFFFFC;
00983   
00984   if (old_size >= new_size) {
00985     new_size = old_size;
00986     new_space = old_space;
00987   } else {
00988     if (old_size) {
00989       free_pages(old_space, old_size);
00990       old_size = 0;
00991     }
00992 
00993     new_space = malloc_pages(new_size + 4);
00994 
00995     if (!new_space) {
00996       printf("Out of memory");
00997       abort();
00998     }
00999   }
01000 
01001   /******************** Mark/Copy ****************************/
01002 
01003   tagged_mark = new_tagged_high = (void **)new_space;
01004   untagged_mark = new_untagged_low = (void **)(new_space + new_size);
01005 
01006 #if KEEP_FROM_PTR
01007   mark_source = FROM_STACK;
01008 #endif
01009 
01010   GC_fixup_variable_stack(GC_variable_stack,
01011                        0,
01012                        (void *)(GC_get_thread_stack_base
01013                                ? GC_get_thread_stack_base()
01014                                : stack_base));
01015 
01016   PRINTTIME((STDERR, "gc: stack: %ld\n", GETTIMEREL()));
01017 
01018 #if KEEP_FROM_PTR
01019   mark_source = FROM_ROOT;
01020 #endif
01021 
01022   for (i = 0; i < roots_count; i += 2) {
01023     void **s = (void **)roots[i];
01024     void **e = (void **)roots[i + 1];
01025     
01026     while (s < e) {
01027       gcFIXUP(*s);
01028       s++;
01029     }
01030   }
01031 
01032 #if KEEP_FROM_PTR
01033   mark_source = FROM_IMM;
01034 #endif
01035 
01036   /* Do immobiles: */
01037   for (ib = immobile; ib; ib = ib->next) {
01038     gcFIXUP(ib->p);
01039   }
01040 
01041   PRINTTIME((STDERR, "gc: roots: %ld\n", GETTIMEREL()));
01042 
01043   iterations = 0;
01044 
01045   while (1) { /* Loop to do finalization */
01046 
01047     while ((tagged_mark < new_tagged_high)
01048           || (untagged_mark > new_untagged_low)) {
01049       
01050       iterations++;
01051       
01052       while (tagged_mark < new_tagged_high) {
01053        Type_Tag tag;
01054        long size;
01055        
01056 #if KEEP_FROM_PTR
01057        tagged_mark++;
01058 #endif
01059 
01060        tag = *(Type_Tag *)tagged_mark;
01061 
01062 #if ALIGN_DOUBLES
01063        if (tag == SKIP)
01064          tagged_mark++;
01065        else {
01066 #endif
01067          
01068 #if SAFETY
01069          if ((tag < 0) || (tag >= _num_tags_) || !size_table[tag]) {
01070            *(int *)0x0 = 1;
01071          }
01072 #endif
01073          
01074 #if KEEP_FROM_PTR
01075          mark_source = tagged_mark;
01076 #endif
01077 
01078          size = size_table[tag](tagged_mark);
01079          fixup_table[tag](tagged_mark);
01080          
01081 #if SAFETY
01082          if (size <= 1) {
01083            *(int *)0x0 = 1;
01084          }
01085 #endif
01086          
01087          tagged_mark += size;
01088          
01089 #if SAFETY
01090          if ((void *)tagged_mark < new_space) {
01091            *(int *)0x0 = 1;
01092          }
01093 #endif
01094 #if ALIGN_DOUBLES
01095        }
01096 #endif
01097       }
01098 
01099       while (untagged_mark > new_untagged_low) {
01100        void **mp, **started;
01101        
01102        mp = started = new_untagged_low;
01103        while (mp < untagged_mark) {
01104          long v, size;
01105 #if KEEP_FROM_PTR
01106          mp++;
01107 #endif
01108          v = *(long *)mp;
01109          size = (v & 0x0FFFFFFF);
01110          
01111          if (v & 0xF0000000) {
01112 #if KEEP_FROM_PTR
01113            mark_source = mp;
01114 #endif
01115            mp++;         
01116            if (v & 0x80000000) {
01117              /* Array of pointers */
01118              int i;
01119              /* printf("parray: %d %lx\n", size, (long)mp); */
01120              for (i = size; i--; mp++) {
01121               gcFIXUP(*mp);
01122              }
01123            } else if (v & 0x10000000) {
01124              /* xtagged */
01125              GC_fixup_xtagged(mp);
01126              mp += size;
01127            } else {
01128              /* Array of tagged */
01129              int i, elem_size;
01130              Type_Tag tag = *(Type_Tag *)mp;
01131              
01132              elem_size = size_table[tag](mp);
01133              fixup_table[tag](mp);
01134              mp += elem_size;
01135              for (i = elem_size; i < size; i += elem_size, mp += elem_size)
01136               fixup_table[tag](mp);
01137            }
01138          } else
01139            mp += v + 1;
01140        }
01141        untagged_mark = started;
01142       }
01143     }
01144       
01145     if ((did_fnls >= 3) || !fnls) {
01146       if (did_fnls == 3) {
01147        /* Finish up ordered finalization */
01148        Fnl *f, *next, *prev;
01149        Fnl_Weak_Link *wl;
01150 
01151        /* Enqueue and mark level 3 finalizers that still haven't been marked. */
01152        /* (Recursive marking is already done, though.) */
01153        prev = NULL;
01154        for (f = fnls; f; f = next) {
01155          next = f->next;
01156          if (f->eager_level == 3) {
01157            void *v;
01158 
01159            v = GC_resolve(f->p);
01160 
01161            if (v == f->p) {
01162              /* Not yet marked. Mark it and enqueue it. */
01163 #if KEEP_FROM_PTR
01164              mark_source = f;
01165 #endif
01166              gcFIXUP(f->p);
01167 
01168              if (prev)
01169               prev->next = next;
01170              else
01171               fnls = next;
01172              
01173              f->eager_level = 0; /* indicates queued */
01174              
01175              f->next = NULL;
01176              if (last_in_queue) {
01177               last_in_queue->next = f;
01178               last_in_queue = f;
01179              } else {
01180               run_queue = last_in_queue = f;
01181              }
01182            } else {
01183              f->p = v;
01184              prev = f;
01185            }
01186          }
01187        }
01188 
01189        /* Restore zeroed out weak links, marking as we go: */  
01190        for (wl = fnl_weaks; wl; wl = wl->next) {
01191          void *wp = (void *)GC_resolve(wl->p);
01192          int markit;
01193          markit = (wp != wl->p);
01194          wp = (wp + wl->offset);
01195          if (markit)
01196            gcFIXUP(wl->saved);
01197          *(void **)wp = wl->saved;
01198        }
01199        
01200        /* We have to mark one more time, because restoring a weak
01201            link may have made something reachable. */
01202 
01203        did_fnls++;
01204       } else
01205        break;
01206     } else {
01207       int eager_level = did_fnls + 1;
01208       
01209       if (eager_level == 3) {
01210        /* Ordered finalization */
01211        Fnl *f;
01212        Fnl_Weak_Link *wl;
01213 
01214        /* Zero out weak links for ordered finalization */
01215        for (wl = fnl_weaks; wl; wl = wl->next) {
01216          void *wp = (void *)GC_resolve(wl->p);
01217          wl->saved = *(void **)(wp + wl->offset);
01218          *(void **)(wp + wl->offset) = NULL;
01219        }
01220 
01221        /* Mark content of not-yet-marked finalized objects,
01222           but don't mark the finalized objects themselves. */  
01223        for (f = fnls; f; f = f->next) {
01224          if (f->eager_level == 3) {
01225            void *v;
01226 
01227            v = GC_resolve(f->p);
01228 
01229            if (v == f->p) {
01230              /* Not yet marked. Do content. */
01231              Type_Tag tag = *(Type_Tag *)v;
01232 #if SAFETY
01233              if ((tag < 0) || (tag >= _num_tags_) || !fixup_table[tag]) {
01234               *(int *)0x0 = 1;
01235              }
01236 #endif
01237 #if KEEP_FROM_PTR
01238              mark_source = FROM_FNL;
01239 #endif
01240              fixup_table[tag](v);
01241            }
01242          }
01243        }
01244       } else {
01245        /* Unordered finalization */
01246        Fnl *f, *prev, *queue;
01247 
01248        f = fnls;
01249        prev = NULL;
01250        queue = NULL;
01251        
01252        while (f) {
01253          if (f->eager_level == eager_level) {
01254            void *v;
01255 
01256            v = GC_resolve(f->p);
01257 
01258            if (v == f->p) {
01259              /* Not yet marked. Move finalization to run queue. */
01260              Fnl *next = f->next;
01261 
01262              if (prev)
01263               prev->next = next;
01264              else
01265               fnls = next;
01266              
01267              f->eager_level = 0; /* indicates queued */
01268              
01269              f->next = NULL;
01270              if (last_in_queue) {
01271               last_in_queue->next = f;
01272               last_in_queue = f;
01273              } else {
01274               run_queue = last_in_queue = f;
01275              }
01276              if (!queue)
01277               queue = f;
01278 
01279              f = next;
01280            } else {
01281              f->p = v;
01282              prev = f;
01283              f = f->next;
01284            }
01285          } else {
01286            prev = f;
01287            f = f->next;
01288          }
01289        }
01290        
01291        /* Mark items added to run queue: */
01292        f = queue;
01293        while (f) {
01294 #if KEEP_FROM_PTR
01295          mark_source = f;
01296 #endif
01297          gcFIXUP(f->p);
01298          f = f->next;
01299        }
01300       }
01301        
01302       did_fnls++;
01303     }
01304 
01305   }
01306 
01307   PRINTTIME((STDERR, "gc: mark/copy (%d): %ld\n", iterations, GETTIMEREL()));
01308 
01309   /******************************************************/
01310 
01311   /* Do weak boxes: */
01312   wb = weak_boxes;
01313   while (wb) {
01314     if (!((long)wb->val & 0x1) && ((void *)wb->val >= GC_alloc_space) && ((void *)wb->val <= GC_alloc_top)) {
01315       void *v;
01316       v = GC_resolve(wb->val);
01317       if (v == wb->val) {
01318        wb->val = NULL;
01319        if (wb->secondary_erase) {
01320          *(wb->secondary_erase + wb->soffset) = NULL;
01321          wb->secondary_erase = NULL;
01322        }
01323       } else
01324        wb->val = v;
01325     } /* else not collectable */
01326 
01327     wb = wb->next;
01328   }
01329 
01330   /* Do weak arrays: */
01331   wa = weak_arrays;
01332   while (wa) {
01333     int i;
01334 
01335     for (i = wa->count; i--; ) {
01336       void *p = wa->data[i];
01337       if (!((long)p & 0x1) && (p >= GC_alloc_space) && (p <= GC_alloc_top)) {
01338        void *v;    
01339        v = GC_resolve(p);
01340        if (v == p)
01341          wa->data[i] = wa->replace_val;
01342        else
01343          wa->data[i] = v;
01344       } /* else not collectable */
01345     }
01346 
01347     wa = wa->next;
01348   }
01349 
01350   /* Cleanup weak finalization links: */
01351   {
01352     Fnl_Weak_Link *wl, *prev, *next;
01353 
01354     prev = NULL;
01355     for (wl = fnl_weaks; wl; wl = next) {
01356       void *wp;
01357       next = wl->next;
01358       wp = (void *)GC_resolve(wl->p);
01359       if (wp == wl->p) {
01360        /* Collectable. Removed this link. */
01361        if (prev)
01362          prev->next = next;
01363        else
01364          fnl_weaks = next;
01365       } else {
01366        wl->p = wp;
01367        prev = wl;
01368       }
01369     }
01370   }
01371 
01372   /******************************************************/
01373   
01374 #if RECYCLE_HEAP
01375   old_space = GC_alloc_space;
01376   old_size = alloc_size;
01377 #else
01378   if (alloc_size)
01379     free_pages(GC_alloc_space, alloc_size + 4);
01380 #endif
01381 
01382   free(alloc_bitmap);
01383 
01384   PRINTTIME((STDERR, "gc: free: %ld\n", GETTIMEREL()));
01385 
01386   if (new_untagged_low < new_tagged_high) {
01387     printf("Ouch: Tagged area collided with untagged area.\n");
01388     abort();
01389   }
01390 
01391   alloc_size = new_size;
01392   GC_alloc_space = new_space;
01393   GC_alloc_top = GC_alloc_space + alloc_size;
01394   tagged_high = new_tagged_high;
01395   untagged_low = new_untagged_low;
01396 
01397   heap_size = new_size - ((untagged_low - tagged_high) << 2);
01398   
01399   {
01400     long *p = (long *)untagged_low;
01401     while (p-- > (long *)tagged_high)
01402       *p = 0;
01403   }
01404 
01405   PRINTTIME((STDERR, "gc: restored: %ld\n", GETTIMEREL()));
01406 
01407   /******************** Make initial bitmap image: ****************************/
01408 
01409   {
01410     alloc_bitmap = bitmap = (char *)malloc((alloc_size >> 5) + 1);
01411     memset(bitmap, 0, (alloc_size >> 5) + 1);
01412   }
01413 
01414   p = (long *)untagged_low;
01415   diff = (((char *)p - (char *)GC_alloc_space) + 4) >> 2;
01416   top = (long *)GC_alloc_top;
01417   while (p < top) {
01418     long size;
01419 
01420 #if KEEP_FROM_PTR
01421     diff++;
01422     p++;
01423 #endif
01424 
01425     size = (*p & 0x0FFFFFFF) + 1;
01426 
01427     bitmap[diff >> 3] |= (1 << (diff & 0x7));
01428 
01429     p += size;
01430     diff += size;
01431   }
01432 
01433   p = ((long *)GC_alloc_space);
01434   diff = ((char *)p - (char *)GC_alloc_space) >> 2;
01435   while (p < (long *)tagged_high) {
01436     Type_Tag tag;
01437     long size;
01438       
01439 #if KEEP_FROM_PTR
01440     diff++;
01441     p++;
01442 #endif
01443     tag = *(Type_Tag *)p;
01444 
01445 #if ALIGN_DOUBLES
01446     if (tag == SKIP) {
01447       p++;
01448       diff++;
01449     } else {
01450 #endif
01451       bitmap[diff >> 3] |= (1 << (diff & 0x7));
01452 
01453 #if SEARCH
01454       if (cycle_count == detail_cycle)
01455        printf("tag: %lx =  %d\n", (long)p, tag);
01456 #endif
01457 
01458 #if SAFETY
01459       if ((tag < 0) || (tag >= _num_tags_) || !size_table[tag]) {
01460        fflush(NULL);
01461        *(int *)0x0 = 1;
01462       }
01463       prev_ptr = p;
01464       prev_var_stack = GC_variable_stack;
01465 #endif
01466       size = size_table[tag](p);
01467 #if SAFETY
01468       if (prev_var_stack != GC_variable_stack) {
01469        *(int *)0x0 = 1;
01470       }
01471 #endif
01472       
01473       p += size;
01474       diff += size;
01475 #if ALIGN_DOUBLES
01476     }
01477 #endif
01478   }
01479 
01480   PRINTTIME((STDERR, "gc: done (t=%d, u=%d): %ld\n", 
01481             (long)((void *)tagged_high - GC_alloc_space),
01482             (long)(GC_alloc_top - (void *)untagged_low),
01483             GETTIMEREL()));
01484 
01485   if (GC_collect_start_callback)
01486     GC_collect_end_callback();
01487 
01488   /**********************************************************************/
01489 
01490   /* Run Finalizations. Collections may happen */
01491 
01492   while (run_queue) {
01493     Fnl *f;
01494     void **gcs;
01495 
01496     f = run_queue;
01497     run_queue = run_queue->next;
01498     if (!run_queue)
01499       last_in_queue = NULL;
01500 
01501     gcs = GC_variable_stack;
01502     f->f(f->p, f->data);
01503     GC_variable_stack = gcs;
01504   }
01505 }
01506 
01507 void *GC_resolve(void *p)
01508 {
01509   if (!((long)p & 0x1) && (p >= GC_alloc_space) && (p <= GC_alloc_top)) {  
01510     if (p < (void *)tagged_high) {
01511       Type_Tag tag = *(Type_Tag *)p;
01512 
01513       if (tag == MOVED)
01514        return ((void **)p)[1];
01515       else
01516        return p;
01517     } else {
01518       long size;
01519       
01520       p -= 4;
01521       size = ((*(long *)p) & 0x0FFFFFFF);
01522       
01523       if (!size)
01524        return ((void **)p)[1];
01525       else
01526        return p + 4;
01527     }
01528   } else
01529     return p;
01530 }
01531 
01532 static void *malloc_tagged(size_t size_in_bytes)
01533 {
01534   void **m, **naya;
01535 
01536 #if SAFETY
01537   check_variable_stack();
01538 #endif
01539 
01540 #if GC_EVERY_ALLOC
01541 # if SKIP_FORCED_GC
01542   if (!skipped_first) {
01543     alloc_cycle++;
01544     if (alloc_cycle >= SKIP_FORCED_GC) {
01545       alloc_cycle = 0;
01546       skipped_first = 1;
01547     }
01548   }
01549 # endif
01550   if (skipped_first) {
01551     alloc_cycle++;
01552     if (alloc_cycle >= GC_EVERY_ALLOC) {
01553       alloc_cycle = 0;
01554       gcollect(size_in_bytes);
01555     }
01556   }
01557 #endif
01558 
01559 #if KEEP_FROM_PTR
01560   size_in_bytes += 4;
01561 #endif
01562 
01563   size_in_bytes = ((size_in_bytes + 3) & 0xFFFFFFFC);
01564 #if ALIGN_DOUBLES
01565   if (!(size_in_bytes & 0x4)) {
01566     /* Make sure memory is 8-aligned */
01567     if (((long)tagged_high & 0x4)) {
01568       if (tagged_high == untagged_low) {
01569        gcollect(size_in_bytes);
01570 #if KEEP_FROM_PTR
01571        size_in_bytes -= 4;
01572 #endif
01573        return malloc_tagged(size_in_bytes);
01574       }
01575       ((Type_Tag *)tagged_high)[0] = SKIP;
01576       tagged_high += 1;
01577     }
01578   }
01579 #endif
01580 
01581 #if SEARCH
01582   if (size_in_bytes == search_size)
01583     stop();
01584 #endif
01585 
01586   m = tagged_high;
01587   naya = tagged_high + (size_in_bytes >> 2);
01588   if (naya > untagged_low) {
01589     gcollect(size_in_bytes);
01590 #if KEEP_FROM_PTR
01591     size_in_bytes -= 4;
01592 #endif
01593     return malloc_tagged(size_in_bytes);
01594   }
01595   tagged_high = naya;
01596 
01597 #if KEEP_FROM_PTR
01598   *m = FROM_NEW;
01599   m++;
01600 #endif
01601 
01602 #if SEARCH
01603   if (m == search_for) {
01604     stop();
01605   }
01606 #endif
01607 
01608   {
01609     long diff = ((char *)m - (char *)GC_alloc_space) >> 2;
01610 
01611     alloc_bitmap[diff >> 3] |= (1 << (diff & 0x7));
01612   }
01613 
01614   return m;
01615 }
01616 
01617 static void *malloc_untagged(size_t size_in_bytes, unsigned long nonatomic)
01618 {
01619   void **naya;
01620 
01621 #if SAFETY
01622   check_variable_stack();
01623 #endif
01624 
01625 #if GC_EVERY_ALLOC
01626 # if SKIP_FORCED_GC
01627   if (!skipped_first) {
01628     alloc_cycle++;
01629     if (alloc_cycle >= SKIP_FORCED_GC) {
01630       alloc_cycle = 0;
01631       skipped_first = 1;
01632     }
01633   }
01634 # endif
01635   if (skipped_first) {
01636     alloc_cycle++;
01637     if (alloc_cycle >= GC_EVERY_ALLOC) {
01638       alloc_cycle = 0;
01639       gcollect(size_in_bytes);
01640     }
01641   }
01642 #endif
01643 
01644   if (!size_in_bytes)
01645     return zero_sized;
01646 
01647 #if KEEP_FROM_PTR
01648   size_in_bytes += 4;
01649 #endif
01650 
01651   size_in_bytes = ((size_in_bytes + 3) & 0xFFFFFFFC);
01652 #if ALIGN_DOUBLES
01653   if (!(size_in_bytes & 0x4)) {
01654     /* Make sure memory is 8-aligned */
01655     if ((long)untagged_low & 0x4) {
01656       if (untagged_low == tagged_high) {
01657 #if KEEP_FROM_PTR
01658        size_in_bytes -= 4;
01659 #endif
01660        gcollect(size_in_bytes);
01661        return malloc_untagged(size_in_bytes, nonatomic);
01662       }
01663       untagged_low -= 1;
01664       ((long *)untagged_low)[0] = 0;
01665     }
01666   }
01667 #endif
01668 
01669 #if SEARCH
01670   if (size_in_bytes == search_size)
01671     stop();
01672 #endif
01673 
01674   naya = untagged_low - ((size_in_bytes >> 2) + 1);
01675   if (naya < tagged_high) {
01676     gcollect(size_in_bytes);
01677 #if KEEP_FROM_PTR
01678     size_in_bytes -= 4;
01679 #endif
01680     return malloc_untagged(size_in_bytes, nonatomic);
01681   }
01682   untagged_low = naya;
01683 
01684 #if KEEP_FROM_PTR
01685   *naya = FROM_NEW;
01686   naya++;
01687   size_in_bytes -= 4;
01688 #endif
01689 
01690   ((long *)naya)[0] = (size_in_bytes >> 2) | nonatomic;
01691   
01692 #if SEARCH
01693   if ((naya + 1) == search_for) {
01694     stop();
01695   }
01696 #endif
01697 
01698   {
01699     long diff = ((char *)(naya + 1) - (char *)GC_alloc_space) >> 2;
01700 
01701     alloc_bitmap[diff >> 3] |= (1 << (diff & 0x7));
01702   }
01703 
01704   return naya + 1;
01705 }
01706 
01707 /* Array of pointers: */
01708 void *GC_malloc(size_t size_in_bytes)
01709 {
01710   return malloc_untagged(size_in_bytes, 0x80000000);
01711 }
01712 
01713 /* Tagged item: */
01714 void *GC_malloc_one_tagged(size_t size_in_bytes)
01715 {
01716   return malloc_tagged(size_in_bytes);
01717 }
01718 
01719 void *GC_malloc_one_xtagged(size_t size_in_bytes)
01720 {
01721   return malloc_untagged(size_in_bytes, 0x10000000);
01722 }
01723 
01724 void *GC_malloc_array_tagged(size_t size_in_bytes)
01725 {
01726   return malloc_untagged(size_in_bytes, 0x40000000);
01727 }
01728 
01729 /* Pointerless */
01730 void *GC_malloc_atomic(size_t size_in_bytes)
01731 {
01732   return malloc_untagged(size_in_bytes, 0x00000000);
01733 }
01734 
01735 /* Plain malloc: */
01736 void *GC_malloc_atomic_uncollectable(size_t size_in_bytes)
01737 {
01738   return malloc(size_in_bytes);
01739 }
01740 
01741 /* Array of pointers: */
01742 void *GC_malloc_allow_interior(size_t size_in_bytes)
01743 {
01744   return malloc_untagged(size_in_bytes, 0xA0000000);
01745 }
01746 
01747 void GC_free(void *s) /* noop */
01748 {
01749 }
01750 
01751 void GC_register_traversers(Type_Tag tag, Size_Proc size, Mark_Proc mark, Fixup_Proc fixup)
01752 {
01753   size_table[tag] = size;
01754   mark_table[tag] = mark;
01755   fixup_table[tag] = fixup;
01756 }
01757 
01758 void GC_gcollect()
01759 {
01760   gcollect(0);
01761 }
01762 
01763 /*************************************************************/
01764 
01765 #if KEEP_FROM_PTR
01766 
01767 void GC_print_back_trace(void *p)
01768 {
01769   while ((p > GC_alloc_space) && (p < GC_alloc_top)) {
01770     if (p < (void *)tagged_high) {
01771       printf("%lx = tagged: %d\n", (long)p, *(short *)p);
01772       p = ((void **)p)[-1];
01773     } else if (p > (void *)untagged_low) {
01774       printf("%lx = untagged: %lx\n", (long)p, *(long *)p);
01775       p = ((void **)p)[-1];
01776     } else
01777       break;
01778   }
01779 
01780   if (p == FROM_STACK)
01781     printf("stack\n");
01782   if (p == FROM_ROOT)
01783     printf("root\n");
01784   if (p == FROM_FNL)
01785     printf("fnl\n");
01786   if (p == FROM_IMM)
01787     printf("immobile\n");
01788 }
01789 #endif