{
dVAR;
SV *const sva = MUTABLE_SV(ptr);
- register SV* sv;
- register SV* svend;
+ SV* sv;
+ SV* svend;
PERL_ARGS_ASSERT_SV_ADD_ARENA;
PERL_ARGS_ASSERT_VISIT;
for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) {
- register const SV * const svend = &sva[SvREFCNT(sva)];
- register SV* sv;
+ const SV * const svend = &sva[SvREFCNT(sva)];
+ SV* sv;
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) != (svtype)SVTYPEMASK
&& (sv->sv_flags & mask) == flags
char *
Perl_sv_grow(pTHX_ register SV *const sv, register STRLEN newlen)
{
- register char *s;
+ char *s;
PERL_ARGS_ASSERT_SV_GROW;
I32
Perl_looks_like_number(pTHX_ SV *const sv)
{
- register const char *sbegin;
+ const char *sbegin;
STRLEN len;
PERL_ARGS_ASSERT_LOOKS_LIKE_NUMBER;
Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags)
{
dVAR;
- register char *s;
+ char *s;
if (!sv) {
if (lp)
Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
{
dVAR;
- register U32 sflags;
- register int dtype;
- register svtype stype;
+ U32 sflags;
+ int dtype;
+ svtype stype;
PERL_ARGS_ASSERT_SV_SETSV_FLAGS;
}
goto undef_sstr;
- case SVt_PVFM:
-#ifdef PERL_OLD_COPY_ON_WRITE
- if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) {
- if (dtype < SVt_PVIV)
- sv_upgrade(dstr, SVt_PVIV);
- break;
- }
- /* Fall through */
-#endif
case SVt_PV:
if (dtype < SVt_PV)
sv_upgrade(dstr, SVt_PV);
dtype = SvTYPE(dstr);
sflags = SvFLAGS(sstr);
- if (dtype == SVt_PVCV || dtype == SVt_PVFM) {
+ if (dtype == SVt_PVCV) {
/* Assigning to a subroutine sets the prototype. */
if (SvOK(sstr)) {
STRLEN len;
} else {
SvOK_off(dstr);
}
- } else if (dtype == SVt_PVAV || dtype == SVt_PVHV) {
+ }
+ else if (dtype == SVt_PVAV || dtype == SVt_PVHV || dtype == SVt_PVFM) {
const char * const type = sv_reftype(dstr,0);
if (PL_op)
/* diag_listed_as: Cannot copy to %s */
&& ((flags & SV_COW_SHARED_HASH_KEYS)
? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
&& (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
- && SvTYPE(sstr) >= SVt_PVIV && SvTYPE(sstr) != SVt_PVFM))
+ && SvTYPE(sstr) >= SVt_PVIV))
: 1)
#endif
) {
{
STRLEN cur = SvCUR(sstr);
STRLEN len = SvLEN(sstr);
- register char *new_pv;
+ char *new_pv;
PERL_ARGS_ASSERT_SV_SETSV_COW;
Perl_sv_setpvn(pTHX_ register SV *const sv, register const char *const ptr, register const STRLEN len)
{
dVAR;
- register char *dptr;
+ char *dptr;
PERL_ARGS_ASSERT_SV_SETPVN;
Perl_sv_setpv(pTHX_ register SV *const sv, register const char *const ptr)
{
dVAR;
- register STRLEN len;
+ STRLEN len;
PERL_ARGS_ASSERT_SV_SETPV;
{
SV_CHECK_THINKFIRST_COW_DROP(sv);
SvUPGRADE(sv, SVt_PV);
+ Safefree(SvPVX(sv));
SvPV_set(sv,(char *)HEK_KEY(share_hek_hek(hek)));
SvCUR_set(sv, HEK_LEN(hek));
SvLEN_set(sv, 0);
Perl_sv_catpv(pTHX_ register SV *const sv, register const char *ptr)
{
dVAR;
- register STRLEN len;
+ STRLEN len;
STRLEN tlen;
char *junk;
Perl_newSV(pTHX_ const STRLEN len)
{
dVAR;
- register SV *sv;
+ SV *sv;
new_SV(sv);
if (len) {
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;
- register char *big;
- register char *mid;
- register char *midend;
- register char *bigend;
- register SSize_t i; /* better be sizeof(STRLEN) or bad things happen */
+ char *big;
+ char *mid;
+ char *midend;
+ char *bigend;
+ SSize_t i; /* better be sizeof(STRLEN) or bad things happen */
STRLEN curlen;
PERL_ARGS_ASSERT_SV_INSERT_FLAGS;
const struct body_details *sv_type_details;
SV* iter_sv = NULL;
SV* next_sv = NULL;
- register SV *sv = orig_sv;
+ SV *sv = orig_sv;
STRLEN hash_index;
PERL_ARGS_ASSERT_SV_CLEAR;
iter_sv = (SV*)SvSTASH(sv);
assert(!SvMAGICAL(sv));
hash_index = ((XPVMG*) SvANY(sv))->xmg_u.xmg_hash_index;
+#ifdef DEBUGGING
+ /* perl -DA does not like rubbish in SvMAGIC. */
+ SvMAGIC_set(sv, 0);
+#endif
/* free any remaining detritus from the hash struct */
Perl_hv_undef_flags(aTHX_ MUTABLE_HV(sv), HV_NAME_SETALL);
calculation in bytes simply because we always know the byte
length. squareroot has the same ordering as the positive value,
so don't bother with the actual square root. */
- const float existing = THREEWAY_SQUARE(0, cache[3], cache[1], blen);
if (byte > cache[1]) {
/* New position is after the existing pair of pairs. */
const float keep_earlier
= THREEWAY_SQUARE(0, cache[1], byte, blen);
if (keep_later < keep_earlier) {
- if (keep_later < existing) {
- cache[2] = cache[0];
- cache[3] = cache[1];
- cache[0] = utf8;
- cache[1] = byte;
- }
+ cache[2] = cache[0];
+ cache[3] = cache[1];
+ cache[0] = utf8;
+ cache[1] = byte;
}
else {
- if (keep_earlier < existing) {
- cache[0] = utf8;
- cache[1] = byte;
- }
+ cache[0] = utf8;
+ cache[1] = byte;
}
}
else if (byte > cache[3]) {
= THREEWAY_SQUARE(0, byte, cache[1], blen);
if (keep_later < keep_earlier) {
- if (keep_later < existing) {
- cache[2] = utf8;
- cache[3] = byte;
- }
+ cache[2] = utf8;
+ cache[3] = byte;
}
else {
- if (keep_earlier < existing) {
- cache[0] = utf8;
- cache[1] = byte;
- }
+ cache[0] = utf8;
+ cache[1] = byte;
}
}
else {
= THREEWAY_SQUARE(0, byte, cache[1], blen);
if (keep_later < keep_earlier) {
- if (keep_later < existing) {
- cache[2] = utf8;
- cache[3] = byte;
- }
+ cache[2] = utf8;
+ cache[3] = byte;
}
else {
- if (keep_earlier < existing) {
- cache[0] = cache[2];
- cache[1] = cache[3];
- cache[2] = utf8;
- cache[3] = byte;
- }
+ cache[0] = cache[2];
+ cache[1] = cache[3];
+ cache[2] = utf8;
+ cache[3] = byte;
}
}
}
dVAR;
const char *rsptr;
STRLEN rslen;
- register STDCHAR rslast;
- register STDCHAR *bp;
- register I32 cnt;
+ STDCHAR rslast;
+ STDCHAR *bp;
+ I32 cnt;
I32 i = 0;
I32 rspara = 0;
* We're going to steal some values from the stdio struct
* and put EVERYTHING in the innermost loop into registers.
*/
- register STDCHAR *ptr;
+ STDCHAR *ptr;
STRLEN bpx;
I32 shortbuffered;
screamer2:
if (rslen) {
- register const STDCHAR * const bpe = buf + sizeof(buf);
+ const STDCHAR * const bpe = buf + sizeof(buf);
bp = buf;
while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = (STDCHAR)i) != rslast && bp < bpe)
; /* keep reading */
Perl_sv_inc_nomg(pTHX_ register SV *const sv)
{
dVAR;
- register char *d;
+ char *d;
int flags;
if (!sv)
Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
{
dVAR;
- register SV *sv;
+ SV *sv;
new_SV(sv);
sv_setsv(sv,oldstr);
Perl_sv_newmortal(pTHX)
{
dVAR;
- register SV *sv;
+ SV *sv;
new_SV(sv);
SvFLAGS(sv) = SVs_TEMP;
Perl_newSVpvn_flags(pTHX_ const char *const s, const STRLEN len, const U32 flags)
{
dVAR;
- register SV *sv;
+ SV *sv;
/* All the flags we don't support must be zero.
And we're new code so I'm going to assert this from the start. */
Perl_newSVpv(pTHX_ const char *const s, const STRLEN len)
{
dVAR;
- register SV *sv;
+ SV *sv;
new_SV(sv);
sv_setpvn(sv, s, len || s == NULL ? len : strlen(s));
Perl_newSVpvn(pTHX_ const char *const buffer, const STRLEN len)
{
dVAR;
- register SV *sv;
+ SV *sv;
new_SV(sv);
sv_setpvn(sv,buffer,len);
Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
{
dVAR;
- register SV *sv;
+ SV *sv;
bool is_utf8 = FALSE;
const char *const orig_src = src;
Perl_newSVpvf_nocontext(const char *const pat, ...)
{
dTHX;
- register SV *sv;
+ SV *sv;
va_list args;
PERL_ARGS_ASSERT_NEWSVPVF_NOCONTEXT;
SV *
Perl_newSVpvf(pTHX_ const char *const pat, ...)
{
- register SV *sv;
+ SV *sv;
va_list args;
PERL_ARGS_ASSERT_NEWSVPVF;
Perl_vnewSVpvf(pTHX_ const char *const pat, va_list *const args)
{
dVAR;
- register SV *sv;
+ SV *sv;
PERL_ARGS_ASSERT_VNEWSVPVF;
Perl_newSVnv(pTHX_ const NV n)
{
dVAR;
- register SV *sv;
+ SV *sv;
new_SV(sv);
sv_setnv(sv,n);
Perl_newSViv(pTHX_ const IV i)
{
dVAR;
- register SV *sv;
+ SV *sv;
new_SV(sv);
sv_setiv(sv,i);
Perl_newSVuv(pTHX_ const UV u)
{
dVAR;
- register SV *sv;
+ SV *sv;
new_SV(sv);
sv_setuv(sv,u);
SV *
Perl_newSV_type(pTHX_ const svtype type)
{
- register SV *sv;
+ SV *sv;
new_SV(sv);
sv_upgrade(sv, type);
Perl_newRV_noinc(pTHX_ SV *const tmpRef)
{
dVAR;
- register SV *sv = newSV_type(SVt_IV);
+ SV *sv = newSV_type(SVt_IV);
PERL_ARGS_ASSERT_NEWRV_NOINC;
Perl_newSVsv(pTHX_ register SV *const old)
{
dVAR;
- register SV *sv;
+ SV *sv;
if (!old)
return NULL;
entry;
entry = HeNEXT(entry))
{
- register GV *gv;
- register SV *sv;
+ GV *gv;
+ SV *sv;
if (!todo[(U8)*HeKEY(entry)])
continue;
if (!sv)
return 0;
if (SvPOK(sv)) {
- register const XPV* const tXpv = (XPV*)SvANY(sv);
+ const XPV* const tXpv = (XPV*)SvANY(sv);
if (tXpv &&
(tXpv->xpv_cur > 1 ||
(tXpv->xpv_cur && *sv->sv_u.svu_pv != '0')))
else
Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
}
- if ((SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)
+ if (SvTYPE(sv) > SVt_PVLV
|| isGV_with_GP(sv))
/* diag_listed_as: Can't coerce %s to %s in %s */
Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),
switch (*q) {
#ifdef WIN32
case 'I': /* Ix, I32x, and I64x */
-# ifdef WIN64
+# ifdef USE_64_BIT_INT
if (q[1] == '6' && q[2] == '4') {
q += 3;
intsize = 'q';
q += 3;
break;
}
-# ifdef WIN64
+# ifdef USE_64_BIT_INT
intsize = 'q';
# endif
q++;
#ifdef HAS_FCHDIR
DIR *pwd;
- register const Direntry_t *dirent;
+ const Direntry_t *dirent;
char smallbuf[256];
char *name = NULL;
STRLEN len = 0;
PL_VertSpace = sv_dup_inc(proto_perl->IVertSpace, param);
+ PL_NonL1NonFinalFold = sv_dup_inc(proto_perl->INonL1NonFinalFold, param);
+
/* utf8 character class swashes */
PL_utf8_alnum = sv_dup_inc(proto_perl->Iutf8_alnum, param);
PL_utf8_alpha = sv_dup_inc(proto_perl->Iutf8_alpha, param);
S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
{
dVAR;
- register HE **array;
+ HE **array;
I32 i;
PERL_ARGS_ASSERT_FIND_HASH_SUBSCRIPT;
array = HvARRAY(hv);
for (i=HvMAX(hv); i>0; i--) {
- register HE *entry;
+ HE *entry;
for (entry = array[i]; entry; entry = HeNEXT(entry)) {
if (HeVAL(entry) != val)
continue;
SV *sv;
AV *av;
- assert(!cv || SvTYPE(cv) == SVt_PVCV);
+ assert(!cv || SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM);
if (!cv || !CvPADLIST(cv))
return NULL;
- av = MUTABLE_AV((*av_fetch(CvPADLIST(cv), 0, FALSE)));
+ av = *PadlistARRAY(CvPADLIST(cv));
sv = *av_fetch(av, targ, FALSE);
sv_setsv(name, sv);
}
https://perl5.git.perl.org / perl5.git / blobdiff