It only does anything under PERL_GLOBAL_STRUCT, which is gone.
Keep the dNOOP defintion for CPAN back-compat
static I32 S_do_amigaos_exec3(pTHX_ const char *incmd, int fd, int do_report)
{
- dVAR;
const char **argv, **a;
char *s;
char *buf;
I32 S_do_amigaos_aexec5(
pTHX_ SV *really, SV **mark, SV **sp, int fd, int do_report)
{
- dVAR;
I32 result = -1;
PERL_ARGS_ASSERT_DO_AEXEC5;
ENTER;
char *buf;
int wlen = 0;
char *oldlocale;
- dVAR;
/* Here and elsewhere in this file, we have a critical section to prevent
* another thread from changing the locale out from under us. XXX But why
mbstate_t mbs;
char *oldlocale;
int wlen = sizeof(wchar_t)*strlen(buf);
- dVAR;
LOCALE_LOCK;
if (!IN_BYTES) {
mbstate_t mbs;
char *oldlocale;
- dVAR;
LOCALE_LOCK;
wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len);
wchar_t *wbuf = (wchar_t *) safemalloc(wlen);
char *oldlocale;
- dVAR;
LOCALE_LOCK;
* to extend it, so for the time being this just isn't available on
* PERL_IMPLICIT_SYS builds.
*/
- dVAR;
DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
PL_strategy_dup,
fcntl(oldfd, F_DUPFD_CLOEXEC, 0),
* to extend it, so for the time being this just isn't available on
* PERL_IMPLICIT_SYS builds.
*/
- dVAR;
DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
PL_strategy_dup2,
dup3(oldfd, newfd, O_CLOEXEC),
int
Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag)
{
- dVAR;
PERL_ARGS_ASSERT_PERLLIO_OPEN_CLOEXEC;
#if defined(O_CLOEXEC)
DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
int
Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm)
{
- dVAR;
PERL_ARGS_ASSERT_PERLLIO_OPEN3_CLOEXEC;
#if defined(O_CLOEXEC)
DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
int
Perl_my_mkstemp_cloexec(char *templte)
{
- dVAR;
PERL_ARGS_ASSERT_MY_MKSTEMP_CLOEXEC;
#if defined(O_CLOEXEC)
DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
int
Perl_my_mkostemp_cloexec(char *templte, int flags)
{
- dVAR;
PERL_ARGS_ASSERT_MY_MKOSTEMP_CLOEXEC;
#if defined(O_CLOEXEC)
DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
int
Perl_PerlProc_pipe_cloexec(pTHX_ int *pipefd)
{
- dVAR;
PERL_ARGS_ASSERT_PERLPROC_PIPE_CLOEXEC;
/*
* struct IPerlProc doesn't cover pipe2(), and there's no clear way
Perl_PerlSock_socket_cloexec(pTHX_ int domain, int type, int protocol)
{
# if defined(SOCK_CLOEXEC)
- dVAR;
DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
PL_strategy_socket,
PerlSock_socket(domain, type | SOCK_CLOEXEC, protocol),
* way to extend it, so for the time being this just isn't available
* on PERL_IMPLICIT_SYS builds.
*/
- dVAR;
DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
PL_strategy_accept,
accept4(listenfd, addr, addrlen, SOCK_CLOEXEC),
Perl_PerlSock_socketpair_cloexec(pTHX_ int domain, int type, int protocol,
int *pairfd)
{
- dVAR;
PERL_ARGS_ASSERT_PERLSOCK_SOCKETPAIR_CLOEXEC;
# ifdef SOCK_CLOEXEC
DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(PL_strategy_socketpair, pairfd,
Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
int fd, int do_report)
{
- dVAR;
PERL_ARGS_ASSERT_DO_AEXEC5;
#if defined(__LIBCATAMOUNT__)
Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
bool
Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
{
- dVAR;
const char **argv, **a;
char *s;
char *buf;
char *
Perl_sv_peek(pTHX_ SV *sv)
{
- dVAR;
SV * const t = sv_newmortal();
int unref = 0;
U32 type;
STATIC UV
S_sequence_num(pTHX_ const OP *o)
{
- dVAR;
SV *op,
**seq;
const char *key;
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;
# walkoptree comes from B.xs
BEGIN {
- $B::VERSION = '1.80';
+ $B::VERSION = '1.81';
@B::EXPORT_OK = ();
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
static XSPROTO(intrpvar_sv_common); /* prototype to pass -Wmissing-prototypes */
static XSPROTO(intrpvar_sv_common)
{
- dVAR;
dXSARGS;
SV *ret;
if (items != 0)
package Devel::Peek;
-$VERSION = '1.28';
+$VERSION = '1.29';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
static void
S_do_dump(pTHX_ SV *const sv, I32 lim)
{
- dVAR;
SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", 0);
const STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0;
SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", 0);
require Exporter;
require XSLoader;
@ISA = qw(Exporter);
-$VERSION = '1.13';
+$VERSION = '1.14';
XSLoader::load();
static void
XS_Fcntl_S_ISREG(pTHX_ CV* cv)
{
- dVAR;
dXSARGS;
dXSI32;
/* Preserve the semantics of the perl code, which was:
# interface look beautiful, which is hard.
{
- dVAR;
POSIX__SigAction action;
GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
struct sigaction act;
package PerlIO::mmap;
use strict;
use warnings;
-our $VERSION = '0.016';
+our $VERSION = '0.017';
use XSLoader;
XSLoader::load(__PACKAGE__, __PACKAGE__->VERSION);
static IV
PerlIOMmap_map(pTHX_ PerlIO *f)
{
- dVAR;
PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
const IV flags = PerlIOBase(f)->flags;
IV code = 0;
#ifndef USE_ITHREADS
GV *filegv;
#endif
- dVAR;
PERL_ARGS_ASSERT_NEWGP;
Newxz(gp, 1, GP);
SV*
Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
{
- dVAR;
MAGIC *mg;
CV *cv=NULL;
CV **cvp=NULL, **ocvp=NULL;
void
Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
{
- dVAR;
U32 hash;
PERL_ARGS_ASSERT_GV_NAME_SET;
require DynaLoader;
@ISA = qw|Exporter DynaLoader|;
- $VERSION = '0.35';
+ $VERSION = '0.36';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
haiku_do_debug_printf(pTHX_ SV *sv,
void (*printfFunc)(const char*,...))
{
- dVAR;
if (!sv)
return;
XS(haiku_debug_printf)
{
- dVAR;
dXSARGS;
dORIGMARK;
SV *sv;
XS(haiku_ktrace_printf)
{
- dVAR;
dXSARGS;
dORIGMARK;
SV *sv;
XS(haiku_debugger)
{
- dVAR;
dXSARGS;
dORIGMARK;
SV *sv;
Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
int flags, int action, SV *val, U32 hash)
{
- dVAR;
XPVHV* xhv;
HE *entry;
HE **oentry;
S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
int k_flags, I32 d_flags, U32 hash)
{
- dVAR;
XPVHV* xhv;
HE *entry;
HE **oentry;
HV *
Perl_newHVhv(pTHX_ HV *ohv)
{
- dVAR;
HV * const hv = newHV();
STRLEN hv_max;
void
Perl_hv_clear(pTHX_ HV *hv)
{
- dVAR;
SSize_t orig_ix;
XPVHV* xhv;
static void
S_clear_placeholders(pTHX_ HV *hv, U32 items)
{
- dVAR;
I32 i;
PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS;
void
Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
{
- dVAR;
struct xpvhv_aux *iter;
U32 hash;
HEK **spot;
void
Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
{
- dVAR;
struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
U32 hash;
HE *
Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
{
- dVAR;
XPVHV* xhv;
HE *entry;
HE *oldentry;
we should flag that it needs upgrading on keys or each. Also flag
that we need share_hek_flags to free the string. */
if (str != save) {
- dVAR;
PERL_HASH(hash, str, len);
flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
}
STATIC SV *
S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
{
- dVAR;
SV *value;
PERL_ARGS_ASSERT_REFCOUNTED_HE_VALUE;
HV *
Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags)
{
- dVAR;
HV *hv;
U32 placeholders, max;
Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain,
const char *keypv, STRLEN keylen, U32 hash, U32 flags)
{
- dVAR;
U8 utf8_flag;
PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN;
Perl_refcounted_he_new_pvn(pTHX_ struct refcounted_he *parent,
const char *keypv, STRLEN keylen, U32 hash, SV *value, U32 flags)
{
- dVAR;
STRLEN value_len = 0;
const char *value_p = NULL;
bool is_pv;
void
Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
#ifdef USE_ITHREADS
- dVAR;
#endif
PERL_UNUSED_CONTEXT;
Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
{
#ifdef USE_ITHREADS
- dVAR;
#endif
PERL_UNUSED_CONTEXT;
if (he) {
void
Perl_hv_assert(pTHX_ HV *hv)
{
- dVAR;
HE* entry;
int withflags = 0;
int placeholders = 0;
PERL_STATIC_INLINE I32
Perl_foldEQ_locale(const char *s1, const char *s2, I32 len)
{
- dVAR;
const U8 *a = (const U8 *)s1;
const U8 *b = (const U8 *)s2;
* this function should be called directly only from this file and from
* POSIX::setlocale() */
- dVAR;
unsigned int i;
/* Don't check for problems if we are suppressing the warnings */
* values for our db, instead of trying to change them.
* */
- dVAR;
int ok = 1;
bool
Perl__is_in_locale_category(pTHX_ const bool compiling, const int category)
{
- dVAR;
/* Internal function which returns if we are in the scope of a pragma that
* enables the locale category 'category'. 'compiling' should indicate if
* this is during the compilation phase (TRUE) or not (FALSE). */
* to the C locale */
char *errstr;
- dVAR;
#ifndef USE_LOCALE_MESSAGES
# ifndef WIN32
{ /* Free up */
- dVAR;
locale_t cur_obj = uselocale(LC_GLOBAL_LOCALE);
if (cur_obj != LC_GLOBAL_LOCALE && cur_obj != PL_C_locale_obj) {
freelocale(cur_obj);
static void
botch(const char *diag, const char *s, const char *file, int line)
{
- dVAR;
dTHX;
if (!(PERL_MAYBE_ALIVE && PERL_GET_THX))
goto do_write;
Malloc_t
Perl_malloc(size_t nbytes)
{
- dVAR;
union overhead *p;
int bucket;
#if defined(DEBUGGING) || defined(RCHECK)
static union overhead *
getpages(MEM_SIZE needed, int *nblksp, int bucket)
{
- dVAR;
/* Need to do (possibly expensive) system call. Try to
optimize it for rare calling. */
MEM_SIZE require = needed - sbrked_remains;
static void
morecore(int bucket)
{
- dVAR;
union overhead *ovp;
int rnu; /* 2^rnu bytes will be requested */
int nblks; /* become nblks blocks of the desired size */
Free_t
Perl_mfree(Malloc_t where)
{
- dVAR;
MEM_SIZE size;
union overhead *ovp;
char *cp = (char*)where;
Malloc_t
Perl_realloc(void *mp, size_t nbytes)
{
- dVAR;
MEM_SIZE onb;
union overhead *ovp;
char *res;
int
Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
{
- dVAR;
I32 i;
SV** svp = NULL;
/* Need to be careful with SvREFCNT_dec(), because that can have side
PERL_TSA_REQUIRES(PL_dollarzero_mutex)
{
#ifdef USE_ITHREADS
- dVAR;
#endif
const char *s;
STRLEN len;
Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
{
#ifdef USE_ITHREADS
- dVAR;
#endif
I32 paren;
const REGEXP * rx;
void
Perl_op_free(pTHX_ OP *o)
{
- dVAR;
OPCODE type;
OP *top_op = o;
OP *next_op = o;
Perl_op_clear(pTHX_ OP *o)
{
- dVAR;
PERL_ARGS_ASSERT_OP_CLEAR;
void
Perl_op_null(pTHX_ OP *o)
{
- dVAR;
PERL_ARGS_ASSERT_OP_NULL;
PERL_TSA_ACQUIRE(PL_op_mutex)
{
#ifdef USE_ITHREADS
- dVAR;
#endif
PERL_UNUSED_CONTEXT;
OP_REFCNT_LOCK;
PERL_TSA_RELEASE(PL_op_mutex)
{
#ifdef USE_ITHREADS
- dVAR;
#endif
PERL_UNUSED_CONTEXT;
OP_REFCNT_UNLOCK;
LOGOP *
Perl_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
{
- dVAR;
LOGOP *logop;
OP *kid = first;
NewOp(1101, logop, 1, LOGOP);
OP *
Perl_scalarvoid(pTHX_ OP *arg)
{
- dVAR;
OP *kid;
SV* sv;
OP *o = arg;
STATIC void
S_maybe_multiconcat(pTHX_ OP *o)
{
- dVAR;
OP *lastkidop; /* the right-most of any kids unshifted onto o */
OP *topop; /* the top-most op in the concat tree (often equals o,
unless there are assign/stringify ops above it */
static void
S_lvref(pTHX_ OP *o, I32 type)
{
- dVAR;
OP *kid;
OP * top_op = o;
OP *
Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
{
- dVAR;
OP *top_op = o;
if (!o || (PL_parser && PL_parser->error_count))
OP *
Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
{
- dVAR;
OP * top_op = o;
PERL_ARGS_ASSERT_DOREF;
OP *
Perl_cmpchain_start(pTHX_ I32 type, OP *left, OP *right)
{
- dVAR;
BINOP *bop;
OP *op;
OP *
Perl_cmpchain_extend(pTHX_ I32 type, OP *ch, OP *right)
{
- dVAR;
BINOP *bop;
OP *op;
OP *
Perl_cmpchain_finish(pTHX_ OP *ch)
{
- dVAR;
PERL_ARGS_ASSERT_CMPCHAIN_FINISH;
if (ch->op_type != OP_NULL) {
OP *
Perl_op_scope(pTHX_ OP *o)
{
- dVAR;
if (o) {
if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || TAINTING_get) {
o = op_prepend_elem(OP_LINESEQ,
/* integerize op. */
if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER))
{
- dVAR;
o->op_ppaddr = PL_ppaddr[++(o->op_type)];
}
static OP *
S_fold_constants(pTHX_ OP *const o)
{
- dVAR;
OP *curop;
OP *newop;
I32 type = o->op_type;
static void
S_gen_constant_list(pTHX_ OP *o)
{
- dVAR;
OP *curop, *old_next;
SV * const oldwarnhook = PL_warnhook;
SV * const olddiehook = PL_diehook;
OP *
Perl_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
{
- dVAR;
if (type < 0) type = -type, flags |= OPf_SPECIAL;
if (!o || o->op_type != OP_LIST)
o = force_list(o, 0);
OP *
Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
{
- dVAR;
LISTOP *listop;
/* Note that allocating an OP_PUSHMARK can die under Safe.pm if
* pushmark is banned. So do it now while existing ops are in a
OP *
Perl_newOP(pTHX_ I32 type, I32 flags)
{
- dVAR;
OP *o;
if (type == -OP_ENTEREVAL) {
OP *
Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
{
- dVAR;
UNOP *unop;
if (type == -OP_ENTEREVAL) {
OP *
Perl_newUNOP_AUX(pTHX_ I32 type, I32 flags, OP *first, UNOP_AUX_item *aux)
{
- dVAR;
UNOP_AUX *unop;
assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP_AUX
static OP*
S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth) {
- dVAR;
METHOP *methop;
assert((PL_opargs[type] & OA_CLASS_MASK) == OA_METHOP
OP *
Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
{
- dVAR;
BINOP *binop;
ASSUME((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP
OP *
Perl_newPMOP(pTHX_ I32 type, I32 flags)
{
- dVAR;
PMOP *pmop;
assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PMOP
OP *
Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
{
- dVAR;
SVOP *svop;
PERL_ARGS_ASSERT_NEWSVOP;
OP *
Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
{
- dVAR;
PADOP *padop;
PERL_ARGS_ASSERT_NEWPADOP;
OP *
Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
{
- dVAR;
const bool utf8 = cBOOL(flags & SVf_UTF8);
PVOP *pvop;
static OP *
S_newONCEOP(pTHX_ OP *initop, OP *padop)
{
- dVAR;
const PADOFFSET target = padop->op_targ;
OP *const other = newOP(OP_PADSV,
padop->op_flags
OP *
Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
{
- dVAR;
const U32 seq = intro_my();
const U32 utf8 = flags & SVf_UTF8;
COP *cop;
STATIC OP *
S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
{
- dVAR;
LOGOP *logop;
OP *o;
OP *first;
OP *
Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
{
- dVAR;
LOGOP *logop;
OP *start;
OP *o;
Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop,
OP *expr, OP *block, OP *cont, I32 has_my)
{
- dVAR;
OP *redo;
OP *next = NULL;
OP *listop;
OP *
Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
{
- dVAR;
LOOP *loop;
OP *wop;
PADOFFSET padoff = 0;
I32 enter_opcode, I32 leave_opcode,
PADOFFSET entertarg)
{
- dVAR;
LOGOP *enterop;
OP *o;
if (CvNAMED(*spot))
hek = CvNAME_HEK(*spot);
else {
- dVAR;
U32 hash;
PERL_HASH(hash, PadnamePV(name)+1, PadnameLEN(name)-1);
CvNAME_HEK_set(*spot, hek =
if (!CvNAME_HEK(cv)) {
if (hek) (void)share_hek_hek(hek);
else {
- dVAR;
U32 hash;
PERL_HASH(hash, PadnamePV(name)+1, PadnameLEN(name)-1);
hek = share_hek(PadnamePV(name)+1,
assert(CvGV(cv) == gv);
}
else {
- dVAR;
U32 hash;
PERL_HASH(hash, name, namlen);
CvNAME_HEK_set(cv,
if (isGV(gv))
CvGV_set(cv, gv);
else {
- dVAR;
U32 hash;
PERL_HASH(hash, name, namlen);
CvNAME_HEK_set(cv, share_hek(name,
OP *
Perl_oopsAV(pTHX_ OP *o)
{
- dVAR;
PERL_ARGS_ASSERT_OOPSAV;
OP *
Perl_oopsHV(pTHX_ OP *o)
{
- dVAR;
PERL_ARGS_ASSERT_OOPSHV;
OP *
Perl_newAVREF(pTHX_ OP *o)
{
- dVAR;
PERL_ARGS_ASSERT_NEWAVREF;
OP *
Perl_newHVREF(pTHX_ OP *o)
{
- dVAR;
PERL_ARGS_ASSERT_NEWHVREF;
Perl_newCVREF(pTHX_ I32 flags, OP *o)
{
if (o->op_type == OP_PADANY) {
- dVAR;
OpTYPE_set(o, OP_PADCV);
}
return newUNOP(OP_RV2CV, flags, scalar(o));
OP *
Perl_newSVREF(pTHX_ OP *o)
{
- dVAR;
PERL_ARGS_ASSERT_NEWSVREF;
OP *
Perl_ck_spair(pTHX_ OP *o)
{
- dVAR;
PERL_ARGS_ASSERT_CK_SPAIR;
OP *
Perl_ck_eval(pTHX_ OP *o)
{
- dVAR;
PERL_ARGS_ASSERT_CK_EVAL;
OP *
Perl_ck_rvconst(pTHX_ OP *o)
{
- dVAR;
SVOP * const kid = (SVOP*)cUNOPo->op_first;
PERL_ARGS_ASSERT_CK_RVCONST;
OP *
Perl_ck_ftst(pTHX_ OP *o)
{
- dVAR;
const I32 type = o->op_type;
PERL_ARGS_ASSERT_CK_FTST;
OP *
Perl_ck_smartmatch(pTHX_ OP *o)
{
- dVAR;
PERL_ARGS_ASSERT_CK_SMARTMATCH;
if (0 == (o->op_flags & OPf_SPECIAL)) {
OP *first = cBINOPo->op_first;
OP *
Perl_ck_sassign(pTHX_ OP *o)
{
- dVAR;
OP * const kid = cBINOPo->op_first;
PERL_ARGS_ASSERT_CK_SASSIGN;
SV * const sv = kid->op_sv;
U32 const was_readonly = SvREADONLY(sv);
if (kid->op_private & OPpCONST_BARE) {
- dVAR;
const char *end;
HEK *hek;
SvREFCNT_dec_NN(sv);
}
else {
- dVAR;
HEK *hek;
if (was_readonly) SvREADONLY_off(sv);
PERL_HASH(hash, s, len);
OP *
Perl_ck_select(pTHX_ OP *o)
{
- dVAR;
OP* kid;
PERL_ARGS_ASSERT_CK_SELECT;
OP *
Perl_ck_split(pTHX_ OP *o)
{
- dVAR;
OP *kid;
OP *sibs;
OP *
Perl_ck_each(pTHX_ OP *o)
{
- dVAR;
OP *kid = o->op_flags & OPf_KIDS ? cUNOPo->op_first : NULL;
const unsigned orig_type = o->op_type;
STATIC void
S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
{
- dVAR;
int pass;
UNOP_AUX_item *arg_buf = NULL;
bool reset_start_targ = FALSE; /* start->op_targ needs zeroing */
void
Perl_rpeep(pTHX_ OP *o)
{
- dVAR;
OP* oldop = NULL;
OP* oldoldop = NULL;
OP** defer_queue[MAX_DEFERRED]; /* small queue of deferred branches */
Perl_wrap_op_checker(pTHX_ Optype opcode,
Perl_check_t new_checker, Perl_check_t *old_checker_p)
{
- dVAR;
PERL_UNUSED_CONTEXT;
PERL_ARGS_ASSERT_WRAP_OP_CHECKER;
void
Perl_pad_tidy(pTHX_ padtidy_type type)
{
- dVAR;
ASSERT_CURPAD_ACTIVE("pad_tidy");
/* my sub */
/* Just provide a stub, but name it. It will be
upgraded to the real thing on scope entry. */
- dVAR;
U32 hash;
PERL_HASH(hash, PadnamePV(namesv)+1,
PadnameLEN(namesv) - 1);
S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned)
{
#ifdef USE_ITHREADS
- dVAR;
#endif
const bool newcv = !cv;
static void
S_init_tls_and_interp(PerlInterpreter *my_perl)
{
- dVAR;
if (!PL_curinterp) {
PERL_SET_INTERP(my_perl);
#if defined(USE_ITHREADS)
void
Perl_sys_init(int* argc, char*** argv)
{
- dVAR;
PERL_ARGS_ASSERT_SYS_INIT;
void
Perl_sys_init3(int* argc, char*** argv, char*** env)
{
- dVAR;
PERL_ARGS_ASSERT_SYS_INIT3;
void
Perl_sys_term(void)
{
- dVAR;
if (!PL_veto_cleanup) {
PERL_SYS_TERM_BODY();
}
void
perl_construct(pTHXx)
{
- dVAR;
PERL_ARGS_ASSERT_PERL_CONSTRUCT;
int
perl_destruct(pTHXx)
{
- dVAR;
volatile signed char destruct_level; /* see possible values in intrpvar.h */
HV *hv;
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
void
perl_free(pTHXx)
{
- dVAR;
PERL_ARGS_ASSERT_PERL_FREE;
#endif
perl_fini(void)
{
- dVAR;
if (
PL_curinterp && !PL_veto_cleanup)
FREE_THREAD_KEY;
int
perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
{
- dVAR;
I32 oldscope;
int ret;
dJMPENV;
STATIC void *
S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
{
- dVAR;
PerlIO *rsfp;
int argc = PL_origargc;
char **argv = PL_origargv;
Perl_call_sv(pTHX_ SV *sv, volatile I32 flags)
/* See G_* flags in cop.h */
{
- dVAR;
LOGOP myop; /* fake syntax tree node */
METHOP method_op;
I32 oldmark;
/* See G_* flags in cop.h */
{
- dVAR;
UNOP myop; /* fake syntax tree node */
volatile I32 oldmark;
volatile I32 retval = 0;
const char *
Perl_moreswitches(pTHX_ const char *s)
{
- dVAR;
UV rschar;
const char option = *s; /* used to remember option in -m/-M code */
PERL_ARGS_ASSERT_VALIDATE_SUID;
if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */
- dVAR;
int fd = PerlIO_fileno(rsfp);
Stat_t statbuf;
if (fd < 0 || PerlLIO_fstat(fd, &statbuf) < 0) { /* may be either wrapped or real suid */
S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env)
{
#ifdef USE_ITHREADS
- dVAR;
#endif
GV* tmpgv;
/* this used to be off by default, now its on, see perlio.h */
#define PERLIO_FUNCS_CONST
-#define pVAR struct perl_vars* my_vars PERL_UNUSED_DECL
-
-# define dVAR dNOOP
-
#ifdef PERL_IMPLICIT_CONTEXT
# ifndef MULTIPLICITY
# define MULTIPLICITY
# define pTHX_12 12
#endif
-#ifndef dVAR
+#ifndef PERL_CORE
+/* Backwards compatibility macro for XS code. It used to be part of
+ * the PERL_GLOBAL_STRUCT(_PRIVATE) feature, which no longer exists */
# define dVAR dNOOP
#endif
S_more_refcounted_fds(pTHX_ const int new_fd)
PERL_TSA_REQUIRES(PL_perlio_mutex)
{
- dVAR;
const int old_max = PL_perlio_fd_refcnt_size;
const int new_max = 16 + (new_fd & ~15);
int *new_array;
{
dTHX;
if (fd >= 0) {
- dVAR;
MUTEX_LOCK(&PL_perlio_mutex);
if (fd >= PL_perlio_fd_refcnt_size)
#ifdef DEBUGGING
dTHX;
#else
- dVAR;
#endif
MUTEX_LOCK(&PL_perlio_mutex);
if (fd >= PL_perlio_fd_refcnt_size) {
dTHX;
int cnt = 0;
if (fd >= 0) {
- dVAR;
MUTEX_LOCK(&PL_perlio_mutex);
if (fd >= PL_perlio_fd_refcnt_size) {
/* diag_listed_as: refcnt: fd %d%s */
void PerlIO_teardown(void) /* Call only from PERL_SYS_TERM(). */
{
- dVAR;
#if 0
/* XXX we can't rely on an interpreter being present at this late stage,
XXX so we can't use a function like PerlLIO_write that relies on one
int dupfd = -1;
dSAVEDERRNO;
#ifdef USE_ITHREADS
- dVAR;
#endif
#ifdef SOCKS5_VERSION_NAME
/* Socks lib overrides close() but stdio isn't linked to
int
Perl_yyparse (pTHX_ int gramtype)
{
- dVAR;
int yystate;
int yyn;
int yyresult;
The first one explicitly passes in the context, which is needed for
e.g. threaded builds. The second one does that implicitly; do not get
them mixed. If you are not passing in a aTHX_, you will need to do a
-dTHX (or a dVAR) as the first thing in the function.
+dTHX as the first thing in the function.
See L<perlguts/"How multiple interpreters and concurrency are
supported"> for further discussion about context.
PP(pp_uc)
{
- dVAR;
dSP;
SV *source = TOPs;
STRLEN len;
PP(pp_avhvswitch)
{
- dVAR; dSP;
+ dSP;
return PL_ppaddr[
(SvTYPE(TOPs) == SVt_PVAV ? OP_AEACH : OP_EACH)
+ (PL_op->op_private & OPpAVHVSWITCH_MASK)
PP(pp_goto)
{
- dVAR; dSP;
+ dSP;
OP *retop = NULL;
I32 ix;
PERL_CONTEXT *cx;
static OP *
S_require_version(pTHX_ SV *sv)
{
- dVAR; dSP;
+ dSP;
sv = sv_2mortal(new_version(sv));
if (!Perl_sv_derived_from_pvn(aTHX_ PL_patchlevel, STR_WITH_LEN("version"), 0))
static OP *
S_require_file(pTHX_ SV *sv)
{
- dVAR; dSP;
+ dSP;
PERL_CONTEXT *cx;
const char *name;
#endif
)
{
- dVAR;
SV **relem;
SV **lelem;
SSize_t lcount = lastlelem - firstlelem + 1;
PP(pp_aassign)
{
- dVAR; dSP;
+ dSP;
SV **lastlelem = PL_stack_sp;
SV **lastrelem = PL_stack_base + POPMARK;
SV **firstrelem = PL_stack_base + POPMARK + 1;
void
Perl_leave_adjust_stacks(pTHX_ SV **from_sp, SV **to_sp, U8 gimme, int pass)
{
- dVAR;
dSP;
SSize_t tmps_base; /* lowest index into tmps stack that needs freeing now */
SSize_t nargs;
* returned list must, and will, contain every code point that is a
* possibility. */
- dVAR;
SV* invlist = NULL;
SV* only_utf8_locale_invlist = NULL;
unsigned int i;
STATIC void
S_rck_elide_nothing(pTHX_ regnode *node)
{
- dVAR;
-
PERL_ARGS_ASSERT_RCK_ELIDE_NOTHING;
if (OP(node) != CURLYX) {
/* recursed: which subroutines have we recursed into */
/* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
{
- dVAR;
SSize_t final_minlen;
/* There must be at least this number of characters to match */
SSize_t min = 0;
OP *expr, const regexp_engine* eng, REGEXP *old_re,
bool *is_bare_re, const U32 orig_rx_flags, const U32 pm_flags)
{
- dVAR;
REGEXP *Rx; /* Capital 'R' means points to a REGEXP */
STRLEN plen;
char *exp;
STATIC SV*
S_make_exactf_invlist(pTHX_ RExC_state_t *pRExC_state, regnode *node)
{
- dVAR;
const U8 * s = (U8*)STRING(node);
SSize_t bytelen = STR_LEN(node);
UV uc;
STATIC regnode_offset
S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
{
- dVAR;
regnode_offset ret = 0;
I32 flags = 0;
char *parse_start;
* sets up the bitmap and any flags, removing those code points from the
* inversion list, setting it to NULL should it become completely empty */
- dVAR;
PERL_ARGS_ASSERT_POPULATE_ANYOF_FROM_INVLIST;
assert(PL_regkind[OP(node)] == ANYOF);
* UTF-8
*/
- dVAR;
UV prevvalue = OOB_UNICODE, save_prevvalue = OOB_UNICODE;
IV range = 0;
UV value = OOB_UNICODE, save_value = OOB_UNICODE;
Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_info *reginfo, const RExC_state_t *pRExC_state)
{
#ifdef DEBUGGING
- dVAR;
int k;
RXi_GET_DECL(prog, progi);
DECLARE_AND_GET_RE_DEBUG_FLAGS;
U32 refcount;
reg_ac_data *aho=(reg_ac_data*)ri->data->data[n];
#ifdef USE_ITHREADS
- dVAR;
#endif
OP_REFCNT_LOCK;
refcount = --aho->refcount;
U32 refcount;
reg_trie_data *trie=(reg_trie_data*)ri->data->data[n];
#ifdef USE_ITHREADS
- dVAR;
#endif
OP_REFCNT_LOCK;
refcount = --trie->refcount;
void
Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param)
{
- dVAR;
I32 npar;
const struct regexp *r = ReANY(sstr);
struct regexp *ret = ReANY(dstr);
void *
Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param)
{
- dVAR;
struct regexp *const r = ReANY(rx);
regexp_internal *reti;
int len;
* output would have been only the inversion indicator '^', NULL is instead
* returned. */
- dVAR;
SV * output;
PERL_ARGS_ASSERT_PUT_CHARCLASS_BITMAP_INNARDS_COMMON;
* cases where it can't try inverting, as what actually matches isn't known
* until runtime, and hence the inversion isn't either. */
- dVAR;
bool inverting_allowed = ! force_as_is_display;
int i;
void
Perl_init_uniprops(pTHX)
{
- dVAR;
# ifdef DEBUGGING
char * dump_len_string;
* properties. This is a function so it can be set up to be called even if
* the program unexpectedly quits */
- dVAR;
SV ** current_entry;
const STRLEN key_len = strlen((const char *) key);
DECLARATION_FOR_GLOBAL_CONTEXT;
this */
const STRLEN level) /* Recursion level of this call */
{
- dVAR;
char* lookup_name; /* normalized name for lookup in our tables */
unsigned lookup_len; /* Its length */
enum { Not_Strict = 0, /* Some properties have stricter name */
* rules, ignoring any locale. So use the Unicode function if this class
* requires an inversion list, and use the Unicode macro otherwise. */
- dVAR;
PERL_ARGS_ASSERT_ISFOO_UTF8_LC;
S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
const char *strend, regmatch_info *reginfo)
{
- dVAR;
/* TRUE if x+ need not match at just the 1st pos of run of x's */
const I32 doevery = (prog->intflags & PREGf_SKIP) == 0;
* to/from code points */
bool utf8_has_been_setup = FALSE;
- dVAR;
U8 *pat = (U8*)STRING(text_node);
U8 folded[UTF8_MAX_FOLD_CHAR_EXPAND * UTF8_MAXBYTES_CASE + 1] = { '\0' };
STATIC GCB_enum
S_backup_one_GCB(pTHX_ const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
{
- dVAR;
GCB_enum gcb;
PERL_ARGS_ASSERT_BACKUP_ONE_GCB;
STATIC LB_enum
S_advance_one_LB(pTHX_ U8 ** curpos, const U8 * const strend, const bool utf8_target)
{
- dVAR;
LB_enum lb;
STATIC LB_enum
S_backup_one_LB(pTHX_ const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
{
- dVAR;
LB_enum lb;
PERL_ARGS_ASSERT_BACKUP_ONE_LB;
STATIC SB_enum
S_advance_one_SB(pTHX_ U8 ** curpos, const U8 * const strend, const bool utf8_target)
{
- dVAR;
SB_enum sb;
PERL_ARGS_ASSERT_ADVANCE_ONE_SB;
STATIC SB_enum
S_backup_one_SB(pTHX_ const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
{
- dVAR;
SB_enum sb;
PERL_ARGS_ASSERT_BACKUP_ONE_SB;
const bool utf8_target,
const bool skip_Extend_Format)
{
- dVAR;
WB_enum wb;
PERL_ARGS_ASSERT_ADVANCE_ONE_WB;
STATIC WB_enum
S_backup_one_WB(pTHX_ WB_enum * previous, const U8 * const strbeg, U8 ** curpos, const bool utf8_target)
{
- dVAR;
WB_enum wb;
PERL_ARGS_ASSERT_BACKUP_ONE_WB;
STATIC SSize_t
S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
{
- dVAR;
const bool utf8_target = reginfo->is_utf8_target;
const U32 uniflags = UTF8_ALLOW_DEFAULT;
REGEXP *rex_sv = reginfo->prog;
S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
char * loceol, regmatch_info *const reginfo, I32 max _pDEPTH)
{
- dVAR;
char *scan; /* Pointer to current position in target string */
I32 c;
char *this_eol = loceol; /* potentially adjusted version. */
STATIC bool
S_reginclass(pTHX_ regexp * const prog, const regnode * const n, const U8* const p, const U8* const p_end, const bool utf8_target)
{
- dVAR;
const char flags = (inRANGE(OP(n), ANYOFH, ANYOFHs))
? 0
: ANYOF_FLAGS(n);
* so code using it would then break), and there has to be a GCB break
* before and after the character. */
- dVAR;
GCB_enum cp_gcb_val, prev_cp_gcb_val, next_cp_gcb_val;
const U8 * prev_cp_start;
* characters for at least one language in the Unicode Common Locale Data
* Repository [CLDR]. */
- dVAR;
/* Things that match /\d/u */
SV * decimals_invlist = PL_XPosix_ptrs[_CC_DIGIT];
void
Perl_sv_clear(pTHX_ SV *const orig_sv)
{
- dVAR;
HV *stash;
U32 type;
const struct body_details *sv_type_details;
void
Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
{
- dVAR;
PERL_ARGS_ASSERT_SV_FREE2;
SV *
Perl_sv_2mortal(pTHX_ SV *const sv)
{
- dVAR;
if (!sv)
return sv;
if (SvIMMORTAL(sv))
SV *
Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
{
- dVAR;
SV *sv;
bool is_utf8 = FALSE;
const char *const orig_src = src;
static SV *
S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
{
- dVAR;
SV *dstr;
PERL_ARGS_ASSERT_SV_DUP_COMMON;
ANY *
Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
{
- dVAR;
ANY * const ss = proto_perl->Isavestack;
const I32 max = proto_perl->Isavestack_max + SS_MAXPUSH;
I32 ix = proto_perl->Isavestack_ix;
PerlInterpreter *
perl_clone(PerlInterpreter *proto_perl, UV flags)
{
- dVAR;
#ifdef PERL_IMPLICIT_SYS
PERL_ARGS_ASSERT_PERL_CLONE;
CLONE_PARAMS *
Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
{
- dVAR;
/* Need to play this game, as newAV() can call safesysmalloc(), and that
does a dTHX; to get the context from thread local storage.
FIXME - under PERL_CORE Newx(), Safefree() and friends should expand to
void
Perl_init_constants(pTHX)
{
- dVAR;
SvREFCNT(&PL_sv_undef) = SvREFCNT_IMMORTAL;
SvFLAGS(&PL_sv_undef) = SVf_READONLY|SVf_PROTECT|SVt_NULL;
STATIC SV*
S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
{
- dVAR;
HE **array;
I32 i;
S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
bool match, const char **desc_p)
{
- dVAR;
SV *sv;
const GV *gv;
const OP *o, *o2, *kid;
void
Perl_lex_stuff_pvn(pTHX_ const char *pv, STRLEN len, U32 flags)
{
- dVAR;
char *bufptr;
PERL_ARGS_ASSERT_LEX_STUFF_PVN;
if (flags & ~(LEX_STUFF_UTF8))
I32
Perl_lex_peek_unichar(pTHX_ U32 flags)
{
- dVAR;
char *s, *bufend;
if (flags & ~(LEX_KEEP_PREVIOUS))
Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_peek_unichar");
const char* context = s - 3;
STRLEN context_len = e - context + 1; /* include all of \N{...} */
- dVAR;
PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME;
&& !instr(s,"indir")
&& instr(PL_origargv[0],"perl"))
{
- dVAR;
char **newargv;
*ipathend = '\0';
static int
yyl_keylookup(pTHX_ char *s, GV *gv)
{
- dVAR;
STRLEN len;
bool anydelim;
I32 key;
int
Perl_yylex(pTHX)
{
- dVAR;
char *s = PL_bufptr;
if (UNLIKELY(PL_parser->recheck_utf8_validity)) {
Perl_wrap_keyword_plugin(pTHX_
Perl_keyword_plugin_t new_plugin, Perl_keyword_plugin_t *old_plugin_p)
{
- dVAR;
PERL_UNUSED_CONTEXT;
PERL_ARGS_ASSERT_WRAP_KEYWORD_PLUGIN;
XS(XS_NamedCapture_TIEHASH)
{
- dVAR; dXSARGS;
+ dXSARGS;
if (items < 1)
croak_xs_usage(cv, "package, ...");
{
XS(XS_NamedCapture_FETCH)
{
- dVAR; dXSARGS;
+ dXSARGS;
dXSI32;
PERL_UNUSED_VAR(cv); /* -W */
PERL_UNUSED_VAR(ax); /* -Wall */
XS(XS_NamedCapture_FIRSTKEY)
{
- dVAR; dXSARGS;
+ dXSARGS;
dXSI32;
PERL_UNUSED_VAR(cv); /* -W */
PERL_UNUSED_VAR(ax); /* -Wall */
/* is this still needed? */
XS(XS_NamedCapture_flags)
{
- dVAR; dXSARGS;
+ dXSARGS;
PERL_UNUSED_VAR(cv); /* -W */
PERL_UNUSED_VAR(ax); /* -Wall */
SP -= items;
bool
Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c)
{
- dVAR;
return _invlist_contains_cp(PL_XPosix_ptrs[classnum], c);
}
bool
Perl__is_uni_perl_idcont(pTHX_ UV c)
{
- dVAR;
return _invlist_contains_cp(PL_utf8_perl_idcont, c);
}
bool
Perl__is_uni_perl_idstart(pTHX_ UV c)
{
- dVAR;
return _invlist_contains_cp(PL_utf8_perl_idstart, c);
}
* The ordinal of the first character of the changed version is returned
* (but note, as explained above, that there may be more.) */
- dVAR;
PERL_ARGS_ASSERT_TO_UNI_UPPER;
if (c < 256) {
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) {
* FOLD_FLAGS_NOMIX_ASCII iff non-ASCII to ASCII folds are prohibited
*/
- dVAR;
PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS;
if (flags & FOLD_FLAGS_LOCALE) {
bool
Perl__is_utf8_FOO(pTHX_ const U8 classnum, const U8 *p, const U8 * const e)
{
- dVAR;
PERL_ARGS_ASSERT__IS_UTF8_FOO;
return is_utf8_common(p, e, PL_XPosix_ptrs[classnum]);
bool
Perl__is_utf8_perl_idstart(pTHX_ const U8 *p, const U8 * const e)
{
- dVAR;
PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART;
return is_utf8_common(p, e, PL_utf8_perl_idstart);
bool
Perl__is_utf8_perl_idcont(pTHX_ const U8 *p, const U8 * const e)
{
- dVAR;
PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT;
return is_utf8_common(p, e, PL_utf8_perl_idcont);
* constructed with this size (to save space and memory), and we return
* pointers, so they must be this size */
- dVAR;
/* 'index' is guaranteed to be non-negative, as this is an inversion map
* that covers all possible inputs. See [perl #133365] */
SSize_t index = _invlist_search(PL_utf8_foldclosures, cp);
* sequence, and the entire sequence will be stored in *ustrp. ustrp will
* contain *lenp bytes */
- dVAR;
PERL_ARGS_ASSERT_TURKIC_LC;
assert(e > p0);
STRLEN *lenp,
bool flags)
{
- dVAR;
UV result;
PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS;
STRLEN *lenp,
bool flags)
{
- dVAR;
UV result;
PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS;
STRLEN *lenp,
bool flags)
{
- dVAR;
UV result;
PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS;
STRLEN *lenp,
U8 flags)
{
- dVAR;
UV result;
PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS;
STATIC bool
S_invoke_exception_hook(pTHX_ SV *ex, bool warn)
{
- dVAR;
HV *stash;
GV *gv;
CV *cv;
void
Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args)
{
- dVAR;
PERL_ARGS_ASSERT_VWARNER;
if (
(PL_warnhook == PERL_WARNHOOK_FATAL || ckDEAD(err)) &&
void
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
- dVAR;
# ifdef __amigaos4__
amigaos4_obtain_environ(__FUNCTION__);
# endif
void
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
- dVAR;
char *envstr;
const Size_t nlen = strlen(nam);
Size_t vlen;
#endif
{
#if defined(USE_ITHREADS)
- dVAR;
/* locks must be held in locking order (if any) */
# ifdef USE_PERLIO
MUTEX_LOCK(&PL_perlio_mutex);
#endif
{
#if defined(USE_ITHREADS)
- dVAR;
/* locks must be released in same order as in atfork_lock() */
# ifdef USE_PERLIO
MUTEX_UNLOCK(&PL_perlio_mutex);
struct sigaction act, oact;
#ifdef USE_ITHREADS
- dVAR;
/* only "parent" interpreter can diddle signals */
if (PL_curinterp != aTHX)
return (Sighandler_t) SIG_ERR;
Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
{
#ifdef USE_ITHREADS
- dVAR;
#endif
struct sigaction act;
Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
{
#ifdef USE_ITHREADS
- dVAR;
#endif
PERL_UNUSED_CONTEXT;
#ifdef USE_ITHREADS
static Signal_t
sig_trap(int signo)
{
- dVAR;
PL_sig_trapped++;
}
Sighandler_t
Perl_rsignal_state(pTHX_ int signo)
{
- dVAR;
Sighandler_t oldsig;
#if defined(USE_ITHREADS) && !defined(WIN32)
Perl_get_context(void)
{
#if defined(USE_ITHREADS)
- dVAR;
# ifdef OLD_PTHREADS_API
pthread_addr_t t;
int error = pthread_getspecific(PL_thr_key, &t);
Perl_set_context(void *t)
{
#if defined(USE_ITHREADS)
- dVAR;
#endif
PERL_ARGS_ASSERT_SET_CONTEXT;
#if defined(USE_ITHREADS)
PPADDR_t*
Perl_get_ppaddr(pTHX)
{
- dVAR;
PERL_UNUSED_CONTEXT;
return (PPADDR_t*)PL_ppaddr;
}
Perl_init_tm(pTHX_ struct tm *ptm) /* see mktime, strftime and asctime */
{
#ifdef HAS_TM_TM_ZONE
- dVAR;
Time_t now;
const struct tm* my_tm;
PERL_UNUSED_CONTEXT;
void
Perl_my_clearenv(pTHX)
{
- dVAR;
#if ! defined(PERL_MICRO)
# if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
PerlEnv_clearenv();
void *
Perl_my_cxt_init(pTHX_ int *indexp, size_t size)
{
- dVAR;
void *p;
int index;
DllExport DIR *
win32_dirp_dup(DIR *const dirp, CLONE_PARAMS *const param)
{
- dVAR;
PerlInterpreter *const from = param->proto_perl;
PerlInterpreter *const to = (PerlInterpreter *)PERL_GET_THX;
static void
out_of_memory(void)
{
- dVAR;
if (PL_curinterp)
croak_no_mem();
void
Perl_sys_intern_init(pTHX)
{
- dVAR;
int i;
w32_perlshell_tokens = NULL;
void
Perl_sys_intern_clear(pTHX)
{
- dVAR;
Safefree(w32_perlshell_tokens);
Safefree(w32_perlshell_vec);
https://perl5.git.perl.org / perl5.git / commitdiff