Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 1 | #!/usr/bin/env perl |
Maurus Cuelenaere | a9fdd60 | 2009-07-05 15:39:17 +0000 | [diff] [blame] | 2 | ############################################################################ |
| 3 | # __________ __ ___. |
| 4 | # Open \______ \ ____ ____ | | _\_ |__ _______ ___ |
| 5 | # Source | _// _ \_/ ___\| |/ /| __ \ / _ \ \/ / |
| 6 | # Jukebox | | ( <_> ) \___| < | \_\ ( <_> > < < |
| 7 | # Firmware |____|_ /\____/ \___ >__|_ \|___ /\____/__/\_ \ |
| 8 | # \/ \/ \/ \/ \/ |
| 9 | # $Id$ |
| 10 | # |
| 11 | # Copyright (C) 2009 by Maurus Cuelenaere |
| 12 | # |
| 13 | # All files in this archive are subject to the GNU General Public License. |
| 14 | # See the file COPYING in the source tree root for full license agreement. |
| 15 | # |
| 16 | # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY |
| 17 | # KIND, either express or implied. |
| 18 | # |
| 19 | ############################################################################ |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 20 | |
Maurus Cuelenaere | d8cef9c | 2010-06-18 12:28:34 +0000 | [diff] [blame] | 21 | |
| 22 | # The purpose of this script is to automatically generate Lua wrappers for |
| 23 | # (easily) portable C functions used in the Rockbox plugin API. |
| 24 | # It doesn't contain support for enums, structs or pointers (apart from char*). |
| 25 | # |
| 26 | # The output will be written to <build_dir>/apps/plugins/lua/rocklib_aux.c |
| 27 | |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 28 | sub trim |
| 29 | { |
| 30 | my $text = $_[0]; |
| 31 | $text =~ s/^\s+//; |
| 32 | $text =~ s/\s+$//; |
| 33 | return $text; |
| 34 | } |
| 35 | |
| 36 | sub rand_string |
| 37 | { |
| 38 | my @chars=('a'..'z'); |
| 39 | my $ret; |
| 40 | foreach (1..5) |
| 41 | { |
| 42 | $ret .= $chars[rand @chars]; |
| 43 | } |
| 44 | return $ret; |
| 45 | } |
| 46 | |
| 47 | |
| 48 | my @functions; |
| 49 | my @ported_functions; |
Maurus Cuelenaere | d8cef9c | 2010-06-18 12:28:34 +0000 | [diff] [blame] | 50 | # These functions are excluded from automatically wrapping. This is useful if |
| 51 | # you want to manually port them to Lua. The format is a standard Perl regular |
| 52 | # expression. |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 53 | my @forbidden_functions = ('^open$', |
William Wilgus | 0b7a8d5 | 2018-10-12 11:58:09 -0400 | [diff] [blame] | 54 | '^open_utf8$', |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 55 | '^close$', |
| 56 | '^read$', |
| 57 | '^write$', |
Rafaël Carré | bfd8d02 | 2010-06-18 13:10:14 +0000 | [diff] [blame] | 58 | '^mkdir$', |
| 59 | '^rmdir$', |
William Wilgus | 0b7a8d5 | 2018-10-12 11:58:09 -0400 | [diff] [blame] | 60 | '^remove$', |
| 61 | '^rename$', |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 62 | '^lseek$', |
| 63 | '^ftruncate$', |
| 64 | '^filesize$', |
| 65 | '^fdprintf$', |
| 66 | '^read_line$', |
| 67 | '^[a-z]+dir$', |
William Wilgus | df4cb9b | 2018-10-23 00:11:34 -0400 | [diff] [blame] | 68 | '^strip_extension$', |
| 69 | '^create_numbered_filename$', |
William Wilgus | 0b7a8d5 | 2018-10-12 11:58:09 -0400 | [diff] [blame] | 70 | '^s?+rand$', |
| 71 | '^strl?+cpy$', |
| 72 | '^strl?+cat$', |
William Wilgus | f6e10b8 | 2018-11-01 14:20:33 -0400 | [diff] [blame] | 73 | 'strn?+casecmp$', |
William Wilgus | be7a58c | 2018-10-30 22:40:23 -0400 | [diff] [blame] | 74 | '^iso_decode$', |
| 75 | '^utf8encode$', |
| 76 | '^utf16', |
William Wilgus | 0b7a8d5 | 2018-10-12 11:58:09 -0400 | [diff] [blame] | 77 | '^codec_', |
| 78 | '^timer_', |
William Wilgus | 9489843 | 2018-10-22 14:00:58 -0400 | [diff] [blame] | 79 | '^lcd_(mono_)?+bitmap', |
William Wilgus | df8233e | 2018-10-27 06:24:27 -0400 | [diff] [blame] | 80 | '^lcd_(draw|fill|update_)rect$', |
| 81 | '^lcd_draw(line|pixel)$', |
| 82 | '^lcd_(h|v)line$', |
| 83 | '^lcd_(update|clear_display|set_drawmode)$', |
| 84 | '^lcd_setfont$', |
| 85 | '^lcd_(set|get)_(fore|back)ground$', |
| 86 | '^lcd_put(s|sxy|s_scroll)$', |
| 87 | '^lcd_scroll_stop$', |
William Wilgus | f6e10b8 | 2018-11-01 14:20:33 -0400 | [diff] [blame] | 88 | '^backlight_o(n|ff)$', |
| 89 | '^backlight_set_brightness$', |
| 90 | '^buttonlight_set_brightness$', |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 91 | '^__.+$', |
| 92 | '^.+_(un)?cached$', |
William Wilgus | 2e1ca20 | 2018-10-30 12:05:15 -0400 | [diff] [blame] | 93 | '^audio_(status|get_file_pos|flush_and_reload_tracks)$', |
| 94 | '^audio_(ff_rewind|next|prev|play|pause|resume|stop)$', |
| 95 | '^playlist_(amount|add|create|start|resume|shuffle)$', |
| 96 | '^playlist_(sync|resume_track|remove_all_tracks)$', |
| 97 | '^playlist_(insert_track|insert_directory)$', |
William Wilgus | 74fe520 | 2018-10-30 13:56:36 -0400 | [diff] [blame] | 98 | '^pcm_is_(playing|paused)$', |
| 99 | '^pcm_play_(stop|pause|lock|unlock)$', |
| 100 | '^pcm_(apply_settings|get_bytes_waiting)$', |
| 101 | '^pcm_(set_frequency|calculate_peaks)$', |
William Wilgus | 6e32e06 | 2019-07-25 10:17:40 -0500 | [diff] [blame^] | 102 | '^sound_(set|current|default|min|max|unit|pitch|val2phys)$', |
William Wilgus | f6e10b8 | 2018-11-01 14:20:33 -0400 | [diff] [blame] | 103 | '^mixer_(set|get)_frequency$', |
| 104 | '^(trigger|cancel)_cpu_boost$', |
Michael Sevakis | 057c111 | 2010-05-14 07:17:03 +0000 | [diff] [blame] | 105 | '^round_value_to_list32$'); |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 106 | |
| 107 | my $rocklib = sprintf("%s/rocklib.c", $ARGV[0]); |
| 108 | open ROCKLIB, "<$rocklib" or die("Couldn't open $rocklib: $!"); |
| 109 | while(<ROCKLIB>) |
| 110 | { |
| 111 | if(/^RB_WRAP\(([^)]+)\)/) |
| 112 | { |
| 113 | push(@ported_functions, $1); |
| 114 | } |
| 115 | } |
| 116 | close ROCKLIB; |
| 117 | |
| 118 | # Parse plugin.h |
| 119 | my $start = 0; |
| 120 | while(<STDIN>) |
| 121 | { |
| 122 | if(/struct plugin_api \{/) |
| 123 | { |
| 124 | $start = 1; |
| 125 | } |
| 126 | elsif($start && /\};/) |
| 127 | { |
| 128 | $start = 0; |
| 129 | } |
| 130 | |
| 131 | if($start == 1) |
| 132 | { |
| 133 | my $line = $_; |
| 134 | while($line !~ /;/) |
| 135 | { |
| 136 | $line .= <STDIN>; |
| 137 | } |
| 138 | |
| 139 | $line =~ s/(\n|\r)//g; |
| 140 | |
| 141 | if($line =~ /([a-zA-Z *_]+)?\s?\(\*([^)]+)?\)\(([^)]+)\).*?;/) |
| 142 | { |
| 143 | $return_type = $1; |
| 144 | $name = $2; |
| 145 | $arguments = $3; |
| 146 | |
| 147 | $return_type = trim($return_type); |
| 148 | $arguments =~ s/\s{2,}/ /g; |
| 149 | |
| 150 | if( !grep($_ eq $name, @ported_functions) && |
| 151 | !grep($name =~ $_, @forbidden_functions)) |
| 152 | { |
| 153 | push(@functions, {'name' => $name, 'return' => $return_type, 'arg' => $arguments}); |
| 154 | } |
| 155 | } |
| 156 | } |
| 157 | } |
| 158 | |
| 159 | my $svnrev = '$Revision$'; |
| 160 | |
| 161 | # Print the header |
| 162 | print <<EOF |
Maurus Cuelenaere | d8cef9c | 2010-06-18 12:28:34 +0000 | [diff] [blame] | 163 | /* Automatically generated from rocklib.c & plugin.h ($svnrev) |
| 164 | * |
| 165 | * See apps/plugins/lua/rocklib_aux.pl for the generator. |
| 166 | */ |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 167 | |
| 168 | #define lrocklib_c |
| 169 | #define LUA_LIB |
| 170 | |
| 171 | #define _ROCKCONF_H_ /* We don't need strcmp() etc. wrappers */ |
| 172 | #include "lua.h" |
| 173 | #include "lauxlib.h" |
| 174 | #include "plugin.h" |
| 175 | |
| 176 | EOF |
| 177 | ; |
| 178 | |
| 179 | my %in_types = ('void' => \&in_void, |
| 180 | 'int' => \&in_int, |
| 181 | 'unsigned' => \&in_int, |
| 182 | 'unsignedint' => \&in_int, |
| 183 | 'signed' => \&in_int, |
| 184 | 'signedint' => \&in_int, |
| 185 | 'short' => \&in_int, |
| 186 | 'unsignedshort' => \&in_int, |
| 187 | 'signedshort' => \&in_int, |
| 188 | 'long' => \&in_int, |
| 189 | 'unsignedlong' => \&in_int, |
| 190 | 'signedlong' => \&in_int, |
| 191 | 'char' => \&in_int, |
| 192 | 'unsignedchar' => \&in_int, |
| 193 | 'signedchar' => \&in_int, |
Maurus Cuelenaere | b1a7511 | 2009-10-29 16:52:09 +0000 | [diff] [blame] | 194 | 'size_t' => \&in_int, |
| 195 | 'ssize_t' => \&in_int, |
| 196 | 'off_t' => \&in_int, |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 197 | 'char*' => \&in_string, |
| 198 | 'signedchar*' => \&in_string, |
| 199 | 'unsignedchar*' => \&in_string, |
| 200 | 'bool' => \&in_bool, |
| 201 | '_Bool' => \&in_bool |
| 202 | ), %out_types = ('void' => \&out_void, |
| 203 | 'int' => \&out_int, |
| 204 | 'unsigned' => \&out_int, |
| 205 | 'unsignedint' => \&out_int, |
| 206 | 'signed' => \&out_int, |
| 207 | 'signedint' => \&out_int, |
| 208 | 'short' => \&out_int, |
| 209 | 'unsignedshort' => \&out_int, |
| 210 | 'signedshort' => \&out_int, |
| 211 | 'long' => \&out_int, |
| 212 | 'unsignedlong' => \&out_int, |
| 213 | 'signedlong' => \&out_int, |
| 214 | 'char' => \&out_int, |
| 215 | 'unsignedchar' => \&out_int, |
| 216 | 'signedchar' => \&out_int, |
Maurus Cuelenaere | b1a7511 | 2009-10-29 16:52:09 +0000 | [diff] [blame] | 217 | 'size_t' => \&out_int, |
| 218 | 'ssize_t' => \&out_int, |
| 219 | 'off_t' => \&out_int, |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 220 | 'char*' => \&out_string, |
| 221 | 'signedchar*' => \&out_string, |
| 222 | 'unsignedchar*' => \&out_string, |
| 223 | 'bool' => \&out_bool, |
| 224 | '_Bool' => \&out_bool |
| 225 | ); |
| 226 | |
| 227 | sub in_void |
| 228 | { |
| 229 | return "\t(void)L;\n"; |
| 230 | } |
| 231 | |
| 232 | sub in_int |
| 233 | { |
| 234 | my ($name, $type, $pos) = @_; |
| 235 | return sprintf("\t%s %s = (%s) luaL_checkint(L, %d);\n", $type, $name, $type, $pos); |
| 236 | } |
| 237 | |
| 238 | sub in_string |
| 239 | { |
| 240 | my ($name, $type, $pos) = @_; |
| 241 | return sprintf("\t%s %s = (%s) luaL_checkstring(L, %d);\n", $type, $name, $type, $pos) |
| 242 | } |
| 243 | |
| 244 | sub in_bool |
| 245 | { |
| 246 | my ($name, $type, $pos) = @_; |
Marcin Bukat | bfd0179 | 2014-04-02 20:46:06 +0200 | [diff] [blame] | 247 | return sprintf("\tbool %s = luaL_checkboolean(L, %d);\n", $name, $pos) |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 248 | } |
| 249 | |
| 250 | sub out_void |
| 251 | { |
| 252 | my $name = $_[0]; |
| 253 | return sprintf("\t%s;\n\treturn 0;\n", $name); |
| 254 | } |
| 255 | |
| 256 | sub out_int |
| 257 | { |
| 258 | my ($name, $type) = @_; |
| 259 | return sprintf("\t%s result = %s;\n\tlua_pushinteger(L, result);\n\treturn 1;\n", $type, $name); |
| 260 | } |
| 261 | |
| 262 | sub out_string |
| 263 | { |
| 264 | my ($name, $type) = @_; |
| 265 | return sprintf("\t%s result = %s;\n\tlua_pushstring(L, result);\n\treturn 1;\n", $type, $name); |
| 266 | } |
| 267 | |
| 268 | sub out_bool |
| 269 | { |
| 270 | my ($name, $type) = @_; |
| 271 | return sprintf("\tbool result = %s;\n\tlua_pushboolean(L, result);\n\treturn 1;\n", $name); |
| 272 | } |
| 273 | |
William Wilgus | 47639fb | 2019-07-17 10:22:21 -0500 | [diff] [blame] | 274 | #Sort the functions |
| 275 | my @sorted_functions = sort { @$a{'name'} cmp @$b{'name'} } @functions; |
| 276 | |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 277 | # Print the functions |
| 278 | my @valid_functions; |
William Wilgus | 47639fb | 2019-07-17 10:22:21 -0500 | [diff] [blame] | 279 | foreach my $function (@sorted_functions) |
Maurus Cuelenaere | d755a5a | 2009-07-05 15:33:08 +0000 | [diff] [blame] | 280 | { |
| 281 | my $valid = 1, @arguments = (); |
| 282 | # Check for supported arguments |
| 283 | foreach my $argument (split(/,/, @$function{'arg'})) |
| 284 | { |
| 285 | $argument = trim($argument); |
| 286 | if($argument !~ /\[.+\]/ && ($argument =~ /^(.+[\s*])([^[*\s]*)/ |
| 287 | || $argument eq "void")) |
| 288 | { |
| 289 | my $literal_type, $type, $name; |
| 290 | if($argument eq "void") |
| 291 | { |
| 292 | $literal_type = "void", $type = "void", $name = ""; |
| 293 | } |
| 294 | else |
| 295 | { |
| 296 | $literal_type = trim($1), $name = trim($2), $type = trim($1); |
| 297 | $type =~ s/(\s|const)//g; |
| 298 | |
| 299 | if($name eq "") |
| 300 | { |
| 301 | $name = rand_string(); |
| 302 | } |
| 303 | } |
| 304 | |
| 305 | #printf "/* %s: %s|%s */\n", @$function{'name'}, $type, $name; |
| 306 | if(!defined $in_types{$type}) |
| 307 | { |
| 308 | $valid = 0; |
| 309 | break; |
| 310 | } |
| 311 | |
| 312 | push(@arguments, {'name' => $name, |
| 313 | 'type' => $type, |
| 314 | 'literal_type' => $literal_type |
| 315 | }); |
| 316 | } |
| 317 | else |
| 318 | { |
| 319 | $valid = 0; |
| 320 | break; |
| 321 | } |
| 322 | } |
| 323 | |
| 324 | # Check for supported return value |
| 325 | my $return = @$function{'return'}; |
| 326 | $return =~ s/(\s|const)//g; |
| 327 | #printf "/* %s: %s [%d] */\n", @$function{'name'}, $return, $valid; |
| 328 | if(!defined $out_types{$return}) |
| 329 | { |
| 330 | $valid = 0; |
| 331 | } |
| 332 | |
| 333 | if($valid == 1) |
| 334 | { |
| 335 | # Print the header |
| 336 | printf "static int rock_%s(lua_State *L)\n". |
| 337 | "{\n", |
| 338 | @$function{'name'}; |
| 339 | |
| 340 | # Print the arguments |
| 341 | my $i = 1; |
| 342 | foreach my $argument (@arguments) |
| 343 | { |
| 344 | print $in_types{@$argument{'type'}}->(@$argument{'name'}, @$argument{'literal_type'}, $i++); |
| 345 | } |
| 346 | |
| 347 | # Generate the arguments string |
| 348 | my $func_args = $arguments[0]{'name'}; |
| 349 | for(my $i = 1; $i < $#arguments + 1; $i++) |
| 350 | { |
| 351 | $func_args .= ", ".$arguments[$i]{'name'}; |
| 352 | } |
| 353 | |
| 354 | # Print the function call |
| 355 | my $func = sprintf("rb->%s(%s)", @$function{'name'}, $func_args); |
| 356 | |
| 357 | # Print the footer |
| 358 | print $out_types{$return}->($func, @$function{'return'}); |
| 359 | print "}\n\n"; |
| 360 | |
| 361 | push(@valid_functions, $function); |
| 362 | } |
| 363 | } |
| 364 | |
| 365 | # Print the C array |
| 366 | print "const luaL_Reg rocklib_aux[] =\n{\n"; |
| 367 | foreach my $function (@valid_functions) |
| 368 | { |
| 369 | printf "\t{\"%s\", rock_%s},\n", @$function{'name'}, @$function{'name'}; |
| 370 | } |
| 371 | print "\t{NULL, NULL}\n};\n\n"; |