ports//math/polymake/work/polymake-2.3/build/perlx-5.8.8-darwin-64int-2level/Scope.c

/*
 * This file was generated automatically by ExtUtils::ParseXS version 2.18 from the
 * contents of Scope.xs. Do not edit this file, edit Scope.xs instead.
 *
 *	ANY CHANGES MADE HERE WILL BE LOST! 
 *
 */

#line 1 "Scope.xs"
/* Copyright (c) 1997-2006			 -*- C -*-
   Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
   http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.de

   This program is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by the
   Free Software Foundation; either version 2, or (at your option) any
   later version: http://www.gnu.org/licenses/gpl.txt.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
*/

#ident "$Project: polymake $$Id: Scope.xs 6949 2006-02-06 16:29:16Z gawrilow $"

#include "Ext.h"

CV *avoid_db_sub=0;

static
void localize_marker(pTHX_ void *p)
{
   if (PL_in_eval & ~(EVAL_INREQUIRE))	/* functionality of $^S less the lex test */
      croak("Scope::end missing");
}

typedef struct local_var_ptrs {
   SV *var;
   void *orig_any;
   SV *temp_owner;
} local_var_ptrs;

static
local_var_ptrs* do_local_var(SV *var, SV *value)
{
   local_var_ptrs *ptrs;
   New(0, ptrs, 1, local_var_ptrs);
   ptrs->var=var;
   ptrs->orig_any=SvANY(var);
   SvANY(var)=SvANY(value);
   ptrs->temp_owner=value;
   SvREFCNT_inc(var);
   SvREFCNT_inc(value);
   return ptrs;
}

static
void undo_local_var(pTHX_ void *p)
{
   local_var_ptrs *ptrs=(local_var_ptrs*)p;
   SvANY(ptrs->var)=ptrs->orig_any;
   SvREFCNT_dec(ptrs->var);
   SvREFCNT_dec(ptrs->temp_owner);
   Safefree(p);
}

typedef struct local_scalar_ptrs {
   SV *var;
   SV orig;
} local_scalar_ptrs;

static
local_scalar_ptrs* do_local_scalar(SV *var, SV *value)
{
   local_scalar_ptrs *ptrs;
   New(0, ptrs, 1, local_scalar_ptrs);
   ptrs->var=var;
   ptrs->orig.sv_any=var->sv_any;
   ptrs->orig.sv_refcnt=var->sv_refcnt;
   ptrs->orig.sv_flags=var->sv_flags;
   var->sv_any=0;
   var->sv_flags=0;
   var->sv_refcnt=1;
   sv_setsv(var,value);
   return ptrs;
}

static
void undo_local_scalar(pTHX_ void *p)
{
   local_scalar_ptrs *ptrs=(local_scalar_ptrs*)p;
   if (SvREFCNT(ptrs->var)>1) {
      SvREFCNT_dec(ptrs->var);
   } else {
      SvREFCNT(ptrs->var)=0;  sv_clear(ptrs->var);
   }
   ptrs->var->sv_any=ptrs->orig.sv_any;
   ptrs->var->sv_refcnt=ptrs->orig.sv_refcnt;
   ptrs->var->sv_flags=ptrs->orig.sv_flags;
   Safefree(p);
}

typedef struct local_incr_ptrs {
   SV *var;
   I32 incr;
} local_incr_ptrs; 

static
local_incr_ptrs* do_local_incr(SV *var, I32 incr)
{
   local_incr_ptrs *ptrs;
   New(0, ptrs, 1, local_incr_ptrs);
   ptrs->var=var;
   ptrs->incr=incr;
   if (SvIOK(var) || SvPOK(var))
      sv_setiv(var, SvIV(var)+incr);
   else if (SvNOK(var))
      sv_setnv(var, SvNVX(var)+incr);
   else
      sv_setiv(var,incr);
   return ptrs;
}

static
void undo_local_incr(pTHX_ void *p)
{
   local_incr_ptrs *ptrs=(local_incr_ptrs*)p;
   SV *var=ptrs->var;
   if (SvIOK(var))
      sv_setiv(var, SvIVX(var)-ptrs->incr);
   else if (SvNOK(ptrs->var))
      sv_setnv(var, SvNVX(var)-ptrs->incr);
   else
      Safefree(p), croak("undoing local increment: variable is no more numerical");
   Safefree(p);
}

