123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337 |
- /*
- * (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);
- }
|