From 5abff6f94a51acbd09f85aee513dc0681aa1ee51 Mon Sep 17 00:00:00 2001 From: Tim Jenness Date: Tue, 17 Apr 2001 12:49:25 -1000 Subject: [PATCH] XS::Typemap - T_OPAQUE Message-ID: p4raw-id: //depot/perl@9737 --- ext/XS/Typemap/Typemap.pm | 3 +- ext/XS/Typemap/Typemap.xs | 86 +++++++++++++++++++++++++++++++++++++---------- ext/XS/Typemap/typemap | 1 + lib/ExtUtils/typemap | 6 ++-- t/lib/xs-typemap.t | 25 +++++++++++--- 5 files changed, 94 insertions(+), 27 deletions(-) diff --git a/ext/XS/Typemap/Typemap.pm b/ext/XS/Typemap/Typemap.pm index ccfdfb1..ce5a65f 100644 --- a/ext/XS/Typemap/Typemap.pm +++ b/ext/XS/Typemap/Typemap.pm @@ -66,8 +66,9 @@ $VERSION = '0.01'; T_REF_IV_REF T_REF_IV_PTR_IN T_REF_IV_PTR_OUT T_PTROBJ_IN T_PTROBJ_OUT - T_OPAQUE_IN T_OPAQUE_array + T_OPAQUE_IN T_OPAQUE_OUT T_OPAQUE_array T_OPAQUEPTR_IN T_OPAQUEPTR_OUT T_OPAQUEPTR_OUT_short + T_OPAQUEPTR_IN_struct T_OPAQUEPTR_OUT_struct T_ARRAY T_STDIO_open T_STDIO_close T_STDIO_print /); diff --git a/ext/XS/Typemap/Typemap.xs b/ext/XS/Typemap/Typemap.xs index ce8bb7c..a829efe 100644 --- a/ext/XS/Typemap/Typemap.xs +++ b/ext/XS/Typemap/Typemap.xs @@ -27,6 +27,15 @@ typedef int intArray; /* T_ARRAY */ typedef short shortOPQ; /* T_OPAQUE */ typedef int intOpq; /* T_OPAQUEPTR */ +/* A structure to test T_OPAQUEPTR */ +struct t_opaqueptr { + int a; + int b; + double c; +}; + +typedef struct t_opaqueptr astruct; + /* Some static memory for the tests */ I32 anint; intRef anintref; @@ -554,16 +563,21 @@ NOT YET =item T_OPAQUEPTR -This can be used to store a pointer in the string component of the -SV. Unlike T_PTR which stores the pointer in an IV that can be -printed, here the representation of the pointer is irrelevant and the -bytes themselves are just stored in the SV. If the pointer is -represented by 4 bytes then those 4 bytes are stored in the SV (and -length() will report a value of 4). This makes use of the fact that a -perl scalar can store arbritray data in its PV component. +This can be used to store bytes in the string component of the +SV. Here the representation of the data is irrelevant to perl and the +bytes themselves are just stored in the SV. It is assumed that the C +variable is a pointer (the bytes are copied from that memory +location). If the pointer is pointing to something that is +represented by 8 bytes then those 8 bytes are stored in the SV (and +length() will report a value of 8). This entry is similar to T_OPAQUE. + +In principal the unpack() command can be used to convert the bytes +back to a number (if the underlying type is known to be a number). -In principal the unpack() command can be used to convert the pointer -to a number. +This entry can be used to store a C structure (the number +of bytes to be copied is calculated using the C C function) +and can be used as an alternative to T_PTRREF without having to worry +about a memory leak (since Perl will clean up the SV). =cut @@ -592,18 +606,46 @@ T_OPAQUEPTR_OUT_short( ptr ) OUTPUT: RETVAL +# Test it with a structure +astruct * +T_OPAQUEPTR_IN_struct( a,b,c ) + int a + int b + double c + PREINIT: + struct t_opaqueptr test; + CODE: + test.a = a; + test.b = b; + test.c = c; + RETVAL = &test; + OUTPUT: + RETVAL + +void +T_OPAQUEPTR_OUT_struct( test ) + astruct * test + PPCODE: + XPUSHs(sv_2mortal(newSViv(test->a))); + XPUSHs(sv_2mortal(newSViv(test->b))); + XPUSHs(sv_2mortal(newSVnv(test->c))); + + =item T_OPAQUE -This can be used to store pointers to non-pointer types in an SV. It -is similar to T_OPAQUEPTR except that the typemap retrieves the -pointer itself rather than assuming that it is to be given a -pointer. This approach hides the pointer as a byte stream in the -string part of the SV rather than making the actual pointer value -available to Perl. +This can be used to store data from non-pointer types in the string +part of an SV. It is similar to T_OPAQUEPTR except that the +typemap retrieves the pointer directly rather than assuming it +is being supplied. For example if an integer is imported into +Perl using T_OPAQUE rather than T_IV the underlying bytes representing the integer will be stored in the SV but the actual integer value will not be +available. i.e. The data is opaque to perl. + +The data may be retrieved using the C function if the +underlying type of the byte stream is known. -There is no reason to use T_OPAQUE to pass the data to C. Use -T_OPAQUEPTR to do that since once the pointer is stored in the SV -T_OPAQUE and T_OPAQUEPTR are identical. +T_OPAQUE supports input and output of simple types. +T_OPAQUEPTR can be used to pass these bytes back into C if a pointer +is acceptable. =cut @@ -615,6 +657,14 @@ T_OPAQUE_IN( val ) OUTPUT: RETVAL +IV +T_OPAQUE_OUT( val ) + shortOPQ val + CODE: + RETVAL = (IV)val; + OUTPUT: + RETVAL + =item Implicit array xsubpp supports a special syntax for returning diff --git a/ext/XS/Typemap/typemap b/ext/XS/Typemap/typemap index 12928c4..2b0d2bf 100644 --- a/ext/XS/Typemap/typemap +++ b/ext/XS/Typemap/typemap @@ -16,3 +16,4 @@ intOpq T_IV intOpq * T_OPAQUEPTR shortOPQ T_OPAQUE shortOPQ * T_OPAQUEPTR +astruct * T_OPAQUEPTR diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index 08ca108..bce6227 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -19,7 +19,7 @@ size_t T_IV ssize_t T_IV time_t T_NV unsigned long * T_OPAQUEPTR -char ** T_PACKED +char ** T_PACKEDARRAY void * T_PTR Time_t * T_PV SV * T_SV @@ -120,7 +120,7 @@ T_PTRREF else Perl_croak(aTHX_ \"$var is not a reference\") T_REF_IV_REF - if (sv_isa($arg, \"${type}\")) { + if (sv_isa($arg, \"${ntype}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = *INT2PTR($type *, tmp); } @@ -163,7 +163,7 @@ T_REFOBJ else Perl_croak(aTHX_ \"$var is not of type ${ntype}\") T_OPAQUE - $var NOT IMPLEMENTED + $var = *($type *)SvPV($arg,PL_na) T_OPAQUEPTR $var = ($type)SvPV($arg,PL_na) T_PACKED diff --git a/t/lib/xs-typemap.t b/t/lib/xs-typemap.t index 1915d9e..eaf83cc 100644 --- a/t/lib/xs-typemap.t +++ b/t/lib/xs-typemap.t @@ -9,7 +9,7 @@ BEGIN { } use Test; -BEGIN { plan tests => 78 } +BEGIN { plan tests => 84 } use strict; use warnings; @@ -241,20 +241,35 @@ ok( $@ ); print "# T_OPAQUEPTR\n"; $t = 22; -$ptr = T_OPAQUEPTR_IN( $t ); -ok( T_OPAQUEPTR_OUT($ptr), $t); +my $p = T_OPAQUEPTR_IN( $t ); +ok( T_OPAQUEPTR_OUT($p), $t); + +# T_OPAQUEPTR with a struct +print "# T_OPAQUEPTR with a struct\n"; + +my @test = (5,6,7); +$p = T_OPAQUEPTR_IN_struct(@test); +my @result = T_OPAQUEPTR_OUT_struct($p); +ok(scalar(@result),scalar(@test)); +for (0..$#test) { + ok($result[$_], $test[$_]); +} # T_OPAQUE print "# T_OPAQUE\n"; $t = 48; -$ptr = T_OPAQUE_IN( $t ); -ok(T_OPAQUEPTR_OUT_short( $ptr ), $t); +$p = T_OPAQUE_IN( $t ); +ok(T_OPAQUEPTR_OUT_short( $p ), $t); # Test using T_OPAQUEPTR +ok(T_OPAQUE_OUT( $p ), $t ); # Test using T_OPQAQUE # T_OPAQUE_array +print "# A packed array\n"; + my @opq = (2,4,8); my $packed = T_OPAQUE_array(@opq); my @uopq = unpack("i*",$packed); +ok(scalar(@uopq), scalar(@opq)); for (0..$#opq) { ok( $uopq[$_], $opq[$_]); } -- 2.7.4