void
Perl_av_reify(pTHX_ AV *av)
{
+ dVAR;
I32 key;
assert(av);
void
Perl_av_extend(pTHX_ AV *av, I32 key)
{
+ dVAR;
MAGIC *mg;
assert(av);
SV**
Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
{
+ dVAR;
SV *sv;
assert(av);
SV**
Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
{
+ dVAR;
SV** ary;
assert(av);
void
Perl_av_clear(pTHX_ register AV *av)
{
+ dVAR;
register I32 key;
assert(av);
SV *
Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
{
+ dVAR;
SV *sv;
assert(av);
bool
Perl_av_exists(pTHX_ AV *av, I32 key)
{
+ dVAR;
assert(av);
if (SvRMAGICAL(av)) {
Perl_vdeb(pTHX_ const char *pat, va_list *args)
{
#ifdef DEBUGGING
+ dVAR;
char* file = OutCopFILE(PL_curcop);
PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"),
Perl_debstackptrs(pTHX)
{
#ifdef DEBUGGING
+ dVAR;
PerlIO_printf(Perl_debug_log,
"%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n",
PTR2UV(PL_curstack), PTR2UV(PL_stack_base),
I32 mark_min, I32 mark_max)
{
#ifdef DEBUGGING
+ dVAR;
register I32 i = stack_max - 30;
const I32 *markscan = PL_markstack + mark_min;
if (i < stack_min)
Perl_debstack(pTHX)
{
#ifndef SKIP_DEBUGGING
+ dVAR;
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return 0;
Perl_deb_stack_all(pTHX)
{
#ifdef DEBUGGING
+ dVAR;
I32 si_ix;
const PERL_SI *si;
PerlIO *
Perl_nextargv(pTHX_ register GV *gv)
{
+ dVAR;
register SV *sv;
#ifndef FLEXFILENAMES
int filedev;
bool
Perl_do_close(pTHX_ GV *gv, bool not_implicit)
{
+ dVAR;
bool retval;
IO *io;
bool
Perl_io_close(pTHX_ IO *io, bool not_implicit)
{
+ dVAR;
bool retval = FALSE;
if (IoIFP(io)) {
bool
Perl_do_eof(pTHX_ GV *gv)
{
+ dVAR;
register IO * const io = GvIO(gv);
if (!io)
Off_t
Perl_do_tell(pTHX_ GV *gv)
{
+ dVAR;
register IO *io = NULL;
register PerlIO *fp;
bool
Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
{
+ dVAR;
register IO *io = NULL;
register PerlIO *fp;
Off_t
Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
{
+ dVAR;
register IO *io = NULL;
register PerlIO *fp;
bool
Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
{
+ dVAR;
register const char *tmps;
STRLEN len;
I32
Perl_my_stat(pTHX)
{
+ dVAR;
dSP;
IO *io;
GV* gv;
I32
Perl_my_lstat(pTHX)
{
+ dVAR;
static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
dSP;
SV *sv;
void
Perl_do_execfree(pTHX)
{
+ dVAR;
Safefree(PL_Argv);
PL_Argv = Null(char **);
Safefree(PL_Cmd);
I32
Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
{
+ dVAR;
register I32 val;
register I32 tot = 0;
const char *const what = PL_op_name[type];
* is in the list of groups returned from getgroups().
*/
{
+ dVAR;
#ifdef DOSISH
/* [Comments and code from Len Reed]
* MS-DOS "user" is similar to UNIX's "superuser," but can't write
/* This is simply not correct for AppleShare, but fix it yerself. */
return TRUE;
#else
+ dVAR;
if (testgid == (effective ? PL_egid : PL_gid))
return TRUE;
#ifdef HAS_GETGROUPS
I32
Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
{
+ dVAR;
const key_t key = (key_t)SvNVx(*++mark);
const I32 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
const I32 flags = SvIVx(*++mark);
I32
Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
{
+ dVAR;
char *a;
I32 ret = -1;
const I32 id = SvIVx(*++mark);
I32
Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
{
+ dVAR;
#ifdef HAS_MSG
STRLEN len;
const I32 id = SvIVx(*++mark);
Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
{
#ifdef HAS_MSG
+ dVAR;
char *mbuf;
long mtype;
I32 msize, flags, ret;
Perl_do_semop(pTHX_ SV **mark, SV **sp)
{
#ifdef HAS_SEM
+ dVAR;
STRLEN opsize;
const I32 id = SvIVx(*++mark);
SV * const opstr = *++mark;
Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
{
#ifdef HAS_SHM
+ dVAR;
char *shm;
struct shmid_ds shmds;
const I32 id = SvIVx(*++mark);
STATIC I32
S_do_trans_simple(pTHX_ SV *sv)
{
+ dVAR;
U8 *s;
U8 *d;
const U8 *send;
STATIC I32
S_do_trans_count(pTHX_ SV *sv)
{
+ dVAR;
const U8 *s;
const U8 *send;
I32 matches = 0;
STATIC I32
S_do_trans_complex(pTHX_ SV *sv)
{
+ dVAR;
U8 *s;
U8 *send;
U8 *d;
STATIC I32
S_do_trans_simple_utf8(pTHX_ SV *sv)
{
+ dVAR;
U8 *s;
U8 *send;
U8 *d;
STATIC I32
S_do_trans_count_utf8(pTHX_ SV *sv)
{
+ dVAR;
const U8 *s;
const U8 *start = NULL;
const U8 *send;
STATIC I32
S_do_trans_complex_utf8(pTHX_ SV *sv)
{
+ dVAR;
U8 *start, *send;
U8 *d;
I32 matches = 0;
I32
Perl_do_trans(pTHX_ SV *sv)
{
+ dVAR;
STRLEN len;
const I32 hasutf = (PL_op->op_private &
(OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF));
void
Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **sp)
{
+ dVAR;
SV ** const oldmark = mark;
register I32 items = sp - mark;
register STRLEN len;
void
Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
{
+ dVAR;
STRLEN patlen;
const char * const pat = SvPV_const(*sarg, patlen);
bool do_taint = FALSE;
UV
Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
{
+ dVAR;
STRLEN srclen, len;
const unsigned char *s = (const unsigned char *) SvPV_const(sv, srclen);
UV retnum = 0;
void
Perl_do_vecset(pTHX_ SV *sv)
{
+ dVAR;
register I32 offset;
register I32 size;
register unsigned char *s;
void
Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
{
+ dVAR;
STRLEN len;
char *s;
I32
Perl_do_chomp(pTHX_ register SV *sv)
{
+ dVAR;
register I32 count;
STRLEN len;
char *s;
void
Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
{
+ dVAR;
#ifdef LIBERAL
register long *dl;
register long *ll;
OP *
Perl_do_kv(pTHX)
{
+ dVAR;
dSP;
HV * const hv = (HV*)POPs;
HV *keys;
void
Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
{
+ dVAR;
PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
PerlIO_vprintf(file, pat, *args);
}
void
Perl_dump_all(pTHX)
{
+ dVAR;
PerlIO_setlinebuf(Perl_debug_log);
if (PL_main_root)
op_dump(PL_main_root);
void
Perl_dump_packsubs(pTHX_ const HV *stash)
{
+ dVAR;
I32 i;
if (!HvARRAY(stash))
void
Perl_dump_eval(pTHX)
{
+ dVAR;
op_dump(PL_eval_root);
}
void
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
{
+ dVAR;
SV *d;
const char *s;
U32 flags;
void
Perl_sv_dump(pTHX_ SV *sv)
{
+ dVAR;
do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
}
int
Perl_runops_debug(pTHX)
{
+ dVAR;
if (!PL_op) {
if (ckWARN_d(WARN_DEBUGGING))
Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
I32
Perl_debop(pTHX_ const OP *o)
{
+ dVAR;
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return 0;
STATIC CV*
S_deb_curcv(pTHX_ I32 ix)
{
+ dVAR;
const PERL_CONTEXT *cx = &cxstack[ix];
if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
return cx->blk_sub.cv;
void
Perl_watch(pTHX_ char **addr)
{
+ dVAR;
PL_watchaddr = addr;
PL_watchok = *addr;
PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
STATIC void
S_debprof(pTHX_ const OP *o)
{
+ dVAR;
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return;
if (!PL_profiledata)
void
Perl_debprofdump(pTHX)
{
+ dVAR;
unsigned i;
if (!PL_profiledata)
return;
BOOT:
{
- MY_CXT_INIT;
#ifdef USE_ITHREADS
+ MY_CXT_INIT;
ithread* thread;
PL_perl_destruct_level = 2;
MUTEX_INIT(&create_destruct_mutex);
GV *
Perl_gv_IOadd(pTHX_ register GV *gv)
{
+ dVAR;
if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) {
/*
GV *
Perl_gv_fetchfile(pTHX_ const char *name)
{
+ dVAR;
char smallbuf[256];
char *tmpbuf;
STRLEN tmplen;
GV *
Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
{
+ dVAR;
AV* av;
GV* topgv;
GV* gv;
GV *
Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
{
+ dVAR;
register const char *nend;
const char *nsplit = NULL;
GV* gv;
Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
I32 sv_type)
{
+ dVAR;
register const char *name = nambeg;
register GV *gv = NULL;
GV**gvp;
IO *
Perl_newIO(pTHX)
{
+ dVAR;
GV *iogv;
IO * const io = (IO*)NEWSV(0,0);
void
Perl_gv_check(pTHX_ HV *stash)
{
+ dVAR;
register I32 i;
if (!HvARRAY(stash))
GV *
Perl_newGVgen(pTHX_ const char *pack)
{
+ dVAR;
return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++),
TRUE, SVt_PVGV);
}
GP*
Perl_gp_ref(pTHX_ GP *gp)
{
+ dVAR;
if (!gp)
return (GP*)NULL;
gp->gp_refcnt++;
void
Perl_gp_free(pTHX_ GV *gv)
{
+ dVAR;
GP* gp;
if (!gv || !(gp = GvGP(gv)))
bool
Perl_Gv_AMupdate(pTHX_ HV *stash)
{
+ dVAR;
MAGIC* const mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
AMT * const amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
AMT amt;
CV*
Perl_gv_handler(pTHX_ HV *stash, I32 id)
{
+ dVAR;
MAGIC *mg;
AMT *amtp;
STATIC void
S_more_he(pTHX)
{
+ dVAR;
HE* he;
HE* heend;
Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE);
STATIC HE*
S_new_he(pTHX)
{
+ dVAR;
HE* he;
void ** const root = &PL_body_roots[HE_SVSLOT];
void
Perl_free_tied_hv_pool(pTHX)
{
+ dVAR;
HE *he = PL_hv_fetch_ent_mh;
while (he) {
HE * const ohe = he;
STATIC void
S_hsplit(pTHX_ HV *hv)
{
+ dVAR;
register XPVHV* xhv = (XPVHV*)SvANY(hv);
const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
register I32 newsize = oldsize * 2;
void
Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
{
+ dVAR;
register XPVHV* xhv = (XPVHV*)SvANY(hv);
const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
register I32 newsize;
void
Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
{
+ dVAR;
SV *val;
if (!entry)
void
Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
{
+ dVAR;
if (!entry)
return;
/* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent */
void
Perl_hv_undef(pTHX_ HV *hv)
{
+ dVAR;
register XPVHV* xhv;
const char *name;
void
Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
{
+ dVAR;
struct xpvhv_aux *iter;
U32 hash;
STATIC void
S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
{
+ dVAR;
register XPVHV* xhv;
HE *entry;
register HE **oentry;
STATIC HEK *
S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
{
+ dVAR;
register HE *entry;
const int flags_masked = flags & HVhek_MASK;
const U32 hindex = hash & (I32) HvMAX(PL_strtab);
my($XSS_work_idx, $cpp_next_tmp);
use vars qw($VERSION);
-$VERSION = '2.15_01';
+$VERSION = '2.15_02';
use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback
$cplusplus $hiertype $WantPrototypes $WantVersionChk $except $WantLineNumbers
#XS(XS_${Full_func_name}); /* prototype to pass -Wmissing-prototypes */
#XS(XS_${Full_func_name})
#[[
+##ifdef dVAR
+# dVAR; dXSARGS;
+##else
# dXSARGS;
+##endif
EOF
print Q(<<"EOF") if $ALIAS ;
# dXSI32;
print Q(<<"EOF");
#[[
+##ifdef dVAR
+# dVAR; dXSARGS;
+##else
# dXSARGS;
+##endif
EOF
#-Wall: if there is no $Full_func_name there are no xsubs in this .xs
Perl_set_numeric_radix(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
# ifdef HAS_LOCALECONV
const struct lconv* const lc = localeconv();
Perl_new_numeric(pTHX_ const char *newnum)
{
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
if (! newnum) {
Safefree(PL_numeric_name);
Perl_set_numeric_standard(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
if (! PL_numeric_standard) {
setlocale(LC_NUMERIC, "C");
Perl_set_numeric_local(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
if (! PL_numeric_local) {
setlocale(LC_NUMERIC, PL_numeric_name);
Perl_new_collate(pTHX_ const char *newcoll)
{
#ifdef USE_LOCALE_COLLATE
+ dVAR;
if (! newcoll) {
if (PL_collation_name) {
*/
#if defined(USE_LOCALE)
+ dVAR;
#ifdef USE_LOCALE_CTYPE
char *curctype = NULL;
char *
Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen)
{
+ dVAR;
char *xbuf;
STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */
void
Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv)
{
+ dVAR;
register IO *rstio;
register IO *wstio;
int fd[2];
/* These ops all have the same body as pp_null. */
PP(pp_scalar)
{
+ dVAR;
return NORMAL;
}
PP(pp_regcmaybe)
{
+ dVAR;
return NORMAL;
}
PP(pp_lineseq)
{
+ dVAR;
return NORMAL;
}
PP(pp_scope)
{
+ dVAR;
return NORMAL;
}
STATIC void
S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
{
+ dVAR;
MGS* mgs;
assert(SvMAGICAL(sv));
#ifdef PERL_OLD_COPY_ON_WRITE
int
Perl_mg_get(pTHX_ SV *sv)
{
+ dVAR;
const I32 mgs_ix = SSNEW(sizeof(MGS));
const bool was_temp = (bool)SvTEMP(sv);
int have_new = 0;
int
Perl_mg_set(pTHX_ SV *sv)
{
+ dVAR;
const I32 mgs_ix = SSNEW(sizeof(MGS));
MAGIC* mg;
MAGIC* nextmg;
U32
Perl_mg_length(pTHX_ SV *sv)
{
+ dVAR;
MAGIC* mg;
STRLEN len;
void
Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
{
+ dVAR;
MAGIC *mg;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
const MGVTBL* const vtbl = mg->mg_virtual;
U32
Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
PERL_UNUSED_ARG(sv);
if (PL_curpm) {
int
Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
if (PL_curpm) {
register const REGEXP * const rx = PM_GETRE(PL_curpm);
if (rx) {
U32
Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
register I32 paren;
register I32 i;
register const REGEXP *rx;
int
Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
PERL_UNUSED_ARG(mg);
#if defined(VMS)
Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
int
Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
/* Are we fetching a signal entry? */
const I32 i = whichsig(MgPV_nolen_const(mg));
if (i > 0) {
static void
S_raise_signal(pTHX_ int sig)
{
+ dVAR;
/* Set a flag to say this signal is pending */
PL_psig_pend[sig]++;
/* And one to say _a_ signal is pending */
void
Perl_despatch_signals(pTHX)
{
+ dVAR;
int sig;
PL_sig_pending = 0;
for (sig = 1; sig < SIG_SIZE; sig++) {
int
Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
PERL_UNUSED_ARG(sv);
PERL_UNUSED_ARG(mg);
PL_sub_generation++;
int
Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
PERL_UNUSED_ARG(sv);
PERL_UNUSED_ARG(mg);
/* HV_badAMAGIC_on(Sv_STASH(sv)); */
STATIC int
S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int n, SV *val)
{
+ dVAR;
dSP;
PUSHMARK(SP);
int
Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
GV * const gv = PL_DBline;
const I32 i = SvTRUE(sv);
SV ** const svp = av_fetch(GvAV(gv),
int
Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
{
+ dVAR;
const AV * const obj = (AV*)mg->mg_obj;
if (obj) {
sv_setiv(sv, AvFILL(obj) + PL_curcop->cop_arybase);
int
Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
AV * const obj = (AV*)mg->mg_obj;
if (obj) {
av_fill(obj, SvIV(sv) - PL_curcop->cop_arybase);
int
Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
PERL_UNUSED_ARG(sv);
/* during global destruction, mg_obj may already have been freed */
if (PL_in_clean_all)
int
Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
SV* const lsv = LvTARG(sv);
if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
int
Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
SV* const lsv = LvTARG(sv);
SSize_t pos;
STRLEN len;
int
Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
STRLEN len;
const char *tmps = SvPV_const(sv, len);
SV * const lsv = LvTARG(sv);
int
Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
PERL_UNUSED_ARG(sv);
TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1));
return 0;
int
Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
PERL_UNUSED_ARG(sv);
/* update taint status unless we're restoring at scope exit */
if (PL_localizing != 2) {
int
Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
SV *targ = Nullsv;
if (LvTARGLEN(sv)) {
if (mg->mg_obj) {
void
Perl_vivify_defelem(pTHX_ SV *sv)
{
+ dVAR;
MAGIC *mg;
SV *value = Nullsv;
int
Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
regexp * const re = (regexp *)mg->mg_obj;
PERL_UNUSED_ARG(sv);
int
Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
{
+ dVAR;
register const char *s;
I32 i;
STRLEN len;
static void
S_restore_magic(pTHX_ const void *p)
{
+ dVAR;
MGS* const mgs = SSPTR(PTR2IV(p), MGS*);
SV* const sv = mgs->mgs_sv;
Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
if (PL_numeric_radix_sv && IN_LOCALE) {
STRLEN len;
const char * const radix = SvPV(PL_numeric_radix_sv, len);
{
NV x = 0.0;
#ifdef USE_LOCALE_NUMERIC
+ dVAR;
if (PL_numeric_local && IN_LOCALE) {
NV y;
PADOFFSET
Perl_allocmy(pTHX_ char *name)
{
+ dVAR;
PADOFFSET off;
const bool is_our = (PL_in_my == KEY_our);
STATIC OP *
S_scalarboolean(pTHX_ OP *o)
{
+ dVAR;
if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
if (ckWARN(WARN_SYNTAX)) {
const line_t oldline = CopLINE(PL_curcop);
OP *
Perl_scalarseq(pTHX_ OP *o)
{
+ dVAR;
if (o) {
if (o->op_type == OP_LINESEQ ||
o->op_type == OP_SCOPE ||
STATIC OP *
S_dup_attrlist(pTHX_ OP *o)
{
+ dVAR;
OP *rop;
/* An attrlist is either a simple OP_CONST or an OP_LIST with kids,
STATIC void
S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
{
+ dVAR;
OP *pack, *imop, *arg;
SV *meth, *stashsv;
STATIC OP *
S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
{
+ dVAR;
I32 type;
if (!o || PL_error_count)
OP *
Perl_my_attrs(pTHX_ OP *o, OP *attrs)
{
+ dVAR;
OP *rops;
int maybe_scalar = 0;
int
Perl_block_start(pTHX_ int full)
{
+ dVAR;
const int retval = PL_savestack_ix;
pad_block_start(full);
SAVEHINTS();
OP*
Perl_block_end(pTHX_ I32 floor, OP *seq)
{
+ dVAR;
const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
OP* const retval = scalarseq(seq);
LEAVE_SCOPE(floor);
STATIC OP *
S_newDEFSVOP(pTHX)
{
+ dVAR;
const I32 offset = pad_findmy("$_");
if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
void
Perl_newPROG(pTHX_ OP *o)
{
+ dVAR;
if (PL_in_eval) {
if (PL_eval_root)
return;
OP *
Perl_localize(pTHX_ OP *o, I32 lex)
{
+ dVAR;
if (o->op_flags & OPf_PARENS)
/* [perl #17376]: this appears to be premature, and results in code such as
C< our(%x); > executing in list mode rather than void mode */
OP *
Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
{
+ dVAR;
SV * const tstr = ((SVOP*)expr)->op_sv;
SV * const rstr = ((SVOP*)repl)->op_sv;
STRLEN tlen;
void
Perl_package(pTHX_ OP *o)
{
+ dVAR;
const char *name;
STRLEN len;
void
Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
{
+ dVAR;
OP *pack;
OP *imop;
OP *veop;
void
Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
{
+ dVAR;
OP *veop, *imop;
OP * const modname = newSVOP(OP_CONST, 0, name);
OP *
Perl_dofile(pTHX_ OP *term, I32 force_builtin)
{
+ dVAR;
OP *doop;
GV *gv = Nullgv;
OP *
Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
{
+ dVAR;
OP *o;
if (optype) {
OP *
Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
{
+ dVAR;
OP* listop;
OP* o;
const bool once = block && block->op_flags & OPf_SPECIAL &&
OP*
Perl_newLOOPEX(pTHX_ I32 type, OP *label)
{
+ dVAR;
OP *o;
if (type != OP_GOTO || label->op_type == OP_CONST) {
I32 enter_opcode, I32 leave_opcode,
PADOFFSET entertarg)
{
+ dVAR;
LOGOP *enterop;
OP *o;
bool
S_looks_like_bool(pTHX_ OP *o)
{
+ dVAR;
switch(o->op_type) {
case OP_OR:
return looks_like_bool(cLOGOPo->op_first);
OP *
Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off)
{
+ dVAR;
assert( cond );
return newGIVWHENOP(
ref_array_or_hash(cond),
SV *
Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
{
+ dVAR;
SV *sv = Nullsv;
if (!o)
CV *
Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
{
+ dVAR;
GV * const gv = gv_fetchpv(name ? name :
(PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
GV_ADDMULTI, SVt_PVCV);
void
Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
{
+ dVAR;
register CV *cv;
GV * const gv = o
OP *
Perl_ck_bitop(pTHX_ OP *o)
{
+ dVAR;
#define OP_IS_NUMCOMPARE(op) \
((op) == OP_LT || (op) == OP_I_LT || \
(op) == OP_GT || (op) == OP_I_GT || \
OP *
Perl_ck_eof(pTHX_ OP *o)
{
+ dVAR;
const I32 type = o->op_type;
if (o->op_flags & OPf_KIDS) {
OP *
Perl_ck_exists(pTHX_ OP *o)
{
+ dVAR;
o = ck_fun(o);
if (o->op_flags & OPf_KIDS) {
OP * const kid = cUNOPo->op_first;
OP *
Perl_ck_fun(pTHX_ OP *o)
{
+ dVAR;
const int type = o->op_type;
register I32 oa = PL_opargs[type] >> OASHIFT;
OP *
Perl_ck_smartmatch(pTHX_ OP *o)
{
+ dVAR;
if (0 == (o->op_flags & OPf_SPECIAL)) {
OP *first = cBINOPo->op_first;
OP *second = first->op_sibling;
OP *
Perl_ck_match(pTHX_ OP *o)
{
+ dVAR;
if (o->op_type != OP_QR && PL_compcv) {
const I32 offset = pad_findmy("$_");
if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS(offset) & SVpad_OUR)) {
OP *
Perl_ck_open(pTHX_ OP *o)
{
+ dVAR;
HV * const table = GvHV(PL_hintgv);
if (table) {
SV **svp = hv_fetch(table, "open_IN", 7, FALSE);
OP *
Perl_ck_require(pTHX_ OP *o)
{
+ dVAR;
GV* gv = Nullgv;
if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
OP *
Perl_ck_return(pTHX_ OP *o)
{
+ dVAR;
if (CvLVALUE(PL_compcv)) {
OP *kid;
for (kid = cLISTOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
OP *
Perl_ck_shift(pTHX_ OP *o)
{
+ dVAR;
const I32 type = o->op_type;
if (!(o->op_flags & OPf_KIDS)) {
OP *
Perl_ck_sort(pTHX_ OP *o)
{
+ dVAR;
OP *firstkid;
if (o->op_type == OP_SORT && (PL_hints & HINT_LOCALIZE_HH) != 0)
STATIC void
S_simplify_sort(pTHX_ OP *o)
{
+ dVAR;
register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
OP *k;
int descending;
OP *
Perl_ck_subr(pTHX_ OP *o)
{
+ dVAR;
OP *prev = ((cUNOPo->op_first->op_sibling)
? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
OP *o2 = prev->op_sibling;
char*
Perl_custom_op_name(pTHX_ const OP* o)
{
+ dVAR;
const IV index = PTR2IV(o->op_ppaddr);
SV* keysv;
HE* he;
char*
Perl_custom_op_desc(pTHX_ const OP* o)
{
+ dVAR;
const IV index = PTR2IV(o->op_ppaddr);
SV* keysv;
HE* he;
static void
const_sv_xsub(pTHX_ CV* cv)
{
+ dVAR;
dXSARGS;
if (items != 0) {
#if 0
START_EXTERN_C
#ifdef PERL_GLOBAL_STRUCT_INIT
+# define PERL_PPADDR_INITED
static const Perl_ppaddr_t Gppaddr[]
#else
# ifndef PERL_GLOBAL_STRUCT
+# define PERL_PPADDR_INITED
EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
# endif
#endif /* PERL_GLOBAL_STRUCT */
#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+# define PERL_PPADDR_INITED
= {
MEMBER_TO_FPTR(Perl_pp_null),
MEMBER_TO_FPTR(Perl_pp_stub),
MEMBER_TO_FPTR(Perl_pp_print), /* Perl_pp_say */
}
#endif
+#ifdef PERL_PPADDR_INITED
;
+#endif
#ifdef PERL_GLOBAL_STRUCT_INIT
+# define PERL_CHECK_INITED
static const Perl_check_t Gcheck[]
#else
# ifndef PERL_GLOBAL_STRUCT
+# define PERL_CHECK_INITED
EXT Perl_check_t PL_check[] /* or perlvars.h */
# endif
#endif
#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+# define PERL_CHECK_INITED
= {
MEMBER_TO_FPTR(Perl_ck_null), /* null */
MEMBER_TO_FPTR(Perl_ck_null), /* stub */
MEMBER_TO_FPTR(Perl_ck_null), /* custom */
}
#endif
+#ifdef PERL_CHECK_INITED
;
+#endif /* #ifdef PERL_CHECK_INITED */
#ifndef PERL_GLOBAL_STRUCT_INIT
START_EXTERN_C
#ifdef PERL_GLOBAL_STRUCT_INIT
+# define PERL_PPADDR_INITED
static const Perl_ppaddr_t Gppaddr[]
#else
# ifndef PERL_GLOBAL_STRUCT
+# define PERL_PPADDR_INITED
EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
# endif
#endif /* PERL_GLOBAL_STRUCT */
#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+# define PERL_PPADDR_INITED
= {
END
print <<END;
}
#endif
+#ifdef PERL_PPADDR_INITED
;
+#endif
END
print <<END;
#ifdef PERL_GLOBAL_STRUCT_INIT
+# define PERL_CHECK_INITED
static const Perl_check_t Gcheck[]
#else
# ifndef PERL_GLOBAL_STRUCT
+# define PERL_CHECK_INITED
EXT Perl_check_t PL_check[] /* or perlvars.h */
# endif
#endif
#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+# define PERL_CHECK_INITED
= {
END
print <<END;
}
#endif
+#ifdef PERL_CHECK_INITED
;
+#endif /* #ifdef PERL_CHECK_INITED */
END
PADLIST *
Perl_pad_new(pTHX_ int flags)
{
+ dVAR;
AV *padlist, *padname, *pad;
ASSERT_CURPAD_LEGAL("pad_new");
void
Perl_pad_undef(pTHX_ CV* cv)
{
+ dVAR;
I32 ix;
const PADLIST * const padlist = CvPADLIST(cv);
PADOFFSET
Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake)
{
+ dVAR;
const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
SV* const namesv = NEWSV(1102, 0);
PADOFFSET
Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
{
+ dVAR;
SV *sv;
I32 retval;
PADOFFSET
Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
{
+ dVAR;
PADOFFSET ix;
SV* const name = NEWSV(1106, 0);
sv_upgrade(name, SVt_PVNV);
void
Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
{
+ dVAR;
SV **svp;
PADOFFSET top, off;
PADOFFSET
Perl_pad_findmy(pTHX_ const char *name)
{
+ dVAR;
SV *out_sv;
int out_flags;
I32 offset;
PADOFFSET
Perl_find_rundefsvoffset(pTHX)
{
+ dVAR;
SV *out_sv;
int out_flags;
return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
SV** out_capture, SV** out_name_sv, int *out_flags)
{
+ dVAR;
I32 offset, new_offset;
SV *new_capture;
SV **new_capturep;
SV *
Perl_pad_sv(pTHX_ PADOFFSET po)
{
+ dVAR;
ASSERT_CURPAD_ACTIVE("pad_sv");
if (!po)
void
Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
{
+ dVAR;
ASSERT_CURPAD_ACTIVE("pad_setsv");
DEBUG_X(PerlIO_printf(Perl_debug_log,
void
Perl_pad_block_start(pTHX_ int full)
{
+ dVAR;
ASSERT_CURPAD_ACTIVE("pad_block_start");
SAVEI32(PL_comppad_name_floor);
PL_comppad_name_floor = AvFILLp(PL_comppad_name);
U32
Perl_intro_my(pTHX)
{
+ dVAR;
SV **svp;
I32 i;
void
Perl_pad_leavemy(pTHX)
{
+ dVAR;
I32 off;
SV * const * const svp = AvARRAY(PL_comppad_name);
void
Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
{
+ dVAR;
ASSERT_CURPAD_LEGAL("pad_swipe");
if (!PL_curpad)
return;
void
Perl_pad_reset(pTHX)
{
+ dVAR;
#ifdef USE_BROKEN_PAD_RESET
if (AvARRAY(PL_comppad) != PL_curpad)
Perl_croak(aTHX_ "panic: pad_reset curpad");
void
Perl_pad_free(pTHX_ PADOFFSET po)
{
+ dVAR;
ASSERT_CURPAD_LEGAL("pad_free");
if (!PL_curpad)
return;
void
Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
{
+ dVAR;
const AV *pad_name;
const AV *pad;
SV **pname;
STATIC void
S_cv_dump(pTHX_ const CV *cv, const char *title)
{
+ dVAR;
const CV * const outside = CvOUTSIDE(cv);
AV* const padlist = CvPADLIST(cv);
void
Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
{
+ dVAR;
I32 ix;
AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
AV * const comppad = (AV*)AvARRAY(padlist)[1];
void
Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
{
+ dVAR;
if (depth <= AvFILLp(padlist))
return;
HV *
Perl_pad_compname_type(pTHX_ const PADOFFSET po)
{
+ dVAR;
SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
if ( SvFLAGS(*av) & SVpad_TYPED ) {
return SvSTASH(*av);
void
Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
{
+ dVAR;
Renew(PL_exitlist, PL_exitlistlen+1, PerlExitListEntry);
PL_exitlist[PL_exitlistlen].fn = fn;
PL_exitlist[PL_exitlistlen].ptr = ptr;
STATIC void
S_set_caret_X(pTHX) {
+ dVAR;
GV* tmpgv = gv_fetchpv("\030",TRUE, SVt_PV); /* $^X */
if (tmpgv) {
#ifdef HAS_PROCSELFEXE
int
perl_run(pTHXx)
{
+ dVAR;
I32 oldscope;
int ret = 0;
dJMPENV;
STATIC void
S_run_body(pTHX_ I32 oldscope)
{
+ dVAR;
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
PL_sawampersand ? "Enabling" : "Omitting"));
/* See G_* flags in cop.h */
/* null terminated arg list */
{
+ dVAR;
dSP;
PUSHMARK(SP);
STATIC void
S_call_body(pTHX_ const OP *myop, bool is_eval)
{
+ dVAR;
if (PL_op == myop) {
if (is_eval)
PL_op = Perl_pp_entereval(aTHX); /* this doesn't do a POPMARK */
/* See G_* flags in cop.h */
{
+ dVAR;
dSP;
UNOP myop; /* fake syntax tree node */
volatile I32 oldmark = SP - PL_stack_base;
SV*
Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
{
+ dVAR;
dSP;
SV* sv = newSVpv(p, 0);
void
Perl_require_pv(pTHX_ const char *pv)
{
- SV* sv;
+ dVAR;
dSP;
+ SV* sv;
PUSHSTACKi(PERLSI_REQUIRE);
PUTBACK;
sv = Perl_newSVpvf(aTHX_ "require q%c%s%c", 0, pv, 0);
STATIC void
S_init_interp(pTHX)
{
-
+ dVAR;
#ifdef MULTIPLICITY
# define PERLVAR(var,type)
# define PERLVARA(var,n,type)
STATIC void
S_init_main_stash(pTHX)
{
+ dVAR;
GV *gv;
PL_curstash = PL_defstash = newHV();
STATIC void
S_find_beginning(pTHX)
{
+ dVAR;
register char *s;
register const char *s2;
#ifdef MACOS_TRADITIONAL
STATIC void
S_init_ids(pTHX)
{
+ dVAR;
PL_uid = PerlProc_getuid();
PL_euid = PerlProc_geteuid();
PL_gid = PerlProc_getgid();
STATIC void
S_forbid_setid(pTHX_ const char *s)
{
+ dVAR;
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
if (PL_euid != PL_uid)
Perl_croak(aTHX_ "No %s allowed while running setuid", s);
void
Perl_init_debugger(pTHX)
{
+ dVAR;
HV * const ostash = PL_curstash;
PL_curstash = PL_debstash;
void
Perl_init_stacks(pTHX)
{
+ dVAR;
/* start with 128-item stack and 8K cxstack */
PL_curstackinfo = new_stackinfo(REASONABLE(128),
REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
STATIC void
S_nuke_stacks(pTHX)
{
+ dVAR;
while (PL_curstackinfo->si_next)
PL_curstackinfo = PL_curstackinfo->si_next;
while (PL_curstackinfo) {
STATIC void
S_init_lexer(pTHX)
{
+ dVAR;
PerlIO *tmpfp;
tmpfp = PL_rsfp;
PL_rsfp = Nullfp;
STATIC void
S_init_predump_symbols(pTHX)
{
+ dVAR;
GV *tmpgv;
IO *io;
void
Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
{
+ dVAR;
argc--,argv++; /* skip name of script */
if (PL_doswitches) {
for (; argc > 0 && **argv == '-'; argc--,argv++) {
STATIC void
S_init_perllib(pTHX)
{
+ dVAR;
char *s;
if (!PL_tainting) {
#ifndef VMS
STATIC SV *
S_incpush_if_exists(pTHX_ SV *dir)
{
+ dVAR;
Stat_t tmpstatbuf;
if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode)) {
S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
bool canrelocate)
{
+ dVAR;
SV *subdir = Nullsv;
const char *p = dir;
STATIC void *
S_call_list_body(pTHX_ CV *cv)
{
+ dVAR;
PUSHMARK(PL_stack_sp);
call_sv((SV*)cv, G_EVAL|G_DISCARD);
return NULL;
void
Perl_my_exit(pTHX_ U32 status)
{
+ dVAR;
DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
thr, (unsigned long) status));
switch (status) {
void
Perl_my_failure_exit(pTHX)
{
+ dVAR;
#ifdef VMS
/* We have been called to fall on our sword. The desired exit code
* should be already set in STATUS_UNIX, but could be shifted over
static I32
read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
{
+ dVAR;
const char * const p = SvPVX_const(PL_e_script);
const char *nl = strchr(p, '\n');
# endif
#endif
-#if defined(MULTIPLICITY)
-# ifndef PERL_IMPLICIT_CONTEXT
-# define PERL_IMPLICIT_CONTEXT
-# endif
-#endif
-
#ifdef PERL_GLOBAL_STRUCT_PRIVATE
# ifndef PERL_GLOBAL_STRUCT
# define PERL_GLOBAL_STRUCT
# endif
#endif
+
#ifdef PERL_GLOBAL_STRUCT
# ifndef MULTIPLICITY
# define MULTIPLICITY
# endif
#endif
+#ifdef MULTIPLICITY
+# ifndef PERL_IMPLICIT_CONTEXT
+# define PERL_IMPLICIT_CONTEXT
+# endif
+#endif
+
/* undef WIN32 when building on Cygwin (for libwin32) - gph */
#ifdef __CYGWIN__
# undef WIN32
I32
Perl_keyword (pTHX_ const char *name, I32 len)
{
+ dVAR;
$switch
unknown:
return 0;
PerlIO *
PerlIO_allocate(pTHX)
{
+ dVAR;
/*
* Find a free slot in the table, allocating new table as necessary
*/
void
PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
{
+ dVAR;
PerlIO_pair_t *p;
if (list->cur >= list->len) {
list->len += 8;
void
PerlIO_destruct(pTHX)
{
+ dVAR;
PerlIO **table = &PL_perlio;
PerlIO *f;
#ifdef USE_ITHREADS
AV *
PerlIO_get_layers(pTHX_ PerlIO *f)
{
+ dVAR;
AV * const av = newAV();
if (PerlIOValid(f)) {
/* This is used as a %SIG{__WARN__} handler to supress warnings
during loading of layers.
*/
+ dVAR;
dXSARGS;
if (items)
PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0)));
XS(XS_PerlIO__Layer__find)
{
+ dVAR;
dXSARGS;
if (items < 2)
Perl_croak(aTHX_ "Usage class->find(name[,load])");
void
PerlIO_define_layer(pTHX_ PerlIO_funcs *tab)
{
+ dVAR;
if (!PL_known_layers)
PL_known_layers = PerlIO_list_alloc(aTHX);
PerlIO_list_push(aTHX_ PL_known_layers, tab, Nullsv);
int
PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
{
+ dVAR;
if (names) {
const char *s = names;
while (*s) {
void
PerlIO_default_buffer(pTHX_ PerlIO_list_t *av)
{
+ dVAR;
PERLIO_FUNCS_DECL(*tab) = &PerlIO_perlio;
#ifdef PERLIO_USING_CRLF
tab = &PerlIO_crlf;
PerlIO_list_t *
PerlIO_default_layers(pTHX)
{
+ dVAR;
if (!PL_def_layerlist) {
const char * const s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix;
PerlIO_funcs *
PerlIO_default_layer(pTHX_ I32 n)
{
+ dVAR;
PerlIO_list_t * const av = PerlIO_default_layers(aTHX);
if (n < 0)
n += av->cur;
void
PerlIO_stdstreams(pTHX)
{
+ dVAR;
if (!PL_perlio) {
PerlIO_allocate(aTHX);
PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT);
int
Perl_PerlIO_fileno(pTHX_ PerlIO *f)
{
+ dVAR;
Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f));
}
static const char *
PerlIO_context_layers(pTHX_ const char *mode)
{
+ dVAR;
const char *type = NULL;
/*
* Need to supply default layer info from open.pm
static PerlIO_funcs *
PerlIO_layer_from_ref(pTHX_ SV *sv)
{
+ dVAR;
/*
* For any scalar type load the handler which is bundled with perl
*/
PerlIO_resolve_layers(pTHX_ const char *layers,
const char *mode, int narg, SV **args)
{
+ dVAR;
PerlIO_list_t *def = PerlIO_default_layers(aTHX);
int incdef = 1;
if (!PL_perlio)
PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
int imode, int perm, PerlIO *f, int narg, SV **args)
{
+ dVAR;
if (!f && narg == 1 && *args == &PL_sv_undef) {
if ((f = PerlIO_tmpfile())) {
if (!layers || !*layers)
int
Perl_PerlIO_flush(pTHX_ PerlIO *f)
{
+ dVAR;
if (f) {
if (*f) {
const PerlIO_funcs *tab = PerlIOBase(f)->tab;
void
PerlIOBase_flush_linebuf(pTHX)
{
+ dVAR;
PerlIO **table = &PL_perlio;
PerlIO *f;
while ((f = *table)) {
{
dTHX;
if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+ dVAR;
#ifdef USE_THREADS
MUTEX_LOCK(&PerlIO_mutex);
#endif
dTHX;
int cnt = 0;
if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+ dVAR;
#ifdef USE_THREADS
MUTEX_LOCK(&PerlIO_mutex);
#endif
void
PerlIO_cleanup(pTHX)
{
+ dVAR;
int i;
#ifdef USE_ITHREADS
PerlIO_debug("Cleanup layers for %p\n",aTHX);
SSize_t
PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
+ dVAR;
const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
#ifdef PERLIO_STD_SPECIAL
if (fd == 0)
SSize_t
PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
+ dVAR;
const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
#ifdef PERLIO_STD_SPECIAL
if (fd == 1 || fd == 2)
IV
PerlIOUnix_close(pTHX_ PerlIO *f)
{
+ dVAR;
const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
int code = 0;
if (PerlIOBase(f)->flags & PERLIO_F_OPEN) {
SSize_t
PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
+ dVAR;
FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio;
SSize_t got = 0;
for (;;) {
SSize_t
PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
+ dVAR;
SSize_t got;
for (;;) {
got = PerlSIO_fwrite(vbuf, 1, count,
PerlIO *
Perl_PerlIO_stdin(pTHX)
{
+ dVAR;
if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
PerlIO *
Perl_PerlIO_stdout(pTHX)
{
+ dVAR;
if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
PerlIO *
Perl_PerlIO_stderr(pTHX)
{
+ dVAR;
if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
/* allocate a unique index to every module that calls MY_CXT_INIT */
#ifdef PERL_IMPLICIT_CONTEXT
+# ifdef USE_ITHREADS
PERLVAR(Gmy_ctx_mutex, perl_mutex)
+# endif
PERLVARI(Gmy_cxt_index, int, 0)
#endif
int
Perl_yyparse (pTHX)
{
+ dVAR;
int yychar; /* The lookahead symbol. */
YYSTYPE yylval; /* The semantic value of the lookahead symbol. */
int yynerrs; /* Number of syntax errors so far. */
PP(pp_stub)
{
+ dVAR;
dSP;
if (GIMME_V == G_SCALAR)
XPUSHs(&PL_sv_undef);
PP(pp_padav)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
I32 gimme;
if (PL_op->op_private & OPpLVAL_INTRO)
SAVECLEARSV(PAD_SVl(PL_op->op_targ));
PP(pp_padhv)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
I32 gimme;
XPUSHs(TARG);
PP(pp_rv2gv)
{
- dSP; dTOPss;
+ dVAR; dSP; dTOPss;
if (SvROK(sv)) {
wasref:
PP(pp_rv2sv)
{
+ dVAR; dSP; dTOPss;
GV *gv = NULL;
- dSP; dTOPss;
if (SvROK(sv)) {
wasref:
PP(pp_av2arylen)
{
- dSP;
+ dVAR; dSP;
AV * const av = (AV*)TOPs;
SV ** const sv = Perl_av_arylen_p(aTHX_ (AV*)av);
if (!*sv) {
PP(pp_pos)
{
- dSP; dTARGET; dPOPss;
+ dVAR; dSP; dTARGET; dPOPss;
if (PL_op->op_flags & OPf_MOD || LVRET) {
if (SvTYPE(TARG) < SVt_PVLV) {
PP(pp_rv2cv)
{
- dSP;
+ dVAR; dSP;
GV *gv;
HV *stash;
const I32 flags = (PL_op->op_flags & OPf_SPECIAL)
PP(pp_prototype)
{
- dSP;
+ dVAR; dSP;
CV *cv;
HV *stash;
GV *gv;
PP(pp_anoncode)
{
- dSP;
+ dVAR; dSP;
CV* cv = (CV*)PAD_SV(PL_op->op_targ);
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
PP(pp_srefgen)
{
- dSP;
+ dVAR; dSP;
*SP = refto(*SP);
RETURN;
}
PP(pp_refgen)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
if (GIMME != G_ARRAY) {
if (++MARK <= SP)
*MARK = *SP;
STATIC SV*
S_refto(pTHX_ SV *sv)
{
+ dVAR;
SV* rv;
if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
PP(pp_ref)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
const char *pv;
SV * const sv = POPs;
PP(pp_bless)
{
- dSP;
+ dVAR; dSP;
HV *stash;
if (MAXARG == 1)
PP(pp_gelem)
{
- dSP;
+ dVAR; dSP;
SV *sv = POPs;
const char * const elem = SvPV_nolen_const(sv);
PP(pp_study)
{
- dSP; dPOPss;
+ dVAR; dSP; dPOPss;
register unsigned char *s;
register I32 pos;
register I32 ch;
PP(pp_trans)
{
- dSP; dTARG;
+ dVAR; dSP; dTARG;
SV *sv;
if (PL_op->op_flags & OPf_STACKED)
PP(pp_schop)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
do_chop(TARG, TOPs);
SETTARG;
RETURN;
PP(pp_chop)
{
- dSP; dMARK; dTARGET; dORIGMARK;
+ dVAR; dSP; dMARK; dTARGET; dORIGMARK;
while (MARK < SP)
do_chop(TARG, *++MARK);
SP = ORIGMARK;
PP(pp_schomp)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
SETi(do_chomp(TOPs));
RETURN;
}
PP(pp_chomp)
{
- dSP; dMARK; dTARGET;
+ dVAR; dSP; dMARK; dTARGET;
register I32 count = 0;
while (SP > MARK)
PP(pp_undef)
{
- dSP;
+ dVAR; dSP;
SV *sv;
if (!PL_op->op_private) {
PP(pp_predec)
{
- dSP;
+ dVAR; dSP;
if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
DIE(aTHX_ PL_no_modify);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
PP(pp_postinc)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
PP(pp_postdec)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
PP(pp_pow)
{
- dSP; dATARGET;
+ dVAR; dSP; dATARGET;
#ifdef PERL_PRESERVE_IVUV
bool is_int = 0;
#endif
PP(pp_multiply)
{
- dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_divide)
{
- dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
/* Only try to do UV divide first
if ((SLOPPYDIVIDE is true) or
(PERL_PRESERVE_IVUV is true and one or both SV is a UV too large
PP(pp_modulo)
{
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
UV left = 0;
UV right = 0;
PP(pp_repeat)
{
- dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
{
register IV count;
dPOPss;
PP(pp_subtract)
{
- dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
+ dVAR; dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
useleft = USE_LEFT(TOPm1s);
#ifdef PERL_PRESERVE_IVUV
/* See comments in pp_add (in pp_hot.c) about Overflow, and how
PP(pp_left_shift)
{
- dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
{
const IV shift = POPi;
if (PL_op->op_private & HINT_INTEGER) {
PP(pp_right_shift)
{
- dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
{
const IV shift = POPi;
if (PL_op->op_private & HINT_INTEGER) {
PP(pp_lt)
{
- dSP; tryAMAGICbinSET(lt,0);
+ dVAR; dSP; tryAMAGICbinSET(lt,0);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_gt)
{
- dSP; tryAMAGICbinSET(gt,0);
+ dVAR; dSP; tryAMAGICbinSET(gt,0);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_le)
{
- dSP; tryAMAGICbinSET(le,0);
+ dVAR; dSP; tryAMAGICbinSET(le,0);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_ge)
{
- dSP; tryAMAGICbinSET(ge,0);
+ dVAR; dSP; tryAMAGICbinSET(ge,0);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_ne)
{
- dSP; tryAMAGICbinSET(ne,0);
+ dVAR; dSP; tryAMAGICbinSET(ne,0);
#ifndef NV_PRESERVES_UV
if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
SP--;
PP(pp_ncmp)
{
- dSP; dTARGET; tryAMAGICbin(ncmp,0);
+ dVAR; dSP; dTARGET; tryAMAGICbin(ncmp,0);
#ifndef NV_PRESERVES_UV
if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
const UV right = PTR2UV(SvRV(POPs));
PP(pp_sle)
{
- dSP;
+ dVAR; dSP;
int amg_type = sle_amg;
int multiplier = 1;
PP(pp_seq)
{
- dSP; tryAMAGICbinSET(seq,0);
+ dVAR; dSP; tryAMAGICbinSET(seq,0);
{
dPOPTOPssrl;
SETs(boolSV(sv_eq(left, right)));
PP(pp_sne)
{
- dSP; tryAMAGICbinSET(sne,0);
+ dVAR; dSP; tryAMAGICbinSET(sne,0);
{
dPOPTOPssrl;
SETs(boolSV(!sv_eq(left, right)));
PP(pp_scmp)
{
- dSP; dTARGET; tryAMAGICbin(scmp,0);
+ dVAR; dSP; dTARGET; tryAMAGICbin(scmp,0);
{
dPOPTOPssrl;
const int cmp = (IN_LOCALE_RUNTIME
PP(pp_bit_and)
{
- dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
{
dPOPTOPssrl;
SvGETMAGIC(left);
PP(pp_bit_xor)
{
- dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
{
dPOPTOPssrl;
SvGETMAGIC(left);
PP(pp_bit_or)
{
- dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
{
dPOPTOPssrl;
SvGETMAGIC(left);
PP(pp_negate)
{
- dSP; dTARGET; tryAMAGICun(neg);
+ dVAR; dSP; dTARGET; tryAMAGICun(neg);
{
dTOPss;
const int flags = SvFLAGS(sv);
PP(pp_not)
{
- dSP; tryAMAGICunSET(not);
+ dVAR; dSP; tryAMAGICunSET(not);
*PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
return NORMAL;
}
PP(pp_complement)
{
- dSP; dTARGET; tryAMAGICun(compl);
+ dVAR; dSP; dTARGET; tryAMAGICun(compl);
{
dTOPss;
SvGETMAGIC(sv);
PP(pp_i_multiply)
{
- dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
{
dPOPTOPiirl;
SETi( left * right );
PP(pp_i_divide)
{
- dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPiv;
if (value == 0)
/* This is the i_modulo with the workaround for the _moddi3 bug
* in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
* See below for pp_i_modulo. */
- dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
PP(pp_i_add)
{
- dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
{
dPOPTOPiirl_ul;
SETi( left + right );
PP(pp_i_subtract)
{
- dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
{
dPOPTOPiirl_ul;
SETi( left - right );
PP(pp_i_lt)
{
- dSP; tryAMAGICbinSET(lt,0);
+ dVAR; dSP; tryAMAGICbinSET(lt,0);
{
dPOPTOPiirl;
SETs(boolSV(left < right));
PP(pp_i_gt)
{
- dSP; tryAMAGICbinSET(gt,0);
+ dVAR; dSP; tryAMAGICbinSET(gt,0);
{
dPOPTOPiirl;
SETs(boolSV(left > right));
PP(pp_i_le)
{
- dSP; tryAMAGICbinSET(le,0);
+ dVAR; dSP; tryAMAGICbinSET(le,0);
{
dPOPTOPiirl;
SETs(boolSV(left <= right));
PP(pp_i_ge)
{
- dSP; tryAMAGICbinSET(ge,0);
+ dVAR; dSP; tryAMAGICbinSET(ge,0);
{
dPOPTOPiirl;
SETs(boolSV(left >= right));
PP(pp_i_eq)
{
- dSP; tryAMAGICbinSET(eq,0);
+ dVAR; dSP; tryAMAGICbinSET(eq,0);
{
dPOPTOPiirl;
SETs(boolSV(left == right));
PP(pp_i_ne)
{
- dSP; tryAMAGICbinSET(ne,0);
+ dVAR; dSP; tryAMAGICbinSET(ne,0);
{
dPOPTOPiirl;
SETs(boolSV(left != right));
PP(pp_i_ncmp)
{
- dSP; dTARGET; tryAMAGICbin(ncmp,0);
+ dVAR; dSP; dTARGET; tryAMAGICbin(ncmp,0);
{
dPOPTOPiirl;
I32 value;
PP(pp_i_negate)
{
- dSP; dTARGET; tryAMAGICun(neg);
+ dVAR; dSP; dTARGET; tryAMAGICun(neg);
SETi(-TOPi);
RETURN;
}
PP(pp_atan2)
{
- dSP; dTARGET; tryAMAGICbin(atan2,0);
+ dVAR; dSP; dTARGET; tryAMAGICbin(atan2,0);
{
dPOPTOPnnrl;
SETn(Perl_atan2(left, right));
PP(pp_sin)
{
- dSP; dTARGET; tryAMAGICun(sin);
+ dVAR; dSP; dTARGET; tryAMAGICun(sin);
{
const NV value = POPn;
XPUSHn(Perl_sin(value));
PP(pp_cos)
{
- dSP; dTARGET; tryAMAGICun(cos);
+ dVAR; dSP; dTARGET; tryAMAGICun(cos);
{
const NV value = POPn;
XPUSHn(Perl_cos(value));
PP(pp_rand)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
NV value;
if (MAXARG < 1)
value = 1.0;
PP(pp_srand)
{
- dSP;
+ dVAR; dSP;
const UV anum = (MAXARG < 1) ? seed() : POPu;
(void)seedDrand01((Rand_seed_t)anum);
PL_srand_called = TRUE;
PP(pp_exp)
{
- dSP; dTARGET; tryAMAGICun(exp);
+ dVAR; dSP; dTARGET; tryAMAGICun(exp);
{
NV value;
value = POPn;
PP(pp_log)
{
- dSP; dTARGET; tryAMAGICun(log);
+ dVAR; dSP; dTARGET; tryAMAGICun(log);
{
const NV value = POPn;
if (value <= 0.0) {
PP(pp_sqrt)
{
- dSP; dTARGET; tryAMAGICun(sqrt);
+ dVAR; dSP; dTARGET; tryAMAGICun(sqrt);
{
const NV value = POPn;
if (value < 0.0) {
PP(pp_int)
{
- dSP; dTARGET; tryAMAGICun(int);
+ dVAR; dSP; dTARGET; tryAMAGICun(int);
{
const IV iv = TOPi; /* attempt to convert to IV if possible. */
/* XXX it's arguable that compiler casting to IV might be subtly
PP(pp_abs)
{
- dSP; dTARGET; tryAMAGICun(abs);
+ dVAR; dSP; dTARGET; tryAMAGICun(abs);
{
/* This will cache the NV value if string isn't actually integer */
const IV iv = TOPi;
PP(pp_hex)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
const char *tmps;
I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
STRLEN len;
PP(pp_oct)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
const char *tmps;
I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
STRLEN len;
PP(pp_length)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
SV * const sv = TOPs;
if (DO_UTF8(sv))
PP(pp_substr)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
SV *sv;
I32 len = 0;
STRLEN curlen;
PP(pp_vec)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
register const IV size = POPi;
register const IV offset = POPi;
register SV * const src = POPs;
PP(pp_index)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
SV *big;
SV *little;
SV *temp = NULL;
PP(pp_rindex)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
SV *big;
SV *little;
SV *temp = NULL;
PP(pp_sprintf)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
do_sprintf(TARG, SP-MARK, MARK+1);
TAINT_IF(SvTAINTED(TARG));
SP = ORIGMARK;
PP(pp_ord)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
SV *argsv = POPs;
STRLEN len;
const U8 *s = (U8*)SvPV_const(argsv, len);
PP(pp_chr)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
char *tmps;
UV value;
PP(pp_crypt)
{
#ifdef HAS_CRYPT
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
dPOPTOPssrl;
STRLEN len;
const char *tmps = SvPV_const(left, len);
PP(pp_ucfirst)
{
+ dVAR;
dSP;
SV *sv = TOPs;
const U8 *s;
PP(pp_uc)
{
+ dVAR;
dSP;
SV *sv = TOPs;
STRLEN len;
PP(pp_lc)
{
+ dVAR;
dSP;
SV *sv = TOPs;
STRLEN len;
PP(pp_quotemeta)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
SV * const sv = TOPs;
STRLEN len;
register const char *s = SvPV_const(sv,len);
PP(pp_aslice)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register AV* const av = (AV*)POPs;
register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
PP(pp_each)
{
+ dVAR;
dSP;
HV * const hash = (HV*)POPs;
HE *entry;
PP(pp_delete)
{
+ dVAR;
dSP;
const I32 gimme = GIMME_V;
const I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
PP(pp_exists)
{
+ dVAR;
dSP;
SV *tmpsv;
HV *hv;
PP(pp_hslice)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register HV * const hv = (HV*)POPs;
register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
PP(pp_list)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
if (GIMME != G_ARRAY) {
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item */
PP(pp_lslice)
{
+ dVAR;
dSP;
SV ** const lastrelem = PL_stack_sp;
SV ** const lastlelem = PL_stack_base + POPMARK;
PP(pp_anonlist)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
const I32 items = SP - MARK;
SV * const av = sv_2mortal((SV*)av_make(items, MARK+1));
SP = ORIGMARK; /* av_make() might realloc stack_sp */
PP(pp_anonhash)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
HV* const hv = (HV*)sv_2mortal((SV*)newHV());
while (MARK < SP) {
PP(pp_pop)
{
+ dVAR;
dSP;
AV * const av = (AV*)POPs;
SV * const sv = av_pop(av);
PP(pp_shift)
{
+ dVAR;
dSP;
AV * const av = (AV*)POPs;
SV * const sv = av_shift(av);
PP(pp_reverse)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
SV ** const oldsp = SP;
if (GIMME == G_ARRAY) {
PP(pp_lock)
{
+ dVAR;
dSP;
dTOPss;
SV *retsv = sv;
PP(unimplemented_op)
{
+ dVAR;
DIE(aTHX_ "panic: unimplemented op %s (#%d) called", OP_NAME(PL_op),
PL_op->op_type);
}
PP(pp_wantarray)
{
+ dVAR;
dSP;
I32 cxix;
EXTEND(SP, 1);
PP(pp_regcreset)
{
+ dVAR;
/* XXXX Should store the old value to allow for tie/overload - and
restore in regcomp, where marked with XXXX. */
PL_reginterp_cnt = 0;
PP(pp_regcomp)
{
+ dVAR;
dSP;
register PMOP *pm = (PMOP*)cLOGOP->op_other;
SV *tmpstr;
PP(pp_substcont)
{
+ dVAR;
dSP;
register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
register PMOP * const pm = (PMOP*) cLOGOP->op_other;
PP(pp_formline)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register SV * const tmpForm = *++MARK;
register U32 *fpc;
register char *t;
PP(pp_range)
{
+ dVAR;
if (GIMME == G_ARRAY)
return NORMAL;
if (SvTRUEx(PAD_SV(PL_op->op_targ)))
PP(pp_flip)
{
+ dVAR;
dSP;
if (GIMME == G_ARRAY) {
PP(pp_flop)
{
- dSP;
+ dVAR; dSP;
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
STATIC I32
S_dopoptolabel(pTHX_ const char *label)
{
+ dVAR;
register I32 i;
for (i = cxstack_ix; i >= 0; i--) {
I32
Perl_dowantarray(pTHX)
{
+ dVAR;
const I32 gimme = block_gimme();
return (gimme == G_VOID) ? G_SCALAR : gimme;
}
I32
Perl_block_gimme(pTHX)
{
+ dVAR;
const I32 cxix = dopoptosub(cxstack_ix);
if (cxix < 0)
return G_VOID;
I32
Perl_is_lvalue_sub(pTHX)
{
+ dVAR;
const I32 cxix = dopoptosub(cxstack_ix);
assert(cxix >= 0); /* We should only be called from inside subs */
STATIC I32
S_dopoptosub(pTHX_ I32 startingblock)
{
+ dVAR;
return dopoptosub_at(cxstack, startingblock);
}
STATIC I32
S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
{
+ dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT * const cx = &cxstk[i];
STATIC I32
S_dopoptoeval(pTHX_ I32 startingblock)
{
+ dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT *cx = &cxstack[i];
STATIC I32
S_dopoptoloop(pTHX_ I32 startingblock)
{
+ dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT * const cx = &cxstack[i];
STATIC I32
S_dopoptogiven(pTHX_ I32 startingblock)
{
+ dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT *cx = &cxstack[i];
STATIC I32
S_dopoptowhen(pTHX_ I32 startingblock)
{
+ dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT *cx = &cxstack[i];
void
Perl_dounwind(pTHX_ I32 cxix)
{
+ dVAR;
I32 optype;
while (cxstack_ix > cxix) {
void
Perl_qerror(pTHX_ SV *err)
{
+ dVAR;
if (PL_in_eval)
sv_catsv(ERRSV, err);
else if (PL_errors)
PP(pp_xor)
{
- dSP; dPOPTOPssrl;
+ dVAR; dSP; dPOPTOPssrl;
if (SvTRUE(left) != SvTRUE(right))
RETSETYES;
else
PP(pp_caller)
{
+ dVAR;
dSP;
register I32 cxix = dopoptosub(cxstack_ix);
register const PERL_CONTEXT *cx;
PP(pp_reset)
{
+ dVAR;
dSP;
const char * const tmps = (MAXARG < 1) ? "" : POPpconstx;
sv_reset(tmps, CopSTASH(PL_curcop));
STATIC OP *
S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
{
+ dVAR;
OP **ops = opstack;
static const char too_deep[] = "Target of goto is too deeply nested";
PP(pp_exit)
{
+ dVAR;
dSP;
I32 anum;
STATIC void
S_docatch_body(pTHX)
{
+ dVAR;
CALLRUNOPS(aTHX);
return;
}
STATIC OP *
S_docatch(pTHX_ OP *o)
{
+ dVAR;
int ret;
OP * const oldop = PL_op;
dJMPENV;
CV*
Perl_find_runcv(pTHX_ U32 *db_seqp)
{
+ dVAR;
PERL_SI *si;
if (db_seqp)
PMOP *
S_make_matcher(pTHX_ regexp *re)
{
+ dVAR;
PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED);
PM_SETRE(matcher, ReREFCNT_inc(re));
bool
S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
{
+ dVAR;
dSP;
PL_op = (OP *) matcher;
void
S_destroy_matcher(pTHX_ PMOP *matcher)
{
+ dVAR;
PERL_UNUSED_ARG(matcher);
FREETMPS;
LEAVE;
OP *
S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
{
+ dVAR;
dSP;
SV *e = TOPs; /* e is for 'expression' */
PP(pp_const)
{
+ dVAR;
dSP;
XPUSHs(cSVOP_sv);
RETURN;
PP(pp_nextstate)
{
+ dVAR;
PL_curcop = (COP*)PL_op;
TAINT_NOT; /* Each statement is presumed innocent */
PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
PP(pp_gvsv)
{
+ dVAR;
dSP;
EXTEND(SP,1);
if (PL_op->op_private & OPpLVAL_INTRO)
PP(pp_null)
{
+ dVAR;
return NORMAL;
}
PP(pp_setstate)
{
+ dVAR;
PL_curcop = (COP*)PL_op;
return NORMAL;
}
PP(pp_pushmark)
{
+ dVAR;
PUSHMARK(PL_stack_sp);
return NORMAL;
}
PP(pp_stringify)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
sv_copypv(TARG,TOPs);
SETTARG;
RETURN;
PP(pp_gv)
{
- dSP;
+ dVAR; dSP;
XPUSHs((SV*)cGVOP_gv);
RETURN;
}
PP(pp_and)
{
- dSP;
+ dVAR; dSP;
if (!SvTRUE(TOPs))
RETURN;
else {
PP(pp_sassign)
{
- dSP; dPOPTOPssrl;
+ dVAR; dSP; dPOPTOPssrl;
if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
SV * const temp = left;
PP(pp_cond_expr)
{
- dSP;
+ dVAR; dSP;
if (SvTRUEx(POPs))
RETURNOP(cLOGOP->op_other);
else
PP(pp_unstack)
{
+ dVAR;
I32 oldsave;
TAINT_NOT; /* Each statement is presumed innocent */
PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
PP(pp_concat)
{
- dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
{
dPOPTOPssrl;
bool lbyte;
PP(pp_padsv)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
XPUSHs(TARG);
if (PL_op->op_flags & OPf_MOD) {
if (PL_op->op_private & OPpLVAL_INTRO)
PP(pp_readline)
{
+ dVAR;
tryAMAGICunTARGET(iter, 0);
PL_last_in_gv = (GV*)(*PL_stack_sp--);
if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
PP(pp_eq)
{
- dSP; tryAMAGICbinSET(eq,0);
+ dVAR; dSP; tryAMAGICbinSET(eq,0);
#ifndef NV_PRESERVES_UV
if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
SP--;
PP(pp_preinc)
{
- dSP;
+ dVAR; dSP;
if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
DIE(aTHX_ PL_no_modify);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
PP(pp_or)
{
- dSP;
+ dVAR; dSP;
if (SvTRUE(TOPs))
RETURN;
else {
PP(pp_defined)
{
- dSP;
+ dVAR; dSP;
register SV* sv = NULL;
bool defined = FALSE;
const int op_type = PL_op->op_type;
PP(pp_add)
{
- dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN);
+ dVAR; dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN);
useleft = USE_LEFT(TOPm1s);
#ifdef PERL_PRESERVE_IVUV
/* We must see if we can perform the addition with integers if possible,
PP(pp_aelemfast)
{
- dSP;
+ dVAR; dSP;
AV * const av = PL_op->op_flags & OPf_SPECIAL ?
(AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv);
const U32 lval = PL_op->op_flags & OPf_MOD;
PP(pp_join)
{
- dSP; dMARK; dTARGET;
+ dVAR; dSP; dMARK; dTARGET;
MARK++;
do_join(TARG, *MARK, MARK, SP);
SP = MARK;
PP(pp_pushre)
{
- dSP;
+ dVAR; dSP;
#ifdef DEBUGGING
/*
* We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
PP(pp_rv2av)
{
- dSP; dTOPss;
+ dVAR; dSP; dTOPss;
AV *av;
if (SvROK(sv)) {
PP(pp_rv2hv)
{
- dSP; dTOPss;
+ dVAR; dSP; dTOPss;
HV *hv;
const I32 gimme = GIMME_V;
static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context";
STATIC void
S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
{
+ dVAR;
if (*relem) {
SV *tmpstr;
const HE *didstore;
PP(pp_qr)
{
- dSP;
+ dVAR; dSP;
register PMOP * const pm = cPMOP;
SV * const rv = sv_newmortal();
SV * const sv = newSVrv(rv, "Regexp");
PP(pp_match)
{
- dSP; dTARG;
+ dVAR; dSP; dTARG;
register PMOP *pm = cPMOP;
PMOP *dynpm = pm;
register const char *t;
PP(pp_helem)
{
- dSP;
+ dVAR; dSP;
HE* he;
SV **svp;
SV * const keysv = POPs;
PP(pp_iter)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
SV *sv, *oldsv;
AV* av;
PP(pp_subst)
{
- dSP; dTARG;
+ dVAR; dSP; dTARG;
register PMOP *pm = cPMOP;
PMOP *rpm = pm;
register SV *dstr;
STATIC CV *
S_get_db_sub(pTHX_ SV **svp, CV *cv)
{
+ dVAR;
SV * const dbsv = GvSVn(PL_DBsub);
save_item(dbsv);
PP(pp_aelem)
{
- dSP;
+ dVAR; dSP;
SV** svp;
SV* const elemsv = POPs;
IV elem = SvIV(elemsv);
PP(pp_method)
{
- dSP;
+ dVAR; dSP;
SV* const sv = TOPs;
if (SvROK(sv)) {
PP(pp_method_named)
{
- dSP;
+ dVAR; dSP;
SV* const sv = cSVOP_sv;
U32 hash = SvSHARED_HASH(sv);
STATIC SV *
S_method_common(pTHX_ SV* meth, U32* hashp)
{
+ dVAR;
SV* ob;
GV* gv;
HV* stash;
STATIC bool
next_uni_uu(pTHX_ const char **s, const char *end, I32 *out)
{
+ dVAR;
STRLEN retlen;
const UV val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen, UTF8_CHECK_ONLY);
if (val >= 0x100 || !ISUUCHAR(val) ||
PP(pp_unpack)
{
+ dVAR;
dSP;
dPOPPOPssrl;
I32 gimme = GIMME_V;
void
Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist )
{
+ dVAR;
STRLEN no_len;
tempsym_t sym;
SV **
S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
{
+ dVAR;
tempsym_t lookahead;
I32 items = endlist - beglist;
bool found = next_symbol(symptr);
PP(pp_pack)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
register SV *cat = TARG;
STRLEN fromlen;
SV *pat_sv = *++MARK;
static I32
cmp_desc(pTHX_ gptr a, gptr b)
{
+ dVAR;
return -PL_sort_RealCmp(aTHX_ a, b);
}
STATIC void
S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
{
+ dVAR;
IV i, run, offset;
I32 sense, level;
register gptr *f1, *f2, *t, *b, *p;
static I32
cmpindir(pTHX_ gptr a, gptr b)
{
+ dVAR;
gptr * const ap = (gptr *)a;
gptr * const bp = (gptr *)b;
const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
static I32
cmpindir_desc(pTHX_ gptr a, gptr b)
{
+ dVAR;
gptr * const ap = (gptr *)a;
gptr * const bp = (gptr *)b;
const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
STATIC void
S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
{
+ dVAR;
if ((flags & SORTf_STABLE) != 0) {
register gptr **pp, *q;
register size_t n, j, i;
static I32
S_amagic_ncmp(pTHX_ register SV *a, register SV *b)
{
+ dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp);
if (tmpsv) {
if (SvIOK(tmpsv)) {
static I32
S_amagic_i_ncmp(pTHX_ register SV *a, register SV *b)
{
+ dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp);
if (tmpsv) {
if (SvIOK(tmpsv)) {
static I32
S_amagic_cmp(pTHX_ register SV *str1, register SV *str2)
{
+ dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp);
if (tmpsv) {
if (SvIOK(tmpsv)) {
static I32
S_amagic_cmp_locale(pTHX_ register SV *str1, register SV *str2)
{
+ dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp);
if (tmpsv) {
if (SvIOK(tmpsv)) {
PP(pp_backtick)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
PerlIO *fp;
const char * const tmps = POPpconstx;
const I32 gimme = GIMME_V;
PP(pp_rcatline)
{
+ dVAR;
PL_last_in_gv = cGVOP_gv;
return do_readline();
}
PP(pp_warn)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
SV *tmpsv;
const char *tmps;
STRLEN len;
PP(pp_die)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
const char *tmps;
SV *tmpsv;
STRLEN len;
PP(pp_pipe_op)
{
#ifdef HAS_PIPE
+ dVAR;
dSP;
register IO *rstio;
register IO *wstio;
PP(pp_umask)
{
+ dVAR;
dSP;
#ifdef HAS_UMASK
dTARGET;
PP(pp_tied)
{
+ dVAR;
dSP;
const MAGIC *mg;
SV *sv = POPs;
PP(pp_sselect)
{
#ifdef HAS_SELECT
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
register I32 i;
register I32 j;
register char *s;
void
Perl_setdefout(pTHX_ GV *gv)
{
+ dVAR;
if (gv)
(void)SvREFCNT_inc(gv);
if (PL_defoutgv)
PP(pp_select)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
HV *hv;
GV * const newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL;
GV * egv = GvEGV(PL_defoutgv);
PP(pp_enterwrite)
{
+ dVAR;
dSP;
register GV *gv;
register IO *io;
PP(pp_sysopen)
{
+ dVAR;
dSP;
const int perm = (MAXARG > 3) ? POPi : 0666;
const int mode = POPi;
PP(pp_truncate)
{
+ dVAR;
dSP;
/* There seems to be no consensus on the length type of truncate()
* and ftruncate(), both off_t and size_t have supporters. In
PP(pp_ioctl)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
SV * const argsv = POPs;
const unsigned int func = POPu;
const int optype = PL_op->op_type;
PP(pp_flock)
{
#ifdef FLOCK
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
I32 value;
IO *io = NULL;
PerlIO *fp;
PP(pp_socket)
{
#ifdef HAS_SOCKET
- dSP;
+ dVAR; dSP;
const int protocol = POPi;
const int type = POPi;
const int domain = POPi;
PP(pp_sockpair)
{
#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET))
- dSP;
+ dVAR; dSP;
const int protocol = POPi;
const int type = POPi;
const int domain = POPi;
PP(pp_bind)
{
#ifdef HAS_SOCKET
- dSP;
+ dVAR; dSP;
#ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */
extern void GETPRIVMODE();
extern void GETUSERMODE();
PP(pp_connect)
{
#ifdef HAS_SOCKET
- dSP;
+ dVAR; dSP;
SV * const addrsv = POPs;
GV * const gv = (GV*)POPs;
register IO * const io = GvIOn(gv);
PP(pp_listen)
{
#ifdef HAS_SOCKET
- dSP;
+ dVAR; dSP;
const int backlog = POPi;
GV * const gv = (GV*)POPs;
register IO * const io = gv ? GvIOn(gv) : NULL;
PP(pp_accept)
{
#ifdef HAS_SOCKET
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
register IO *nstio;
register IO *gstio;
char namebuf[MAXPATHLEN];
PP(pp_shutdown)
{
#ifdef HAS_SOCKET
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
const int how = POPi;
GV * const gv = (GV*)POPs;
register IO * const io = GvIOn(gv);
PP(pp_ssockopt)
{
#ifdef HAS_SOCKET
- dSP;
+ dVAR; dSP;
const int optype = PL_op->op_type;
SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(NEWSV(22, 257)) : POPs;
const unsigned int optname = (unsigned int) POPi;
PP(pp_getpeername)
{
#ifdef HAS_SOCKET
- dSP;
+ dVAR; dSP;
const int optype = PL_op->op_type;
GV * const gv = (GV*)POPs;
register IO * const io = GvIOn(gv);
PP(pp_stat)
{
+ dVAR;
dSP;
GV *gv;
I32 gimme;
PP(pp_ftrread)
{
+ dVAR;
I32 result;
/* Not const, because things tweak this below. Not bool, because there's
no guarantee that OPp_FT_ACCESS is <= CHAR_MAX */
PP(pp_ftis)
{
+ dVAR;
I32 result;
const int op_type = PL_op->op_type;
dSP;
PP(pp_ftrowned)
{
+ dVAR;
I32 result;
dSP;
PP(pp_ftlink)
{
+ dVAR;
I32 result = my_lstat();
dSP;
if (result < 0)
PP(pp_fttty)
{
+ dVAR;
dSP;
int fd;
GV *gv;
PP(pp_fttext)
{
+ dVAR;
dSP;
I32 i;
I32 len;
PP(pp_chdir)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
const char *tmps = NULL;
GV *gv = NULL;
PP(pp_chown)
{
- dSP; dMARK; dTARGET;
+ dVAR; dSP; dMARK; dTARGET;
const I32 value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
PP(pp_chroot)
{
#ifdef HAS_CHROOT
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
char * const tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
PP(pp_rename)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
int anum;
const char * const tmps2 = POPpconstx;
const char * const tmps = SvPV_nolen_const(TOPs);
#if defined(HAS_LINK) || defined(HAS_SYMLINK)
PP(pp_link)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
const int op_type = PL_op->op_type;
int result;
PP(pp_readlink)
{
+ dVAR;
dSP;
#ifdef HAS_SYMLINK
dTARGET;
PP(pp_mkdir)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
STRLEN len;
const char *tmps;
bool copy = FALSE;
PP(pp_rmdir)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
STRLEN len;
const char *tmps;
bool copy = FALSE;
PP(pp_open_dir)
{
#if defined(Direntry_t) && defined(HAS_READDIR)
- dSP;
+ dVAR; dSP;
const char * const dirname = POPpconstx;
GV * const gv = (GV*)POPs;
register IO * const io = GvIOn(gv);
#if !defined(I_DIRENT) && !defined(VMS)
Direntry_t *readdir (DIR *);
#endif
+ dVAR;
dSP;
SV *sv;
PP(pp_seekdir)
{
#if defined(HAS_SEEKDIR) || defined(seekdir)
- dSP;
+ dVAR; dSP;
const long along = POPl;
GV * const gv = (GV*)POPs;
register IO * const io = GvIOn(gv);
PP(pp_rewinddir)
{
#if defined(HAS_REWINDDIR) || defined(rewinddir)
- dSP;
+ dVAR; dSP;
GV * const gv = (GV*)POPs;
register IO * const io = GvIOn(gv);
PP(pp_closedir)
{
#if defined(Direntry_t) && defined(HAS_READDIR)
- dSP;
+ dVAR; dSP;
GV * const gv = (GV*)POPs;
register IO * const io = GvIOn(gv);
PP(pp_fork)
{
#ifdef HAS_FORK
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
Pid_t childpid;
EXTEND(SP, 1);
PP(pp_wait)
{
#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
Pid_t childpid;
int argflags;
PP(pp_waitpid)
{
#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
const int optype = POPi;
const Pid_t pid = TOPi;
Pid_t result;
PP(pp_system)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
I32 value;
int result;
PP(pp_exec)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
I32 value;
if (PL_tainting) {
PP(pp_getppid)
{
#ifdef HAS_GETPPID
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
# ifdef THREADS_HAVE_PIDS
if (PL_ppid != 1 && getppid() == 1)
/* maybe the parent process has died. Refresh ppid cache */
PP(pp_getpgrp)
{
#ifdef HAS_GETPGRP
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
Pid_t pgrp;
const Pid_t pid = (MAXARG < 1) ? 0 : SvIVx(POPs);
PP(pp_setpgrp)
{
#ifdef HAS_SETPGRP
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
Pid_t pgrp;
Pid_t pid;
if (MAXARG < 2) {
PP(pp_getpriority)
{
#ifdef HAS_GETPRIORITY
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
const int who = POPi;
const int which = TOPi;
SETi( getpriority(which, who) );
PP(pp_setpriority)
{
#ifdef HAS_SETPRIORITY
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
const int niceval = POPi;
const int who = POPi;
const int which = TOPi;
PP(pp_time)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
#ifdef BIG_TIME
XPUSHn( time(Null(Time_t*)) );
#else
PP(pp_tms)
{
#ifdef HAS_TIMES
+ dVAR;
dSP;
EXTEND(SP, 4);
#ifndef VMS
PP(pp_gmtime)
{
+ dVAR;
dSP;
Time_t when;
const struct tm *tmbuf;
PP(pp_alarm)
{
#ifdef HAS_ALARM
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
int anum;
anum = POPi;
anum = alarm((unsigned int)anum);
PP(pp_sleep)
{
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
I32 duration;
Time_t lasttime;
Time_t when;
PP(pp_shmwrite)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ dVAR; dSP; dMARK; dTARGET;
const int op_type = PL_op->op_type;
I32 value;
PP(pp_semget)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ dVAR; dSP; dMARK; dTARGET;
const int anum = do_ipcget(PL_op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
PP(pp_semctl)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dSP; dMARK; dTARGET;
+ dVAR; dSP; dMARK; dTARGET;
const int anum = do_ipcctl(PL_op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
PP(pp_ghostent)
{
#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
- dSP;
+ dVAR; dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_gnetent)
{
#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
- dSP;
+ dVAR; dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_gprotoent)
{
#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
- dSP;
+ dVAR; dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_gservent)
{
#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
- dSP;
+ dVAR; dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_shostent)
{
#ifdef HAS_SETHOSTENT
- dSP;
+ dVAR; dSP;
PerlSock_sethostent(TOPi);
RETSETYES;
#else
PP(pp_snetent)
{
#ifdef HAS_SETNETENT
- dSP;
+ dVAR; dSP;
PerlSock_setnetent(TOPi);
RETSETYES;
#else
PP(pp_sprotoent)
{
#ifdef HAS_SETPROTOENT
- dSP;
+ dVAR; dSP;
PerlSock_setprotoent(TOPi);
RETSETYES;
#else
PP(pp_sservent)
{
#ifdef HAS_SETSERVENT
- dSP;
+ dVAR; dSP;
PerlSock_setservent(TOPi);
RETSETYES;
#else
PP(pp_ehostent)
{
#ifdef HAS_ENDHOSTENT
- dSP;
+ dVAR; dSP;
PerlSock_endhostent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_enetent)
{
#ifdef HAS_ENDNETENT
- dSP;
+ dVAR; dSP;
PerlSock_endnetent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_eprotoent)
{
#ifdef HAS_ENDPROTOENT
- dSP;
+ dVAR; dSP;
PerlSock_endprotoent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_eservent)
{
#ifdef HAS_ENDSERVENT
- dSP;
+ dVAR; dSP;
PerlSock_endservent();
EXTEND(SP,1);
RETPUSHYES;
PP(pp_gpwent)
{
#ifdef HAS_PASSWD
- dSP;
+ dVAR; dSP;
I32 which = PL_op->op_type;
register SV *sv;
struct passwd *pwent = NULL;
PP(pp_spwent)
{
#if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
- dSP;
+ dVAR; dSP;
setpwent();
RETPUSHYES;
#else
PP(pp_epwent)
{
#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
- dSP;
+ dVAR; dSP;
endpwent();
RETPUSHYES;
#else
PP(pp_ggrent)
{
#ifdef HAS_GROUP
- dSP;
+ dVAR; dSP;
I32 which = PL_op->op_type;
register char **elem;
register SV *sv;
PP(pp_sgrent)
{
#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
- dSP;
+ dVAR; dSP;
setgrent();
RETPUSHYES;
#else
PP(pp_egrent)
{
#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
- dSP;
+ dVAR; dSP;
endgrent();
RETPUSHYES;
#else
PP(pp_getlogin)
{
#ifdef HAS_GETLOGIN
- dSP; dTARGET;
+ dVAR; dSP; dTARGET;
char *tmps;
EXTEND(SP, 1);
if (!(tmps = PerlProc_getlogin()))
PP(pp_syscall)
{
#ifdef HAS_SYSCALL
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
register I32 items = SP - MARK;
unsigned long a[20];
register I32 i = 0;
/* deltap: Write maxlen-minlen here. */
/* last: Stop before this one. */
{
+ dVAR;
I32 min = 0, pars = 0, code;
regnode *scan = *scanp, *next;
I32 delta = 0;
void
Perl_reginitcolors(pTHX)
{
+ dVAR;
const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
if (s) {
char *t = savepv(s);
regexp *
Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
{
+ dVAR;
register regexp *r;
regnode *scan;
regnode *first;
STATIC regnode *
S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first)
{
+ dVAR;
register regnode *ret;
register regnode *chain = NULL;
register regnode *latest;
STATIC regnode *
S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
{
+ dVAR;
register regnode *ret;
register char op;
register char *next;
STATIC regnode *
S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
{
+ dVAR;
register regnode *ret = NULL;
I32 flags;
char *parse_start = RExC_parse;
STATIC I32
S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
{
+ dVAR;
I32 namedclass = OOB_NAMEDCLASS;
if (value == '[' && RExC_parse + 1 < RExC_end &&
STATIC void
S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
{
+ dVAR;
if (!SIZE_ONLY && POSIXCC(UCHARAT(RExC_parse))) {
const char *s = RExC_parse;
const char c = *s++;
STATIC regnode *
S_regclass(pTHX_ RExC_state_t *pRExC_state)
{
+ dVAR;
register UV value;
register UV nextvalue;
register IV prevvalue = OOB_UNICODE;
STATIC char*
S_nextchar(pTHX_ RExC_state_t *pRExC_state)
{
+ dVAR;
char* retval = RExC_parse++;
for (;;) {
STATIC regnode * /* Location. */
S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op)
{
+ dVAR;
register regnode *ptr;
regnode * const ret = RExC_emit;
STATIC regnode * /* Location. */
S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg)
{
+ dVAR;
register regnode *ptr;
regnode * const ret = RExC_emit;
STATIC void
S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp)
{
+ dVAR;
*lenp = SIZE_ONLY ? UNISKIP(uv) : (uvchr_to_utf8((U8*)s, uv) - (U8*)s);
}
STATIC void
S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd)
{
+ dVAR;
register regnode *src;
register regnode *dst;
register regnode *place;
STATIC void
S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val)
{
+ dVAR;
register regnode *scan;
if (SIZE_ONLY)
STATIC void
S_regoptail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val)
{
+ dVAR;
/* "Operandless" and "op != BRANCH" are synonymous in practice. */
if (p == NULL || SIZE_ONLY)
return;
Perl_regdump(pTHX_ regexp *r)
{
#ifdef DEBUGGING
+ dVAR;
SV * const sv = sv_newmortal();
(void)dumpuntil(r->program, r->program + 1, NULL, sv, 0);
Perl_regprop(pTHX_ SV *sv, const regnode *o)
{
#ifdef DEBUGGING
+ dVAR;
register int k;
sv_setpvn(sv, "", 0);
SV *
Perl_re_intuit_string(pTHX_ regexp *prog)
{ /* Assume that RE_INTUIT is set */
+ dVAR;
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_COMPILE_r(
{
regnode *
Perl_regnext(pTHX_ register regnode *p)
{
+ dVAR;
register I32 offset;
if (p == &PL_regdummy)
void
Perl_save_re_context(pTHX)
{
+ dVAR;
SAVEI32(PL_reg_flags); /* from regexec.c */
SAVEPPTR(PL_bostr);
SAVEPPTR(PL_reginput); /* String-input pointer. */
static void
clear_re(pTHX_ void *r)
{
+ dVAR;
ReREFCNT_dec((regexp *)r);
}
STATIC regnode *
S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
{
+ dVAR;
register U8 op = EXACT; /* Arbitrary non-END op. */
register regnode *next;
STATIC CHECKPOINT
S_regcppush(pTHX_ I32 parenfloor)
{
+ dVAR;
const int retval = PL_savestack_ix;
#define REGCP_PAREN_ELEMS 4
const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
STATIC char *
S_regcppop(pTHX)
{
+ dVAR;
I32 i;
U32 paren = 0;
char *input;
STATIC char *
S_regcp_set_to(pTHX_ I32 ss)
{
+ dVAR;
const I32 tmp = PL_savestack_ix;
PL_savestack_ix = ss;
STATIC void
S_cache_re(pTHX_ regexp *prog)
{
+ dVAR;
PL_regprecomp = prog->precomp; /* Needed for FAIL. */
#ifdef DEBUGGING
PL_regprogram = prog->program;
Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
char *strend, U32 flags, re_scream_pos_data *data)
{
+ dVAR;
register I32 start_shift = 0;
/* Should be nonnegative! */
register I32 end_shift = 0;
/* data: May be used for some additional optimizations. */
/* nosave: For optimizations. */
{
+ dVAR;
register char *s;
register regnode *c;
register char *startpos = stringarg;
STATIC I32 /* 0 failure, 1 success */
S_regtry(pTHX_ regexp *prog, char *startpos)
{
+ dVAR;
register I32 i;
register I32 *sp;
register I32 *ep;
STATIC I32
S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
{
+ dVAR;
register char *scan = Nullch;
register char *start;
register char *loceol = PL_regeol;
SV *
Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
{
+ dVAR;
SV *sw = NULL;
SV *si = NULL;
SV *alt = NULL;
STATIC U8 *
S_reghop(pTHX_ U8 *s, I32 off)
{
+ dVAR;
return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
}
STATIC U8 *
S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
{
+ dVAR;
if (off >= 0) {
while (off-- && s < lim) {
/* XXX could check well-formedness here */
STATIC U8 *
S_reghopmaybe(pTHX_ U8 *s, I32 off)
{
+ dVAR;
return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
}
STATIC U8 *
S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
{
+ dVAR;
if (off >= 0) {
while (off-- && s < lim) {
/* XXX could check well-formedness here */
static void
restore_pos(pTHX_ void *arg)
{
+ dVAR;
PERL_UNUSED_ARG(arg);
if (PL_reg_eval_set) {
if (PL_reg_oldsaved) {
STATIC void
S_to_byte_substr(pTHX_ register regexp *prog)
{
+ dVAR;
if (prog->float_utf8 && !prog->float_substr) {
SV* sv;
prog->float_substr = sv = newSVsv(prog->float_utf8);
int
Perl_runops_standard(pTHX)
{
+ dVAR;
while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
PERL_ASYNC_CHECK();
}
SV**
Perl_stack_grow(pTHX_ SV **sp, SV **p, int n)
{
+ dVAR;
PL_stack_sp = sp;
#ifndef STRESS_REALLOC
av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
PERL_SI *
Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
{
+ dVAR;
PERL_SI *si;
Newx(si, 1, PERL_SI);
si->si_stack = newAV();
I32
Perl_cxinc(pTHX)
{
+ dVAR;
const IV old_max = cxstack_max;
cxstack_max = GROW(cxstack_max);
Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */
void
Perl_push_scope(pTHX)
{
+ dVAR;
if (PL_scopestack_ix == PL_scopestack_max) {
PL_scopestack_max = GROW(PL_scopestack_max);
Renew(PL_scopestack, PL_scopestack_max, I32);
void
Perl_pop_scope(pTHX)
{
+ dVAR;
const I32 oldsave = PL_scopestack[--PL_scopestack_ix];
LEAVE_SCOPE(oldsave);
}
void
Perl_markstack_grow(pTHX)
{
+ dVAR;
const I32 oldmax = PL_markstack_max - PL_markstack;
const I32 newmax = GROW(oldmax);
void
Perl_savestack_grow(pTHX)
{
+ dVAR;
PL_savestack_max = GROW(PL_savestack_max) + 4;
Renew(PL_savestack, PL_savestack_max, ANY);
}
void
Perl_savestack_grow_cnt(pTHX_ I32 need)
{
+ dVAR;
PL_savestack_max = PL_savestack_ix + need;
Renew(PL_savestack, PL_savestack_max, ANY);
}
void
Perl_tmps_grow(pTHX_ I32 n)
{
+ dVAR;
#ifndef STRESS_REALLOC
if (n < 128)
n = (PL_tmps_max < 512) ? 128 : 512;
void
Perl_free_tmps(pTHX)
{
+ dVAR;
/* XXX should tmps_floor live in cxstack? */
const I32 myfloor = PL_tmps_floor;
while (PL_tmps_ix > myfloor) { /* clean up after last statement */
STATIC SV *
S_save_scalar_at(pTHX_ SV **sptr)
{
+ dVAR;
SV * const osv = *sptr;
register SV * const sv = *sptr = NEWSV(0,0);
SV *
Perl_save_scalar(pTHX_ GV *gv)
{
+ dVAR;
SV ** const sptr = &GvSV(gv);
PL_localizing = 1;
SvGETMAGIC(*sptr);
SV*
Perl_save_svref(pTHX_ SV **sptr)
{
+ dVAR;
SvGETMAGIC(*sptr);
SSCHECK(3);
SSPUSHPTR(sptr);
void
Perl_save_generic_svref(pTHX_ SV **sptr)
{
+ dVAR;
SSCHECK(3);
SSPUSHPTR(sptr);
SSPUSHPTR(SvREFCNT_inc(*sptr));
void
Perl_save_generic_pvref(pTHX_ char **str)
{
+ dVAR;
SSCHECK(3);
SSPUSHPTR(str);
SSPUSHPTR(*str);
void
Perl_save_shared_pvref(pTHX_ char **str)
{
+ dVAR;
SSCHECK(3);
SSPUSHPTR(str);
SSPUSHPTR(*str);
void
Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val)
{
+ dVAR;
SSCHECK(4);
SSPUSHPTR(sv);
SSPUSHINT(mask);
void
Perl_save_gp(pTHX_ GV *gv, I32 empty)
{
+ dVAR;
SSGROW(6);
SSPUSHIV((IV)SvLEN(gv));
SvLEN_set(gv, 0); /* forget that anything was allocated here */
AV *
Perl_save_ary(pTHX_ GV *gv)
{
+ dVAR;
AV * const oav = GvAVn(gv);
AV *av;
HV *
Perl_save_hash(pTHX_ GV *gv)
{
+ dVAR;
HV *ohv, *hv;
SSCHECK(3);
void
Perl_save_item(pTHX_ register SV *item)
{
+ dVAR;
register SV * const sv = newSVsv(item);
SSCHECK(3);
void
Perl_save_int(pTHX_ int *intp)
{
+ dVAR;
SSCHECK(3);
SSPUSHINT(*intp);
SSPUSHPTR(intp);
void
Perl_save_long(pTHX_ long int *longp)
{
+ dVAR;
SSCHECK(3);
SSPUSHLONG(*longp);
SSPUSHPTR(longp);
void
Perl_save_bool(pTHX_ bool *boolp)
{
+ dVAR;
SSCHECK(3);
SSPUSHBOOL(*boolp);
SSPUSHPTR(boolp);
void
Perl_save_I32(pTHX_ I32 *intp)
{
+ dVAR;
SSCHECK(3);
SSPUSHINT(*intp);
SSPUSHPTR(intp);
void
Perl_save_I16(pTHX_ I16 *intp)
{
+ dVAR;
SSCHECK(3);
SSPUSHINT(*intp);
SSPUSHPTR(intp);
void
Perl_save_I8(pTHX_ I8 *bytep)
{
+ dVAR;
SSCHECK(3);
SSPUSHINT(*bytep);
SSPUSHPTR(bytep);
void
Perl_save_iv(pTHX_ IV *ivp)
{
+ dVAR;
SSCHECK(3);
SSPUSHIV(*ivp);
SSPUSHPTR(ivp);
void
Perl_save_pptr(pTHX_ char **pptr)
{
+ dVAR;
SSCHECK(3);
SSPUSHPTR(*pptr);
SSPUSHPTR(pptr);
void
Perl_save_vptr(pTHX_ void *ptr)
{
+ dVAR;
SSCHECK(3);
SSPUSHPTR(*(char**)ptr);
SSPUSHPTR(ptr);
void
Perl_save_sptr(pTHX_ SV **sptr)
{
+ dVAR;
SSCHECK(3);
SSPUSHPTR(*sptr);
SSPUSHPTR(sptr);
void
Perl_save_padsv(pTHX_ PADOFFSET off)
{
+ dVAR;
SSCHECK(4);
ASSERT_CURPAD_ACTIVE("save_padsv");
SSPUSHPTR(PL_curpad[off]);
SV **
Perl_save_threadsv(pTHX_ PADOFFSET i)
{
+ dVAR;
Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl");
PERL_UNUSED_ARG(i);
NORETURN_FUNCTION_END;
void
Perl_save_nogv(pTHX_ GV *gv)
{
+ dVAR;
SSCHECK(2);
SSPUSHPTR(gv);
SSPUSHINT(SAVEt_NSTAB);
void
Perl_save_hptr(pTHX_ HV **hptr)
{
+ dVAR;
SSCHECK(3);
SSPUSHPTR(*hptr);
SSPUSHPTR(hptr);
void
Perl_save_aptr(pTHX_ AV **aptr)
{
+ dVAR;
SSCHECK(3);
SSPUSHPTR(*aptr);
SSPUSHPTR(aptr);
void
Perl_save_freesv(pTHX_ SV *sv)
{
+ dVAR;
SSCHECK(2);
SSPUSHPTR(sv);
SSPUSHINT(SAVEt_FREESV);
void
Perl_save_mortalizesv(pTHX_ SV *sv)
{
+ dVAR;
SSCHECK(2);
SSPUSHPTR(sv);
SSPUSHINT(SAVEt_MORTALIZESV);
void
Perl_save_freeop(pTHX_ OP *o)
{
+ dVAR;
SSCHECK(2);
SSPUSHPTR(o);
SSPUSHINT(SAVEt_FREEOP);
void
Perl_save_freepv(pTHX_ char *pv)
{
+ dVAR;
SSCHECK(2);
SSPUSHPTR(pv);
SSPUSHINT(SAVEt_FREEPV);
void
Perl_save_clearsv(pTHX_ SV **svp)
{
+ dVAR;
ASSERT_CURPAD_ACTIVE("save_clearsv");
SSCHECK(2);
SSPUSHLONG((long)(svp-PL_curpad));
void
Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
{
+ dVAR;
SSCHECK(4);
SSPUSHINT(klen);
SSPUSHPTR(key);
void
Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
{
+ dVAR;
register I32 i;
for (i = 1; i <= maxsarg; i++) {
void
Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
{
+ dVAR;
SSCHECK(3);
SSPUSHDPTR(f);
SSPUSHPTR(p);
void
Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
{
+ dVAR;
SSCHECK(3);
SSPUSHDXPTR(f);
SSPUSHPTR(p);
void
Perl_save_aelem(pTHX_ const AV *av, I32 idx, SV **sptr)
{
+ dVAR;
SV *sv;
SvGETMAGIC(*sptr);
SSCHECK(4);
void
Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr)
{
+ dVAR;
SV *sv;
SvGETMAGIC(*sptr);
SSCHECK(4);
void
Perl_save_op(pTHX)
{
+ dVAR;
SSCHECK(2);
SSPUSHPTR(PL_op);
SSPUSHINT(SAVEt_OP);
I32
Perl_save_alloc(pTHX_ I32 size, I32 pad)
{
+ dVAR;
register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
- (char*)PL_savestack);
register const I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
void
Perl_leave_scope(pTHX_ I32 base)
{
+ dVAR;
register SV *sv;
register SV *value;
register GV *gv;
void
Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
{
+ dVAR;
#ifdef DEBUGGING
PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
if (CxTYPE(cx) != CXt_SUBST) {
void
Perl_offer_nice_chunk(pTHX_ void *chunk, U32 chunk_size)
{
+ dVAR;
void *new_chunk;
U32 new_chunk_size;
LOCK_SV_MUTEX;
STATIC SV*
S_more_sv(pTHX)
{
+ dVAR;
SV* sv;
if (PL_nice_chunk) {
STATIC void
S_del_sv(pTHX_ SV *p)
{
+ dVAR;
if (DEBUG_D_TEST) {
SV* sva;
bool ok = 0;
void
Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
{
+ dVAR;
SV* const sva = (SV*)ptr;
register SV* sv;
register SV* svend;
STATIC I32
S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask)
{
+ dVAR;
SV* sva;
I32 visited = 0;
static void
do_clean_objs(pTHX_ SV *ref)
{
+ dVAR;
if (SvROK(ref)) {
SV * const target = SvRV(ref);
if (SvOBJECT(target)) {
static void
do_clean_named_objs(pTHX_ SV *sv)
{
+ dVAR;
if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
if ((
#ifdef PERL_DONT_CREATE_GVSV
void
Perl_sv_clean_objs(pTHX)
{
+ dVAR;
PL_in_clean_objs = TRUE;
visit(do_clean_objs, SVf_ROK, SVf_ROK);
#ifndef DISABLE_DESTRUCTOR_KLUDGE
static void
do_clean_all(pTHX_ SV *sv)
{
+ dVAR;
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
SvFLAGS(sv) |= SVf_BREAK;
if (PL_comppad == (AV*)sv) {
I32
Perl_sv_clean_all(pTHX)
{
+ dVAR;
I32 cleaned;
PL_in_clean_all = TRUE;
cleaned = visit(do_clean_all, 0,0);
void
Perl_sv_free_arenas(pTHX)
{
+ dVAR;
SV* sva;
SV* svanext;
int i;
STATIC void *
S_more_bodies (pTHX_ size_t size, svtype sv_type)
{
+ dVAR;
void ** const arena_root = &PL_body_arenaroots[sv_type];
void ** const root = &PL_body_roots[sv_type];
char *start;
STATIC void *
S_new_body(pTHX_ size_t size, svtype sv_type)
{
+ dVAR;
void *xpv;
new_body_inline(xpv, size, sv_type);
return xpv;
void
Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
{
+ dVAR;
void* old_body;
void* new_body;
const U32 old_type = SvTYPE(sv);
void
Perl_sv_setiv(pTHX_ register SV *sv, IV i)
{
+ dVAR;
SV_CHECK_THINKFIRST_COW_DROP(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
void
Perl_sv_setnv(pTHX_ register SV *sv, NV num)
{
+ dVAR;
SV_CHECK_THINKFIRST_COW_DROP(sv);
switch (SvTYPE(sv)) {
case SVt_NULL:
STATIC void
S_not_a_number(pTHX_ SV *sv)
{
+ dVAR;
SV *dsv;
char tmpbuf[64];
const char *pv;
STATIC int
S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype)
{
+ dVAR;
DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2iuv_non '%s', IV=0x%"UVxf" NV=%"NVgf" inttype=%"UVXf"\n", SvPVX_const(sv), SvIVX(sv), SvNVX(sv), (UV)numtype));
if (SvNVX(sv) < (NV)IV_MIN) {
(void)SvIOKp_on(sv);
STATIC bool
S_sv_2iuv_common(pTHX_ SV *sv) {
+ dVAR;
if (SvNOKp(sv)) {
/* erm. not sure. *should* never get NOKp (without NOK) from sv_2nv
* without also getting a cached IV/UV from it at the same time
IV
Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
{
+ dVAR;
if (!sv)
return 0;
if (SvGMAGICAL(sv)) {
UV
Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
{
+ dVAR;
if (!sv)
return 0;
if (SvGMAGICAL(sv)) {
NV
Perl_sv_2nv(pTHX_ register SV *sv)
{
+ dVAR;
if (!sv)
return 0.0;
if (SvGMAGICAL(sv)) {
static char *
S_stringify_regexp(pTHX_ SV *sv, MAGIC *mg, STRLEN *lp) {
+ dVAR;
const regexp * const re = (regexp *)mg->mg_obj;
if (!mg->mg_ptr) {
char *
Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
{
+ dVAR;
register char *s;
if (!sv) {
bool
Perl_sv_2bool(pTHX_ register SV *sv)
{
+ dVAR;
SvGETMAGIC(sv);
if (!SvOK(sv))
STRLEN
Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
{
+ dVAR;
if (sv == &PL_sv_undef)
return 0;
if (!SvPOK(sv)) {
bool
Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
{
+ dVAR;
if (SvPOKp(sv) && SvUTF8(sv)) {
if (SvCUR(sv)) {
U8 *s;
void
Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
{
+ dVAR;
register U32 sflags;
register int dtype;
register int stype;
void
Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
{
+ dVAR;
register char *dptr;
SV_CHECK_THINKFIRST_COW_DROP(sv);
void
Perl_sv_setpv(pTHX_ register SV *sv, register const char *ptr)
{
+ dVAR;
register STRLEN len;
SV_CHECK_THINKFIRST_COW_DROP(sv);
void
Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
{
+ dVAR;
STRLEN allocate;
SV_CHECK_THINKFIRST_COW_DROP(sv);
SvUPGRADE(sv, SVt_PV);
void
Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
{
+ dVAR;
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvREADONLY(sv)) {
/* At this point I believe I should acquire a global SV mutex. */
void
Perl_sv_catpvn_flags(pTHX_ register SV *dsv, register const char *sstr, register STRLEN slen, I32 flags)
{
+ dVAR;
STRLEN dlen;
const char * const dstr = SvPV_force_flags(dsv, dlen, flags);
void
Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags)
{
+ dVAR;
if (ssv) {
STRLEN slen;
const char *spv = SvPV_const(ssv, slen);
void
Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr)
{
+ dVAR;
register STRLEN len;
STRLEN tlen;
char *junk;
SV *
Perl_newSV(pTHX_ STRLEN len)
{
+ dVAR;
register SV *sv;
new_SV(sv);
Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
const char* name, I32 namlen)
{
+ dVAR;
MAGIC* mg;
if (SvTYPE(sv) < SVt_PVMG) {
void
Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
{
+ dVAR;
const MGVTBL *vtable;
MAGIC* mg;
void
Perl_sv_add_backref(pTHX_ SV *tsv, SV *sv)
{
+ dVAR;
AV *av;
if (SvTYPE(tsv) == SVt_PVHV) {
STATIC void
S_sv_del_backref(pTHX_ SV *tsv, SV *sv)
{
+ dVAR;
AV *av = NULL;
SV **svp;
I32 i;
void
Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, const char *little, STRLEN littlelen)
{
+ dVAR;
register char *big;
register char *mid;
register char *midend;
void
Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
{
+ dVAR;
const U32 refcnt = SvREFCNT(sv);
SV_CHECK_THINKFIRST_COW_DROP(sv);
if (SvREFCNT(nsv) != 1) {
I32
Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
{
+ dVAR;
const char *pv1;
STRLEN cur1;
const char *pv2;
I32
Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
{
+ dVAR;
STRLEN cur1, cur2;
const char *pv1, *pv2;
char *tpv = Nullch;
I32
Perl_sv_cmp_locale(pTHX_ register SV *sv1, register SV *sv2)
{
+ dVAR;
#ifdef USE_LOCALE_COLLATE
char *pv1, *pv2;
char *
Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp)
{
+ dVAR;
MAGIC *mg;
mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_collxfrm) : (MAGIC *) NULL;
char *
Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
{
+ dVAR;
const char *rsptr;
STRLEN rslen;
register STDCHAR rslast;
void
Perl_sv_inc(pTHX_ register SV *sv)
{
+ dVAR;
register char *d;
int flags;
void
Perl_sv_dec(pTHX_ register SV *sv)
{
+ dVAR;
int flags;
if (!sv)
SV *
Perl_sv_mortalcopy(pTHX_ SV *oldstr)
{
+ dVAR;
register SV *sv;
new_SV(sv);
SV *
Perl_sv_newmortal(pTHX)
{
+ dVAR;
register SV *sv;
new_SV(sv);
SV *
Perl_newSVpv(pTHX_ const char *s, STRLEN len)
{
+ dVAR;
register SV *sv;
new_SV(sv);
SV *
Perl_newSVpvn(pTHX_ const char *s, STRLEN len)
{
+ dVAR;
register SV *sv;
new_SV(sv);
SV *
Perl_newSVhek(pTHX_ const HEK *hek)
{
+ dVAR;
if (!hek) {
SV *sv;
SV *
Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
{
+ dVAR;
register SV *sv;
bool is_utf8 = FALSE;
if (len < 0) {
SV *
Perl_vnewSVpvf(pTHX_ const char* pat, va_list* args)
{
+ dVAR;
register SV *sv;
new_SV(sv);
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
SV *
Perl_newSVnv(pTHX_ NV n)
{
+ dVAR;
register SV *sv;
new_SV(sv);
SV *
Perl_newSViv(pTHX_ IV i)
{
+ dVAR;
register SV *sv;
new_SV(sv);
SV *
Perl_newSVuv(pTHX_ UV u)
{
+ dVAR;
register SV *sv;
new_SV(sv);
SV *
Perl_newRV_noinc(pTHX_ SV *tmpRef)
{
+ dVAR;
register SV *sv;
new_SV(sv);
SV *
Perl_newRV(pTHX_ SV *tmpRef)
{
+ dVAR;
return newRV_noinc(SvREFCNT_inc(tmpRef));
}
SV *
Perl_newSVsv(pTHX_ register SV *old)
{
+ dVAR;
register SV *sv;
if (!old)
char *
Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
{
-
+ dVAR;
if (SvTHINKFIRST(sv) && !SvROK(sv))
sv_force_normal_flags(sv, 0);
SV*
Perl_newSVrv(pTHX_ SV *rv, const char *classname)
{
+ dVAR;
SV *sv;
new_SV(sv);
SV*
Perl_sv_setref_pv(pTHX_ SV *rv, const char *classname, void *pv)
{
+ dVAR;
if (!pv) {
sv_setsv(rv, &PL_sv_undef);
SvSETMAGIC(rv);
SV*
Perl_sv_bless(pTHX_ SV *sv, HV *stash)
{
+ dVAR;
SV *tmpRef;
if (!SvROK(sv))
Perl_croak(aTHX_ "Can't bless non-reference value");
STATIC void
S_sv_unglob(pTHX_ SV *sv)
{
+ dVAR;
void *xpvmg;
assert(SvTYPE(sv) == SVt_PVGV);
STATIC I32
S_expect_number(pTHX_ char** pattern)
{
+ dVAR;
I32 var = 0;
switch (**pattern) {
case '1': case '2': case '3':
void
Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted)
{
+ dVAR;
char *p;
char *q;
const char *patend;
STATIC I32
S_find_array_subscript(pTHX_ AV *av, SV* val)
{
+ dVAR;
SV** svp;
I32 i;
if (!av || SvMAGICAL(av) || !AvARRAY(av) ||
void
Perl_report_uninit(pTHX_ SV* uninit_sv)
{
+ dVAR;
if (PL_op) {
SV* varname = Nullsv;
if (uninit_sv) {
Perl_taint_proper(pTHX_ const char *f, const char *s)
{
#if defined(HAS_SETEUID) && defined(DEBUGGING)
+ dVAR;
# if Uid_t_size == 1
{
const UV uid = PL_uid;
void
Perl_taint_env(pTHX)
{
+ dVAR;
SV** svp;
MAGIC* mg;
const char* const *e;
STATIC int
S_tokereport(pTHX_ I32 rv)
{
+ dVAR;
if (DEBUG_T_TEST) {
const char *name = Nullch;
enum token_type type = TOKENTYPE_NONE;
STATIC int
S_ao(pTHX_ int toketype)
{
+ dVAR;
if (*PL_bufptr == '=') {
PL_bufptr++;
if (toketype == ANDAND)
STATIC void
S_no_op(pTHX_ const char *what, char *s)
{
+ dVAR;
char * const oldbp = PL_bufptr;
const bool is_first = (PL_oldbufptr == PL_linestart);
STATIC void
S_missingterm(pTHX_ char *s)
{
+ dVAR;
char tmpbuf[3];
char q;
if (s) {
STATIC bool
S_feature_is_enabled(pTHX_ char *name, STRLEN namelen)
{
+ dVAR;
HV * const hinthv = GvHV(PL_hintgv);
char he_name[32] = "feature_";
(void) strncpy(&he_name[8], name, 24);
void
Perl_lex_start(pTHX_ SV *line)
{
+ dVAR;
const char *s;
STRLEN len;
void
Perl_lex_end(pTHX)
{
+ dVAR;
PL_doextract = FALSE;
}
STATIC void
S_incline(pTHX_ char *s)
{
+ dVAR;
char *t;
char *n;
char *e;
STATIC char *
S_skipspace(pTHX_ register char *s)
{
+ dVAR;
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
while (s < PL_bufend && SPACE_OR_TAB(*s))
s++;
STATIC void
S_check_uni(pTHX)
{
+ dVAR;
char *s;
char *t;
STATIC I32
S_lop(pTHX_ I32 f, int x, char *s)
{
+ dVAR;
yylval.ival = f;
CLINE;
PL_expect = x;
STATIC void
S_force_next(pTHX_ I32 type)
{
+ dVAR;
PL_nexttype[PL_nexttoke] = type;
PL_nexttoke++;
if (PL_lex_state != LEX_KNOWNEXT) {
STATIC SV *
S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
{
+ dVAR;
SV * const sv = newSVpvn(start,len);
if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len))
SvUTF8_on(sv);
STATIC char *
S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
{
+ dVAR;
register char *s;
STRLEN len;
STATIC void
S_force_ident(pTHX_ register const char *s, int kind)
{
+ dVAR;
if (s && *s) {
OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
PL_nextval[PL_nexttoke].opval = o;
STATIC char *
S_force_version(pTHX_ char *s, int guessing)
{
+ dVAR;
OP *version = Nullop;
char *d;
STATIC SV *
S_tokeq(pTHX_ SV *sv)
{
+ dVAR;
register char *s;
register char *send;
register char *d;
STATIC I32
S_sublex_start(pTHX)
{
+ dVAR;
register const I32 op_type = yylval.ival;
if (op_type == OP_NULL) {
STATIC char *
S_scan_const(pTHX_ char *start)
{
+ dVAR;
register char *send = PL_bufend; /* end of the constant */
SV *sv = NEWSV(93, send - start); /* sv for the constant */
register char *s = start; /* start of the constant */
STATIC int
S_intuit_more(pTHX_ register char *s)
{
+ dVAR;
if (PL_lex_brackets)
return TRUE;
if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
STATIC int
S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
{
+ dVAR;
char *s = start + (*start == '$');
char tmpbuf[sizeof PL_tokenbuf];
STRLEN len;
STATIC const char*
S_incl_perldb(pTHX)
{
+ dVAR;
if (PL_perldb) {
const char * const pdb = PerlEnv_getenv("PERL5DB");
SV *
Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
{
+ dVAR;
if (!funcp)
return Nullsv;
void
Perl_filter_del(pTHX_ filter_t funcp)
{
+ dVAR;
SV *datasv;
#ifdef DEBUGGING
I32
Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
{
+ dVAR;
filter_t funcp;
SV *datasv = NULL;
STATIC char *
S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append)
{
+ dVAR;
#ifdef PERL_CR_FILTER
if (!PL_rsfp_filters) {
filter_add(S_cr_textfilter,NULL);
STATIC HV *
S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
{
+ dVAR;
GV *gv;
if (len == 11 && *pkgname == '_' && strEQ(pkgname, "__PACKAGE__"))
STATIC char *
S_tokenize_use(pTHX_ int is_use, char *s) {
+ dVAR;
if (PL_expect != XSTATE)
yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression",
is_use ? "use" : "no"));
int
Perl_yylex(pTHX)
{
+ dVAR;
register char *s = PL_bufptr;
register char *d;
STRLEN len;
static int
S_pending_ident(pTHX)
{
+ dVAR;
register char *d;
register I32 tmp = 0;
/* pit holds the identifier we read and pending_ident is reset */
I32
Perl_keyword (pTHX_ const char *name, I32 len)
{
+ dVAR;
switch (len)
{
case 1: /* 5 tokens of length 1 */
STATIC void
S_checkcomma(pTHX_ register char *s, const char *name, const char *what)
{
+ dVAR;
const char *w;
if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
STATIC char *
S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
{
+ dVAR;
register char *d = dest;
register char * const e = d + destlen - 3; /* two-character token, ending NUL */
for (;;) {
STATIC char *
S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRLEN destlen, I32 ck_uni)
{
+ dVAR;
register char *d;
register char *e;
char *bracket = Nullch;
STATIC char *
S_scan_pat(pTHX_ char *start, I32 type)
{
+ dVAR;
PMOP *pm;
char *s = scan_str(start,FALSE,FALSE);
STATIC char *
S_scan_trans(pTHX_ char *start)
{
+ dVAR;
register char* s;
OP *o;
short *tbl;
STATIC char *
S_scan_heredoc(pTHX_ register char *s)
{
+ dVAR;
SV *herewas;
I32 op_type = OP_SCALAR;
I32 len;
STATIC char *
S_scan_inputsymbol(pTHX_ char *start)
{
+ dVAR;
register char *s = start; /* current position in buffer */
register char *d;
const char *e;
STATIC char *
S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
{
+ dVAR;
SV *sv; /* scalar value: string */
char *tmps; /* temp string, used for delimiter matching */
register char *s = start; /* current position in the buffer */
char *
Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
{
+ dVAR;
register const char *s = start; /* current position in buffer */
register char *d; /* destination in temp buffer */
register char *e; /* end of temp buffer */
STATIC char *
S_scan_formline(pTHX_ register char *s)
{
+ dVAR;
register char *eol;
register char *t;
SV *stuff = newSVpvs("");
S_set_csh(pTHX)
{
#ifdef CSH
+ dVAR;
if (!PL_cshlen)
PL_cshlen = strlen(PL_cshname);
#endif
I32
Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
{
+ dVAR;
const I32 oldsavestack_ix = PL_savestack_ix;
CV* outsidecv = PL_compcv;
int
Perl_yywarn(pTHX_ const char *s)
{
+ dVAR;
PL_in_eval |= EVAL_WARNONLY;
yyerror(s);
PL_in_eval &= ~EVAL_WARNONLY;
int
Perl_yyerror(pTHX_ const char *s)
{
+ dVAR;
const char *where = NULL;
const char *context = NULL;
int contlen = -1;
STATIC char*
S_swallow_bom(pTHX_ U8 *s)
{
+ dVAR;
const STRLEN slen = SvCUR(PL_linestr);
switch (s[0]) {
case 0xFF:
static void
restore_rsfp(pTHX_ void *f)
{
+ dVAR;
PerlIO * const fp = (PerlIO*)f;
if (PL_rsfp == PerlIO_stdin())
static I32
utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
+ dVAR;
const STRLEN old = SvCUR(sv);
const I32 count = FILTER_READ(idx+1, sv, maxlen);
DEBUG_P(PerlIO_printf(Perl_debug_log,
static I32
utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
+ dVAR;
const STRLEN old = SvCUR(sv);
const I32 count = FILTER_READ(idx+1, sv, maxlen);
DEBUG_P(PerlIO_printf(Perl_debug_log,
char *
Perl_scan_vstring(pTHX_ const char *s, SV *sv)
{
+ dVAR;
const char *pos = s;
const char *start = s;
if (*pos == 'v') pos++; /* get past 'v' */
S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
int len, int level)
{
+ dVAR;
AV* av;
GV* gv;
GV** gvp;
bool
Perl_sv_derived_from(pTHX_ SV *sv, const char *name)
{
+ dVAR;
HV *stash;
SvGETMAGIC(sv);
void
Perl_boot_core_UNIVERSAL(pTHX)
{
+ dVAR;
const char file[] = __FILE__;
newXS("UNIVERSAL::isa", XS_UNIVERSAL_isa, file);
XS(XS_UNIVERSAL_isa)
{
+ dVAR;
dXSARGS;
if (items != 2)
XS(XS_UNIVERSAL_can)
{
+ dVAR;
dXSARGS;
SV *sv;
const char *name;
XS(XS_UNIVERSAL_VERSION)
{
+ dVAR;
dXSARGS;
HV *pkg;
GV **gvp;
XS(XS_version_new)
{
+ dVAR;
dXSARGS;
if (items > 3)
Perl_croak(aTHX_ "Usage: version::new(class, version)");
XS(XS_version_stringify)
{
+ dVAR;
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)");
XS(XS_version_numify)
{
+ dVAR;
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)");
XS(XS_version_normal)
{
+ dVAR;
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::normal(lobj, ...)");
XS(XS_version_vcmp)
{
+ dVAR;
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)");
XS(XS_version_boolean)
{
- dXSARGS;
- if (items < 1)
- Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)");
- SP -= items;
+ dVAR;
+ dXSARGS;
+ if (items < 1)
+ Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)");
+ SP -= items;
if (sv_derived_from(ST(0), "version")) {
SV * const lobj = SvRV(ST(0));
SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
XS(XS_version_noop)
{
+ dVAR;
dXSARGS;
if (items < 1)
Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)");
XS(XS_version_is_alpha)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: version::is_alpha(lobj)");
XS(XS_version_qv)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: version::qv(ver)");
XS(XS_utf8_is_utf8)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)");
XS(XS_utf8_valid)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::valid(sv)");
XS(XS_utf8_encode)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::encode(sv)");
XS(XS_utf8_decode)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::decode(sv)");
XS(XS_utf8_upgrade)
{
+ dVAR;
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)");
XS(XS_utf8_downgrade)
{
+ dVAR;
dXSARGS;
if (items < 1 || items > 2)
Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)");
XS(XS_utf8_native_to_unicode)
{
+ dVAR;
dXSARGS;
const UV uv = SvUV(ST(0));
XS(XS_utf8_unicode_to_native)
{
+ dVAR;
dXSARGS;
const UV uv = SvUV(ST(0));
XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
{
+ dVAR;
dXSARGS;
SV * const sv = SvRV(ST(0));
XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
{
+ dVAR;
dXSARGS;
SV * const sv = SvRV(ST(0));
XS(XS_Internals_hv_clear_placehold)
{
+ dVAR;
dXSARGS;
if (items != 1)
XS(XS_PerlIO_get_layers)
{
+ dVAR;
dXSARGS;
if (items < 1 || items % 2 == 0)
Perl_croak(aTHX_ "Usage: PerlIO_get_layers(filehandle[,args])");
XS(XS_Internals_hash_seed)
{
+ dVAR;
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;
XS(XS_Internals_rehash_seed)
{
+ dVAR;
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;
XS(XS_Internals_HvREHASH) /* Subject to change */
{
+ dVAR;
dXSARGS;
if (SvROK(ST(0))) {
const HV * const hv = (HV *) SvRV(ST(0));
XS(XS_Internals_inc_sub_generation)
{
+ dVAR;
/* Using dXSARGS would also have dITEM and dSP,
* which define 2 unused local variables. */
dAXMARK;
UV
Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
{
+ dVAR;
const U8 *s0 = s;
UV uv = *s, ouv = 0;
STRLEN len = 1;
STRLEN
Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
{
+ dVAR;
STRLEN len = 0;
/* Note: cannot use UTF8_IS_...() too eagerly here since e.g.
IV
Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b)
{
+ dVAR;
IV off = 0;
/* Note: cannot use UTF8_IS_...() too eagerly here since e.g.
S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,
const char *const swashname)
{
+ dVAR;
if (!is_utf8_char(p))
return FALSE;
if (!*swash)
bool
Perl_is_utf8_alnum(pTHX_ const U8 *p)
{
+ dVAR;
/* NOTE: "IsWord", not "IsAlnum", since Alnum is a true
* descendant of isalnum(3), in other words, it doesn't
* contain the '_'. --jhi */
bool
Perl_is_utf8_alnumc(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_alnumc, "IsAlnumC");
}
bool
Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */
{
+ dVAR;
if (*p == '_')
return TRUE;
/* is_utf8_idstart would be more logical. */
bool
Perl_is_utf8_idcont(pTHX_ const U8 *p)
{
+ dVAR;
if (*p == '_')
return TRUE;
return S_is_utf8_common(aTHX_ p, &PL_utf8_idcont, "IdContinue");
bool
Perl_is_utf8_alpha(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_alpha, "IsAlpha");
}
bool
Perl_is_utf8_ascii(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_ascii, "IsAscii");
}
bool
Perl_is_utf8_space(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_space, "IsSpacePerl");
}
bool
Perl_is_utf8_digit(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_digit, "IsDigit");
}
bool
Perl_is_utf8_upper(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_upper, "IsUppercase");
}
bool
Perl_is_utf8_lower(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_lower, "IsLowercase");
}
bool
Perl_is_utf8_cntrl(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_cntrl, "IsCntrl");
}
bool
Perl_is_utf8_graph(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_graph, "IsGraph");
}
bool
Perl_is_utf8_print(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_print, "IsPrint");
}
bool
Perl_is_utf8_punct(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_punct, "IsPunct");
}
bool
Perl_is_utf8_xdigit(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_xdigit, "Isxdigit");
}
bool
Perl_is_utf8_mark(pTHX_ const U8 *p)
{
+ dVAR;
return S_is_utf8_common(aTHX_ p, &PL_utf8_mark, "IsM");
}
Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
SV **swashp, const char *normal, const char *special)
{
+ dVAR;
U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
STRLEN len = 0;
UV
Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
{
+ dVAR;
return Perl_to_utf8_case(aTHX_ p, ustrp, lenp,
&PL_utf8_toupper, "ToUpper", "utf8::ToSpecUpper");
}
UV
Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
{
+ dVAR;
return Perl_to_utf8_case(aTHX_ p, ustrp, lenp,
&PL_utf8_totitle, "ToTitle", "utf8::ToSpecTitle");
}
UV
Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
{
+ dVAR;
return Perl_to_utf8_case(aTHX_ p, ustrp, lenp,
&PL_utf8_tolower, "ToLower", "utf8::ToSpecLower");
}
UV
Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
{
+ dVAR;
return Perl_to_utf8_case(aTHX_ p, ustrp, lenp,
&PL_utf8_tofold, "ToFold", "utf8::ToSpecFold");
}
I32
Perl_ibcmp_utf8(pTHX_ const char *s1, char **pe1, register UV l1, bool u1, const char *s2, char **pe2, register UV l2, bool u2)
{
+ dVAR;
register const U8 *p1 = (const U8*)s1;
register const U8 *p2 = (const U8*)s2;
register const U8 *f1 = NULL;
static char *
S_write_no_mem(pTHX)
{
+ dVAR;
/* Can't use PerlIO to write as it allocates memory */
PerlLIO_write(PerlIO_fileno(Perl_error_log),
PL_no_mem, strlen(PL_no_mem));
Free_t
Perl_safesysfree(Malloc_t where)
{
- dVAR;
#if defined(PERL_IMPLICIT_SYS) || defined(PERL_TRACK_MEMPOOL)
dTHX;
+#else
+ dVAR;
#endif
DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++));
if (where) {
void
Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
{
+ dVAR;
register const U8 *s;
register U32 i;
STRLEN len;
char *
Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last)
{
+ dVAR;
register const unsigned char *big;
register I32 pos;
register I32 previous;
STATIC SV *
S_mess_alloc(pTHX)
{
+ dVAR;
SV *sv;
XPVMG *any;
STATIC COP*
S_closest_cop(pTHX_ COP *cop, const OP *o)
{
+ dVAR;
/* Look for PL_op starting from o. cop is the last COP we've seen. */
if (!o || o == PL_op)
SV *
Perl_vmess(pTHX_ const char *pat, va_list *args)
{
+ dVAR;
SV * const sv = mess_alloc();
static const char dgd[] = " during global destruction.\n";
STATIC void
S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8)
{
+ dVAR;
HV *stash;
GV *gv;
CV *cv;
OP *
Perl_vdie(pTHX_ const char* pat, va_list *args)
{
+ dVAR;
const char *message;
const int was_in_eval = PL_in_eval;
STRLEN msglen;
void
Perl_vcroak(pTHX_ const char* pat, va_list *args)
{
+ dVAR;
const char *message;
STRLEN msglen;
I32 utf8 = 0;
bool
Perl_ckwarn(pTHX_ U32 w)
{
+ dVAR;
return
(
isLEXWARN_on
bool
Perl_ckwarn_d(pTHX_ U32 w)
{
+ dVAR;
return
isLEXWARN_off
|| PL_curcop->cop_warnings == pWARN_ALL
Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
{
#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) && !defined(NETWARE)
+ dVAR;
int p[2];
register I32 This, that;
register Pid_t pid;
PerlIO *
Perl_my_popen(pTHX_ const char *cmd, const char *mode)
{
+ dVAR;
int p[2];
register I32 This, that;
register Pid_t pid;
I32
Perl_my_pclose(pTHX_ PerlIO *ptr)
{
+ dVAR;
Sigsave_t hstat, istat, qstat;
int status;
SV **svp;
I32
Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
{
+ dVAR;
I32 result = 0;
if (!pid)
return -1;
Perl_find_script(pTHX_ const char *scriptname, bool dosearch,
const char *const *const search_ext, I32 flags)
{
+ dVAR;
const char *xfound = Nullch;
char *xfailed = Nullch;
char tmpbuf[MAXPATHLEN];
Perl_getcwd_sv(pTHX_ register SV *sv)
{
#ifndef PERL_MICRO
-
+ dVAR;
#ifndef INCOMPLETE_TAINTS
SvTAINTED_on(sv);
#endif
SV *
Perl_new_version(pTHX_ SV *ver)
{
+ dVAR;
SV * const rv = newSV(0);
if ( sv_derived_from(ver,"version") ) /* can just copy directly */
{
U32
Perl_seed(pTHX)
{
+ dVAR;
/*
* This is really just a quick hack which grabs various garbage
* values. It really should be a real hash algorithm which
UV
Perl_get_hash_seed(pTHX)
{
+ dVAR;
const char *s = PerlEnv_getenv("PERL_HASH_SEED");
UV myseed = 0;
void *
Perl_my_cxt_init(pTHX_ int *index, size_t size)
{
+ dVAR;
void *p;
if (*index == -1) {
/* this module hasn't been allocated an index yet */
static int
modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs)
{
+ dVAR;
SV *attr;
int nret;
XS(XS_attributes_bootstrap)
{
+ dVAR;
dXSARGS;
const char file[] = __FILE__;
XS(XS_attributes__modify_attrs)
{
+ dVAR;
dXSARGS;
SV *rv, *sv;
XS(XS_attributes__fetch_attrs)
{
+ dVAR;
dXSARGS;
SV *rv, *sv;
cv_flags_t cvflags;
XS(XS_attributes__guess_stash)
{
+ dVAR;
dXSARGS;
SV *rv, *sv;
dXSTARG;
XS(XS_attributes_reftype)
{
+ dVAR;
dXSARGS;
SV *rv, *sv;
dXSTARG;
XS(XS_attributes__warn_reserved)
{
+ dVAR;
dXSARGS;
if (items != 0) {
projects / p5sagit/p5-mst-13.2.git / commitdiff