src/expressions/evaluate.inc.pl

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