/* * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. * See the copyright notice in the ACK home directory, in the file "Copyright". * */ #include "ass00.h" #include "assex.h" #ifndef NORCSID static char rcs_id[] = "$Id$" ; #endif /* ** utilities of EM1-assembler/loader */ static int globstep; /* * glohash returns an index in table and leaves a stepsize in globstep * */ static int glohash(aname,size) char *aname; { register char *p; register i; register sum; /* * Computes a hash-value from a string. * Algorithm is adding all the characters after shifting some way. */ for(sum=i=0,p=aname;*p;i += 3) sum += (*p++)<<(i&07); sum &= 077777; globstep = (sum / size) % (size - 7) + 7; return(sum % size); } /* * lookup idname in labeltable , if it is not there enter it * return index in labeltable */ glob_t *glo2lookup(name,status) char *name; { return(glolookup(name,status,mglobs,oursize->n_mlab)); } glob_t *xglolookup(name,status) char *name; { return(glolookup(name,status,xglobs,oursize->n_glab)); } static void findext(g) glob_t *g ; { glob_t *x; x = xglolookup(g->g_name,ENTERING); if (x && (x->g_status&DEF)) { g->g_status |= DEF; g->g_val.g_addr = x->g_val.g_addr; } g->g_status |= EXT; } glob_t *glolookup(name,status,table,size) char *name; /* name */ int status; /* kind of lookup */ glob_t *table; /* which table to use */ int size; /* size for hash */ { register glob_t *g; register rem,j; int new; /* * lookup global symbol name in specified table. * Various actions are taken depending on status. * * DEFINING: * Lookup or enter the symbol, check for mult. def. * OCCURRING: * Lookup the symbol, export if not known. * INTERNING: * Enter symbol local to the module. * EXTERNING: * Enter symbol visable from every module. * SEARCHING: * Lookup the symbol, return 0 if not found. * ENTERING: * Lookup or enter the symbol, don't check */ rem = glohash(name,size); j = 0; new=0; g = &table[rem]; while (g->g_name != 0 && strcmp(name,g->g_name) != 0) { j++; if (j>size) fatal("global label table overflow"); rem = (rem + globstep) % size; g = &table[rem]; } if (g->g_name == 0) { /* * This symbol is shining new. * Enter it in table except for status = SEARCHING */ if (status == SEARCHING) return(0); g->g_name = (char *) getarea((unsigned) (strlen(name) + 1)); strcpy(g->g_name,name); g->g_status = 0; g->g_val.g_addr=0; new++; } switch(status) { case SEARCHING: /* nothing special */ case ENTERING: break; case INTERNING: if (!new && (g->g_status&EXT)) werror("INA must be first occurrence of '%s'",name); break; case EXTERNING: /* lookup in other table */ /* * The If statement is removed to be friendly * to Backend writers having to deal with assemblers * not following our conventions. if (!new) error("EXA must be first occurrence of '%s'",name); */ findext(g); break; case DEFINING: /* Thou shalt not redefine */ if (g->g_status&DEF) error("global symbol '%s' redefined",name); g->g_status |= DEF; break; case OCCURRING: if ( new ) findext(g); g->g_status |= OCC; break; default: fatal("bad status in glolookup"); } return(g); } locl_t *loclookup(an,status) { register locl_t *lbp,*l_lbp; register unsigned num; char hinum; if ( !pstate.s_locl ) fatal("label outside procedure"); num = an; if ( num/LOCLABSIZE>255 ) fatal("local label number too large"); hinum = num/LOCLABSIZE; l_lbp= lbp= &(*pstate.s_locl)[num%LOCLABSIZE]; if ( lbp->l_defined==EMPTY ) { lbp= lbp_cast 0 ; } else { while ( lbp!= lbp_cast 0 && lbp->l_hinum != hinum ) { l_lbp = lbp ; lbp = lbp->l_chain; } } if ( lbp == lbp_cast 0 ) { if ( l_lbp->l_defined!=EMPTY ) { lbp = lbp_cast getarea(sizeof *lbp); l_lbp->l_chain= lbp ; } else lbp= l_lbp ; lbp->l_chain= lbp_cast 0 ; lbp->l_hinum=hinum; lbp->l_defined = (status==OCCURRING ? NO : YES); lbp->l_min= line_num; } else if (status == DEFINING) { if (lbp->l_defined == YES) error("multiple defined local symbol"); else lbp->l_defined = YES; } if ( status==DEFINING ) lbp->l_min= line_num ; return(lbp); } proc_t *prolookup(name,status) char *name; { register proc_t *p; register pstat; /* * Look up a procedure name according to status * * PRO_OCC: Occurrence * Search both tables, local table first. * If not found, enter in global table * PRO_INT: INP * Enter symbol in local table. * PRO_DEF: Definition * Define local procedure. * PRO_EXT: EXP * Enter symbol in global table. * * The EXT bit in this table indicates the the name is used * as external in this module. */ switch(status) { case PRO_OCC: p = searchproc(name,mprocs,oursize->n_mproc); if (p->p_name) { p->p_status |= OCC; return(p); } p = searchproc(name,xprocs,oursize->n_xproc); if (p->p_name) { p->p_status |= OCC; return(p); } pstat = OCC|EXT; unresolved++ ; break; case PRO_INT: p = searchproc(name,xprocs,oursize->n_xproc); if (p->p_name && (p->p_status&EXT) ) error("pro '%s' conflicting use",name); p = searchproc(name,mprocs,oursize->n_mproc); if (p->p_name) werror("INP must be first occurrence of '%s'",name); pstat = 0; break; case PRO_EXT: p = searchproc(name,mprocs,oursize->n_mproc); if (p->p_name) error("pro '%s' exists already localy",name); p = searchproc(name,xprocs,oursize->n_xproc); if (p->p_name) { /* * The If statement is removed to be friendly * to Backend writers having to deal with assemblers * not following our conventions. if ( p->p_status&EXT ) werror("EXP must be first occurrence of '%s'", name) ; */ p->p_status |= EXT; return(p); } pstat = EXT; unresolved++; break; case PRO_DEF: p = searchproc(name,xprocs,oursize->n_xproc); if (p->p_name && (p->p_status&EXT) ) { if (p->p_status&DEF) error("global pro '%s' redeclared",name); else unresolved-- ; p->p_status |= DEF; return(p); } else { p = searchproc(name,mprocs,oursize->n_mproc); if (p->p_name) { if (p->p_status&DEF) error("local pro '%s' redeclared", name); p->p_status |= DEF; return(p); } } pstat = DEF; break; default: fatal("bad status in prolookup"); } return(enterproc(name,pstat,p)); } proc_t *searchproc(name,table,size) char *name; proc_t *table; int size; { register proc_t *p; register rem,j; /* * return a pointer into table to the place where the procedure * name is or should be if in the table. */ rem = glohash(name,size); j = 0; p = &table[rem]; while (p->p_name != 0 && strcmp(name,p->p_name) != 0) { j++; if (j>size) fatal("procedure table overflow"); rem = (rem + globstep) % size; p = &table[rem]; } return(p); } proc_t *enterproc(name,status,place) char *name; char status; proc_t *place; { register proc_t *p; /* * Enter the procedure name into the table at place place. * Place had better be computed by searchproc(). * * NOTE: * At this point the procedure gets assigned a number. * This number is used as a parameter of cal and in some * other ways. There exists a 1-1 correspondence between * procedures and numbers. * Two local procedures with the same name in different * modules have different numbers. */ p=place; p->p_name = (char *) getarea((unsigned) (strlen(name) + 1)); strcpy(p->p_name,name); p->p_status = status; if (procnum>=oursize->n_proc) fatal("too many procedures"); p->p_num = procnum++; return(p); }