view release on metacpan or  search on metacpan

gperl_marshal.h  view on Meta::CPAN

	SPAGAIN;						\
	if (!instance)						\
		instance = &PL_sv_undef;			\
	/* the instance is always the first item in @_ */	\
	XPUSHs (sv_2mortal (instance));

/*
=item GPERL_CLOSURE_MARSHAL_PUSH_DATA

Push the callback's user data onto the Perl arg stack, with XPUSHs.  Handles
the case of swapped instance and data.  The user data is not included in
param_values.

=cut
*/
#define GPERL_CLOSURE_MARSHAL_PUSH_DATA	\
	if (data) XPUSHs (sv_2mortal (data));


/*
=item GPERL_CLOSURE_MARSHAL_CALL(flags)

Invoke the callback.  You must ensure that all the arguments are already on
the stack, and that you've called PUTBACK.  This will invoke call_sv(), adding
G_EVAL to the I<flags> you supply, and store the return value in I<count> on
the stack (count is declared by C<dGPERL_CLOSURE_MARSHAL_ARGS>).  It then
refreshes the stack pointer.  If an exception occurred, the function returns
after running exception handlers.

You'll be interested in the following values for I<flags>:

 G_DISCARD
     this is effectively "void return", as it discards whatever the
     callback put on the return stack.
 G_SCALAR
     invoke the callback in scalar context.  you are pretty much
     guaranteed that one item will be on the stack, even if it is
     undef.
 G_ARRAY
     invoke the callback in array context.  C<count> (declared by
     C<dGPERL_CLOSURE_MARSHAL_ARGS>) will contain the number of
     items on the return stack.

As the callback is always run with G_EVAL, call_sv() will clobber ERRSV
($@); since closures are typically part of a mechanism that is transparent
to the layer of Perl code that calls them, we save and restore ERRSV.  Thus,
code like

  eval { something that fails }
  $button->clicked;
  # $@ still has value from eval above

works as expected.

See C<call_sv> in L<perlcall> for more information.

=cut
*/
#define GPERL_CLOSURE_MARSHAL_CALL(flags)	\
	{							\
	/* copy is needed to keep the old value alive. */	\
	/* mortal so it will die if not stolen by SvSetSV. */	\
	SV * save_errsv = sv_2mortal (newSVsv (ERRSV));		\
	count = call_sv (pc->callback, (flags) | G_EVAL);	\
	SPAGAIN;						\
	if (SvTRUE (ERRSV)) {					\
		gperl_run_exception_handlers ();		\
		SvSetSV (ERRSV, save_errsv);			\
		FREETMPS;					\
		LEAVE;						\
		return;						\
	}							\
	SvSetSV (ERRSV, save_errsv);				\
	}


/***************************************************************************/

/*
=item dGPERL_CALLBACK_MARSHAL_SP

Declare the stack pointer such that it can be properly initialized by
C<GPERL_CALLBACK_MARSHAL_INIT>.  Do I<not> just use C<dSP>.  This should always
come last in a list of declarations as its expansion might contain statements
under certain conditions.

=item GPERL_CALLBACK_MARSHAL_INIT(callback)

Initialize the callback stuff.  This must happen before any other Perl API
statements in the callback marshaller.  In a threaded Perl, this ensures that
the proper interpreter context is used; if this isn't first, you'll mix and
match two contexts and bad things will happen.

=cut
*/
#ifdef PERL_IMPLICIT_CONTEXT

# define dGPERL_CALLBACK_MARSHAL_SP	\
	SV ** sp;

# define GPERL_CALLBACK_MARSHAL_INIT(callback)	\
	PERL_SET_CONTEXT (callback->priv);	\
	SPAGAIN;

#else

# define dGPERL_CALLBACK_MARSHAL_SP	\
	dSP;

# define GPERL_CALLBACK_MARSHAL_INIT(callback)	\
	/* nothing to do */

#endif


#endif /* __GPERL_MARSHAL_H__ */