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