ghc/runtime/profiling/Indexing.lc

   1 Only have cost centres etc if @PROFILING@ defined
   2
   3 \begin{code}
   4 #define NULL_REG_MAP    /* Not threaded */
   5 #include "../storage/SMinternal.h"  /* for ??? */
   6 #if defined (PROFILING)
   7 \end{code}
   8
   9 %************************************************************************
  10 %*                                                                      *
  11 \subsection[indexing]{Indexing Cost Centres and Closure Categories}
  12 %*                                                                      *
  13 %************************************************************************
  14
  15 See \tr{CostCentre.lh} for an overview.
  16
  17 \begin{code}
  18
  19 CostCentre *index_cc_table = 0;
  20 hash_t max_cc_no = DEFAULT_MAX_CC;
  21
  22 static hash_t index_cc_no = 0;
  23 static hash_t mask_cc;
  24
  25 hash_t
  26 init_index_cc()
  27 {
  28     hash_t max2 = 1, count;
  29
  30     if (index_cc_table) {
  31         if (max_cc_no != mask_cc + 1) {
  32             fprintf(stderr, "init_index_cc: twice %ld %ld\n", max_cc_no, mask_cc + 1);
  33             abort();
  34         }
  35         return mask_cc + 1;
  36     }
  37
  38     while (max2 < max_cc_no) max2 <<= 1;
  39
  40     max_cc_no = max2;
  41     mask_cc = max2 - 1;
  42
  43     index_cc_table = (CostCentre *) stgMallocBytes(max2 * sizeof(CostCentre), "init_index_cc");
  44
  45     for (count = 0; count < max2; count++)
  46         index_cc_table[count] = 0;
  47
  48     return max2;
  49 }
  50
  51 hash_t index_cc(cc)
  52     CostCentre cc;
  53 {
  54     if (cc->index_val == UNHASHED) {
  55
  56         hash_t h = hash_fixed((char *)&cc, sizeof(CostCentre)) & mask_cc;
  57         while (index_cc_table[h])
  58             h = (h + 1) & mask_cc;
  59
  60         cc->index_val = h;
  61         index_cc_table[h] = cc;
  62
  63         if (++index_cc_no > mask_cc - (mask_cc >> 6)) {
  64             fprintf(stderr, "Cost Centre hash table full: %ld entries (in %ld table)\n",
  65                     index_cc_no, mask_cc+1);
  66             fprintf(stderr, "   +RTS -z%c<size> option will increase the hash table size\n", CCchar);
  67             EXIT(EXIT_FAILURE);
  68         }
  69     }
  70     return cc->index_val;
  71 }
  72 \end{code}
  73
  74 \begin{code}
  75
  76 CostCentre *index_mod_table = 0;
  77 hash_t max_mod_no = DEFAULT_MAX_MOD;
  78
  79 static hash_t index_mod_no = 0;
  80 static hash_t mask_mod;
  81
  82 hash_t
  83 init_index_mod()
  84 {
  85     hash_t max2 = 1, count;
  86
  87     if (index_mod_table) {
  88         if (max_mod_no != mask_mod + 1) {
  89             fprintf(stderr, "init_index_mod: twice %ld %ld\n", max_mod_no, mask_mod + 1);
  90             abort();
  91         }
  92         return mask_mod + 1;
  93     }
  94
  95     while (max2 < max_mod_no) max2 <<= 1;
  96
  97     max_mod_no = max2;
  98     mask_mod = max2 - 1;
  99
 100     index_mod_table = (CostCentre *) stgMallocBytes(max2 * sizeof(CostCentre), "init_index_mod");
 101
 102     for (count = 0; count < max2; count++)
 103         index_mod_table[count] = 0;
 104
 105     return max2;
 106 }
 107
 108 hash_t
 109 index_mod(cc)
 110     CostCentre cc;
 111 {
 112     if (cc->index_val == UNHASHED) {
 113
 114         hash_t h = hash_str(cc->module) & mask_mod;
 115
 116         while (index_mod_table[h] && (strcmp(index_mod_table[h]->module, cc->module) != 0))
 117             h = (h + 1) & mask_mod;
 118
 119         cc->index_val = h;
 120         index_mod_table[h] = cc;  /* may replace existing cc at h index */
 121
 122         if (++index_mod_no > mask_mod - (mask_mod >> 6)) {
 123             fprintf(stderr, "Module hash table full: %ld entries (in %ld table)\n",
 124                     index_mod_no, mask_mod+1);
 125             fprintf(stderr, "   +RTS -z%c<size> option will increase the hash table size\n", MODchar);
 126             EXIT(EXIT_FAILURE);
 127         }
 128     }
 129     return cc->index_val;
 130 }
 131 \end{code}
 132
 133
 134 \begin{code}
 135
 136 CostCentre *index_grp_table = 0;
 137 hash_t max_grp_no = DEFAULT_MAX_GRP;
 138
 139 static hash_t index_grp_no = 0;
 140 static hash_t mask_grp;
 141
 142 hash_t
 143 init_index_grp()
 144 {
 145     hash_t max2 = 1, count;
 146
 147     if (index_grp_table) {
 148         if (max_grp_no != mask_grp + 1) {
 149             fprintf(stderr, "init_index_grp: twice %ld %ld\n", max_grp_no, mask_grp + 1);
 150             abort();
 151         }
 152         return mask_grp + 1;
 153     }
 154
 155     while (max2 < max_grp_no) max2 <<= 1;
 156
 157     max_grp_no = max2;
 158     mask_grp = max2 - 1;
 159
 160     index_grp_table = (CostCentre *) stgMallocBytes(max2 * sizeof(CostCentre), "init_index_grp");
 161
 162     for (count = 0; count < max2; count++)
 163         index_grp_table[count] = 0;
 164
 165     return max2;
 166 }
 167
 168 hash_t
 169 index_grp(cc)
 170     CostCentre cc;
 171 {
 172     if (cc->index_val == UNHASHED) {
 173
 174         hash_t h = hash_str(cc->group) & mask_grp;
 175
 176         while (index_grp_table[h] && (strcmp(index_grp_table[h]->group, cc->group) != 0))
 177             h = (h + 1) & mask_grp;
 178
 179         cc->index_val = h;
 180         index_grp_table[h] = cc;  /* may replace existing cc at h index */
 181
 182         if (++index_grp_no > mask_grp - (mask_grp >> 6)) {
 183             fprintf(stderr, "Group hash table full: %ld entries (in %ld table)\n",
 184                     index_grp_no, mask_grp+1);
 185             fprintf(stderr, "   +RTS -z%c<size> option will increase the hash table size\n", GRPchar);
 186             EXIT(EXIT_FAILURE);
 187         }
 188     }
 189     return cc->index_val;
 190 }
 191 \end{code}
 192
 193
 194 \begin{code}
 195
 196 ClCategory *index_descr_table = 0;
 197 hash_t max_descr_no = DEFAULT_MAX_DESCR;
 198
 199 static hash_t index_descr_no = 0;
 200 static hash_t mask_descr;
 201
 202 hash_t
 203 init_index_descr()
 204 {
 205     hash_t max2 = 1, count;
 206
 207     if (index_descr_table) {
 208         if (max_descr_no != mask_descr + 1) {
 209             fprintf(stderr, "init_index_descr: twice %ld %ld\n", max_descr_no, mask_descr + 1);
 210             abort();
 211         }
 212         return mask_descr + 1;
 213     }
 214
 215     while (max2 < max_descr_no) max2 <<= 1;
 216
 217     max_descr_no = max2;
 218     mask_descr = max2 - 1;
 219
 220     index_descr_table = (ClCategory *) stgMallocBytes(max2 * sizeof(ClCategory), "init_index_descr");
 221
 222     for (count = 0; count < max2; count++)
 223         index_descr_table[count] = 0;
 224
 225     return max2;
 226 }
 227
 228 hash_t
 229 index_descr(clcat)
 230     ClCategory clcat;
 231 {
 232     if (clcat->index_val == UNHASHED) {
 233
 234         hash_t h = hash_str(clcat->descr) & mask_descr;
 235
 236         while (index_descr_table[h] && (strcmp(index_descr_table[h]->descr, clcat->descr) != 0))
 237             h = (h + 1) & mask_descr;
 238
 239         clcat->index_val = h;
 240         index_descr_table[h] = clcat;  /* may replace existing clcat at h index */
 241
 242         if (++index_descr_no > mask_descr - (mask_descr >> 6)) {
 243             fprintf(stderr, "Closure Description hash table full: %ld entries (in %ld table)\n",
 244                     index_descr_no, mask_descr+1);
 245             fprintf(stderr, "   +RTS -z%c<size> option will increase the hash table size\n", DESCRchar);
 246             EXIT(EXIT_FAILURE);
 247         }
 248     }
 249     return clcat->index_val;
 250 }
 251 \end{code}
 252
 253
 254 \begin{code}
 255
 256 ClCategory *index_type_table = 0;
 257 hash_t max_type_no = DEFAULT_MAX_TYPE;
 258
 259 static hash_t index_type_no = 0;
 260 static hash_t mask_type;
 261
 262 hash_t
 263 init_index_type()
 264 {
 265     hash_t max2 = 1, count;
 266
 267     if (index_type_table) {
 268         if (max_type_no != mask_type + 1) {
 269             fprintf(stderr, "init_index_type: twice %ld %ld\n", max_type_no, mask_type + 1);
 270             abort();
 271         }
 272         return mask_type + 1;
 273     }
 274
 275     while (max2 < max_type_no) max2 <<= 1;
 276
 277     max_type_no = max2;
 278     mask_type = max2 - 1;
 279
 280     index_type_table = (ClCategory *) stgMallocBytes(max2 * sizeof(ClCategory), "init_index_type");
 281
 282     for (count = 0; count < max2; count++)
 283         index_type_table[count] = 0;
 284
 285     return max2;
 286 }
 287
 288 hash_t index_type(clcat)
 289     ClCategory clcat;
 290 {
 291     if (clcat->index_val == UNHASHED) {
 292
 293         hash_t h = hash_str(clcat->type) & mask_type;
 294
 295         while (index_type_table[h] && (strcmp(index_type_table[h]->type, clcat->type) != 0))
 296             h = (h + 1) & mask_type;
 297
 298         clcat->index_val = h;
 299         index_type_table[h] = clcat;  /* may replace existing clcat at h index */
 300
 301         if (++index_type_no > mask_type - (mask_type >> 6)) {
 302             fprintf(stderr, "Type Description hash table full: %ld entries (in %ld table)\n",
 303                     index_type_no, mask_type+1);
 304             fprintf(stderr, "   +RTS -z%c<size> option will increase the hash table size\n", TYPEchar);
 305             EXIT(EXIT_FAILURE);
 306         }
 307     }
 308     return clcat->index_val;
 309 }
 310 \end{code}
 311
 312 \begin{code}
 313 #endif /* PROFILING */
 314 \end{code}