nsz Git - libfirm/blob - ir/ana2/typalise.c

   1 /* -*- c -*- */
   2
   3 /*
   4  * Project:     libFIRM
   5  * File name:   ir/ana2/pto.c
   6  * Purpose:     Pto
   7  * Author:      Florian
   8  * Modified by:
   9  * Created:     Mon 18 Oct 2004
  10  * CVS-ID:      $Id$
  11  * Copyright:   (c) 1999-2004 Universität Karlsruhe
  12  * Licence:     This file is protected by GPL -  GNU GENERAL PUBLIC LICENSE.
  13  */
  14
  15
  16 # ifdef HAVE_CONFIG_H
  17 #  include <config.h>
  18 # endif
  19
  20 # include "typalise.h"
  21
  22 # ifndef TRUE
  23 #  define TRUE 1
  24 #  define FALSE 0
  25 # endif /* not defined TRUE */
  26
  27 # include <assert.h>
  28
  29 # include "irnode.h"
  30 # include "irgwalk.h"
  31 # include "xmalloc.h"
  32
  33
  34 /*
  35   Local Globals
  36 */
  37
  38 static long ta_id = 0;
  39
  40 /*
  41   Local Protos
  42 */
  43 static typalise_t *typalise_proj (ir_node*);
  44
  45
  46 /*
  47   Ctors, Dtors for typalise_t-s
  48 */
  49 static typalise_t *ta_exact (type *tp)
  50 {
  51   typalise_t *ta = (typalise_t*) xmalloc (sizeof (typalise_t));
  52   ta->kind = type_exact;
  53   ta->res.type = tp;
  54   ta->id = ta_id ++;
  55
  56   assert (is_class_type (tp));
  57
  58   return (ta);
  59 }
  60
  61 static typalise_t *ta_types (lset_t *set)
  62 {
  63   typalise_t *ta = (typalise_t*) xmalloc (sizeof (typalise_t));
  64   ta->kind = type_types;
  65   ta->res.types = set;
  66   ta->id = ta_id ++;
  67
  68   return (ta);
  69 }
  70
  71 static typalise_t *ta_type (type *tp)
  72 {
  73   typalise_t *ta = (typalise_t*) xmalloc (sizeof (typalise_t));
  74   ta->kind = type_type;
  75   ta->res.type = tp;
  76   ta->id = ta_id ++;
  77
  78   assert (is_class_type (tp));
  79
  80   return (ta);
  81 }
  82
  83 static void ta_delete (typalise_t *ta)
  84 {
  85   if (type_types == ta->kind) {
  86     lset_destroy (ta->res.types);
  87     ta->res.types = NULL;
  88   } else {
  89     ta->res.type = NULL;
  90   }
  91
  92   ta->kind = type_invalid;
  93
  94   free (ta);
  95 }
  96
  97 /*
  98   Helpers for inheritance, overwriting and stuff
  99 */
 100 /**
 101    Find out whether otype is a subtype of stype.
 102    Return non-zero iff otype is a subtype of stype.
 103 */
 104 static int is_subtype (type *otype, type *stype)
 105 {
 106   int n_sub = get_class_n_subtypes (stype);
 107   int is_sub = FALSE;
 108   int i;
 109
 110   if (otype == stype) {
 111     return (TRUE);
 112   }
 113
 114   for (i = 0; (!is_sub) && (i < n_sub); i ++) {
 115     type *sub = get_class_subtype (stype, i);
 116
 117     is_sub |= is_subtype (otype, sub);
 118   }
 119
 120
 121   return (is_sub);
 122 }
 123
 124
 125 /**
 126     Compute the closure of all subtypes of otype (including otype
 127     itself)
 128 */
 129 static void _collect_subtypes (type *otype, lset_t *set)
 130 {
 131   lset_insert (set, otype);
 132
 133   int n_sub = get_class_n_subtypes (otype);
 134   int i;
 135
 136   for (i = 0; i < n_sub; i ++) {
 137     type *sub = get_class_subtype (otype, i);
 138
 139     _collect_subtypes (sub, set);
 140   }
 141 }
 142
 143 static lset_t *subtype_closure (type *otype)
 144 {
 145   lset_t *set = lset_create ();
 146
 147   _collect_subtypes (otype, set);
 148
 149   return (set);
 150 }
 151
 152 /**
 153    Helper method for get_owner_types
 154 */
 155 static void _collect_owner_types (entity *method, ir_graph *graph, lset_t *tps)
 156 {
 157   /* search DOWNwards in clazz hierarchy */
 158
 159   if ((peculiarity_description == get_entity_peculiarity (method)) ||
 160       (peculiarity_inherited   == get_entity_peculiarity (method))) {
 161     lset_insert (tps, get_entity_owner (method));
 162   } else if (peculiarity_existent == get_entity_peculiarity (method)) {
 163     ir_graph *ex_graph = get_entity_irg (method);
 164
 165     if ((NULL == ex_graph) || (ex_graph == graph)) {
 166       /* wtf? they define the same graph again? well, whatever: */
 167       lset_insert (tps, get_entity_owner (method));
 168     } else {
 169       /* aha: they define a new graph. can't have that, so bail out */
 170       return;
 171     }
 172   }
 173
 174   int n_over = get_entity_n_overwrittenby (method);
 175   int i;
 176
 177   for (i = 0; i < n_over; i ++) {
 178     entity *ometh = get_entity_overwrittenby (method, i);
 179
 180     _collect_owner_types (ometh, graph, tps);
 181   }
 182 }
 183
 184
 185 /**
 186    Collect all classes that use the given implementation of a method.
 187 */
 188 static lset_t *get_owner_types (ir_graph *graph)
 189 {
 190   lset_t *tps = lset_create ();
 191   entity *meth = get_irg_entity (graph);
 192
 193   _collect_owner_types (meth, graph, tps);
 194
 195   return (tps);
 196 }
 197
 198 /**
 199    Return a list containing all types of 'set' which are a subtype of 'type'.
 200 */
 201 static lset_t *filter_for_type (lset_t *set, type *stype)
 202 {
 203   type *curs = (type*) lset_first (set);
 204   lset_t *lset = lset_create ();
 205
 206   while (NULL != curs) {
 207     if (is_subtype (curs, stype)) {
 208       lset_insert (lset, curs);
 209     }
 210
 211     curs = lset_next (set);
 212   }
 213
 214   return (lset);
 215 }
 216
 217 /*
 218  Handle typalise_t-s
 219 */
 220 /**
 221     Join 'one' and 'two'; both args are deallocated, result is freshly
 222     allocated.
 223 */
 224 static typalise_t *ta_join (typalise_t *one, typalise_t *two)
 225 {
 226   typalise_t *res = NULL;
 227
 228   switch (one->kind) {
 229   case (type_invalid): { /* shut up, gcc */ }
 230   case (type_exact): {
 231     switch (two->kind) {
 232     case (type_invalid): { /* shut up, gcc */ }
 233     case (type_exact): {
 234       if (one->res.type == two->res.type) {
 235         res = one;
 236       } else {
 237         lset_t *set = lset_create ();
 238         lset_insert (set, one->res.type);
 239         lset_insert (set, two->res.type);
 240         res = ta_types (set);
 241
 242         ta_delete (one);
 243       }
 244
 245       ta_delete (two);
 246     } break;
 247     case (type_types): {
 248       lset_insert (two->res.types, one->res.type);
 249       ta_delete (one);
 250
 251       res = two;
 252     } break;
 253     case (type_type): {
 254       if (is_subtype (one->res.type, two->res.type)) {
 255         ta_delete (one);
 256         res = two;
 257       } else {
 258         lset_t *closure = subtype_closure (two->res.type);
 259         lset_insert (closure, one->res.type);
 260
 261         ta_delete (two);
 262
 263         res = one;
 264       }
 265     } break;
 266     }
 267   } break;
 268   case (type_types): {
 269     switch (two->kind) {
 270     case (type_invalid): { /* shut up, gcc */ }
 271     case (type_exact): {
 272       res = ta_join (two, one);
 273     } break;
 274     case (type_types): {
 275       lset_insert_all (one->res.types, two->res.types);
 276       ta_delete (two);
 277
 278       res = one;
 279     } break;
 280     case (type_type): {
 281       lset_t *closure = subtype_closure (two->res.type);
 282       lset_append (one->res.types, closure);
 283
 284       ta_delete (two);
 285
 286       res = one;
 287     } break;
 288     }
 289   } break;
 290   case (type_type): {
 291     switch (two->kind) {
 292     case (type_invalid): { /* shut up, gcc */ }
 293     case (type_exact): {
 294       res = ta_join (two, one);
 295     } break;
 296     case (type_types): {
 297       res = ta_join (two, one);
 298     } break;
 299     case (type_type): {
 300       type *one_type = one->res.type;
 301       type *two_type = two->res.type;
 302
 303       if (is_subtype (one_type, two_type)) {
 304         ta_delete (one);
 305         res = two;
 306       } else if (is_subtype (two_type, one_type)) {
 307         ta_delete (two);
 308         res = one;
 309       } else {
 310         lset_t *one_closure = subtype_closure (one->res.type);
 311         lset_t *two_closure = subtype_closure (two->res.type);
 312
 313         lset_append (one_closure, two_closure);
 314
 315         ta_delete (two);
 316         ta_delete (one);
 317
 318         res = ta_types (one_closure);
 319       }
 320     } break;
 321     }
 322   } break;
 323   }
 324
 325   assert (res && "no result");
 326
 327   return (res);
 328 }
 329
 330
 331 # ifdef SHUT_UP_GCC
 332 static const char *ta_name (typalise_t *ta)
 333 {
 334   /* # define BUF_SIZE 1024 */
 335   static char buf [BUF_SIZE];
 336
 337   int len = sprintf (buf, "[%d] ", ta->id);
 338
 339   switch (ta->kind) {
 340   case (type_invalid): { /* shut up, gcc */ }
 341   case (type_exact): {
 342     len += sprintf (buf+len, "only ");
 343     strncat (buf, get_type_name (ta->res.type), BUF_SIZE);
 344   } break;
 345   case (type_types): {
 346     len += sprintf (buf+len, "one_of ");
 347
 348     type *iter = lset_first (ta->res.types);
 349
 350     int size = BUF_SIZE - len - 1;
 351     while ((NULL != iter) && (0 < size)) {
 352       char *dest = strncat (buf, get_type_name (iter), size);
 353       size = (dest - buf);
 354
 355       iter = lset_next (ta->res.types);
 356     }
 357   } break;
 358   case (type_type): {
 359     len += sprintf (buf+len, "poly ");
 360     strncat (buf, get_type_name (ta->res.type), BUF_SIZE);
 361   } break;
 362   }
 363
 364   return (buf);
 365   /* # undef BUF_SIZE */
 366 }
 367 # endif /* SHUT_UP_GCC */
 368
 369 /**
 370    Find out whether the given clazz uses the given implementation of a
 371    method.  Presumably, this is because clazz inherits the graph as
 372    the implementation for a method.
 373 */
 374 static int uses_graph (type *clazz, entity *meth, ir_graph *graph)
 375 {
 376   type *g_clazz = get_entity_owner (meth);
 377
 378   if (g_clazz == clazz) {
 379     return (TRUE);
 380   }
 381
 382   if (peculiarity_existent == get_entity_peculiarity (meth)) {
 383     ir_graph *g_graph = get_entity_irg (meth);
 384
 385     if (g_graph != graph) {
 386       return (FALSE);
 387     }
 388   }
 389
 390   /* else inherited or description */
 391   int use = FALSE;
 392   int i;
 393   int n_over = get_entity_n_overwrittenby (meth); /* DOWN-wards */
 394
 395   for (i = 0; (i < n_over) && (!use); i ++) {
 396     entity *over = get_entity_overwrittenby (meth, i);
 397
 398     use |= uses_graph (clazz, over, graph);
 399   }
 400
 401   return (use);
 402 }
 403
 404 /**
 405    Check whether the given typalise_t includes the given type.
 406 */
 407 static int ta_supports (typalise_t *ta, ir_graph *graph)
 408 {
 409   switch (ta->kind) {
 410   case (type_invalid): { /* shut up, gcc */ }
 411   case (type_exact): {
 412     int res = FALSE;
 413     lset_t *tps = get_owner_types (graph);
 414
 415     if (lset_contains (tps, ta->res.type)) {
 416       res = TRUE;
 417     }
 418
 419     lset_destroy (tps);
 420
 421     return (res);
 422   }
 423   case (type_type): {
 424     entity *meth = get_irg_entity (graph);
 425     type *tp = get_entity_owner (meth);
 426     int res = is_subtype (tp, ta->res.type);
 427
 428     if (res) {
 429       return (TRUE);
 430     } else {
 431       res = uses_graph (ta->res.type, meth, graph);
 432     }
 433
 434     return (res);
 435   }
 436   case (type_types): {
 437     type *tp = get_entity_owner (get_irg_entity (graph));
 438
 439     return (lset_contains (ta->res.types, tp));
 440   }
 441   }
 442
 443   assert (0 && "invalid ta");
 444 }
 445
 446
 447 /* =========== WHAT ELSE ? =========== */
 448
 449 /*
 450   Helper to typalise (ir_node*)
 451 */
 452 /**
 453     Find an approximation to the given proj node's value's types
 454 */
 455 static typalise_t *typalise_proj (ir_node *proj)
 456 {
 457   typalise_t *res = NULL;
 458   ir_node *proj_in = get_Proj_pred (proj);
 459
 460   if (iro_Proj  == get_irn_opcode (proj_in)) {
 461     /* fprintf (stdout, "\tProj (Proj)\n"); */
 462
 463     proj_in = get_Proj_pred (proj_in);
 464     if (iro_Start == get_irn_opcode (proj_in)) {
 465       long n = get_Proj_proj (proj);
 466       if (1 == n) {
 467         /* yay proj this */
 468         ir_graph *graph = get_irn_irg (proj);
 469         entity   *meth  = get_irg_entity (graph);
 470         type     *tp    = get_entity_owner (meth);
 471
 472         /* res = ta_exact (tp); */
 473         res = ta_type (tp);     /* TODO */
 474       } else {
 475         /* ugh proj arg */
 476         /* hey, even 'filtering' this NULL by the select of the actual
 477            call is probably as "precise" as anything: */
 478         return (NULL);
 479       }
 480     } else if (iro_Call == get_irn_opcode (proj_in)) {
 481       /* call result ... 'whatever' */
 482       ir_node *call_ptr = get_Call_ptr (proj_in);
 483
 484       res = typalise (call_ptr);
 485     } else {
 486       fprintf (stdout, "\n Proj (Proj (%s)) not handled\n",
 487                get_op_name (get_irn_op (proj_in)));
 488       assert (0);
 489     }
 490   } else {
 491     opcode op = get_irn_opcode (proj_in);
 492     if ((iro_Load != op) && (iro_Alloc != op) && (iro_Call != op)) {
 493       fprintf (stdout, "\n Proj (%s) not handled\n",
 494                get_op_name (get_irn_op (proj_in)));
 495       assert (0);
 496     }
 497     res = typalise (proj_in);      /* everything else */
 498     /* Proj (Load), Proj (New), Proj (Call) */
 499   }
 500
 501   return (res);
 502 }
 503
 504
 505
 506 /*
 507   Public Interface
 508 */
 509 /**
 510    Given a set of graphs and a typalise_t,  return the method (s) in
 511    the set that are supported by the typalise_t.  Also, deallocates
 512    the given set.
 513 */
 514 lset_t *filter_for_ta (lset_t *set, typalise_t *ta)
 515 {
 516   lset_t *res = lset_create ();
 517   ir_graph *curs = (ir_graph*) lset_first (set);
 518
 519   while (NULL != curs) {
 520     if (ta_supports (ta, curs)) {
 521       lset_insert (res, curs);
 522     }
 523
 524     curs = lset_next (set);
 525   }
 526
 527   lset_destroy (set);
 528
 529   return (res);
 530 }
 531
 532 /**
 533    For the given ptr, do a quick check about what (class) types may be
 534    brought along on it.
 535 */
 536 typalise_t *typalise (ir_node *node)
 537 {
 538   opcode op = get_irn_opcode (node);
 539   typalise_t *res = NULL;
 540
 541   switch (op) {
 542   case (iro_Cast): {
 543     /* casts always succeed */
 544     typalise_t *ta = NULL;
 545     type *tp = get_Cast_type (node);
 546
 547     if (is_pointer_type (tp)) {
 548       tp = get_pointer_points_to_type (tp);
 549     }
 550     assert (is_class_type (tp));
 551
 552     ta = typalise (get_Cast_op (node));
 553
 554     if (NULL == ta) {           /* no type found */
 555       ta = ta_type (tp);
 556     } else if (type_exact == ta->kind) { /* one type found */
 557       /* nothing (maybe check cast? */
 558     } else if (type_type == ta->kind) { /* some types found */
 559       if (is_subtype (tp, ta->res.type)) {
 560         ta->res.type = tp;     /* assume cast is correct */
 561       } else {
 562         /* should assert (is_subtype (ta->res.type, tp)) */
 563       }
 564     } else if (type_types == ta->kind) {
 565       lset_t *ftp = filter_for_type (ta->res.types, tp);
 566       lset_destroy (ta->res.types);
 567       ta->res.types = ftp;
 568     }
 569
 570     res = ta;
 571   } break;
 572
 573   case (iro_Proj): {
 574     res = typalise_proj (node);
 575   } break;
 576
 577   case (iro_Load): {
 578     /* presumably it's call (load (ptr)) we're analyzing. */
 579     ir_node *load_ptr = get_Load_ptr (node);
 580
 581     res = typalise (load_ptr);
 582   } break;
 583
 584   case (iro_Sel): {
 585     /* FILTER */
 586     /* it's call (sel (ptr)) or load (sel (ptr)) */
 587     entity *ent = get_Sel_entity (node);
 588     type *tp = get_entity_type (ent);
 589
 590     if (is_method_type (tp)) {
 591       tp = get_entity_type (ent);
 592       tp = get_method_res_type (tp, 0);
 593
 594       if (is_pointer_type (tp)) {
 595         tp = get_pointer_points_to_type (tp);
 596       }
 597
 598       res = ta_type (tp);
 599     } else if (is_class_type (tp)) {
 600       tp = get_entity_type (ent);
 601
 602       if (is_pointer_type (tp)) {
 603         tp = get_pointer_points_to_type (tp);
 604       }
 605
 606       res = ta_type (tp);
 607     } else if (is_pointer_type (tp)) {
 608       tp = get_pointer_points_to_type (tp);
 609       res = ta_type (tp);
 610     } else {
 611       assert (0 && "select not handled");
 612     }
 613   } break;
 614
 615   case (iro_Phi): {
 616     int n_ins = get_irn_arity (node);
 617     int i;
 618     ir_node *phi_in = NULL;
 619     typalise_t *ta = NULL;
 620     /* assert (0 && "Do we ever get here?"); */ /* apparently, we do. */
 621
 622     for (i = 0; i < n_ins; i ++) {
 623       phi_in = get_irn_n (node, i);
 624       ta = (NULL == ta) ? typalise (phi_in) : ta_join (ta, typalise (phi_in));
 625     }
 626
 627     res = ta;
 628   } break;
 629
 630   case (iro_Alloc): {
 631     type *type = get_Alloc_type (node);
 632     res = ta_exact (type);
 633   } break;
 634
 635   case (iro_Call): {
 636     /* presumably call (sel (proj (call))) */
 637     ir_node *ptr = get_Call_ptr (node);
 638     entity *meth = NULL;
 639     if (iro_Sel == get_irn_opcode (ptr)) {
 640       meth = get_Sel_entity (ptr);
 641     } else if (iro_SymConst == get_irn_opcode (ptr)) {
 642       if (get_SymConst_kind (ptr) == symconst_addr_ent) {
 643         meth = get_SymConst_entity (ptr);
 644       } else {
 645         meth = NULL;            /* WTF? */
 646       }
 647     }
 648
 649     if (NULL != meth) {
 650       type *tp = get_method_res_type ((type*) meth, 0);
 651       res = ta_type (tp);
 652     } else {
 653       /* could be anything */
 654       /* fprintf (stdout, "meth= (null)"); */
 655       res = NULL;
 656     }
 657
 658     fprintf (stdout, "]\n");
 659
 660   } break;
 661
 662   case (iro_SymConst): {
 663     if (get_SymConst_kind (node) == symconst_type_tag) {
 664       type *tp = get_SymConst_type (node);
 665
 666       res = ta_type (tp);
 667     } else if (get_SymConst_kind (node) == symconst_addr_ent) {
 668       entity *ent = get_SymConst_entity (node);
 669       type *tp = get_entity_type (ent);
 670       tp = get_pointer_points_to_type (tp);
 671       assert (is_class_type (tp));
 672
 673       res = ta_type (tp);       /* can't use ta_exact */
 674     } else {
 675       fprintf (stdout, "can't handle SymConst %s?\n",
 676                get_op_name (get_irn_op (node)));
 677       res = NULL;
 678     }
 679   } break;
 680
 681   /* template:
 682      case (iro_Cast): {}
 683      break;
 684   */
 685
 686   default: {
 687     fprintf (stdout, "what's with %s?\n", get_op_name (get_irn_op (node)));
 688     assert (0);
 689   } break;
 690   }
 691
 692   return (res);
 693 }
 694
 695
 696
 697
 698 \f
 699 /*
 700   $Log$
 701   Revision 1.1  2004/10/21 11:09:37  liekweg
 702   Moved memwalk stuf into irmemwalk
 703   Moved lset stuff into lset
 704   Moved typalise stuff into typalise
 705
 706
 707  */