Permalink
Browse files

remove CLONE_SKIP frmo Event and Surface, but associates the object w…

…ith the interpreter which owns it so it only gets destroyed once... seems to work, but needs more testing...
  • Loading branch information...
1 parent a4394c0 commit 2be22bab99983d4330b300725d197f08f87a4997 @ruoso ruoso committed Jan 12, 2010
Showing with 50 additions and 26 deletions.
  1. +1 −1 lib/SDL/Event.pm
  2. +1 −1 lib/SDL/Surface.pm
  3. +21 −12 src/Core/objects/Event.xs
  4. +15 −4 src/Core/objects/Surface.xs
  5. +12 −8 typemap
View
@@ -5,5 +5,5 @@ require Exporter;
require DynaLoader;
our @ISA = qw(Exporter DynaLoader);
bootstrap SDL::Event;
-sub CLONE_SKIP { 1 };
+#sub CLONE_SKIP { 1 };
1;
View
@@ -5,5 +5,5 @@ require Exporter;
require DynaLoader;
our @ISA = qw(Exporter DynaLoader);
bootstrap SDL::Surface;
-sub CLONE_SKIP { 1 };
+#sub CLONE_SKIP { 1 };
1;
View
@@ -963,17 +963,26 @@ event_syswm_msg ( event, ... )
RETVAL
void
-event_DESTROY(self)
- SDL_Event *self
+event_DESTROY(bag)
+ SV* bag
CODE:
- if(self->type == SDL_USEREVENT)
- {
- if( (self->user).data1 != NULL )
- SvREFCNT_dec( (self->user).data1);
- if( (self->user).data2 != NULL )
- SvREFCNT_dec( (self->user).data2);
- }
- safefree(self);
-
-
+ if( sv_isobject(bag) && (SvTYPE(SvRV(bag)) == SVt_PVMG) ) {
+ void** pointers = (void**)(SvIV((SV*)SvRV( bag )));
+ SDL_Event* self = (SDL_Event*)(pointers[0]);
+ if (my_perl == pointers[1]) {
+ //warn("Freed surface %p and pixels %p \n", surface, surface->pixels);
+ if(self->type == SDL_USEREVENT) {
+ if( (self->user).data1 != NULL )
+ SvREFCNT_dec( (self->user).data1);
+ if( (self->user).data2 != NULL )
+ SvREFCNT_dec( (self->user).data2);
+ }
+ safefree(self);
+ free(pointers);
+ }
+ } else if (bag == 0) {
+ XSRETURN(0);
+ } else {
+ XSRETURN_UNDEF;
+ }
@@ -144,9 +144,20 @@ surface_set_pixels(surface, index, value)
((unsigned int*)surface->pixels)[index] = value;
void
-surface_DESTROY(surface)
- SDL_Surface *surface
+surface_DESTROY(bag)
+ SV* bag
CODE:
- //warn("Freed surface %p and pixels %p \n", surface, surface->pixels);
- SDL_FreeSurface(surface);
+ if( sv_isobject(bag) && (SvTYPE(SvRV(bag)) == SVt_PVMG) ) {
+ void** pointers = (void**)(SvIV((SV*)SvRV( bag )));
+ SDL_Surface* surface = (SDL_Surface*)(pointers[0]);
+ if (my_perl == pointers[1]) {
+ //warn("Freed surface %p and pixels %p \n", surface, surface->pixels);
+ SDL_FreeSurface(surface);
+ free(pointers);
+ }
+ } else if (bag == 0) {
+ XSRETURN(0);
+ } else {
+ XSRETURN_UNDEF;
+ }
View
20 typemap
@@ -102,18 +102,22 @@ OUTPUT
# The Perl object is blessed into 'CLASS', which should be a
# char* having the name of the package for the blessing.
O_OBJECT
- sv_setref_pv( $arg, CLASS, (void*)$var );
+ void** pointers = malloc(2 * sizeof(void*));
+ pointers[0] = (void*)$var;
+ pointers[1] = (void*)my_perl;
+ sv_setref_pv( $arg, CLASS, (void*)pointers );
INPUT
O_OBJECT
- if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
- { $var = ($type)SvIV((SV*)SvRV( $arg )); }
- else if ($arg == 0)
- { XSRETURN(0); }
- else{
- XSRETURN_UNDEF;
- }
+ if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) ) {
+ void** pointers = (void**)(SvIV((SV*)SvRV( $arg )));
+ $var = ($type)(pointers[0]);
+ } else if ($arg == 0) {
+ XSRETURN(0);
+ } else {
+ XSRETURN_UNDEF;
+ }

0 comments on commit 2be22ba

Please sign in to comment.