static
local_incr_ptrs* do_local_push(pTHX_ SV *av, SV **src, int n, int side)
{
   local_incr_ptrs *ptrs;
   SV **dst, **src_end;
   New(0, ptrs, 1, local_incr_ptrs);
   ptrs->var=av;
   ptrs->incr=side*n;
   av_extend((AV*)av, AvFILLp(av)+n);
   if (side<0) {
      dst=AvARRAY(av);
      Move(dst, dst+n, AvFILLp(av)+1, SV*);
   } else {
      dst=AvARRAY(av)+AvFILLp(av)+1;
   }
   for (src_end=src+n; src<src_end; ++src, ++dst) {
      SV *d=*src;
      if (SvREADONLY(d) || !SvTEMP(d))
	 *dst=newSVsv(d);
      else
	 *dst=SvREFCNT_inc(d);
   }
   AvFILLp(av)+=n;
   return ptrs;
}

static
void undo_local_push(pTHX_ void *p)
{
   local_incr_ptrs *ptrs=(local_incr_ptrs*)p;
   SV *av=ptrs->var;
   I32 n=ptrs->incr;
   SV **e, **eend;
   if (n>0) {
      for (e=AvARRAY(av)+AvFILLp(av), eend=e-n; e>eend; --e) {
	 SvREFCNT_dec(*e);
	 *e=&PL_sv_undef;
      }
      AvFILLp(av)-=n;
   } else {
      for (eend=AvARRAY(av)-1, e=eend-n; e>eend; --e)
	 SvREFCNT_dec(*e);
      AvFILLp(av)+=n;
      ++eend;
      Move(eend-n, eend, AvFILLp(av)+1, SV*);
      for (e=eend+AvFILLp(av)+1, eend=e-n; e<eend; ++e)
	 *e=&PL_sv_undef;
   }
   Safefree(p);
}

#ifndef PERL_UNUSED_VAR
#  define PERL_UNUSED_VAR(var) if (0) var = var
#endif

#line 195 "Scope.c"

