Closure *
loadClosure(const char *filename,
FILE *f, const StringTabEntry *strings,
HashTable *itbls, HashTable *closures)
{
u4 i;
u4 magic = fget_u4(f);
assert(magic == CLOSURE_MAGIC);
char *clos_name = loadId(f, strings, ".");
u4 payloadsize = fget_varuint(f);
char *itbl_name = loadId(f, strings, ".");
Closure *cl = allocStaticClosure(wordsof(ClosureHeader) + payloadsize);
Closure *fwd_ref;
InfoTable* info = HashTable_lookup(itbls, itbl_name);
LC_ASSERT(info != NULL && info->type != INVALID_OBJECT);
// Fill in closure payload. May create forward references to
// the current closure.
setInfo(cl, info);
xfree(itbl_name);
for (i = 0; i < payloadsize; i++) {
LD_DBG_PR(1, "Loading payload for: %s [%d]\n", clos_name, i);
u1 dummy;
loadLiteral(filename, f, &dummy, &cl->payload[i], strings, itbls, closures);
}
fwd_ref = HashTable_lookup(closures, clos_name);
if (fwd_ref != NULL) {
LD_DBG_PR(2, "Fixing closure forward ref: %s, %p -> %p\n", clos_name, fwd_ref, cl);
// fixup forward refs
void **p, *next;
for (p = (void**)fwd_ref->payload[0]; p != NULL; p = next) {
next = *p;
*p = (void*)cl;
}
xfree(fwd_ref);
HashTable_update(closures, clos_name, cl);
// The key has been allocated by whoever installed the first
// forward reference.
xfree(clos_name);
} else {
HashTable_insert(closures, clos_name, cl);
}
return cl;
}
int
isModuleLoaded(const char *moduleName)
{
Module *mdl;
mdl = HashTable_lookup(G_loader->loadedModules, moduleName);
// If the module is currently being loaded, then its string table
// will be non-empty.
return (mdl != NULL) && (mdl->strings == NULL);
}
// Postorder traversal
void
loadModule_aux(const char *moduleName, u4 level)
{
char *filename;
Module *mdl;
FILE *f;
int i;
mdl = (Module*)HashTable_lookup(G_loader->loadedModules, moduleName);
if (mdl != NULL) {
// Module is either already loaded, or currently in process of
// being loaded.
return;
}
filename = findModule(moduleName);
for (i = 0; i < level; i++) fputc(' ', stderr);
fprintf(stderr, "> Loading %s ...(%s)\n", moduleName, filename);
f = fopen(filename, "rb");
if (f == NULL) {
fprintf(stderr, "ERROR: Could not open file: %s\n",
filename);
exit(14);
}
mdl = loadModuleHeader(f, filename);
HashTable_insert(G_loader->loadedModules, moduleName, mdl);
// Load dependencies first. This avoids creating many forward
// references. The downside is that we keep more file descriptors
// open.
for (i = 0; i < mdl->numImports; i++)
loadModule_aux(mdl->imports[i], level + 1);
loadModuleBody(filename, f, mdl);
fclose(f);
// We now don't need the string table anymore.
xfree(mdl->strings);
mdl->strings = NULL;
for (i = 0; i < level; i++) fputc(' ', stderr);
fprintf(stderr, "< DONE (%s)\n", moduleName);
}
void LexParser_syncLastVar(LexParser * self) {
HashTableItem * i;
iVar * v;
switch (self->idMode) {
case lp_insertOnly:
if (HashTable_insertNew(self->symbolTable, self->str.buff,
&(self->lastSymbol)) != ht_inserted) {
Definition_err_throw(self); // redefinition
}
break;
case lp_parseParams:
v = iVar__init__();
self->lastSymbol = v;
iFunction_addParam(self->lastFunction, self->lastSymbol,
strdup(self->str.buff));
break;
case lp_fnSearch:
i = HashTable_lookup(self->symbolTable, self->str.buff);
if (!i) {
if (HashTable_insertNew(self->symbolTable, self->str.buff,
&(self->lastSymbol)) != ht_inserted) {
Definition_err_throw(self); // redefinition
}
self->lastSymbol->type = iFn;
self->lastSymbol->val.fn = iFunction__init__();
self->lastSymbol->val.fn->name = strdup(self->str.buff);
} else {
if (i->var->type != iFn || i->var->val.fn->bodyFound)
Definition_err_throw(self);
self->lastSymbol = i->var;
}
self->lastFunction = self->lastSymbol->val.fn;
break;
case lp_searchOnly:
i = HashTable_lookupEverywhere(self->symbolTable, self->str.buff);
if (!i) {
Definition_err_throw(self);
}
self->lastSymbol = i->var;
break;
case lp_ignore:
break;
default:
Lex_throwError(self,
"LexParser doesn't know whether to search or insert new id\n");
}
}
void
loadLiteral(const char *filename,
FILE *f, u1 *littype /*out*/, Word *literal /*out*/,
const StringTabEntry *strings, HashTable *itbls,
HashTable *closures)
{
u4 i;
*littype = fget_u1(f);
switch (*littype) {
case LIT_INT:
*literal = (Word)fget_varsint(f);
break;
case LIT_CHAR:
*literal = (Word)fget_varuint(f);
break;
case LIT_WORD:
*literal = (Word)fget_varuint(f);
break;
case LIT_FLOAT:
*literal = (Word)fget_u4(f);
break;
case LIT_STRING:
i = fget_varuint(f);
*literal = (Word)strings[i].str;
break;
case LIT_CLOSURE:
{ char *clname = loadId(f, strings, ".");
Closure *cl = HashTable_lookup(closures, clname);
if (cl == NULL) {
// 1st forward ref, create the link
cl = xmalloc(sizeof(ClosureHeader) + sizeof(Word));
setInfo(cl, NULL);
cl->payload[0] = (Word)literal;
*literal = (Word)NULL;
LD_DBG_PR(2, "Creating forward reference %p for `%s', %p\n",
cl, clname, literal);
HashTable_insert(closures, clname, cl);
} else if (getInfo(cl) == NULL) {
// forward ref (not the first), insert into linked list
LD_DBG_PR(2, "Linking forward reference %p (%s, target: %p)\n",
cl, clname, literal);
*literal = (Word)cl->payload[0];
cl->payload[0] = (Word)literal;
xfree(clname);
} else {
*literal = (Word)cl;
xfree(clname);
}
}
break;
case LIT_INFO:
{ char *infoname = loadId(f, strings, ".");
InfoTable *info = HashTable_lookup(itbls, infoname);
FwdRefInfoTable *info2;
if (info == NULL) {
// 1st forward ref
info2 = xmalloc(sizeof(FwdRefInfoTable));
info2->i.type = INVALID_OBJECT;
info2->next = (void**)literal;
*literal = (Word)NULL;
HashTable_insert(itbls, infoname, info2);
} else if (info->type == INVALID_OBJECT) {
// subsequent forward ref
info2 = (FwdRefInfoTable*)info;
*literal = (Word)info2->next;
info2->next = (void**)literal;
xfree(infoname);
} else {
*literal = (Word)info;
xfree(infoname);
}
}
break;
default:
fprintf(stderr, "ERROR: Unknown literal type (%d) "
"when loading file: %s\n",
*littype, filename);
exit(1);
}
}
InfoTable *
loadInfoTable(const char *filename,
FILE *f, const StringTabEntry *strings,
HashTable *itbls, HashTable *closures)
{
u4 magic = fget_u4(f);
assert(magic == INFO_MAGIC);
char *itbl_name = loadId(f, strings, ".");
u2 cl_type = fget_varuint(f);
InfoTable *new_itbl = NULL;
FwdRefInfoTable *old_itbl = HashTable_lookup(itbls, itbl_name);
if (old_itbl && old_itbl->i.type != INVALID_OBJECT) {
fprintf(stderr, "ERROR: Duplicate info table: %s\n",
itbl_name);
exit(1);
}
switch (cl_type) {
case CONSTR:
// A statically allocated constructor
{
ConInfoTable *info = allocInfoTable(wordsof(ConInfoTable));
info->i.type = cl_type;
info->i.tagOrBitmap = fget_varuint(f); // tag
Word sz = fget_varuint(f);
assert(sz <= 32);
info->i.size = sz;
info->i.layout.bitmap = sz > 0 ? fget_u4(f) : 0;
// info->i.layout.payload.ptrs = fget_varuint(f);
// info->i.layout.payload.nptrs = fget_varuint(f);
info->name = loadId(f, strings, ".");
new_itbl = (InfoTable*)info;
}
break;
case FUN:
{
FuncInfoTable *info = allocInfoTable(wordsof(FuncInfoTable));
info->i.type = cl_type;
info->i.tagOrBitmap = 0; // TODO: anything useful to put in here?
Word sz = fget_varuint(f);
assert(sz <= 32);
info->i.size = sz;
info->i.layout.bitmap = sz > 0 ? fget_u4(f) : 0;
info->name = loadId(f, strings, ".");
loadCode(filename, f, &info->code, strings, itbls, closures);
new_itbl = (InfoTable*)info;
}
break;
case CAF:
case THUNK:
{
ThunkInfoTable *info = allocInfoTable(wordsof(ThunkInfoTable));
info->i.type = cl_type;
info->i.tagOrBitmap = 0; // TODO: anything useful to put in here?
Word sz = fget_varuint(f);
assert(sz <= 32);
info->i.size = sz;
info->i.layout.bitmap = sz > 0 ? fget_u4(f) : 0;
info->name = loadId(f, strings, ".");
loadCode(filename, f, &info->code, strings, itbls, closures);
new_itbl = (InfoTable*)info;
}
break;
default:
fprintf(stderr, "ERROR: Unknown info table type (%d)", cl_type);
exit(1);
}
// new_itbl is the new info table. There may have been forward
// references (even during loading the code for this info table).
if (old_itbl != NULL) {
LD_DBG_PR(1, "Fixing itable forward reference for: %s, %p\n", itbl_name, new_itbl);
void **p, *next;
LC_ASSERT(old_itbl->i.type == INVALID_OBJECT);
for (p = old_itbl->next; p != NULL; p = next) {
next = *p;
*p = (void*)new_itbl;
}
// TODO: fixup forward refs
xfree(old_itbl);
HashTable_update(itbls, itbl_name, new_itbl);
xfree(itbl_name);
} else {
HashTable_insert(itbls, itbl_name, new_itbl);
}
return new_itbl;
}
Closure *
lookupClosure(const char *name)
{
return HashTable_lookup(G_loader->closures, name);
}
