/* This function searches for the root of the ART graph. The function
* scans through the file linearly, looking for an ExpConstDef node
* which points to an Atom called 'main'. This is (sort of) the root of
* the graph. It's good enough, anyway
*/
FileOffset
getRootNode( void )
{
FileOffset curr, root, atom;
int err; char tag;
Ident *atomvariable;
q_position = 0x10;
fseek(HatFileSeq,q_position,SEEK_SET);
root = 0x00;
while (root == 0x00) {
nodecount++;
curr = q_position;
err = q_fread(&tag,sizeof(unsigned char),1,HatFileSeq);
if (tag == ExpConstDef) {
q_readFO(); // throw away the parent
q_readFO(); // throw away the result
atom = q_readFO();
atomvariable = readAtomAt(atom);
if ( strcmp( atomvariable->idname, "main") == 0 ) {
root = curr;
}
free(atomvariable);
}
q_skipNode(tag);
}
return root;
}
/* Look for the file node that corresponds to the definition of Main.main */
FileOffset
findMainUse (Bool findUse)
{
FileOffset fo;
FileOffset atom;
FileOffset def;
FileOffset use;
char c;
char *str;
// We should find the main module at 0x10
fseek(HatFileSeq,0x10,SEEK_SET); q_position=0x10;
q_fread(&c,sizeof(char),1,HatFileSeq);
assert (lower5(c)==Module, "Module tag");
str = q_readString();
assert (!strcmp(str,"Main"),"Module is Main");
// The next thing shoult be the atom variable belonging to that module
q_readString();
atom = q_position;
q_fread(&c,sizeof(char),1,HatFileSeq);
assert (lower5(c)==AtomVariable, "AtomVariable tag");
fo = q_readFO();
assert (fo==0x10, "AtomVariable module is Main");
{ /* skip defnpos */
int x;
q_fread(&x,sizeof(int),1,HatFileSeq);
}
{ /* skip defnpos */
int x;
q_fread(&x,sizeof(int),1,HatFileSeq);
}
{ /* skip fixity */
char x;
q_fread(&x,sizeof(char),1,HatFileSeq);
}
// Main takes no arguments
q_fread(&c,sizeof(char),1,HatFileSeq);
assert (c==0, "AtomVariable has arity 0");
// Make sure the deffinition is main
str = q_readString();
assert (!strcmp(str,"main"),"AtomVariable is main");
// Make sure there is a constant definition pointing at main
def = q_position;
q_fread(&c,sizeof(char),1,HatFileSeq);
assert (lower5(c)==ExpConstDef, "ExpConstDef tag");
q_readFO(); q_readFO();
fo = q_readFO();
assert (fo==atom, "ExpConstDef points to AtomVariable main");
// Make sure that main is called
use = q_position;
q_fread(&c,sizeof(char),1,HatFileSeq);
assert (lower5(c)==ExpConstUse, "ExpConstUse tag");
if (hasSrcPos(c)) q_readFO();
q_readFO();
fo = q_readFO();
assert(fo==def, "ExpConstUse points to ExpConstDef");
if (findUse)
{
return use;
}
else
{
return def;
}
/* postcondition: q_position points to first node following ExpConstUse */
}
/* q_oneNode() moves the file pointer past a single node in the file.
* As a side-effect, if it finds an AtomVariable or AtomConstructor,
* it adds it to the global structure 'map1'. If it finds an ExpValueUse
* or ExpConstDef, it adds an entry in map2 from that usage to the relevant
* Atom in map1. If it finds an ExpApp or ExpConstUse, it instead looks
* up the Atom ptr in map2, then looks up that Atom in map1, and finally
* increments the usage counter. However, in the case where an ExpApp
* is undersaturated (discovered by comparing its arity with the arity
* stored in map2), rather than incrementing the usage counter, we
* instead need to add the address of the ExpApp to map2.
*/
void
q_oneNode (void)
{
char c; int err;
FileOffset node = q_position;
/*fprintf(stdout,"\n0x%x: ",position); fflush(stdout);*/
err = q_fread(&c,sizeof(char),1,HatFileSeq);
if (err!=1) return;
switch (lower5(c)) { /* lower 5 bits identify the TraceType */
case ExpApp:
if (hasSrcPos(c)) { q_readFO(); }
q_readFO(); /* skip parent */
{ unsigned char size, next, i;
FileOffset fun, result; defn *def; item *it;
result = q_readFO(); /* get result */
fun = q_readFO(); /* keep fun ptr */
q_fread(&size,sizeof(unsigned char),1,HatFileSeq); /* get arity */
for (i=0; i<size; i++) q_readFO(); /* skip args */
def = (defn*)FM_lookup(map2,(cast)(uintptr_t)fun);
if (def) {
defn *def2;
it = FM_lookup(map1,(cast)(uintptr_t)def->atom);
if (it) {
if (size>=def->arity) {
if (result==Entered) it->pending += 1;
else if (result==Unevaluated) it->thunks += 1;
else it->uses += 1;
} else if (size < def->arity)
def2 = map2_insert(node,def->atom,size);
} else {
fprintf(stderr,"unknown atom in fun at (ExpApp 0x%x)\n",node);
}
if (def->next) {
it = FM_lookup(map1,(cast)(uintptr_t)def->next->atom);
if (it) {
if (size>=def->next->arity) {
if (result==Entered) it->pending += 1;
else if (result==Unevaluated) it->thunks += 1;
else it->uses += 1;
} else if (size < def->next->arity) {
def2->next = (defn*)malloc(sizeof(defn));
def2->next->atom = def->next->atom;
def2->next->arity = def->next->arity - size;
def2->next->next = (defn*)0;
}
} else {
fprintf(stderr,"unknown atom in CAF fun at (ExpApp 0x%x)\n",node);
}
}
} else {
// fprintf(stderr,"unknown fun at (ExpApp 0x%x)\n",node);
}
} break;
case ExpValueApp:
if (hasSrcPos(c)) { q_readFO(); }
q_readFO(); /* skip parent */
{ unsigned char size, next, i;
FileOffset fun; defn *def; item *it;
fun = q_readFO(); /* fun ptr is an Atom ref */
q_fread(&size,sizeof(unsigned char),1,HatFileSeq); /* get arity */
for (i=0; i<size; i++) q_readFO(); /* skip args */
it = FM_lookup(map1,(cast)(uintptr_t)fun);
if (it) {
if (size>=it->arity) {
it->uses += 1;
HIDE(fprintf(stderr,"0x%x ExpValueApp: incrementing\n",node);)
} else if (size < it->arity) {
map2_insert(node,fun,size);
HIDE(fprintf(stderr,"0x%x ExpValueApp: partial app\n",node);)
}
} else {
