restore GC_malloc_pair to 3m

svn: r12390
This commit is contained in:
Matthew Flatt 2008-11-11 22:23:30 +00:00
parent 74ac5ba272
commit 8b6ccea76c
4 changed files with 70 additions and 0 deletions

View File

@ -3859,6 +3859,23 @@ void *GC_malloc_one_small_dirty_tagged(size_t size_in_bytes)
return GC_malloc_one_tagged(size_in_bytes);
}
void *GC_malloc_pair(void *a, void *b)
{
void *p;
park[0] = a;
park[1] = b;
p = GC_malloc_one_tagged(3 << LOG_WORD_SIZE);
a = park[0];
b = park[1];
((Type_Tag *)p)[0] = pair_tag;
((void **)p)[1] = a;
((void **)p)[2] = b;
return p;
}
#ifndef gcINLINE
# define gcINLINE inline
#endif

View File

@ -164,6 +164,12 @@ GC2_EXTERN void *GC_malloc_one_small_dirty_tagged(size_t);
zeroed. The client must set all words in the allocated
object before a GC can occur. */
GC2_EXTERN void *GC_malloc_pair(void *car, void *cdr);
/*
Like GC_malloc_one_tagged, but even more streamlined.
The main potential advantage is that `car' and `cdr' don't
have to be retained by the callee in the case of a GC. */
GC2_EXTERN void *GC_malloc_one_xtagged(size_t);
/*
Alloc an item, initially zeroed. Rather than having a specific tag,

View File

@ -617,6 +617,49 @@ inline static void *fast_malloc_one_small_tagged(size_t sizeb, int dirty)
}
}
void *GC_malloc_pair(void *car, void *cdr)
{
unsigned long ptr, newptr;
size_t sizeb;
void *retval;
sizeb = ALIGN_BYTES_SIZE(gcWORDS_TO_BYTES(gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object))) + WORD_SIZE);
ptr = GC_gen0_alloc_page_ptr;
newptr = GC_gen0_alloc_page_ptr + sizeb;
if(OVERFLOWS_GEN0(newptr)) {
NewGC *gc = GC_get_GC();
gc->park[0] = car;
gc->park[1] = cdr;
retval = GC_malloc_one_tagged(sizeb - WORD_SIZE);
car = gc->park[0];
cdr = gc->park[1];
gc->park[0] = NULL;
gc->park[1] = NULL;
} else {
struct objhead *info;
GC_gen0_alloc_page_ptr = newptr;
retval = PTR(ptr);
info = (struct objhead *)retval;
((void **)retval)[0] = NULL; /* objhead */
((void **)retval)[1] = 0; /* tag word */
/* info->type = type; */ /* We know that the type field is already 0 */
info->size = (sizeb >> gcLOG_WORD_SIZE);
retval = PTR(NUM(retval) + WORD_SIZE);
}
((short *)retval)[0] = scheme_pair_type;
((void **)retval)[1] = car;
((void **)retval)[2] = cdr;
return retval;
}
/* the allocation mechanism we present to the outside world */
void *GC_malloc(size_t s) { return allocate(s, PAGE_ARRAY); }
void *GC_malloc_one_tagged(size_t s) { return allocate(s, PAGE_TAGGED); }

View File

@ -669,12 +669,16 @@ scheme_init_list (Scheme_Env *env)
Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr)
{
#ifdef MZ_PRECISE_GC
return GC_malloc_pair(car, cdr);
#else
Scheme_Object *cons;
cons = scheme_alloc_object();
cons->type = scheme_pair_type;
SCHEME_CAR(cons) = car;
SCHEME_CDR(cons) = cdr;
return cons;
#endif
}
Scheme_Object *scheme_make_mutable_pair(Scheme_Object *car, Scheme_Object *cdr)