ghc/compiler/yaccParser/id.c

   1 /**********************************************************************
   2 *                                                                     *
   3 *                                                                     *
   4 *      Identifier Processing                                          *
   5 *                                                                     *
   6 *                                                                     *
   7 **********************************************************************/
   8
   9 #include <stdio.h>
  10
  11 #include "hspincl.h"
  12 #include "constants.h"
  13 #include "id.h"
  14 #include "utils.h"
  15
  16 /* partain: special version for strings that may have NULs (etc) in them
  17    (used in UgenUtil.lhs)
  18 */
  19 long
  20 get_hstring_len(hs)
  21   hstring hs;
  22 {
  23     return(hs->len);
  24 }
  25
  26 char *
  27 get_hstring_bytes(hs)
  28   hstring hs;
  29 {
  30   return(hs->bytes);
  31 }
  32
  33 hstring
  34 installHstring(length, s)
  35   int  length;
  36   char *s;
  37 {
  38   char *p;
  39   hstring str;
  40   int i;
  41
  42 /* fprintf(stderr, "installHstring: %d, %s\n",length, s); */
  43
  44   if (length > 999999) { /* too long */
  45       fprintf(stderr,"String length more than six digits\n");
  46       exit(1);
  47   } else if (length < 0) { /* too short */
  48       fprintf(stderr,"String length < 0 !!\n");
  49       abort();
  50   }
  51
  52   /* alloc the struct and store the length */
  53   str = (hstring) xmalloc(sizeof(Hstring));
  54   str->len = length;
  55
  56   if (length == 0) {
  57      str->bytes = NULL;
  58
  59   } else {
  60      p = xmalloc(length);
  61
  62      /* now store the string */
  63      for (i = 0; i < length; i++) {
  64        p[i] = s[i];
  65      }
  66      str->bytes = p;
  67   }
  68   return str;
  69 }
  70
  71
  72 /**********************************************************************
  73 *                                                                     *
  74 *                                                                     *
  75 *      Hashed Identifiers                                             *
  76 *                                                                     *
  77 *                                                                     *
  78 **********************************************************************/
  79
  80
  81 extern BOOLEAN hashIds;                         /* Whether to use hashed ids. */
  82
  83 unsigned hash_table_size = HASH_TABLE_SIZE;
  84
  85 static char **hashtab = NULL;
  86
  87 static unsigned  max_hash_table_entries = 0;
  88
  89 void
  90 hash_init()
  91 {
  92   if(!hashIds) {
  93     /*NOTHING*/;
  94
  95   } else {
  96
  97   /* Create an initialised hash table */
  98   hashtab = (char **) calloc( hash_table_size, sizeof(char *) );
  99   if(hashtab == NULL)
 100     {
 101       fprintf(stderr,"Cannot allocate a hash table with %d entries -- insufficient memory\n",hash_table_size);
 102       exit(1);
 103     }
 104 #ifdef HSP_DEBUG
 105   fprintf(stderr,"hashtab = %x\n",hashtab);
 106 #endif
 107
 108   /* Allow no more than 90% occupancy -- Divide first to avoid overflows with BIG tables! */
 109   max_hash_table_entries = (hash_table_size / 10) * 9;
 110   }
 111 }
 112
 113 void
 114 print_hash_table()
 115 {
 116   if(hashIds)
 117     {
 118       unsigned i;
 119
 120       printf("%u ",hash_table_size);
 121
 122       for(i=0; i < hash_table_size; ++i)
 123         if(hashtab[i] != NULL)
 124           printf("(%u,%s) ",i,hashtab[i]);
 125     }
 126 }
 127
 128
 129 long int
 130 hash_index(ident)
 131   id ident;
 132 {
 133   return((char **) /* YURGH */ ident - hashtab);
 134 }
 135
 136
 137 /*
 138   The hash function.  Returns 0 for Null strings.
 139 */
 140
 141 static unsigned hash_fn(char *ident)
 142 {
 143   unsigned len = (unsigned) strlen(ident);
 144   unsigned res;
 145
 146   if(*ident == '\0')
 147     return( 0 );
 148
 149   /* does not work well for hash tables with more than 35K elements */
 150   res = (((unsigned)ident[0]*631)+((unsigned)ident[len/2-1]*217)+((unsigned)ident[len-1]*43)+len)
 151           % hash_table_size;
 152
 153 #ifdef HSP_DEBUG
 154   fprintf(stderr,"\"%s\" hashes to %d\n",ident,res);
 155 #endif
 156   return(res);
 157 }
 158
 159
 160 /*
 161   Install a literal identifier, such as "+" in hsparser.
 162   If we are not using hashing, just return the string.
 163 */
 164
 165 id
 166 install_literal(s)
 167   char *s;
 168 {
 169   return( hashIds? installid(s): s);
 170 }
 171
 172
 173 char *
 174 id_to_string(sp)
 175   id sp;
 176 {
 177   return( hashIds? *(char **)sp: (char *)sp );
 178 }
 179
 180 id
 181 installid(s)
 182   char *s;
 183 {
 184   unsigned hash, count;
 185
 186   if(!hashIds)
 187     return(xstrdup(s));
 188
 189   for(hash = hash_fn(s),count=0; count<max_hash_table_entries; ++hash,++count)
 190     {
 191       if (hash >= hash_table_size) hash = 0;
 192
 193       if(hashtab[hash] == NULL)
 194         {
 195           hashtab[hash] = xstrdup(s);
 196 #ifdef HSP_DEBUG
 197           fprintf(stderr,"New Hash Entry %x\n",(char *)&hashtab[hash]);
 198 #endif
 199           if ( count >= 100 ) {
 200             fprintf(stderr, "installid: %d collisions for %s\n", count, s);
 201           }
 202
 203           return((char *)&hashtab[hash]);
 204         }
 205
 206       if(strcmp(hashtab[hash],s) == 0)
 207         {
 208 #ifdef HSP_DEBUG
 209           fprintf(stderr,"Old Hash Entry %x (%s)\n",(char *)&hashtab[hash],hashtab[hash]);
 210 #endif
 211           if ( count >= 100 ) {
 212             fprintf(stderr, "installid: %d collisions for %s\n", count, s);
 213           }
 214
 215           return((char *)&hashtab[hash]);
 216         }
 217     }
 218   fprintf(stderr,"Hash Table Contains more than %d entries -- make larger?\n",max_hash_table_entries);
 219   exit(1);
 220 }
 221
 222
 223 /**********************************************************************
 224 *                                                                     *
 225 *                                                                     *
 226 *     Memory Allocation                                               *
 227 *                                                                     *
 228 *                                                                     *
 229 **********************************************************************/
 230
 231 /* Malloc with error checking */
 232
 233 char *
 234 xmalloc(length)
 235 unsigned length;
 236 {
 237     char *stuff = malloc(length);
 238
 239     if (stuff == NULL) {
 240         fprintf(stderr, "xmalloc failed on a request for %d bytes\n", length);
 241         exit(1);
 242     }
 243     return (stuff);
 244 }
 245
 246 char *
 247 xrealloc(ptr, length)
 248 char *ptr;
 249 unsigned length;
 250 {
 251     char *stuff = realloc(ptr, length);
 252
 253     if (stuff == NULL) {
 254         fprintf(stderr, "xrealloc failed on a request for %d bytes\n", length);
 255         exit(1);
 256     }
 257     return (stuff);
 258 }
 259
 260 /* Strdup with error checking */
 261
 262 char *
 263 xstrdup(s)
 264 char *s;
 265 {
 266     unsigned len = strlen(s);
 267     return xstrndup(s, len);
 268 }
 269
 270 /*
 271  * Strdup for possibly unterminated strings (e.g. substrings of longer strings)
 272  * with error checking.  Handles NULs as well.
 273  */
 274
 275 char *
 276 xstrndup(s, len)
 277 char *s;
 278 unsigned len;
 279 {
 280     char *p = xmalloc(len + 1);
 281
 282     bcopy(s, p, len);
 283     p[len] = '\0';
 284
 285     return (p);
 286 }