1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
#!/usr/bin/perl
require 'c_types.pl';
die "Usage: $0 features.def call-vector.h.in" unless $#ARGV == 1;
$[ = 1; # set array base to 1
$, = ' '; # set output field separator
$\ = "\n"; # set output record separator
sub toupper {
local($_) = @_;
tr/a-z/A-Z/;
return $_;
}
sub tolower {
local($_) = @_;
tr/A-Z/a-z/;
return $_;
}
$func_decl_code = '';
open FEATURESDEF, $ARGV[1] or
die "open ($ARGV[1]): $!";
while (<FEATURESDEF>) {
chop; # strip record separator
if (/^[^\#]/) {
&parse_features_def ($_);
}
}
close FEATURESDEF;
sub parse_features_def {
local($line) = @_;
@line_fields = split(/\|/, $line, 9999);
$retval = $line_fields[1];
$element_def = $line_fields[3];
$feature = $line_fields[2];
$param_def = $line_fields[4];
$orig = $feature;
$feature =~ s/^@//;
$space = $feature;
$space =~ s/./ /g;
if ($retval eq 'retval') {
$retval_param = '&retval';
$retval = 'int';
}
elsif ($retval !~ /^void$/) {
$retval_param = 'NULL';
}
else {
$retval_param = 'NULL';
}
if ($retval =~ /^(array|pointer)\((.*)\)$/) {
$retval = ($2 eq 'string') ? 'char **' : "$2 *";
}
$param_decl = '';
$nr_params = (@params = split(/:/, $param_def, 9999));
for ($param = 1; $param <= $nr_params; $param++) {
$list = $params[$param];
$type = $params[$param];
$type =~ s/\(.*//;
$list =~ s/^.*\(//;
$list =~ s/\)$//;
$count = (@fields = split(/,/, $list, 9999));
for ($field = 1; $field <= $count; $field++) {
my $c_type = $typeinfo->{$type}->[1];
$param_decl = $param_decl . ', ';
$param_decl = $param_decl . $c_type;
}
}
if ($line_fields[3] eq '') {
$func_decl_code .= sprintf
(qq[\t%s (*%s) (glibtop_server *, glibtop_closure *%s);\n], $retval, $feature, $param_decl);
} elsif ($line_fields[3] eq 'array') {
$func_decl_code .= sprintf
(qq[\t%s (*%s) (glibtop_server *, glibtop_closure *, glibtop_array *%s);\n], $retval, $feature, $param_decl);
} elsif ($line_fields[3] =~ /^array/) {
$func_decl_code .= sprintf
(qq[\t%s (*%s) (glibtop_server *, glibtop_closure *, glibtop_array *, %s *%s);\n], $retval, $feature, 'glibtop_'.$feature, $param_decl);
} else {
$func_decl_code .= sprintf
(qq[\t%s (*%s) (glibtop_server *, glibtop_closure *, %s *%s);\n], $retval, $feature, 'glibtop_'.$feature, $param_decl);
}
}
chop $func_decl_code;
$auto_gen_comment = sprintf
(qq[/*\n * This file is automatically generated.\n * Please modify `call-vector.pl' and `call-vector.h.in'.\n */]);
open CALLVECTOR, $ARGV[2] or
die "open ($ARGV[2]): $!";
while (<CALLVECTOR>) {
chop;
s/^\s*\@\@GLIBTOP_CALL_VECTOR\@\@\s*$/$func_decl_code/;
s/^\s*\@\@AUTOGEN_COMMENT\@\@\s*$/$auto_gen_comment/;
} continue {
print $_;
}
close CALLVECTOR;
|
