avoid warnings in autoenerated code
[libfirm] / ir / be / scripts / generate_new_opcodes.pl
1 #!/usr/bin/perl -w
2
3 #
4 # Copyright (C) 1995-2007 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 the C code which creates the irop's and
23 # their coresponding node constructors for all operations in a given spec
24 # so they can be used as normal firm nodes.
25 # Creation: 2005/10/19
26 # $Id$
27
28 use strict;
29 use Data::Dumper;
30
31 my $specfile   = $ARGV[0];
32 my $target_dir = $ARGV[1];
33 my $state      = 1;
34 my $cur_op     = "";
35 my $line_nr    = 0;
36
37 our $arch;
38 our $additional_opcodes;
39 our %nodes;
40 our %cpu;
41 our $default_attr_type;
42 our $default_cmp_attr;
43 our %init_attr;
44 our %compare_attr;
45
46 # include spec file
47
48 my $return;
49
50 no strict "subs";
51 unless ($return = do $specfile) {
52         die "Fatal error: couldn't parse $specfile: $@" if $@;
53         die "Fatal error: couldn't do $specfile: $!"    unless defined $return;
54         die "Fatal error: couldn't run $specfile"       unless $return;
55 }
56 use strict "subs";
57
58 my $target_c = $target_dir."/gen_".$arch."_new_nodes.c.inl";
59 my $target_h = $target_dir."/gen_".$arch."_new_nodes.h";
60
61 if(!defined($default_attr_type)) {
62         $default_attr_type = "${arch}_attr_t";
63 }
64 if(!defined(%init_attr)) {
65         %init_attr = (
66                 "$default_attr_type" => "\tinit_${arch}_attributes(res, flags, in_reqs, out_reqs, exec_units, n_res, latency);",
67         );
68 }
69 if(!defined($default_cmp_attr)) {
70         $default_cmp_attr = "${arch}_compare_attr";
71 }
72 if(!defined(%compare_attr)) {
73         %compare_attr = (
74                 "${default_attr_type}" => "${default_cmp_attr}",
75         );
76 }
77
78 #print Dumper(%nodes);
79 #print Dumper(%operands);
80
81 # create c code file from specs
82
83 my @obst_opvar;       # stack for the "ir_op *op_<arch>_<op-name> = NULL;" statements
84 my @obst_get_opvar;   # stack for the get_op_<arch>_<op-name>() functions
85 my @obst_constructor; # stack for node constructor functions
86 my @obst_new_irop;    # stack for the new_ir_op calls
87 my @obst_enum_op;     # stack for creating the <arch>_opcode enum
88 my @obst_header;      # stack for function prototypes
89 my @obst_is_archirn;  # stack for the is_$arch_irn() function
90 my @obst_cmp_attr;    # stack for the compare attribute functions
91 my @obst_proj;        # stack for the pn_ numbers
92 my $orig_op;
93 my $arity;
94 my $cmp_attr_func;
95 my $temp;
96 my $n_opcodes = 0;    # number of opcodes
97 my $ARITY_VARIABLE = -1;
98 my $ARITY_DYNAMIC  = -2;
99
100 # for registering additional opcodes
101 $n_opcodes += $additional_opcodes if (defined($additional_opcodes));
102
103 push(@obst_header, "void ".$arch."_create_opcodes(void);\n");
104
105 push(@obst_enum_op, "typedef enum _$arch\_opcodes {\n");
106 foreach my $op (keys(%nodes)) {
107         my %n        = %{ $nodes{"$op"} };
108         my $known_mode;
109         my $num_outs = 0;
110         my $out_arity;
111         my @out_flags;
112
113         # determine arity
114         $arity = 0;
115         if(exists($n{"arity"})) {
116                 $arity = $n{"arity"};
117         } elsif (exists($n{"reg_req"}) && exists($n{"reg_req"}{"in"})) {
118                 $arity = scalar(@{ $n{"reg_req"}{"in"} });
119         } elsif (exists($n{"ins"})) {
120                 $arity = scalar(@{ $n{"ins"} });
121         }
122         if($arity eq "variable") {
123                 $arity = $ARITY_VARIABLE;
124         } elsif($arity eq "dynamic") {
125                 $arity = $ARITY_DYNAMIC;
126         }
127
128         # determine out arity
129         $out_arity = 0;
130         if(exists($n{"out_arity"})) {
131                 $out_arity = $n{"out_arity"};
132         } elsif (exists($n{"reg_req"}) && exists($n{"reg_req"}{"out"})) {
133                 $out_arity = scalar(@{ $n{"reg_req"}{"out"} });
134         } elsif (exists($n{"outs"})) {
135                 $out_arity = scalar(@{ $n{"outs"} });
136         }
137         if($out_arity eq "variable") {
138                 $out_arity = $ARITY_VARIABLE;
139         } elsif($out_arity eq "dynamic") {
140                 $out_arity = $ARITY_DYNAMIC;
141         }
142
143         $orig_op = $op;
144         $op      = $arch."_".$op;
145         $temp    = "";
146
147         # define proj numbers and in numbers
148         if (exists($n{"outs"})) {
149                 undef my @outs;
150
151                 @outs     = @{ $n{"outs"} };
152                 if($out_arity >= 0 && scalar(@outs) != $out_arity) {
153                         die "Fatal error: Op ${op} has different number of outs and out_arity\n";
154                 }
155
156                 $num_outs = $#outs + 1;
157
158                 push(@obst_proj, "\nenum pn_$op {\n");
159
160                 for (my $idx = 0; $idx <= $#outs; $idx++) {
161                         # check, if we have additional flags annotated to out
162                         if ($outs[$idx] =~ /:((S|I)(\|(S|I))*)/) {
163                                 push(@out_flags, $1);
164                                 $outs[$idx] =~ s/:((S|I)(\|(S|I))*)//;
165                         }
166                         push(@obst_proj, "\tpn_$op\_".$outs[$idx]." = $idx,\n");
167                 }
168
169                 push(@obst_proj, "};\n");
170                 # outs have names, it must be a mode_T node
171                 $known_mode = "mode_T";
172         }
173         if (exists($n{"ins"})) {
174                 undef my @ins;
175
176                 @ins = @{ $n{"ins"} };
177                 if($arity >= 0 && scalar(@ins) != $arity) {
178                         die "Fatal error: Op ${op} has different number of ins and arity\n";
179                 }
180
181                 push(@obst_proj, "\nenum n_$op {\n");
182
183                 for (my $idx = 0; $idx <= $#ins; $idx++) {
184                         push(@obst_proj, "\tn_${op}_".$ins[$idx]." = $idx,\n");
185                 }
186
187                 push(@obst_proj, "};\n");
188         }
189
190         # determine mode
191         if (exists($n{"mode"})) {
192                 $known_mode = $n{"mode"};
193         }
194
195         push(@obst_opvar, "ir_op *op_$op = NULL;\n");
196         push(@obst_get_opvar, "ir_op *get_op_$op(void)         { return op_$op; }\n");
197         push(@obst_get_opvar, "int    is_$op(const ir_node *n) { return get_$arch\_irn_opcode(n) == iro_$op; }\n\n");
198
199         push(@obst_is_archirn, "is_$op(node)");
200
201         push(@obst_header, "extern ir_op *op_$op;\n");
202         push(@obst_header, "ir_op *get_op_$op(void);\n");
203         push(@obst_header, "int is_$op(const ir_node *n);\n");
204
205         my $attr_type= $n{"attr_type"};
206         if(!defined($attr_type)) {
207                 $attr_type = $default_attr_type;
208         }
209
210         # determine compare function
211         my $cmp_attr_func;
212         if (exists($n{"cmp_attr"})) {
213                 my $cmpcode = $n{"cmp_attr"};
214
215                 push(@obst_cmp_attr, "static int cmp_attr_$op(ir_node *a, ir_node *b) {\n");
216                 if($cmpcode =~ m/attr_a/) {
217                         push(@obst_cmp_attr, "\t${attr_type} *attr_a = get_irn_generic_attr(a);\n");
218                 } else {
219                         push(@obst_cmp_attr, "\t(void) a;\n");
220                 }
221                 if($cmpcode =~ m/attr_b/) {
222                         push(@obst_cmp_attr, "\t${attr_type} *attr_b = get_irn_generic_attr(b);\n");
223                 } else {
224                         push(@obst_cmp_attr, "\t(void) b;\n");
225                 }
226                 push(@obst_cmp_attr, "\t${cmpcode}\n");
227                 push(@obst_cmp_attr, "}\n\n");
228
229                 $cmp_attr_func = "cmp_attr_${op}";
230         } else {
231                 if(defined($compare_attr{${attr_type}})) {
232                         $cmp_attr_func = $compare_attr{${attr_type}};
233                 } else {
234                         die "Fatal error: No compare function defined for ${attr_type} attributes.";
235                 }
236         }
237
238         if (exists($n{"rd_constructor"}) && $n{"rd_constructor"} =~ /^NONE$/i) {
239                 # we explicitly skip the constructor if the specification entry says NONE
240         } else {
241                 my $comment = $n{"comment"};
242                 if(!exists($n{"comment"})) {
243                         $comment = "construct ${orig_op} node";
244                 }
245                 $comment =
246                         "/**\n".
247                         " * ${comment}\n".
248                         " */\n";
249
250                 push(@obst_constructor, $comment);
251
252                 # create constructor head
253                 my $complete_args = "";
254                 $temp             = "";
255
256                 $temp = "ir_node *new_rd_$op(dbg_info *db, ir_graph *irg, ir_node *block";
257                 if (!exists($n{"args"})) { # default args
258                         if ($arity == $ARITY_VARIABLE) {
259                                 $complete_args = ", int arity, ir_node *in[]";
260                         } elsif ($arity == $ARITY_DYNAMIC) {
261                                 $complete_args = "";
262                         } else {
263                                 for (my $i = 0; $i < $arity; $i++) {
264                                         my $opname = "op${i}";
265                                         if (exists($n{"ins"})) {
266                                                 my @ins = @{ $n{"ins"} };
267                                                 $opname = $ins[$i];
268                                         }
269
270                                         $complete_args .= ", ir_node *${opname}";
271                                 }
272                         }
273                         if ($out_arity == $ARITY_VARIABLE) {
274                                 $complete_args .= ", int n_res";
275                         }
276
277                         if (!defined($known_mode)) {
278                                 $complete_args .= ", ir_mode *mode";
279                         }
280                 } else { # user defined args
281                         for my $href (@{ $n{"args"} }) {
282                                 $href->{"type"} .= " " if ($href->{"type"} !~ / [*]?$/); # put a space between name and type if there is none at the end
283                                 $complete_args  .= ", ".$href->{"type"}.$href->{"name"};
284                         }
285                 }
286
287                 # we have additional attribute arguements
288                 if (exists($n{"attr"})) {
289                         $complete_args .= ", ".$n{"attr"};
290                 }
291
292                 $temp .= "$complete_args)";
293                 push(@obst_constructor, $temp."\n{\n");
294                 push(@obst_header, $comment);
295                 push(@obst_header, $temp.";\n");
296
297                 # emit constructor code
298                 if (!exists($n{"rd_constructor"})) { # default constructor
299                         $temp  = "\tir_node  *res;\n";
300                         $temp .= "\tir_op    *op      = op_${op};\n";
301                         $temp .= "\tint       flags   = 0;\n";
302
303                         if($arity == $ARITY_DYNAMIC) {
304                                 $temp .= "\tint        arity   = -1;\n";
305                                 $temp .= "\tir_node  **in      = NULL;\n";
306                         } elsif($arity == $ARITY_VARIABLE) {
307                         } else {
308                                 $temp .= "\tint       arity   = $arity;\n";
309                                 if($arity > 0) {
310                                         $temp .= "\tir_node  *in[$arity];\n";
311                                 } else {
312                                         $temp .= "\tir_node **in    = NULL;\n";
313                                 }
314                         }
315                         if($out_arity == $ARITY_DYNAMIC) {
316                                 $temp .= "\tint       n_res   = -1;\n";
317                         } elsif($out_arity == $ARITY_VARIABLE) {
318                         } else {
319                                 $temp .= "\tint       n_res   = ${out_arity};\n";
320                         }
321
322                         my $latency = $n{"latency"};
323                         if (!defined($latency)) {
324                                 $latency = 1;
325                         }
326                         $temp .= "\tunsigned  latency = ${latency};\n";
327
328                         if (defined($known_mode)) {
329                                 $temp .= "\tir_mode  *mode    = ${known_mode};\n";
330                         }
331
332                         # set up static variables for cpu execution unit assigments
333                         if (exists($n{"units"})) {
334                                 $temp .= gen_execunit_list_initializer($n{"units"});
335                         } else {
336                                 $temp .= "\tstatic const be_execution_unit_t ***exec_units = NULL;\n";
337                         }
338
339                         undef my $in_req_var;
340                         undef my $out_req_var;
341
342                         # set up static variables for requirements and registers
343                         if (exists($n{"reg_req"})) {
344                                 my %req = %{ $n{"reg_req"} };
345                                 my $idx;
346
347                                 undef my @in;
348                                 @in = @{ $req{"in"} } if (exists($req{"in"}));
349                                 undef my @out;
350                                 @out = @{ $req{"out"} } if exists(($req{"out"}));
351
352                                 if (@in) {
353                                         if($arity >= 0 && scalar(@in) != $arity) {
354                                                 die "Fatal error: Arity and number of in requirements don't match for ${op}\n";
355                                         }
356
357                                         $temp .= "\tstatic const arch_register_req_t *in_reqs[] =\n";
358                                         $temp .= "\t{\n";
359                                         for ($idx = 0; $idx <= $#in; $idx++) {
360                                                 $temp .= "\t\t&".$op."_reg_req_in_".$idx.",\n";
361                                         }
362                                         $temp .= "\t};\n";
363                                 } else {
364                                         if($arity > 0) {
365                                                 die "Fatal error: need in requirements for ${op}\n";
366                                         }
367                                         $temp .= "\tstatic const arch_register_req_t **in_reqs = NULL;\n";
368                                 }
369
370                                 if (@out) {
371                                         if($out_arity >= 0 && scalar(@out) != $out_arity) {
372                                                 die "Fatal error: Out-Arity and number of out requirements don't match for ${op}\n";
373                                         }
374
375                                         $temp .= "\tstatic const arch_register_req_t *out_reqs[] =\n";
376                                         $temp .= "\t{\n";
377                                         for ($idx = 0; $idx <= $#out; $idx++) {
378                                                 $temp .= "\t\t&".$op."_reg_req_out_".$idx.",\n";
379                                         }
380                                         $temp .= "\t};\n";
381                                 } else {
382                                         if($out_arity > 0) {
383                                                 die "Fatal error: need out requirements for ${op}\n";
384                                         }
385                                         $temp .= "\tstatic const arch_register_req_t **out_reqs = NULL;\n";
386                                 }
387                         } else {
388                                 $temp .= "\tstatic const arch_register_req_t **in_reqs = NULL;\n";
389                                 $temp .= "\tstatic const arch_register_req_t **out_reqs = NULL;\n";
390                         }
391                         if(exists($n{"init_attr"})) {
392                                 $temp .= "\t${attr_type} *attr;\n";
393                         }
394
395                         $temp .= "\n";
396
397                         if($arity > 0) {
398                                 $temp .= "\t/* construct in array */\n";
399                                 for (my $i = 0; $i < $arity; $i++) {
400                                         my $opname = "op${i}";
401                                         if (exists($n{"ins"})) {
402                                                 my @ins = @{ $n{"ins"} };
403                                                 $opname = $ins[$i];
404                                         }
405
406                                         $temp .= "\tin[${i}] = ${opname};\n";
407                                 }
408                                 $temp .= "\n";
409                         }
410
411                         # set flags
412                         if (exists($n{"irn_flags"})) {
413                                 $temp .= "\t/* flags */\n";
414                                 foreach my $flag (split(/\|/, $n{"irn_flags"})) {
415                                         if ($flag eq "R") {
416                                                 $temp .= "\tflags |= arch_irn_flags_rematerializable;\n";
417                                         } elsif ($flag eq "N") {
418                                                 $temp .= "\tflags |= arch_irn_flags_dont_spill;\n";
419                                         } elsif ($flag eq "I") {
420                                                 $temp .= "\tflags |= arch_irn_flags_ignore;\n";
421                                         } elsif ($flag eq "S") {
422                                                 $temp .= "\tflags |= arch_irn_flags_modify_sp;\n";
423                                         }
424                                 }
425                                 $temp .= "\n";
426                         }
427
428                         $temp .= "\t/* create node */\n";
429                         $temp .= "\tassert(op != NULL);\n";
430                         $temp .= "\tres = new_ir_node(db, irg, block, op, mode, arity, in);\n";
431                         $temp .= "\n";
432
433                         $temp .= "\t/* init node attributes */\n";
434                         # lookup init function
435                         my $attr_init_code = $init_attr{$attr_type};
436                         if(!defined($attr_init_code)) {
437                                 die "Fatal error: Couldn't find attribute initialisation code for type '${attr_type}'";
438                         }
439                         $temp .= "${attr_init_code}\n";
440                         $temp .= "\n";
441
442                         # set flags for outs
443                         if ($#out_flags >= 0) {
444                                 $temp .= "\t/* set flags for outs */\n";
445                                 for (my $idx = 0; $idx <= $#out_flags; $idx++) {
446                                         my $flags  = "";
447                                         my $prefix = "";
448
449                                         foreach my $flag (split(/\|/, $out_flags[$idx])) {
450                                                 if ($flag eq "I") {
451                                                         $flags .= $prefix."arch_irn_flags_ignore";
452                                                         $prefix = " | ";
453                                                 }
454                                                 elsif ($flag eq "S") {
455                                                         $flags .= $prefix."arch_irn_flags_modify_sp";
456                                                         $prefix = " | ";
457                                                 }
458                                         }
459
460                                         $temp .= "\tset_$arch\_out_flags(res, $flags, $idx);\n";
461                                 }
462                                 $temp .= "\n";
463                         }
464
465
466                         if (exists($n{"init_attr"})) {
467                                 $temp .= "\tattr = get_irn_generic_attr(res);\n";
468                                 $temp .= "\t".$n{"init_attr"}."\n";
469                         }
470
471                         $temp .= "\t/* optimize node */\n";
472                         $temp .= "\tres = optimize_node(res);\n";
473                         $temp .= "\tirn_vrfy_irg(res, irg);\n";
474                         $temp .= "\n";
475
476                         $temp .= "\treturn res;\n";
477
478                         push(@obst_constructor, $temp);
479                 }
480                 else { # user defined constructor
481                         push(@obst_constructor, $n{"rd_constructor"});
482                 }
483
484                 # close constructor function
485                 push(@obst_constructor, "}\n\n");
486         } # constructor creation
487
488         # set default values for state and flags if not given
489         $n{"state"}    = "floats" if (! exists($n{"state"}));
490         $n{"op_flags"} = "N"      if (! exists($n{"op_flags"}));
491
492
493         push(@obst_new_irop, "\n\tmemset(&ops, 0, sizeof(ops));\n");
494         push(@obst_new_irop, "\tops.dump_node     = $arch\_dump_node;\n");
495
496         if (defined($cmp_attr_func)) {
497                 push(@obst_new_irop, "\tops.node_cmp_attr = ${cmp_attr_func};\n");
498         }
499
500         $n_opcodes++;
501         my $n_res = $out_arity;
502         if($n_res < 0) {
503                 $n_res = "20"; # hacky....
504         }
505         $temp  = "\top_$op = new_ir_op(cur_opcode + iro_$op, \"$op\", op_pin_state_".$n{"state"}.", ".$n{"op_flags"};
506         $temp .= "|M, ".translate_arity($arity).", 0, sizeof(${attr_type}), &ops);\n";
507         push(@obst_new_irop, $temp);
508         push(@obst_new_irop, "\tset_op_tag(op_$op, &$arch\_op_tag);\n");
509         push(@obst_enum_op, "\tiro_$op,\n");
510
511         push(@obst_header, "\n");
512 }
513 push(@obst_enum_op, "\tiro_$arch\_last_generated,\n");
514 push(@obst_enum_op, "\tiro_$arch\_last = iro_$arch\_last_generated");
515 push(@obst_enum_op, " + $additional_opcodes") if (defined($additional_opcodes));
516 push(@obst_enum_op, "\n} $arch\_opcodes;\n\n");
517
518 # emit the code
519
520 open(OUT, ">$target_c") || die("Fatal error: Could not open $target_c, reason: $!\n");
521
522 print OUT "#include \"gen_$arch\_regalloc_if_t.h\"\n\n";
523 print OUT @obst_cmp_attr;
524 print OUT "\n";
525 print OUT @obst_opvar;
526 print OUT "\n";
527 print OUT @obst_get_opvar;
528 print OUT "\n";
529
530 print OUT<<EOF;
531
532 static int $arch\_opcode_start = -1;
533 static int $arch\_opcode_end   = -1;
534
535 EOF
536
537 # build the FOURCC arguments from $arch
538
539 my ($a, $b, $c, $d) = ('\0', '\0', '\0', '\0');
540
541 if (length($arch) >= 1) {
542         $a = uc(substr($arch, 0, 1));
543 }
544
545 if (length($arch) >= 2) {
546         $b = uc(substr($arch, 1, 1));
547 }
548
549 if (length($arch) >= 3) {
550         $c = uc(substr($arch, 2, 1));
551 }
552
553 if (length($arch) >= 4) {
554         $d = uc(substr($arch, 3, 1));
555 }
556
557 print OUT<<ENDOFISIRN;
558
559 /** A tag for the $arch opcodes. Note that the address is used as a tag value, NOT the FOURCC code. */
560 static unsigned $arch\_op_tag = FOURCC('$a', '$b', '$c', '$d');
561
562 /** Return the opcode number of the first $arch opcode. */
563 int get_$arch\_opcode_first(void) {
564         return $arch\_opcode_start;
565 }
566
567 /** Return the opcode number of the last $arch opcode + 1. */
568 int get_$arch\_opcode_last(void) {
569         return $arch\_opcode_end;
570 }
571
572 /** Return 1 if the given opcode is a $arch machine op, 0 otherwise */
573 int is_$arch\_op(const ir_op *op) {
574         return get_op_tag(op) == &$arch\_op_tag;
575 }
576
577 /** Return 1 if the given node is a $arch machine node, 0 otherwise */
578 int is_$arch\_irn(const ir_node *node) {
579         return is_$arch\_op(get_irn_op(node));
580 }
581
582 int get_$arch\_irn_opcode(const ir_node *node) {
583         if (is_$arch\_irn(node))
584                 return get_irn_opcode(node) - $arch\_opcode_start;
585         return -1;
586 }
587
588 ENDOFISIRN
589
590 print OUT @obst_constructor;
591
592 print OUT<<ENDOFMAIN;
593 /**
594  * Creates the $arch specific Firm machine operations
595  * needed for the assembler irgs.
596  */
597 void $arch\_create_opcodes(void) {
598 #define N   irop_flag_none
599 #define L   irop_flag_labeled
600 #define C   irop_flag_commutative
601 #define X   irop_flag_cfopcode
602 #define I   irop_flag_ip_cfopcode
603 #define F   irop_flag_fragile
604 #define Y   irop_flag_forking
605 #define H   irop_flag_highlevel
606 #define c   irop_flag_constlike
607 #define K   irop_flag_keep
608 #define M   irop_flag_machine
609 #define O   irop_flag_machine_op
610 #define R   (irop_flag_user << 0)
611
612         ir_op_ops  ops;
613         int        cur_opcode;
614         static int run_once = 0;
615
616         if (run_once)
617                 return;
618         run_once = 1;
619
620         cur_opcode = get_next_ir_opcodes(iro_$arch\_last);
621
622         $arch\_opcode_start = cur_opcode;
623 ENDOFMAIN
624
625 print OUT @obst_new_irop;
626 print OUT "\n";
627 print OUT "\t$arch\_register_additional_opcodes(cur_opcode);\n" if (defined($additional_opcodes));
628 print OUT "\t$arch\_opcode_end = cur_opcode + iro_$arch\_last";
629 print OUT " + $additional_opcodes" if (defined($additional_opcodes));
630 print OUT ";\n";
631 print OUT "}\n";
632
633 close(OUT);
634
635 open(OUT, ">$target_h") || die("Fatal error: Could not open $target_h, reason: $!\n");
636
637 my $creation_time = localtime(time());
638 my $tmp = uc($arch);
639
640 print OUT<<EOF;
641 /**
642  * \@file
643  * \@brief Function prototypes for the new opcode functions.
644  * \@note  DO NOT EDIT THIS FILE, your changes will be lost.
645  *        Edit $specfile instead.
646  *        created by: $0 $specfile $target_dir
647  * \@date  $creation_time
648  */
649 #ifndef FIRM_BE_${tmp}_GEN_${tmp}_NEW_NODES_H
650 #define FIRM_BE_${tmp}_GEN_${tmp}_NEW_NODES_H
651
652 EOF
653
654 print OUT @obst_enum_op;
655 print OUT "int is_$arch\_irn(const ir_node *node);\n\n";
656 print OUT "int get_$arch\_opcode_first(void);\n";
657 print OUT "int get_$arch\_opcode_last(void);\n";
658 print OUT "int get_$arch\_irn_opcode(const ir_node *node);\n";
659 print OUT @obst_header;
660 print OUT @obst_proj;
661
662 print OUT <<EOF;
663 #endif
664 EOF
665
666 close(OUT);
667
668 ###
669 # Translates numeric arity into string constant.
670 ###
671 sub translate_arity {
672         my $arity = shift;
673
674         if ($arity =~ /^\d+$/) {
675                 if    ($arity == 0) {
676                         return "oparity_zero";
677                 }
678                 elsif ($arity == 1) {
679                         return "oparity_unary";
680                 }
681                 elsif ($arity == 2) {
682                         return "oparity_binary";
683                 }
684                 elsif ($arity == 3) {
685                         return "oparity_trinary";
686                 }
687                 else {
688                         return "oparity_any";
689                 }
690         } elsif ($arity == $ARITY_VARIABLE) {
691                 return "oparity_variable";
692         } elsif ($arity == $ARITY_DYNAMIC) {
693                 return "oparity_dynamic";
694         } else {
695                 die "Fatal error: Unknown arity $arity";
696         }
697 }
698
699 ###
700 # Return the list of pointers for the given execution units.
701 ###
702 sub gen_execunit_list_initializer {
703         my $units   = shift;
704         my $uc_arch = uc($arch);
705         my $ret     = "";
706         my $ret2    = "";
707         my %init;
708
709         foreach my $unit (@{ $units }) {
710                 if ($unit eq "DUMMY") {
711                         push(@{ $init{"DUMMY"} }, "\t\t&be_machine_execution_units_DUMMY[0]");
712                 }
713                 elsif (exists($cpu{"$unit"})) {
714                         # operation can be executed on all units of this type
715                         # -> add them all
716                         my $tp_name = "$arch\_execution_units_$unit";
717                         my $idx     = 0;
718                         foreach (@{ $cpu{"$unit"} }) {
719                                 next if ($idx++ == 0);  # skip first element (it's not a unit)
720                                 my $unit_name = "$uc_arch\_EXECUNIT_TP_$unit\_$_";
721                                 push(@{ $init{"$unit"} }, "\t\t&".$tp_name."[".$unit_name."]");
722                         }
723                 }
724                 else {
725                         # operation can be executed only a certain unit
726                         # -> find corresponding unit type
727                         my $found = 0;
728 TP_SEARCH:      foreach my $cur_type (keys(%cpu)) {
729                                 foreach my $cur_unit (@{ $cpu{"$cur_type"} }) {
730                                         if ($unit eq $cur_unit) {
731                                                 my $tp_name   = "$arch\_execution_units_$cur_type";
732                                                 my $unit_name = "$uc_arch\_EXECUNIT_TP_$cur_type\_$unit";
733                                                 push(@{ $init{"$unit"} }, "\t\t&".$tp_name."[".$unit_name."]");
734                                                 $found = 1;
735                                                 last TP_SEARCH;
736                                         }
737                                 }
738                         }
739
740                         if (! $found) {
741                                 print STDERR "Invalid execution unit $unit specified!\n";
742                         }
743                 }
744         }
745
746         # prepare the 2-dim array init
747         foreach my $key (keys(%init)) {
748                 $ret .= "\tstatic const be_execution_unit_t *allowed_units_".$key."[] =\n";
749                 $ret .= "\t{\n";
750                 foreach (@{ $init{"$key"} }) {
751                         $ret .= "$_,\n";
752                 }
753                 $ret .= "\t\tNULL\n";
754                 $ret .= "\t};\n";
755                 $ret2 .= "\t\tallowed_units_$key,\n";
756         }
757         $ret2 .= "\t\tNULL\n";
758
759         $ret .= "\tstatic const be_execution_unit_t **exec_units[] =\n";
760         $ret .= "\t{\n";
761         $ret .= $ret2;
762         $ret .= "\t};\n";
763
764         return $ret;
765 }