Permalink
Browse files

Merge branch 'wrap-opengl-strings'

  • Loading branch information...
plobsing committed May 16, 2011
2 parents c07f2ff + 478188d commit aafb6933dd9aa8f3b7b75db24da51f7f71ac1ecc
Showing with 162 additions and 14 deletions.
  1. +43 −6 config/gen/opengl.pm
  2. +106 −7 runtime/parrot/library/NCI/Utils.pir
  3. +13 −1 runtime/parrot/library/OpenGL.pir
View
@@ -287,7 +287,7 @@ my %PCC_CAST = (
);
my %OVERRIDE = (
glutInit => [qw[ void int& ptr ]],
glutInit => [[qw[ void int& ptr ]], [0, 0, 0]],
);
my @IGNORE = (
@@ -716,7 +716,8 @@ sub gen_opengl_wrappers {
$group = lc $group;
# Convert return and param types to NCI signature
my @nci_sig = @{$OVERRIDE{$name} or []};
my @nci_sig = @{${$OVERRIDE{$name} or []}[0] or []};
my @cstr_trans = @{${$OVERRIDE{$name} or []}[1] or []};
unless (@nci_sig) {
$params = '' if $params eq 'void';
@@ -732,7 +733,8 @@ sub gen_opengl_wrappers {
if $verbose;
next PROTO;
}
push @nci_sig, $NCI_TYPE{$param};
push @nci_sig, $NCI_TYPE{$param};
push @cstr_trans, $param eq 'char*';
}
if (any sub { $_ eq 'void' }, @nci_sig[1..$#nci_sig]) {
@@ -746,7 +748,7 @@ sub gen_opengl_wrappers {
# Success! Save results.
$pass{$file}++;
$sigs{join ',', @nci_sig} = [@nci_sig];
push @{$funcs{$group}}, [$name, [@nci_sig]];
push @{$funcs{$group}}, [$name, [@nci_sig], [@cstr_trans]];
my $nci_sig = '[' . (join ',', @nci_sig) . ']';
print "$group\t$nci_sig\t$return $name($params);\n"
@@ -796,64 +798,94 @@ HEADER
glutcb_funcs = new 'ResizableStringArray'
push glutcb_funcs, 'Parrot_glut_nci_loader'
push glutcb_funcs, 'void,ptr'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbCloseFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbDisplayFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbIdleFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbMenuDestroyFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbOverlayDisplayFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbWMCloseFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbEntryFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbMenuStateFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbVisibilityFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbWindowStatusFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbButtonBoxFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbDialsFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbMotionFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbPassiveMotionFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbReshapeFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbSpaceballButtonFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbTabletMotionFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbKeyboardFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbKeyboardUpFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbMenuStatusFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbSpaceballMotionFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbSpaceballRotateFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbSpecialFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbSpecialUpFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbMouseFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbMouseWheelFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbTabletButtonFunc'
push glutcb_funcs, 'void,ptr,PMC'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbTimerFunc'
push glutcb_funcs, 'void,ptr,PMC,int,int'
push glutcb_funcs, ''
push glutcb_funcs, 'glutcbJoystickFunc'
push glutcb_funcs, 'void,ptr,PMC,int'
push glutcb_funcs, ''
.return (glutcb_funcs)
.end
@@ -874,13 +906,18 @@ SUB_HEADER
my @funcs = sort {$a->[0] cmp $b->[0]} @{$funcs{$group}};
foreach my $func (@funcs) {
my ($name, $sig) = @$func;
my ($name, $sig, $cstr) = @$func;
my $sig_str = join ',', @$sig;
my $sig_str = join ',', @$sig;
my $cstr_str = do {
my $i = -1;
join ',', map $_->[1], grep $_->[0], map [$_, $i++], @$cstr;
};
print $funcs <<"FUNCTION"
push $list_name, '$name'
push $list_name, '$sig_str'
push $list_name, '$cstr_str'
FUNCTION
}
print $funcs <<"SUB_FOOTER";
@@ -77,13 +77,15 @@ this will tend to make the toolkit init function much happier.
.include 'datatypes.pasm'
.sub _init_nci_utils :load
# Mark all functions for export
.local pmc parrot
load_language 'parrot'
parrot = compreg 'parrot'
parrot.'export'('call_toolkit_init')
.end
# TODO: this crashes rakudo
# .sub _init_nci_utils :load
# # Mark all functions for export
# .local pmc parrot
# load_language 'parrot'
# parrot = compreg 'parrot'
# parrot.'export'('call_toolkit_init')
# parrot.'export'('call_with_cstring')
# .end
.sub call_toolkit_init
.param pmc init_func
@@ -152,6 +154,103 @@ this will tend to make the toolkit init function much happier.
.return (new_argv)
.end
.sub call_with_cstring
.param pmc func
.param pmc cstrings :slurpy
.local pmc cstr_args
cstr_args = new ['ResizableIntegerArray']
.local pmc i
i = iter cstrings
loop:
unless i goto end_loop
$I0 = shift i
unless $I0 == -1 goto else
func = wrap_cstr_ret(func)
goto endif
else:
push cstr_args, $I0
endif:
goto loop
end_loop:
$I0 = elements cstr_args
unless $I0 goto done_wrap_args
func = wrap_cstr_args(func, cstr_args)
done_wrap_args:
.return (func)
.end
.sub 'wrap_cstr_ret' :anon
.param pmc func
.lex 'func', func
.const 'Sub' $P0 = 'wrap_ret_closure'
$P0 = newclosure $P0
.return ($P0)
.end
.sub 'wrap_ret_closure' :anon :outer('wrap_cstr_ret')
.param pmc args :slurpy
$P0 = find_lex 'func'
$P0 = $P0(args :flat)
$P1 = null
$P1 = dlfunc $P1, 'Parrot_str_new', 'Spi'
$P2 = getinterp
$S0 = $P1($P2, 0)
.return ($S0)
.end
.sub 'wrap_cstr_args' :anon
.param pmc func
.param pmc cstr_args
.lex 'func', func
.lex 'cstr_args', cstr_args
.const 'Sub' $P0 = 'wrap_args_closure'
$P0 = newclosure $P0
.return ($P0)
.end
.sub 'wrap_args_closure' :anon :outer('wrap_cstr_args')
.param pmc args :slurpy
.local pmc func
.local pmc cstr_args
func = find_lex 'func'
cstr_args = find_lex 'cstr_args'
.local pmc interp, str_to_cstring, str_free_cstring
interp = getinterp
$P0 = null
str_to_cstring = dlfunc $P0, 'Parrot_str_to_cstring', 'ppS'
str_free_cstring = dlfunc $P0, 'Parrot_str_free_cstring', 'vp'
.local pmc i
i = iter cstr_args
trans_loop:
unless i goto end_trans_loop
$I0 = shift i
$S0 = args[$I0]
$P0 = str_to_cstring(interp, $S0)
args[$I0] = $P0
goto trans_loop
end_trans_loop:
.local pmc retv
(retv :slurpy) = func(args :flat)
i = iter cstr_args
free_loop:
unless i goto end_free_loop
$I0 = shift i
$P0 = args[$I0]
str_free_cstring($P0)
goto free_loop
end_free_loop:
.return (retv :flat)
.end
# Local Variables:
# mode: pir
@@ -226,14 +226,16 @@ alternating function names and Parrot NCI signatures.
.local pmc list_iter
list_iter = iter nci_list
.local string func_name, signature
.local string func_name, signature, cstrings
.local pmc function
list_loop:
unless list_iter goto done
func_name = shift list_iter
signature = shift list_iter
cstrings = shift list_iter
$P0 = '_parse_signature'(signature)
function = dlfunc library, func_name, $P0
function = '_wrap_cstrings'(function, cstrings)
unless first_arg_interp goto done_interp_wrap
.const 'Sub' $P0 = '_call_with_interp'
$P0 = clone $P0
@@ -284,6 +286,16 @@ alternating function names and Parrot NCI signatures.
.return (retv)
.end
.sub '_wrap_cstrings' :anon
.param pmc func
.param string cstrings
$P0 = split ',', cstrings
load_bytecode 'NCI/Utils.pbc'
$P1 = get_root_global ['parrot';'NCI';'Utils'], 'call_with_cstring'
func = $P1(func, $P0 :flat)
.return (func)
.end
=back
=head2 Thunk Loading

0 comments on commit aafb693

Please sign in to comment.