/* 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 {