src/language/expressions/optimize.incpl

   1 use strict;
   2 use warnings 'all';
   3
   4 do 'generate.pl';
   5 our (@order, %ops);
   6
   7 sub generate_output {
   8     for my $opname (@order) {
   9         my ($op) = $ops{$opname};
  10
  11         if (!$op->{OPTIMIZABLE} || $op->{UNIMPLEMENTED}) {
  12             print "case $opname:\n";
  13             print "  NOT_REACHED ();\n\n";
  14             next;
  15         }
  16
  17         my (@decls);
  18         my ($arg_idx) = 0;
  19         for my $arg (@{$op->{ARGS}}) {
  20             my ($decl);
  21             my ($name) = $arg->{NAME};
  22             my ($type) = $arg->{TYPE};
  23             my ($ctype) = c_type ($type);
  24             my ($idx) = $arg->{IDX};
  25             if (!defined ($idx)) {
  26                 my ($func) = "get_$type->{ATOM}_arg";
  27                 push (@decls, "${ctype}arg_$name = $func (node, $arg_idx)");
  28             } else {
  29                 my ($decl) = "size_t arg_$idx = node->arg_cnt";
  30                 $decl .= " - $arg_idx" if $arg_idx;
  31                 push (@decls, $decl);
  32
  33                 push (@decls, "${ctype}*arg_$name = "
  34                       . "get_$type->{ATOM}_args "
  35                       . " (node, $arg_idx, arg_$idx, e)");
  36             }
  37             $arg_idx++;
  38         }
  39
  40         my ($sysmis_cond) = make_sysmis_decl ($op, "node->min_valid");
  41         push (@decls, $sysmis_cond) if defined $sysmis_cond;
  42
  43         my (@args);
  44         for my $arg (@{$op->{ARGS}}) {
  45             push (@args, "arg_$arg->{NAME}");
  46             if (defined $arg->{IDX}) {
  47                 my ($idx) = "arg_$arg->{IDX}";
  48                 $idx .= " / $arg->{TIMES}" if $arg->{TIMES} != 1;
  49                 push (@args, $idx);
  50             }
  51         }
  52         for my $aux (@{$op->{AUX}}) {
  53             my ($type) = $aux->{TYPE};
  54             if ($type->{ROLE} eq 'leaf') {
  55                 my ($func) = "get_$type->{ATOM}_arg";
  56                 push (@args, "$func (node, $arg_idx)");
  57                 $arg_idx++;
  58             } elsif ($type->{ROLE} eq 'fixed') {
  59                 push (@args, $type->{FIXED_VALUE});
  60             } else {
  61                 die;
  62             }
  63         }
  64
  65         my ($result) = "eval_$op->{OPNAME} (" . join (', ', @args) . ")";
  66         if (@decls && defined ($sysmis_cond)) {
  67             my ($miss_ret) = $op->{RETURNS}{MISSING_VALUE};
  68             push (@decls, c_type ($op->{RETURNS}) . "result = "
  69                   . "force_sysmis ? $miss_ret : $result");
  70             $result = "result";
  71         }
  72
  73         print "case $opname:\n";
  74         my ($alloc_func) = "expr_allocate_$op->{RETURNS}{NAME}";
  75         if (@decls) {
  76             print "  {\n";
  77             print "    $_;\n" foreach @decls;
  78             print "    return $alloc_func (e, $result);\n";
  79             print "  }\n";
  80         } else {
  81             print "  return $alloc_func (e, $result);\n";
  82         }
  83         print "\n";
  84     }
  85 }