util/ego/cf/cf.c

   1 /* $Id: cf.c,v 1.10 1994/06/24 10:20:12 ceriel Exp $ */
   2 /*
   3  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   4  * See the copyright notice in the ACK home directory, in the file "Copyright".
   5  */
   6 /*  C O N T R O L   F L O W
   7  *
   8  *  M A I N   R O U T I N E
   9  */
  10
  11 #include <stdio.h>
  12 #include <em_mnem.h>
  13 #include <em_pseu.h>
  14 #include <em_spec.h>
  15 #include <em_flag.h>
  16 #include <em_mes.h>
  17 #include "../share/types.h"
  18 #include "../share/debug.h"
  19 #include "../share/map.h"
  20 #include "../share/files.h"
  21 #include "../share/global.h"
  22 #include "../share/alloc.h"
  23 #include "../share/lset.h"
  24 #include "../share/cset.h"
  25 #include "../share/get.h"
  26 #include "../share/put.h"
  27 #include "../share/def.h"
  28 #include "cf.h"
  29 #include "cf_succ.h"
  30 #include "cf_idom.h"
  31 #include "cf_loop.h"
  32
  33 #define newcfbx()       (bext_p) newstruct(bext_cf)
  34 #define oldcfbx(x)      oldstruct(bext_cf,x)
  35
  36 extern char em_flag[];
  37
  38 STATIC cset     lpi_set;        /* set of procedures used in LPI instruction */
  39 STATIC cset     cai_set;        /* set of all procedures doing a CAI */
  40
  41
  42 /* The procedure getbblocks reads the EM textfile and
  43  * partitions every procedure into a number of basic blocks.
  44  */
  45
  46 #define LABEL0          0
  47 #define LABEL           1
  48 #define NORMAL          2
  49 #define JUMP            3
  50 #define END             4
  51 #define AFTERPRO        5
  52 #define INIT            6
  53
  54
  55 /* These global variables are used by getbblocks and nextblock. */
  56
  57 STATIC bblock_p b, *bp;  /* b is the current basic block, bp is
  58                           * the address where the next block has
  59                           * to be linked.
  60                           */
  61 STATIC line_p   lnp, *lp; /* lnp is the current line, lp is
  62                            * the address where the next line
  63                            * has to be linked.
  64                            */
  65 STATIC short state;     /* We use a finite state machine with the
  66                          * following states:
  67                          *  LABEL0: after the first (successive)
  68                          *          instruction label.
  69                          *  LABEL1:  after at least two successive
  70                          *          instruction labels.
  71                          *  NORMAL: after a normal instruction.
  72                          *  JUMP:   after a branch (conditional,
  73                          *          unconditional or CSA/CSB).
  74                          *  END:    after an END pseudo
  75                          *  AFTERPRO: after we've read a PRO pseudo
  76                          *  INIT:   initial state
  77                          */
  78
  79
  80 STATIC nextblock()
  81 {
  82         /* allocate a new basic block structure and
  83          * set b, bp and lp.
  84          */
  85
  86         b = *bp = freshblock();
  87         bp = &b->b_next;
  88         b->b_start = lnp;
  89         b->b_succ = Lempty_set();
  90         b->b_pred = Lempty_set();
  91         b->b_extend = newcfbx(); /* basic block extension for CF */
  92         b->b_extend->bx_cf.bx_bucket = Lempty_set();
  93         b->b_extend->bx_cf.bx_semi = 0;
  94         lp = &lnp->l_next;
  95 #ifdef TRACE
  96         fprintf(stderr,"new basic block, id = %d\n",lastbid);
  97 #endif
  98 }
  99
 100
 101 STATIC short kind(lnp)
 102         line_p lnp;
 103 {
 104         /* determine if lnp is a label, branch, end or otherwise */
 105
 106         short instr;
 107         byte  flow;
 108
 109         if ((instr = INSTR(lnp)) == op_lab) return (short) LABEL;
 110         if (instr == ps_end) return (short) END;
 111         if (instr > sp_lmnem) return (short) NORMAL; /* pseudo */
 112         if ((flow = (em_flag[instr-sp_fmnem] & EM_FLO)) == FLO_C ||
 113              flow == FLO_T) return (short) JUMP; /* conditional/uncond. jump */
 114         return (short) NORMAL;
 115 }
 116
 117
 118 STATIC line_p doread_line(p_out)
 119         proc_p *p_out;
 120 {
 121         /* read a line, and check pseudos for procedure addresses */
 122
 123         register line_p lnp = read_line(p_out);
 124
 125         if (lnp && TYPE(lnp) == OPLIST && INSTR(lnp) != ps_mes) {
 126                 register arg_p arg = ARG(lnp);
 127
 128                 while (arg) {
 129                         if (arg->a_type == ARGPROC) {
 130                                 Cadd(arg->a_a.a_proc->p_id, &lpi_set);
 131                                 arg->a_a.a_proc->p_flags1 |= PF_LPI;
 132                         }
 133                         arg = arg->a_next;
 134                 }
 135         }
 136         return lnp;
 137 }
 138
 139 STATIC bool getbblocks(fp,kind_out,n_out,g_out,l_out)
 140         FILE *fp;
 141         short *kind_out;
 142         short *n_out;
 143         bblock_p *g_out;
 144         line_p *l_out;
 145 {
 146         bblock_p head = (bblock_p) 0;
 147         line_p headl = (line_p) 0;
 148
 149         curproc = (proc_p) 0;
 150         /* curproc will get a value when we encounter a PRO pseudo.
 151          * If there is no such pseudo, we're reading only data
 152          * declarations or messages (outside any proc.).
 153          */
 154         curinp = fp;
 155         lastbid = (block_id) 0;  /* block identier */
 156         state = INIT;   /* initial state */
 157         bp = &head;
 158
 159         for (;;) {
 160 #ifdef TRACE
 161                 fprintf(stderr,"state = %d\n",state);
 162 #endif
 163                 switch(state) {
 164                         case LABEL0:
 165                                 nextblock();
 166                                 /* Fall through !! */
 167                         case LABEL:
 168                                 lbmap[INSTRLAB(lnp)] = b;
 169                                 /* The lbmap table contains for each
 170                                  * label_id the basic block of that label.
 171                                  */
 172                                 lnp = doread_line(&curproc);
 173                                 state = kind(lnp);
 174                                 if (state != END) {
 175                                         *lp = lnp;
 176                                         lp = &lnp->l_next;
 177                                 }
 178                                 break;
 179                         case NORMAL:
 180                                 lnp = doread_line(&curproc);
 181                                 if ( (state = kind(lnp)) == LABEL) {
 182                                         /* If we come accross a label
 183                                          * here, it must be the beginning
 184                                          * of a new basic block.
 185                                          */
 186                                         state = LABEL0;
 187                                 } else {
 188                                         if (state != END) {
 189                                                 *lp = lnp;
 190                                                 lp = &lnp->l_next;
 191                                         }
 192                                 }
 193                                 break;
 194                         case JUMP:
 195                                 lnp = doread_line(&curproc);
 196                                 /* fall through ... */
 197                         case AFTERPRO:
 198                                 switch(state = kind(lnp)) {
 199                                         case LABEL:
 200                                                 state = LABEL0;
 201                                                 break;
 202                                         case JUMP:
 203                                         case NORMAL:
 204                                                 nextblock();
 205                                                 break;
 206                                 }
 207                                 break;
 208                         case END:
 209                                 *lp = lnp;
 210 #ifdef TRACE
 211                                 fprintf(stderr,"at end of proc, %d blocks\n",lastbid);
 212 #endif
 213                                 if (head == (bblock_p) 0) {
 214                                         *kind_out = LDATA;
 215                                         *l_out = headl;
 216                                 } else {
 217                                         *kind_out = LTEXT;
 218                                         *g_out = head;
 219                                         *n_out = (short) lastbid;
 220                                         /* number of basic blocks */
 221                                 }
 222                                 return TRUE;
 223                         case INIT:
 224                                 lnp = doread_line(&curproc);
 225                                 if (feof(curinp)) return FALSE;
 226                                 if (INSTR(lnp) == ps_pro) {
 227                                         state = AFTERPRO;
 228                                 } else {
 229                                         state = NORMAL;
 230                                         headl = lnp;
 231                                         lp = &lnp->l_next;
 232                                 }
 233                                 break;
 234                 }
 235         }
 236 }
 237
 238
 239 STATIC interproc_analysis(p)
 240         proc_p p;
 241 {
 242         /* Interprocedural analysis of a procedure p determines:
 243          *  - all procedures called by p (the 'call graph')
 244          *  - the set of objects changed by p (directly)
 245          *  - whether p does a load-indirect (loi,lof etc.)
 246          *  - whether p does a store-indirect (sti, stf etc.)
 247          * The changed/used variables information will be
 248          * transitively closed, i.e. if P calls Q and Q changes
 249          * a variable X, the P changes X too.
 250          * (The same applies for used variables and for use/store
 251          * indirect).
 252          * The transitive closure will be computed by main
 253          * after all procedures have been processed.
 254          */
 255
 256         bblock_p b;
 257         line_p   lnp;
 258         bool inloop;
 259
 260         /* Allocate memory for structs and sets */
 261
 262         p->p_use = newuse();
 263         p->p_change = newchange();
 264         p->p_change->c_ext = Cempty_set(olength);
 265         p->p_calling = Cempty_set(plength);
 266
 267         for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
 268            inloop = (Lnrelems(b->b_loops) > 0);
 269            for (lnp = b->b_start; lnp != (line_p) 0; lnp = lnp->l_next) {
 270                 /* for all instructions of p do */
 271                 switch(INSTR(lnp)) {
 272                    case op_cal:
 273                         Cadd(PROC(lnp)->p_id, &p->p_calling);
 274                         /* add called proc to p_calling */
 275                         if (inloop) {
 276                                 CALLED_IN_LOOP(PROC(lnp));
 277                         }
 278                         break;
 279                    case op_cai:
 280                         Cadd(p->p_id,&cai_set);
 281                         break;
 282                    case op_lpi:
 283                         Cadd(PROC(lnp)->p_id, &lpi_set);
 284                         /* All procedures that have their names used
 285                          * in an lpi instruction, may be called via
 286                          * a cai instruction.
 287                          */
 288                         PROC(lnp)->p_flags1 |= PF_LPI;
 289                         break;
 290                    case op_ste:
 291                    case op_sde:
 292                    case op_ine:
 293                    case op_dee:
 294                    case op_zre:
 295                         Cadd(OBJ(lnp)->o_id, &p->p_change->c_ext);
 296                         /* Add changed object to c_ext */
 297                         break;
 298                    case op_lil:
 299                    case op_lof:
 300                    case op_loi:
 301                    case op_los:
 302                    case op_lar:
 303                         p->p_use->u_flags |= UF_INDIR;
 304                         /* p does a load-indirect */
 305                         break;
 306                    case op_sil:
 307                    case op_stf:
 308                    case op_sti:
 309                    case op_sts:
 310                    case op_sar:
 311                         p->p_change->c_flags |= CF_INDIR;
 312                         /* p does a store-indirect */
 313                         break;
 314                    case op_blm:
 315                    case op_bls:
 316                         p->p_use->u_flags |= UF_INDIR;
 317                         p->p_change->c_flags |= CF_INDIR;
 318                         /* p does both */
 319                         break;
 320                    case op_mon:
 321                         printf("mon not yet implemented\n");
 322                         break;
 323                    case op_lxl:
 324                    case op_lxa:
 325                         curproc->p_flags1 |= PF_ENVIRON;
 326                         break;
 327                    case op_lor:
 328                    case op_str:
 329                         if (SHORT(lnp) == 0) {
 330                                 curproc->p_flags1 |= PF_ENVIRON;
 331                         }
 332                         break;
 333                    case ps_mes:
 334                         if (aoff(ARG(lnp),0) == ms_gto) {
 335                                 ENTERED_WITH_GTO(curproc);
 336                         }
 337                         break;
 338                 }
 339            }
 340         }
 341 }
 342
 343
 344 STATIC cf_cleanproc(p)
 345         proc_p p;
 346 {
 347         /* Remove the extended data structures of p */
 348
 349         register bblock_p b;
 350         register Lindex pi;
 351         loop_p lp;
 352
 353         for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
 354                 oldcfbx(b->b_extend);
 355         }
 356         for (pi = Lfirst(p->p_loops); pi != (Lindex) 0; pi = Lnext(pi,
 357                                                         p->p_loops)) {
 358                 lp = (loop_p) Lelem(pi);
 359                 oldcflpx(lp->lp_extend);
 360         }
 361 }
 362
 363
 364
 365 #define CH_CHANGE_INDIR(ch)     ((ch->c_flags & CF_INDIR) != 0)
 366 #define USE_INDIR(us)           ((us->u_flags & UF_INDIR) != 0)
 367 #define CALLS_UNKNOWN(p)        (p->p_flags1 & (byte) PF_CALUNKNOWN)
 368 #define ENVIRON(p)              (p->p_flags1 & (byte) PF_ENVIRON)
 369
 370
 371 STATIC bool add_info(q,p)
 372         proc_p q,p;
 373 {
 374         /* Determine the consequences for used/changed variables info
 375          * of the fact that p calls q. If e.g. q changes a variable X
 376          * then p changes this variable too. This routine is an
 377          * auxiliary routine of the transitive closure process.
 378          * The returned value indicates if there was any change in
 379          * the information of p.
 380          */
 381
 382         change_p chp, chq;
 383         use_p    usp, usq;
 384         bool     diff = FALSE;
 385
 386         chp = p->p_change;
 387         chq = q->p_change;
 388         usp = p->p_use;
 389         usq = q->p_use;
 390
 391         if (!BODY_KNOWN(q)) {
 392                 /* q is a procedure of which the body is not available
 393                  * as EM text.
 394                  */
 395                 if (CALLS_UNKNOWN(p)) {
 396                         return FALSE;
 397                         /* p already called an unknown procedure */
 398                 } else {
 399                         p->p_flags1 |= PF_CALUNKNOWN;
 400                         return TRUE;
 401                 }
 402         }
 403         if (CALLS_UNKNOWN(q)) {
 404                 /* q calls a procedure of which the body is not available
 405                  * as EM text.
 406                  */
 407                 if (!CALLS_UNKNOWN(p)) {
 408                         p->p_flags1 |= PF_CALUNKNOWN;
 409                         diff = TRUE;
 410                 }
 411         }
 412         if (IS_CALLED_IN_LOOP(p) && !IS_CALLED_IN_LOOP(q)) {
 413                 CALLED_IN_LOOP(q);
 414                 diff = TRUE;
 415         }
 416         if (!Cis_subset(chq->c_ext, chp->c_ext)) {
 417                 /* q changes global variables (objects) that
 418                 * p did not (yet) change. Add all variables
 419                 * changed by q to the c_ext set of p.
 420                 */
 421                 Cjoin(chq->c_ext, &chp->c_ext);
 422                 diff = TRUE;
 423         }
 424         if (CH_CHANGE_INDIR(chq) && !CH_CHANGE_INDIR(chp)) {
 425                 /* q does a change-indirect (sil etc.)
 426                  * and p did not (yet).
 427                  */
 428                 chp->c_flags |= CF_INDIR;
 429                 diff = TRUE;
 430         }
 431         if (USE_INDIR(usq) && !USE_INDIR(usp)) {
 432                 /* q does a use-indirect (lil etc.)
 433                  * and p dis not (yet).
 434                  */
 435                 usp->u_flags |= UF_INDIR;
 436                 diff = TRUE;
 437         }
 438         if (ENVIRON(q) && !ENVIRON(p)) {
 439                 /* q uses or changes local variables in its
 440                  * environment while p does not (yet).
 441                  */
 442                 p->p_flags1 |= PF_ENVIRON;
 443                 diff = TRUE;
 444         }
 445         return diff;
 446 }
 447
 448
 449
 450 STATIC trans_clos(head)
 451         proc_p head;
 452 {
 453         /* Compute the transitive closure of the used/changed
 454          * variable information.
 455          */
 456
 457         register proc_p p,q;
 458         Cindex i;
 459         bool changes = TRUE;
 460
 461         while(changes) {
 462                 changes = FALSE;
 463                 for (p = head; p != (proc_p) 0; p = p->p_next) {
 464                    if (!BODY_KNOWN(p)) continue;
 465                    for (i = Cfirst(p->p_calling); i != (Cindex) 0;
 466                                                 i = Cnext(i,p->p_calling)) {
 467                         q = pmap[Celem(i)];
 468                         if (add_info(q,p)) {
 469                                 changes = TRUE;
 470                         }
 471                    }
 472                 }
 473         }
 474 }
 475
 476
 477
 478
 479 indir_calls()
 480 {
 481         Cindex i;
 482         proc_p p;
 483
 484         for (i = Cfirst(cai_set); i != (Cindex) 0; i = Cnext(i,cai_set)) {
 485                 p = pmap[Celem(i)];  /* p does a CAI */
 486                 Cjoin(lpi_set, &p->p_calling);
 487         }
 488         Cdeleteset(lpi_set);
 489         Cdeleteset(cai_set);
 490 }
 491
 492
 493
 494 main(argc,argv)
 495         int argc;
 496         char *argv[];
 497 {
 498         FILE *f, *f2, *gf2;  /* The EM input, EM output, basic block output */
 499         bblock_p g;
 500         short n, kind;
 501         line_p l;
 502
 503         linecount = 0;
 504         fproc = getptable(pname); /* proc table */
 505         fdblock = getdtable(dname);  /* data block table */
 506         lpi_set = Cempty_set(plength);
 507         cai_set = Cempty_set(plength);
 508         if ((f = fopen(lname,"r")) == NULL) {
 509                 error("cannot open %s", lname);
 510         }
 511         if ((f2 = fopen(lname2,"w")) == NULL) {
 512                 error("cannot open %s", lname2);
 513         }
 514         if ((gf2 = fopen(bname2,"w")) == NULL) {
 515                 error("cannot open %s",bname2);
 516         }
 517         while (getbblocks(f,&kind,&n,&g,&l)) {
 518                 /* read EM text of one unit and
 519                  * (if it is a procedure)
 520                  * partition it into n basic blocks.
 521                  */
 522                 if (kind == LDATA) {
 523                         putunit(LDATA,(proc_p) 0,l,gf2,f2);
 524                 } else {
 525                         curproc->p_start = g;
 526                         /* The global variable curproc points to the
 527                          * current procedure. It is set by getbblocks
 528                          */
 529                         control_flow(g); /* compute pred and succ */
 530                         dominators(g,n); /* compute immediate dominators */
 531                         loop_detection(curproc); /* compute loops */
 532                         interproc_analysis(curproc);
 533                         /* Interprocedural analysis */
 534                         cf_cleanproc(curproc);
 535                         putunit(LTEXT,curproc,(line_p) 0,gf2,f2);
 536                         /* output control flow graph + text */
 537                 }
 538         }
 539         fclose(f);
 540         fclose(f2);
 541         fclose(gf2);
 542         indir_calls();
 543         trans_clos(fproc);
 544         /* Compute transitive closure of used/changed
 545          * variables information for every procedure.
 546          */
 547         if ((f = fopen(dname2,"w")) == NULL) {
 548                 error("cannot open %s",dname2);
 549         }
 550         putdtable(fdblock,f);
 551         if ((f = fopen(pname2,"w")) == NULL) {
 552                 error("cannot open %s",pname2);
 553         }
 554         putptable(fproc,f,TRUE);
 555         exit(0);
 556 }