lang/m2/comp/stab.c

   1 /*
   2  * (c) copyright 1990 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3  * See the copyright notice in the ACK home directory, in the file "Copyright".
   4  *
   5  * Author: Ceriel J.H. Jacobs
   6  */
   7
   8 /* D E B U G G E R   S Y M B O L   T A B L E */
   9
  10 /* $Id: stab.c,v 1.14 1995/12/19 09:30:46 ceriel Exp $ */
  11
  12 #include "dbsymtab.h"
  13
  14 #ifdef DBSYMTAB
  15
  16 #include        <alloc.h>
  17 #include        <em_arith.h>
  18 #include        <em_label.h>
  19 #include        <em_code.h>
  20 #include        <flt_arith.h>
  21 #include        <stb.h>
  22
  23 #include        "LLlex.h"
  24 #include        "def.h"
  25 #include        "type.h"
  26 #include        "idf.h"
  27 #include        "scope.h"
  28 #include        "main.h"
  29
  30 extern int      gdb_flag;
  31
  32 #define INCR_SIZE       64
  33
  34 extern int      proclevel;
  35 extern char     *sprint();
  36
  37 static struct db_str {
  38         unsigned        sz;
  39         char            *base;
  40         char            *currpos;
  41 } db_str;
  42
  43 static
  44 create_db_str()
  45 {
  46         if (! db_str.base) {
  47                 db_str.base = Malloc(INCR_SIZE);
  48                 db_str.sz = INCR_SIZE;
  49         }
  50         db_str.currpos = db_str.base;
  51 }
  52
  53 static
  54 addc_db_str(c)
  55         int     c;
  56 {
  57         int df = db_str.currpos - db_str.base;
  58         if (df >= db_str.sz-1) {
  59                 db_str.sz += INCR_SIZE;
  60                 db_str.base = Realloc(db_str.base, db_str.sz);
  61                 db_str.currpos = db_str.base + df;
  62         }
  63         *db_str.currpos++ = c;
  64         *db_str.currpos = '\0';
  65 }
  66
  67 static
  68 adds_db_str(s)
  69         char    *s;
  70 {
  71         while (*s) addc_db_str(*s++);
  72 }
  73
  74 static
  75 stb_type(tp, assign_num)
  76         register t_type *tp;
  77 {
  78         char buf[128];
  79         static int      stb_count;
  80
  81         if (tp->tp_dbindex > 0) {
  82                 adds_db_str(sprint(buf, "%d", tp->tp_dbindex));
  83                 return;
  84         }
  85         if (tp->tp_dbindex < 0) {
  86                 if (tp->tp_next == 0) {
  87                         adds_db_str(sprint(buf, "%d", -tp->tp_dbindex));
  88                         return;
  89                 }
  90                 tp->tp_dbindex = -tp->tp_dbindex;
  91         }
  92         if (tp->tp_dbindex == 0 && assign_num) {
  93                 tp->tp_dbindex = ++stb_count;
  94         }
  95         if (tp->tp_dbindex > 0) {
  96                 adds_db_str(sprint(buf, "%d=", tp->tp_dbindex));
  97         }
  98         if (tp == void_type) {
  99                 adds_db_str(sprint(buf, "%d", tp->tp_dbindex));
 100                 return;
 101         }
 102         switch(tp->tp_fund) {
 103         /* simple types ... */
 104         case T_INTEGER:
 105                 adds_db_str(sprint(buf,
 106                        "r%d;%ld;%ld",
 107                        tp->tp_dbindex,
 108                        (long) min_int[(int)tp->tp_size],
 109                        (long) max_int[(int)tp->tp_size]));
 110                 break;
 111         case T_CARDINAL:
 112                 adds_db_str(sprint(buf,
 113                        "r%d;0;-1",
 114                        tp->tp_dbindex));
 115                 break;
 116         case T_REAL:
 117                 adds_db_str(sprint(buf,
 118                        "r%d;%ld;0",
 119                        tp->tp_dbindex,
 120                        (long)tp->tp_size));
 121                 break;
 122         case T_CHAR:
 123                 adds_db_str(sprint(buf,
 124                        "r%d;0;255",
 125                        tp->tp_dbindex));
 126                 break;
 127         case T_WORD:
 128                 if (tp->tp_size == word_size) {
 129                         adds_db_str(sprint(buf,
 130                                 "r%d;0;-1",
 131                                 tp->tp_dbindex));
 132                 }
 133                 else {
 134                         adds_db_str(sprint(buf,
 135                                 "r%d;0;255",
 136                                 tp->tp_dbindex));
 137                 }
 138                 break;
 139
 140         /* constructed types ... */
 141         case T_SUBRANGE:
 142                 adds_db_str(sprint(buf,
 143                        "r%d;%ld;%ld",
 144                        tp->tp_next->tp_dbindex,
 145                        (long) tp->sub_lb,
 146                        (long) tp->sub_ub));
 147                 break;
 148         case T_EQUAL:
 149                 stb_type(tp->tp_next, 0);
 150                 if (tp->tp_dbindex < 0) tp->tp_dbindex = -tp->tp_dbindex;
 151                 break;
 152         case T_HIDDEN:
 153                 if (DefinitionModule && CurrVis == Defined->mod_vis) {
 154                         tp->tp_dbindex = - ++stb_count;
 155                         adds_db_str(sprint(buf, "%d", -tp->tp_dbindex));
 156                 }
 157                 else {
 158                         /* ??? what to do here??? */
 159                         addc_db_str('*');
 160                         stb_type(void_type, 0);
 161                         /* ??? this certainly is not correct */
 162                 }
 163                 break;
 164         case T_POINTER:
 165                 if (tp->tp_next) {
 166                         addc_db_str('*');
 167                         stb_type(tp->tp_next, 0);
 168                         if (tp->tp_dbindex < 0) tp->tp_dbindex = -tp->tp_dbindex;
 169                 }
 170                 else {
 171                         tp->tp_dbindex = - ++stb_count;
 172                         adds_db_str(sprint(buf, "%d", -tp->tp_dbindex));
 173                 }
 174                 break;
 175         case T_SET:
 176                 addc_db_str('S');
 177                 stb_type(tp->tp_next, 0);
 178                 adds_db_str(sprint(buf, ";%ld;%ld;", tp->tp_size, tp->set_low));
 179                 break;
 180         case T_ARRAY:
 181                 addc_db_str('a');
 182                 if (IsConformantArray(tp)) {
 183                         addc_db_str('r');
 184                         stb_type(tp->tp_next, 0);
 185                         adds_db_str(sprint(buf, ";0;A%ld", tp->arr_high));
 186                 }
 187                 else {
 188                         stb_type(tp->tp_next, 0);
 189                 }
 190                 addc_db_str(';');
 191                 stb_type(tp->arr_elem, 0);
 192                 break;
 193         case T_ENUMERATION:
 194                 addc_db_str('e');
 195                 {
 196                         register struct def     *edef = tp->enm_enums;
 197
 198                         while (edef) {
 199                                 adds_db_str(sprint(buf, "%s:%ld,",
 200                                         edef->df_idf->id_text,
 201                                         edef->enm_val));
 202                                 edef = edef->enm_next;
 203                         }
 204                 }
 205                 addc_db_str(';');
 206                 break;
 207         case T_RECORD:
 208                 adds_db_str(sprint(buf, "s%ld", tp->tp_size));
 209                 {
 210                         register struct def     *sdef = tp->rec_scope->sc_def;
 211
 212                         while (sdef) {
 213                                 adds_db_str(sdef->df_idf->id_text);
 214                                 addc_db_str(':');
 215                                 stb_type(sdef->df_type, 0);
 216                                 adds_db_str(sprint(buf,
 217                                         ",%ld,%ld;",
 218                                         sdef->fld_off*8,
 219                                         sdef->df_type->tp_size*8));
 220                                 sdef = sdef->df_nextinscope;
 221                         }
 222                 }
 223                 addc_db_str(';');
 224                 break;
 225         case T_PROCEDURE:
 226                 if (gdb_flag) {
 227                         addc_db_str('f');
 228                         stb_type(tp->tp_next ? tp->tp_next : void_type, 0);
 229                         break;
 230                 }
 231                 addc_db_str('Q');
 232                 stb_type(tp->tp_next ? tp->tp_next : void_type, 0);
 233                 {
 234                         register struct paramlist *p = tp->prc_params;
 235                         int paramcount = 0;
 236
 237                         while (p) {
 238                                 paramcount++;
 239                                 p = p->par_next;
 240                         }
 241                         adds_db_str(sprint(buf, ",%d;", paramcount));
 242                         p = tp->prc_params;
 243                         while (p) {
 244                                 addc_db_str(IsVarParam(p)
 245                                         ? 'v'
 246                                         : IsConformantArray(TypeOfParam(p))
 247                                                 ? 'i'
 248                                                 : 'p');
 249                                 stb_type(TypeOfParam(p), 0);
 250                                 addc_db_str(';');
 251                                 p = p->par_next;
 252                         }
 253                 }
 254         }
 255 }
 256
 257 stb_addtp(s, tp)
 258         char    *s;
 259         t_type  *tp;
 260 {
 261         create_db_str();
 262         adds_db_str(s);
 263         addc_db_str(':');
 264         addc_db_str('t');
 265         stb_type(tp, 1);
 266         addc_db_str(';');
 267         C_ms_stb_cst(db_str.base,
 268                      N_LSYM,
 269                      tp == void_type || tp->tp_size >= max_int[2]
 270                        ? 0
 271                        : (int)tp->tp_size,
 272                      (arith) 0);
 273 }
 274
 275 stb_string(df, kind)
 276         register t_def *df;
 277 {
 278         register t_type *tp = df->df_type;
 279         char buf[64];
 280
 281         create_db_str();
 282         adds_db_str(df->df_idf->id_text);
 283         addc_db_str(':');
 284         switch(kind) {
 285         case D_MODULE:
 286                 if (gdb_flag) {
 287                         addc_db_str('F');
 288                         stb_type(void_type, 0);
 289                 }
 290                 else {
 291                         adds_db_str(sprint(buf, "M%d;", df->mod_vis->sc_count));
 292                 }
 293                 C_ms_stb_pnam(db_str.base, N_FUN, gdb_flag ? 0 : proclevel, df->mod_vis->sc_scope->sc_name);
 294                 break;
 295         case D_PROCEDURE:
 296                 if (gdb_flag) {
 297                         addc_db_str('f');
 298                 }
 299                 else    adds_db_str(sprint(buf, "Q%d;", df->prc_vis->sc_count));
 300                 stb_type(tp->tp_next ? tp->tp_next : void_type, 0);
 301                 if (gdb_flag) {
 302                         t_scopelist *sc = df->prc_vis;
 303                         sc = enclosing(sc);
 304                         while (sc) {
 305                                 t_def *d = sc->sc_scope->sc_definedby;
 306
 307                                 if (d && d->df_kind == D_PROCEDURE) {
 308                                         adds_db_str(sprint(buf, ",%s", d->df_idf->id_text));
 309                                         break;
 310                                 }
 311                                 sc = enclosing(sc);
 312                         }
 313                 }
 314                 else addc_db_str(';');
 315                 C_ms_stb_pnam(db_str.base, N_FUN, gdb_flag ? 0 : proclevel, df->prc_vis->sc_scope->sc_name);
 316                 break;
 317         case D_END:
 318                 if (gdb_flag) break;
 319                 adds_db_str(sprint(buf, "E%d;", df->mod_vis->sc_count));
 320                 C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, (arith) 0);
 321                 break;
 322         case D_PEND:
 323                 if (gdb_flag) break;
 324                 adds_db_str(sprint(buf, "E%d;", df->prc_vis->sc_count));
 325                 C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, (arith) 0);
 326                 break;
 327         case D_VARIABLE:
 328                 if (DefinitionModule && CurrVis != Defined->mod_vis) break;
 329                 if (df->df_flags & D_VARPAR) {  /* VAR parameter */
 330                         addc_db_str('v');
 331                         stb_type(tp, 0);
 332                         addc_db_str(';');
 333                         C_ms_stb_cst(db_str.base, N_PSYM, 0, df->var_off);
 334                 }
 335                 else if (df->df_flags & D_VALPAR) {     /* value parameter */
 336                         addc_db_str(IsConformantArray(tp)
 337                                 ? 'i'
 338                                 : 'p');
 339                         stb_type(tp, 0);
 340                         addc_db_str(';');
 341                         C_ms_stb_cst(db_str.base, N_PSYM, 0, df->var_off);
 342                 }
 343                 else if (!proclevel ||
 344                          (df->df_flags & D_ADDRGIVEN)) {        /* global */
 345                         int knd = N_LCSYM;
 346                         if (df->df_flags & D_EXPORTED) {
 347                                 knd = N_GSYM;
 348                                 addc_db_str('G');
 349                         }
 350                         else {
 351                                 addc_db_str('S');
 352                         }
 353                         stb_type(tp, 0);
 354                         addc_db_str(';');
 355                         if (df->df_flags & D_ADDRGIVEN) {
 356                                 C_ms_stb_cst(db_str.base, knd, 0, df->var_off);
 357                         }
 358                         else {
 359                                 C_ms_stb_dnam(db_str.base, knd, 0, df->var_name, (arith) 0);
 360                         }
 361                 }
 362                 else {  /* local variable */
 363                         stb_type(tp, 1);        /* assign type num to avoid
 364                                                    difficult to parse string */
 365                         addc_db_str(';');
 366                         C_ms_stb_cst(db_str.base, N_LSYM, 0, df->var_off);
 367                 }
 368                 break;
 369         case D_TYPE:
 370                 addc_db_str('t');
 371                 stb_type(tp, 1);
 372                 addc_db_str(';');
 373                 C_ms_stb_cst(db_str.base,
 374                              N_LSYM,
 375                              tp == void_type || tp->tp_size >= max_int[2]
 376                                ? 0
 377                                : (int)tp->tp_size,
 378                              (arith) 0);
 379                 break;
 380         case D_CONST:
 381                 if (DefinitionModule && CurrVis != Defined->mod_vis) break;
 382                 addc_db_str('c');
 383                 addc_db_str('=');
 384                 tp = BaseType(tp);
 385                 switch(tp->tp_fund) {
 386                 case T_INTEGER:
 387                 case T_INTORCARD:
 388                 case T_CARDINAL:
 389                 case T_WORD:
 390                 case T_POINTER:
 391                 case T_PROCEDURE:
 392                         adds_db_str(sprint(buf, "i%ld;", df->con_const.TOK_INT));
 393                         break;
 394                 case T_CHAR:
 395                         adds_db_str(sprint(buf, "c%ld;", df->con_const.TOK_INT));
 396                         break;
 397                 case T_REAL:
 398                         addc_db_str('r');
 399                         if (! df->con_const.TOK_RSTR) {
 400                                 char buf2[FLT_STRLEN];
 401
 402                                 flt_flt2str(&df->con_const.TOK_RVAL, buf2, FLT_STRLEN);
 403                                 adds_db_str(buf2);
 404                         }
 405                         else adds_db_str(df->con_const.TOK_RSTR);
 406                         addc_db_str(';');
 407                         break;
 408                 case T_STRING: {
 409                         register char *p = df->con_const.TOK_STR;
 410
 411                         adds_db_str("s'");
 412                         while (*p) {
 413                                 if (*p == '\'' || *p == '\\') {
 414                                         addc_db_str('\\');
 415                                 }
 416                                 addc_db_str(*p++);
 417                         }
 418                         adds_db_str("';");
 419                         }
 420                         break;
 421                 case T_ENUMERATION:
 422                         addc_db_str('e');
 423                         stb_type(tp, 0);
 424                         adds_db_str(sprint(buf, ",%ld;", df->con_const.TOK_INT));
 425                         break;
 426                 case T_SET: {
 427                         register int i;
 428
 429                         addc_db_str('S');
 430                         stb_type(tp, 0);
 431                         for (i = 0; i < tp->tp_size; i++) {
 432                                 adds_db_str(sprint(buf, ",%ld",
 433                                         (df->con_const.tk_data.tk_set[i/(int) word_size] >> (8*(i%(int)word_size)))&0377));
 434                         }
 435                         addc_db_str(';');
 436                         }
 437                         break;
 438                 }
 439                 C_ms_stb_cst(db_str.base,
 440                              N_LSYM,
 441                              tp->tp_size < max_int[2] ? (int)tp->tp_size : 0,
 442                              (arith) 0);
 443                 break;
 444         }
 445 }
 446
 447 #endif /* DBSYMTAB */