src/expressions/optimize.inc.pl

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