static __regargs BOOL AllocHunks(FileT *fh, LONG hunkNum, HunkT **hunks) {
LONG memFlags, n, size;
HunkT *hunk, *prev = NULL;
while (hunkNum--) {
/* size specifiers including memory attribute flags */
FileRead(fh, ONSTACK(n));
memFlags = n >> 30;
size = n & 0x3FFFFFFF;
if (memFlags == 1)
memFlags = MEMF_CHIP;
else if (memFlags == 2)
memFlags = MEMF_FAST;
else
memFlags = MEMF_PUBLIC;
if (!(hunk = AllocMem(sizeof(HunkT) + n * sizeof(LONG), memFlags)))
return FALSE;
hunk->size = n * sizeof(LONG);
hunk->next = NULL;
if (prev)
prev->next = MKBADDR(&hunk->next);
prev = hunk;
*hunks++ = hunk;
}
return TRUE;
}
void bbcheck(stack wam) {
{term *tp;
fprintf(STD_err,"\nBlackBOARD => %lu\n",g.shared[BBoardStk].top-g.shared[BBoardStk].base);
for(tp=g.shared[BBoardStk].base; tp<g.shared[BBoardStk].top; tp++)
if(VAR(tp) && ! ONSTACK(g.shared[BBoardStk],tp)) {
fprintf(STD_err,"[%lu] %s\n",tp-g.shared[BBoardStk].base,
smartref((cell)(*tp),wam));
}
}
}
__regargs BPTR LoadExecutable(FileT *fh) {
HunkT **hunks;
LONG n, hunkId, hunkNum;
FileRead(fh, ONSTACK(hunkId));
hunkId &= 0x3FFFFFFF;
if (hunkId == HUNK_HEADER) {
/* Skip resident library names. */
do {
FileRead(fh, ONSTACK(n));
if (n == 0) break;
FileSeek(fh, n * sizeof(LONG), SEEK_CUR);
} while(1);
/*
* number of hunks (including resident libraries and overlay hunks)
* number of the first (root) hunk
* number of the last (root) hunk
*/
{
struct { LONG hunks, first, last; } s;
FileRead(fh, ONSTACK(s));
hunkNum = s.last - s.first + 1;
}
hunks = __builtin_alloca(sizeof(HunkT *) * hunkNum);
if (AllocHunks(fh, hunkNum, hunks)) {
BPTR seglist = MKBADDR(&(hunks[0]->next));
if (LoadHunks(fh, hunks))
return seglist;
FreeSegList(seglist);
}
}
return NULL;
}
static void str(cell ptr, register stack wam,string s)
{ int i;
for(i=0; i<MaxStk; i++)
if(ON(i,ptr))
{
sprintf(s,"%s[%ld]",wam[i].name,(term*)ptr-wam[i].base);
return;
}
if(ONSTACK(g.shared[BBoardStk],ptr)) {
sprintf(s,"BBOARD[_%ld]",(term)ptr-(term)g.shared[BBoardStk].base);
}
else if(ONSTACK(g.shared[InstrStk],ptr)) {
sprintf(s,"CODE[_%ld]",(term)ptr-(term)g.shared[InstrStk].base);
}
else if(INTEGER(ptr))
sprintf(s,"bp_long(%ld)",OUTPUT_INT(ptr));
else
{
if(GETSYMNO(ptr)<MAXATOM && NAME(ptr))
sprintf(s,"%s/%lu",NAME(ptr),GETARITY(ptr));
else
sprintf(s,"MEM[%lu]",(no)ptr);
}
}
/* stackCheck:
* Return true if n in on the stack.
*/
int stackCheck(nstack_t * s, Agnode_t * n)
{
return ONSTACK(n);
#ifdef OLD
stackitem_t *top = s->top;
Agnode_t *node;
while (top != NULL) {
node = top->data;
if (node == n)
return 1;
top = top->next;
}
return 0;
#endif
}
static __regargs BOOL LoadHunks(FileT *fh, HunkT **hunks) {
LONG n, hunkCode, hunkNum;
WORD hunkIdx = 0;
BOOL hunkRoot = TRUE;
while (FileRead(fh, &hunkCode, sizeof(LONG))) {
WORD hunkId = hunkCode; /* hunkId = 10xx, so we can ignore upper bits */
HunkT *hunk = hunks[hunkIdx];
if (hunkId == HUNK_CODE || hunkId == HUNK_DATA || hunkId == HUNK_BSS) {
hunkRoot = TRUE;
FileRead(fh, ONSTACK(n));
if (hunkId != HUNK_BSS)
FileRead(fh, hunk->data, n * sizeof(LONG));
else
memset(hunk->data, 0, n * sizeof(LONG));
{
char *hunkType;
if (hunkId == HUNK_CODE)
hunkType = "CODE";
else if (hunkId == HUNK_DATA)
hunkType = "DATA";
else
hunkType = " BSS";
Log("%s: %lx - %lx\n", hunkType,
(LONG)hunk->data, (LONG)(hunk->data + hunk->size));
}
} else if (hunkId == HUNK_DEBUG) {
FileRead(fh, ONSTACK(n));
FileSeek(fh, n * sizeof(LONG), SEEK_CUR);
} else if (hunkId == HUNK_RELOC32) {
LONG hunkRef, reloc;
do {
FileRead(fh, ONSTACK(n));
if (n == 0) break;
FileRead(fh, ONSTACK(hunkNum));
hunkRef = (LONG)hunks[hunkNum]->data;
while (n--) {
FileRead(fh, ONSTACK(reloc));
((LONG *)hunk->data)[reloc] += hunkRef;
}
} while(1);
} else if (hunkId == HUNK_SYMBOL) {
do {
FileRead(fh, ONSTACK(n));
if (n == 0) break;
FileSeek(fh, (n + 1) * sizeof(LONG), SEEK_CUR);
} while(1);
} else if (hunkId == HUNK_END) {
if (hunkRoot) {
hunkRoot = FALSE;
hunkIdx++;
}
} else {
Log("Unknown hunk $%08lx!\n", hunkCode);
return FALSE;
}
}
return TRUE;
}
term hlist(register term H, register term regs, stack wam)
{ no i; cell xval; bp_long ival; byte stamp;
#if TRACE>0
fprintf(STD_err,"entering hlist, wam=%d, bboard=%d H=%d\n",
wam,g.shared[BBoardStk].base,H);
bbcheck(wam);
#endif
if(!INTEGER(X(1))) return NULL; /* first arg: stamp */
stamp=(byte)(OUTPUT_INT(X(1)));
xval=X(2); /* second arg: starting arity of listed terms */
if(!INTEGER(xval)) return NULL;
ival=OUTPUT_INT(xval);
for(i=0; i<HMAX; i++)
if(hstamp[i]>=stamp && HUSED())
{ term xref=C2T(g.predmark);
if(hstamp[i]<=RUNTIME)
{ /* gets preds of arity < ival `represented' as g.predmark*/
if(g.predmark!=htable[i].pred
|| GETARITY(htable[i].fun)<(no)ival)
continue;
xval=g.predmark;
}
else
{ /* gets RUNTIME data of arity > ival */
cell v=htable[i].val;
if(NULL==(term)v)
continue;
if(VAR(v) &&
!(
ONSTACK(g.shared[BBoardStk],v) ||
ONSTACK(g.shared[InstrStk],v) /*|| ON(HeapStk,v) */
)) {
#if TRACE>0
fprintf(STD_err,
"unexpected data in htable[%d]=>\n<%s,%s>->%s\n",i,
smartref(htable[i].pred,wam),
smartref(htable[i].fun,wam),
smartref(v,wam));
#endif
/* continue; */
}
FDEREF(v);
if((INTEGER(xval) && ival>0)
|| VAR(xval)
|| (GETARITY(xval) < (no)ival)
|| xval==g.empty
)
continue;
if(COMPOUND(xval))
xval=T2C(xref);
}
IF_OVER("COPY_KEYS",(term *)H,HeapStk,bp_halt(9));
SAVE_FUN(htable[i].pred);
SAVE_FUN(htable[i].fun);
#if 0
ASSERT2(( ATOMIC(xval)
|| ONSTACK(g.shared[BBoardStk],xval)
|| ON(HeapStk,xval)), /* will fail with multiple engines */
xval);
#endif
PUSH_LIST(xval);
}
PUSH_NIL();
return H;
}
