util/grind/type.c

   1 /* $Id: type.c,v 1.13 1994/06/24 11:01:39 ceriel Exp $ */
   2
   3 /* Routines to create type structures */
   4
   5 #include <alloc.h>
   6 #include <assert.h>
   7
   8 #include "idf.h"
   9 #include "type.h"
  10 #include "symbol.h"
  11 #include "scope.h"
  12 #include "langdep.h"
  13 #include "expr.h"
  14 #include "misc.h"
  15
  16 p_type  int_type, char_type, short_type, long_type, bool_type;
  17 p_type  uint_type, uchar_type, ushort_type, ulong_type;
  18 p_type  void_type;
  19 p_type  float_type, double_type;
  20 p_type  string_type, address_type;
  21
  22 long    int_size = sizeof(int),
  23         char_size = 1,
  24         short_size = sizeof(short),
  25         long_size = sizeof(long),
  26         pointer_size = sizeof(char *);
  27
  28 long    float_size = sizeof(float),
  29         double_size = sizeof(double);
  30
  31 struct bounds {
  32         long low, high;
  33 };
  34
  35 static struct bounds ibounds[2] = {
  36         { -128, 127 },
  37         { -32768, 32767 }
  38 };
  39
  40 static struct bounds ubounds[2] = {
  41         { 0, 255 },
  42         { 0, 65535 }
  43 };
  44
  45 static long max_int[8], max_uns[8];
  46
  47 struct integer_types {
  48         long    maxval;
  49         p_type  type;
  50 };
  51
  52 static struct integer_types i_types[4];
  53 static struct integer_types u_types[4];
  54
  55 #define ufit(n, nb)     Xfit(n, nb, ubounds)
  56 #define ifit(n, nb)     Xfit(n, nb, ibounds)
  57 #define Xfit(n, nb, b)  ((n) >= (b)[(nb)-1].low && (n) <= (b)[(nb)-1].high)
  58
  59 /* Create a subrange type, but is it really a subrange? */
  60 p_type
  61 subrange_type(A, base_index, c1, c2, result_index)
  62   int *base_index, *result_index;
  63   long c1, c2;
  64 {
  65   int itself = 0;
  66   register p_type p;
  67   p_type base_type;
  68
  69   if (!A) {
  70         /* Subrange of itself is a special case ... */
  71         if (result_index &&
  72            result_index[0] == base_index[0] &&
  73            result_index[1] == base_index[1]) {
  74
  75                 /* c1 = 0 and c2 = 0 -> void */
  76                 if (c1 == 0 && c2 == 0) {
  77                         return void_type;
  78                 }
  79
  80                 if ((c1 == 0 || c1 == -128) && c2 == 127) {
  81                         return char_type;
  82                 }
  83
  84                 if (c1 == 0 && c2 == 255) {
  85                         return uchar_type;
  86                 }
  87
  88                 itself = 1;
  89         }
  90   }
  91
  92   if (itself) base_type = int_type; else base_type = *(tp_lookup(base_index));
  93
  94   if (! A) {
  95         /* c2 = 0 and c1 > 0 -> real */
  96         if (c2 == 0 && c1 > 0) {
  97                 if (c1 == float_size) return float_type;
  98                 return double_type;
  99         }
 100
 101         /* c1 = 0 and base_index indicates int_type or itself -> unsigned,
 102            c1 = -c2 - 1 and base_index indicates int_type or itself -> integer
 103         */
 104         if (itself || base_type == int_type) {
 105                 register struct integer_types *ip = 0;
 106                 if (c1 == 0) {
 107                         ip = &u_types[0];
 108                 }
 109                 else if (c1 == -c2 - 1) {
 110                         ip = &i_types[0];
 111                 }
 112                 if (ip) {
 113                         while (ip->maxval != 0 && ip->maxval != c2) ip++;
 114                         if (ip->maxval) return ip->type;
 115                 }
 116         }
 117   }
 118   /* if we get here, it actually is a subrange type */
 119   p = new_type();
 120   p->ty_class = T_SUBRANGE;
 121   p->ty_low = c1;
 122   p->ty_up = c2;
 123   p->ty_base = base_type;
 124   p->ty_A = A;
 125
 126   /* determine size of subrange type */
 127   p->ty_size = base_type->ty_size;
 128   if (!A && p->ty_base == uint_type) {
 129         if (ufit(p->ty_up, 1)) {
 130                 p->ty_size = 1;
 131         }
 132         else if (ufit(p->ty_up, (int)short_size)) {
 133                 p->ty_size = short_size;
 134         }
 135   }
 136   if (!A && p->ty_base == int_type) {
 137         if (ifit(p->ty_up, 1) && ifit(p->ty_low, 1)) {
 138                 p->ty_size = 1;
 139         }
 140         else if (ifit(p->ty_up, (int)short_size) &&
 141                  ifit(p->ty_low, (int)short_size)) {
 142                 p->ty_size = short_size;
 143         }
 144   }
 145
 146   return p;
 147 }
 148
 149 static long
 150 nel(tp)
 151   register p_type tp;
 152 {
 153   switch(tp->ty_class) {
 154   case T_SUBRANGE:
 155         if (tp->ty_A) return 0;
 156         if (tp->ty_low <= tp->ty_up) return tp->ty_up - tp->ty_low + 1;
 157         return tp->ty_low - tp->ty_up + 1;
 158   case T_UNSIGNED:
 159   case T_INTEGER:
 160         if (tp->ty_size == 1) return 256;
 161         if (tp->ty_size == 2) return 65536L;
 162         assert(0);
 163         break;
 164   case T_ENUM:
 165         return tp->ty_nenums;
 166   default:
 167         assert(0);
 168         break;
 169   }
 170   return 0;
 171 }
 172
 173 p_type
 174 array_type(bound_type, el_type)
 175   p_type bound_type, el_type;
 176 {
 177   register p_type tp = new_type();
 178
 179   tp->ty_class = T_ARRAY;
 180   tp->ty_index = bound_type;
 181   switch(bound_type->ty_class) {
 182   case T_SUBRANGE:
 183         if (bound_type->ty_A) break;
 184         tp->ty_lb = bound_type->ty_low;
 185         tp->ty_hb = bound_type->ty_up;
 186         break;
 187   case T_ENUM:
 188         tp->ty_lb = 0;
 189         tp->ty_hb = bound_type->ty_nenums-1;
 190         break;
 191   case T_UNSIGNED:
 192         tp->ty_lb = 0;
 193         tp->ty_hb = bound_type->ty_size == 1 ? 255 : 65535L;
 194         break;
 195   case T_INTEGER:
 196         tp->ty_lb = bound_type->ty_size == 1 ? -128 : -32768;
 197         tp->ty_hb = bound_type->ty_size == 1 ? 127 : 32767;
 198         break;
 199   }
 200   tp->ty_elements = el_type;
 201   tp->ty_size = (*currlang->arrayelsize)(el_type->ty_size) * nel(bound_type);
 202   return tp;
 203 }
 204
 205 p_type
 206 basic_type(fund, size)
 207   int   fund;
 208   long  size;
 209 {
 210   register p_type       p = new_type();
 211
 212   p->ty_class = fund;
 213   p->ty_size = size;
 214   return p;
 215 }
 216
 217 set_bounds(tp)
 218   register p_type       tp;
 219 {
 220   /* Determine the size and low of a set type */
 221   register p_type base = tp->ty_setbase;
 222
 223   if (base->ty_class == T_SUBRANGE) {
 224         tp->ty_size = (base->ty_up - base->ty_low + 7) >> 3;
 225         tp->ty_setlow = base->ty_low;
 226   }
 227   else if (base->ty_class == T_INTEGER) {
 228         tp->ty_size = (max_int[(int)base->ty_size] + 1) >>  2;
 229         tp->ty_setlow = -max_int[(int)base->ty_size] - 1;
 230   }
 231   else {
 232         assert(base->ty_class == T_UNSIGNED);
 233         tp->ty_size = (max_uns[(int)base->ty_size] + 1) >>  3;
 234         tp->ty_setlow = 0;
 235   }
 236 }
 237
 238 init_types()
 239 {
 240   register int i = 0;
 241   register long x = 0;
 242
 243   while (x >= 0) {
 244         i++;
 245         x = (x << 8) + 0377;
 246         max_uns[i] = x;
 247         max_int[i] = x & ~(1L << (8*i - 1));
 248   }
 249   int_type = basic_type(T_INTEGER, int_size);
 250   long_type = basic_type(T_INTEGER, long_size);
 251   short_type = basic_type(T_INTEGER, short_size);
 252   char_type = basic_type(T_INTEGER, char_size);
 253   uint_type = basic_type(T_UNSIGNED, int_size);
 254   ulong_type = basic_type(T_UNSIGNED, long_size);
 255   ushort_type = basic_type(T_UNSIGNED, short_size);
 256   uchar_type = basic_type(T_UNSIGNED, char_size);
 257   string_type = basic_type(T_STRING, 0L);
 258   address_type = basic_type(T_POINTER, pointer_size);
 259   void_type = basic_type(T_VOID, 0L);
 260   float_type = basic_type(T_REAL, float_size);
 261   double_type = basic_type(T_REAL, double_size);
 262
 263   i_types[0].maxval = max_int[(int)int_size]; i_types[0].type = int_type;
 264   i_types[1].maxval = max_int[(int)short_size]; i_types[1].type = short_type;
 265   i_types[2].maxval = max_int[(int)long_size]; i_types[2].type = long_type;
 266   u_types[0].maxval = max_uns[(int)int_size]; u_types[0].type = uint_type;
 267   u_types[1].maxval = max_uns[(int)short_size]; u_types[1].type = ushort_type;
 268   u_types[2].maxval = max_uns[(int)long_size]; u_types[2].type = ulong_type;
 269 }
 270
 271 /*
 272  * Some code to handle type indices, which are pairs of integers.
 273  * What we need is a two-dimensional array, but we don't know how large
 274  * it is going to be, so we use a list of rows instead.
 275  */
 276 static struct tp_index {
 277   unsigned      len;
 278   p_type        **row;
 279 } *list_row;
 280 static unsigned list_len;
 281
 282 #define NINCR 10
 283
 284 p_type *
 285 tp_lookup(type_index)
 286   int *type_index;
 287 {
 288   register int i;
 289   register struct tp_index *p;
 290
 291   while (type_index[0] >= list_len) {
 292         if (list_len) {
 293                 list_row = (struct tp_index *) Realloc((char *) list_row,
 294                                 (list_len += NINCR) * sizeof(struct tp_index));
 295         }
 296         else    list_row = (struct tp_index *)
 297                         Malloc((list_len = NINCR) * sizeof(struct tp_index));
 298         for (i = NINCR; i > 0; i--) {
 299                 list_row[list_len - i].len = 0;
 300         }
 301   }
 302   p = &list_row[type_index[0]];
 303   while (type_index[1] >= p->len) {
 304         int indx = p->len/NINCR;
 305         if (p->len) {
 306                 p->row = (p_type **) Realloc((char *) p->row,
 307                                 (unsigned) (indx + 1) * sizeof(p_type *));
 308         }
 309         else    p->row = (p_type **) Malloc(sizeof(p_type *));
 310         p->len += NINCR;
 311         p->row[indx] = (p_type *) Malloc(NINCR * sizeof(p_type));
 312         for (i = NINCR-1; i >= 0; i--) {
 313                 p->row[indx][i] = 0;
 314         }
 315   }
 316   return &(p->row[type_index[1]/NINCR][type_index[1]%NINCR]);
 317 }
 318
 319 clean_tp_tab()
 320 {
 321   if (list_len) {
 322         register int i = list_len;
 323
 324         while (--i >= 0) {
 325                 register int j = list_row[i].len;
 326                 if (j) {
 327                         while (--j > 0) {
 328                                 p_type p = list_row[i].row[j/NINCR][j%NINCR];
 329                                 if (p && p->ty_class == 0) {
 330                                         error("%s: incomplete type (%d,%d)",
 331                                               FileScope->sc_definedby->sy_idf->id_text,
 332                                               i,
 333                                               j);
 334                                 }
 335                         }
 336                         j = list_row[i].len;
 337                         while (j > 0) {
 338                                 free((char *) list_row[i].row[j/NINCR-1]);
 339                                 j -= NINCR;
 340                         }
 341                         free((char *) list_row[i].row);
 342                 }
 343         }
 344         free((char *) list_row);
 345         list_len = 0;
 346         list_row = 0;
 347   }
 348 }
 349
 350 end_literal(tp, maxval)
 351   register p_type tp;
 352   long maxval;
 353 {
 354   tp->ty_literals = (struct literal *)
 355         Realloc((char *) tp->ty_literals,
 356                 tp->ty_nenums * sizeof(struct literal));
 357   if (ufit(maxval, 1)) tp->ty_size = 1;
 358   else if (ufit(maxval, (int)short_size)) tp->ty_size = short_size;
 359   else tp->ty_size = int_size;
 360   if (! bool_type) bool_type = tp;
 361 }
 362
 363 long
 364 param_size(t, v)
 365   int   v;
 366   p_type t;
 367 {
 368   if (v == 'i' || v == 'v') {
 369         /* addresss; only exception is a conformant array, which also
 370            takes a descriptor.
 371         */
 372         if (currlang == m2_dep &&
 373             t->ty_class == T_ARRAY &&
 374             t->ty_index->ty_class == T_SUBRANGE &&
 375             t->ty_index->ty_A) {
 376                 return pointer_size + 3 * int_size;
 377         }
 378         return pointer_size;
 379   }
 380   return ((t->ty_size + int_size - 1) / int_size) * int_size;
 381 }
 382
 383 add_param_type(v, s)
 384   int   v;              /* 'v' or 'i' for address, 'p' for value */
 385   p_symbol s;           /* parameter itself */
 386 {
 387   register p_scope sc = base_scope(s->sy_scope);
 388   register p_type prc_type;
 389
 390   if (! sc) return;
 391   prc_type = sc->sc_definedby->sy_type;
 392   assert(prc_type->ty_class == T_PROCEDURE);
 393
 394   if (v == 'Z') {
 395         prc_type->ty_nbparams += 3 * int_size;
 396         return;
 397   }
 398   prc_type->ty_nparams++;
 399   prc_type->ty_params = (struct param *) Realloc((char *) prc_type->ty_params,
 400                                 (unsigned)prc_type->ty_nparams * sizeof(struct param));
 401   prc_type->ty_params[prc_type->ty_nparams - 1].par_type = s->sy_type;
 402   prc_type->ty_params[prc_type->ty_nparams - 1].par_kind = v;
 403   prc_type->ty_params[prc_type->ty_nparams - 1].par_off = s->sy_name.nm_value;
 404   prc_type->ty_nbparams += param_size(s->sy_type, v);
 405 }
 406
 407 /* Compute the size of a parameter of dynamic size
 408 */
 409
 410 long
 411 compute_size(tp, AB)
 412   p_type        tp;
 413   char          *AB;
 414 {
 415   long  low, high;
 416
 417   assert(tp->ty_class == T_ARRAY);
 418   assert(tp->ty_index->ty_class == T_SUBRANGE);
 419   assert(tp->ty_index->ty_A != 0);
 420
 421   if (tp->ty_index->ty_A & 1) {
 422         low = get_int(AB+tp->ty_index->ty_low, int_size, T_INTEGER);
 423   } else low = tp->ty_index->ty_low;
 424   tp->ty_lb = low;
 425   if (tp->ty_index->ty_A & 2) {
 426         high = get_int(AB+tp->ty_index->ty_up, int_size, T_INTEGER);
 427   } else if (tp->ty_index->ty_A & 0200) {
 428         high = get_int(AB+tp->ty_index->ty_up, int_size, T_INTEGER);
 429         high += get_int(AB+tp->ty_index->ty_up+int_size, int_size, T_INTEGER);
 430   } else high = tp->ty_index->ty_up;
 431   tp->ty_hb = high;
 432   return (high - low + 1) * tp->ty_elements->ty_size;
 433 }