src/language/expressions/evaluate.incpl

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