nsz Git - libfirm/blob - ir/be/scripts/generate_regalloc_if.pl

   1 #!/usr/bin/perl -w
   2
   3 # This script generates C code which emits assembler code for the
   4 # assembler ir nodes. It takes a "emit" key from the node specification
   5 # and substitutes lines starting with . with a corresponding fprintf().
   6 # Creation: 2005/11/14
   7 # $Id$
   8
   9 use strict;
  10 use Data::Dumper;
  11
  12 my $specfile   = $ARGV[0];
  13 my $target_dir = $ARGV[1];
  14
  15 our $arch;
  16 our %reg_classes;
  17 our %nodes;
  18
  19 # include spec file
  20
  21 my $return;
  22
  23 no strict "subs";
  24 unless ($return = do $specfile) {
  25   warn "couldn't parse $specfile: $@" if $@;
  26   warn "couldn't do $specfile: $!"    unless defined $return;
  27   warn "couldn't run $specfile"       unless $return;
  28 }
  29 use strict "subs";
  30
  31 my $target_c = $target_dir."/gen_".$arch."_regalloc_if.c.inl";
  32 my $target_h = $target_dir."/gen_".$arch."_regalloc_if.h";
  33
  34 # helper function
  35 my @rt = ("arch_register_type_none",
  36           "arch_register_type_write_invariant",
  37           "arch_register_type_caller_saved",
  38           "arch_register_type_callee_saved",
  39           "arch_register_type_ignore");
  40
  41 # stacks for output
  42 my @obst_regtypes;     # stack for the register type variables
  43 my @obst_regclasses;   # stack for the register class variables
  44 my @obst_classdef;     # stack to assign a number to a certain class
  45 my @obst_reginit;      # stack for the register type inits
  46 my @obst_req;          # stack for the register requirements
  47 my @obst_limit_func;   # stack for functions to return a subset of a register class
  48
  49 my $numregs;
  50 my $class_idx = 0;
  51
  52 my %reg2class;
  53
  54 # generate register type and class variable and init function
  55 foreach my $class_name (keys(%reg_classes)) {
  56   my @class         = @{ $reg_classes{"$class_name"} };
  57   my $old_classname = $class_name;
  58
  59   $class_name = $arch."_".$class_name;
  60   $numregs    = "N_".$class_name."_REGS";
  61
  62   push(@obst_regtypes, "#define $numregs ".($#class + 1)."\n");
  63   push(@obst_regtypes, "arch_register_t ".$class_name."_regs[$numregs];\n\n");
  64
  65   push(@obst_classdef, "#define CLASS_$class_name $class_idx\n");
  66   push(@obst_regclasses, "{ \"$class_name\", $numregs, ".$class_name."_regs }");
  67
  68   my $idx = 0;
  69   push(@obst_reginit, "  /* Init of all registers in class '$class_name' */\n\n");
  70   foreach (@class) {
  71     $reg2class{$_->{"name"}} = { "class" => $old_classname, "index" => $idx }; # remember reg to class for later use
  72     push(@obst_reginit, "  ".$class_name."_regs[$idx].name      = \"".$_->{"name"}."\";\n");
  73     push(@obst_reginit, "  ".$class_name."_regs[$idx].reg_class = &$arch\_reg_classes[CLASS_$class_name];\n");
  74     push(@obst_reginit, "  ".$class_name."_regs[$idx].index     = $idx;\n");
  75     push(@obst_reginit, "  ".$class_name."_regs[$idx].type      = ".$rt[$_->{"type"}].";\n\n");
  76     $idx++;
  77   }
  78
  79   $class_idx++;
  80 }
  81
  82 # generate node-register constraints
  83 foreach my $op (keys(%nodes)) {
  84   my %n = %{ $nodes{"$op"} };
  85
  86   next if (!exists($n{"reg_req"}));
  87
  88   $op = $arch."_".$op;
  89
  90   push(@obst_req, "/* IN requirements for '$op' */\n");
  91
  92   my @inidx_class;
  93
  94   # check for argument requirements
  95   if (exists($n{"reg_req"}{"in"})) {
  96     my @in = @{ $n{"reg_req"}{"in"} };
  97
  98     for (my $idx = 0; $idx <= $#in; $idx++) {
  99       my $class = undef;
 100
 101       push(@obst_req, "static const arch_register_req_t ".$op."_reg_req_in_$idx = {\n");
 102
 103       if ($in[$idx] eq "none") {
 104         push(@inidx_class, "none");
 105         push(@obst_req, "  arch_register_req_type_none,\n  NULL,\n  { NULL }");
 106       }
 107       elsif (is_reg_class($in[$idx])) {
 108         push(@inidx_class, $in[$idx]);
 109         push(@obst_req, "  arch_register_req_type_normal,\n  &$arch\_reg_classes[CLASS_$arch\_".$in[$idx]."],\n  { NULL }");
 110       }
 111       else {
 112         $class = build_subset_class_func($op, $idx, 1, $in[$idx]);
 113         if (!defined $class) {
 114           die("Could not build subset for IN requirements '$op' pos $idx ... exiting.\n");
 115         }
 116         push(@inidx_class, $class);
 117         push(@obst_req, "  arch_register_req_type_limited,\n  &$arch\_reg_classes[CLASS_$arch\_".$class."],\n  { limit_reg_".$op."_in_".$idx." }");
 118       }
 119
 120       push(@obst_req, "\n};\n\n");
 121     }
 122   }
 123
 124   push(@obst_req, "/* OUT requirements for '$op' */\n");
 125
 126   # check for result requirements
 127   if (exists($n{"reg_req"}{"out"})) {
 128     my @out = @{ $n{"reg_req"}{"out"} };
 129
 130     for (my $idx = 0; $idx <= $#out; $idx++) {
 131       my $class = undef;
 132
 133       push(@obst_req, "static const arch_register_req_t ".$op."_reg_req_out_$idx = {\n");
 134
 135       if ($out[$idx] eq "none") {
 136         push(@obst_req, "  arch_register_req_type_none,\n  NULL,\n  { NULL }");
 137       }
 138       elsif (is_reg_class($out[$idx])) {
 139         push(@obst_req, "  arch_register_req_type_normal,\n  &$arch\_reg_classes[CLASS_$arch\_".$out[$idx]."],\n  { NULL }");
 140       }
 141       elsif ($out[$idx] =~ /^(!)?in_s(\d+)/) { # this is a "should be (un)equal to register at in_X"
 142         push(@obst_req, "  arch_register_req_type_".($1 ? "un" : "")."equal,\n");
 143         push(@obst_req, "  &$arch\_reg_classes[CLASS_$arch\_".$inidx_class[$2 - 1]."],\n");
 144         push(@obst_req, "  { ".($2 - 1)." }");
 145       }
 146       else {
 147         $class = build_subset_class_func($op, $idx, 0, $out[$idx]);
 148         if (!defined $class) {
 149           die("Could not build subset for OUT requirements '$op' pos $idx ... exiting.\n");
 150         }
 151         push(@obst_req, "  arch_register_req_type_limited,\n  &$arch\_reg_classes[CLASS_$arch\_".$class."],\n  { limit_reg_".$op."_out_".$idx." }");
 152       }
 153
 154       push(@obst_req, "\n};\n\n");
 155     }
 156   }
 157 }
 158
 159
 160
 161 # generate header file
 162 open(OUT, ">$target_h") || die("Could not open $target_h, reason: $!\n");
 163
 164 my $creation_time = localtime(time());
 165
 166 my $tmp = uc($arch);
 167
 168 print OUT<<EOF;
 169 #ifndef _GEN_$tmp\_REGALLOC_IF_H_
 170 #define _GEN_$tmp\_REGALLOC_IF_H_
 171
 172 /**
 173  * Generated register classes from spec
 174  *
 175  * DO NOT EDIT THIS FILE, your changes will be lost.
 176  * Edit $specfile instead.
 177  * created by: $0 $specfile $target_dir
 178  * date:       $creation_time
 179  */
 180
 181 EOF
 182
 183 print OUT @obst_regtypes;
 184
 185 print OUT "void ".$arch."_register_init(void);\n\n";
 186
 187 print OUT "\n#endif /* _GEN_$tmp\_REGALLOC_IF_H_ */\n";
 188
 189
 190
 191 # generate c inline file
 192 open(OUT, ">$target_c") || die("Could not open $target_c, reason: $!\n");
 193
 194 $creation_time = localtime(time());
 195
 196 print OUT<<EOF;
 197 /**
 198  * The generated interface for the register allocator.
 199  * Contains register classes and types and register constraints
 200  * for all nodes where constraints were given in spec.
 201  *
 202  * DO NOT EDIT THIS FILE, your changes will be lost.
 203  * Edit $specfile instead.
 204  * created by: $0 $specfile $target_dir
 205  * date:       $creation_time
 206  */
 207
 208 #include "gen_$arch\_regalloc_if.h"
 209
 210 EOF
 211
 212 print OUT @obst_classdef, "\n";
 213
 214 print OUT "arch_register_class_t $arch\_reg_classes[] = {\n  ".join(",\n  ", @obst_regclasses)."\n};\n\n";
 215
 216 print OUT "void ".$arch."_register_init(void) {\n";
 217 print OUT @obst_reginit;
 218 print OUT "}\n\n";
 219
 220 print OUT @obst_limit_func;
 221 print OUT @obst_req;
 222
 223 close(OUT);
 224
 225
 226
 227 ###
 228 # Determines whether $name is a specified register class or not.
 229 # @return 1 if name is register class, 0 otherwise
 230 ###
 231 sub is_reg_class {
 232   my $name = shift;
 233   return 1 if exists($reg_classes{"$name"});
 234   return 0;
 235 }
 236
 237 ###
 238 # Returns the register class for a given register.
 239 # @return class or undef
 240 ###
 241 sub get_reg_class {
 242   my $reg = shift;
 243   return $reg2class{"$reg"}{"class"} if (exists($reg2class{"$reg"}));
 244   return undef;
 245 }
 246
 247 ###
 248 # Returns the index of a given register within it's register class.
 249 # @return index or undef
 250 ###
 251 sub get_reg_index {
 252   my $reg = shift;
 253   return $reg2class{"$reg"}{"index"} if (exists($reg2class{"$reg"}));
 254   return undef;
 255 }
 256
 257 ###
 258 # Generates the function for a given $op and a given IN-index
 259 # which returns a subset of possible register from a register class
 260 # @return classname from which the subset is derived or undef
 261 ###
 262 sub build_subset_class_func {
 263   my $neg   = undef;
 264   my $class = "";
 265   my $temp;
 266
 267   # build function header
 268   my $op  = shift;
 269   my $idx = shift;
 270   my $in  = shift;
 271   push(@obst_limit_func, "/* limit the possible registers for ".($in ? "IN" : "OUT")." $idx at op $op */\n");
 272   push(@obst_limit_func, "int limit_reg_".$op."_".($in ? "in" : "out")."_".$idx."(const ir_node *irn, int pos, bitset_t *bs) {\n");
 273
 274   my @regs = split(/ /, shift);
 275
 276   # set/unset registers
 277   foreach (@regs) {
 278     # check for negate
 279
 280     if (substr($_, 0, 1) eq "!") {
 281       if (defined($neg) && $neg == 0) {
 282         # we have seen a positiv constraint as first one but this one is negative
 283         # this doesn't make sense
 284         print STDERR "Mixed positive and negative constraints for the same slot are not allowed.\n";
 285         return undef;
 286       }
 287
 288       if (!defined($neg)) {
 289         push(@obst_limit_func, "  bs = bitset_set_all(bs);     /* allow all register (negative constraints given) */\n");
 290       }
 291
 292       $_   = substr($_, 1); # skip '!'
 293       $neg = 1;
 294     }
 295     else {
 296       if (defined($neg) && $neg == 1) {
 297         # we have seen a negative constraint as first one but this one is positive
 298         # this doesn't make sense
 299         print STDERR "Mixed positive and negative constraints for the same slot are not allowed.\n";
 300         return undef;
 301       }
 302
 303       if (!defined($neg)) {
 304         push(@obst_limit_func, "  bs = bitset_clear_all(bs);   /* disallow all register (positive constraints given) */\n");
 305       }
 306       $neg = 0;
 307     }
 308
 309     # check if register belongs to one of the given classes
 310     $temp = get_reg_class($_);
 311     if (!defined($temp)) {
 312       print STDERR "Unknown register '$_'!\n";
 313       return undef;
 314     }
 315
 316     # set class
 317     if (!$class) {
 318       $class = $temp;
 319     }
 320     elsif ($class ne $temp) {
 321       # all registers must belong to the same class
 322       print STDERR "Registerclass mismatch. '$_' is not member of class '$class'.\n";
 323       return undef;
 324     }
 325
 326     if ($neg == 1) {
 327       push(@obst_limit_func, "  bitset_clear(bs, ".get_reg_index($_).");         /* disallow $_ */\n");
 328     }
 329     else {
 330       push(@obst_limit_func, "  bitset_set(bs, ".get_reg_index($_).");           /* allow $_ */\n");
 331     }
 332   }
 333
 334   push(@obst_limit_func, "\n  return ".($neg ? scalar(@{ $reg_classes{"$class"} }) - scalar(@regs) : scalar(@regs)).";\n");
 335   push(@obst_limit_func, "}\n\n");
 336
 337   return $class;
 338 }