scope.c revision 7c478bd95313f5f23a4c958a745db2134aa03244
/* scope.c
*
* Copyright (c) 1991-2001, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "For the fashion of Minas Tirith was such that it was built on seven
* levels..."
*/
#include "EXTERN.h"
#define PERL_IN_SCOPE_C
#include "perl.h"
#if defined(PERL_FLEXIBLE_EXCEPTIONS)
void *
protect_body_t body, ...)
{
void *ret;
return ret;
}
void *
{
int ex;
void *ret;
if (ex)
else
return ret;
}
#endif
SV**
{
#if defined(DEBUGGING) && !defined(USE_THREADS)
static int growing = 0;
if (growing++)
abort();
#endif
PL_stack_sp = sp;
#ifndef STRESS_REALLOC
#else
#endif
#if defined(DEBUGGING) && !defined(USE_THREADS)
growing--;
#endif
return PL_stack_sp;
}
#ifndef STRESS_REALLOC
#else
#endif
PERL_SI *
{
return si;
}
{
return cxstack_ix + 1;
}
void
{
if (PL_retstack_ix == PL_retstack_max) {
}
}
OP *
{
if (PL_retstack_ix > 0)
return PL_retstack[--PL_retstack_ix];
else
return Nullop;
}
void
{
if (PL_scopestack_ix == PL_scopestack_max) {
}
}
void
{
}
void
{
}
void
{
}
void
{
#ifndef STRESS_REALLOC
if (n < 128)
#endif
}
void
{
/* XXX should tmps_floor live in cxstack? */
if (sv) {
SvTEMP_off(sv);
}
}
}
{
if (SvGMAGICAL(osv)) {
bool oldtainted = PL_tainted;
}
}
/* XXX SvMAGIC() is *shared* between osv and sv. This can
* lead to coredumps when both SVs are destroyed without one
* of their SvMAGIC() slots being NULLed. */
PL_localizing = 1;
SvSETMAGIC(sv);
PL_localizing = 0;
}
return sv;
}
SV *
{
SSCHECK(3);
return save_scalar_at(sptr);
}
SV*
{
SSCHECK(3);
return save_scalar_at(sptr);
}
/* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to
* restore a global SV to its prior contents, freeing new value. */
void
{
SSCHECK(3);
}
/* Like save_pptr(), but also Safefree()s the new value if it is different
* from the old one. Can be used to restore a global char* to its prior
* contents, freeing new value. */
void
{
SSCHECK(3);
}
void
{
SSCHECK(6);
if (empty) {
PL_sub_generation++; /* taking a method out of circulation */
}
}
else {
GvINTRO_on(gv);
}
}
AV *
{
SSCHECK(3);
PL_localizing = 1;
PL_localizing = 0;
}
return av;
}
HV *
{
SSCHECK(3);
PL_localizing = 1;
PL_localizing = 0;
}
return hv;
}
void
{
SSCHECK(3);
}
void
{
SSCHECK(3);
}
void
{
SSCHECK(3);
SSPUSHLONG(*longp);
}
void
{
SSCHECK(3);
}
void
{
SSCHECK(3);
}
void
{
SSCHECK(3);
}
void
{
SSCHECK(3);
}
/* Cannot use save_sptr() to store a char* since the SV** cast will
* force word-alignment and we'll miss the pointer.
*/
void
{
SSCHECK(3);
}
void
{
SSCHECK(3);
}
void
{
SSCHECK(3);
}
void
{
SSCHECK(4);
SSPUSHLONG((long)off);
}
SV **
{
#ifdef USE_THREADS
return svp;
#else
return 0;
#endif /* USE_THREADS */
}
void
{
SSCHECK(2);
}
void
{
SSCHECK(3);
}
void
{
SSCHECK(3);
}
void
{
SSCHECK(2);
}
void
{
SSCHECK(2);
}
void
{
SSCHECK(2);
SSPUSHPTR(o);
}
void
{
SSCHECK(2);
}
void
{
SSCHECK(2);
}
void
{
SSCHECK(4);
}
void
{
register I32 i;
for (i = 1; i <= maxsarg; i++) {
SSCHECK(3);
}
}
void
{
SSCHECK(3);
SSPUSHDPTR(f);
SSPUSHPTR(p);
}
void
{
SSCHECK(3);
SSPUSHDXPTR(f);
SSPUSHPTR(p);
}
void
{
SSCHECK(4);
}
void
{
SSCHECK(4);
}
void
{
SSCHECK(2);
}
{
- (char*)PL_savestack);
/* SSCHECK may not be good enough */
PL_savestack_ix += elems;
return start;
}
void
{
register void* ptr;
register char* str;
I32 i;
if (base < -1)
while (PL_savestack_ix > base) {
switch (SSPOPINT) {
case SAVEt_ITEM: /* normal string */
PL_localizing = 2;
SvSETMAGIC(sv);
PL_localizing = 0;
break;
case SAVEt_SV: /* scalar reference */
goto restore_sv;
case SAVEt_GENERIC_PVREF: /* generic pv */
}
break;
case SAVEt_GENERIC_SVREF: /* generic sv */
break;
case SAVEt_SVREF: /* scalar reference */
"restore svref: %p %p:%s -> %p:%s\n",
{
}
/* XXX This branch is pretty bogus. This code irretrievably
* clears(!) the magic on the SV (either to avoid further
* croaking that might ensue when the SvSETMAGIC() below is
* called, or to avoid two different SVs pointing at the same
* SvMAGIC()). This needs a total rethink. --GSAR */
{
/* XXX this is a leak when we get here because the
* mg_get() in save_scalar_at() croaked */
}
PL_localizing = 2;
PL_localizing = 0;
break;
case SAVEt_AV: /* array reference */
}
PL_localizing = 2;
PL_localizing = 0;
}
break;
case SAVEt_HV: /* hash reference */
}
PL_localizing = 2;
PL_localizing = 0;
}
break;
case SAVEt_INT: /* int reference */
break;
case SAVEt_LONG: /* long reference */
break;
case SAVEt_I32: /* I32 reference */
break;
case SAVEt_I16: /* I16 reference */
break;
case SAVEt_I8: /* I8 reference */
break;
case SAVEt_IV: /* IV reference */
break;
case SAVEt_SPTR: /* SV* reference */
break;
case SAVEt_VPTR: /* random* reference */
case SAVEt_PPTR: /* char* reference */
break;
case SAVEt_HPTR: /* HV* reference */
break;
case SAVEt_APTR: /* AV* reference */
break;
case SAVEt_NSTAB:
break;
case SAVEt_GP: /* scalar reference */
}
PL_sub_generation++; /* putting a method back into circulation */
break;
case SAVEt_FREESV:
break;
case SAVEt_MORTALIZESV:
break;
case SAVEt_FREEOP:
if (PL_comppad)
break;
case SAVEt_FREEPV:
break;
case SAVEt_CLEARSV:
/* Can clear pad variable in place? */
if (SvTHINKFIRST(sv))
case SVt_NULL:
break;
case SVt_PVAV:
break;
case SVt_PVHV:
break;
case SVt_PVCV:
case SVt_RV:
case SVt_IV:
case SVt_NV:
break;
default:
break;
}
}
else { /* Someone has a claim on this, so abandon it. */
}
}
break;
case SAVEt_DELETE:
break;
case SAVEt_DESTRUCTOR:
break;
case SAVEt_DESTRUCTOR_X:
break;
case SAVEt_REGCONTEXT:
case SAVEt_ALLOC:
i = SSPOPINT;
PL_savestack_ix -= i; /* regexp must have croaked */
break;
case SAVEt_STACK_POS: /* Position on Perl stack */
i = SSPOPINT;
PL_stack_sp = PL_stack_base + i;
break;
case SAVEt_AELEM: /* array element */
i = SSPOPINT;
if (ptr) {
(void)SvREFCNT_inc(sv);
goto restore_sv;
}
}
break;
case SAVEt_HELEM: /* hash element */
if (ptr) {
goto restore_sv;
}
}
break;
case SAVEt_OP:
break;
case SAVEt_HINTS:
break;
case SAVEt_COMPPAD:
if (PL_comppad)
else
break;
case SAVEt_PADSV:
{
if (ptr)
}
break;
default:
}
}
}
void
{
#ifdef DEBUGGING
}
case CXt_NULL:
case CXt_BLOCK:
break;
case CXt_FORMAT:
break;
case CXt_SUB:
break;
case CXt_EVAL:
break;
case CXt_LOOP:
break;
case CXt_SUBST:
(long)cx->sb_maxiters);
break;
}
#endif /* DEBUGGING */
}