ass70.c 7.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337
  1. /*
  2. * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
  3. * See the copyright notice in the ACK home directory, in the file "Copyright".
  4. *
  5. */
  6. #include "ass00.h"
  7. #include "assex.h"
  8. #ifndef NORCSID
  9. static char rcs_id[] = "$Id$" ;
  10. #endif
  11. /*
  12. ** utilities of EM1-assembler/loader
  13. */
  14. static int globstep;
  15. /*
  16. * glohash returns an index in table and leaves a stepsize in globstep
  17. *
  18. */
  19. static int glohash(aname,size) char *aname; {
  20. register char *p;
  21. register i;
  22. register sum;
  23. /*
  24. * Computes a hash-value from a string.
  25. * Algorithm is adding all the characters after shifting some way.
  26. */
  27. for(sum=i=0,p=aname;*p;i += 3)
  28. sum += (*p++)<<(i&07);
  29. sum &= 077777;
  30. globstep = (sum / size) % (size - 7) + 7;
  31. return(sum % size);
  32. }
  33. /*
  34. * lookup idname in labeltable , if it is not there enter it
  35. * return index in labeltable
  36. */
  37. glob_t *glo2lookup(name,status) char *name; {
  38. return(glolookup(name,status,mglobs,oursize->n_mlab));
  39. }
  40. glob_t *xglolookup(name,status) char *name; {
  41. return(glolookup(name,status,xglobs,oursize->n_glab));
  42. }
  43. static void findext(g) glob_t *g ; {
  44. glob_t *x;
  45. x = xglolookup(g->g_name,ENTERING);
  46. if (x && (x->g_status&DEF)) {
  47. g->g_status |= DEF;
  48. g->g_val.g_addr = x->g_val.g_addr;
  49. }
  50. g->g_status |= EXT;
  51. }
  52. glob_t *glolookup(name,status,table,size)
  53. char *name; /* name */
  54. int status; /* kind of lookup */
  55. glob_t *table; /* which table to use */
  56. int size; /* size for hash */
  57. {
  58. register glob_t *g;
  59. register rem,j;
  60. int new;
  61. /*
  62. * lookup global symbol name in specified table.
  63. * Various actions are taken depending on status.
  64. *
  65. * DEFINING:
  66. * Lookup or enter the symbol, check for mult. def.
  67. * OCCURRING:
  68. * Lookup the symbol, export if not known.
  69. * INTERNING:
  70. * Enter symbol local to the module.
  71. * EXTERNING:
  72. * Enter symbol visable from every module.
  73. * SEARCHING:
  74. * Lookup the symbol, return 0 if not found.
  75. * ENTERING:
  76. * Lookup or enter the symbol, don't check
  77. */
  78. rem = glohash(name,size);
  79. j = 0; new=0;
  80. g = &table[rem];
  81. while (g->g_name != 0 && strcmp(name,g->g_name) != 0) {
  82. j++;
  83. if (j>size)
  84. fatal("global label table overflow");
  85. rem = (rem + globstep) % size;
  86. g = &table[rem];
  87. }
  88. if (g->g_name == 0) {
  89. /*
  90. * This symbol is shining new.
  91. * Enter it in table except for status = SEARCHING
  92. */
  93. if (status == SEARCHING)
  94. return(0);
  95. g->g_name = (char *) getarea((unsigned) (strlen(name) + 1));
  96. strcpy(g->g_name,name);
  97. g->g_status = 0;
  98. g->g_val.g_addr=0;
  99. new++;
  100. }
  101. switch(status) {
  102. case SEARCHING: /* nothing special */
  103. case ENTERING:
  104. break;
  105. case INTERNING:
  106. if (!new && (g->g_status&EXT))
  107. werror("INA must be first occurrence of '%s'",name);
  108. break;
  109. case EXTERNING: /* lookup in other table */
  110. /*
  111. * The If statement is removed to be friendly
  112. * to Backend writers having to deal with assemblers
  113. * not following our conventions.
  114. if (!new)
  115. error("EXA must be first occurrence of '%s'",name);
  116. */
  117. findext(g);
  118. break;
  119. case DEFINING: /* Thou shalt not redefine */
  120. if (g->g_status&DEF)
  121. error("global symbol '%s' redefined",name);
  122. g->g_status |= DEF;
  123. break;
  124. case OCCURRING:
  125. if ( new )
  126. findext(g);
  127. g->g_status |= OCC;
  128. break;
  129. default:
  130. fatal("bad status in glolookup");
  131. }
  132. return(g);
  133. }
  134. locl_t *loclookup(an,status) {
  135. register locl_t *lbp,*l_lbp;
  136. register unsigned num;
  137. char hinum;
  138. if ( !pstate.s_locl ) fatal("label outside procedure");
  139. num = an;
  140. if ( num/LOCLABSIZE>255 ) fatal("local label number too large");
  141. hinum = num/LOCLABSIZE;
  142. l_lbp= lbp= &(*pstate.s_locl)[num%LOCLABSIZE];
  143. if ( lbp->l_defined==EMPTY ) {
  144. lbp= lbp_cast 0 ;
  145. } else {
  146. while ( lbp!= lbp_cast 0 && lbp->l_hinum != hinum ) {
  147. l_lbp = lbp ;
  148. lbp = lbp->l_chain;
  149. }
  150. }
  151. if ( lbp == lbp_cast 0 ) {
  152. if ( l_lbp->l_defined!=EMPTY ) {
  153. lbp = lbp_cast getarea(sizeof *lbp);
  154. l_lbp->l_chain= lbp ;
  155. } else lbp= l_lbp ;
  156. lbp->l_chain= lbp_cast 0 ;
  157. lbp->l_hinum=hinum;
  158. lbp->l_defined = (status==OCCURRING ? NO : YES);
  159. lbp->l_min= line_num;
  160. } else
  161. if (status == DEFINING) {
  162. if (lbp->l_defined == YES)
  163. error("multiple defined local symbol");
  164. else
  165. lbp->l_defined = YES;
  166. }
  167. if ( status==DEFINING ) lbp->l_min= line_num ;
  168. return(lbp);
  169. }
  170. proc_t *prolookup(name,status) char *name; {
  171. register proc_t *p;
  172. register pstat;
  173. /*
  174. * Look up a procedure name according to status
  175. *
  176. * PRO_OCC: Occurrence
  177. * Search both tables, local table first.
  178. * If not found, enter in global table
  179. * PRO_INT: INP
  180. * Enter symbol in local table.
  181. * PRO_DEF: Definition
  182. * Define local procedure.
  183. * PRO_EXT: EXP
  184. * Enter symbol in global table.
  185. *
  186. * The EXT bit in this table indicates the the name is used
  187. * as external in this module.
  188. */
  189. switch(status) {
  190. case PRO_OCC:
  191. p = searchproc(name,mprocs,oursize->n_mproc);
  192. if (p->p_name) {
  193. p->p_status |= OCC;
  194. return(p);
  195. }
  196. p = searchproc(name,xprocs,oursize->n_xproc);
  197. if (p->p_name) {
  198. p->p_status |= OCC;
  199. return(p);
  200. }
  201. pstat = OCC|EXT;
  202. unresolved++ ;
  203. break;
  204. case PRO_INT:
  205. p = searchproc(name,xprocs,oursize->n_xproc);
  206. if (p->p_name && (p->p_status&EXT) )
  207. error("pro '%s' conflicting use",name);
  208. p = searchproc(name,mprocs,oursize->n_mproc);
  209. if (p->p_name)
  210. werror("INP must be first occurrence of '%s'",name);
  211. pstat = 0;
  212. break;
  213. case PRO_EXT:
  214. p = searchproc(name,mprocs,oursize->n_mproc);
  215. if (p->p_name)
  216. error("pro '%s' exists already localy",name);
  217. p = searchproc(name,xprocs,oursize->n_xproc);
  218. if (p->p_name) {
  219. /*
  220. * The If statement is removed to be friendly
  221. * to Backend writers having to deal with assemblers
  222. * not following our conventions.
  223. if ( p->p_status&EXT )
  224. werror("EXP must be first occurrence of '%s'",
  225. name) ;
  226. */
  227. p->p_status |= EXT;
  228. return(p);
  229. }
  230. pstat = EXT;
  231. unresolved++;
  232. break;
  233. case PRO_DEF:
  234. p = searchproc(name,xprocs,oursize->n_xproc);
  235. if (p->p_name && (p->p_status&EXT) ) {
  236. if (p->p_status&DEF)
  237. error("global pro '%s' redeclared",name);
  238. else
  239. unresolved-- ;
  240. p->p_status |= DEF;
  241. return(p);
  242. } else {
  243. p = searchproc(name,mprocs,oursize->n_mproc);
  244. if (p->p_name) {
  245. if (p->p_status&DEF)
  246. error("local pro '%s' redeclared",
  247. name);
  248. p->p_status |= DEF;
  249. return(p);
  250. }
  251. }
  252. pstat = DEF;
  253. break;
  254. default:
  255. fatal("bad status in prolookup");
  256. }
  257. return(enterproc(name,pstat,p));
  258. }
  259. proc_t *searchproc(name,table,size)
  260. char *name;
  261. proc_t *table;
  262. int size;
  263. {
  264. register proc_t *p;
  265. register rem,j;
  266. /*
  267. * return a pointer into table to the place where the procedure
  268. * name is or should be if in the table.
  269. */
  270. rem = glohash(name,size);
  271. j = 0;
  272. p = &table[rem];
  273. while (p->p_name != 0 && strcmp(name,p->p_name) != 0) {
  274. j++;
  275. if (j>size)
  276. fatal("procedure table overflow");
  277. rem = (rem + globstep) % size;
  278. p = &table[rem];
  279. }
  280. return(p);
  281. }
  282. proc_t *enterproc(name,status,place)
  283. char *name;
  284. char status;
  285. proc_t *place; {
  286. register proc_t *p;
  287. /*
  288. * Enter the procedure name into the table at place place.
  289. * Place had better be computed by searchproc().
  290. *
  291. * NOTE:
  292. * At this point the procedure gets assigned a number.
  293. * This number is used as a parameter of cal and in some
  294. * other ways. There exists a 1-1 correspondence between
  295. * procedures and numbers.
  296. * Two local procedures with the same name in different
  297. * modules have different numbers.
  298. */
  299. p=place;
  300. p->p_name = (char *) getarea((unsigned) (strlen(name) + 1));
  301. strcpy(p->p_name,name);
  302. p->p_status = status;
  303. if (procnum>=oursize->n_proc)
  304. fatal("too many procedures");
  305. p->p_num = procnum++;
  306. return(p);
  307. }