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         my $in_array = "NULL";
 183         if ($arity eq $ARITY_VARIABLE) {
 184                 $in_array = "in";
 185         } elsif ($arity > 0) {
 186                 push(@text_cons, "\tir_node *in[$arity];\n");
 187                 $in_array = "in";
 188
 189                 my @ins = @{ $node{"ins"} };
 190                 for (my $idx = 0; $idx <= $#ins; $idx++) {
 191                         push(@text_cons, "\tin[$idx] = ".$ins[$idx].";\n");
 192                 }
 193         }
 194
 195         push(@text_cons, "\tres = new_ir_node(db, irg, $block_name, op_$op_name, $mode_name, $arity, $in_array);\n");
 196
 197         if (exists($node{"attrs"})) {
 198                 my @attrs = @{ $node{"attrs"} };
 199
 200                 foreach my $attritem (@attrs) {
 201                         my %attr = %{ $attritem };
 202                         if (!exists($attr{"init"}) || $attr{"init"} ne $MANUALFROMPARAM &&
 203                                                       $attr{"init"} ne $NONE) {
 204                                 my $initname = exists($attr{"initname"}) ? $attr{"initname"} : "." . $attr{"name"};
 205                                 my $initval  = exists($attr{"init"})     ? $attr{"init"}     : $attr{"name"};
 206                                 push(@text_cons, "\tres->attr.".$node{"attrs_name"}."$initname = $initval;\n");
 207                         }
 208                 }
 209         }
 210
 211         if (exists($node{"init"})) {
 212                 push(@text_cons, $node{"init"});
 213         }
 214
 215         if (!exists($node{"optimize"}) || $node{"optimize"} eq 1) {
 216                 push(@text_cons, "\tres = optimize_node(res);\n");
 217         }
 218
 219         push(@text_cons, "\tIRN_VRFY_IRG(res, irg);\n".
 220                 "\treturn res;\n".
 221                 "}\n\n");
 222
 223         # build new_r_$nodename function
 224
 225         push(@text_cons, "ir_node *new_r_$nodename(ir_graph *irg");
 226         push(@text_cons, ", ir_node *block") unless exists($node{"block"});
 227         push(@text_cons, ", " . join(", ", @text_paramdecls)) if @text_paramdecls;
 228         push(@text_cons, ")\n"
 229                 ."{\n"
 230                 ."\treturn new_rd_$nodename(NULL, irg");
 231         push(@text_cons, ", block") unless exists($node{"block"});
 232         push(@text_cons, ", " . join(", ", @text_paramuse)) if @text_paramuse;
 233         push(@text_cons, ");\n"
 234                 ."}\n\n");
 235
 236         # build new_d_$nodename function
 237
 238         push(@text_cons, "ir_node *new_d_$nodename(dbg_info *db");
 239         push(@text_cons, ", " . join(", ", @text_paramdecls)) if @text_paramdecls;
 240         push(@text_cons, ")\n"
 241                         ."{\n"
 242                         ."\tir_node *res;\n");
 243         push(@text_cons, $node{"d_pre"}) if exists($node{"d_pre"});
 244         push(@text_cons, "\tres = new_rd_$nodename(db, current_ir_graph");
 245         push(@text_cons, ", current_ir_graph->current_block") unless exists($node{"block"});
 246         push(@text_cons, ", " . join(", ", @text_paramuse)) if @text_paramuse;
 247         push(@text_cons, ");\n");
 248         push(@text_cons, $node{"d_post"}) if exists($node{"d_post"});
 249         push(@text_cons, "\treturn res;\n"
 250                         ."}\n\n");
 251
 252         # build new_$nodename function
 253
 254         push(@text_cons, "ir_node *new_$nodename(");
 255         if (@text_paramdecls) {
 256                 push(@text_cons, join(", ", @text_paramdecls));
 257         } else {
 258                 push(@text_cons, "void");
 259         }
 260         push(@text_cons, ")\n"
 261                 ."{\n"
 262                 ."\treturn new_d_$nodename(NULL");
 263         push(@text_cons, ", " . join(", ", @text_paramuse)) if @text_paramuse;
 264         push(@text_cons, ");\n"
 265                 ."}\n\n");
 266
 267 #       push(@text_cons, "ir_node *new_bd_$nodename(dbg_info *db");
 268 #       if (!exists($node{"block"})) {
 269 #               push(@text_cons, ", ir_node *block");
 270 #       }
 271 #       push(@text_cons, @text_paramdecls);
 272 #       push(@text_cons, ")\n"
 273 #               ."{\n"
 274 #               ."\treturn new_rd_$nodename(db, current_ir_graph");
 275 #       if (!exists($node{"block"})) {
 276 #               push(@text_cons, ", block");
 277 #       }
 278 #       push(@text_cons, @text_paramuse);
 279 #       push(@text_cons, ");\n"
 280 #               ."}\n\n");
 281 }
 282
 283 !$had_error || die;
 284
 285 # emit the code
 286
 287 print "Emitting code to $target_cons\n";
 288
 289 open(OUT, ">$target_cons") || die("Fatal error: Could not open $target_cons, reason: $!\n");
 290
 291 print OUT @text_cons;
 292
 293 close(OUT);
 294
 295 print "Done.\n"