int
Perl_runops_debug(pTHX)
{
#ifdef DEBUGGING
if (!PL_op) {
if (ckWARN_d(WARN_DEBUGGING))
Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
return 0;
}
do {
PERL_ASYNC_CHECK();
if (PL_debug) {
if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok)
PerlIO_printf(Perl_debug_log,
"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
PTR2UV(*PL_watchaddr));
DEBUG_s(debstack());
DEBUG_t(debop(PL_op));
DEBUG_P(debprof(PL_op));
}
} while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
TAINT_NOT;
return 0;
#else
return runops_standard();
#endif /* DEBUGGING */
}
static int
runops_leakcheck( pTHX ) {
char *lastfile = NULL;
int lastline = 0;
while ( ( PL_op = CALL_FPTR( PL_op->op_ppaddr ) ( aTHX ) ) ) {
PERL_ASYNC_CHECK( );
if ( interesting_op( PL_op->op_type ) ) {
/*fprintf(stderr, "%s, line %d\n", lastfile, lastline); */
NOTE_NEW_VARS( lastline, lastfile );
free( lastfile );
if ( lastfile = strdup( CopFILE( cCOP ) ), NULL == lastfile ) {
nomem( );
}
lastline = CopLINE( cCOP );
}
}
/*fprintf(stderr, "%s, line %d\n", lastfile, lastline); */
NOTE_NEW_VARS( lastline, lastfile );
free( lastfile );
TAINT_NOT;
return 0;
}
int
Perl_runops_standard(pTHX)
{
while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
PERL_ASYNC_CHECK();
}
TAINT_NOT;
return 0;
}
/*
NOTE: mouse_tc_check() handles GETMAGIC
*/
int
mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) {
CV* const cv = (CV*)SvRV(tc_code);
assert(SvTYPE(cv) == SVt_PVCV);
if(CvXSUB(cv) == XS_Mouse_constraint_check){ /* built-in type constraints */
MAGIC* const mg = (MAGIC*)CvXSUBANY(cv).any_ptr;
assert(CvXSUBANY(cv).any_ptr != NULL);
assert(mg->mg_ptr != NULL);
SvGETMAGIC(sv);
/* call the check function directly, skipping call_sv() */
return CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv);
}
else { /* custom */
int ok;
dSP;
dMY_CXT;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv);
if( MY_CXT.tc_extra_args ) {
AV* const av = MY_CXT.tc_extra_args;
I32 const len = AvFILLp(av) + 1;
int i;
for(i = 0; i < len; i++) {
XPUSHs( AvARRAY(av)[i] );
}
}
PUTBACK;
call_sv(tc_code, G_SCALAR);
SPAGAIN;
ok = sv_true(POPs);
PUTBACK;
FREETMPS;
LEAVE;
return ok;
}
}
