void
Perl_av_reify(pTHX_ AV *av)
{
- dVAR;
SSize_t key;
PERL_ARGS_ASSERT_AV_REIFY;
void
Perl_av_extend(pTHX_ AV *av, SSize_t key)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_AV_EXTEND;
Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
SV ***arrayp)
{
- dVAR;
-
PERL_ARGS_ASSERT_AV_EXTEND_GUTS;
if (key > *maxp) {
SV**
Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
{
- dVAR;
-
PERL_ARGS_ASSERT_AV_FETCH;
assert(SvTYPE(av) == SVt_PVAV);
SV**
Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
{
- dVAR;
SV** ary;
PERL_ARGS_ASSERT_AV_STORE;
void
Perl_av_clear(pTHX_ AV *av)
{
- dVAR;
SSize_t extra;
bool real;
void
Perl_av_push(pTHX_ AV *av, SV *val)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_AV_PUSH;
SV *
Perl_av_pop(pTHX_ AV *av)
{
- dVAR;
SV *retval;
MAGIC* mg;
void
Perl_av_unshift(pTHX_ AV *av, SSize_t num)
{
- dVAR;
SSize_t i;
MAGIC* mg;
SV *
Perl_av_shift(pTHX_ AV *av)
{
- dVAR;
SV *retval;
MAGIC* mg;
void
Perl_av_fill(pTHX_ AV *av, SSize_t fill)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_AV_FILL;
SV *
Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags)
{
- dVAR;
SV *sv;
PERL_ARGS_ASSERT_AV_DELETE;
bool
Perl_av_exists(pTHX_ AV *av, SSize_t key)
{
- dVAR;
PERL_ARGS_ASSERT_AV_EXISTS;
assert(SvTYPE(av) == SVt_PVAV);
static MAGIC *
S_get_aux_mg(pTHX_ AV *av) {
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_GET_AUX_MG;
void
Perl_set_caret_X(pTHX) {
- dVAR;
GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */
if (tmpgv) {
SV *const caret_x = GvSV(tmpgv);
Perl_debstack(pTHX)
{
#ifndef SKIP_DEBUGGING
- dVAR;
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return 0;
S_openn_setup(pTHX_ GV *gv, char *mode, PerlIO **saveifp, PerlIO **saveofp,
int *savefd, char *savetype)
{
- dVAR;
IO * const io = GvIOn(gv);
PERL_ARGS_ASSERT_OPENN_SETUP;
Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN len,
int rawmode, int rawperm)
{
- dVAR;
PerlIO *saveifp;
PerlIO *saveofp;
int savefd;
Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
PerlIO *supplied_fp, SV **svp, U32 num_svs)
{
- dVAR;
PerlIO *saveifp;
PerlIO *saveofp;
int savefd;
PerlIO *
Perl_nextargv(pTHX_ GV *gv)
{
- dVAR;
IO * const io = GvIOp(gv);
PERL_ARGS_ASSERT_NEXTARGV;
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;
PERL_ARGS_ASSERT_IO_CLOSE;
bool
Perl_do_eof(pTHX_ GV *gv)
{
- dVAR;
IO * const io = GvIO(gv);
PERL_ARGS_ASSERT_DO_EOF;
Off_t
Perl_do_tell(pTHX_ GV *gv)
{
- dVAR;
IO *const io = GvIO(gv);
PerlIO *fp;
bool
Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
{
- dVAR;
IO *const io = GvIO(gv);
PerlIO *fp;
Off_t
Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
{
- dVAR;
IO *const io = GvIO(gv);
PerlIO *fp;
bool
Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
{
- dVAR;
-
PERL_ARGS_ASSERT_DO_PRINT;
/* assuming fp is checked earlier */
I32
Perl_my_stat_flags(pTHX_ const U32 flags)
{
- dVAR;
dSP;
IO *io;
GV* gv;
I32
Perl_my_lstat_flags(pTHX_ const U32 flags)
{
- dVAR;
static const char* const no_prev_lstat = "The stat preceding -l _ wasn't an lstat";
dSP;
const char *file;
void
Perl_do_execfree(pTHX)
{
- dVAR;
Safefree(PL_Argv);
PL_Argv = NULL;
Safefree(PL_Cmd);
I32
Perl_apply(pTHX_ I32 type, SV **mark, SV **sp)
{
- dVAR;
I32 val;
I32 tot = 0;
const char *const what = PL_op_name[type];
* is in the list of groups returned from getgroups().
*/
{
- dVAR;
-
PERL_ARGS_ASSERT_CANDO;
PERL_UNUSED_CONTEXT;
static bool
S_ingroup(pTHX_ Gid_t testgid, bool effective)
{
- dVAR;
#ifndef PERL_IMPLICIT_SYS
/* PERL_IMPLICIT_SYS like Win32: getegid() etc. require the context. */
PERL_UNUSED_CONTEXT;
I32
Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
{
- dVAR;
const key_t key = (key_t)SvNVx(*++mark);
SV *nsv = optype == OP_MSGGET ? NULL : *++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);
PerlIO *
Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
{
- dVAR;
SV * const tmpcmd = newSV(0);
PerlIO *fp;
STRLEN len;
STATIC I32
S_do_trans_simple(pTHX_ SV * const sv)
{
- dVAR;
I32 matches = 0;
STRLEN len;
U8 *s = (U8*)SvPV_nomg(sv,len);
STATIC I32
S_do_trans_count(pTHX_ SV * const sv)
{
- dVAR;
STRLEN len;
const U8 *s = (const U8*)SvPV_nomg_const(sv, len);
const U8 * const send = s + len;
STATIC I32
S_do_trans_complex(pTHX_ SV * const sv)
{
- dVAR;
STRLEN len;
U8 *s = (U8*)SvPV_nomg(sv, len);
U8 * const send = s+len;
STATIC I32
S_do_trans_simple_utf8(pTHX_ SV * const sv)
{
- dVAR;
U8 *s;
U8 *send;
U8 *d;
STATIC I32
S_do_trans_count_utf8(pTHX_ SV * const sv)
{
- dVAR;
const U8 *s;
const U8 *start = NULL;
const U8 *send;
STATIC I32
S_do_trans_complex_utf8(pTHX_ SV * const 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_ SV *sv, SV *delim, SV **mark, SV **sp)
{
- dVAR;
SV ** const oldmark = mark;
I32 items = sp - mark;
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, SSize_t offset, int size)
{
- dVAR;
STRLEN srclen, len, uoffset, bitoffs = 0;
const I32 svpv_flags = ((PL_op->op_flags & OPf_MOD || LVRET)
? SV_UNDEF_RETURNS_NULL : 0);
void
Perl_do_vecset(pTHX_ SV *sv)
{
- dVAR;
SSize_t offset, bitoffs = 0;
int size;
unsigned char *s;
void
Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
{
- dVAR;
#ifdef LIBERAL
long *dl;
long *ll;
OP *
Perl_do_kv(pTHX)
{
- dVAR;
dSP;
HV * const keys = MUTABLE_HV(POPs);
HE *entry;
void
Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
{
- dVAR;
PERL_ARGS_ASSERT_DUMP_VINDENT;
PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
PerlIO_vprintf(file, pat, *args);
void
Perl_dump_all_perl(pTHX_ bool justperl)
{
-
- dVAR;
PerlIO_setlinebuf(Perl_debug_log);
if (PL_main_root)
op_dump(PL_main_root);
void
Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
{
- dVAR;
I32 i;
PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL;
void
Perl_dump_eval(pTHX)
{
- dVAR;
op_dump(PL_eval_root);
}
void
Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
{
- dVAR;
UV seq;
const OPCODE optype = o->op_type;
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;
-
PERL_ARGS_ASSERT_SV_DUMP;
if (SvROK(sv))
int
Perl_runops_debug(pTHX)
{
- dVAR;
if (!PL_op) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN");
return 0;
I32
Perl_debop(pTHX_ const OP *o)
{
- dVAR;
int count;
PERL_ARGS_ASSERT_DEBOP;
STATIC CV*
S_deb_curcv(pTHX_ const I32 ix)
{
- dVAR;
const PERL_CONTEXT * const cx = &cxstack[ix];
if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
return cx->blk_sub.cv;
void
Perl_watch(pTHX_ char **addr)
{
- dVAR;
-
PERL_ARGS_ASSERT_WATCH;
PL_watchaddr = addr;
STATIC void
S_debprof(pTHX_ const OP *o)
{
- dVAR;
-
PERL_ARGS_ASSERT_DEBPROF;
if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
void
Perl_debprofdump(pTHX)
{
- dVAR;
unsigned i;
if (!PL_profiledata)
return;
Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen,
const U32 flags)
{
- dVAR;
char smallbuf[128];
char *tmpbuf;
const STRLEN tmplen = namelen + 2;
void
Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flags)
{
- dVAR;
const U32 old_type = SvTYPE(gv);
const bool doproto = old_type > SVt_NULL;
char * const proto = (doproto && SvPOK(gv))
GV *
Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level, U32 flags)
{
- dVAR;
GV** gvp;
AV* linear_av;
SV** linear_svp;
GV *
Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN len, U32 flags)
{
- dVAR;
const char *nend;
const char *nsplit = NULL;
GV* gv;
GV*
Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
{
- dVAR;
GV* gv;
CV* cv;
HV* varstash;
STATIC HV*
S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methpv,const U32 flags)
{
- dVAR;
HV* stash = gv_stashsv(namesv, 0);
PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
const svtype sv_type)
{
- dVAR;
const char *name = nambeg;
GV *gv = NULL;
GV**gvp;
void
Perl_gv_check(pTHX_ HV *stash)
{
- dVAR;
I32 i;
PERL_ARGS_ASSERT_GV_CHECK;
GV *
Perl_newGVgen_flags(pTHX_ const char *pack, U32 flags)
{
- dVAR;
PERL_ARGS_ASSERT_NEWGVGEN_FLAGS;
assert(!(flags & ~SVf_UTF8));
GP*
Perl_gp_ref(pTHX_ GP *gp)
{
- dVAR;
if (!gp)
return NULL;
gp->gp_refcnt++;
void
Perl_gp_free(pTHX_ GV *gv)
{
- dVAR;
GP* gp;
int attempts = 100;
int
Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
{
- dVAR;
MAGIC* const mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table);
AMT amt;
const struct mro_meta* stash_meta = HvMROMETA(stash);
CV*
Perl_gv_handler(pTHX_ HV *stash, I32 id)
{
- dVAR;
MAGIC *mg;
AMT *amtp;
U32 newgen;
bool
Perl_try_amagic_un(pTHX_ int method, int flags) {
- dVAR;
dSP;
SV* tmpsv;
SV* const arg = TOPs;
bool
Perl_try_amagic_bin(pTHX_ int method, int flags) {
- dVAR;
dSP;
SV* const left = TOPm1s;
SV* const right = TOPs;
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, STRLEN const oldsize, STRLEN newsize)
{
- dVAR;
STRLEN i = 0;
char *a = (char*) HvARRAY(hv);
HE **aep;
void
Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
{
- dVAR;
XPVHV* xhv = (XPVHV*)SvANY(hv);
const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
I32 newsize;
STATIC SV*
S_hv_free_ent_ret(pTHX_ HV *hv, HE *entry)
{
- dVAR;
SV *val;
PERL_ARGS_ASSERT_HV_FREE_ENT_RET;
void
Perl_hv_free_ent(pTHX_ HV *hv, HE *entry)
{
- dVAR;
SV *val;
PERL_ARGS_ASSERT_HV_FREE_ENT;
void
Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry)
{
- dVAR;
-
PERL_ARGS_ASSERT_HV_DELAYFREE_ENT;
if (!entry)
void
Perl_hv_clear_placeholders(pTHX_ HV *hv)
{
- dVAR;
const U32 items = (U32)HvPLACEHOLDERS_get(hv);
PERL_ARGS_ASSERT_HV_CLEAR_PLACEHOLDERS;
void
Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
{
- dVAR;
XPVHV* xhv;
bool save;
void
Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
{
- dVAR;
struct xpvhv_aux *aux;
PERL_ARGS_ASSERT_HV_ENAME_DELETE;
STATIC void
S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
{
- dVAR;
XPVHV* xhv;
HE *entry;
HE **oentry;
STATIC HEK *
S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
{
- dVAR;
HE *entry;
const int flags_masked = flags & HVhek_MASK;
const U32 hindex = hash & (I32) HvMAX(PL_strtab);
SSize_t *
Perl_hv_placeholders_p(pTHX_ HV *hv)
{
- dVAR;
MAGIC *mg = mg_find((const SV *)hv, PERL_MAGIC_rhash);
PERL_ARGS_ASSERT_HV_PLACEHOLDERS_P;
I32
Perl_hv_placeholders_get(pTHX_ const HV *hv)
{
- dVAR;
MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash);
PERL_ARGS_ASSERT_HV_PLACEHOLDERS_GET;
void
Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph)
{
- dVAR;
MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash);
PERL_ARGS_ASSERT_HV_PLACEHOLDERS_SET;
void
Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
+#ifdef USE_ITHREADS
dVAR;
+#endif
PERL_UNUSED_CONTEXT;
while (he) {
struct refcounted_he *
Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
{
+#ifdef USE_ITHREADS
dVAR;
+#endif
PERL_UNUSED_CONTEXT;
if (he) {
HINTS_REFCNT_LOCK;
I32
Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
{
- dVAR;
-
PERL_ARGS_ASSERT_KEYWORD;
switch (len)
}
/* Generated from:
- * 7c6d47fd2890b2422a40331ec90eac08f9808209b01f2b9c113141410fea91b5 regen/keywords.pl
+ * 963511f90d23994583c88b07c3cf2258473567702972e94b59a635727c4aa944 regen/keywords.pl
* ex: set ro: */
#define KEY_y 254
/* Generated from:
- * 7c6d47fd2890b2422a40331ec90eac08f9808209b01f2b9c113141410fea91b5 regen/keywords.pl
+ * 963511f90d23994583c88b07c3cf2258473567702972e94b59a635727c4aa944 regen/keywords.pl
* ex: set ro: */
Perl_set_numeric_radix(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
- dVAR;
# ifdef HAS_LOCALECONV
const struct lconv* const lc = localeconv();
* POSIX::setlocale() */
char *save_newnum;
- dVAR;
if (! newnum) {
Safefree(PL_numeric_name);
Perl_set_numeric_standard(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
- dVAR;
-
/* Toggle the LC_NUMERIC locale to C, if not already there. Probably
* should use the macros like SET_NUMERIC_STANDARD() in perl.h instead of
* calling this directly. */
Perl_set_numeric_local(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
- dVAR;
-
/* Toggle the LC_NUMERIC locale to the current underlying default, if not
* already there. Probably should use the macros like SET_NUMERIC_LOCAL()
* in perl.h instead of calling this directly. */
* should be called directly only from this file and from
* POSIX::setlocale() */
- dVAR;
-
if (! newcoll) {
if (PL_collation_name) {
++PL_collation_ix;
int ok = 1;
#if defined(USE_LOCALE)
- dVAR;
-
#ifdef USE_LOCALE_CTYPE
char *curctype = NULL;
#endif /* USE_LOCALE_CTYPE */
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 */
int
Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
{
- dTHXs;
int ret = 0;
va_list(arglist);
void
Perl_save_long(pTHX_ long int *longp)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_LONG;
SSCHECK(3);
void
Perl_save_iv(pTHX_ IV *ivp)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_IV;
SSCHECK(3);
void
Perl_save_nogv(pTHX_ GV *gv)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_NOGV;
SSCHECK(2);
void
Perl_save_list(pTHX_ SV **sarg, I32 maxsarg)
{
- dVAR;
I32 i;
PERL_ARGS_ASSERT_SAVE_LIST;
void
Perl_save_freesv(pTHX_ SV *sv)
{
- dVAR;
save_freesv(sv);
}
void
Perl_save_mortalizesv(pTHX_ SV *sv)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
save_mortalizesv(sv);
void
Perl_save_freeop(pTHX_ OP *o)
{
- dVAR;
save_freeop(o);
}
void
Perl_save_freepv(pTHX_ char *pv)
{
- dVAR;
save_freepv(pv);
}
void
Perl_save_op(pTHX)
{
- dVAR;
save_op();
}
bool
Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_IDFIRST;
return _is_utf8_idstart(p);
bool
Perl_is_utf8_xidfirst(pTHX_ const U8 *p) /* The naming is historical. */
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_XIDFIRST;
return _is_utf8_xidstart(p);
bool
Perl_is_utf8_idcont(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_IDCONT;
return _is_utf8_idcont(p);
bool
Perl_is_utf8_xidcont(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_XIDCONT;
return _is_utf8_xidcont(p);
bool
Perl_is_utf8_alnum(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_ALNUM;
/* NOTE: "IsWord", not "IsAlnum", since Alnum is a true
bool
Perl_is_utf8_alnumc(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_ALNUMC;
return isALPHANUMERIC_utf8(p);
bool
Perl_is_utf8_alpha(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_ALPHA;
return isALPHA_utf8(p);
bool
Perl_is_utf8_ascii(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_ASCII;
PERL_UNUSED_CONTEXT;
bool
Perl_is_utf8_blank(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_BLANK;
PERL_UNUSED_CONTEXT;
bool
Perl_is_utf8_space(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_SPACE;
PERL_UNUSED_CONTEXT;
bool
Perl_is_utf8_perl_space(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_PERL_SPACE;
PERL_UNUSED_CONTEXT;
bool
Perl_is_utf8_perl_word(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_PERL_WORD;
PERL_UNUSED_CONTEXT;
bool
Perl_is_utf8_digit(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_DIGIT;
return isDIGIT_utf8(p);
bool
Perl_is_utf8_posix_digit(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_POSIX_DIGIT;
PERL_UNUSED_CONTEXT;
bool
Perl_is_utf8_upper(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_UPPER;
return isUPPER_utf8(p);
bool
Perl_is_utf8_lower(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_LOWER;
return isLOWER_utf8(p);
bool
Perl_is_utf8_cntrl(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_CNTRL;
PERL_UNUSED_CONTEXT;
bool
Perl_is_utf8_graph(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_GRAPH;
return isGRAPH_utf8(p);
bool
Perl_is_utf8_print(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_PRINT;
return isPRINT_utf8(p);
bool
Perl_is_utf8_punct(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_PUNCT;
return isPUNCT_utf8(p);
bool
Perl_is_utf8_xdigit(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_XDIGIT;
PERL_UNUSED_CONTEXT;
bool
Perl_is_utf8_mark(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_MARK;
return _is_utf8_mark(p);
STATIC void
S_save_magic_flags(pTHX_ I32 mgs_ix, SV *sv, U32 flags)
{
- dVAR;
MGS* mgs;
bool bumped = FALSE;
int
Perl_mg_get(pTHX_ SV *sv)
{
- dVAR;
const I32 mgs_ix = SSNEW(sizeof(MGS));
bool saved = FALSE;
bool 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, bool setmagic)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_MG_LOCALIZE;
U32
Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
PERL_UNUSED_ARG(sv);
PERL_ARGS_ASSERT_MAGIC_REGDATA_CNT;
int
Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
-
PERL_ARGS_ASSERT_MAGIC_REGDATUM_GET;
if (PL_curpm) {
int
Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
I32 paren;
const char *s = NULL;
REGEXP *rx;
int
Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
STRLEN len = 0, klen;
const char * const key = MgPV_const(mg,klen);
const char *s = "";
int
Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
PERL_ARGS_ASSERT_MAGIC_SET_ALL_ENV;
PERL_UNUSED_ARG(mg);
#if defined(VMS)
int
Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
PERL_ARGS_ASSERT_MAGIC_CLEAR_ALL_ENV;
PERL_UNUSED_ARG(sv);
PERL_UNUSED_ARG(mg);
int
Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
/* Are we fetching a signal entry? */
int i = (I16)mg->mg_private;
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_ARGS_ASSERT_MAGIC_SETISA;
PERL_UNUSED_ARG(sv);
int
Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
HV* stash;
-
PERL_ARGS_ASSERT_MAGIC_CLEARISA;
/* Bail out if destruction is going on */
Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
U32 argc, ...)
{
- dVAR;
dSP;
SV* ret = NULL;
S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
int n, SV *val)
{
- dVAR;
SV* arg1 = NULL;
PERL_ARGS_ASSERT_MAGIC_METHCALL1;
STATIC int
S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, SV *meth)
{
- dVAR;
SV* ret;
PERL_ARGS_ASSERT_MAGIC_METHPACK;
int
Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
MAGIC *tmg;
SV *val;
U32
Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
I32 retval = 0;
SV* retsv;
int
Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
-
PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(CLEAR), G_DISCARD, 0);
int
Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
{
- dVAR;
SV* ret;
PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
SV *
Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
{
- dVAR;
SV *retval;
SV * const tied = SvTIED_obj(MUTABLE_SV(hv), mg);
HV * const pkg = SvSTASH((const SV *)SvRV(tied));
int
Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
SV **svp;
PERL_ARGS_ASSERT_MAGIC_SETDBLINE;
int
Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
{
- dVAR;
AV * const obj = MUTABLE_AV(mg->mg_obj);
PERL_ARGS_ASSERT_MAGIC_GETARYLEN;
int
Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
AV * const obj = MUTABLE_AV(mg->mg_obj);
PERL_ARGS_ASSERT_MAGIC_SETARYLEN;
int
Perl_magic_cleararylen_p(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
-
PERL_ARGS_ASSERT_MAGIC_CLEARARYLEN_P;
PERL_UNUSED_ARG(sv);
PERL_UNUSED_CONTEXT;
int
Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
-
PERL_ARGS_ASSERT_MAGIC_FREEARYLEN_P;
PERL_UNUSED_ARG(sv);
int
Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
SV* const lsv = LvTARG(sv);
MAGIC * const found = mg_find_mglob(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, lsv_len, oldtarglen, newtarglen;
const char * const tmps = SvPV_const(sv, len);
SV * const lsv = LvTARG(sv);
int
Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
-
PERL_ARGS_ASSERT_MAGIC_GETTAINT;
PERL_UNUSED_ARG(sv);
#ifdef NO_TAINT_SUPPORT
int
Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
-
PERL_ARGS_ASSERT_MAGIC_SETTAINT;
PERL_UNUSED_ARG(sv);
SV *
Perl_defelem_target(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
SV *targ = NULL;
PERL_ARGS_ASSERT_DEFELEM_TARGET;
if (!mg) mg = mg_find(sv, PERL_MAGIC_defelem);
void
Perl_vivify_defelem(pTHX_ SV *sv)
{
- dVAR;
MAGIC *mg;
SV *value = NULL;
int
Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
{
+#ifdef USE_ITHREADS
dVAR;
+#endif
const char *s;
I32 paren;
const REGEXP * rx;
static void
S_restore_magic(pTHX_ const void *p)
{
- dVAR;
MGS* const mgs = SSPTR(PTR2IV(p), MGS*);
SV* const sv = mgs->mgs_sv;
bool bumped;
static void
S_unwind_handler_stack(pTHX_ const void *p)
{
- dVAR;
PERL_UNUSED_ARG(p);
PL_savestack_ix -= 5; /* Unprotect save in progress. */
int
Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
SV *key = (mg->mg_len == HEf_SVKEY) ? MUTABLE_SV(mg->mg_ptr)
: newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
int
Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
-
PERL_ARGS_ASSERT_MAGIC_CLEARHINT;
PERL_UNUSED_ARG(sv);
void
Perl_mro_isa_changed_in(pTHX_ HV* stash)
{
- dVAR;
HV* isarev;
AV* linear_mro;
HE* iter;
void
Perl_boot_core_mro(pTHX)
{
- dVAR;
static const char file[] = __FILE__;
Perl_mro_register(aTHX_ &dfs_alg);
XS(XS_mro_method_changed_in)
{
- dVAR;
dXSARGS;
SV* classname;
HV* class_stash;
UV
Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
- dVAR;
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
- dVAR;
-
PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX;
if (IN_LC(LC_NUMERIC)) {
{
NV x = 0.0;
#ifdef USE_LOCALE_NUMERIC
- dVAR;
-
PERL_ARGS_ASSERT_MY_ATOF;
{
void *
Perl_Slab_Alloc(pTHX_ size_t sz)
{
- dVAR;
OPSLAB *slab;
OPSLAB *slab2;
OPSLOT *slot;
void
Perl_Slab_Free(pTHX_ void *op)
{
- dVAR;
OP * const o = (OP *)op;
OPSLAB *slab;
void
Perl_opslab_free_nopad(pTHX_ OPSLAB *slab)
{
- dVAR;
const bool havepad = !!PL_comppad;
PERL_ARGS_ASSERT_OPSLAB_FREE_NOPAD;
if (havepad) {
void
Perl_opslab_free(pTHX_ OPSLAB *slab)
{
- dVAR;
OPSLAB *slab2;
PERL_ARGS_ASSERT_OPSLAB_FREE;
PERL_UNUSED_CONTEXT;
PADOFFSET
Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
{
- dVAR;
PADOFFSET off;
const bool is_our = (PL_parser->in_my == KEY_our);
void
Perl_op_free(pTHX_ OP *o)
{
+#ifdef USE_ITHREADS
dVAR;
+#endif
OPCODE type;
/* Though ops may be freed twice, freeing the op after its slab is a
void
Perl_op_refcnt_lock(pTHX)
{
+#ifdef USE_ITHREADS
dVAR;
+#endif
PERL_UNUSED_CONTEXT;
OP_REFCNT_LOCK;
}
void
Perl_op_refcnt_unlock(pTHX)
{
+#ifdef USE_ITHREADS
dVAR;
+#endif
PERL_UNUSED_CONTEXT;
OP_REFCNT_UNLOCK;
}
STATIC OP *
S_scalarboolean(pTHX_ OP *o)
{
- dVAR;
-
PERL_ARGS_ASSERT_SCALARBOOLEAN;
if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST
OP *
Perl_scalar(pTHX_ OP *o)
{
- dVAR;
OP *kid;
/* assumes no premature commitment */
OP *
Perl_list(pTHX_ OP *o)
{
- dVAR;
OP *kid;
/* assumes no premature commitment */
static OP *
S_scalarseq(pTHX_ OP *o)
{
- dVAR;
if (o) {
const OPCODE type = o->op_type;
STATIC OP *
S_dup_attrlist(pTHX_ OP *o)
{
- dVAR;
OP *rop;
PERL_ARGS_ASSERT_DUP_ATTRLIST;
STATIC void
S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
{
- dVAR;
SV * const stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
PERL_ARGS_ASSERT_APPLY_ATTRS;
STATIC void
S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
{
- dVAR;
OP *pack, *imop, *arg;
SV *meth, *stashsv, **svp;
STATIC OP *
S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
{
- dVAR;
I32 type;
const bool stately = PL_parser && PL_parser->in_my == KEY_state;
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);
OP*
Perl_block_end(pTHX_ I32 floor, OP *seq)
{
- dVAR;
const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
OP* retval = scalarseq(seq);
OP *o;
STATIC OP *
S_newDEFSVOP(pTHX)
{
- dVAR;
const PADOFFSET offset = pad_findmy_pvs("$_", 0);
if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
void
Perl_newPROG(pTHX_ OP *o)
{
- dVAR;
-
PERL_ARGS_ASSERT_NEWPROG;
if (PL_in_eval) {
OP *
Perl_localize(pTHX_ OP *o, I32 lex)
{
- dVAR;
-
PERL_ARGS_ASSERT_LOCALIZE;
if (o->op_flags & OPf_PARENS)
static OP *
S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
{
- dVAR;
SV * const tstr = ((SVOP*)expr)->op_sv;
SV * const rstr =
((SVOP*)repl)->op_sv;
OP *
Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
{
- dVAR;
-
PERL_ARGS_ASSERT_NEWGVOP;
#ifdef USE_ITHREADS
void
Perl_package(pTHX_ OP *o)
{
- dVAR;
SV *const sv = cSVOPo->op_sv;
PERL_ARGS_ASSERT_PACKAGE;
void
Perl_package_version( pTHX_ OP *v )
{
- dVAR;
U32 savehints = PL_hints;
PERL_ARGS_ASSERT_PACKAGE_VERSION;
PL_hints &= ~HINT_STRICT_VARS;
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;
OP *
Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
{
- dVAR;
OP *o;
if (optype) {
OP *
Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other)
{
- dVAR;
-
PERL_ARGS_ASSERT_NEWLOGOP;
return new_logop(type, flags, &first, &other);
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 = NULL;
PERL_ARGS_ASSERT_NEWLOOPEX;
STATIC bool
S_looks_like_bool(pTHX_ const OP *o)
{
- dVAR;
-
PERL_ARGS_ASSERT_LOOKS_LIKE_BOOL;
switch(o->op_type) {
OP *
Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off)
{
- dVAR;
PERL_ARGS_ASSERT_NEWGIVENOP;
return newGIVWHENOP(
ref_array_or_hash(cond),
SV *
Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
{
- dVAR;
SV *sv = NULL;
if (!o)
CV *
Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
{
- dVAR;
CV **spot;
SV **svspot;
const char *ps;
Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
OP *block, bool o_is_gv)
{
- dVAR;
GV *gv;
const char *ps;
STRLEN ps_len = 0; /* init it to avoid false uninit warning from icc */
Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, STRLEN len,
U32 flags, SV *sv)
{
- dVAR;
CV* cv;
const char *const file = CopFILE(PL_curcop);
void
Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
{
- dVAR;
CV *cv;
GV *gv;
OP *
Perl_ck_bitop(pTHX_ OP *o)
{
- dVAR;
-
PERL_ARGS_ASSERT_CK_BITOP;
o->op_private = (U8)(PL_hints & HINT_INTEGER);
OP *
Perl_ck_eof(pTHX_ OP *o)
{
- dVAR;
-
PERL_ARGS_ASSERT_CK_EOF;
if (o->op_flags & OPf_KIDS) {
OP *
Perl_ck_exists(pTHX_ OP *o)
{
- dVAR;
-
PERL_ARGS_ASSERT_CK_EXISTS;
o = ck_fun(o);
OP *
Perl_ck_fun(pTHX_ OP *o)
{
- dVAR;
const int type = o->op_type;
I32 oa = PL_opargs[type] >> OASHIFT;
OP *
Perl_ck_glob(pTHX_ OP *o)
{
- dVAR;
GV *gv;
PERL_ARGS_ASSERT_CK_GLOB;
OP *
Perl_ck_match(pTHX_ OP *o)
{
- dVAR;
-
PERL_ARGS_ASSERT_CK_MATCH;
if (o->op_type != OP_QR && PL_compcv) {
OP *
Perl_ck_open(pTHX_ OP *o)
{
- dVAR;
-
PERL_ARGS_ASSERT_CK_OPEN;
S_io_hints(aTHX_ o);
OP *
Perl_ck_require(pTHX_ OP *o)
{
- dVAR;
GV* gv;
PERL_ARGS_ASSERT_CK_REQUIRE;
OP *
Perl_ck_return(pTHX_ OP *o)
{
- dVAR;
OP *kid;
PERL_ARGS_ASSERT_CK_RETURN;
OP *
Perl_ck_shift(pTHX_ OP *o)
{
- dVAR;
const I32 type = o->op_type;
PERL_ARGS_ASSERT_CK_SHIFT;
OP *
Perl_ck_sort(pTHX_ OP *o)
{
- dVAR;
OP *firstkid;
OP *kid;
HV * const hinthv =
STATIC void
S_simplify_sort(pTHX_ OP *o)
{
- dVAR;
OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
OP *k;
int descending;
static void
const_sv_xsub(pTHX_ CV* cv)
{
- dVAR;
dXSARGS;
SV *const sv = MUTABLE_SV(XSANY.any_ptr);
PERL_UNUSED_ARG(items);
static void
const_av_xsub(pTHX_ CV* cv)
{
- dVAR;
dXSARGS;
AV * const av = MUTABLE_AV(XSANY.any_ptr);
SP -= items;
PADLIST *
Perl_pad_new(pTHX_ int flags)
{
- dVAR;
PADLIST *padlist;
PAD *padname, *pad;
PAD **ary;
void
Perl_cv_undef(pTHX_ CV *cv)
{
- dVAR;
const PADLIST *padlist = CvPADLIST(cv);
bool const slabbed = !!CvSLABBED(cv);
static PADOFFSET
S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
{
- dVAR;
const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, HV *typestash, HV *ourstash)
{
- dVAR;
PADOFFSET offset;
SV *namesv;
bool is_utf8;
PADOFFSET
Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
{
- dVAR;
SV *sv;
I32 retval;
PADOFFSET
Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
{
- dVAR;
PADOFFSET ix;
SV* const name = newSV_type(SVt_PVNV);
STATIC void
S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
{
- dVAR;
SV **svp;
PADOFFSET top, off;
const U32 is_our = flags & padadd_OUR;
PADOFFSET
Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
{
- dVAR;
SV *out_sv;
int out_flags;
I32 offset;
PADOFFSET
Perl_find_rundefsvoffset(pTHX)
{
- dVAR;
SV *out_sv;
int out_flags;
return pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, 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;
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;
U32 seq;
OP *
Perl_pad_leavemy(pTHX)
{
- dVAR;
I32 off;
OP *o = NULL;
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;
static void
S_pad_reset(pTHX)
{
- dVAR;
#ifdef USE_BROKEN_PAD_RESET
if (AvARRAY(PL_comppad) != PL_curpad)
Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p",
void
Perl_pad_free(pTHX_ PADOFFSET po)
{
- dVAR;
SV *sv;
ASSERT_CURPAD_LEGAL("pad_free");
if (!PL_curpad)
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_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
{
- dVAR;
I32 ix;
PADLIST* const protopadlist = CvPADLIST(proto);
PAD *const protopad_name = *PadlistARRAY(protopadlist);
static CV *
S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
{
+#ifdef USE_ITHREADS
dVAR;
+#endif
const bool newcv = !cv;
assert(!CvUNIQUE(proto));
void
Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
{
- dVAR;
I32 ix;
AV * const comppad_name = PadlistARRAY(padlist)[0];
AV * const comppad = PadlistARRAY(padlist)[1];
void
Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
{
- dVAR;
-
PERL_ARGS_ASSERT_PAD_PUSH;
if (depth > PadlistMAX(padlist) || !PadlistARRAY(padlist)[depth]) {
HV *
Perl_pad_compname_type(pTHX_ const PADOFFSET po)
{
- dVAR;
SV* const av = PAD_COMPNAME_SV(po);
if ( SvPAD_TYPED(av) ) {
return SvSTASH(av);
PAD **
Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *val)
{
- dVAR;
PAD **ary;
SSize_t const oldmax = PadlistMAX(padlist);
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;
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 (0x%x).\n",
PL_sawampersand ? "Enabling" : "Omitting",
(unsigned int)(PL_sawampersand)));
/* See G_* flags in cop.h */
/* null terminated arg list */
{
- dVAR;
dSP;
PERL_ARGS_ASSERT_CALL_ARGV;
SV*
Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
{
- dVAR;
SV* sv = newSVpv(p, 0);
PERL_ARGS_ASSERT_EVAL_PV;
void
Perl_require_pv(pTHX_ const char *pv)
{
- dVAR;
dSP;
SV* sv;
STATIC void
S_init_interp(pTHX)
{
- dVAR;
#ifdef MULTIPLICITY
# define PERLVAR(prefix,var,type)
# define PERLVARA(prefix,var,n,type)
STATIC void
S_init_main_stash(pTHX)
{
- dVAR;
GV *gv;
PL_curstash = PL_defstash = (HV *)SvREFCNT_inc_simple_NN(newHV());
{
int fdscript = -1;
PerlIO *rsfp = NULL;
- dVAR;
Stat_t tmpstatbuf;
int fd;
STATIC void
S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
{
- dVAR;
const char *s;
const char *s2;
/* no need to do anything here any more if we don't
* do tainting. */
#ifndef NO_TAINT_SUPPORT
- dVAR;
const Uid_t my_uid = PerlProc_getuid();
const Uid_t my_euid = PerlProc_geteuid();
const Gid_t my_gid = PerlProc_getgid();
const Gid_t my_egid = PerlProc_getegid();
+ PERL_UNUSED_CONTEXT;
+
/* Should not happen: */
CHECK_MALLOC_TAINT(my_uid && (my_euid != my_uid || my_egid != my_gid));
TAINTING_set( TAINTING_get | (my_uid && (my_euid != my_uid || my_egid != my_gid)) );
STATIC void
S_forbid_setid(pTHX_ const char flag, const bool suidscript) /* g */
{
- dVAR;
char string[3] = "-x";
const char *message = "program input from stdin";
+ PERL_UNUSED_CONTEXT;
if (flag) {
string[1] = flag;
message = string;
void
Perl_init_debugger(pTHX)
{
- dVAR;
HV * const ostash = PL_curstash;
PL_curstash = (HV *)SvREFCNT_inc_simple(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_predump_symbols(pTHX)
{
- dVAR;
GV *tmpgv;
IO *io;
void
Perl_init_argv_symbols(pTHX_ int argc, char **argv)
{
- dVAR;
-
PERL_ARGS_ASSERT_INIT_ARGV_SYMBOLS;
argc--,argv++; /* skip name of script */
STATIC void
S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env)
{
+#ifdef USE_ITHREADS
dVAR;
+#endif
GV* tmpgv;
PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS;
STATIC void
S_init_perllib(pTHX)
{
- dVAR;
#ifndef VMS
const char *perl5lib = NULL;
#endif
STATIC SV *
S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem)
{
- dVAR;
Stat_t tmpstatbuf;
PERL_ARGS_ASSERT_INCPUSH_IF_EXISTS;
STATIC void
S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
{
- dVAR;
#ifndef PERL_IS_MINIPERL
const U8 using_sub_dirs
= (U8)flags & (INCPUSH_ADD_VERSIONED_SUB_DIRS
void
Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
{
- dVAR;
SV *atsv;
volatile const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0;
CV *cv;
void
Perl_my_exit(pTHX_ U32 status)
{
- dVAR;
if (PL_exit_flags & PERL_EXIT_ABORT) {
abort();
}
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 void
S_my_exit_jump(pTHX)
{
- dVAR;
-
if (PL_e_script) {
SvREFCNT_dec(PL_e_script);
PL_e_script = NULL;
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');
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;
PERL_UNUSED_CONTEXT;
void
PerlIO_destruct(pTHX)
{
- dVAR;
PerlIOl **table = &PL_perlio;
PerlIOl *f;
#ifdef USE_ITHREADS
AV *
PerlIO_get_layers(pTHX_ PerlIO *f)
{
- dVAR;
AV * const av = newAV();
if (PerlIOValid(f)) {
PerlIO_funcs *
PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
{
- dVAR;
+
IV i;
if ((SSize_t) len <= 0)
len = strlen(name);
/* This is used as a %SIG{__WARN__} handler to suppress warnings
during loading of layers.
*/
- dVAR;
dXSARGS;
PERL_UNUSED_ARG(cv);
if (items)
XS(XS_PerlIO__Layer__find); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlIO__Layer__find)
{
- dVAR;
dXSARGS;
PERL_UNUSED_ARG(cv);
if (items < 2)
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, NULL);
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 = TAINTING_get ? NULL : 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_init_table(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));
+ Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f));
}
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;
PerlIOl **table = &PL_perlio;
PerlIOl *f;
while ((f = *table)) {
void
PerlIO_cleanup(pTHX)
{
- dVAR;
int i;
#ifdef USE_ITHREADS
PerlIO_debug("Cleanup layers for %p\n",(void*)aTHX);
SSize_t
PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
- dVAR;
int fd;
if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */
return -1;
SSize_t
PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
- dVAR;
int fd;
if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */
return -1;
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 * s;
SSize_t got = 0;
if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */
SSize_t
PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
- dVAR;
SSize_t got;
if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */
return -1;
void
PerlIO_releaseFILE(PerlIO *p, FILE *f)
{
- dVAR;
PerlIOl *l;
while ((l = *p)) {
if (l->tab == &PerlIO_stdio) {
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);
}
const char *
Perl_PerlIO_context_layers(pTHX_ const char *mode)
{
- dVAR;
const char *direction = NULL;
SV *layers;
/*
int
Perl_yyparse (pTHX_ int gramtype)
{
- dVAR;
int yystate;
int yyn;
int yyresult;
PP(pp_stub)
{
- dVAR;
dSP;
if (GIMME_V == G_SCALAR)
XPUSHs(&PL_sv_undef);
PP(pp_padav)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
I32 gimme;
assert(SvTYPE(TARG) == SVt_PVAV);
if (UNLIKELY( PL_op->op_private & OPpLVAL_INTRO ))
PP(pp_padhv)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
I32 gimme;
assert(SvTYPE(TARG) == SVt_PVHV);
PP(pp_padcv)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
assert(SvTYPE(TARG) == SVt_PVCV);
XPUSHs(TARG);
RETURN;
PP(pp_introcv)
{
- dVAR; dTARGET;
+ dTARGET;
SvPADSTALE_off(TARG);
return NORMAL;
}
PP(pp_clonecv)
{
- dVAR; dTARGET;
+ dTARGET;
MAGIC * const mg =
mg_find(PadlistNAMESARRAY(CvPADLIST(find_runcv(NULL)))[ARGTARG],
PERL_MAGIC_proto);
S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
const bool noinit)
{
- dVAR;
if (!isGV(sv) || SvFAKE(sv)) SvGETMAGIC(sv);
if (SvROK(sv)) {
if (SvAMAGIC(sv)) {
PP(pp_rv2gv)
{
- dVAR; dSP; dTOPss;
+ dSP; dTOPss;
sv = S_rv2gv(aTHX_
sv, PL_op->op_private & OPpDEREF,
Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
const svtype type, SV ***spp)
{
- dVAR;
GV *gv;
PERL_ARGS_ASSERT_SOFTREF2XV;
PP(pp_rv2sv)
{
- dVAR; dSP; dTOPss;
+ dSP; dTOPss;
GV *gv = NULL;
SvGETMAGIC(sv);
PP(pp_av2arylen)
{
- dVAR; dSP;
+ dSP;
AV * const av = MUTABLE_AV(TOPs);
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
if (lvalue) {
PP(pp_pos)
{
- dVAR; dSP; dPOPss;
+ dSP; dPOPss;
if (PL_op->op_flags & OPf_MOD || LVRET) {
SV * const ret = sv_2mortal(newSV_type(SVt_PVLV));/* Not TARG RT#67838 */
PP(pp_rv2cv)
{
- dVAR; dSP;
+ dSP;
GV *gv;
HV *stash_unused;
const I32 flags = (PL_op->op_flags & OPf_SPECIAL)
PP(pp_prototype)
{
- dVAR; dSP;
+ dSP;
CV *cv;
HV *stash;
GV *gv;
PP(pp_anoncode)
{
- dVAR; dSP;
+ dSP;
CV *cv = MUTABLE_CV(PAD_SV(PL_op->op_targ));
if (CvCLONE(cv))
cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
PP(pp_srefgen)
{
- dVAR; dSP;
+ dSP;
*SP = refto(*SP);
RETURN;
}
PP(pp_refgen)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
if (GIMME != G_ARRAY) {
if (++MARK <= SP)
*MARK = *SP;
STATIC SV*
S_refto(pTHX_ SV *sv)
{
- dVAR;
SV* rv;
PERL_ARGS_ASSERT_REFTO;
PP(pp_ref)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
SV * const sv = POPs;
SvGETMAGIC(sv);
PP(pp_bless)
{
- dVAR; dSP;
+ dSP;
HV *stash;
if (MAXARG == 1)
PP(pp_gelem)
{
- dVAR; dSP;
+ dSP;
SV *sv = POPs;
STRLEN len;
PP(pp_study)
{
- dVAR; dSP; dPOPss;
+ dSP; dPOPss;
STRLEN len;
(void)SvPV(sv, len);
PP(pp_trans)
{
- dVAR; dSP; dTARG;
+ dSP; dTARG;
SV *sv;
if (PL_op->op_flags & OPf_STACKED)
static void
S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
{
- dVAR;
STRLEN len;
char *s;
PP(pp_schop)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const bool chomping = PL_op->op_type == OP_SCHOMP;
if (chomping)
PP(pp_chop)
{
- dVAR; dSP; dMARK; dTARGET; dORIGMARK;
+ dSP; dMARK; dTARGET; dORIGMARK;
const bool chomping = PL_op->op_type == OP_CHOMP;
if (chomping)
PP(pp_undef)
{
- dVAR; dSP;
+ dSP;
SV *sv;
if (!PL_op->op_private) {
PP(pp_postinc)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const bool inc =
PL_op->op_type == OP_POSTINC || PL_op->op_type == OP_I_POSTINC;
if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
PP(pp_pow)
{
- dVAR; dSP; dATARGET; SV *svl, *svr;
+ dSP; dATARGET; SV *svl, *svr;
#ifdef PERL_PRESERVE_IVUV
bool is_int = 0;
#endif
PP(pp_multiply)
{
- dVAR; dSP; dATARGET; SV *svl, *svr;
+ dSP; dATARGET; SV *svl, *svr;
tryAMAGICbin_MG(mult_amg, AMGf_assign|AMGf_numeric);
svr = TOPs;
svl = TOPm1s;
PP(pp_divide)
{
- dVAR; dSP; dATARGET; SV *svl, *svr;
+ dSP; dATARGET; SV *svl, *svr;
tryAMAGICbin_MG(div_amg, AMGf_assign|AMGf_numeric);
svr = TOPs;
svl = TOPm1s;
PP(pp_modulo)
{
- dVAR; dSP; dATARGET;
+ dSP; dATARGET;
tryAMAGICbin_MG(modulo_amg, AMGf_assign|AMGf_numeric);
{
UV left = 0;
PP(pp_repeat)
{
- dVAR; dSP; dATARGET;
+ dSP; dATARGET;
IV count;
SV *sv;
PP(pp_subtract)
{
- dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr;
+ dSP; dATARGET; bool useleft; SV *svl, *svr;
tryAMAGICbin_MG(subtr_amg, AMGf_assign|AMGf_numeric);
svr = TOPs;
svl = TOPm1s;
PP(pp_left_shift)
{
- dVAR; dSP; dATARGET; SV *svl, *svr;
+ dSP; dATARGET; SV *svl, *svr;
tryAMAGICbin_MG(lshift_amg, AMGf_assign|AMGf_numeric);
svr = POPs;
svl = TOPs;
PP(pp_right_shift)
{
- dVAR; dSP; dATARGET; SV *svl, *svr;
+ dSP; dATARGET; SV *svl, *svr;
tryAMAGICbin_MG(rshift_amg, AMGf_assign|AMGf_numeric);
svr = POPs;
svl = TOPs;
PP(pp_lt)
{
- dVAR; dSP;
+ dSP;
SV *left, *right;
tryAMAGICbin_MG(lt_amg, AMGf_set|AMGf_numeric);
PP(pp_gt)
{
- dVAR; dSP;
+ dSP;
SV *left, *right;
tryAMAGICbin_MG(gt_amg, AMGf_set|AMGf_numeric);
PP(pp_le)
{
- dVAR; dSP;
+ dSP;
SV *left, *right;
tryAMAGICbin_MG(le_amg, AMGf_set|AMGf_numeric);
PP(pp_ge)
{
- dVAR; dSP;
+ dSP;
SV *left, *right;
tryAMAGICbin_MG(ge_amg, AMGf_set|AMGf_numeric);
PP(pp_ne)
{
- dVAR; dSP;
+ dSP;
SV *left, *right;
tryAMAGICbin_MG(ne_amg, AMGf_set|AMGf_numeric);
I32
Perl_do_ncmp(pTHX_ SV* const left, SV * const right)
{
- dVAR;
-
PERL_ARGS_ASSERT_DO_NCMP;
#ifdef PERL_PRESERVE_IVUV
/* Fortunately it seems NaN isn't IOK */
PP(pp_ncmp)
{
- dVAR; dSP;
+ dSP;
SV *left, *right;
I32 value;
tryAMAGICbin_MG(ncmp_amg, AMGf_numeric);
PP(pp_sle)
{
- dVAR; dSP;
+ dSP;
int amg_type = sle_amg;
int multiplier = 1;
PP(pp_seq)
{
- dVAR; dSP;
+ dSP;
tryAMAGICbin_MG(seq_amg, AMGf_set);
{
dPOPTOPssrl;
PP(pp_sne)
{
- dVAR; dSP;
+ dSP;
tryAMAGICbin_MG(sne_amg, AMGf_set);
{
dPOPTOPssrl;
PP(pp_scmp)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
tryAMAGICbin_MG(scmp_amg, 0);
{
dPOPTOPssrl;
PP(pp_bit_and)
{
- dVAR; dSP; dATARGET;
+ dSP; dATARGET;
tryAMAGICbin_MG(band_amg, AMGf_assign);
{
dPOPTOPssrl;
PP(pp_bit_or)
{
- dVAR; dSP; dATARGET;
+ dSP; dATARGET;
const int op_type = PL_op->op_type;
tryAMAGICbin_MG((op_type == OP_BIT_OR ? bor_amg : bxor_amg), AMGf_assign);
PP(pp_negate)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
tryAMAGICun_MG(neg_amg, AMGf_numeric);
if (S_negate_string(aTHX)) return NORMAL;
{
PP(pp_not)
{
- dVAR; dSP;
+ dSP;
tryAMAGICun_MG(not_amg, AMGf_set);
*PL_stack_sp = boolSV(!SvTRUE_nomg(*PL_stack_sp));
return NORMAL;
PP(pp_complement)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
tryAMAGICun_MG(compl_amg, AMGf_numeric);
{
dTOPss;
PP(pp_i_multiply)
{
- dVAR; dSP; dATARGET;
+ dSP; dATARGET;
tryAMAGICbin_MG(mult_amg, AMGf_assign);
{
dPOPTOPiirl_nomg;
PP(pp_i_divide)
{
IV num;
- dVAR; dSP; dATARGET;
+ dSP; dATARGET;
tryAMAGICbin_MG(div_amg, AMGf_assign);
{
dPOPTOPssrl;
#endif
{
/* This is the vanilla old i_modulo. */
- dVAR; dSP; dATARGET;
+ dSP; dATARGET;
tryAMAGICbin_MG(modulo_amg, AMGf_assign);
{
dPOPTOPiirl_nomg;
/* 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;
+ dSP; dATARGET;
tryAMAGICbin_MG(modulo_amg, AMGf_assign);
{
dPOPTOPiirl_nomg;
PP(pp_i_add)
{
- dVAR; dSP; dATARGET;
+ dSP; dATARGET;
tryAMAGICbin_MG(add_amg, AMGf_assign);
{
dPOPTOPiirl_ul_nomg;
PP(pp_i_subtract)
{
- dVAR; dSP; dATARGET;
+ dSP; dATARGET;
tryAMAGICbin_MG(subtr_amg, AMGf_assign);
{
dPOPTOPiirl_ul_nomg;
PP(pp_i_lt)
{
- dVAR; dSP;
+ dSP;
tryAMAGICbin_MG(lt_amg, AMGf_set);
{
dPOPTOPiirl_nomg;
PP(pp_i_gt)
{
- dVAR; dSP;
+ dSP;
tryAMAGICbin_MG(gt_amg, AMGf_set);
{
dPOPTOPiirl_nomg;
PP(pp_i_le)
{
- dVAR; dSP;
+ dSP;
tryAMAGICbin_MG(le_amg, AMGf_set);
{
dPOPTOPiirl_nomg;
PP(pp_i_ge)
{
- dVAR; dSP;
+ dSP;
tryAMAGICbin_MG(ge_amg, AMGf_set);
{
dPOPTOPiirl_nomg;
PP(pp_i_eq)
{
- dVAR; dSP;
+ dSP;
tryAMAGICbin_MG(eq_amg, AMGf_set);
{
dPOPTOPiirl_nomg;
PP(pp_i_ne)
{
- dVAR; dSP;
+ dSP;
tryAMAGICbin_MG(ne_amg, AMGf_set);
{
dPOPTOPiirl_nomg;
PP(pp_i_ncmp)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
tryAMAGICbin_MG(ncmp_amg, 0);
{
dPOPTOPiirl_nomg;
PP(pp_i_negate)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
tryAMAGICun_MG(neg_amg, 0);
if (S_negate_string(aTHX)) return NORMAL;
{
PP(pp_atan2)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
tryAMAGICbin_MG(atan2_amg, 0);
{
dPOPTOPnnrl_nomg;
PP(pp_sin)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
int amg_type = sin_amg;
const char *neg_report = NULL;
NV (*func)(NV) = Perl_sin;
PP(pp_rand)
{
- dVAR;
if (!PL_srand_called) {
(void)seedDrand01((Rand_seed_t)seed());
PL_srand_called = TRUE;
PP(pp_srand)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
UV anum;
if (MAXARG >= 1 && (TOPs || POPs)) {
PP(pp_int)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
tryAMAGICun_MG(int_amg, AMGf_numeric);
{
SV * const sv = TOPs;
PP(pp_abs)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
tryAMAGICun_MG(abs_amg, AMGf_numeric);
{
SV * const sv = TOPs;
PP(pp_oct)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const char *tmps;
I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
STRLEN len;
PP(pp_length)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
SV * const sv = TOPs;
SvGETMAGIC(sv);
PP(pp_substr)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
SV *sv;
STRLEN curlen;
STRLEN utf8_curlen;
PP(pp_vec)
{
- dVAR; dSP;
+ dSP;
const IV size = POPi;
const IV offset = POPi;
SV * const src = POPs;
PP(pp_index)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
SV *big;
SV *little;
SV *temp = NULL;
PP(pp_sprintf)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
SvTAINTED_off(TARG);
do_sprintf(TARG, SP-MARK, MARK+1);
TAINT_IF(SvTAINTED(TARG));
PP(pp_ord)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
SV *argsv = POPs;
STRLEN len;
PP(pp_chr)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
char *tmps;
UV value;
SV *top = POPs;
PP(pp_crypt)
{
#ifdef HAS_CRYPT
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
dPOPTOPssrl;
STRLEN len;
const char *tmps = SvPV_const(left, len);
* take the source and change that one character and store it back, but not
* if read-only etc, or if the length changes */
- dVAR;
dSP;
SV *source = TOPs;
STRLEN slen; /* slen is the byte length of the whole SV. */
of the three tight loops. There is less and less commonality though */
PP(pp_uc)
{
- dVAR;
dSP;
SV *source = TOPs;
STRLEN len;
PP(pp_lc)
{
- dVAR;
dSP;
SV *source = TOPs;
STRLEN len;
PP(pp_quotemeta)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
SV * const sv = TOPs;
STRLEN len;
const char *s = SvPV_const(sv,len);
PP(pp_fc)
{
- dVAR;
dTARGET;
dSP;
SV *source = TOPs;
PP(pp_aslice)
{
- dVAR; dSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
AV *const av = MUTABLE_AV(POPs);
const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
PP(pp_kvaslice)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
AV *const av = MUTABLE_AV(POPs);
I32 lval = (PL_op->op_flags & OPf_MOD);
SSize_t items = SP - MARK;
/* Smart dereferencing for keys, values and each */
PP(pp_rkeys)
{
- dVAR;
dSP;
dPOPss;
PP(pp_aeach)
{
- dVAR;
dSP;
AV *array = MUTABLE_AV(POPs);
const I32 gimme = GIMME_V;
PP(pp_akeys)
{
- dVAR;
dSP;
AV *array = MUTABLE_AV(POPs);
const I32 gimme = GIMME_V;
PP(pp_each)
{
- dVAR;
dSP;
HV * hash = MUTABLE_HV(POPs);
HE *entry;
STATIC OP *
S_do_delete_local(pTHX)
{
- dVAR;
dSP;
const I32 gimme = GIMME_V;
const MAGIC *mg;
PP(pp_delete)
{
- dVAR;
dSP;
I32 gimme;
I32 discard;
PP(pp_exists)
{
- dVAR;
dSP;
SV *tmpsv;
HV *hv;
PP(pp_hslice)
{
- dVAR; dSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
HV * const hv = MUTABLE_HV(POPs);
const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
PP(pp_kvhslice)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
HV * const hv = MUTABLE_HV(POPs);
I32 lval = (PL_op->op_flags & OPf_MOD);
SSize_t items = SP - MARK;
PP(pp_list)
{
- dVAR;
I32 markidx = POPMARK;
if (GIMME != G_ARRAY) {
SV **mark = PL_stack_base + markidx;
PP(pp_lslice)
{
- dVAR;
dSP;
SV ** const lastrelem = PL_stack_sp;
SV ** const lastlelem = PL_stack_base + POPMARK;
PP(pp_anonlist)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
const I32 items = SP - MARK;
SV * const av = MUTABLE_SV(av_make(items, MARK+1));
SP = MARK;
PP(pp_anonhash)
{
- dVAR; dSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
HV* const hv = newHV();
SV* const retval = sv_2mortal( PL_op->op_flags & OPf_SPECIAL
? newRV_noinc(MUTABLE_SV(hv))
PP(pp_splice)
{
- dVAR; dSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
int num_args = (SP - MARK);
AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
SV **src;
PP(pp_push)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
AV * const ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
PP(pp_shift)
{
- dVAR;
dSP;
AV * const av = PL_op->op_flags & OPf_SPECIAL
? MUTABLE_AV(GvAV(PL_defgv)) : DEREF_PLAIN_ARRAY(MUTABLE_AV(POPs));
PP(pp_unshift)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
PP(pp_reverse)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
if (GIMME == G_ARRAY) {
if (PL_op->op_private & OPpREVERSE_INPLACE) {
PP(pp_split)
{
- dVAR; dSP; dTARG;
+ dSP; dTARG;
AV *ary;
IV limit = POPi; /* note, negative is forever */
SV * const sv = POPs;
PP(pp_lock)
{
- dVAR;
dSP;
dTOPss;
SV *retsv = sv;
PP(unimplemented_op)
{
- dVAR;
const Optype op_type = PL_op->op_type;
/* Using OP_NAME() isn't going to be helpful here. Firstly, it doesn't cope
with out of range op numbers - it only "special" cases op_custom.
PP(pp_wantarray)
{
- dVAR;
dSP;
I32 cxix;
const PERL_CONTEXT *cx;
PP(pp_regcreset)
{
- dVAR;
TAINT_NOT;
return NORMAL;
}
PP(pp_regcomp)
{
- dVAR;
dSP;
PMOP *pm = (PMOP*)cLOGOP->op_other;
SV **args;
PP(pp_substcont)
{
- dVAR;
dSP;
PERL_CONTEXT *cx = &cxstack[cxstack_ix];
PMOP * const pm = (PMOP*) cLOGOP->op_other;
PP(pp_formline)
{
- dVAR; dSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
SV * const tmpForm = *++MARK;
SV *formsv; /* contains text of original format */
U32 *fpc; /* format ops program counter */
PP(pp_grepstart)
{
- dVAR; dSP;
+ dSP;
SV *src;
if (PL_stack_base + *PL_markstack_ptr == SP) {
PP(pp_mapwhile)
{
- dVAR; dSP;
+ dSP;
const I32 gimme = GIMME_V;
I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
I32 count;
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)
{
- dVAR; dSP;
+ dSP;
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
STATIC I32
S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags)
{
- dVAR;
I32 i;
PERL_ARGS_ASSERT_DOPOPTOLABEL;
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 */
I32
Perl_was_lvalue_sub(pTHX)
{
- dVAR;
const I32 cxix = dopoptosub(cxstack_ix-1);
assert(cxix >= 0); /* We should only be called from inside subs */
STATIC I32
S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
{
- dVAR;
I32 i;
PERL_ARGS_ASSERT_DOPOPTOSUB_AT;
STATIC I32
S_dopoptoeval(pTHX_ I32 startingblock)
{
- dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
const PERL_CONTEXT *cx = &cxstack[i];
STATIC I32
S_dopoptoloop(pTHX_ I32 startingblock)
{
- dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
const PERL_CONTEXT * const cx = &cxstack[i];
STATIC I32
S_dopoptogiven(pTHX_ I32 startingblock)
{
- dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
const PERL_CONTEXT *cx = &cxstack[i];
STATIC I32
S_dopoptowhen(pTHX_ I32 startingblock)
{
- dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
const PERL_CONTEXT *cx = &cxstack[i];
void
Perl_dounwind(pTHX_ I32 cxix)
{
- dVAR;
I32 optype;
if (!PL_curstackinfo) /* can happen if die during thread cloning */
void
Perl_qerror(pTHX_ SV *err)
{
- dVAR;
-
PERL_ARGS_ASSERT_QERROR;
if (PL_in_eval) {
void
Perl_die_unwind(pTHX_ SV *msv)
{
- dVAR;
SV *exceptsv = sv_mortalcopy(msv);
U8 in_eval = PL_in_eval;
PERL_ARGS_ASSERT_DIE_UNWIND;
PP(pp_xor)
{
- dVAR; dSP; dPOPTOPssrl;
+ dSP; dPOPTOPssrl;
if (SvTRUE(left) != SvTRUE(right))
RETSETYES;
else
PP(pp_caller)
{
- dVAR;
dSP;
const PERL_CONTEXT *cx;
const PERL_CONTEXT *dbcx;
PP(pp_reset)
{
- dVAR;
dSP;
const char * tmps;
STRLEN len = 0;
PP(pp_dbstate)
{
- 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_enter)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
PP(pp_leave)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
SV **newsp;
PMOP *newpm;
PP(pp_enteriter)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
void *itervar; /* location of the iteration variable */
PP(pp_enterloop)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
PP(pp_leaveloop)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
PP(pp_return)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
PERL_CONTEXT *cx;
bool popsub2 = FALSE;
bool clear_errsv = FALSE;
* pp_return */
PP(pp_leavesublv)
{
- dVAR; dSP;
+ dSP;
SV **newsp;
PMOP *newpm;
I32 gimme;
static I32
S_unwind_loop(pTHX_ const char * const opname)
{
- dVAR;
I32 cxix;
if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
PP(pp_last)
{
- dVAR;
PERL_CONTEXT *cx;
I32 pop2 = 0;
I32 gimme;
PP(pp_next)
{
- dVAR;
PERL_CONTEXT *cx;
const I32 inner = PL_scopestack_ix;
PP(pp_redo)
{
- dVAR;
const I32 cxix = S_unwind_loop(aTHX_ "redo");
PERL_CONTEXT *cx;
I32 oldsave;
STATIC OP *
S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstack, OP **oplimit)
{
- dVAR;
OP **ops = opstack;
static const char* const too_deep = "Target of goto is too deeply nested";
PP(pp_exit)
{
- dVAR;
dSP;
I32 anum;
STATIC OP *
S_docatch(pTHX_ OP *o)
{
- dVAR;
int ret;
OP * const oldop = PL_op;
dJMPENV;
CV *
Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp)
{
- dVAR;
PERL_SI *si;
int level = 0;
STATIC bool
S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
{
- dVAR; dSP;
+ dSP;
OP * const saveop = PL_op;
bool clear_hints = saveop->op_type != OP_ENTEREVAL;
COP * const oldcurcop = PL_curcop;
PP(pp_require)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
SV *sv;
const char *name;
PP(pp_hintseval)
{
- dVAR;
dSP;
mXPUSHs(MUTABLE_SV(hv_copy_hints_hv(MUTABLE_HV(cSVOP_sv))));
RETURN;
PP(pp_entereval)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
SV *sv;
const I32 gimme = GIMME_V;
PP(pp_leaveeval)
{
- dVAR; dSP;
+ dSP;
SV **newsp;
PMOP *newpm;
I32 gimme;
PP(pp_entertry)
{
- dVAR;
PERL_CONTEXT * const cx = create_eval_scope(0);
cx->blk_eval.retop = cLOGOP->op_other->op_next;
return DOCATCH(PL_op->op_next);
PP(pp_leavetry)
{
- dVAR; dSP;
+ dSP;
SV **newsp;
PMOP *newpm;
I32 gimme;
PP(pp_entergiven)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
PP(pp_leavegiven)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
STATIC PMOP *
S_make_matcher(pTHX_ REGEXP *re)
{
- dVAR;
PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED);
PERL_ARGS_ASSERT_MAKE_MATCHER;
STATIC bool
S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
{
- dVAR;
dSP;
PERL_ARGS_ASSERT_MATCHER_MATCHES_SV;
STATIC void
S_destroy_matcher(pTHX_ PMOP *matcher)
{
- dVAR;
-
PERL_ARGS_ASSERT_DESTROY_MATCHER;
PERL_UNUSED_ARG(matcher);
STATIC OP *
S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
{
- dVAR;
dSP;
bool object_on_left = FALSE;
PP(pp_enterwhen)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
PP(pp_leavewhen)
{
- dVAR; dSP;
+ dSP;
I32 cxix;
PERL_CONTEXT *cx;
I32 gimme;
PP(pp_continue)
{
- dVAR; dSP;
+ dSP;
I32 cxix;
PERL_CONTEXT *cx;
I32 gimme;
PP(pp_break)
{
- dVAR;
I32 cxix;
PERL_CONTEXT *cx;
static I32
S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
{
- dVAR;
SV * const datasv = FILTER_DATA(idx);
const int filter_has_file = IoLINES(datasv);
SV * const filter_state = MUTABLE_SV(IoTOP_GV(datasv));
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 (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO))
PP(pp_null)
{
- dVAR;
return NORMAL;
}
/* This is sometimes called directly by pp_coreargs and pp_grepstart. */
PP(pp_pushmark)
{
- dVAR;
PUSHMARK(PL_stack_sp);
return NORMAL;
}
PP(pp_stringify)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
SV * const sv = TOPs;
SETs(TARG);
sv_copypv(TARG, sv);
PP(pp_gv)
{
- dVAR; dSP;
+ dSP;
XPUSHs(MUTABLE_SV(cGVOP_gv));
RETURN;
}
PP(pp_and)
{
- dVAR;
PERL_ASYNC_CHECK();
{
/* SP is not used to remove a variable that is saved across the
PP(pp_sassign)
{
- dVAR; dSP;
+ dSP;
/* sassign keeps its args in the optree traditionally backwards.
So we pop them differently.
*/
PP(pp_cond_expr)
{
- dVAR; dSP;
+ dSP;
PERL_ASYNC_CHECK();
if (SvTRUEx(POPs))
RETURNOP(cLOGOP->op_other);
PP(pp_unstack)
{
- dVAR;
PERL_ASYNC_CHECK();
TAINT_NOT; /* Each statement is presumed innocent */
PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
PP(pp_concat)
{
- dVAR; dSP; dATARGET; tryAMAGICbin_MG(concat_amg, AMGf_assign);
+ dSP; dATARGET; tryAMAGICbin_MG(concat_amg, AMGf_assign);
{
dPOPTOPssrl;
bool lbyte;
PP(pp_padrange)
{
- dVAR; dSP;
+ dSP;
PADOFFSET base = PL_op->op_targ;
int count = (int)(PL_op->op_private) & OPpPADRANGE_COUNTMASK;
int i;
PP(pp_padsv)
{
- dVAR; dSP;
+ dSP;
EXTEND(SP, 1);
{
OP * const op = PL_op;
PP(pp_readline)
{
- dVAR;
dSP;
if (TOPs) {
SvGETMAGIC(TOPs);
PP(pp_eq)
{
- dVAR; dSP;
+ dSP;
SV *left, *right;
tryAMAGICbin_MG(eq_amg, AMGf_set|AMGf_numeric);
PP(pp_preinc)
{
- dVAR; dSP;
+ dSP;
const bool inc =
PL_op->op_type == OP_PREINC || PL_op->op_type == OP_I_PREINC;
if (UNLIKELY(SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs))))
PP(pp_or)
{
- dVAR; dSP;
+ dSP;
PERL_ASYNC_CHECK();
if (SvTRUE(TOPs))
RETURN;
PP(pp_defined)
{
- dVAR; dSP;
+ dSP;
SV* sv;
bool defined;
const int op_type = PL_op->op_type;
PP(pp_add)
{
- dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr;
+ dSP; dATARGET; bool useleft; SV *svl, *svr;
tryAMAGICbin_MG(add_amg, AMGf_assign|AMGf_numeric);
svr = TOPs;
svl = TOPm1s;
PP(pp_aelemfast)
{
- dVAR; dSP;
+ dSP;
AV * const av = PL_op->op_type == OP_AELEMFAST_LEX
? MUTABLE_AV(PAD_SV(PL_op->op_targ)) : GvAVn(cGVOP_gv);
const U32 lval = PL_op->op_flags & OPf_MOD;
PP(pp_join)
{
- dVAR; dSP; dMARK; dTARGET;
+ dSP; dMARK; dTARGET;
MARK++;
do_join(TARG, *MARK, MARK, SP);
SP = MARK;
PP(pp_pushre)
{
- dVAR; dSP;
+ dSP;
#ifdef DEBUGGING
/*
* We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
PP(pp_print)
{
- dVAR; dSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
PerlIO *fp;
MAGIC *mg;
GV * const gv
PP(pp_rv2av)
{
- dVAR; dSP; dTOPss;
+ dSP; dTOPss;
const I32 gimme = GIMME_V;
static const char an_array[] = "an ARRAY";
static const char a_hash[] = "a HASH";
STATIC void
S_do_oddball(pTHX_ SV **oddkey, SV **firstkey)
{
- dVAR;
-
PERL_ARGS_ASSERT_DO_ODDBALL;
if (*oddkey) {
PP(pp_qr)
{
- dVAR; dSP;
+ dSP;
PMOP * const pm = cPMOP;
REGEXP * rx = PM_GETRE(pm);
SV * const pkg = rx ? CALLREG_PACKAGE(rx) : NULL;
PP(pp_match)
{
- dVAR; dSP; dTARG;
+ dSP; dTARG;
PMOP *pm = cPMOP;
PMOP *dynpm = pm;
const char *s;
OP *
Perl_do_readline(pTHX)
{
- dVAR; dSP; dTARGETSTACKED;
+ dSP; dTARGETSTACKED;
SV *sv;
STRLEN tmplen = 0;
STRLEN offset;
PP(pp_helem)
{
- dVAR; dSP;
+ dSP;
HE* he;
SV **svp;
SV * const keysv = POPs;
PP(pp_iter)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
SV *oldsv;
SV **itersvp;
PP(pp_subst)
{
- dVAR; dSP; dTARG;
+ dSP; dTARG;
PMOP *pm = cPMOP;
PMOP *rpm = pm;
char *s;
PP(pp_grepwhile)
{
- dVAR; dSP;
+ dSP;
if (SvTRUEx(POPs))
PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
PP(pp_leavesub)
{
- dVAR; dSP;
+ dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
PP(pp_entersub)
{
- dVAR; dSP; dPOPss;
+ dSP; dPOPss;
GV *gv;
CV *cv;
PERL_CONTEXT *cx;
PP(pp_aelem)
{
- dVAR; dSP;
+ dSP;
SV** svp;
SV* const elemsv = POPs;
IV elem = SvIV(elemsv);
PP(pp_method)
{
- dVAR; dSP;
+ dSP;
SV* const sv = TOPs;
if (SvROK(sv)) {
PP(pp_method_named)
{
- dVAR; dSP;
+ 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) ||
STATIC I32
S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const char *strend, const char **new_s )
{
- dVAR; dSP;
+ dSP;
SV *sv = NULL;
const I32 start_sp_offset = SP - PL_stack_base;
howlen_t howlen;
PP(pp_unpack)
{
- dVAR;
dSP;
dPOPPOPssrl;
I32 gimme = GIMME_V;
void
Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist )
{
- dVAR;
tempsym_t sym;
PERL_ARGS_ASSERT_PACKLIST;
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)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
SV *cat = TARG;
STRLEN fromlen;
SV *pat_sv = *++MARK;
static I32
cmp_desc(pTHX_ gptr const a, gptr const 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;
gptr *f1, *f2, *t, *b, *p;
static I32
cmpindir(pTHX_ gptr const a, gptr const 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 const a, gptr const 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) {
gptr **pp, *q;
size_t n, j, i;
PP(pp_sort)
{
- dVAR; dSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
SV **p1 = ORIGMARK+1, **p2;
SSize_t max, i;
AV* av = NULL;
static I32
S_sortcv(pTHX_ SV *const a, SV *const b)
{
- dVAR;
const I32 oldsaveix = PL_savestack_ix;
const I32 oldscopeix = PL_scopestack_ix;
I32 result;
static I32
S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
{
- dVAR;
const I32 oldsaveix = PL_savestack_ix;
const I32 oldscopeix = PL_scopestack_ix;
I32 result;
static I32
S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
{
- dVAR; dSP;
+ dSP;
const I32 oldsaveix = PL_savestack_ix;
const I32 oldscopeix = PL_scopestack_ix;
CV * const cv=MUTABLE_CV(PL_sortcop);
static I32
S_amagic_ncmp(pTHX_ SV *const a, SV *const b)
{
- dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
PERL_ARGS_ASSERT_AMAGIC_NCMP;
static I32
S_amagic_i_ncmp(pTHX_ SV *const a, SV *const b)
{
- dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
PERL_ARGS_ASSERT_AMAGIC_I_NCMP;
static I32
S_amagic_cmp(pTHX_ SV *const str1, SV *const str2)
{
- dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
PERL_ARGS_ASSERT_AMAGIC_CMP;
static I32
S_amagic_cmp_locale(pTHX_ SV *const str1, SV *const str2)
{
- dVAR;
SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
PERL_ARGS_ASSERT_AMAGIC_CMP_LOCALE;
PP(pp_backtick)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
PerlIO *fp;
const char * const tmps = POPpconstx;
const I32 gimme = GIMME_V;
PP(pp_glob)
{
- dVAR;
OP *result;
dSP;
GV * const gv = (PL_op->op_flags & OPf_SPECIAL) ? NULL : (GV *)POPs;
PP(pp_rcatline)
{
- dVAR;
PL_last_in_gv = cGVOP_gv;
return do_readline();
}
PP(pp_warn)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
SV *exsv;
STRLEN len;
if (SP - MARK > 1) {
PP(pp_die)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
SV *exsv;
STRLEN len;
#ifdef VMS
PP(pp_open)
{
- dVAR; dSP;
+ dSP;
dMARK; dORIGMARK;
dTARGET;
SV *sv;
PP(pp_close)
{
- dVAR; dSP;
+ dSP;
GV * const gv =
MAXARG == 0 || (!TOPs && !POPs) ? PL_defoutgv : MUTABLE_GV(POPs);
PP(pp_pipe_op)
{
#ifdef HAS_PIPE
- dVAR;
dSP;
IO *rstio;
IO *wstio;
PP(pp_fileno)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_umask)
{
- dVAR;
dSP;
#ifdef HAS_UMASK
dTARGET;
PP(pp_binmode)
{
- dVAR; dSP;
+ dSP;
GV *gv;
IO *io;
PerlIO *fp;
PP(pp_tie)
{
- dVAR; dSP; dMARK;
+ dSP; dMARK;
HV* stash;
GV *gv = NULL;
SV *sv;
PP(pp_untie)
{
- dVAR; dSP;
+ dSP;
MAGIC *mg;
SV *sv = POPs;
const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
PP(pp_tied)
{
- dVAR;
dSP;
const MAGIC *mg;
dTOPss;
PP(pp_dbmopen)
{
- dVAR; dSP;
+ dSP;
dPOPPOPssrl;
HV* stash;
GV *gv = NULL;
PP(pp_sselect)
{
#ifdef HAS_SELECT
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
I32 i;
I32 j;
char *s;
void
Perl_setdefout(pTHX_ GV *gv)
{
- dVAR;
PERL_ARGS_ASSERT_SETDEFOUT;
SvREFCNT_inc_simple_void_NN(gv);
SvREFCNT_dec(PL_defoutgv);
PP(pp_select)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
HV *hv;
GV * const newdefout = (PL_op->op_private > 0) ? (MUTABLE_GV(POPs)) : NULL;
GV * egv = GvEGVx(PL_defoutgv);
PP(pp_getc)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
GV * const gv =
MAXARG==0 || (!TOPs && !POPs) ? PL_stdingv : MUTABLE_GV(POPs);
IO *const io = GvIO(gv);
STATIC OP *
S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
{
- dVAR;
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
PP(pp_enterwrite)
{
- dVAR;
dSP;
GV *gv;
IO *io;
PP(pp_leavewrite)
{
- dVAR; dSP;
+ dSP;
GV * const gv = cxstack[cxstack_ix].blk_format.gv;
IO * const io = GvIOp(gv);
PerlIO *ofp;
PP(pp_prtf)
{
- dVAR; dSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
PerlIO *fp;
GV * const gv
PP(pp_sysopen)
{
- dVAR;
dSP;
const int perm = (MAXARG > 3 && (TOPs || POPs)) ? POPi : 0666;
const int mode = POPi;
PP(pp_sysread)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
SSize_t offset;
IO *io;
char *buffer;
PP(pp_syswrite)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
SV *bufsv;
const char *buffer;
SSize_t retval;
PP(pp_eof)
{
- dVAR; dSP;
+ dSP;
GV *gv;
IO *io;
const MAGIC *mg;
PP(pp_tell)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
GV *gv;
IO *io;
PP(pp_sysseek)
{
- dVAR; dSP;
+ dSP;
const int whence = POPi;
#if LSEEKSIZE > IVSIZE
const Off_t offset = (Off_t)SvNVx(POPs);
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)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
SV * const argsv = POPs;
const unsigned int func = POPu;
int optype;
PP(pp_flock)
{
#ifdef FLOCK
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
I32 value;
const int argtype = POPi;
GV * const gv = MUTABLE_GV(POPs);
PP(pp_socket)
{
- dVAR; dSP;
+ 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))
- dVAR; dSP;
+ dSP;
int fd[2];
const int protocol = POPi;
const int type = POPi;
PP(pp_bind)
{
- dVAR; dSP;
+ dSP;
SV * const addrsv = POPs;
/* OK, so on what platform does bind modify addr? */
const char *addr;
PP(pp_listen)
{
- dVAR; dSP;
+ dSP;
const int backlog = POPi;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
PP(pp_accept)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
IO *nstio;
char namebuf[MAXPATHLEN];
#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
PP(pp_shutdown)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const int how = POPi;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
PP(pp_ssockopt)
{
- dVAR; dSP;
+ dSP;
const int optype = PL_op->op_type;
SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(newSV(257)) : POPs;
const unsigned int optname = (unsigned int) POPi;
PP(pp_getpeername)
{
- dVAR; dSP;
+ dSP;
const int optype = PL_op->op_type;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
PP(pp_stat)
{
- dVAR;
dSP;
GV *gv = NULL;
IO *io = NULL;
STATIC OP *
S_try_amagic_ftest(pTHX_ char chr) {
- dVAR;
SV *const arg = *PL_stack_sp;
assert(chr != '?');
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;
char opchar = '?';
PP(pp_ftrowned)
{
- dVAR;
I32 result;
char opchar = '?';
PP(pp_ftlink)
{
- dVAR;
I32 result;
tryAMAGICftest_MG('l');
PP(pp_fttty)
{
- dVAR;
int fd;
GV *gv;
char *name = NULL;
PP(pp_fttext)
{
- dVAR;
I32 i;
SSize_t len;
I32 odd = 0;
PP(pp_chdir)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const char *tmps = NULL;
GV *gv = NULL;
PP(pp_chown)
{
- dVAR; dSP; dMARK; dTARGET;
+ dSP; dMARK; dTARGET;
const I32 value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
PP(pp_chroot)
{
#ifdef HAS_CHROOT
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
char * const tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
PP(pp_rename)
{
- dVAR; dSP; dTARGET;
+ 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)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const int op_type = PL_op->op_type;
int result;
PP(pp_readlink)
{
- dVAR;
dSP;
#ifdef HAS_SYMLINK
dTARGET;
PP(pp_mkdir)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
STRLEN len;
const char *tmps;
bool copy = FALSE;
PP(pp_rmdir)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
STRLEN len;
const char *tmps;
bool copy = FALSE;
PP(pp_open_dir)
{
#if defined(Direntry_t) && defined(HAS_READDIR)
- dVAR; dSP;
+ dSP;
const char * const dirname = POPpconstx;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
#if !defined(I_DIRENT) && !defined(VMS)
Direntry_t *readdir (DIR *);
#endif
- dVAR;
dSP;
SV *sv;
PP(pp_telldir)
{
#if defined(HAS_TELLDIR) || defined(telldir)
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
/* XXX does _anyone_ need this? --AD 2/20/1998 */
/* XXX netbsd still seemed to.
XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style.
PP(pp_seekdir)
{
#if defined(HAS_SEEKDIR) || defined(seekdir)
- dVAR; dSP;
+ dSP;
const long along = POPl;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
PP(pp_rewinddir)
{
#if defined(HAS_REWINDDIR) || defined(rewinddir)
- dVAR; dSP;
+ dSP;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
PP(pp_closedir)
{
#if defined(Direntry_t) && defined(HAS_READDIR)
- dVAR; dSP;
+ dSP;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
PP(pp_fork)
{
#ifdef HAS_FORK
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
Pid_t childpid;
#ifdef HAS_SIGPROCMASK
sigset_t oldmask, newmask;
PP(pp_wait)
{
#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
Pid_t childpid;
int argflags;
PP(pp_waitpid)
{
#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const int optype = POPi;
const Pid_t pid = TOPi;
Pid_t result;
PP(pp_system)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
#if defined(__LIBCATAMOUNT__)
PL_statusvalue = -1;
SP = ORIGMARK;
PP(pp_exec)
{
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
I32 value;
if (TAINTING_get) {
PP(pp_getppid)
{
#ifdef HAS_GETPPID
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
XPUSHi( getppid() );
RETURN;
#else
PP(pp_getpgrp)
{
#ifdef HAS_GETPGRP
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
Pid_t pgrp;
const Pid_t pid =
(MAXARG < 1) ? 0 : TOPs ? SvIVx(POPs) : ((void)POPs, 0);
PP(pp_setpgrp)
{
#ifdef HAS_SETPGRP
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
Pid_t pgrp;
Pid_t pid;
pgrp = MAXARG == 2 && (TOPs||POPs) ? POPi : 0;
PP(pp_getpriority)
{
#ifdef HAS_GETPRIORITY
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const int who = POPi;
const int which = TOPi;
SETi( getpriority(PRIORITY_WHICH_T(which), who) );
PP(pp_setpriority)
{
#ifdef HAS_SETPRIORITY
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
const int niceval = POPi;
const int who = POPi;
const int which = TOPi;
PP(pp_time)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
#ifdef BIG_TIME
XPUSHn( time(NULL) );
#else
PP(pp_tms)
{
#ifdef HAS_TIMES
- dVAR;
dSP;
struct tms timesbuf;
PP(pp_gmtime)
{
- dVAR;
dSP;
Time64_T when;
struct TM tmbuf;
PP(pp_alarm)
{
#ifdef HAS_ALARM
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
int anum;
anum = POPi;
anum = alarm((unsigned int)anum);
PP(pp_sleep)
{
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
I32 duration;
Time_t lasttime;
Time_t when;
PP(pp_shmwrite)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- dVAR; dSP; dMARK; dTARGET;
+ 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)
- dVAR; dSP; dMARK; dTARGET;
+ 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)
- dVAR; dSP; dMARK; dTARGET;
+ 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)
- dVAR; dSP;
+ dSP;
I32 which = PL_op->op_type;
char **elem;
SV *sv;
PP(pp_gnetent)
{
#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
- dVAR; dSP;
+ dSP;
I32 which = PL_op->op_type;
SV *sv;
#ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
PP(pp_gprotoent)
{
#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
- dVAR; dSP;
+ dSP;
I32 which = PL_op->op_type;
SV *sv;
#ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
PP(pp_gservent)
{
#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
- dVAR; dSP;
+ dSP;
I32 which = PL_op->op_type;
SV *sv;
#ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
PP(pp_shostent)
{
- dVAR; dSP;
+ dSP;
const int stayopen = TOPi;
switch(PL_op->op_type) {
case OP_SHOSTENT:
PP(pp_ehostent)
{
- dVAR; dSP;
+ dSP;
switch(PL_op->op_type) {
case OP_EHOSTENT:
#ifdef HAS_ENDHOSTENT
PP(pp_gpwent)
{
#ifdef HAS_PASSWD
- dVAR; dSP;
+ dSP;
I32 which = PL_op->op_type;
SV *sv;
struct passwd *pwent = NULL;
PP(pp_ggrent)
{
#ifdef HAS_GROUP
- dVAR; dSP;
+ dSP;
const I32 which = PL_op->op_type;
const struct group *grent;
PP(pp_getlogin)
{
#ifdef HAS_GETLOGIN
- dVAR; dSP; dTARGET;
+ dSP; dTARGET;
char *tmps;
EXTEND(SP, 1);
if (!(tmps = PerlProc_getlogin()))
PP(pp_syscall)
{
#ifdef HAS_SYSCALL
- dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
I32 items = SP - MARK;
unsigned long a[20];
I32 i = 0;
regnode *first, regnode *last, regnode *tail,
U32 word_count, U32 flags, U32 depth)
{
- dVAR;
/* first pass, loop through and scan words */
reg_trie_data *trie;
HV *widecharmap = NULL;
/* recursed: which subroutines have we recursed into */
/* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
{
- dVAR;
/* There must be at least this number of characters to match */
SSize_t min = 0;
I32 pars = 0, code;
void
Perl_reginitcolors(pTHX)
{
- dVAR;
const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
if (s) {
char *t = savepv(s);
regexp_engine const *
Perl_current_re_engine(pTHX)
{
- dVAR;
-
if (IN_PERL_COMPILETIME) {
HV * const table = GvHV(PL_hintgv);
SV **ptr;
REGEXP *
Perl_pregcomp(pTHX_ SV * const pattern, const U32 flags)
{
- dVAR;
regexp_engine const *eng = current_re_engine();
GET_RE_DEBUG_FLAGS_DECL;
OP *expr, const regexp_engine* eng, REGEXP *old_re,
bool *is_bare_re, U32 orig_rx_flags, U32 pm_flags)
{
- dVAR;
REGEXP *rx;
struct regexp *r;
regexp_internal *ri;
* RExC_parse beyond the '('. Things like '(?' are indivisible tokens, and
* this flag alerts us to the need to check for that */
{
- dVAR;
regnode *ret; /* Will be the head of the group. */
regnode *br;
regnode *lastbr;
STATIC regnode *
S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth)
{
- dVAR;
regnode *ret;
regnode *chain = NULL;
regnode *latest;
STATIC regnode *
S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
{
- dVAR;
regnode *ret;
char op;
char *next;
STATIC regnode *
S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
{
- dVAR;
regnode *ret = NULL;
I32 flags = 0;
char *parse_start = RExC_parse;
PERL_STATIC_INLINE I32
S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value, const bool strict)
{
- dVAR;
I32 namedclass = OOB_NAMEDCLASS;
PERL_ARGS_ASSERT_REGPPOSIXCC;
* to be restarted. This can only happen if ret_invlist is non-NULL.
*/
- dVAR;
UV prevvalue = OOB_UNICODE, save_prevvalue = OOB_UNICODE;
IV range = 0;
UV value = OOB_UNICODE, save_value = OOB_UNICODE;
STATIC regnode * /* Location. */
S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op)
{
- dVAR;
regnode *ptr;
regnode * const ret = RExC_emit;
GET_RE_DEBUG_FLAGS_DECL;
STATIC regnode * /* Location. */
S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg)
{
- dVAR;
regnode *ptr;
regnode * const ret = RExC_emit;
GET_RE_DEBUG_FLAGS_DECL;
PERL_STATIC_INLINE STRLEN
S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s)
{
- dVAR;
-
PERL_ARGS_ASSERT_REGUNI;
return 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, U32 depth)
{
- dVAR;
regnode *src;
regnode *dst;
regnode *place;
S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p,
const regnode *val,U32 depth)
{
- dVAR;
regnode *scan;
GET_RE_DEBUG_FLAGS_DECL;
SV *
Perl_re_intuit_string(pTHX_ REGEXP * const r)
{ /* Assume that RE_INTUIT is set */
- dVAR;
struct regexp *const prog = ReANY(r);
GET_RE_DEBUG_FLAGS_DECL;
void
Perl_pregfree2(pTHX_ REGEXP *rx)
{
- dVAR;
struct regexp *const r = ReANY(rx);
GET_RE_DEBUG_FLAGS_DECL;
void
Perl_regfree_internal(pTHX_ REGEXP * const rx)
{
- dVAR;
struct regexp *const r = ReANY(rx);
RXi_GET_DECL(r,ri);
GET_RE_DEBUG_FLAGS_DECL;
Used in stclass optimization only */
U32 refcount;
reg_ac_data *aho=(reg_ac_data*)ri->data->data[n];
+#ifdef USE_ITHREADS
+ dVAR;
+#endif
OP_REFCNT_LOCK;
refcount = --aho->refcount;
OP_REFCNT_UNLOCK;
/* trie structure. */
U32 refcount;
reg_trie_data *trie=(reg_trie_data*)ri->data->data[n];
+#ifdef USE_ITHREADS
+ dVAR;
+#endif
OP_REFCNT_LOCK;
refcount = --trie->refcount;
OP_REFCNT_UNLOCK;
regnode *
Perl_regnext(pTHX_ regnode *p)
{
- dVAR;
I32 offset;
if (!p)
void
Perl_save_re_context(pTHX)
{
- dVAR;
-
/* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */
if (PL_curpm) {
const REGEXP * const rx = PM_GETRE(PL_curpm);
I32
Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
{
- dVAR;
-
PERL_ARGS_ASSERT_KEYWORD;
$switch
STATIC CHECKPOINT
S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen)
{
- dVAR;
const int retval = PL_savestack_ix;
const int paren_elems_to_push =
(maxopenparen - parenfloor) * REGCP_PAREN_ELEMS;
STATIC void
S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p)
{
- dVAR;
UV i;
U32 paren;
GET_RE_DEBUG_FLAGS_DECL;
const U32 flags,
re_scream_pos_data *data)
{
- dVAR;
struct regexp *const prog = ReANY(rx);
SSize_t start_shift = prog->check_offset_min;
/* Should be nonnegative! */
/* flags: For optimizations. See REXEC_* in regexp.h */
{
- dVAR;
struct regexp *const prog = ReANY(rx);
char *s;
regnode *c;
STATIC I32 /* 0 failure, 1 success */
S_regtry(pTHX_ regmatch_info *reginfo, char **startposp)
{
- dVAR;
CHECKPOINT lastcp;
REGEXP *const rx = reginfo->prog;
regexp *const prog = ReANY(rx);
S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
regmatch_info *const reginfo, I32 max, int depth)
{
- dVAR;
char *scan; /* Pointer to current position in target string */
I32 c;
char *loceol = reginfo->strend; /* local version */
* swash are returned (in a printable form).
* Tied intimately to how regcomp.c sets up the data structure */
- dVAR;
SV *sw = NULL;
SV *si = NULL; /* Input swash initialization string */
SV* invlist = NULL;
* 'off' >= 0, backwards if negative. But don't go outside of position
* 'lim', which better be < s if off < 0 */
- dVAR;
-
PERL_ARGS_ASSERT_REGHOP3;
if (off >= 0) {
STATIC U8 *
S_reghop4(U8 *s, SSize_t off, const U8* llim, const U8* rlim)
{
- dVAR;
-
PERL_ARGS_ASSERT_REGHOP4;
if (off >= 0) {
STATIC U8 *
S_reghopmaybe3(U8* s, SSize_t off, const U8* lim)
{
- dVAR;
-
PERL_ARGS_ASSERT_REGHOPMAYBE3;
if (off >= 0) {
static void
S_cleanup_regmatch_info_aux(pTHX_ void *arg)
{
- dVAR;
regmatch_info_aux *aux = (regmatch_info_aux *) arg;
regmatch_info_aux_eval *eval_state = aux->info_aux_eval;
regmatch_slab *s;
/* Converts substr fields in prog from UTF-8 to bytes, calling fbm_compile
* on the converted value; returns FALSE if can't be converted. */
- dVAR;
int i = 1;
PERL_ARGS_ASSERT_TO_BYTE_SUBSTR;
int
Perl_runops_standard(pTHX)
{
- dVAR;
OP *op = PL_op;
OP_ENTRY_PROBE(OP_NAME(op));
while ((PL_op = op = op->op_ppaddr(aTHX))) {
SV**
Perl_stack_grow(pTHX_ SV **sp, SV **p, SSize_t n)
{
- dVAR;
-
PERL_ARGS_ASSERT_STACK_GROW;
PL_stack_sp = sp;
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);
void
Perl_push_scope(pTHX)
{
- dVAR;
if (UNLIKELY(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);
}
I32 *
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_ SSize_t 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 SSize_t myfloor = PL_tmps_floor;
while (PL_tmps_ix > myfloor) { /* clean up after last statement */
STATIC SV *
S_save_scalar_at(pTHX_ SV **sptr, const U32 flags)
{
- dVAR;
SV * osv;
SV *sv;
void
Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type)
{
- dVAR;
dSS_ADD;
SS_ADD_PTR(ptr1);
SS_ADD_PTR(ptr2);
SV *
Perl_save_scalar(pTHX_ GV *gv)
{
- dVAR;
SV ** const sptr = &GvSVn(gv);
PERL_ARGS_ASSERT_SAVE_SCALAR;
void
Perl_save_generic_svref(pTHX_ SV **sptr)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_GENERIC_SVREF;
save_pushptrptr(sptr, SvREFCNT_inc(*sptr), SAVEt_GENERIC_SVREF);
void
Perl_save_generic_pvref(pTHX_ char **str)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF;
save_pushptrptr(*str, str, SAVEt_GENERIC_PVREF);
void
Perl_save_shared_pvref(pTHX_ char **str)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_SHARED_PVREF;
save_pushptrptr(str, *str, SAVEt_SHARED_PVREF);
void
Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val)
{
- dVAR;
dSS_ADD;
PERL_ARGS_ASSERT_SAVE_SET_SVFLAGS;
void
Perl_save_gp(pTHX_ GV *gv, I32 empty)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_GP;
save_pushptrptr(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP);
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;
PERL_ARGS_ASSERT_SAVE_HASH;
void
Perl_save_item(pTHX_ SV *item)
{
- dVAR;
SV * const sv = newSVsv(item);
PERL_ARGS_ASSERT_SAVE_ITEM;
void
Perl_save_bool(pTHX_ bool *boolp)
{
- dVAR;
dSS_ADD;
PERL_ARGS_ASSERT_SAVE_BOOL;
void
Perl_save_pushi32ptr(pTHX_ const I32 i, void *const ptr, const int type)
{
- dVAR;
dSS_ADD;
SS_ADD_INT(i);
void
Perl_save_int(pTHX_ int *intp)
{
- dVAR;
const int i = *intp;
UV type = ((UV)((UV)i << SAVE_TIGHT_SHIFT) | SAVEt_INT_SMALL);
int size = 2;
void
Perl_save_I8(pTHX_ I8 *bytep)
{
- dVAR;
dSS_ADD;
PERL_ARGS_ASSERT_SAVE_I8;
void
Perl_save_I16(pTHX_ I16 *intp)
{
- dVAR;
dSS_ADD;
PERL_ARGS_ASSERT_SAVE_I16;
void
Perl_save_I32(pTHX_ I32 *intp)
{
- dVAR;
const I32 i = *intp;
UV type = ((I32)((U32)i << SAVE_TIGHT_SHIFT) | SAVEt_I32_SMALL);
int size = 2;
void
Perl_save_strlen(pTHX_ STRLEN *ptr)
{
- dVAR;
dSS_ADD;
PERL_ARGS_ASSERT_SAVE_STRLEN;
void
Perl_save_pptr(pTHX_ char **pptr)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_PPTR;
save_pushptrptr(*pptr, pptr, SAVEt_PPTR);
void
Perl_save_vptr(pTHX_ void *ptr)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_VPTR;
save_pushptrptr(*(char**)ptr, ptr, SAVEt_VPTR);
void
Perl_save_sptr(pTHX_ SV **sptr)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_SPTR;
save_pushptrptr(*sptr, sptr, SAVEt_SPTR);
void
Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off)
{
- dVAR;
dSS_ADD;
ASSERT_CURPAD_ACTIVE("save_padsv");
void
Perl_save_hptr(pTHX_ HV **hptr)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_HPTR;
save_pushptrptr(*hptr, hptr, SAVEt_HPTR);
void
Perl_save_aptr(pTHX_ AV **aptr)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_APTR;
save_pushptrptr(*aptr, aptr, SAVEt_APTR);
void
Perl_save_pushptr(pTHX_ void *const ptr, const int type)
{
- dVAR;
dSS_ADD;
SS_ADD_PTR(ptr);
SS_ADD_UV(type);
void
Perl_save_clearsv(pTHX_ SV **svp)
{
- dVAR;
const UV offset = svp - PL_curpad;
const UV offset_shifted = offset << SAVE_TIGHT_SHIFT;
void
Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_DELETE;
save_pushptri32ptr(key, klen, SvREFCNT_inc_simple(hv), SAVEt_DELETE);
void
Perl_save_adelete(pTHX_ AV *av, SSize_t key)
{
- dVAR;
dSS_ADD;
PERL_ARGS_ASSERT_SAVE_ADELETE;
void
Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
{
- dVAR;
dSS_ADD;
-
PERL_ARGS_ASSERT_SAVE_DESTRUCTOR;
SS_ADD_DPTR(f);
void
Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
{
- dVAR;
dSS_ADD;
SS_ADD_DXPTR(f);
void
Perl_save_hints(pTHX)
{
- dVAR;
COPHH *save_cophh = cophh_copy(CopHINTHASH_get(&PL_compiling));
if (PL_hints & HINT_LOCALIZE_HH) {
HV *oldhh = GvHV(PL_hintgv);
Perl_save_aelem_flags(pTHX_ AV *av, SSize_t idx, SV **sptr,
const U32 flags)
{
- dVAR; dSS_ADD;
+ dSS_ADD;
SV *sv;
PERL_ARGS_ASSERT_SAVE_AELEM_FLAGS;
void
Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
{
- dVAR;
SV *sv;
PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS;
SV*
Perl_save_svref(pTHX_ SV **sptr)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_SVREF;
SvGETMAGIC(*sptr);
I32
Perl_save_alloc(pTHX_ I32 size, I32 pad)
{
- dVAR;
const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
- (char*)PL_savestack);
const UV elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
void
Perl_leave_scope(pTHX_ I32 base)
{
- dVAR;
-
/* Localise the effects of the TAINT_NOT inside the loop. */
bool was = TAINT_get;
void
Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
{
- dVAR;
-
PERL_ARGS_ASSERT_CX_DUMP;
#ifdef DEBUGGING
STATIC SV*
S_more_sv(pTHX)
{
- dVAR;
SV* sv;
char *chunk; /* must use New here to match call to */
Newx(chunk,PERL_ARENA_SIZE,char); /* Safefree() in sv_free_arenas() */
static void
S_sv_add_arena(pTHX_ char *const ptr, const U32 size, const U32 flags)
{
- dVAR;
SV *const sva = MUTABLE_SV(ptr);
SV* sv;
SV* svend;
STATIC I32
S_visit(pTHX_ SVFUNC_t f, const U32 flags, const U32 mask)
{
- dVAR;
SV* sva;
I32 visited = 0;
static void
do_clean_objs(pTHX_ SV *const ref)
{
- dVAR;
assert (SvROK(ref));
{
SV * const target = SvRV(ref);
static void
do_clean_named_objs(pTHX_ SV *const sv)
{
- dVAR;
SV *obj;
assert(SvTYPE(sv) == SVt_PVGV);
assert(isGV_with_GP(sv));
static void
do_clean_named_io_objs(pTHX_ SV *const sv)
{
- dVAR;
SV *obj;
assert(SvTYPE(sv) == SVt_PVGV);
assert(isGV_with_GP(sv));
void
Perl_sv_clean_objs(pTHX)
{
- dVAR;
GV *olddef, *olderr;
PL_in_clean_objs = TRUE;
visit(do_clean_objs, SVf_ROK, SVf_ROK);
static void
do_clean_all(pTHX_ SV *const sv)
{
- dVAR;
if (sv == (const SV *) PL_fdpid || sv == (const SV *)PL_strtab) {
/* don't clean pid table and strtab */
return;
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;
unsigned int i;
Perl_more_bodies (pTHX_ const svtype sv_type, const size_t body_size,
const size_t arena_size)
{
- dVAR;
void ** const root = &PL_body_roots[sv_type];
struct arena_desc *adesc;
struct arena_set *aroot = (struct arena_set *) PL_body_arenas;
char *start;
const char *end;
const size_t good_arena_size = Perl_malloc_good_size(arena_size);
+#if defined(DEBUGGING) && defined(PERL_GLOBAL_STRUCT)
+ dVAR;
+#endif
#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
static bool done_sanity_check;
STATIC void *
S_new_body(pTHX_ const svtype sv_type)
{
- dVAR;
void *xpv;
new_body_inline(xpv, sv_type);
return xpv;
void
Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type)
{
- dVAR;
void* old_body;
void* new_body;
const svtype old_type = SvTYPE(sv);
void
Perl_sv_setiv(pTHX_ SV *const sv, const IV i)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_SETIV;
SV_CHECK_THINKFIRST_COW_DROP(sv);
void
Perl_sv_setnv(pTHX_ SV *const sv, const NV num)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_SETNV;
SV_CHECK_THINKFIRST_COW_DROP(sv);
STATIC void
S_not_a_number(pTHX_ SV *const sv)
{
- dVAR;
SV *dsv;
char tmpbuf[64];
const char *pv;
# endif
)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_2IUV_NON_PRESERVE;
PERL_UNUSED_CONTEXT;
STATIC bool
S_sv_2iuv_common(pTHX_ SV *const sv)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_2IUV_COMMON;
if (SvNOKp(sv)) {
IV
Perl_sv_2iv_flags(pTHX_ SV *const sv, const I32 flags)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_2IV_FLAGS;
assert (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVHV
UV
Perl_sv_2uv_flags(pTHX_ SV *const sv, const I32 flags)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_2UV_FLAGS;
if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
NV
Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_2NV_FLAGS;
assert (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVHV
char *
Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
{
- dVAR;
char *s;
PERL_ARGS_ASSERT_SV_2PV_FLAGS;
bool
Perl_sv_2bool_flags(pTHX_ SV *sv, I32 flags)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_2BOOL_FLAGS;
restart:
STRLEN
Perl_sv_utf8_upgrade_flags_grow(pTHX_ SV *const sv, const I32 flags, STRLEN extra)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_UTF8_UPGRADE_FLAGS_GROW;
if (sv == &PL_sv_undef)
bool
Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_UTF8_DOWNGRADE;
if (SvPOKp(sv) && SvUTF8(sv)) {
void
Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
{
- dVAR;
U32 sflags;
int dtype;
svtype stype;
void
Perl_sv_setpvn(pTHX_ SV *const sv, const char *const ptr, const STRLEN len)
{
- dVAR;
char *dptr;
PERL_ARGS_ASSERT_SV_SETPVN;
void
Perl_sv_setpv(pTHX_ SV *const sv, const char *const ptr)
{
- dVAR;
STRLEN len;
PERL_ARGS_ASSERT_SV_SETPV;
void
Perl_sv_sethek(pTHX_ SV *const sv, const HEK *const hek)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_SETHEK;
if (!hek) {
void
Perl_sv_usepvn_flags(pTHX_ SV *const sv, char *ptr, const STRLEN len, const U32 flags)
{
- dVAR;
STRLEN allocate;
PERL_ARGS_ASSERT_SV_USEPVN_FLAGS;
static void
S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
{
- dVAR;
-
assert(SvIsCOW(sv));
{
#ifdef PERL_ANY_COW
void
Perl_sv_catpvn_flags(pTHX_ SV *const dsv, const char *sstr, const STRLEN slen, const I32 flags)
{
- dVAR;
STRLEN dlen;
const char * const dstr = SvPV_force_flags(dsv, dlen, flags);
void
Perl_sv_catsv_flags(pTHX_ SV *const dsv, SV *const ssv, const I32 flags)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_CATSV_FLAGS;
if (ssv) {
void
Perl_sv_catpv(pTHX_ SV *const sv, const char *ptr)
{
- dVAR;
STRLEN len;
STRLEN tlen;
char *junk;
SV *
Perl_newSV(pTHX_ const STRLEN len)
{
- dVAR;
SV *sv;
new_SV(sv);
Perl_sv_magicext(pTHX_ SV *const sv, SV *const obj, const int how,
const MGVTBL *const vtable, const char *const name, const I32 namlen)
{
- dVAR;
MAGIC* mg;
PERL_ARGS_ASSERT_SV_MAGICEXT;
Perl_sv_magic(pTHX_ SV *const sv, SV *const obj, const int how,
const char *const name, const I32 namlen)
{
- dVAR;
const MGVTBL *vtable;
MAGIC* mg;
unsigned int flags;
void
Perl_sv_add_backref(pTHX_ SV *const tsv, SV *const sv)
{
- dVAR;
SV **svp;
AV *av = NULL;
MAGIC *mg = NULL;
void
Perl_sv_del_backref(pTHX_ SV *const tsv, SV *const sv)
{
- dVAR;
SV **svp = NULL;
PERL_ARGS_ASSERT_SV_DEL_BACKREF;
void
Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen, const U32 flags)
{
- dVAR;
char *big;
char *mid;
char *midend;
void
Perl_sv_replace(pTHX_ SV *const sv, SV *const nsv)
{
- dVAR;
const U32 refcnt = SvREFCNT(sv);
PERL_ARGS_ASSERT_SV_REPLACE;
static bool
S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
- dVAR;
-
PERL_ARGS_ASSERT_CURSE;
assert(SvOBJECT(sv));
STRLEN
Perl_sv_len_utf8_nomg(pTHX_ SV * const sv)
{
- dVAR;
STRLEN len;
const U8 *s = (U8*)SvPV_nomg_const(sv, len);
I32
Perl_sv_eq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
{
- dVAR;
const char *pv1;
STRLEN cur1;
const char *pv2;
Perl_sv_cmp_flags(pTHX_ SV *const sv1, SV *const sv2,
const U32 flags)
{
- dVAR;
STRLEN cur1, cur2;
const char *pv1, *pv2;
I32 cmp;
Perl_sv_cmp_locale_flags(pTHX_ SV *const sv1, SV *const sv2,
const U32 flags)
{
- dVAR;
#ifdef USE_LOCALE_COLLATE
char *pv1, *pv2;
char *
Perl_sv_collxfrm_flags(pTHX_ SV *const sv, STRLEN *const nxp, const I32 flags)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_SV_COLLXFRM_FLAGS;
char *
Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
{
- dVAR;
const char *rsptr;
STRLEN rslen;
STDCHAR rslast;
void
Perl_sv_inc_nomg(pTHX_ SV *const sv)
{
- dVAR;
char *d;
int flags;
void
Perl_sv_dec(pTHX_ SV *const sv)
{
- dVAR;
if (!sv)
return;
SvGETMAGIC(sv);
void
Perl_sv_dec_nomg(pTHX_ SV *const sv)
{
- dVAR;
int flags;
if (!sv)
SV *
Perl_sv_mortalcopy_flags(pTHX_ SV *const oldstr, U32 flags)
{
- dVAR;
SV *sv;
if (flags & SV_GMAGIC)
SV *
Perl_sv_newmortal(pTHX)
{
- dVAR;
SV *sv;
new_SV(sv);
SV *
Perl_newSVpvn_flags(pTHX_ const char *const s, const STRLEN len, const U32 flags)
{
- dVAR;
SV *sv;
/* All the flags we don't support must be zero.
SV *
Perl_newSVpv(pTHX_ const char *const s, const STRLEN len)
{
- dVAR;
SV *sv;
new_SV(sv);
SV *
Perl_newSVpvn(pTHX_ const char *const buffer, const STRLEN len)
{
- dVAR;
SV *sv;
-
new_SV(sv);
sv_setpvn(sv,buffer,len);
return sv;
SV *
Perl_newSVhek(pTHX_ const HEK *const hek)
{
- dVAR;
if (!hek) {
SV *sv;
SV *
Perl_vnewSVpvf(pTHX_ const char *const pat, va_list *const args)
{
- dVAR;
SV *sv;
PERL_ARGS_ASSERT_VNEWSVPVF;
SV *
Perl_newSVnv(pTHX_ const NV n)
{
- dVAR;
SV *sv;
new_SV(sv);
SV *
Perl_newSViv(pTHX_ const IV i)
{
- dVAR;
SV *sv;
new_SV(sv);
SV *
Perl_newSVuv(pTHX_ const UV u)
{
- dVAR;
SV *sv;
new_SV(sv);
SV *
Perl_newRV_noinc(pTHX_ SV *const tmpRef)
{
- dVAR;
SV *sv = newSV_type(SVt_IV);
PERL_ARGS_ASSERT_NEWRV_NOINC;
SV *
Perl_newRV(pTHX_ SV *const sv)
{
- dVAR;
-
PERL_ARGS_ASSERT_NEWRV;
return newRV_noinc(SvREFCNT_inc_simple_NN(sv));
SV *
Perl_newSVsv(pTHX_ SV *const old)
{
- dVAR;
SV *sv;
if (!old)
void
Perl_sv_resetpvn(pTHX_ const char *s, STRLEN len, HV * const stash)
{
- dVAR;
char todo[PERL_UCHAR_MAX+1];
const char *send;
CV *
Perl_sv_2cv(pTHX_ SV *sv, HV **const st, GV **const gvp, const I32 lref)
{
- dVAR;
GV *gv = NULL;
CV *cv = NULL;
char *
Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_PVN_FORCE_FLAGS;
if (flags & SV_GMAGIC) SvGETMAGIC(sv);
SV*
Perl_newSVrv(pTHX_ SV *const rv, const char *const classname)
{
- dVAR;
SV *sv;
PERL_ARGS_ASSERT_NEWSVRV;
SV*
Perl_sv_setref_pv(pTHX_ SV *const rv, const char *const classname, void *const pv)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_SETREF_PV;
if (!pv) {
SV*
Perl_sv_bless(pTHX_ SV *const sv, HV *const stash)
{
- dVAR;
SV *tmpRef;
HV *oldstash = NULL;
PERL_STATIC_INLINE void
S_sv_unglob(pTHX_ SV *const sv, U32 flags)
{
- dVAR;
void *xpvmg;
HV *stash;
SV * const temp = flags & SV_COW_DROP_PV ? NULL : sv_newmortal();
STATIC I32
S_expect_number(pTHX_ char **const pattern)
{
- dVAR;
I32 var = 0;
PERL_ARGS_ASSERT_EXPECT_NUMBER;
va_list *const args, SV **const svargs, const I32 svmax, bool *const maybe_tainted,
const U32 flags)
{
- dVAR;
char *p;
char *q;
const char *patend;
char *
Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
{
- dVAR;
-
PERL_ARGS_ASSERT_SV_RECODE_TO_UTF8;
if (SvPOK(sv) && !SvUTF8(sv) && !IN_BYTES && SvROK(encoding)) {
Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
SV *ssv, int *offset, char *tstr, int tlen)
{
- dVAR;
bool ret = FALSE;
PERL_ARGS_ASSERT_SV_CAT_DECODE;
STATIC I32
S_find_array_subscript(pTHX_ const AV *const av, const SV *const val)
{
- dVAR;
-
PERL_ARGS_ASSERT_FIND_ARRAY_SUBSCRIPT;
if (!av || SvMAGICAL(av) || !AvARRAY(av) ||
void
Perl_report_uninit(pTHX_ const SV *uninit_sv)
{
- dVAR;
if (PL_op) {
SV* varname = NULL;
if (uninit_sv && PL_curpad) {
void
Perl_taint_env(pTHX)
{
- dVAR;
SV** svp;
MAGIC* mg;
const char* const *e;
STATIC int
S_ao(pTHX_ int toketype)
{
- dVAR;
if (*PL_bufptr == '=') {
PL_bufptr++;
if (toketype == ANDAND)
STATIC void
S_no_op(pTHX_ const char *const 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) {
bool
Perl_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen)
{
- dVAR;
char he_name[8 + MAX_FEATURE_LEN] = "feature_";
PERL_ARGS_ASSERT_FEATURE_IS_ENABLED;
void
Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
{
- dVAR;
const char *s = NULL;
yy_parser *parser, *oparser;
if (flags && flags & ~LEX_START_FLAGS)
STATIC void
S_incline(pTHX_ const char *s)
{
- dVAR;
const char *t;
const char *n;
const char *e;
STATIC void
S_check_uni(pTHX)
{
- dVAR;
const char *s;
const char *t;
STATIC I32
S_lop(pTHX_ I32 f, int x, char *s)
{
- dVAR;
-
PERL_ARGS_ASSERT_LOP;
pl_yylval.ival = f;
STATIC void
S_force_next(pTHX_ I32 type)
{
- dVAR;
#ifdef DEBUGGING
if (DEBUG_T_TEST) {
PerlIO_printf(Perl_debug_log, "### forced token:\n");
static int
S_postderef(pTHX_ int const funny, char const next)
{
- dVAR;
assert(funny == DOLSHARP || strchr("$@%&*", funny));
assert(strchr("*[{", next));
if (next == '*') {
STATIC SV *
S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
{
- dVAR;
SV * const sv = newSVpvn_utf8(start, len,
!IN_BYTES
&& UTF
STATIC char *
S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack)
{
- dVAR;
char *s;
STRLEN len;
STATIC void
S_force_ident(pTHX_ const char *s, int kind)
{
- dVAR;
-
PERL_ARGS_ASSERT_FORCE_IDENT;
if (s[0]) {
STATIC char *
S_force_version(pTHX_ char *s, int guessing)
{
- dVAR;
OP *version = NULL;
char *d;
STATIC char *
S_force_strict_version(pTHX_ char *s)
{
- dVAR;
OP *version = NULL;
const char *errstr = NULL;
STATIC SV *
S_tokeq(pTHX_ SV *sv)
{
- dVAR;
char *s;
char *send;
char *d;
STATIC I32
S_sublex_start(pTHX)
{
- dVAR;
const I32 op_type = pl_yylval.ival;
if (op_type == OP_NULL) {
STATIC I32
S_sublex_push(pTHX)
{
- dVAR;
LEXSHARED *shared;
const bool is_heredoc = PL_multi_close == '<';
ENTER;
STATIC I32
S_sublex_done(pTHX)
{
- dVAR;
if (!PL_lex_starts++) {
SV * const sv = newSVpvs("");
if (SvUTF8(PL_linestr))
STATIC char *
S_scan_const(pTHX_ char *start)
{
- dVAR;
char *send = PL_bufend; /* end of the constant */
SV *sv = newSV(send - start); /* sv for the constant. See
note below on sizing. */
STATIC int
S_intuit_more(pTHX_ char *s)
{
- dVAR;
-
PERL_ARGS_ASSERT_INTUIT_MORE;
if (PL_lex_brackets)
STATIC int
S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
{
- dVAR;
char *s = start + (*start == '$');
char tmpbuf[sizeof PL_tokenbuf];
STRLEN len;
SV *
Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
{
- dVAR;
if (!funcp)
return NULL;
void
Perl_filter_del(pTHX_ filter_t funcp)
{
- dVAR;
SV *datasv;
PERL_ARGS_ASSERT_FILTER_DEL;
I32
Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
{
- dVAR;
filter_t funcp;
SV *datasv = NULL;
/* This API is bad. It should have been using unsigned int for maxlen.
STATIC char *
S_filter_gets(pTHX_ SV *sv, STRLEN append)
{
- dVAR;
-
PERL_ARGS_ASSERT_FILTER_GETS;
#ifdef PERL_CR_FILTER
STATIC HV *
S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len)
{
- dVAR;
GV *gv;
PERL_ARGS_ASSERT_FIND_IN_MY_STASH;
STATIC char *
S_tokenize_use(pTHX_ int is_use, char *s) {
- dVAR;
-
PERL_ARGS_ASSERT_TOKENIZE_USE;
if (PL_expect != XSTATE)
static int
S_pending_ident(pTHX)
{
- dVAR;
PADOFFSET tmp = 0;
const char pit = (char)pl_yylval.ival;
const STRLEN tokenbuf_len = strlen(PL_tokenbuf);
STATIC void
S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
{
- dVAR;
-
PERL_ARGS_ASSERT_CHECKCOMMA;
if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
SV *sv, SV *pv, const char *type, STRLEN typelen)
{
- dVAR; dSP;
+ dSP;
HV * table = GvHV(PL_hintgv); /* ^H */
SV *res;
SV *errsv = NULL;
PERL_STATIC_INLINE void
S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8) {
- dVAR;
PERL_ARGS_ASSERT_PARSE_IDENT;
for (;;) {
STATIC char *
S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
{
- dVAR;
char *d = dest;
char * const e = d + destlen - 3; /* two-character token, ending NUL */
bool is_utf8 = cBOOL(UTF);
STATIC char *
S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
{
- dVAR;
I32 herelines = PL_parser->herelines;
SSize_t bracket = -1;
char funny = *s++;
STATIC char *
S_scan_pat(pTHX_ char *start, I32 type)
{
- dVAR;
PMOP *pm;
char *s;
const char * const valid_flags =
STATIC char *
S_scan_subst(pTHX_ char *start)
{
- dVAR;
char *s;
PMOP *pm;
I32 first_start;
STATIC char *
S_scan_trans(pTHX_ char *start)
{
- dVAR;
char* s;
OP *o;
U8 squash;
STATIC char *
S_scan_heredoc(pTHX_ char *s)
{
- dVAR;
I32 op_type = OP_SCALAR;
I32 len;
SV *tmpstr;
STATIC char *
S_scan_inputsymbol(pTHX_ char *start)
{
- dVAR;
char *s = start; /* current position in buffer */
char *end;
I32 len;
char **delimp
)
{
- dVAR;
SV *sv; /* scalar value: string */
const char *tmps; /* temp string, used for delimiter matching */
char *s = start; /* current position in the buffer */
char *
Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
{
- dVAR;
const char *s = start; /* current position in buffer */
char *d; /* destination in temp buffer */
char *e; /* end of temp buffer */
STATIC char *
S_scan_formline(pTHX_ char *s)
{
- dVAR;
char *eol;
char *t;
SV * const stuff = newSVpvs("");
I32
Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
{
- dVAR;
const I32 oldsavestack_ix = PL_savestack_ix;
CV* const outsidecv = PL_compcv;
static int
S_yywarn(pTHX_ const char *const s, U32 flags)
{
- dVAR;
-
PERL_ARGS_ASSERT_YYWARN;
PL_in_eval |= EVAL_WARNONLY;
int
Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
{
- dVAR;
const char *context = NULL;
int contlen = -1;
SV *msg;
STATIC char*
S_swallow_bom(pTHX_ U8 *s)
{
- dVAR;
const STRLEN slen = SvCUR(PL_linestr);
PERL_ARGS_ASSERT_SWALLOW_BOM;
static I32
S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
- dVAR;
SV *const filter = FILTER_DATA(idx);
/* We re-use this each time round, throwing the contents away before we
return. */
char *
Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
{
- dVAR;
const char *pos = s;
const char *start = s;
STATIC bool
S_isa_lookup(pTHX_ HV *stash, const char * const name, STRLEN len, U32 flags)
{
- dVAR;
const struct mro_meta *const meta = HvMROMETA(stash);
HV *isa = meta->isa;
const HV *our_stash;
bool
Perl_sv_derived_from_pvn(pTHX_ SV *sv, const char *const name, const STRLEN len, U32 flags)
{
- dVAR;
HV *stash;
PERL_ARGS_ASSERT_SV_DERIVED_FROM_PVN;
XS(XS_UNIVERSAL_isa); /* prototype to pass -Wmissing-prototypes */
XS(XS_UNIVERSAL_isa)
{
- dVAR;
dXSARGS;
if (items != 2)
XS(XS_UNIVERSAL_can); /* prototype to pass -Wmissing-prototypes */
XS(XS_UNIVERSAL_can)
{
- dVAR;
dXSARGS;
SV *sv;
SV *rv;
XS(XS_UNIVERSAL_DOES); /* prototype to pass -Wmissing-prototypes */
XS(XS_UNIVERSAL_DOES)
{
- dVAR;
dXSARGS;
PERL_UNUSED_ARG(cv);
XS(XS_utf8_is_utf8); /* prototype to pass -Wmissing-prototypes */
XS(XS_utf8_is_utf8)
{
- dVAR;
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "sv");
XS(XS_utf8_valid); /* prototype to pass -Wmissing-prototypes */
XS(XS_utf8_valid)
{
- dVAR;
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "sv");
XS(XS_utf8_encode); /* prototype to pass -Wmissing-prototypes */
XS(XS_utf8_encode)
{
- dVAR;
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "sv");
XS(XS_utf8_decode); /* prototype to pass -Wmissing-prototypes */
XS(XS_utf8_decode)
{
- dVAR;
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "sv");
XS(XS_utf8_upgrade); /* prototype to pass -Wmissing-prototypes */
XS(XS_utf8_upgrade)
{
- dVAR;
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "sv");
XS(XS_utf8_downgrade); /* prototype to pass -Wmissing-prototypes */
XS(XS_utf8_downgrade)
{
- dVAR;
dXSARGS;
if (items < 1 || items > 2)
croak_xs_usage(cv, "sv, failok=0");
XS(XS_utf8_native_to_unicode); /* prototype to pass -Wmissing-prototypes */
XS(XS_utf8_native_to_unicode)
{
- dVAR;
dXSARGS;
const UV uv = SvUV(ST(0));
XS(XS_utf8_unicode_to_native); /* prototype to pass -Wmissing-prototypes */
XS(XS_utf8_unicode_to_native)
{
- dVAR;
dXSARGS;
const UV uv = SvUV(ST(0));
XS(XS_Internals_SvREADONLY); /* prototype to pass -Wmissing-prototypes */
XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
{
- dVAR;
dXSARGS;
SV * const svz = ST(0);
SV * sv;
XS(XS_constant__make_const); /* prototype to pass -Wmissing-prototypes */
XS(XS_constant__make_const) /* This is dangerous stuff. */
{
- dVAR;
dXSARGS;
SV * const svz = ST(0);
SV * sv;
XS(XS_Internals_SvREFCNT); /* prototype to pass -Wmissing-prototypes */
XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
{
- dVAR;
dXSARGS;
SV * const svz = ST(0);
SV * sv;
XS(XS_Internals_hv_clear_placehold); /* prototype to pass -Wmissing-prototypes */
XS(XS_Internals_hv_clear_placehold)
{
- dVAR;
dXSARGS;
if (items != 1 || !SvROK(ST(0)))
XS(XS_PerlIO_get_layers); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlIO_get_layers)
{
- dVAR;
dXSARGS;
if (items < 1 || items % 2 == 0)
croak_xs_usage(cv, "filehandle[,args]");
XS(XS_re_is_regexp); /* prototype to pass -Wmissing-prototypes */
XS(XS_re_is_regexp)
{
- dVAR;
dXSARGS;
PERL_UNUSED_VAR(cv);
{
REGEXP *rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
SV * ret;
- dVAR;
dXSARGS;
if (items != 0)
XS(XS_re_regname); /* prototype to pass -Wmissing-prototypes */
XS(XS_re_regname)
{
- dVAR;
dXSARGS;
REGEXP * rx;
U32 flags;
XS(XS_re_regnames); /* prototype to pass -Wmissing-prototypes */
XS(XS_re_regnames)
{
- dVAR;
dXSARGS;
REGEXP * rx;
U32 flags;
XS(XS_re_regexp_pattern); /* prototype to pass -Wmissing-prototypes */
XS(XS_re_regexp_pattern)
{
- dVAR;
dXSARGS;
REGEXP *re;
void
Perl_boot_core_UNIVERSAL(pTHX)
{
- dVAR;
static const char file[] = __FILE__;
const struct xsub_details *xsub = details;
const struct xsub_details *end = C_ARRAY_END(details);
UV
Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
{
- dVAR;
const U8 * const s0 = s;
U8 overflow_byte = '\0'; /* Save byte in case of overflow */
U8 * send;
STRLEN
Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
{
- dVAR;
STRLEN len = 0;
PERL_ARGS_ASSERT_UTF8_LENGTH;
bool
Perl__is_utf8_idstart(pTHX_ const U8 *p)
{
- dVAR;
PERL_ARGS_ASSERT__IS_UTF8_IDSTART;
if (*p == '_')
UV
Perl_to_uni_upper(pTHX_ UV c, U8* p, STRLEN *lenp)
{
- dVAR;
-
/* Convert the Unicode character whose ordinal is <c> to its uppercase
* version and store that in UTF-8 in <p> and its length in bytes in <lenp>.
* Note that the <p> needs to be at least UTF8_MAXBYTES_CASE+1 bytes since
UV
Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp)
{
- dVAR;
-
PERL_ARGS_ASSERT_TO_UNI_TITLE;
if (c < 256) {
UV
Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp)
{
- dVAR;
-
PERL_ARGS_ASSERT_TO_UNI_LOWER;
if (c < 256) {
* have been checked before this call for mal-formedness enough to assure
* that. */
- dVAR;
-
PERL_ARGS_ASSERT_IS_UTF8_COMMON;
/* The API should have included a length for the UTF-8 character in <p>,
bool
Perl__is_utf8_FOO(pTHX_ const U8 classnum, const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT__IS_UTF8_FOO;
assert(classnum < _FIRST_NON_SWASH_CC);
bool
Perl__is_utf8_perl_idstart(pTHX_ const U8 *p)
{
- dVAR;
SV* invlist = NULL;
PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART;
bool
Perl__is_utf8_xidstart(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT__IS_UTF8_XIDSTART;
if (*p == '_')
bool
Perl__is_utf8_perl_idcont(pTHX_ const U8 *p)
{
- dVAR;
SV* invlist = NULL;
PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT;
bool
Perl__is_utf8_idcont(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT__IS_UTF8_IDCONT;
return is_utf8_common(p, &PL_utf8_idcont, "IdContinue", NULL);
bool
Perl__is_utf8_xidcont(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT__IS_UTF8_XIDCONT;
return is_utf8_common(p, &PL_utf8_idcont, "XIdContinue", NULL);
bool
Perl__is_utf8_mark(pTHX_ const U8 *p)
{
- dVAR;
-
PERL_ARGS_ASSERT__IS_UTF8_MARK;
return is_utf8_common(p, &PL_utf8_mark, "IsM", NULL);
Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
SV **swashp, const char *normal, const char *special)
{
- dVAR;
STRLEN len = 0;
const UV uv1 = valid_utf8_to_uvchr(p, NULL);
UV
Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags)
{
- dVAR;
-
UV result;
PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS;
UV
Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags)
{
- dVAR;
-
UV result;
PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS;
{
UV result;
- dVAR;
-
PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS;
if (flags && IN_UTF8_CTYPE_LOCALE) {
UV
Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)
{
- dVAR;
-
UV result;
PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS;
*
* <invlist> is only valid for binary properties */
- dVAR;
SV* retval = &PL_sv_undef;
HV* swash_hv = NULL;
const int invlist_swash_boundary =
UV
Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
{
- dVAR;
HV *const hv = MUTABLE_HV(SvRV(swash));
U32 klen;
U32 off;
I32
Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const char *s2, char **pe2, UV l2, bool u2, U32 flags)
{
- dVAR;
const U8 *p1 = (const U8*)s1; /* Point to current char */
const U8 *p2 = (const U8*)s2;
const U8 *g1 = NULL; /* goal for s1 */
{
#ifdef ALWAYS_NEED_THX
dTHX;
-#else
- dVAR;
#endif
DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++));
if (where) {
Malloc_t Perl_malloc (MEM_SIZE nbytes)
{
- dTHXs;
+#ifdef PERL_IMPLICIT_SYS
+ dTHX;
+#endif
return (Malloc_t)PerlMem_malloc(nbytes);
}
Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size)
{
- dTHXs;
+#ifdef PERL_IMPLICIT_SYS
+ dTHX;
+#endif
return (Malloc_t)PerlMem_calloc(elements, size);
}
Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes)
{
- dTHXs;
+#ifdef PERL_IMPLICIT_SYS
+ dTHX;
+#endif
return (Malloc_t)PerlMem_realloc(where, nbytes);
}
Free_t Perl_mfree (Malloc_t where)
{
- dTHXs;
+#ifdef PERL_IMPLICIT_SYS
+ dTHX;
+#endif
PerlMem_free(where);
}
void
Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
{
- dVAR;
const U8 *s;
STRLEN i;
STRLEN len;
char *
Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last)
{
- dVAR;
PERL_ARGS_ASSERT_SCREAMINSTR;
PERL_UNUSED_ARG(bigstr);
PERL_UNUSED_ARG(littlestr);
STATIC SV *
S_mess_alloc(pTHX)
{
- dVAR;
SV *sv;
XPVMG *any;
Perl_closest_cop(pTHX_ const COP *cop, const OP *o, const OP *curop,
bool opnext)
{
- dVAR;
/* Look for curop starting from o. cop is the last COP we've seen. */
/* opnext means that curop is actually the ->op_next of the op we are
seeking. */
SV *
Perl_mess_sv(pTHX_ SV *basemsg, bool consume)
{
- dVAR;
SV *sv;
#if defined(USE_C_BACKTRACE) && defined(USE_C_BACKTRACE_ON_ERROR)
SV *
Perl_vmess(pTHX_ const char *pat, va_list *args)
{
- dVAR;
SV * const sv = mess_alloc();
PERL_ARGS_ASSERT_VMESS;
void
Perl_write_to_stderr(pTHX_ SV* msv)
{
- dVAR;
IO *io;
MAGIC *mg;
STATIC bool
S_invoke_exception_hook(pTHX_ SV *ex, bool warn)
{
- dVAR;
HV *stash;
GV *gv;
CV *cv;
bool
Perl_ckwarn(pTHX_ U32 w)
{
- dVAR;
/* If lexical warnings have not been set, use $^W. */
if (isLEXWARN_off)
return PL_dowarn & G_WARN_ON;
bool
Perl_ckwarn_d(pTHX_ U32 w)
{
- dVAR;
/* If lexical warnings have not been set then default classes warn. */
if (isLEXWARN_off)
return TRUE;
Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
{
#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(NETWARE) && !defined(__LIBCATAMOUNT__)
- dVAR;
int p[2];
I32 This, that;
Pid_t pid;
PerlIO *
Perl_my_popen(pTHX_ const char *cmd, const char *mode)
{
- dVAR;
int p[2];
I32 This, that;
Pid_t pid;
void
Perl_atfork_lock(void)
{
- dVAR;
#if defined(USE_ITHREADS)
+ dVAR;
/* locks must be held in locking order (if any) */
# ifdef USE_PERLIO
MUTEX_LOCK(&PL_perlio_mutex);
void
Perl_atfork_unlock(void)
{
- dVAR;
#if defined(USE_ITHREADS)
+ dVAR;
/* locks must be released in same order as in atfork_lock() */
# ifdef USE_PERLIO
MUTEX_UNLOCK(&PL_perlio_mutex);
Sighandler_t
Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
{
- dVAR;
struct sigaction act, oact;
#ifdef USE_ITHREADS
+ dVAR;
/* only "parent" interpreter can diddle signals */
if (PL_curinterp != aTHX)
return (Sighandler_t) SIG_ERR;
int
Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
{
+#ifdef USE_ITHREADS
dVAR;
+#endif
struct sigaction act;
PERL_ARGS_ASSERT_RSIGNAL_SAVE;
int
Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
{
+#ifdef USE_ITHREADS
dVAR;
+#endif
+ PERL_UNUSED_CONTEXT;
#ifdef USE_ITHREADS
/* only "parent" interpreter can diddle signals */
if (PL_curinterp != aTHX)
I32
Perl_my_pclose(pTHX_ PerlIO *ptr)
{
- dVAR;
int status;
SV **svp;
Pid_t pid;
I32
Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
{
- dVAR;
I32 result = 0;
PERL_ARGS_ASSERT_WAIT4PID;
#ifdef PERL_USES_PL_PIDSTATUS
Perl_find_script(pTHX_ const char *scriptname, bool dosearch,
const char *const *const search_ext, I32 flags)
{
- dVAR;
const char *xfound = NULL;
char *xfailed = NULL;
char tmpbuf[MAXPATHLEN];
void *
Perl_get_context(void)
{
- dVAR;
#if defined(USE_ITHREADS)
+ dVAR;
# ifdef OLD_PTHREADS_API
pthread_addr_t t;
int error = pthread_getspecific(PL_thr_key, &t)
void
Perl_set_context(void *t)
{
+#if defined(USE_ITHREADS)
dVAR;
+#endif
PERL_ARGS_ASSERT_SET_CONTEXT;
#if defined(USE_ITHREADS)
# ifdef I_MACH_CTHREADS
Perl_getcwd_sv(pTHX_ SV *sv)
{
#ifndef PERL_MICRO
- dVAR;
SvTAINTED_on(sv);
PERL_ARGS_ASSERT_GETCWD_SV;
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
void
Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer)
{
- dVAR;
const char *env_pv;
unsigned long i;
void
Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
{
- dVAR;
SV * const dbsv = GvSVn(PL_DBsub);
const bool save_taint = TAINT_get;
https://perl5.git.perl.org / perl5.git / commitdiff