if (PL_nice_chunk) {
sv_add_arena(PL_nice_chunk, PL_nice_chunk_size, 0);
- PL_nice_chunk = Nullch;
+ PL_nice_chunk = NULL;
PL_nice_chunk_size = 0;
}
else {
return cleaned;
}
+/*
+ ARENASETS: a meta-arena implementation which separates arena-info
+ into struct arena_set, which contains an array of struct
+ arena_descs, each holding info for a single arena. By separating
+ the meta-info from the arena, we recover the 1st slot, formerly
+ borrowed for list management. The arena_set is about the size of an
+ arena, avoiding the needless malloc overhead of a naive linked-list
+
+ The cost is 1 arena-set malloc per ~320 arena-mallocs, + the unused
+ memory in the last arena-set (1/2 on average). In trade, we get
+ back the 1st slot in each arena (ie 1.7% of a CV-arena, less for
+ others)
+
+ union arena is declared with a fixed size, but is intended to vary
+ by type, allowing their use for big, rare body-types where theres
+ currently too much wastage (unused arena slots)
+*/
+#define ARENASETS 1
+
+struct arena_desc {
+ char *arena; /* the raw storage, allocated aligned */
+ size_t size; /* its size ~4k typ */
+ int unit_type; /* useful for arena audits */
+ /* info for sv-heads (eventually)
+ int count, flags;
+ */
+};
+
+struct arena_set;
+
+/* Get the maximum number of elements in set[] such that struct arena_set
+ will fit within PERL_ARENA_SIZE, which is probabably just under 4K, and
+ therefore likely to be 1 aligned memory page. */
+
+#define ARENAS_PER_SET ((PERL_ARENA_SIZE - sizeof(struct arena_set*) \
+ - 2 * sizeof(int)) / sizeof (struct arena_desc))
+
+struct arena_set {
+ struct arena_set* next;
+ int set_size; /* ie ARENAS_PER_SET */
+ int curr; /* index of next available arena-desc */
+ struct arena_desc set[ARENAS_PER_SET];
+};
+
+#if !ARENASETS
+
static void
S_free_arena(pTHX_ void **root) {
while (root) {
root = next;
}
}
-
+#endif
+
/*
=for apidoc sv_free_arenas
Safefree(sva);
}
+#if ARENASETS
+ {
+ struct arena_set *next, *aroot = (struct arena_set*) PL_body_arenas;
+
+ for (; aroot; aroot = next) {
+ int max = aroot->curr;
+ for (i=0; i<max; i++) {
+ assert(aroot->set[i].arena);
+ Safefree(aroot->set[i].arena);
+ }
+ next = aroot->next;
+ Safefree(aroot);
+ }
+ }
+#else
S_free_arena(aTHX_ (void**) PL_body_arenas);
+#endif
for (i=0; i<SVt_LAST; i++)
PL_body_roots[i] = 0;
Safefree(PL_nice_chunk);
- PL_nice_chunk = Nullch;
+ PL_nice_chunk = NULL;
PL_nice_chunk_size = 0;
PL_sv_arenaroot = 0;
PL_sv_root = 0;
contexts below (line ~10k)
*/
+/* get_arena(size): when ARENASETS is enabled, this creates
+ custom-sized arenas, otherwize it uses PERL_ARENA_SIZE, as
+ previously done.
+ TBD: export properly for hv.c: S_more_he().
+*/
+void*
+Perl_get_arena(pTHX_ int arena_size)
+{
+#if !ARENASETS
+ union arena* arp;
+
+ /* allocate and attach arena */
+ Newx(arp, PERL_ARENA_SIZE, char);
+ arp->next = PL_body_arenas;
+ PL_body_arenas = arp;
+ return arp;
+
+#else
+ struct arena_desc* adesc;
+ struct arena_set *newroot, *aroot = (struct arena_set*) PL_body_arenas;
+ int curr;
+
+ if (!arena_size)
+ arena_size = PERL_ARENA_SIZE;
+
+ /* may need new arena-set to hold new arena */
+ if (!aroot || aroot->curr >= aroot->set_size) {
+ Newxz(newroot, 1, struct arena_set);
+ newroot->set_size = ARENAS_PER_SET;
+ newroot->next = aroot;
+ aroot = newroot;
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", aroot));
+ }
+
+ /* ok, now have arena-set with at least 1 empty/available arena-desc */
+ curr = aroot->curr++;
+ adesc = &aroot->set[curr];
+ assert(!adesc->arena);
+
+ /* old fixed-size way
+ Newxz(adesc->arena, 1, union arena);
+ adesc->size = sizeof(union arena);
+ */
+ /* new buggy way */
+ Newxz(adesc->arena, arena_size, char);
+ adesc->size = arena_size;
+
+ /* adesc->count = sizeof(struct arena)/size; */
+
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p\n", curr, aroot));
+
+ return adesc->arena;
+#endif
+}
+
STATIC void *
S_more_bodies (pTHX_ size_t size, svtype sv_type)
{
const char *end;
const size_t count = PERL_ARENA_SIZE / size;
- Newx(start, count*size, char);
- *((void **) start) = PL_body_arenas;
- PL_body_arenas = (void *)start;
+ start = (char*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE); /* get a raw arena */
end = start + (count-1) * size;
+#if !ARENASETS
/* The initial slot is used to link the arenas together, so it isn't to be
linked into the list of ready-to-use bodies. */
-
start += size;
+#endif
*root = (void *)start;
};
#define new_body_type(sv_type) \
- (void *)((char *)S_new_body(aTHX_ bodies_by_type[sv_type].size, sv_type)\
- - bodies_by_type[sv_type].offset)
+ (void *)((char *)S_new_body(aTHX_ bodies_by_type[sv_type].size, sv_type))
#define del_body_type(p, sv_type) \
del_body(p, &PL_body_roots[sv_type])
SvFLAGS(sv) &= ~SVTYPEMASK;
SvFLAGS(sv) |= new_type;
+ /* This can't happen, as SVt_NULL is <= all values of new_type, so one of
+ the return statements above will have triggered. */
+ assert (new_type != SVt_NULL);
switch (new_type) {
- case SVt_NULL:
- Perl_croak(aTHX_ "Can't upgrade to undef");
case SVt_IV:
assert(old_type == SVt_NULL);
SvANY(sv) = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
SvRV_set(sv, 0);
return;
case SVt_PVHV:
- SvANY(sv) = new_XPVHV();
- HvFILL(sv) = 0;
- HvMAX(sv) = 0;
- HvTOTALKEYS(sv) = 0;
-
- goto hv_av_common;
-
case SVt_PVAV:
- SvANY(sv) = new_XPVAV();
- AvMAX(sv) = -1;
- AvFILLp(sv) = -1;
- AvALLOC(sv) = 0;
- AvREAL_only(sv);
+ assert(new_type_details->size);
+
+#ifndef PURIFY
+ assert(new_type_details->arena);
+ /* This points to the start of the allocated area. */
+ new_body_inline(new_body, new_type_details->size, new_type);
+ Zero(new_body, new_type_details->size, char);
+ new_body = ((char *)new_body) - new_type_details->offset;
+#else
+ /* We always allocated the full length item with PURIFY. To do this
+ we fake things so that arena is false for all 16 types.. */
+ new_body = new_NOARENAZ(new_type_details);
+#endif
+ SvANY(sv) = new_body;
+ if (new_type == SVt_PVAV) {
+ AvMAX(sv) = -1;
+ AvFILLp(sv) = -1;
+ AvREAL_only(sv);
+ }
- hv_av_common:
/* SVt_NULL isn't the only thing upgraded to AV or HV.
The target created by newSVrv also is, and it can have magic.
However, it never has SvPVX set.
if (old_type >= SVt_PVMG) {
SvMAGIC_set(sv, ((XPVMG*)old_body)->xmg_magic);
SvSTASH_set(sv, ((XPVMG*)old_body)->xmg_stash);
- } else {
- SvMAGIC_set(sv, NULL);
- SvSTASH_set(sv, NULL);
}
break;
/* don't upgrade SVt_PVLV: it can hold a glob */
if (dtype != SVt_PVLV)
sv_upgrade(dstr, SVt_PVGV);
- sv_magic(dstr, dstr, PERL_MAGIC_glob, Nullch, 0);
+ sv_magic(dstr, dstr, PERL_MAGIC_glob, NULL, 0);
GvSTASH(dstr) = GvSTASH(sstr);
if (GvSTASH(dstr))
Perl_sv_add_backref(aTHX_ (SV*)GvSTASH(dstr), dstr);
if (intro) {
if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) {
SvREFCNT_dec(GvCV(dstr));
- GvCV(dstr) = Nullcv;
+ GvCV(dstr) = NULL;
GvCVGEN(dstr) = 0; /* Switch off cacheness. */
PL_sub_generation++;
}
}
if (!intro)
cv_ckproto(cv, (GV*)dstr,
- SvPOK(sref) ? SvPVX_const(sref) : Nullch);
+ SvPOK(sref) ? SvPVX_const(sref) : NULL);
}
GvCV(dstr) = (CV*)sref;
GvCVGEN(dstr) = 0; /* Switch off cacheness. */
}
(void)SvOK_off(dstr);
SvRV_set(dstr, SvREFCNT_inc(SvRV(sstr)));
- SvFLAGS(dstr) |= sflags & (SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK|SVf_ROK
- |SVf_AMAGIC);
- if (sflags & SVp_NOK) {
- SvNV_set(dstr, SvNVX(sstr));
- }
- if (sflags & SVp_IOK) {
- /* Must do this otherwise some other overloaded use of 0x80000000
- gets confused. Probably SVprv_WEAKREF */
- if (sflags & SVf_IVisUV)
- SvIsUV_on(dstr);
- SvIV_set(dstr, SvIVX(sstr));
- }
+ SvFLAGS(dstr) |= sflags & (SVf_ROK|SVf_AMAGIC);
+ assert(!(sflags & SVp_NOK));
+ assert(!(sflags & SVp_IOK));
+ assert(!(sflags & SVf_NOK));
+ assert(!(sflags & SVf_IOK));
}
else if (sflags & SVp_POK) {
bool isSwipe = 0;
{
if (len) { /* this SV was SvIsCOW_normal(sv) */
/* we need to find the SV pointing to us. */
- SV * const current = SV_COW_NEXT_SV(after);
+ SV *current = SV_COW_NEXT_SV(after);
if (current == sv) {
/* The SV we point to points back to us (there were only two of us
const STRLEN len = SvCUR(sv);
SvFAKE_off(sv);
SvREADONLY_off(sv);
- SvPV_set(sv, Nullch);
+ SvPV_set(sv, NULL);
SvLEN_set(sv, 0);
SvGROW(sv, len + 1);
Move(pvx,SvPVX(sv),len,char);
*/
svp[i] = svp[fill];
}
- svp[fill] = Nullsv;
+ svp[fill] = NULL;
AvFILLp(av) = fill - 1;
}
}
(UV)SvFLAGS(referrer));
}
- *svp = Nullsv;
+ *svp = NULL;
}
svp++;
}
const char *pv2;
STRLEN cur2;
I32 eq = 0;
- char *tpv = Nullch;
- SV* svrecode = Nullsv;
+ char *tpv = NULL;
+ SV* svrecode = NULL;
if (!sv1) {
pv1 = "";
dVAR;
STRLEN cur1, cur2;
const char *pv1, *pv2;
- char *tpv = Nullch;
+ char *tpv = NULL;
I32 cmp;
- SV *svrecode = Nullsv;
+ SV *svrecode = NULL;
if (!sv1) {
pv1 = "";
}
return_string_or_null:
- return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
+ return (SvCUR(sv) - append) ? SvPVX(sv) : NULL;
}
/*
if (SvTYPE(old) == SVTYPEMASK) {
if (ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
- return Nullsv;
+ return NULL;
}
new_SV(sv);
/* SV_GMAGIC is the default for sv_setv()
SvOK_off(sv);
if (SvTYPE(sv) >= SVt_PV) {
SvCUR_set(sv, 0);
- if (SvPVX_const(sv) != Nullch)
+ if (SvPVX_const(sv) != NULL)
*SvPVX(sv) = '\0';
SvTAINT(sv);
}
Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
{
dVAR;
- GV *gv = Nullgv;
- CV *cv = Nullcv;
+ GV *gv = NULL;
+ CV *cv = NULL;
- if (!sv)
- return *st = NULL, *gvp = Nullgv, Nullcv;
+ if (!sv) {
+ *st = NULL;
+ *gvp = NULL;
+ return NULL;
+ }
switch (SvTYPE(sv)) {
case SVt_PVCV:
*st = CvSTASH(sv);
- *gvp = Nullgv;
+ *gvp = NULL;
return (CV*)sv;
case SVt_PVHV:
case SVt_PVAV:
*st = NULL;
- *gvp = Nullgv;
- return Nullcv;
+ *gvp = NULL;
+ return NULL;
case SVt_PVGV:
gv = (GV*)sv;
*gvp = gv;
sv = SvRV(sv);
if (SvTYPE(sv) == SVt_PVCV) {
cv = (CV*)sv;
- *gvp = Nullgv;
+ *gvp = NULL;
*st = CvSTASH(cv);
return cv;
}
*gvp = gv;
if (!gv) {
*st = NULL;
- return Nullcv;
+ return NULL;
}
/* Some flags to gv_fetchsv mean don't really create the GV */
if (SvTYPE(gv) != SVt_PVGV) {
SV *tmpsv;
ENTER;
tmpsv = newSV(0);
- gv_efullname3(tmpsv, gv, Nullch);
+ gv_efullname3(tmpsv, gv, NULL);
/* XXX this is probably not what they think they're getting.
* It has the same effect as "sub name;", i.e. just a forward
* declaration! */
argument will be upgraded to an RV. That RV will be modified to point to
the new SV. If the C<pv> argument is NULL then C<PL_sv_undef> will be placed
into the SV. The C<classname> argument indicates the package for the
-blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
+blessing. Set C<classname> to C<NULL> to avoid the blessing. The new SV
will have a reference count of 1, and the RV will be returned.
Do not use with other Perl types such as HV, AV, SV, CV, because those
Copies an integer into a new SV, optionally blessing the SV. The C<rv>
argument will be upgraded to an RV. That RV will be modified to point to
the new SV. The C<classname> argument indicates the package for the
-blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
+blessing. Set C<classname> to C<NULL> to avoid the blessing. The new SV
will have a reference count of 1, and the RV will be returned.
=cut
Copies an unsigned integer into a new SV, optionally blessing the SV. The C<rv>
argument will be upgraded to an RV. That RV will be modified to point to
the new SV. The C<classname> argument indicates the package for the
-blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
+blessing. Set C<classname> to C<NULL> to avoid the blessing. The new SV
will have a reference count of 1, and the RV will be returned.
=cut
Copies a double into a new SV, optionally blessing the SV. The C<rv>
argument will be upgraded to an RV. That RV will be modified to point to
the new SV. The C<classname> argument indicates the package for the
-blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
+blessing. Set C<classname> to C<NULL> to avoid the blessing. The new SV
will have a reference count of 1, and the RV will be returned.
=cut
string must be specified with C<n>. The C<rv> argument will be upgraded to
an RV. That RV will be modified to point to the new SV. The C<classname>
argument indicates the package for the blessing. Set C<classname> to
-C<Nullch> to avoid the blessing. The new SV will have a reference count
+C<NULL> to avoid the blessing. The new SV will have a reference count
of 1, and the RV will be returned.
Note that C<sv_setref_pv> copies the pointer while this copies the string.
*len = endbuf - p;
return p;
}
- return Nullch;
+ return NULL;
}
STRLEN origlen;
I32 svix = 0;
static const char nullstr[] = "(null)";
- SV *argsv = Nullsv;
+ SV *argsv = NULL;
bool has_utf8 = DO_UTF8(sv); /* has the result utf8? */
const bool pat_utf8 = has_utf8; /* the pattern is in utf8? */
- SV *nsv = Nullsv;
+ SV *nsv = NULL;
/* Times 4: a decimal digit takes more than 3 binary digits.
* NV_DIG: mantissa takes than many decimal digits.
* Plus 32: Playing safe. */
U8 utf8buf[UTF8_MAXBYTES+1];
STRLEN esignlen = 0;
- const char *eptr = Nullch;
+ const char *eptr = NULL;
STRLEN elen = 0;
- SV *vecsv = Nullsv;
+ SV *vecsv = NULL;
const U8 *vecstr = Null(U8*);
STRLEN veclen = 0;
char c = 0;
if (RX_MATCH_COPIED(ret))
ret->subbeg = SAVEPVN(r->subbeg, r->sublen);
else
- ret->subbeg = Nullch;
+ ret->subbeg = NULL;
#ifdef PERL_OLD_COPY_ON_WRITE
- ret->saved_copy = Nullsv;
+ ret->saved_copy = NULL;
#endif
ptr_table_store(PL_ptr_table, r, ret);
}
}
else {
- SvPV_set(dstr, Nullch);
+ SvPV_set(dstr, NULL);
AvALLOC((AV*)dstr) = (SV**)NULL;
}
break;
}
}
else {
- SvPV_set(dstr, Nullch);
+ SvPV_set(dstr, NULL);
}
/* Record stashes for possible cloning in Perl_clone(). */
if(hvname)
/* don't dup if copying back - CvGV isn't refcounted, so the
* duped GV may never be freed. A bit of a hack! DAPM */
CvGV(dstr) = (param->flags & CLONEf_JOIN_IN) ?
- Nullgv : gv_dup(CvGV(dstr), param) ;
+ NULL : gv_dup(CvGV(dstr), param) ;
if (!(param->flags & CLONEf_COPY_STACKS)) {
CvDEPTH(dstr) = 0;
}
param->flags = flags;
param->proto_perl = proto_perl;
+ INIT_TRACK_MEMPOOL(my_perl->Imemory_debug_header, my_perl);
+
PL_body_arenas = NULL;
Zero(&PL_body_roots, 1, PL_body_roots);
PL_nice_chunk_size = 0;
PL_sv_count = 0;
PL_sv_objcount = 0;
- PL_sv_root = Nullsv;
- PL_sv_arenaroot = Nullsv;
+ PL_sv_root = NULL;
+ PL_sv_arenaroot = NULL;
PL_debug = proto_perl->Idebug;
if (proto_perl->Iop_mask)
PL_op_mask = SAVEPVN(proto_perl->Iop_mask, PL_maxo);
else
- PL_op_mask = Nullch;
+ PL_op_mask = NULL;
/* PL_asserting = proto_perl->Iasserting; */
/* current interpreter roots */
PL_lastfd = proto_perl->Ilastfd;
PL_oldname = proto_perl->Ioldname; /* XXX not quite right */
PL_Argv = NULL;
- PL_Cmd = Nullch;
+ PL_Cmd = NULL;
PL_gensym = proto_perl->Igensym;
PL_preambled = proto_perl->Ipreambled;
PL_preambleav = av_dup_inc(proto_perl->Ipreambleav, param);
PL_laststatval = proto_perl->Ilaststatval;
PL_laststype = proto_perl->Ilaststype;
- PL_mess_sv = Nullsv;
+ PL_mess_sv = NULL;
PL_ors_sv = sv_dup_inc(proto_perl->Iors_sv, param);
PL_glob_index = proto_perl->Iglob_index;
PL_srand_called = proto_perl->Isrand_called;
PL_uudmap['M'] = 0; /* reinits on demand */
- PL_bitcount = Nullch; /* reinits on demand */
+ PL_bitcount = NULL; /* reinits on demand */
if (proto_perl->Ipsig_pend) {
Newxz(PL_psig_pend, SIG_SIZE, int);
PL_op = proto_perl->Top;
- PL_Sv = Nullsv;
+ PL_Sv = NULL;
PL_Xpv = (XPV*)NULL;
PL_na = proto_perl->Tna;
PL_sortstash = hv_dup(proto_perl->Tsortstash, param);
PL_firstgv = gv_dup(proto_perl->Tfirstgv, param);
PL_secondgv = gv_dup(proto_perl->Tsecondgv, param);
- PL_efloatbuf = Nullch; /* reinits on demand */
+ PL_efloatbuf = NULL; /* reinits on demand */
PL_efloatsize = 0; /* reinits on demand */
/* regex stuff */
PL_screamfirst = NULL;
PL_screamnext = NULL;
PL_maxscream = -1; /* reinits on demand */
- PL_lastscream = Nullsv;
+ PL_lastscream = NULL;
PL_watchaddr = NULL;
- PL_watchok = Nullch;
+ PL_watchok = NULL;
PL_regdummy = proto_perl->Tregdummy;
- PL_regprecomp = Nullch;
+ PL_regprecomp = NULL;
PL_regnpar = 0;
PL_regsize = 0;
PL_colorset = 0; /* reinits PL_colors[] */
/*PL_colors[6] = {0,0,0,0,0,0};*/
- PL_reginput = Nullch;
- PL_regbol = Nullch;
- PL_regeol = Nullch;
+ PL_reginput = NULL;
+ PL_regbol = NULL;
+ PL_regeol = NULL;
PL_regstartp = (I32*)NULL;
PL_regendp = (I32*)NULL;
PL_reglastparen = (U32*)NULL;
PL_reglastcloseparen = (U32*)NULL;
- PL_regtill = Nullch;
+ PL_regtill = NULL;
PL_reg_start_tmp = (char**)NULL;
PL_reg_start_tmpl = 0;
PL_regdata = (struct reg_data*)NULL;
- PL_bostr = Nullch;
+ PL_bostr = NULL;
PL_reg_flags = 0;
PL_reg_eval_set = 0;
PL_regnarrate = 0;
PL_regcc = (CURCUR*)NULL;
PL_reg_call_cc = (struct re_cc_state*)NULL;
PL_reg_re = (regexp*)NULL;
- PL_reg_ganch = Nullch;
- PL_reg_sv = Nullsv;
+ PL_reg_ganch = NULL;
+ PL_reg_sv = NULL;
PL_reg_match_utf8 = FALSE;
PL_reg_magic = (MAGIC*)NULL;
PL_reg_oldpos = 0;
PL_reg_oldcurpm = (PMOP*)NULL;
PL_reg_curpm = (PMOP*)NULL;
- PL_reg_oldsaved = Nullch;
+ PL_reg_oldsaved = NULL;
PL_reg_oldsavedlen = 0;
#ifdef PERL_OLD_COPY_ON_WRITE
- PL_nrs = Nullsv;
+ PL_nrs = NULL;
#endif
PL_reg_maxiter = 0;
PL_reg_leftiter = 0;
- PL_reg_poscache = Nullch;
+ PL_reg_poscache = NULL;
PL_reg_poscache_size= 0;
/* RE engine - function pointers */
if (!hv || SvMAGICAL(hv) || !HvARRAY(hv) ||
(HvTOTALKEYS(hv) > FUV_MAX_SEARCH_SIZE))
- return Nullsv;
+ return NULL;
array = HvARRAY(hv);
HeVAL(entry) == &PL_sv_placeholder)
continue;
if (!HeKEY(entry))
- return Nullsv;
+ return NULL;
if (HeKLEN(entry) == HEf_SVKEY)
return sv_mortalcopy(HeKEY_sv(entry));
return sv_2mortal(newSVpvn(HeKEY(entry), HeKLEN(entry)));
}
}
- return Nullsv;
+ return NULL;
}
/* Look for an entry in the array whose value has the same SV as val;
AV *av;
if (!cv || !CvPADLIST(cv))
- return Nullsv;
+ return NULL;
av = (AV*)(*av_fetch(CvPADLIST(cv), 0, FALSE));
sv = *av_fetch(av, targ, FALSE);
/* SvLEN in a pad name is not to be trusted */
if (!obase || (match && (!uninit_sv || uninit_sv == &PL_sv_undef ||
uninit_sv == &PL_sv_placeholder)))
- return Nullsv;
+ return NULL;
switch (obase->op_type) {
const bool pad = (obase->op_type == OP_PADAV || obase->op_type == OP_PADHV);
const bool hash = (obase->op_type == OP_PADHV || obase->op_type == OP_RV2HV);
I32 index = 0;
- SV *keysv = Nullsv;
+ SV *keysv = NULL;
int subscript_type = FUV_SUBSCRIPT_WITHIN;
if (pad) { /* @lex, %lex */
sv = PAD_SVl(obase->op_targ);
- gv = Nullgv;
+ gv = NULL;
}
else {
if (cUNOPx(obase)->op_first->op_type == OP_GV) {
case OP_PADSV:
if (match && PAD_SVl(obase->op_targ) != uninit_sv)
break;
- return varname(Nullgv, '$', obase->op_targ,
- Nullsv, 0, FUV_SUBSCRIPT_NONE);
+ return varname(NULL, '$', obase->op_targ,
+ NULL, 0, FUV_SUBSCRIPT_NONE);
case OP_GVSV:
gv = cGVOPx_gv(obase);
if (!gv || (match && GvSV(gv) != uninit_sv))
break;
- return varname(gv, '$', 0, Nullsv, 0, FUV_SUBSCRIPT_NONE);
+ return varname(gv, '$', 0, NULL, 0, FUV_SUBSCRIPT_NONE);
case OP_AELEMFAST:
if (obase->op_flags & OPf_SPECIAL) { /* lexical array */
if (!svp || *svp != uninit_sv)
break;
}
- return varname(Nullgv, '$', obase->op_targ,
- Nullsv, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
+ return varname(NULL, '$', obase->op_targ,
+ NULL, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
}
else {
gv = cGVOPx_gv(obase);
break;
}
return varname(gv, '$', 0,
- Nullsv, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
+ NULL, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
}
break;
/* $a[uninit_expr] or $h{uninit_expr} */
return find_uninit_var(cBINOPx(obase)->op_last, uninit_sv, match);
- gv = Nullgv;
+ gv = NULL;
o = cBINOPx(obase)->op_first;
kid = cBINOPx(obase)->op_last;
/* get the av or hv, and optionally the gv */
- sv = Nullsv;
+ sv = NULL;
if (o->op_type == OP_PADAV || o->op_type == OP_PADHV) {
sv = PAD_SV(o->op_targ);
}
return varname(gv, '%', o->op_targ,
cSVOPx_sv(kid), 0, FUV_SUBSCRIPT_HASH);
else
- return varname(gv, '@', o->op_targ, Nullsv,
+ return varname(gv, '@', o->op_targ, NULL,
SvIV(cSVOPx_sv(kid)), FUV_SUBSCRIPT_ARRAY);
}
else {
const I32 index = S_find_array_subscript(aTHX_ (AV*)sv, uninit_sv);
if (index >= 0)
return varname(gv, '@', o->op_targ,
- Nullsv, index, FUV_SUBSCRIPT_ARRAY);
+ NULL, index, FUV_SUBSCRIPT_ARRAY);
}
if (match)
break;
return varname(gv,
(o->op_type == OP_PADAV || o->op_type == OP_RV2AV)
? '@' : '%',
- o->op_targ, Nullsv, 0, FUV_SUBSCRIPT_WITHIN);
+ o->op_targ, NULL, 0, FUV_SUBSCRIPT_WITHIN);
}
break;
if (match && GvSV(gv) != uninit_sv)
break;
return varname(gv, '$', 0,
- Nullsv, 0, FUV_SUBSCRIPT_NONE);
+ NULL, 0, FUV_SUBSCRIPT_NONE);
}
/* other possibilities not handled are:
* open $x; or open my $x; should return '${*$x}'
}
break;
}
- return Nullsv;
+ return NULL;
}
{
dVAR;
if (PL_op) {
- SV* varname = Nullsv;
+ SV* varname = NULL;
if (uninit_sv) {
varname = find_uninit_var(PL_op, uninit_sv,0);
if (varname)