/* * 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; srcvar; 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= 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; }