# ifndef NGROUPS
# define NGROUPS 32
# endif
+# ifdef I_GRP
+# include <grp.h>
+# endif
#endif
static void restore_magic(pTHXo_ void *p);
MGS* mgs;
assert(SvMAGICAL(sv));
- SAVEDESTRUCTOR_X(restore_magic, (void*)mgs_ix);
+ SAVEDESTRUCTOR_X(restore_magic, INT2PTR(void*, (IV)mgs_ix));
mgs = SSPTR(mgs_ix, MGS*);
mgs->mgs_sv = sv;
SvMAGICAL_off(sv);
SvREADONLY_off(sv);
- SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+ SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
}
/*
int
Perl_mg_get(pTHX_ SV *sv)
{
- I32 mgs_ix;
- MAGIC* mg;
- MAGIC** mgp;
- int mgp_valid = 0;
+ int new = 0;
+ MAGIC *newmg, *head, *cur, *mg;
+ I32 mgs_ix = SSNEW(sizeof(MGS));
- mgs_ix = SSNEW(sizeof(MGS));
save_magic(mgs_ix, sv);
- mgp = &SvMAGIC(sv);
- while ((mg = *mgp) != 0) {
- MGVTBL* vtbl = mg->mg_virtual;
+ /* We must call svt_get(sv, mg) for each valid entry in the linked
+ list of magic. svt_get() may delete the current entry, add new
+ magic to the head of the list, or upgrade the SV. AMS 20010810 */
+
+ newmg = cur = head = mg = SvMAGIC(sv);
+ while (mg) {
+ MGVTBL *vtbl = mg->mg_virtual;
+
if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg);
- /* Ignore this magic if it's been deleted */
- if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) &&
- (mg->mg_flags & MGf_GSKIP))
- (SSPTR(mgs_ix, MGS*))->mgs_flags = 0;
+ /* Don't restore the flags for this entry if it was deleted. */
+ if (mg->mg_flags & MGf_GSKIP)
+ (SSPTR(mgs_ix, MGS *))->mgs_flags = 0;
}
- /* Advance to next magic (complicated by possible deletion) */
- if (mg == (mgp_valid ? *mgp : SvMAGIC(sv))) {
- mgp = &mg->mg_moremagic;
- mgp_valid = 1;
+
+ mg = mg->mg_moremagic;
+
+ if (new) {
+ /* Have we finished with the new entries we saw? Start again
+ where we left off (unless there are more new entries). */
+ if (mg == head) {
+ new = 0;
+ mg = cur;
+ head = newmg;
+ }
+ }
+
+ /* Were any new entries added? */
+ if (!new && (newmg = SvMAGIC(sv)) != head) {
+ new = 1;
+ cur = mg;
+ mg = newmg;
}
- else
- mgp = &SvMAGIC(sv); /* Re-establish pointer after sv_upgrade */
}
- restore_magic(aTHXo_ (void*)mgs_ix);
+ restore_magic(aTHXo_ INT2PTR(void *, (IV)mgs_ix));
return 0;
}
CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg);
}
- restore_magic(aTHXo_ (void*)mgs_ix);
+ restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
return 0;
}
Perl_mg_length(pTHX_ SV *sv)
{
MAGIC* mg;
- char *junk;
STRLEN len;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
save_magic(mgs_ix, sv);
/* omit MGf_GSKIP -- not changed here */
len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg);
- restore_magic(aTHXo_ (void*)mgs_ix);
+ restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
return len;
}
}
- junk = SvPV(sv, len);
+ if (DO_UTF8(sv))
+ {
+ U8 *s = (U8*)SvPV(sv, len);
+ len = Perl_utf8_length(aTHX_ s, s + len);
+ }
+ else
+ (void)SvPV(sv, len);
return len;
}
save_magic(mgs_ix, sv);
/* omit MGf_GSKIP -- not changed here */
len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg);
- restore_magic(aTHXo_ (void*)mgs_ix);
+ restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
return len;
}
}
CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg);
}
- restore_magic(aTHXo_ (void*)mgs_ix);
+ restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
return 0;
}
{
register REGEXP *rx;
- if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
if (mg->mg_obj) /* @+ */
return rx->nparens;
else /* @- */
register REGEXP *rx;
I32 t;
- if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
paren = mg->mg_len;
if (paren < 0)
return 0;
if (i > 0 && DO_UTF8(PL_reg_sv)) {
char *b = rx->subbeg;
- i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+ if (b)
+ i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
}
- sv_setiv(sv,i);
+
+ sv_setiv(sv, i);
}
}
return 0;
switch (*mg->mg_ptr) {
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': case '&':
- if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
paren = atoi(mg->mg_ptr); /* $& is in [0] */
getparen:
}
return 0;
case '+':
- if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
paren = rx->lastparen;
if (paren)
goto getparen;
}
return 0;
+ case '\016': /* ^N */
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+ paren = rx->lastcloseparen;
+ if (paren)
+ goto getparen;
+ }
+ return 0;
case '`':
- if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
if (rx->startp[0] != -1) {
i = rx->startp[0];
if (i > 0) {
}
return 0;
case '\'':
- if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
if (rx->endp[0] != -1) {
i = rx->sublen - rx->endp[0];
if (i > 0) {
(void)SvOK_off(sv);
else if (PL_in_eval)
sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE));
+ else
+ sv_setiv(sv, 0);
}
break;
case '\024': /* ^T */
break;
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': case '&':
- if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
I32 s1, t1;
/*
getrx:
if (i >= 0) {
- bool was_tainted;
+ bool was_tainted = FALSE;
if (PL_tainting) {
was_tainted = PL_tainted;
PL_tainted = FALSE;
sv_setsv(sv,&PL_sv_undef);
break;
case '+':
- if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
paren = rx->lastparen;
if (paren)
goto getparen;
}
sv_setsv(sv,&PL_sv_undef);
break;
+ case '\016': /* ^N */
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+ paren = rx->lastcloseparen;
+ if (paren)
+ goto getparen;
+ }
+ sv_setsv(sv,&PL_sv_undef);
+ break;
case '`':
- if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
if ((s = rx->subbeg) && rx->startp[0] != -1) {
i = rx->startp[0];
goto getrx;
sv_setsv(sv,&PL_sv_undef);
break;
case '\'':
- if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
if (rx->subbeg && rx->endp[0] != -1) {
s = rx->subbeg + rx->endp[0];
i = rx->sublen - rx->endp[0];
{
register char *s;
I32 i;
- SV** svp;
+ SV** svp = 0;
STRLEN len;
s = MgPV(mg,len);
Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg)
{
HV *hv = (HV*)LvTARG(sv);
- HE *entry;
I32 i = 0;
-
+
if (hv) {
- (void) hv_iterinit(hv);
- if (! SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
- i = HvKEYS(hv);
- else {
- /*SUPPRESS 560*/
- while ((entry = hv_iternext(hv))) {
- i++;
- }
- }
+ (void) hv_iterinit(hv);
+ if (! SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
+ i = HvKEYS(hv);
+ else {
+ while (hv_iternext(hv))
+ i++;
+ }
}
sv_setiv(sv, (IV)i);
# ifdef WIN32
SetLastError( SvIV(sv) );
# else
-# ifndef OS2
+# ifdef OS2
+ os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+# else
/* will anyone ever use this? */
SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
# endif
* the setproctitle() routine to manipulate that. */
{
s = SvPV(sv, len);
-# if __FreeBSD_version >= 410001
+# if __FreeBSD_version > 410001
/* The leading "-" removes the "perl: " prefix,
* but not the "(perl) suffix from the ps(1)
* output, because that's what ps(1) shows if the
* argv[] is modified. */
- setproctitle("-%s", s, len + 1);
+ setproctitle("-%s", s);
# else /* old FreeBSDs, NetBSD, OpenBSD, anyBSD */
/* This doesn't really work if you assume that
* $0 = 'foobar'; will wipe out 'perl' from the $0
break;
}
/* can grab env area too? */
- if (PL_origenviron && (PL_origenviron[0] == s + 1
-#ifdef OS2
- || (PL_origenviron[0] == s + 9 && (s += 8))
-#endif
- )) {
+ if (PL_origenviron && (PL_origenviron[0] == s + 1)) {
my_setenv("NoNe SuCh", Nullch);
/* force copy of environment */
for (i = 0; PL_origenviron[i]; i++)
{
DEBUG_S(PerlIO_printf(Perl_debug_log,
"0x%"UVxf": magic_mutexfree 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(sv));)
+ PTR2UV(thr), PTR2UV(sv)));
if (MgOWNER(mg))
Perl_croak(aTHX_ "panic: magic_mutexfree");
MUTEX_DESTROY(MgMUTEXP(mg));
dSP;
GV *gv = Nullgv;
HV *st;
- SV *sv, *tSv = PL_Sv;
+ SV *sv = Nullsv, *tSv = PL_Sv;
CV *cv = Nullcv;
OP *myop = PL_op;
U32 flags = 0;
- I32 o_save_i = PL_savestack_ix;
XPV *tXpv = PL_Xpv;
#if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
infinity, so we fix 4 (in fact 5): */
if (flags & 1) {
PL_savestack_ix += 5; /* Protect save in progress. */
- o_save_i = PL_savestack_ix;
SAVEDESTRUCTOR_X(unwind_handler_stack, (void*)&flags);
}
if (flags & 4)
https://perl5.git.perl.org / perl5.git / blobdiff