int
Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
{
- PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg);
+ PERL_UNUSED_ARG(sv);
+ PERL_UNUSED_ARG(mg);
Perl_croak(aTHX_ PL_no_modify);
NORETURN_FUNCTION_END;
}
}
#elif defined(WIN32)
{
- DWORD dwErr = GetLastError();
+ const DWORD dwErr = GetLastError();
sv_setnv(sv, (NV)dwErr);
if (dwErr) {
PerlProc_GetOSError(sv, dwErr);
case '/':
break;
case '[':
- WITH_THR(sv_setiv(sv, (IV)PL_curcop->cop_arybase));
+ WITH_THR(sv_setiv(sv, (IV)CopARYBASE_get(PL_curcop)));
break;
case '|':
if (GvIOp(PL_defoutgv))
dVAR;
const AV * const obj = (AV*)mg->mg_obj;
if (obj) {
- sv_setiv(sv, AvFILL(obj) + PL_curcop->cop_arybase);
+ sv_setiv(sv, AvFILL(obj) + CopARYBASE_get(PL_curcop));
} else {
SvOK_off(sv);
}
dVAR;
AV * const obj = (AV*)mg->mg_obj;
if (obj) {
- av_fill(obj, SvIV(sv) - PL_curcop->cop_arybase);
+ av_fill(obj, SvIV(sv) - CopARYBASE_get(PL_curcop));
} else {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC),
I32 i = mg->mg_len;
if (DO_UTF8(lsv))
sv_pos_b2u(lsv, &i);
- sv_setiv(sv, i + PL_curcop->cop_arybase);
+ sv_setiv(sv, i + CopARYBASE_get(PL_curcop));
return 0;
}
}
if (!mg) {
if (!SvOK(sv))
return 0;
- sv_magic(lsv, NULL, PERL_MAGIC_regex_global, NULL, 0);
- mg = mg_find(lsv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(lsv))
+ sv_force_normal_flags(lsv, 0);
+#endif
+ mg = sv_magicext(lsv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+ NULL, 0);
}
else if (!SvOK(sv)) {
mg->mg_len = -1;
}
len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
- pos = SvIV(sv) - PL_curcop->cop_arybase;
+ pos = SvIV(sv) - CopARYBASE_get(PL_curcop);
if (DO_UTF8(lsv)) {
ulen = sv_len_utf8(lsv);
if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av))
LvTARG(sv) = NULL; /* array can't be extended */
else {
- SV** const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
+ SV* const * const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
if (!svp || (value = *svp) == &PL_sv_undef)
Perl_croak(aTHX_ PL_no_aelem, (I32)LvTARGOFF(sv));
}
sv_setsv(PL_bodytarget, sv);
break;
case '\003': /* ^C */
- PL_minus_c = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ PL_minus_c = (bool)SvIV(sv);
break;
case '\004': /* ^D */
PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
DEBUG_x(dump_all());
#else
- PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
+ PL_debug = (SvIV(sv)) | DEBUG_TOP_FLAG;
#endif
break;
case '\005': /* ^E */
if (*(mg->mg_ptr+1) == '\0') {
#ifdef MACOS_TRADITIONAL
- gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ gMacPerl_OSErr = SvIV(sv);
#else
# ifdef VMS
- set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ set_vaxc_errno(SvIV(sv));
# else
# ifdef WIN32
SetLastError( SvIV(sv) );
# else
# ifdef OS2
- os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ os2_setsyserrno(SvIV(sv));
# else
/* will anyone ever use this? */
- SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
+ SETERRNO(SvIV(sv), 4);
# endif
# endif
# endif
}
break;
case '\006': /* ^F */
- PL_maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_maxsysfd = SvIV(sv);
break;
case '\010': /* ^H */
- PL_hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_hints = SvIV(sv);
break;
case '\011': /* ^I */ /* NOT \t in EBCDIC */
Safefree(PL_inplace);
}
break;
case '\020': /* ^P */
- PL_perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_perldb = SvIV(sv);
if (PL_perldb && !PL_DBsingle)
init_debugger();
break;
#ifdef BIG_TIME
PL_basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
#else
- PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ PL_basetime = (Time_t)SvIV(sv);
#endif
break;
case '\025': /* ^UTF8CACHE */
case '\027': /* ^W & $^WARNING_BITS */
if (*(mg->mg_ptr+1) == '\0') {
if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
- i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ i = SvIV(sv);
PL_dowarn = (PL_dowarn & ~G_WARN_ON)
| (i ? G_WARN_ON : G_WARN_OFF) ;
}
IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO);
break;
case '=':
- IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv));
break;
case '-':
- IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv));
if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
break;
case '%':
- IoPAGE(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv));
break;
case '|':
{
IO * const io = GvIOp(PL_defoutgv);
if(!io)
break;
- if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0)
+ if ((SvIV(sv)) == 0)
IoFLAGS(io) &= ~IOf_FLUSH;
else {
if (!(IoFLAGS(io) & IOf_FLUSH)) {
}
break;
case '[':
- PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ CopARYBASE_set(&PL_compiling, SvIV(sv));
break;
case '?':
#ifdef COMPLEX_STATUS
STATUS_NATIVE_CHILD_SET((U32)SvIV(sv));
else
#endif
- STATUS_UNIX_EXIT_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ STATUS_UNIX_EXIT_SET(SvIV(sv));
break;
case '!':
{
}
break;
case '<':
- PL_uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_uid = SvIV(sv);
if (PL_delaymagic) {
PL_delaymagic |= DM_RUID;
break; /* don't do magic till later */
PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case '>':
- PL_euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_euid = SvIV(sv);
if (PL_delaymagic) {
PL_delaymagic |= DM_EUID;
break; /* don't do magic till later */
PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case '(':
- PL_gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_gid = SvIV(sv);
if (PL_delaymagic) {
PL_delaymagic |= DM_RGID;
break; /* don't do magic till later */
Safefree(gary);
}
#else /* HAS_SETGROUPS */
- PL_egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_egid = SvIV(sv);
#endif /* HAS_SETGROUPS */
if (PL_delaymagic) {
PL_delaymagic |= DM_EGID;
}
/*
+=for apidoc magic_sethint
+
+Triggered by a store to %^H, records the key/value pair to
+C<PL_compiling.cop_hints>. It is assumed that hints aren't storing anything
+that would need a deep copy. Maybe we should warn if we find a reference.
+
+=cut
+*/
+int
+Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
+{
+ dVAR;
+ assert(mg->mg_len == HEf_SVKEY);
+
+ /* mg->mg_obj isn't being used. If needed, it would be possible to store
+ an alternative leaf in there, with PL_compiling.cop_hints being used if
+ it's NULL. If needed for threads, the alternative could lock a mutex,
+ or take other more complex action. */
+
+ /* Something changed in %^H, so it will need to be restored on scope exit.
+ Doing this here saves a lot of doing it manually in perl code (and
+ forgetting to do it, and consequent subtle errors. */
+ PL_hints |= HINT_LOCALIZE_HH;
+ PL_compiling.cop_hints
+ = Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints,
+ (SV *)mg->mg_ptr, newSVsv(sv));
+ return 0;
+}
+
+/*
+=for apidoc magic_sethint
+
+Triggered by a delete from %^H, records the key to C<PL_compiling.cop_hints>.
+
+=cut
+*/
+int
+Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
+{
+ dVAR;
+ assert(mg->mg_len == HEf_SVKEY);
+
+ PL_hints |= HINT_LOCALIZE_HH;
+ PL_compiling.cop_hints
+ = Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints,
+ (SV *)mg->mg_ptr, &PL_sv_placeholder);
+ return 0;
+}
+
+/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
projects / p5sagit/p5-mst-13.2.git / blobdiff