nsz Git - libfirm/blob - scripts/gen_ir.pl

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # Copyright (C) 1995-2008 University of Karlsruhe.  All right reserved.
   5 #
   6 # This file is part of libFirm.
   7 #
   8 # This file may be distributed and/or modified under the terms of the
   9 # GNU General Public License version 2 as published by the Free Software
  10 # Foundation and appearing in the file LICENSE.GPL included in the
  11 # packaging of this file.
  12 #
  13 # Licensees holding valid libFirm Professional Edition licenses may use
  14 # this file in accordance with the libFirm Commercial License.
  15 # Agreement provided with the Software.
  16 #
  17 # This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE
  18 # WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  19 # PURPOSE.
  20 #
  21
  22 # This script generates C code for the IR nodes specified
  23 # in ../ir/ir/ir_spec.pl.
  24 #
  25 # $Id$
  26
  27 use strict;
  28
  29 my $specfile = $ARGV[0];
  30 my $target_dir = $ARGV[1];
  31 my $target_cons = $target_dir."/gen_ir_cons.c.inl";
  32
  33 our %nodes;
  34 our $NONE;
  35 our $MANUALFROMPARAM;
  36
  37 # include spec file
  38
  39 my $return;
  40
  41 no strict "subs";
  42 unless ($return = do $specfile) {
  43         die "Fatal error: couldn't parse $specfile: $@" if $@;
  44         die "Fatal error: couldn't do $specfile: $!"    unless defined $return;
  45         die "Fatal error: couldn't run $specfile"       unless $return;
  46 }
  47 use strict "subs";
  48
  49 my @text_cons;
  50 my $ARITY_DYNAMIC = -1;
  51 my $ARITY_VARIABLE = "arity";
  52 my $had_error = 0;
  53
  54 # generate IR node constructors
  55
  56 foreach my $nodename (keys(%nodes)) {
  57         my %curnode = %{ $nodes{"$nodename"} };
  58
  59         my $op_name;
  60         if (exists($curnode{"op"})) {
  61                 $op_name = $curnode{"op"};
  62         } else {
  63                 $op_name = $nodename;
  64         }
  65
  66         if ($op_name eq 0) {
  67                 next;
  68         }
  69
  70         print "${op_name}\n";
  71
  72         # handle inheritance
  73
  74         my @hierarchy;
  75         my %curop = %curnode;
  76         my $supername;
  77         push(@hierarchy, $nodename);
  78         while (exists($curop{"is_a"})) {
  79                 $supername = $curop{"is_a"};
  80                 push(@hierarchy, $supername);
  81                 %curop = %{ $nodes{$supername} };
  82         }
  83         my %node;
  84         foreach my $cursupername (reverse @hierarchy) {
  85                 # print " - $cursupername\n";
  86                 my %supernode = %{ $nodes{$cursupername} };
  87                 foreach my $keyname (keys(%supernode)) {
  88                         # print " --- $keyname\n";
  89                         if ($keyname eq "op") {
  90                                 next;
  91                         }
  92                         my $value = $supernode{$keyname};
  93                         $node{$keyname} = $value;
  94                 }
  95         }
  96
  97         # check op_flags and state fields
  98
  99         if (!exists($node{"op_flags"})) {
 100                 $node{"op_flags"} = "N";
 101         }
 102         if (!exists($node{"state"})) {
 103                 $node{"state"} = "floats";
 104         }
 105
 106         # calculate arity
 107
 108         my $arity = 0;
 109
 110         if (exists($node{"arity"})) {
 111                 $arity = $node{"arity"};
 112                 if (exists($node{"ins"})) {
 113                         print "ERROR: $nodename defines \"arity\" AND \"ins\" field\n";
 114                         $had_error = 1;
 115                 }
 116         } elsif (exists($node{"ins"})) {
 117                 $arity = scalar(@{ $node{"ins"} });
 118         }
 119
 120         if ($arity eq "dynamic") {
 121                 $arity = $ARITY_DYNAMIC;
 122         } elsif ($arity eq "variable") {
 123                 $arity = $ARITY_VARIABLE;
 124         }
 125
 126         # build new_rd_$nodename function
 127
 128         push(@text_cons, "ir_node *new_rd_$nodename(dbg_info *db, ir_graph *irg");
 129
 130         my @text_paramdecls;
 131         my @text_paramuse;
 132
 133         my $block_name;
 134         if (!exists($node{"block"})) {
 135                 push(@text_cons, ", ir_node *block");
 136                 $block_name = "block";
 137         } else {
 138                 $block_name = $node{"block"};
 139         }
 140
 141         if (exists($node{"ins"})) {
 142                 my @ins = @{ $node{"ins"} };
 143
 144                 foreach my $inname (@ins) {
 145                         push(@text_paramdecls, "ir_node *$inname");
 146                         push(@text_paramuse, "$inname");
 147                 }
 148         } elsif ($arity eq $ARITY_VARIABLE) {
 149                 push(@text_paramdecls, "int arity, ir_node **in");
 150                 push(@text_paramuse, "arity, in");
 151         }
 152
 153         my $mode_name;
 154         if (exists($node{"mode"})) {
 155                 $mode_name = $node{"mode"};
 156         } else {
 157                 $mode_name = "mode";
 158                 push(@text_paramdecls, "ir_mode *mode");
 159                 push(@text_paramuse, "mode");
 160         }
 161
 162         if (exists($node{"attrs"})) {
 163                 my @attrs = @{ $node{"attrs"} };
 164
 165                 if (!exists($node{"attrs_name"})) {
 166                         $node{"attrs_name"} = lcfirst($nodename);
 167                 }
 168
 169                 foreach my $attritem (@attrs) {
 170                         my %attr = %{ $attritem };
 171                         if (!exists($attr{"init"}) || $attr{"init"} eq $MANUALFROMPARAM) {
 172                                 push(@text_paramdecls, $attr{"type"}. " ".$attr{"name"});
 173                                 push(@text_paramuse, $attr{"name"});
 174                         }
 175                 }
 176         }
 177
 178         push(@text_cons, ", " . join(", ", @text_paramdecls)) if @text_paramdecls;
 179         push(@text_cons, ")\n{\n".
 180                 "\tir_node *res;\n");
 181
 182         push(@text_cons, "\tir_graph *rem = current_ir_graph;\n");
 183
 184         my $in_array = "NULL";
 185         if ($arity eq $ARITY_VARIABLE) {
 186                 $in_array = "in";
 187         } elsif ($arity > 0) {
 188                 push(@text_cons, "\tir_node *in[$arity];\n");
 189                 $in_array = "in";
 190
 191                 my @ins = @{ $node{"ins"} };
 192                 for (my $idx = 0; $idx <= $#ins; $idx++) {
 193                         push(@text_cons, "\tin[$idx] = ".$ins[$idx].";\n");
 194                 }
 195         }
 196
 197         push(@text_cons, "\tcurrent_ir_graph = irg;\n");
 198
 199         push(@text_cons, "\tres = new_ir_node(db, irg, $block_name, op_$op_name, $mode_name, $arity, $in_array);\n");
 200
 201         if (exists($node{"attrs"})) {
 202                 my @attrs = @{ $node{"attrs"} };
 203
 204                 foreach my $attritem (@attrs) {
 205                         my %attr = %{ $attritem };
 206                         if (!exists($attr{"init"}) || $attr{"init"} ne $MANUALFROMPARAM &&
 207                                                       $attr{"init"} ne $NONE) {
 208                                 my $initname = exists($attr{"initname"}) ? $attr{"initname"} : "." . $attr{"name"};
 209                                 my $initval  = exists($attr{"init"})     ? $attr{"init"}     : $attr{"name"};
 210                                 push(@text_cons, "\tres->attr.".$node{"attrs_name"}."$initname = $initval;\n");
 211                         }
 212                 }
 213         }
 214
 215         if (exists($node{"init"})) {
 216                 push(@text_cons, $node{"init"});
 217         }
 218
 219         if (!exists($node{"optimize"}) || $node{"optimize"} eq 1) {
 220                 push(@text_cons, "\tres = optimize_node(res);\n");
 221         }
 222
 223         push(@text_cons, "\tIRN_VRFY_IRG(res, irg);\n".
 224                 "\tcurrent_ir_graph = rem;\n".
 225                 "\treturn res;\n".
 226                 "}\n\n");
 227
 228         # build new_r_$nodename function
 229
 230         push(@text_cons, "ir_node *new_r_$nodename(ir_graph *irg");
 231         push(@text_cons, ", ir_node *block") unless exists($node{"block"});
 232         push(@text_cons, ", " . join(", ", @text_paramdecls)) if @text_paramdecls;
 233         push(@text_cons, ")\n"
 234                 ."{\n"
 235                 ."\treturn new_rd_$nodename(NULL, irg");
 236         push(@text_cons, ", block") unless exists($node{"block"});
 237         push(@text_cons, ", " . join(", ", @text_paramuse)) if @text_paramuse;
 238         push(@text_cons, ");\n"
 239                 ."}\n\n");
 240
 241         # build new_d_$nodename function
 242
 243         push(@text_cons, "ir_node *new_d_$nodename(dbg_info *db");
 244         push(@text_cons, ", " . join(", ", @text_paramdecls)) if @text_paramdecls;
 245         push(@text_cons, ")\n"
 246                         ."{\n"
 247                         ."\tir_node *res;\n");
 248         push(@text_cons, $node{"d_pre"}) if exists($node{"d_pre"});
 249         push(@text_cons, "\tres = new_rd_$nodename(db, current_ir_graph");
 250         push(@text_cons, ", current_ir_graph->current_block") unless exists($node{"block"});
 251         push(@text_cons, ", " . join(", ", @text_paramuse)) if @text_paramuse;
 252         push(@text_cons, ");\n");
 253         push(@text_cons, $node{"d_post"}) if exists($node{"d_post"});
 254         push(@text_cons, "\treturn res;\n"
 255                         ."}\n\n");
 256
 257         # build new_$nodename function
 258
 259         push(@text_cons, "ir_node *new_$nodename(");
 260         if (@text_paramdecls) {
 261                 push(@text_cons, join(", ", @text_paramdecls));
 262         } else {
 263                 push(@text_cons, "void");
 264         }
 265         push(@text_cons, ")\n"
 266                 ."{\n"
 267                 ."\treturn new_d_$nodename(NULL");
 268         push(@text_cons, ", " . join(", ", @text_paramuse)) if @text_paramuse;
 269         push(@text_cons, ");\n"
 270                 ."}\n\n");
 271
 272 #       push(@text_cons, "ir_node *new_bd_$nodename(dbg_info *db");
 273 #       if (!exists($node{"block"})) {
 274 #               push(@text_cons, ", ir_node *block");
 275 #       }
 276 #       push(@text_cons, @text_paramdecls);
 277 #       push(@text_cons, ")\n"
 278 #               ."{\n"
 279 #               ."\treturn new_rd_$nodename(db, current_ir_graph");
 280 #       if (!exists($node{"block"})) {
 281 #               push(@text_cons, ", block");
 282 #       }
 283 #       push(@text_cons, @text_paramuse);
 284 #       push(@text_cons, ");\n"
 285 #               ."}\n\n");
 286 }
 287
 288 !$had_error || die;
 289
 290 # emit the code
 291
 292 print "Emitting code to $target_cons\n";
 293
 294 open(OUT, ">$target_cons") || die("Fatal error: Could not open $target_cons, reason: $!\n");
 295
 296 print OUT @text_cons;
 297
 298 close(OUT);
 299
 300 print "Done.\n"