/* mg.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
"magical" properties. When any Perl code tries to read from, or assign to,
an SV marked as magical, it calls the 'get' or 'set' function associated
with that SV's magic. A get is called prior to reading an SV, in order to
-give it a chance to update its interval value (get on $. writes the line
+give it a chance to update its internal value (get on $. writes the line
number of the last read filehandle into to the SV's IV slot), while
set is called after an SV has been written to, in order to allow it to make
-use of it's changed value (set on $/ copies the SV's new value to the
+use of its changed value (set on $/ copies the SV's new value to the
PL_rs global variable).
Magic is implemented as a linked list of MAGIC structures attached to the
# define FAKE_DEFAULT_SIGNAL_HANDLERS
#endif
-static void restore_magic(pTHX_ void *p);
-static void unwind_handler_stack(pTHX_ void *p);
+static void restore_magic(pTHX_ const void *p);
+static void unwind_handler_stack(pTHX_ const void *p);
#ifdef __Lynx__
/* Missing protos on LynxOS */
void
Perl_mg_magical(pTHX_ SV *sv)
{
- MAGIC* mg;
+ const MAGIC* mg;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
- MGVTBL* vtbl = mg->mg_virtual;
+ const MGVTBL* const vtbl = mg->mg_virtual;
if (vtbl) {
if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
SvGMAGICAL_on(sv);
int
Perl_mg_get(pTHX_ SV *sv)
{
+ const I32 mgs_ix = SSNEW(sizeof(MGS));
+ const bool was_temp = SvTEMP(sv);
int new = 0;
MAGIC *newmg, *head, *cur, *mg;
- I32 mgs_ix = SSNEW(sizeof(MGS));
- int was_temp = SvTEMP(sv);
/* guard against sv having being freed midway by holding a private
reference. */
newmg = cur = head = mg = SvMAGIC(sv);
while (mg) {
- MGVTBL *vtbl = mg->mg_virtual;
+ const MGVTBL * const vtbl = mg->mg_virtual;
if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg);
if (SvREFCNT(sv) == 1) {
/* We hold the last reference to this SV, which implies that the
SV was deleted as a side effect of the routines we called. */
- (void)SvOK_off(sv);
+ SvOK_off(sv);
}
return 0;
}
int
Perl_mg_set(pTHX_ SV *sv)
{
- I32 mgs_ix;
+ const I32 mgs_ix = SSNEW(sizeof(MGS));
MAGIC* mg;
MAGIC* nextmg;
- mgs_ix = SSNEW(sizeof(MGS));
save_magic(mgs_ix, sv);
for (mg = SvMAGIC(sv); mg; mg = nextmg) {
- MGVTBL* vtbl = mg->mg_virtual;
+ const MGVTBL* vtbl = mg->mg_virtual;
nextmg = mg->mg_moremagic; /* it may delete itself */
if (mg->mg_flags & MGf_GSKIP) {
mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
STRLEN len;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
- MGVTBL* vtbl = mg->mg_virtual;
+ const MGVTBL * const vtbl = mg->mg_virtual;
if (vtbl && vtbl->svt_len) {
- I32 mgs_ix;
-
- mgs_ix = SSNEW(sizeof(MGS));
+ const I32 mgs_ix = SSNEW(sizeof(MGS));
save_magic(mgs_ix, sv);
/* omit MGf_GSKIP -- not changed here */
len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg);
}
}
- if (DO_UTF8(sv))
- {
+ if (DO_UTF8(sv)) {
U8 *s = (U8*)SvPV(sv, len);
len = Perl_utf8_length(aTHX_ s, s + len);
}
Perl_mg_size(pTHX_ SV *sv)
{
MAGIC* mg;
- I32 len;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
- MGVTBL* vtbl = mg->mg_virtual;
+ const MGVTBL* const vtbl = mg->mg_virtual;
if (vtbl && vtbl->svt_len) {
- I32 mgs_ix;
-
- mgs_ix = SSNEW(sizeof(MGS));
+ const I32 mgs_ix = SSNEW(sizeof(MGS));
+ I32 len;
save_magic(mgs_ix, sv);
/* omit MGf_GSKIP -- not changed here */
len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg);
switch(SvTYPE(sv)) {
case SVt_PVAV:
- len = AvFILLp((AV *) sv); /* Fallback to non-tied array */
- return len;
+ return AvFILLp((AV *) sv); /* Fallback to non-tied array */
case SVt_PVHV:
/* FIXME */
default:
int
Perl_mg_clear(pTHX_ SV *sv)
{
- I32 mgs_ix;
+ const I32 mgs_ix = SSNEW(sizeof(MGS));
MAGIC* mg;
- mgs_ix = SSNEW(sizeof(MGS));
save_magic(mgs_ix, sv);
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
- MGVTBL* vtbl = mg->mg_virtual;
+ const MGVTBL* const vtbl = mg->mg_virtual;
/* omit GSKIP -- never set here */
if (vtbl && vtbl->svt_clear)
*/
MAGIC*
-Perl_mg_find(pTHX_ SV *sv, int type)
+Perl_mg_find(pTHX_ const SV *sv, int type)
{
- MAGIC* mg;
- if (!sv)
- return 0;
- for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
- if (mg->mg_type == type)
- return mg;
+ if (sv) {
+ MAGIC *mg;
+ for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+ if (mg->mg_type == type)
+ return mg;
+ }
}
return 0;
}
int count = 0;
MAGIC* mg;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
- MGVTBL* vtbl = mg->mg_virtual;
+ const MGVTBL* const vtbl = mg->mg_virtual;
if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){
count += CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv, key, klen);
}
MAGIC* mg;
MAGIC* moremagic;
for (mg = SvMAGIC(sv); mg; mg = moremagic) {
- MGVTBL* vtbl = mg->mg_virtual;
+ const MGVTBL* const vtbl = mg->mg_virtual;
moremagic = mg->mg_moremagic;
if (vtbl && vtbl->svt_free)
CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
U32
Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
{
- register REGEXP *rx;
+ register const REGEXP *rx;
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
if (mg->mg_obj) /* @+ */
int
Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
{
- register I32 paren;
- register I32 s;
- register I32 i;
register REGEXP *rx;
- I32 t;
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- paren = mg->mg_len;
+ register const I32 paren = mg->mg_len;
+ register I32 s;
+ register I32 t;
if (paren < 0)
return 0;
if (paren <= (I32)rx->nparens &&
(s = rx->startp[paren]) != -1 &&
(t = rx->endp[paren]) != -1)
{
+ register I32 i;
if (mg->mg_obj) /* @+ */
i = t;
else /* @- */
case '\023': /* ^S */
if (*(mg->mg_ptr+1) == '\0') {
if (PL_lex_state != LEX_NOTPARSING)
- (void)SvOK_off(sv);
+ SvOK_off(sv);
else if (PL_in_eval)
sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE));
else
? (PL_taint_warn || PL_unsafe ? -1 : 1)
: 0);
break;
- case '\025': /* $^UNICODE */
+ case '\025': /* $^UNICODE, $^UTF8LOCALE */
if (strEQ(mg->mg_ptr, "\025NICODE"))
sv_setuv(sv, (UV) PL_unicode);
+ else if (strEQ(mg->mg_ptr, "\025TF8LOCALE"))
+ sv_setuv(sv, (UV) PL_utf8locale);
break;
case '\027': /* ^W & $^WARNING_BITS */
if (*(mg->mg_ptr+1) == '\0')
# endif
{
# ifndef PERL_USE_SAFE_PUTENV
+ if (!PL_use_safe_putenv) {
I32 i;
if (environ == PL_origenviron)
else
for (i = 0; environ[i]; i++)
safesysfree(environ[i]);
+ }
# endif /* PERL_USE_SAFE_PUTENV */
environ[0] = Nullch;
/* XXX Some of this code was copied from Perl_magic_setsig. A little
* refactoring might be in order.
*/
- register char *s;
STRLEN n_a;
SV* to_dec;
- s = MgPV(mg,n_a);
+ register const char *s = MgPV(mg,n_a);
if (*s == '_') {
SV** svp;
if (strEQ(s,"__DIE__"))
int
Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
{
- register char *s;
I32 i;
SV** svp = 0;
/* Need to be careful with SvREFCNT_dec(), because that can have side
SV* save_sv;
#endif
- s = MgPV(mg,len);
+ register const char *s = MgPV(mg,len);
if (*s == '_') {
if (strEQ(s,"__DIE__"))
svp = &PL_diehook;
/* caller is responsible for stack switching/cleanup */
STATIC int
-S_magic_methcall(pTHX_ SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val)
+S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int n, SV *val)
{
dSP;
}
STATIC int
-S_magic_methpack(pTHX_ SV *sv, MAGIC *mg, char *meth)
+S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth)
{
dSP;
Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
{
dSP;
- const char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
+ const char * const meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
ENTER;
SAVETMPS;
return 0;
}
}
- (void)SvOK_off(sv);
+ SvOK_off(sv);
return 0;
}
int
Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
{
- register char *s;
GV* gv;
- STRLEN n_a;
-
+
if (!SvOK(sv))
return 0;
- s = SvPV(sv, n_a);
- if (*s == '*' && s[1])
- s++;
- gv = gv_fetchpv(s,TRUE, SVt_PVGV);
+ gv = gv_fetchsv(sv,TRUE, SVt_PVGV);
if (sv == (SV*)gv)
return 0;
if (GvGP(sv))
Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
{
STRLEN len;
- SV *lsv = LvTARG(sv);
- char *tmps = SvPV(lsv,len);
+ SV * const lsv = LvTARG(sv);
+ const char * const tmps = SvPV(lsv,len);
I32 offs = LvTARGOFF(sv);
I32 rem = LvTARGLEN(sv);
int
Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
{
- SV *lsv = LvTARG(sv);
+ SV * const lsv = LvTARG(sv);
if (!lsv) {
- (void)SvOK_off(sv);
+ SvOK_off(sv);
return 0;
}
Perl_croak(aTHX_ "panic: magic_killbackrefs");
/* XXX Should we check that it hasn't changed? */
SvRV(svp[i]) = 0;
- (void)SvOK_off(svp[i]);
+ SvOK_off(svp[i]);
SvWEAKREF_off(svp[i]);
svp[i] = Nullsv;
}
int
Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
{
- struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
+ const struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
if (uf && uf->uf_set)
(*uf->uf_set)(aTHX_ uf->uf_index, sv);
int
Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
{
- register char *s;
+ register const char *s;
I32 i;
STRLEN len;
switch (*mg->mg_ptr) {
case '\004': /* ^D */
#ifdef DEBUGGING
s = SvPV_nolen(sv);
- PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
+ 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;
if (PL_inplace)
Safefree(PL_inplace);
if (SvOK(sv))
- PL_inplace = savepv(SvPV(sv,len));
+ PL_inplace = savesvpv(sv);
else
PL_inplace = Nullch;
break;
}
if (SvOK(sv)) {
TAINT_PROPER("assigning to $^O");
- PL_osname = savepv(SvPV(sv,len));
+ PL_osname = savesvpv(sv);
}
}
else if (strEQ(mg->mg_ptr, "\017PEN")) {
STRLEN len, i;
int accumulate = 0 ;
int any_fatals = 0 ;
- char * ptr = (char*)SvPV(sv, len) ;
+ const char * const ptr = (char*)SvPV(sv, len) ;
for (i = 0 ; i < len ; ++i) {
accumulate |= ptr[i] ;
any_fatals |= (ptr[i] & 0xAA) ;
break;
case '^':
Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
- IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
- IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+ s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+ IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
break;
case '~':
Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
- IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
- IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+ s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+ IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
break;
case '=':
IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
case '#':
if (PL_ofmt)
Safefree(PL_ofmt);
- PL_ofmt = savepv(SvPV(sv,len));
+ PL_ofmt = savesvpv(sv);
break;
case '[':
PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
case ')':
#ifdef HAS_SETGROUPS
{
- char *p = SvPV(sv, len);
+ const char *p = SvPV(sv, len);
Groups_t gary[NGROUPS];
while (isSPACE(*p))
}
I32
-Perl_whichsig(pTHX_ char *sig)
+Perl_whichsig(pTHX_ const char *sig)
{
- register char **sigv;
+ register const char **sigv;
for (sigv = PL_sig_name; *sigv; sigv++)
if (strEQ(sig,*sigv))
(void)rsignal(sig, PL_csighandlerp);
#endif
#endif /* !PERL_MICRO */
- Perl_die(aTHX_ Nullformat);
+ DieNull;
}
cleanup:
if (flags & 1)
static void
-restore_magic(pTHX_ void *p)
+restore_magic(pTHX_ const void *p)
{
MGS* mgs = SSPTR(PTR2IV(p), MGS*);
SV* sv = mgs->mgs_sv;
}
static void
-unwind_handler_stack(pTHX_ void *p)
+unwind_handler_stack(pTHX_ const void *p)
{
- U32 flags = *(U32*)p;
+ const U32 flags = *(const U32*)p;
if (flags & 1)
PL_savestack_ix -= 5; /* Unprotect save in progress. */
projects / p5sagit/p5-mst-13.2.git / blobdiff