XS(XS_Poly__Scope_begin_locals); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly__Scope_begin_locals)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 1)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::Scope::begin_locals", "scope");
    PERL_UNUSED_VAR(cv); /* -W */
    {
	SV *	scope =SvRV(ST(0));
#line 187 "Scope.xs"
LEAVE;
{
   save_destructor_x(&localize_marker, scope);
}
ENTER;
#line 216 "Scope.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_Poly__Scope_end_locals); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly__Scope_end_locals)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 1)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::Scope::end_locals", "scope");
    PERL_UNUSED_VAR(cv); /* -W */
    {
	SV *	scope =SvRV(ST(0));
#line 197 "Scope.xs"
LEAVE;
{
   ANY *mainstack=PL_savestack;
   I32 frame_top=PL_savestack_ix, frame_bottom=PL_scopestack[PL_scopestack_ix-1], f, to_save;

   /* find the marker or resign */
   for (f=frame_top-3; f >= frame_bottom; --f)
      if (mainstack[f].any_ptr == (void*)&localize_marker
	  && f+2 < frame_top
	  && mainstack[f+2].any_i32 == SAVEt_DESTRUCTOR_X) {

	 if (scope != (SV*)mainstack[f+1].any_ptr) break;

	 to_save=frame_top-(f+3);
	 if (to_save > 0) {
	    SV *marker=*av_fetch((AV*)scope, 0, 0);
	    sv_catpvn(marker, (char*)&(mainstack[f+3]), to_save*sizeof(ANY));
	    PL_savestack_ix=f;	/* pop the marker and the saved locals quickly */
	 }
	    scope=0;
	    break;
      }
   if (scope)
      croak("Scope: begin-end mismatch");
}
ENTER;
#line 262 "Scope.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_Poly__Scope_unwind); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly__Scope_unwind)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 1)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::Scope::unwind", "marker");
    PERL_UNUSED_VAR(cv); /* -W */
    {
	SV *	marker =ST(0);
#line 228 "Scope.xs"
{
   I32 saved=SvCUR(marker)/sizeof(ANY);
   if (saved) {
      LEAVE;
      SSCHECK(saved);
      Copy(SvPVX(marker), &(PL_savestack[PL_savestack_ix]), saved, ANY);
      PL_savestack_ix+=saved;
      ENTER;
   }
}
#line 292 "Scope.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_Poly_local_scalar); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly_local_scalar)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 2)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::local_scalar", "var, value");
    PERL_UNUSED_VAR(cv); /* -W */
    {
	SV *	var = ST(0);
	SV *	value = ST(1);
#line 247 "Scope.xs"
{
   if ( (isGV(var) ? !(var=GvSV(var))
	           : SvTYPE(var) >= SVt_PVAV) ||
	SvTYPE(value) >= SVt_PVAV )
      croak("usage: local_scalar(*glob || $var, value)");
   LEAVE;
   save_destructor_x(&undo_local_scalar, do_local_scalar(var, value));
   ENTER;
}
#line 322 "Scope.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_Poly_local_array); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly_local_array)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 2)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::local_array", "var, value");
    PERL_UNUSED_VAR(cv); /* -W */
    {
	SV *	var = ST(0);
	SV *	value = ST(1);
#line 263 "Scope.xs"
{
   if ( (isGV(var) ? !(var=(SV*)GvAV(var))
                   : !SvROK(var) || (var=SvRV(var), SvTYPE(var) != SVt_PVAV)) ||
	(!SvROK(value) || (value=SvRV(value), SvTYPE(value) != SVt_PVAV)) )
      croak("usage: local_array(*glob || \\@array, [ value ])");
   LEAVE;
   save_destructor_x(&undo_local_var, do_local_var(var, value));
   ENTER;
}
#line 352 "Scope.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_Poly_local_hash); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly_local_hash)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 2)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::local_hash", "var, value");
    PERL_UNUSED_VAR(cv); /* -W */
    {
	SV *	var = ST(0);
	SV *	value = ST(1);
#line 279 "Scope.xs"
{
   if ( (isGV(var) ? !(var=(SV*)GvHV(var))
	           : !SvROK(var) || (var=SvRV(var), SvTYPE(var) != SVt_PVHV)) ||
	(!SvROK(value) || (value=SvRV(value), SvTYPE(value) != SVt_PVHV)) )
      croak("usage: local_hash(*glob || \\%hash, { value })");
   LEAVE;
   save_destructor_x(&undo_local_var, do_local_var(var, value));
   ENTER;
}
#line 382 "Scope.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_Poly_local_sub); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly_local_sub)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 2)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::local_sub", "var, value");
    PERL_UNUSED_VAR(cv); /* -W */
    {
	SV *	var = ST(0);
	SV *	value =ST(1);
#line 295 "Scope.xs"
{
   if ( (isGV(var) ? !(var=(SV*)GvCV(var))
	           : !SvROK(var) || (var=SvRV(var), SvTYPE(var) != SVt_PVCV)) ||
	(!SvROK(value) || (value=SvRV(value), SvTYPE(value) != SVt_PVCV)) )
      croak("usage: local_sub(*glob || \\&sub, sub { ... })");
   LEAVE;
   save_destructor_x(&undo_local_var, do_local_var(var, value));
   ENTER;
}
#line 412 "Scope.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_Poly_local_incr); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly_local_incr)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items < 1)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::local_incr", "var, ...");
    PERL_UNUSED_VAR(cv); /* -W */
    {
	SV *	var = ST(0);
#line 310 "Scope.xs"
{
   SV *incr= items==2 ? ST(1) : 0;
   if ( items>2 ||
	(isGV(var) ? !(var=GvSV(var))
	           : SvTYPE(var) >= SVt_PVAV) ||
	(incr && SvTYPE(incr) >= SVt_PVAV) )
      croak("usage: local_incr(*glob || $var, incr(=1))");
   LEAVE;
   save_destructor_x(&undo_local_incr, do_local_incr(var, incr ? SvIV(incr) : 1));
   ENTER;
}
#line 443 "Scope.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_Poly_local_push); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly_local_push)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items < 1)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::local_push", "avref, ...");
    PERL_UNUSED_VAR(cv); /* -W */
    {
	SV *	avref = ST(0);
#line 327 "Scope.xs"
{
   SV *av=0;
   if (isGV(avref)
       ? !(av=(SV*)GvAV(avref))
       : !SvROK(avref) || (av=SvRV(avref), SvTYPE(av) != SVt_PVAV || SvMAGICAL(av)))
      croak("usage: local_push(\\@array, data ...");
   if (items>=2) {
      LEAVE;
      save_destructor_x(&undo_local_push, do_local_push(aTHX_ av, &ST(1), items-1, 1));
      ENTER;
   }
}
#line 475 "Scope.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_Poly_local_unshift); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly_local_unshift)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items < 1)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::local_unshift", "avref, ...");
    PERL_UNUSED_VAR(cv); /* -W */
    {
	SV *	avref = ST(0);
#line 345 "Scope.xs"
{
   SV *av=0;
   if (isGV(avref)
       ? !(av=(SV*)GvAV(avref))
       : !SvROK(avref) || (av=SvRV(avref), SvTYPE(av) != SVt_PVAV || SvMAGICAL(av)))
      croak("usage: local_unshift(\\@array, data ...");
   if (items>=2) {
      LEAVE;
      save_destructor_x(&undo_local_push, do_local_push(aTHX_ av, &ST(1), items-1, -1));
      ENTER;
   }
}
#line 507 "Scope.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_Poly_propagate_match); /* prototype to pass -Wmissing-prototypes */
XS(XS_Poly_propagate_match)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 0)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Poly::propagate_match", "");
    PERL_UNUSED_VAR(cv); /* -W */
    PERL_UNUSED_VAR(ax); /* -Wall */
    SP -= items;
    {
#line 361 "Scope.xs"
{
   PERL_CONTEXT *cx_bottom=cxstack, *cx=cx_bottom+cxstack_ix;
   while (cx >= cx_bottom) {
      if (CxTYPE(cx) == CXt_SUB) {
	 cx->blk_oldpm=PL_curpm;
	 if (!avoid_db_sub || cx->blk_sub.cv == avoid_db_sub)
	    break;
      }
      --cx;
   }
}
#line 539 "Scope.c"
	PUTBACK;
	return;
    }
}

#ifdef __cplusplus
extern "C"
#endif
XS(boot_Poly__Scope); /* prototype to pass -Wmissing-prototypes */
XS(boot_Poly__Scope)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    char* file = __FILE__;

    PERL_UNUSED_VAR(cv); /* -W */
    PERL_UNUSED_VAR(items); /* -W */
    XS_VERSION_BOOTCHECK ;

        newXS("Poly::Scope::begin_locals", XS_Poly__Scope_begin_locals, file);
        newXS("Poly::Scope::end_locals", XS_Poly__Scope_end_locals, file);
        newXS("Poly::Scope::unwind", XS_Poly__Scope_unwind, file);
        newXSproto("Poly::local_scalar", XS_Poly_local_scalar, file, "$$");
        newXSproto("Poly::local_array", XS_Poly_local_array, file, "$$");
        newXSproto("Poly::local_hash", XS_Poly_local_hash, file, "$$");
        newXSproto("Poly::local_sub", XS_Poly_local_sub, file, "$$");
        newXSproto("Poly::local_incr", XS_Poly_local_incr, file, "$;$");
        newXSproto("Poly::local_push", XS_Poly_local_push, file, "$@");
        newXSproto("Poly::local_unshift", XS_Poly_local_unshift, file, "$@");
        newXS("Poly::propagate_match", XS_Poly_propagate_match, file);

    /* Initialisation Section */

#line 374 "Scope.xs"
if (PL_DBgv) {
   CvNODEBUG_on(get_cv("Poly::Scope::begin_locals", FALSE));
   CvNODEBUG_on(get_cv("Poly::Scope::end_locals", FALSE));
   CvNODEBUG_on(get_cv("Poly::Scope::unwind", FALSE));
   CvNODEBUG_on(get_cv("Poly::local_scalar", FALSE));
   CvNODEBUG_on(get_cv("Poly::local_array", FALSE));
   CvNODEBUG_on(get_cv("Poly::local_hash", FALSE));
   CvNODEBUG_on(get_cv("Poly::local_incr", FALSE));
   CvNODEBUG_on(get_cv("Poly::local_push", FALSE));
   CvNODEBUG_on(get_cv("Poly::local_unshift", FALSE));
   CvNODEBUG_on(get_cv("Poly::propagate_match", FALSE));
   avoid_db_sub=GvCV(PL_DBsub);
}

#line 591 "Scope.c"

    /* End of Initialisation Section */

    XSRETURN_YES;
}
syntax highlighted by Code2HTML, v. 0.9.1