lang/pc/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.10 1994/06/24 12:36:09 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        <stb.h>
  21
  22 #include        "LLlex.h"
  23 #include        "def.h"
  24 #include        "type.h"
  25 #include        "idf.h"
  26 #include        "const.h"
  27 #include        "scope.h"
  28 #include        "main.h"
  29 #include        "node.h"
  30
  31 #define INCR_SIZE       64
  32
  33 extern int      proclevel;
  34
  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 struct 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->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         case T_LONG: {
 106                 arith l = full_mask[(int)tp->tp_size] & ~(1L << (tp->tp_size*8-1));
 107                 adds_db_str(sprint(buf,
 108                        "r%d;%ld;%ld",
 109                        tp->tp_dbindex,
 110                        (long) -l-1,
 111                        (long) l));
 112                 }
 113                 break;
 114         case T_REAL:
 115                 adds_db_str(sprint(buf,
 116                        "r%d;%ld;0",
 117                        tp->tp_dbindex,
 118                        (long)tp->tp_size));
 119                 break;
 120         case T_CHAR:
 121                 adds_db_str(sprint(buf,
 122                        "r%d;0;255",
 123                        tp->tp_dbindex));
 124                 break;
 125
 126         /* constructed types ... */
 127         case T_SUBRANGE:
 128                 adds_db_str(sprint(buf,
 129                        "r%d;%ld;%ld",
 130                        tp->next->tp_dbindex,
 131                        (long) tp->sub_lb,
 132                        (long) tp->sub_ub));
 133                 break;
 134         case T_POINTER:
 135                 if (tp->next) {
 136                         addc_db_str('*');
 137                         stb_type(tp->next, 0);
 138                         if (tp->tp_dbindex < 0) tp->tp_dbindex = -tp->tp_dbindex;
 139                 }
 140                 else {
 141                         tp->tp_dbindex = - ++stb_count;
 142                         adds_db_str(sprint(buf, "%d", -tp->tp_dbindex));
 143                 }
 144                 break;
 145         case T_SET:
 146                 addc_db_str('S');
 147                 stb_type(tp->next, 0);
 148                 adds_db_str(sprint(buf, ";%ld;%ld;", (long) tp->tp_size, 0L));
 149                 break;
 150         case T_ARRAY:
 151                 addc_db_str('a');
 152                 if (IsConformantArray(tp)) {
 153                         addc_db_str('r');
 154                         stb_type(tp->next, 0);
 155                         adds_db_str(sprint(buf, ";A%ld;Z%ld", (long) tp->arr_cfdescr, (long) tp->arr_cfdescr));
 156                 }
 157                 else {
 158                         stb_type(tp->next, 0);
 159                 }
 160                 addc_db_str(';');
 161                 stb_type(tp->arr_elem, 0);
 162                 break;
 163         case T_ENUMERATION:
 164                 addc_db_str('e');
 165                 {
 166                         register struct def     *edef = tp->enm_enums;
 167
 168                         while (edef) {
 169                                 adds_db_str(sprint(buf, "%s:%ld,",
 170                                         edef->df_idf->id_text,
 171                                         (long) edef->enm_val));
 172                                 edef = edef->enm_next;
 173                         }
 174                 }
 175                 addc_db_str(';');
 176                 break;
 177         case T_RECORD:
 178                 adds_db_str(sprint(buf, "s%ld", (long) tp->tp_size));
 179                 {
 180                         register struct def     *sdef = tp->rec_scope->sc_def;
 181
 182                         while (sdef) {
 183                                 adds_db_str(sdef->df_idf->id_text);
 184                                 addc_db_str(':');
 185                                 stb_type(sdef->df_type, 0);
 186                                 adds_db_str(sprint(buf,
 187                                         ",%ld,%ld;",
 188                                         sdef->fld_off*8L,
 189                                         sdef->df_type->tp_size*8L));
 190                                 sdef = sdef->df_nextinscope;
 191                         }
 192                 }
 193                 addc_db_str(';');
 194                 break;
 195         case T_PROCEDURE:
 196         case T_FUNCTION:
 197                 addc_db_str('Q');
 198                 stb_type(tp->next ? tp->next : void_type, 0);
 199                 {
 200                         register struct paramlist *p = tp->prc_params;
 201                         int paramcount = 0;
 202
 203                         while (p) {
 204                                 paramcount++;
 205                                 p = p->next;
 206                         }
 207                         adds_db_str(sprint(buf, ",%d;", paramcount));
 208                         p = tp->prc_params;
 209                         while (p) {
 210                                 addc_db_str(IsVarParam(p)
 211                                         ? 'v'
 212                                         : IsConformantArray(TypeOfParam(p))
 213                                                 ? 'i'
 214                                                 : 'p');
 215                                 stb_type(TypeOfParam(p), 0);
 216                                 addc_db_str(';');
 217                                 p = p->next;
 218                         }
 219                 }
 220                 break;
 221         case T_FILE:
 222                 addc_db_str('L');
 223                 stb_type(tp->next, 0);
 224                 break;
 225         case T_STRING:
 226                 addc_db_str('*');
 227                 stb_type(char_type, 0);
 228                 break;
 229         }
 230 }
 231
 232 stb_addtp(s, tp)
 233         char    *s;
 234         struct type  *tp;
 235 {
 236         create_db_str();
 237         adds_db_str(s);
 238         addc_db_str(':');
 239         addc_db_str('t');
 240         stb_type(tp, 1);
 241         addc_db_str(';');
 242         C_ms_stb_cst(db_str.base,
 243                      N_LSYM,
 244                      tp == void_type || tp->tp_size > 32767
 245                        ? 0
 246                        : (IsPacked(tp) ? (int) tp->tp_psize : (int)tp->tp_size),
 247                      (arith) 0);
 248 }
 249
 250 stb_string(df, kind)
 251         register struct def *df;
 252         long kind;
 253 {
 254         register struct type    *tp = df->df_type;
 255         char buf[64];
 256
 257         create_db_str();
 258         adds_db_str(df->df_idf->id_text);
 259         addc_db_str(':');
 260         if (kind == D_MODULE) {
 261                 adds_db_str(sprint(buf, "M%d;", df->prc_vis->sc_count));
 262                 C_ms_stb_pnam(db_str.base, N_FUN, proclevel, "_m_a_i_n");
 263                 return;
 264         }
 265         switch((int)kind) {
 266         case D_PROCEDURE:
 267         case D_FUNCTION:
 268                 adds_db_str(sprint(buf, "Q%d;", df->prc_vis->sc_count));
 269                 stb_type(tp->next ? tp->next : void_type, 0);
 270                 addc_db_str(';');
 271                 C_ms_stb_pnam(db_str.base, N_FUN, proclevel, df->df_idf->id_text);
 272                 {
 273                         register struct paramlist *p = tp->prc_params;
 274                         while (p) {
 275                                 stb_string(p->par_def, D_VARIABLE);
 276                                 p = p->next;
 277                         }
 278                 }
 279                 for (df = df->prc_vis->sc_scope->sc_def; df; df = df->df_nextinscope) {
 280                         if (df->df_kind == D_LBOUND ||
 281                             df->df_kind == D_UBOUND) {
 282                                 stb_string(df, df->df_kind);
 283                         }
 284                 }
 285                 break;
 286         case D_END:
 287         case D_PEND:
 288                 adds_db_str(sprint(buf, "E%d;", df->prc_vis->sc_count));
 289                 C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, (arith)0);
 290                 break;
 291         case D_VARIABLE:
 292                 if (df->df_flags & D_VARPAR) {  /* VAR parameter */
 293                         addc_db_str('v');
 294                         stb_type(tp, 0);
 295                         addc_db_str(';');
 296                         C_ms_stb_cst(db_str.base, N_PSYM, 0, df->var_off);
 297                 }
 298                 else if (df->df_flags & D_VALPAR) {     /* value parameter */
 299                         addc_db_str(IsConformantArray(tp)
 300                                 ? 'i'
 301                                 : 'p');
 302                         stb_type(tp, 0);
 303                         addc_db_str(';');
 304                         C_ms_stb_cst(db_str.base, N_PSYM, 0, df->var_off);
 305                 }
 306                 else if (!proclevel) {
 307                         addc_db_str('G');
 308                         stb_type(tp, 0);
 309                         addc_db_str(';');
 310                         C_ms_stb_dnam(db_str.base, N_LCSYM, 0, df->var_name, (arith) 0);
 311                 }
 312                 else {  /* local variable */
 313                         stb_type(tp, 1);        /* assign type num to avoid
 314                                                    difficult to parse string */
 315                         addc_db_str(';');
 316                         C_ms_stb_cst(db_str.base, N_LSYM, 0, df->var_off);
 317                 }
 318                 break;
 319         case D_LBOUND:
 320         case D_UBOUND:
 321                 addc_db_str(kind == D_LBOUND ? 'A' : 'Z');
 322                 addc_db_str('p');
 323                 stb_type(tp, 0);
 324                 addc_db_str(';');
 325                 C_ms_stb_cst(db_str.base, N_PSYM, 0, df->bnd_type->arr_cfdescr);
 326                 break;
 327         case D_TYPE:
 328                 addc_db_str('t');
 329                 stb_type(tp, 1);
 330                 addc_db_str(';');
 331                 C_ms_stb_cst(db_str.base,
 332                              N_LSYM,
 333                              tp == void_type || tp->tp_size > 32767
 334                                ? 0
 335                                : (IsPacked(tp) ? (int) tp->tp_psize : (int)tp->tp_size),
 336                              (arith) 0);
 337                 break;
 338         case D_CONST:
 339                 addc_db_str('c');
 340                 addc_db_str('=');
 341                 tp = BaseType(tp);
 342                 switch(tp->tp_fund) {
 343                 case T_INTEGER:
 344                 case T_LONG:
 345                 case T_POINTER:
 346                 case T_PROCEDURE:
 347                         adds_db_str(sprint(buf, "i%ld;", (long) df->con_const->nd_INT));
 348                         break;
 349                 case T_CHAR:
 350                         adds_db_str(sprint(buf, "c%ld;", (long) df->con_const->nd_INT));
 351                         break;
 352                 case T_REAL:
 353                         addc_db_str('r');
 354                         adds_db_str(df->con_const->nd_REL);
 355                         addc_db_str(';');
 356                         break;
 357                 case T_STRINGCONST: {
 358                         register char *p = df->con_const->nd_STR;
 359
 360                         adds_db_str("s'");
 361                         while (*p) {
 362                                 if (*p == '\'' || *p == '\\') {
 363                                         addc_db_str('\\');
 364                                 }
 365                                 addc_db_str(*p++);
 366                         }
 367                         adds_db_str("';");
 368                         }
 369                         break;
 370                 case T_ENUMERATION:
 371                         addc_db_str('e');
 372                         stb_type(tp, 0);
 373                         adds_db_str(sprint(buf, ",%ld;", (long) df->con_const->nd_INT));
 374                         break;
 375                 case T_SET: {
 376                         register int i;
 377
 378                         addc_db_str('S');
 379                         stb_type(tp, 0);
 380                         for (i = 0; i < tp->tp_size; i++) {
 381                                 adds_db_str(sprint(buf, ",%ld",
 382                                         (long) (df->con_const->nd_set[i/(int) word_size] >> (8*(i%(int)word_size)))&0377));
 383                         }
 384                         addc_db_str(';');
 385                         }
 386                         break;
 387                 }
 388                 C_ms_stb_cst(db_str.base,
 389                              N_LSYM,
 390                              tp->tp_size <= 32767 ? (int)tp->tp_size : 0,
 391                              (arith) 0);
 392                 break;
 393         }
 394 }
 395
 396 #endif /* DBSYMTAB */