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