/*
* Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
* Copyright (c) 1991,1992 by Xerox Corporation. All rights reserved.
*
* THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
* OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
*
* Permission is hereby granted to copy this garbage collector for any purpose,
* provided the above notices are retained on all copies.
*/
#define DEBUG /* Some run-time consistency checks */
#undef DEBUG
#define VERBOSE
#undef VERBOSE
#include <stdio.h>
#include <signal.h>
#define I←HIDE←POINTERS /* To make GC←call←with←alloc←lock visible */
#include "gc←private.h"
# ifdef THREADS
# ifdef PCR
# include "pcr/il/PCR←IL.h"
struct PCR←Th←MLRep GC←allocate←ml;
# else
--> declare allocator lock here
# endif
# endif
struct ←GC←arrays GC←arrays = { 0 };
/* Initialize GC←obj←kinds properly and standard free lists properly. */
/* This must be done statically since they may be accessed before */
/* GC←init is called. */
struct obj←kind GC←obj←kinds[MAXOBJKINDS] = {
/* PTRFREE */ { &GC←aobjfreelist[0], &GC←areclaim←list[0],
GC←no←mark←proc, FALSE },
/* NORMAL */ { &GC←objfreelist[0], &GC←reclaim←list[0],
GC←normal←mark←proc, TRUE },
};
ptr←t GC←stackbottom = 0;
word GC←hincr;
int GC←n←kinds = 2;
bool GC←dont←gc = 0;
extern signed←word GC←mem←found;
# ifdef ALL←INTERIOR←POINTERS
# define ROUNDED←UP←WORDS(n) BYTES←TO←WORDS((n) + WORDS←TO←BYTES(1))
# else
# define ROUNDED←UP←WORDS(n) BYTES←TO←WORDS((n) + WORDS←TO←BYTES(1) - 1)
# endif
# ifdef MERGE←SIZES
/* Set things up so that GC←size←map[i] >= words(i), */
/* but not too much bigger */
/* and so that size←map contains relatively few distinct entries */
/* This is stolen from Russ Atkinson's Cedar quantization */
/* alogrithm (but we precompute it). */
# if (CPP←WORDSZ != 32)
--> fix the following code
# endif
void GC←init←size←map()
{
register unsigned i;
register unsigned sz←rounded←up = 0;
/* Map size 0 to 1. This avoids problems at lower levels. */
GC←size←map[0] = 1;
/* One word objects don't have to be 2 word aligned. */
GC←size←map[1] = 1;
GC←size←map[2] = 1;
GC←size←map[3] = 1;
GC←size←map[4] = ROUNDED←UP←WORDS(4);
for (i = 5; i <= 32; i++) {
# ifdef ALIGN←DOUBLE
GC←size←map[i] = (ROUNDED←UP←WORDS(i) + 1) & (~1);
# else
GC←size←map[i] = ROUNDED←UP←WORDS(i);
# endif
}
for (i = 33; i <= WORDS←TO←BYTES(MAXOBJSZ); i++) {
if (sz←rounded←up < ROUNDED←UP←WORDS(i)) {
register int size = ROUNDED←UP←WORDS(i);
register unsigned m = 0;
while (size > 7) {
m += 1;
size += 1;
size >>= 1;
}
sz←rounded←up = size << m;
if (sz←rounded←up > MAXOBJSZ) {
sz←rounded←up = MAXOBJSZ;
}
}
GC←size←map[i] = sz←rounded←up;
}
}
# endif
# ifdef ALL←INTERIOR←POINTERS
# define SMALL←OBJ(bytes) ((bytes) < WORDS←TO←BYTES(MAXOBJSZ))
# define ADD←SLOP(bytes) ((bytes)+1)
# else
# define SMALL←OBJ(bytes) ((bytes) <= WORDS←TO←BYTES(MAXOBJSZ))
# define ADD←SLOP(bytes) (bytes)
# endif
/*
* The following is a gross hack to deal with a problem that can occur
* on machines that are sloppy about stack frame sizes, notably SPARC.
* Bogus pointers may be written to the stack and not cleared for
* a LONG time, because they always fall into holes in stack frames
* that are not written. We partially address this by randomly clearing
* sections of the stack whenever we get control.
*/
word GC←stack←last←cleared = 0; /* GC←no when we last did this */
# define CLEAR←SIZE 213
# define CLEAR←THRESHOLD 10000
# define DEGRADE←RATE 50
ptr←t GC←min←sp; /* Coolest stack pointer value from which we've */
/* already cleared the stack. */
# ifdef STACK←GROWS←DOWN
# define COOLER←THAN >
# define HOTTER←THAN <
# define MAKE←COOLER(x,y) if ((word)(x)+(y) > (word)(x)) {(x) += (y);} \
else {(x) = (ptr←t)ONES;}
# define MAKE←HOTTER(x,y) (x) -= (y)
# else
# define COOLER←THAN <
# define HOTTER←THAN >
# define MAKE←COOLER(x,y) if ((word)(x)-(y) < (word)(x)) {(x) -= (y);} else {(x) = 0;}
# define MAKE←HOTTER(x,y) (x) += (y)
# endif
ptr←t GC←high←water;
/* "hottest" stack pointer value we have seen */
/* recently. Degrades over time. */
/*ARGSUSED*/
void GC←clear←stack←inner(d)
word *d;
{
word dummy[CLEAR←SIZE];
bzero((char *)dummy, (int)(CLEAR←SIZE*sizeof(word)));
# ifdef THREADS
GC←noop(dummy);
# else
if ((ptr←t)(dummy) COOLER←THAN GC←min←sp) {
GC←clear←stack←inner(dummy);
}
# endif
}
void GC←clear←stack()
{
word dummy;
# ifdef THREADS
GC←clear←stack←inner(&dummy);
# else
if (GC←gc←no > GC←stack←last←cleared) {
/* Start things over, so we clear the entire stack again */
if (GC←stack←last←cleared == 0) GC←high←water = GC←stackbottom;
GC←min←sp = GC←high←water;
GC←stack←last←cleared = GC←gc←no;
}
/* Adjust GC←high←water */
MAKE←COOLER(GC←high←water, WORDS←TO←BYTES(DEGRADE←RATE));
if ((word)(&dummy) HOTTER←THAN (word)GC←high←water) {
GC←high←water = (ptr←t)(&dummy);
}
if ((word)(&dummy) COOLER←THAN (word)GC←min←sp) {
GC←clear←stack←inner(&dummy);
GC←min←sp = (ptr←t)(&dummy);
}
# endif
}
/* allocate lb bytes for an object of kind k */
ptr←t GC←generic←malloc(lb, k)
register word lb;
register int k;
{
register word lw;
register ptr←t op;
register ptr←t *opp;
DCL←LOCK←STATE;
DISABLE←SIGNALS();
LOCK();
if( SMALL←OBJ(lb) ) {
# ifdef MERGE←SIZES
lw = GC←size←map[lb];
# else
lw = ROUNDED←UP←WORDS(lb);
if (lw == 0) lw = 1;
# endif
opp = &(GC←obj←kinds[k].ok←freelist[lw]);
if( (op = *opp) == 0 ) {
if (!GC←is←initialized) {
GC←init←inner();
ENABLE←SIGNALS();
/* This may have fixed GC←size←map */
UNLOCK();
return(GC←generic←malloc(lb, k));
}
GC←clear←stack();
op = GC←allocobj(lw, k);
if (op == 0) goto out;
}
/* Here everything is in a consistent state. */
/* We assume the following assignment is */
/* atomic. If we get aborted */
/* after the assignment, we lose an object, */
/* but that's benign. */
/* Volatile declarations may need to be added */
/* to prevent the compiler from breaking things.*/
*opp = obj←link(op);
obj←link(op) = 0;
} else {
register struct hblk * h;
if (!GC←is←initialized) GC←init←inner();
lw = ROUNDED←UP←WORDS(lb);
while ((h = GC←allochblk(lw, k)) == 0) {
GC←collect←or←expand(divHBLKSZ(lb) + 1);
}
if (h == 0) {
op = 0;
} else {
op = (ptr←t) (h -> hb←body);
}
}
GC←words←allocd += lw;
out:
UNLOCK();
ENABLE←SIGNALS();
return((ptr←t)op);
}
/* Analogous to the above, but assumes a small object size, and */
/* bypasses MERGE←SIZES mechanism. Used by gc←inline.h. */
ptr←t GC←generic←malloc←words←small(lw, k)
register word lw;
register int k;
{
register ptr←t op;
register ptr←t *opp;
DCL←LOCK←STATE;
LOCK();
DISABLE←SIGNALS();
opp = &(GC←obj←kinds[k].ok←freelist[lw]);
if( (op = *opp) == 0 ) {
if (!GC←is←initialized) {
GC←init←inner();
}
GC←clear←stack();
op = GC←allocobj(lw, k);
if (op == 0) goto out;
}
*opp = obj←link(op);
obj←link(op) = 0;
GC←words←allocd += lw;
out:
UNLOCK();
ENABLE←SIGNALS();
return((ptr←t)op);
}
/* Allocate lb bytes of atomic (pointerfree) data */
# ifdef ←←STDC←←
extern←ptr←t GC←malloc←atomic(size←t lb)
# else
extern←ptr←t GC←malloc←atomic(lb)
size←t lb;
# endif
{
register ptr←t op;
register ptr←t * opp;
register word lw;
DCL←LOCK←STATE;
if( SMALL←OBJ(lb) ) {
# ifdef MERGE←SIZES
lw = GC←size←map[lb];
# else
lw = ROUNDED←UP←WORDS(lb);
# endif
opp = &(GC←aobjfreelist[lw]);
FASTLOCK();
if( !FASTLOCK←SUCCEEDED() || (op = *opp) == 0 ) {
FASTUNLOCK();
return(GC←generic←malloc((word)lb, PTRFREE));
}
/* See above comment on signals. */
*opp = obj←link(op);
GC←words←allocd += lw;
FASTUNLOCK();
return((extern←ptr←t) op);
} else {
return((extern←ptr←t)
GC←generic←malloc((word)lb, PTRFREE));
}
}
/* Allocate lb bytes of composite (pointerful) data */
# ifdef ←←STDC←←
extern←ptr←t GC←malloc(size←t lb)
# else
extern←ptr←t GC←malloc(lb)
size←t lb;
# endif
{
register ptr←t op;
register ptr←t *opp;
register word lw;
DCL←LOCK←STATE;
if( SMALL←OBJ(lb) ) {
# ifdef MERGE←SIZES
lw = GC←size←map[lb];
# else
lw = ROUNDED←UP←WORDS(lb);
# endif
opp = &(GC←objfreelist[lw]);
FASTLOCK();
if( !FASTLOCK←SUCCEEDED() || (op = *opp) == 0 ) {
FASTUNLOCK();
return(GC←generic←malloc((word)lb, NORMAL));
}
/* See above comment on signals. */
*opp = obj←link(op);
obj←link(op) = 0;
GC←words←allocd += lw;
FASTUNLOCK();
return((extern←ptr←t) op);
} else {
return((extern←ptr←t)
GC←generic←malloc((word)lb, NORMAL));
}
}
/* Change the size of the block pointed to by p to contain at least */
/* lb bytes. The object may be (and quite likely will be) moved. */
/* The kind (e.g. atomic) is the same as that of the old. */
/* Shrinking of large blocks is not implemented well. */
# ifdef ←←STDC←←
extern←ptr←t GC←realloc(extern←ptr←t p, size←t lb)
# else
extern←ptr←t GC←realloc(p,lb)
extern←ptr←t p;
size←t lb;
# endif
{
register struct hblk * h;
register hdr * hhdr;
register signed←word sz; /* Current size in bytes */
register word orig←sz; /* Original sz in bytes */
int obj←kind;
if (p == 0) return(GC←malloc(lb)); /* Required by ANSI */
h = HBLKPTR(p);
hhdr = HDR(h);
sz = hhdr -> hb←sz;
obj←kind = hhdr -> hb←obj←kind;
sz = WORDS←TO←BYTES(sz);
orig←sz = sz;
if (sz > WORDS←TO←BYTES(MAXOBJSZ)) {
/* Round it up to the next whole heap block */
sz = (sz+HDR←BYTES+HBLKSIZE-1)
& (~HBLKMASK);
sz -= HDR←BYTES;
hhdr -> hb←sz = BYTES←TO←WORDS(sz);
/* Extra area is already cleared by allochblk. */
}
if (ADD←SLOP(lb) <= sz) {
if (lb >= (sz >> 1)) {
if (orig←sz > lb) {
/* Clear unneeded part of object to avoid bogus pointer */
/* tracing. */
bzero(((char *)p) + lb, (int)(orig←sz - lb));
}
return(p);
} else {
/* shrink */
extern←ptr←t result = GC←generic←malloc((word)lb, obj←kind);
if (result == 0) return(0);
/* Could also return original object. But this */
/* gives the client warning of imminent disaster. */
bcopy(p, result, (int)lb);
GC←free(p);
return(result);
}
} else {
/* grow */
extern←ptr←t result = GC←generic←malloc((word)lb, obj←kind);
if (result == 0) return(0);
bcopy(p, result, (int)sz);
GC←free(p);
return(result);
}
}
/* Return a pointer to the base address of p, given a pointer to a */
/* an address within an object. Return 0 o.w. */
# ifdef ←←STDC←←
extern←ptr←t GC←base(extern←ptr←t p)
# else
extern←ptr←t GC←base(p)
extern←ptr←t p;
# endif
{
register word r;
register struct hblk *h;
register hdr *candidate←hdr;
r = (word)p;
h = HBLKPTR(r);
candidate←hdr = HDR(r);
if (candidate←hdr == 0) return(0);
/* If it's a pointer to the middle of a large object, move it */
/* to the beginning. */
while (IS←FORWARDING←ADDR←OR←NIL(candidate←hdr)) {
h = h - (int)candidate←hdr;
r = (word)h + HDR←BYTES;
candidate←hdr = HDR(h);
}
if (candidate←hdr -> hb←map == GC←invalid←map) return(0);
/* Make sure r points to the beginning of the object */
r &= ~(WORDS←TO←BYTES(1) - 1);
{
register int offset =
(word *)r - (word *)(HBLKPTR(r)) - HDR←WORDS;
register signed←word sz = candidate←hdr -> hb←sz;
register int correction;
correction = offset % sz;
r -= (WORDS←TO←BYTES(correction));
if (((word *)r + sz) > (word *)(h + 1)
&& sz <= MAXOBJSZ) {
return(0);
}
}
return((extern←ptr←t)r);
}
/* Return the size of an object, given a pointer to its base. */
/* (For small obects this also happens to work from interior pointers, */
/* but that shouldn't be relied upon.) */
# ifdef ←←STDC←←
size←t GC←size(extern←ptr←t p)
# else
size←t GC←size(p)
extern←ptr←t p;
# endif
{
register int sz;
register hdr * hhdr = HDR(p);
sz = WORDS←TO←BYTES(hhdr -> hb←sz);
if (sz < 0) {
return(-sz);
} else {
return(sz);
}
}
/* Explicitly deallocate an object p. */
# ifdef ←←STDC←←
void GC←free(extern←ptr←t p)
# else
void GC←free(p)
extern←ptr←t p;
# endif
{
register struct hblk *h;
register hdr *hhdr;
register signed←word sz;
register ptr←t * flh;
register struct obj←kind * ok;
if (p == 0) return;
/* Required by ANSI. It's not my fault ... */
h = HBLKPTR(p);
hhdr = HDR(h);
sz = hhdr -> hb←sz;
GC←mem←freed += sz;
ok = &GC←obj←kinds[hhdr -> hb←obj←kind];
if (sz > MAXOBJSZ) {
GC←freehblk(h);
} else {
ok = &GC←obj←kinds[hhdr -> hb←obj←kind];
if (ok -> ok←init) {
bzero((char *)((word *)p + 1), (int)(WORDS←TO←BYTES(sz-1)));
}
flh = &(ok -> ok←freelist[sz]);
obj←link(p) = *flh;
*flh = (ptr←t)p;
}
}
bool GC←is←initialized = FALSE;
void GC←init()
{
DCL←LOCK←STATE;
DISABLE←SIGNALS();
LOCK();
GC←init←inner();
UNLOCK();
ENABLE←SIGNALS();
}
void GC←init←inner()
{
word dummy;
if (GC←is←initialized) return;
GC←is←initialized = TRUE;
# ifndef THREADS
if (GC←stackbottom == 0) {
GC←stackbottom = GC←get←stack←base();
}
# endif
if (sizeof (ptr←t) != sizeof(word)) {
GC←err←printf0("sizeof (ptr←t) != sizeof(word)\n");
ABORT("sizeof (ptr←t) != sizeof(word)\n");
}
if (sizeof (signed←word) != sizeof(word)) {
GC←err←printf0("sizeof (signed←word) != sizeof(word)\n");
ABORT("sizeof (signed←word) != sizeof(word)\n");
}
if (sizeof (struct hblk) != HBLKSIZE) {
GC←err←printf0("sizeof (struct hblk) != HBLKSIZE\n");
ABORT("sizeof (struct hblk) != HBLKSIZE\n");
}
# ifndef THREADS
# if defined(STACK←GROWS←UP) && defined(STACK←GROWS←DOWN)
GC←err←printf0(
"Only one of STACK←GROWS←UP and STACK←GROWS←DOWN should be defd\n");
ABORT("stack direction 1\n");
# endif
# if !defined(STACK←GROWS←UP) && !defined(STACK←GROWS←DOWN)
GC←err←printf0(
"One of STACK←GROWS←UP and STACK←GROWS←DOWN should be defd\n");
ABORT("stack direction 2\n");
# endif
# ifdef STACK←GROWS←DOWN
if ((word)(&dummy) > (word)GC←stackbottom) {
GC←err←printf0(
"STACK←GROWS←DOWN is defd, but stack appears to grow up\n");
GC←err←printf2("sp = 0x%lx, GC←stackbottom = 0x%lx\n",
(unsigned long) (&dummy),
(unsigned long) GC←stackbottom);
ABORT("stack direction 3\n");
}
# else
if ((word)(&dummy) < (word)GC←stackbottom) {
GC←err←printf0(
"STACK←GROWS←UP is defd, but stack appears to grow down\n");
GC←err←printf2("sp = 0x%lx, GC←stackbottom = 0x%lx\n",
(unsigned long) (&dummy),
(unsigned long) GC←stackbottom);
ABORT("stack direction 4");
}
# endif
# endif
# if !defined(←AUX←SOURCE) || defined(←←GNUC←←)
if ((word)(-1) < (word)0) {
GC←err←printf0("The type word should be an unsigned integer type\n");
GC←err←printf0("It appears to be signed\n");
ABORT("word");
}
# endif
if ((signed←word)(-1) >= (signed←word)0) {
GC←err←printf0(
"The type signed←word should be a signed integer type\n");
GC←err←printf0("It appears to be unsigned\n");
ABORT("signed←word");
}
GC←hincr = HINCR;
GC←init←headers();
GC←bl←init();
GC←mark←init();
if (!GC←expand←hp←inner(GC←hincr)) {
GC←printf0("Can't start up: no memory\n");
EXIT();
}
GC←register←displacement←inner(0L);
# ifdef MERGE←SIZES
GC←init←size←map();
# endif
/* Add initial guess of root sets */
GC←register←data←segments();
# ifdef PCR
PCR←IL←Lock(PCR←Bool←false, PCR←allSigsBlocked, PCR←waitForever);
PCR←IL←Unlock();
GC←pcr←install();
# endif
/* Get black list set up */
(void)GC←gcollect←inner(TRUE);
(void)GC←gcollect←inner(TRUE);
/* Convince lint that some things are used */
{
extern char * GC←copyright[];
GC←noop(GC←copyright, GC←find←header,
GC←tl←mark, GC←call←with←alloc←lock);
}
}
/* A version of printf that is unlikely to call malloc, and is thus safer */
/* to call from the collector in case malloc has been bound to GC←malloc. */
/* Assumes that no more than 1023 characters are written at once. */
/* Assumes that all arguments have been converted to something of the */
/* same size as long, and that the format conversions expect something */
/* of that size. */
void GC←printf(format, a, b, c, d, e, f)
char * format;
long a, b, c, d, e, f;
{
char buf[1025];
buf[1024] = 0x15;
(void) sprintf(buf, format, a, b, c, d, e, f);
if (buf[1024] != 0x15) ABORT("GC←printf clobbered stack");
# ifdef OS2
/* We hope this doesn't allocate */
if (fwrite(buf, 1, strlen(buf), stdout) != strlen(buf))
ABORT("write to stdout failed");
# else
if (write(1, buf, strlen(buf)) < 0) ABORT("write to stdout failed");
# endif
}
void GC←err←printf(format, a, b, c, d, e, f)
char * format;
long a, b, c, d, e, f;
{
char buf[1025];
buf[1024] = 0x15;
(void) sprintf(buf, format, a, b, c, d, e, f);
if (buf[1024] != 0x15) ABORT("GC←err←printf clobbered stack");
# ifdef OS2
/* We hope this doesn't allocate */
if (fwrite(buf, 1, strlen(buf), stderr) != strlen(buf))
ABORT("write to stderr failed");
# else
if (write(2, buf, strlen(buf)) < 0) ABORT("write to stderr failed");
# endif
}
void GC←err←puts(s)
char *s;
{
# ifdef OS2
/* We hope this doesn't allocate */
if (fwrite(s, 1, strlen(s), stderr) != strlen(s))
ABORT("write to stderr failed");
# else
if (write(2, s, strlen(s)) < 0) ABORT("write to stderr failed");
# endif
}