diff options
author | Maurus Cuelenaere <mcuelenaere@gmail.com> | 2009-07-05 15:33:08 +0000 |
---|---|---|
committer | Maurus Cuelenaere <mcuelenaere@gmail.com> | 2009-07-05 15:33:08 +0000 |
commit | d755a5ac58b8401255eb3a2e7b00e902bc06ad1d (patch) | |
tree | dfcbe89f139dbe54ae1e9e37176c78ab6df68a0e /apps/plugins/lua/rocklib_aux.pl | |
parent | 9b1c774218e59fbcb7160709687686275ee04c13 (diff) | |
download | rockbox-d755a5ac58b8401255eb3a2e7b00e902bc06ad1d.tar.gz rockbox-d755a5ac58b8401255eb3a2e7b00e902bc06ad1d.zip |
Lua: add script which wraps not-yet ported C functions to Lua
git-svn-id: svn://svn.rockbox.org/rockbox/trunk@21657 a1c6a512-1295-4272-9138-f99709370657
Diffstat (limited to 'apps/plugins/lua/rocklib_aux.pl')
-rwxr-xr-x | apps/plugins/lua/rocklib_aux.pl | 291 |
1 files changed, 291 insertions, 0 deletions
diff --git a/apps/plugins/lua/rocklib_aux.pl b/apps/plugins/lua/rocklib_aux.pl new file mode 100755 index 0000000000..b5de1e4544 --- /dev/null +++ b/apps/plugins/lua/rocklib_aux.pl | |||
@@ -0,0 +1,291 @@ | |||
1 | #!/usr/bin/env perl | ||
2 | |||
3 | sub trim | ||
4 | { | ||
5 | my $text = $_[0]; | ||
6 | $text =~ s/^\s+//; | ||
7 | $text =~ s/\s+$//; | ||
8 | return $text; | ||
9 | } | ||
10 | |||
11 | sub rand_string | ||
12 | { | ||
13 | my @chars=('a'..'z'); | ||
14 | my $ret; | ||
15 | foreach (1..5) | ||
16 | { | ||
17 | $ret .= $chars[rand @chars]; | ||
18 | } | ||
19 | return $ret; | ||
20 | } | ||
21 | |||
22 | |||
23 | my @functions; | ||
24 | my @ported_functions; | ||
25 | my @forbidden_functions = ('^open$', | ||
26 | '^close$', | ||
27 | '^read$', | ||
28 | '^write$', | ||
29 | '^lseek$', | ||
30 | '^ftruncate$', | ||
31 | '^filesize$', | ||
32 | '^fdprintf$', | ||
33 | '^read_line$', | ||
34 | '^[a-z]+dir$', | ||
35 | '^__.+$', | ||
36 | '^.+_(un)?cached$', | ||
37 | '^audio_play$'); | ||
38 | |||
39 | my $rocklib = sprintf("%s/rocklib.c", $ARGV[0]); | ||
40 | open ROCKLIB, "<$rocklib" or die("Couldn't open $rocklib: $!"); | ||
41 | while(<ROCKLIB>) | ||
42 | { | ||
43 | if(/^RB_WRAP\(([^)]+)\)/) | ||
44 | { | ||
45 | push(@ported_functions, $1); | ||
46 | } | ||
47 | } | ||
48 | close ROCKLIB; | ||
49 | |||
50 | # Parse plugin.h | ||
51 | my $start = 0; | ||
52 | while(<STDIN>) | ||
53 | { | ||
54 | if(/struct plugin_api \{/) | ||
55 | { | ||
56 | $start = 1; | ||
57 | } | ||
58 | elsif($start && /\};/) | ||
59 | { | ||
60 | $start = 0; | ||
61 | } | ||
62 | |||
63 | if($start == 1) | ||
64 | { | ||
65 | my $line = $_; | ||
66 | while($line !~ /;/) | ||
67 | { | ||
68 | $line .= <STDIN>; | ||
69 | } | ||
70 | |||
71 | $line =~ s/(\n|\r)//g; | ||
72 | |||
73 | if($line =~ /([a-zA-Z *_]+)?\s?\(\*([^)]+)?\)\(([^)]+)\).*?;/) | ||
74 | { | ||
75 | $return_type = $1; | ||
76 | $name = $2; | ||
77 | $arguments = $3; | ||
78 | |||
79 | $return_type = trim($return_type); | ||
80 | $arguments =~ s/\s{2,}/ /g; | ||
81 | |||
82 | if( !grep($_ eq $name, @ported_functions) && | ||
83 | !grep($name =~ $_, @forbidden_functions)) | ||
84 | { | ||
85 | push(@functions, {'name' => $name, 'return' => $return_type, 'arg' => $arguments}); | ||
86 | } | ||
87 | } | ||
88 | } | ||
89 | } | ||
90 | |||
91 | my $svnrev = '$Revision$'; | ||
92 | |||
93 | # Print the header | ||
94 | print <<EOF | ||
95 | /* Automatically generated of $svnrev from rocklib.c & plugin.h */ | ||
96 | |||
97 | #define lrocklib_c | ||
98 | #define LUA_LIB | ||
99 | |||
100 | #define _ROCKCONF_H_ /* We don't need strcmp() etc. wrappers */ | ||
101 | #include "lua.h" | ||
102 | #include "lauxlib.h" | ||
103 | #include "plugin.h" | ||
104 | |||
105 | EOF | ||
106 | ; | ||
107 | |||
108 | my %in_types = ('void' => \&in_void, | ||
109 | 'int' => \&in_int, | ||
110 | 'unsigned' => \&in_int, | ||
111 | 'unsignedint' => \&in_int, | ||
112 | 'signed' => \&in_int, | ||
113 | 'signedint' => \&in_int, | ||
114 | 'short' => \&in_int, | ||
115 | 'unsignedshort' => \&in_int, | ||
116 | 'signedshort' => \&in_int, | ||
117 | 'long' => \&in_int, | ||
118 | 'unsignedlong' => \&in_int, | ||
119 | 'signedlong' => \&in_int, | ||
120 | 'char' => \&in_int, | ||
121 | 'unsignedchar' => \&in_int, | ||
122 | 'signedchar' => \&in_int, | ||
123 | 'char*' => \&in_string, | ||
124 | 'signedchar*' => \&in_string, | ||
125 | 'unsignedchar*' => \&in_string, | ||
126 | 'bool' => \&in_bool, | ||
127 | '_Bool' => \&in_bool | ||
128 | ), %out_types = ('void' => \&out_void, | ||
129 | 'int' => \&out_int, | ||
130 | 'unsigned' => \&out_int, | ||
131 | 'unsignedint' => \&out_int, | ||
132 | 'signed' => \&out_int, | ||
133 | 'signedint' => \&out_int, | ||
134 | 'short' => \&out_int, | ||
135 | 'unsignedshort' => \&out_int, | ||
136 | 'signedshort' => \&out_int, | ||
137 | 'long' => \&out_int, | ||
138 | 'unsignedlong' => \&out_int, | ||
139 | 'signedlong' => \&out_int, | ||
140 | 'char' => \&out_int, | ||
141 | 'unsignedchar' => \&out_int, | ||
142 | 'signedchar' => \&out_int, | ||
143 | 'char*' => \&out_string, | ||
144 | 'signedchar*' => \&out_string, | ||
145 | 'unsignedchar*' => \&out_string, | ||
146 | 'bool' => \&out_bool, | ||
147 | '_Bool' => \&out_bool | ||
148 | ); | ||
149 | |||
150 | sub in_void | ||
151 | { | ||
152 | return "\t(void)L;\n"; | ||
153 | } | ||
154 | |||
155 | sub in_int | ||
156 | { | ||
157 | my ($name, $type, $pos) = @_; | ||
158 | return sprintf("\t%s %s = (%s) luaL_checkint(L, %d);\n", $type, $name, $type, $pos); | ||
159 | } | ||
160 | |||
161 | sub in_string | ||
162 | { | ||
163 | my ($name, $type, $pos) = @_; | ||
164 | return sprintf("\t%s %s = (%s) luaL_checkstring(L, %d);\n", $type, $name, $type, $pos) | ||
165 | } | ||
166 | |||
167 | sub in_bool | ||
168 | { | ||
169 | my ($name, $type, $pos) = @_; | ||
170 | return sprintf("\tbool %s = luaL_checkboolean(L, %d);\n", $name, $pos) | ||
171 | } | ||
172 | |||
173 | sub out_void | ||
174 | { | ||
175 | my $name = $_[0]; | ||
176 | return sprintf("\t%s;\n\treturn 0;\n", $name); | ||
177 | } | ||
178 | |||
179 | sub out_int | ||
180 | { | ||
181 | my ($name, $type) = @_; | ||
182 | return sprintf("\t%s result = %s;\n\tlua_pushinteger(L, result);\n\treturn 1;\n", $type, $name); | ||
183 | } | ||
184 | |||
185 | sub out_string | ||
186 | { | ||
187 | my ($name, $type) = @_; | ||
188 | return sprintf("\t%s result = %s;\n\tlua_pushstring(L, result);\n\treturn 1;\n", $type, $name); | ||
189 | } | ||
190 | |||
191 | sub out_bool | ||
192 | { | ||
193 | my ($name, $type) = @_; | ||
194 | return sprintf("\tbool result = %s;\n\tlua_pushboolean(L, result);\n\treturn 1;\n", $name); | ||
195 | } | ||
196 | |||
197 | # Print the functions | ||
198 | my @valid_functions; | ||
199 | foreach my $function (@functions) | ||
200 | { | ||
201 | my $valid = 1, @arguments = (); | ||
202 | # Check for supported arguments | ||
203 | foreach my $argument (split(/,/, @$function{'arg'})) | ||
204 | { | ||
205 | $argument = trim($argument); | ||
206 | if($argument !~ /\[.+\]/ && ($argument =~ /^(.+[\s*])([^[*\s]*)/ | ||
207 | || $argument eq "void")) | ||
208 | { | ||
209 | my $literal_type, $type, $name; | ||
210 | if($argument eq "void") | ||
211 | { | ||
212 | $literal_type = "void", $type = "void", $name = ""; | ||
213 | } | ||
214 | else | ||
215 | { | ||
216 | $literal_type = trim($1), $name = trim($2), $type = trim($1); | ||
217 | $type =~ s/(\s|const)//g; | ||
218 | |||
219 | if($name eq "") | ||
220 | { | ||
221 | $name = rand_string(); | ||
222 | } | ||
223 | } | ||
224 | |||
225 | #printf "/* %s: %s|%s */\n", @$function{'name'}, $type, $name; | ||
226 | if(!defined $in_types{$type}) | ||
227 | { | ||
228 | $valid = 0; | ||
229 | break; | ||
230 | } | ||
231 | |||
232 | push(@arguments, {'name' => $name, | ||
233 | 'type' => $type, | ||
234 | 'literal_type' => $literal_type | ||
235 | }); | ||
236 | } | ||
237 | else | ||
238 | { | ||
239 | $valid = 0; | ||
240 | break; | ||
241 | } | ||
242 | } | ||
243 | |||
244 | # Check for supported return value | ||
245 | my $return = @$function{'return'}; | ||
246 | $return =~ s/(\s|const)//g; | ||
247 | #printf "/* %s: %s [%d] */\n", @$function{'name'}, $return, $valid; | ||
248 | if(!defined $out_types{$return}) | ||
249 | { | ||
250 | $valid = 0; | ||
251 | } | ||
252 | |||
253 | if($valid == 1) | ||
254 | { | ||
255 | # Print the header | ||
256 | printf "static int rock_%s(lua_State *L)\n". | ||
257 | "{\n", | ||
258 | @$function{'name'}; | ||
259 | |||
260 | # Print the arguments | ||
261 | my $i = 1; | ||
262 | foreach my $argument (@arguments) | ||
263 | { | ||
264 | print $in_types{@$argument{'type'}}->(@$argument{'name'}, @$argument{'literal_type'}, $i++); | ||
265 | } | ||
266 | |||
267 | # Generate the arguments string | ||
268 | my $func_args = $arguments[0]{'name'}; | ||
269 | for(my $i = 1; $i < $#arguments + 1; $i++) | ||
270 | { | ||
271 | $func_args .= ", ".$arguments[$i]{'name'}; | ||
272 | } | ||
273 | |||
274 | # Print the function call | ||
275 | my $func = sprintf("rb->%s(%s)", @$function{'name'}, $func_args); | ||
276 | |||
277 | # Print the footer | ||
278 | print $out_types{$return}->($func, @$function{'return'}); | ||
279 | print "}\n\n"; | ||
280 | |||
281 | push(@valid_functions, $function); | ||
282 | } | ||
283 | } | ||
284 | |||
285 | # Print the C array | ||
286 | print "const luaL_Reg rocklib_aux[] =\n{\n"; | ||
287 | foreach my $function (@valid_functions) | ||
288 | { | ||
289 | printf "\t{\"%s\", rock_%s},\n", @$function{'name'}, @$function{'name'}; | ||
290 | } | ||
291 | print "\t{NULL, NULL}\n};\n\n"; | ||