From d755a5ac58b8401255eb3a2e7b00e902bc06ad1d Mon Sep 17 00:00:00 2001 From: Maurus Cuelenaere Date: Sun, 5 Jul 2009 15:33:08 +0000 Subject: 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 --- apps/plugins/lua/rocklib_aux.pl | 291 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 291 insertions(+) create mode 100755 apps/plugins/lua/rocklib_aux.pl (limited to 'apps/plugins/lua/rocklib_aux.pl') 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 @@ +#!/usr/bin/env perl + +sub trim +{ + my $text = $_[0]; + $text =~ s/^\s+//; + $text =~ s/\s+$//; + return $text; +} + +sub rand_string +{ + my @chars=('a'..'z'); + my $ret; + foreach (1..5) + { + $ret .= $chars[rand @chars]; + } + return $ret; +} + + +my @functions; +my @ported_functions; +my @forbidden_functions = ('^open$', + '^close$', + '^read$', + '^write$', + '^lseek$', + '^ftruncate$', + '^filesize$', + '^fdprintf$', + '^read_line$', + '^[a-z]+dir$', + '^__.+$', + '^.+_(un)?cached$', + '^audio_play$'); + +my $rocklib = sprintf("%s/rocklib.c", $ARGV[0]); +open ROCKLIB, "<$rocklib" or die("Couldn't open $rocklib: $!"); +while() +{ + if(/^RB_WRAP\(([^)]+)\)/) + { + push(@ported_functions, $1); + } +} +close ROCKLIB; + +# Parse plugin.h +my $start = 0; +while() +{ + if(/struct plugin_api \{/) + { + $start = 1; + } + elsif($start && /\};/) + { + $start = 0; + } + + if($start == 1) + { + my $line = $_; + while($line !~ /;/) + { + $line .= ; + } + + $line =~ s/(\n|\r)//g; + + if($line =~ /([a-zA-Z *_]+)?\s?\(\*([^)]+)?\)\(([^)]+)\).*?;/) + { + $return_type = $1; + $name = $2; + $arguments = $3; + + $return_type = trim($return_type); + $arguments =~ s/\s{2,}/ /g; + + if( !grep($_ eq $name, @ported_functions) && + !grep($name =~ $_, @forbidden_functions)) + { + push(@functions, {'name' => $name, 'return' => $return_type, 'arg' => $arguments}); + } + } + } +} + +my $svnrev = '$Revision$'; + +# Print the header +print < \&in_void, + 'int' => \&in_int, + 'unsigned' => \&in_int, + 'unsignedint' => \&in_int, + 'signed' => \&in_int, + 'signedint' => \&in_int, + 'short' => \&in_int, + 'unsignedshort' => \&in_int, + 'signedshort' => \&in_int, + 'long' => \&in_int, + 'unsignedlong' => \&in_int, + 'signedlong' => \&in_int, + 'char' => \&in_int, + 'unsignedchar' => \&in_int, + 'signedchar' => \&in_int, + 'char*' => \&in_string, + 'signedchar*' => \&in_string, + 'unsignedchar*' => \&in_string, + 'bool' => \&in_bool, + '_Bool' => \&in_bool +), %out_types = ('void' => \&out_void, + 'int' => \&out_int, + 'unsigned' => \&out_int, + 'unsignedint' => \&out_int, + 'signed' => \&out_int, + 'signedint' => \&out_int, + 'short' => \&out_int, + 'unsignedshort' => \&out_int, + 'signedshort' => \&out_int, + 'long' => \&out_int, + 'unsignedlong' => \&out_int, + 'signedlong' => \&out_int, + 'char' => \&out_int, + 'unsignedchar' => \&out_int, + 'signedchar' => \&out_int, + 'char*' => \&out_string, + 'signedchar*' => \&out_string, + 'unsignedchar*' => \&out_string, + 'bool' => \&out_bool, + '_Bool' => \&out_bool +); + +sub in_void +{ + return "\t(void)L;\n"; +} + +sub in_int +{ + my ($name, $type, $pos) = @_; + return sprintf("\t%s %s = (%s) luaL_checkint(L, %d);\n", $type, $name, $type, $pos); +} + +sub in_string +{ + my ($name, $type, $pos) = @_; + return sprintf("\t%s %s = (%s) luaL_checkstring(L, %d);\n", $type, $name, $type, $pos) +} + +sub in_bool +{ + my ($name, $type, $pos) = @_; + return sprintf("\tbool %s = luaL_checkboolean(L, %d);\n", $name, $pos) +} + +sub out_void +{ + my $name = $_[0]; + return sprintf("\t%s;\n\treturn 0;\n", $name); +} + +sub out_int +{ + my ($name, $type) = @_; + return sprintf("\t%s result = %s;\n\tlua_pushinteger(L, result);\n\treturn 1;\n", $type, $name); +} + +sub out_string +{ + my ($name, $type) = @_; + return sprintf("\t%s result = %s;\n\tlua_pushstring(L, result);\n\treturn 1;\n", $type, $name); +} + +sub out_bool +{ + my ($name, $type) = @_; + return sprintf("\tbool result = %s;\n\tlua_pushboolean(L, result);\n\treturn 1;\n", $name); +} + +# Print the functions +my @valid_functions; +foreach my $function (@functions) +{ + my $valid = 1, @arguments = (); + # Check for supported arguments + foreach my $argument (split(/,/, @$function{'arg'})) + { + $argument = trim($argument); + if($argument !~ /\[.+\]/ && ($argument =~ /^(.+[\s*])([^[*\s]*)/ + || $argument eq "void")) + { + my $literal_type, $type, $name; + if($argument eq "void") + { + $literal_type = "void", $type = "void", $name = ""; + } + else + { + $literal_type = trim($1), $name = trim($2), $type = trim($1); + $type =~ s/(\s|const)//g; + + if($name eq "") + { + $name = rand_string(); + } + } + + #printf "/* %s: %s|%s */\n", @$function{'name'}, $type, $name; + if(!defined $in_types{$type}) + { + $valid = 0; + break; + } + + push(@arguments, {'name' => $name, + 'type' => $type, + 'literal_type' => $literal_type + }); + } + else + { + $valid = 0; + break; + } + } + + # Check for supported return value + my $return = @$function{'return'}; + $return =~ s/(\s|const)//g; + #printf "/* %s: %s [%d] */\n", @$function{'name'}, $return, $valid; + if(!defined $out_types{$return}) + { + $valid = 0; + } + + if($valid == 1) + { + # Print the header + printf "static int rock_%s(lua_State *L)\n". + "{\n", + @$function{'name'}; + + # Print the arguments + my $i = 1; + foreach my $argument (@arguments) + { + print $in_types{@$argument{'type'}}->(@$argument{'name'}, @$argument{'literal_type'}, $i++); + } + + # Generate the arguments string + my $func_args = $arguments[0]{'name'}; + for(my $i = 1; $i < $#arguments + 1; $i++) + { + $func_args .= ", ".$arguments[$i]{'name'}; + } + + # Print the function call + my $func = sprintf("rb->%s(%s)", @$function{'name'}, $func_args); + + # Print the footer + print $out_types{$return}->($func, @$function{'return'}); + print "}\n\n"; + + push(@valid_functions, $function); + } +} + +# Print the C array +print "const luaL_Reg rocklib_aux[] =\n{\n"; +foreach my $function (@valid_functions) +{ + printf "\t{\"%s\", rock_%s},\n", @$function{'name'}, @$function{'name'}; +} +print "\t{NULL, NULL}\n};\n\n"; -- cgit v1.2.3