/* blast-gc.c
*
* COPYRIGHT (c) 1993 by AT&T Bell Laboratories.
*
* This is the garbage collector for compacting a blasted object.
*
* NOTE: the extraction of literals could cause a space overflow.
*/
#include <stdio.h>
#include "ml-base.h"
#include "ml-limits.h"
#include "ml-state.h"
#include "ml-values.h"
#include "memory.h"
#include "card-map.h"
#include "heap.h"
#include "tags.h"
#include "copy-loop.h"
#include "heap-monitor.h"
#include "ml-timer.h"
#include "ml-heap-image.h"
#include "blast-out.h"
#include "addr-hash.h"
#include "c-globals-tbl.h"
#include "ml-objects.h"
#include "ml-globals.h"
PVT bool_t repairHeap; /* this is TRUE, as long as it is cheaper */
/* to repair the heap, than to complete */
/* the collection */
PVT bool_t finishGC; /* this is TRUE, when we are finishing a */
/* garbage collection after blasting. */
PVT int maxCollectedGen; /* the oldest generation being collected */
PVT ml_val_t *savedTop /* save to-space top pointers */
[MAX_NUM_GENS][NUM_ARENAS];
PVT export_table_t *ExportTbl; /* the table of exported symbols */
PVT addr_tbl_t *EmbObjTbl; /* the table of embedded object references */
/* typedef struct repair repair_t; */ /* in heap.h */
struct repair {
ml_val_t *loc; /* the location to repair */
ml_val_t val; /* the old value */
};
/* record a location in a given arena for repair */
#define NOTE_REPAIR(ap, location, value) { \
arena_t *__ap = (ap); \
if (repairHeap) { \
repair_t *__rp = __ap->repairList - 1; \
if ((ml_val_t *)__rp > __ap->nextw) { \
__rp->loc = (location); \
__rp->val = (value); \
__ap->repairList = __rp; \
} \
else \
repairHeap = FALSE; \
} \
}
/* local routines */
PVT void BlastGC_RepairHeap (ml_state_t *msp, int maxGen);
PVT void BlastGC_FinishGC (ml_state_t *msp, int maxGen);
PVT void BlastGC_Flip (heap_t *heap, int gen);
PVT status_t BlastGC_SweepToSpace (heap_t *heap, aid_t maxAid);
/*
PVT bool_t BlastGC_SweepToSpArrays (heap_t *heap, arena_t *tosp, card_map_t *cm);
*/
PVT ml_val_t BlastGC_ForwardObj (heap_t *heap, ml_val_t obj, aid_t id);
PVT bigobj_desc_t *BlastGC_ForwardBigObj (
heap_t *heap, ml_val_t *p, ml_val_t obj, aid_t aid);
PVT embobj_info_t *EmbObjLookup (addr_tbl_t *tbl, Addr_t addr, embobj_kind_t kind);
PVT void BlastGC_AssignLits (Addr_t addr, void *_closure, void *_info);
PVT void BlastGC_ExtractLits (Addr_t addr, void *_closure, void *_info);
struct assignlits_clos { /* the closure for BlastGC_AssignLits */
Word_t id; /* the heap image chunk index for */
/* embedded literals */
Word_t offset; /* the offset of the next literal */
};
struct extractlits_clos { /* the closure for BlastGC_ExtractLits */
writer_t *wr;
Word_t offset; /* the offset of the next literal; this is */
/* used to align reals. */
};
/* check to see if we need to extend the number of flipped generations */
#define CHECK_GEN(heap, g) { \
int __g = (g); \
if (__g > maxCollectedGen) \
BlastGC_Flip ((heap), __g); \
}
/* BlastGC_CheckWord:
*
* Check an ML value for external references, etc.
*/
#define BlastGC_CheckWord(heap, bibop, p, maxAid, errFlg) { \
ml_val_t __w = *(p); \
/*SayDebug ("CheckWord @ %#x --> %#x: ", p, __w);*/\
if (isBOXED(__w)) { \
aid_t __aid = ADDR_TO_PAGEID(bibop, __w); \
if (isUNMAPPED(__aid)) { \
/* an external reference */ \
/*SayDebug ("external reference\n");*/\
if ((! finishGC) && (ExportCSymbol(ExportTbl, __w) == ML_unit)) \
(errFlg) = TRUE; \
} \
else if (IS_BIGOBJ_AID(__aid)) \
/*{SayDebug ("big-object\n");*/\
BlastGC_ForwardBigObj(heap, p, __w, __aid); \
/*}*/\
else if (IS_FROM_SPACE(__aid, maxAid)) \
/*{SayDebug ("regular object\n");*/\
*(p) = BlastGC_ForwardObj(heap, __w, __aid); \
/*}*/\
} \
/*else SayDebug ("unboxed \n");*/\
}
/* BlastGC:
*
*/
blast_res_t BlastGC (ml_state_t *msp, ml_val_t *root, int gen)
{
heap_t *heap = msp->ml_heap;
bibop_t bibop = BIBOP;
blast_res_t result;
bool_t errFlg = FALSE;
/* Allocates the export and embedded object tables */
ExportTbl = NewExportTbl();
EmbObjTbl = MakeAddrTbl(LOG_BYTES_PER_WORD, 64);
result.exportTbl = ExportTbl;
result.embobjTbl = EmbObjTbl;
/* Initialize, by flipping the generations upto the one including the object */
repairHeap = TRUE;
finishGC = FALSE;
maxCollectedGen = 0;
BlastGC_Flip (heap, gen);
/* Scan the object root */
BlastGC_CheckWord (heap, bibop, root, AID_MAX, errFlg);
if (errFlg) {
result.error = TRUE;
return result;
}
/* Sweep to-space */
if (BlastGC_SweepToSpace(heap, AID_MAX) == FAILURE) {
result.error = TRUE;
return result;
}
result.error = FALSE;
result.needsRepair = repairHeap;
result.maxGen = maxCollectedGen;
return result;
} /* end of BlastGC. */
/* BlastGC_AssignLitAddrs:
*
* Assign relocation addresses to the embedded literals that are going to be
* extracted. The arguments to this are the blast result (containing the
* embedded literal table), the ID of the heap image chunk that the string
* literals are to be stored in, and the starting offset in that chunk.
* This returns the address immediately following the last embedded literal.
*
* NOTE: this code will break if the size of the string space, plus embedded
* literals exceeds 16Mb.
*/
Addr_t BlastGC_AssignLitAddrs (blast_res_t *res, int id, Addr_t offset)
{
struct assignlits_clos closure;
closure.offset = offset;
closure.id = id;
AddrTblApply (EmbObjTbl, &closure, BlastGC_AssignLits);
return closure.offset;
} /* end of BlastGC_AssignLitAddrs */
/* BlastGC_BlastLits:
*
* Blast out the embedded literals.
*/
void BlastGC_BlastLits (writer_t *wr)
{
struct extractlits_clos closure;
closure.wr = wr;
closure.offset = 0;
AddrTblApply (EmbObjTbl, &closure, BlastGC_ExtractLits);
} /* end of BlastGC_BlastLits */
/* BlastGC_FinishUp:
*
* Finish up the blast-out operation. This means either repairing the heap,
* or completing the GC.
*/
void BlastGC_FinishUp (ml_state_t *msp, blast_res_t *res)
{
if (res->needsRepair)
BlastGC_RepairHeap (msp, res->maxGen);
else
BlastGC_FinishGC (msp, res->maxGen);
FreeExportTbl (ExportTbl);
FreeAddrTbl (EmbObjTbl, TRUE);
} /* BlastGC_FinishUp */
/* BlastGC_RepairHeap:
*/
PVT void BlastGC_RepairHeap (ml_state_t *msp, int maxGen)
{
heap_t *heap = msp->ml_heap;
int i, j;
#ifdef VERBOSE
SayDebug ("Repairing blast GC (maxGen = %d of %d)\n", maxGen, heap->numGens);
#endif
for (i = 0; i < maxGen; i++) {
gen_t *gen = heap->gen[i];
#define REPAIR(INDX) { \
arena_t *__ap = gen->arena[INDX]; \
if (isACTIVE(__ap)) { \
repair_t *__stop, *__rp; \
__stop = (repair_t *)(__ap->tospTop); \
for (__rp = __ap->repairList; __rp < __stop; __rp++) { \
ml_val_t *__p = __rp->loc; \
if (INDX != PAIR_INDX) \
__p[-1] = FOLLOW_FWDOBJ(__p)[-1]; \
__p[0] = __rp->val; \
} \
} \
} /* end of REPAIR */
/* repair the arenas */
REPAIR(RECORD_INDX);
REPAIR(PAIR_INDX);
REPAIR(STRING_INDX);
REPAIR(ARRAY_INDX);
/* free the to-space object, and reset the BIBOP marks */
for (j = 0; j < NUM_ARENAS; j++) {
arena_t *ap = gen->arena[j];
if (isACTIVE(ap)) {
/* un-flip the spaces; note that FreeGeneration needs the from-space
* information.
*/
ml_val_t *tmpBase = ap->tospBase;
Addr_t tmpSizeB = ap->tospSizeB;
ml_val_t *tmpTop = ap->tospTop;
ap->nextw =
ap->sweep_nextw = ap->frspTop;
ap->tospBase = ap->frspBase;
ap->frspBase = tmpBase;
ap->tospSizeB = ap->frspSizeB;
ap->frspSizeB = tmpSizeB;
ap->tospTop = savedTop[i][j];
ap->frspTop = tmpTop;
}
} /* end of for */
/* free the to-space memory object */
{
mem_obj_t *tmpObj = gen->fromObj;
gen->fromObj = gen->toObj;
gen->toObj = tmpObj;
FreeGeneration (heap, i);
}
} /* end of for */
} /* end of BlastGC_RepairHeap */
/* BlastGC_FinishGC:
*
* Complete the partial garbage collection.
*/
PVT void BlastGC_FinishGC (ml_state_t *msp, int maxGen)
{
heap_t *heap = msp->ml_heap;
bibop_t bibop = BIBOP;
bool_t dummy = FALSE;
int i, j;
aid_t maxAid;
#ifdef VERBOSE
SayDebug ("Completing blast GC (maxGen = %d of %d)\n", maxGen, heap->numGens);
#endif
finishGC = TRUE;
maxAid = MAKE_MAX_AID(maxGen);
/* allocate new dirty vectors for the flipped generations */
for (i = 0; i < maxGen; i++) {
gen_t *gen = heap->gen[i];
if (isACTIVE(gen->arena[ARRAY_INDX]))
NewDirtyVector(gen);
}
/* collect the roots */
#define CheckRoot(p) { \
ml_val_t *__p = (p); \
BlastGC_CheckWord (heap, bibop, __p, maxAid, dummy); \
}
for (i = 0; i < NumCRoots; i++)
CheckRoot(CRoots[i]);
CheckRoot(&(msp->ml_arg));
CheckRoot(&(msp->ml_cont));
CheckRoot(&(msp->ml_closure));
CheckRoot(&(msp->ml_linkReg));
CheckRoot(&(msp->ml_pc));
CheckRoot(&(msp->ml_exnCont));
CheckRoot(&(msp->ml_varReg));
CheckRoot(&(msp->ml_calleeSave[0]));
CheckRoot(&(msp->ml_calleeSave[1]));
CheckRoot(&(msp->ml_calleeSave[2]));
/* sweep the dirty pages of generations over maxGen */
for (i = maxGen; i < heap->numGens; i++) {
gen_t *gen = heap->gen[i];
if (isACTIVE(gen->arena[ARRAY_INDX])) {
card_map_t *cm = gen->dirty;
if (cm != NIL(card_map_t *)) {
ml_val_t *maxSweep = gen->arena[ARRAY_INDX]->sweep_nextw;
int card;
#if (!defined(BIT_CARDS) && defined(TOSPACE_ID))
FOR_DIRTY_CARD (cm, maxGen, card, {
ml_val_t *p = (cm->baseAddr + (card*CARD_SZW));
ml_val_t *q = p + CARD_SZW;
int mark = i+1;
if (q > maxSweep)
/* don't sweep above the allocation high-water mark */
q = maxSweep;
for (; p < q; p++) {
ml_val_t w = *p;
if (isBOXED(w)) {
aid_t aid = ADDR_TO_PAGEID(bibop, w);
int targetGen;
if (IS_FROM_SPACE(aid, maxAid)) {
/* this is a from-space object */
if (IS_BIGOBJ_AID(aid)) {
bigobj_desc_t *dp;
dp = BlastGC_ForwardBigObj (heap, p, w, aid);
targetGen = dp->gen;
}
else {
*p =
w = BlastGC_ForwardObj(heap, w, aid);
aid = ADDR_TO_PAGEID(bibop, w);
if (IS_TOSPACE_AID(aid))
targetGen = TOSPACE_GEN(aid);
else
targetGen = EXTRACT_GEN(aid);
}
if (targetGen < mark)
mark = targetGen;
}
}
} /* end of for */
/* re-mark the card */
ASSERT(cm->map[card] <= mark);
if (mark <= i)
cm->map[card] = mark;
else if (i == maxGen)
cm->map[card] = CARD_CLEAN;
});
#elif (!defined(BIT_CARDS))
FOR_DIRTY_CARD (cm, maxGen, card, {
ml_val_t *p = (cm->baseAddr + (card*CARD_SZW));
ml_val_t *q = p + CARD_SZW;
int mark = i+1;
if (q > maxSweep)
/* don't sweep above the allocation high-water mark */
q = maxSweep;
for (; p < q; p++) {
ml_val_t w = *p;
if (isBOXED(w)) {
aid_t aid = ADDR_TO_PAGEID(bibop, w);
int targetGen;
if (IS_FROM_SPACE(aid, maxAid)) {
/* this is a from-space object */
if (IS_BIGOBJ_AID(aid)) {
bigobj_desc_t *dp;
dp = BlastGC_ForwardBigObj (heap, p, w, aid);
targetGen = dp->gen;
}
else {
*p =
w = BlastGC_ForwardObj(heap, w, aid);
targetGen = EXTRACT_GEN(ADDR_TO_PAGEID(bibop, w));
}
if (targetGen < mark)
mark = targetGen;
}
}
} /* end of for */
/* re-mark the card */
ASSERT(cm->map[card] <= mark);
if (mark <= i)
cm->map[card] = mark;
else if (i == maxGen)
cm->map[card] = CARD_CLEAN;
});
#else
/* BIT_CARDS */
#endif
}
}
}
/* sweep to-space */
BlastGC_SweepToSpace (heap, maxAid);
/* Scan the array spaces of the flipped generations, marking dirty pages */
for (i = 1; i < maxGen; i++) {
gen_t *gen = heap->gen[i];
arena_t *ap = gen->arena[ARRAY_INDX];
if (isACTIVE(ap)) {
card_map_t *cm = gen->dirty;
int card;
ml_val_t *p, *stop, w;
p = ap->tospBase;
card = 0;
while (p < ap->nextw) {
int mark = i+1;
stop = (ml_val_t *)(((Addr_t)p + CARD_SZB) & ~(CARD_SZB - 1));
if (stop > ap->nextw)
stop = ap->nextw;
while (p < stop) {
if (isBOXED(w = *p++)) {
aid_t aid = ADDR_TO_PAGEID(bibop, w);
int targetGen;
if (IS_BIGOBJ_AID(aid)) {
bigobj_desc_t *dp = BO_GetDesc(w);
targetGen = dp->gen;
}
else
targetGen = EXTRACT_GEN(aid);
if (targetGen < mark) {
mark = targetGen;
if (mark == 1) {
p = stop;
break; /* nothing dirtier than 1st generation */
}
}
}
}
if (mark <= i)
cm->map[card] = mark;
else
cm->map[card] = CARD_CLEAN;
card++;
}
}
}
/* reclaim space */
for (i = 0; i < maxGen; i++) {
FreeGeneration (heap, i);
#ifdef TOSPACE_ID
for (j = 0; j < NUM_ARENAS; j++) {
arena_t *ap = heap->gen[i]->arena[j];
if (isACTIVE(ap))
MarkRegion (bibop, ap->tospBase, ap->tospSizeB, ap->id);
}
#endif
}
/* remember the top of to-space in the collected generations */
for (i = 0; i < maxGen; i++) {
gen_t *g = heap->gen[i];
if (i == heap->numGens-1) {
/* the oldest generation has only "young" objects */
for (j = 0; j < NUM_ARENAS; j++) {
if (isACTIVE(g->arena[j]))
g->arena[j]->oldTop = g->arena[j]->tospBase;
else
g->arena[j]->oldTop = NIL(ml_val_t *);
}
}
else {
for (j = 0; j < NUM_ARENAS; j++) {
if (isACTIVE(g->arena[j]))
g->arena[j]->oldTop = g->arena[j]->nextw;
else
g->arena[j]->oldTop = NIL(ml_val_t *);
}
}
}
HeapMon_UpdateHeap (heap, maxSweptGen);
#ifdef GC_STATS
/* Count the number of forwarded bytes */
for (i = 0; i < maxGen; i++) {
for (j = 0; j < NUM_ARENAS; j++) {
arena_t *ap = heap->gen[i]->arena[j];
if (isACTIVE(ap)) {
CNTR_INCR(&(heap->numCopied[i][j]), ap->nextw - ap->tospBase);
}
}
}
#endif
} /* end of BlastGC_FinishGC */
/* BlastGC_Flip:
*
* Flip additional generations from maxCollectedGen+1 .. gen. We allocate
* a to-space that is the same size as the existing from-space.
*/
PVT void BlastGC_Flip (heap_t *heap, int gen)
{
int i, j;
Addr_t newSz;
for (i = maxCollectedGen; i < gen; i++) {
gen_t *g = heap->gen[i];
for (j = 0; j < NUM_ARENAS; j++) {
arena_t *ap = g->arena[j];
if (isACTIVE(ap)) {
ASSERT ((j == STRING_INDX) || (ap->nextw == ap->sweep_nextw));
savedTop[i][j] = ap->tospTop;
FLIP_ARENA(ap);
newSz = (Addr_t)(ap->frspTop) - (Addr_t)(ap->frspBase);
if (i == 0)
/* need to guarantee space for future minor collections */
newSz += heap->allocSzB;
if (j == PAIR_INDX)
newSz += 2*WORD_SZB;
ap->tospSizeB = RND_MEMOBJ_SZB(newSz);
}
}
g->fromObj = g->toObj;
#ifdef VERBOSE
SayDebug ("New Generation %d:\n", i+1);
#endif
if (NewGeneration(g) == FAILURE)
Die ("unable to allocate to-space for generation %d\n", i+1);
/* initialize the repair lists */
for (j = 0; j < NUM_ARENAS; j++) {
arena_t *ap = g->arena[j];
#ifdef VERBOSE
if (isACTIVE(ap)) SayDebug (" %#x: [%#x, %#x)\n", ap->id, ap->tospBase, ap->tospTop);
#endif
if (isACTIVE(ap))
ap->repairList = (repair_t *)(ap->tospTop);
}
}
maxCollectedGen = gen;
} /* end of BlastGC_Flip */
/* BlastGC_SweepToSpace:
* Sweep the to-space arenas. Because there are few references forward in time, we
* try to completely scavenge a younger generation before moving on to the
* next oldest.
*/
PVT status_t BlastGC_SweepToSpace (heap_t *heap, aid_t maxAid)
{
int i;
bool_t swept;
bibop_t bibop = BIBOP;
bool_t errFlg = FALSE;
#define SweepToSpArena(gen, indx) { \
arena_t *__ap = (gen)->arena[(indx)]; \
if (isACTIVE(__ap)) { \
ml_val_t *__p, *__q; \
__p = __ap->sweep_nextw; \
if (__p < __ap->nextw) { \
swept = TRUE; \
do { \
for (__q = __ap->nextw; __p < __q; __p++) { \
BlastGC_CheckWord(heap, bibop, __p, maxAid, errFlg); \
} \
} while (__q != __ap->nextw); \
__ap->sweep_nextw = __q; \
} \
} \
} /* SweepToSpArena */
do {
swept = FALSE;
for (i = 0; i < maxCollectedGen; i++) {
gen_t *gen = heap->gen[i];
/* Sweep the record and pair arenas */
SweepToSpArena(gen, RECORD_INDX);
SweepToSpArena(gen, PAIR_INDX);
SweepToSpArena(gen, ARRAY_INDX);
}
} while (swept && (!errFlg));
return (errFlg ? FAILURE : SUCCESS);
} /* end of SweepToSpace */
/* BlastGC_ForwardObj:
*
* Forward an object.
*/
PVT ml_val_t BlastGC_ForwardObj (heap_t *heap, ml_val_t v, aid_t id)
{
ml_val_t *obj = PTR_MLtoC(ml_val_t, v);
int gen = EXTRACT_GEN(id);
ml_val_t *new_obj;
ml_val_t desc;
Word_t len;
arena_t *arena;
if (! finishGC)
CHECK_GEN(heap, gen);
switch (EXTRACT_OBJC(id)) {
case OBJC_record: {
desc = obj[-1];
switch (GET_TAG(desc)) {
case DTAG_vec_hdr:
case DTAG_arr_hdr:
len = 2;
break;
case DTAG_forward:
/* This object has already been forwarded */
return PTR_CtoML(FOLLOW_FWDOBJ(obj));
default:
len = GET_LEN(desc);
}
arena = heap->gen[gen-1]->arena[RECORD_INDX];
} break;
case OBJC_pair: {
ml_val_t w;
w = obj[0];
if (isDESC(w))
return PTR_CtoML(FOLLOW_FWDPAIR(w, obj));
else {
/* forward the pair */
arena = heap->gen[gen-1]->arena[PAIR_INDX];
new_obj = arena->nextw;
arena->nextw += 2;
new_obj[0] = w;
new_obj[1] = obj[1];
/* setup the forward pointer in the old pair */
NOTE_REPAIR(arena, obj, w);
obj[0] = MAKE_PAIR_FP(new_obj);
return PTR_CtoML(new_obj);
}
} break;
case OBJC_string: {
arena = heap->gen[gen-1]->arena[STRING_INDX];
desc = obj[-1];
switch (GET_TAG(desc)) {
case DTAG_forward:
return PTR_CtoML(FOLLOW_FWDOBJ(obj));
case DTAG_raw32:
len = GET_LEN(desc);
break;
case DTAG_raw64:
len = GET_LEN(desc);
#ifdef ALIGN_REALDS
# ifdef CHECK_HEAP
if (((Addr_t)arena->nextw & WORD_SZB) == 0) {
*(arena->nextw) = (ml_val_t)0;
arena->nextw++;
}
# else
arena->nextw = (ml_val_t *)(((Addr_t)arena->nextw) | WORD_SZB);
# endif
#endif
break;
default:
Die ("bad string tag %d, obj = %#x, desc = %#x",
GET_TAG(desc), obj, desc);
}
} break;
case OBJC_array: {
desc = obj[-1];
switch (GET_TAG(desc)) {
case DTAG_forward:
/* This object has already been forwarded */
return PTR_CtoML(FOLLOW_FWDOBJ(obj));
case DTAG_arr_data:
len = GET_LEN(desc);
break;
case DTAG_special:
/* we are conservative here, and never nullify special objects */
len = 1;
break;
default:
Die ("bad array tag %d, obj = %#x, desc = %#x",
GET_TAG(desc), obj, desc);
} /* end of switch */
arena = heap->gen[gen-1]->arena[ARRAY_INDX];
} break;
case OBJC_bigobj:
default:
Die("BlastGC_ForwardObj: unknown object class %d @ %#x",
EXTRACT_OBJC(id), obj);
} /* end of switch */
/* Allocate and initialize a to-space copy of the object */
new_obj = arena->nextw;
arena->nextw += (len + 1);
*new_obj++ = desc;
COPYLOOP(obj, new_obj, len);
/* set up the forward pointer, and return the new object. */
NOTE_REPAIR(arena, obj, *obj);
obj[-1] = DESC_forwarded;
obj[0] = (ml_val_t)(Addr_t)new_obj;
return PTR_CtoML(new_obj);
} /* end of BlastGC_ForwardObj */
/* BlastGC_ForwardBigObj:
*
* Forward a big-object obj, where id is the BIBOP entry for obj, and return
* the big-object descriptor.
* NOTE: we do not ``promote'' big-objects here, because are not reclaimed
* when completing th collection.
*/
PVT bigobj_desc_t *BlastGC_ForwardBigObj (
heap_t *heap,
ml_val_t *p,
ml_val_t obj,
aid_t aid)
{
int i;
bigobj_region_t *region;
bigobj_desc_t *dp;
embobj_info_t *codeInfo;
for (i = BIBOP_ADDR_TO_INDEX(obj); !BO_IS_HDR(aid); aid = BIBOP[--i])
continue;
region = (bigobj_region_t *)BIBOP_INDEX_TO_ADDR(i);
dp = ADDR_TO_BODESC(region, obj);
if (! finishGC) {
CHECK_GEN(heap, dp->gen);
codeInfo = EmbObjLookup (EmbObjTbl, dp->obj, UNUSED_CODE);
codeInfo->kind = USED_CODE;
}
return dp;
} /* end of BlastGC_ForwardBigObj */
/* EmbObjLookup:
*/
PVT embobj_info_t *EmbObjLookup (addr_tbl_t *tbl, Addr_t addr, embobj_kind_t kind)
{
embobj_info_t *p = FindEmbObj(tbl, addr);
if (p == NIL(embobj_info_t *)) {
p = NEW_OBJ(embobj_info_t);
p->kind = kind;
p->codeObj = NIL(embobj_info_t *);
AddrTblInsert(tbl, addr, p);
}
ASSERT(kind == p->kind);
return p;
} /* end of EmbObjLookup */
/* BlastGC_AssignLits:
*
* Calculate the location of the extracted literal strings in the blasted
* image, and record their addresses. This function is passed as an argument
* to AddrTblApply; its second argument is its "closure," and its third
* argument is the embedded object info.
*/
PVT void BlastGC_AssignLits (Addr_t addr, void *_closure, void *_info)
{
#ifdef XXX
struct assignlits_clos *closure = (struct assignlits_clos *) _closure;
embobj_info_t *info = (embobj_info_t *) _info;
int objSzB;
switch (info->kind) {
case UNUSED_CODE:
case USED_CODE:
info->relAddr = (ml_val_t)0;
return;
case EMB_STRING: {
int nChars = OBJ_LEN(PTR_CtoML(addr));
int nWords = BYTES_TO_WORDS(nChars);
if ((nChars != 0) && ((nChars & 0x3) == 0))
nWords++;
objSzB = nWords * WORD_SZB;
} break;
case EMB_REALD:
objSzB = OBJ_LEN(PTR_CtoML(addr)) * REALD_SZB;
#ifdef ALIGN_REALDS
closure->offset |= WORD_SZB;
#endif
break;
}
if (info->codeObj->kind == USED_CODE) {
/* the containing code object is also being exported */
info->relAddr = (ml_val_t)0;
return;
}
if (objSzB == 0) {
info->relAddr = ExportCSymbol (ExportTbl,
(info->kind == EMB_STRING) ? ML_string0 : ML_realarray0);
}
else {
/* assign a relocation address to the object, and bump the offset counter */
closure->offset += WORD_SZB; /* space for the descriptor */
info->relAddr = HIO_TAG_PTR(closure->id, closure->offset);
closure->offset += objSzB;
}
#else
Die ("BlastGC_AssignLits");
#endif
} /* end of BlastGC_AssignLits */
/* BlastGC_ExtractLits:
*
* Extract the embedded literals that are in otherwise unreferenced code
* blocks. This function is passed as an argument to AddrTblApply; its
* second argument is its "closure," and its third argument is the
* embedded object info.
*/
PVT void BlastGC_ExtractLits (Addr_t addr, void *_closure, void *_info)
{
struct extractlits_clos *closure = (struct extractlits_clos *) _closure;
embobj_info_t *info = (embobj_info_t *) _info;
int objSzB;
if (info->relAddr == (ml_val_t)0)
return;
switch (info->kind) {
case EMB_STRING: {
int nChars = OBJ_LEN(PTR_CtoML(addr));
int nWords = BYTES_TO_WORDS(nChars);
if ((nChars != 0) && ((nChars & 0x3) == 0))
nWords++;
objSzB = nWords * WORD_SZB;
} break;
case EMB_REALD:
objSzB = OBJ_LEN(PTR_CtoML(addr)) * REALD_SZB;
#ifdef ALIGN_REALDS
if ((closure->offset & (REALD_SZB-1)) == 0) {
/* the descriptor would be 8-byte aligned, which means that the
* real number would not be, so add some padding.
*/
WR_Put(closure->wr, 0);
closure->offset += 4;
}
#endif
break;
}
if (objSzB != 0) {
/* extract the object into the blast buffer (including the descriptor) */
WR_Write(closure->wr, (void *)(addr - WORD_SZB), objSzB + WORD_SZB);
closure->offset += (objSzB + WORD_SZB);
}
} /* end of BlastGC_ExtractLits */
syntax highlighted by Code2HTML, v. 0.9.1