Implemented long variable names a la spss V12.
[pspp] / 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 }