static IV asIV _((SV* sv));
static UV asUV _((SV* sv));
static SV *more_sv _((void));
-static XPVIV *more_xiv _((void));
-static XPVNV *more_xnv _((void));
-static XPV *more_xpv _((void));
-static XRV *more_xrv _((void));
+static void more_xiv _((void));
+static void more_xnv _((void));
+static void more_xpv _((void));
+static void more_xrv _((void));
static XPVIV *new_xiv _((void));
static XPVNV *new_xnv _((void));
static XPV *new_xpv _((void));
reg_add(sv)
SV* sv;
{
- if (sv_count >= (registry_size >> 1))
+ if (PL_sv_count >= (registry_size >> 1))
{
SV **oldreg = registry;
I32 oldsize = registry_size;
}
REG_ADD(sv);
- ++sv_count;
+ ++PL_sv_count;
}
static void
SV* sv;
{
REG_REMOVE(sv);
- --sv_count;
+ --PL_sv_count;
}
static void
#define plant_SV(p) \
do { \
- SvANY(p) = (void *)sv_root; \
+ SvANY(p) = (void *)PL_sv_root; \
SvFLAGS(p) = SVTYPEMASK; \
- sv_root = (p); \
- --sv_count; \
+ PL_sv_root = (p); \
+ --PL_sv_count; \
} while (0)
/* sv_mutex must be held while calling uproot_SV() */
#define uproot_SV(p) \
do { \
- (p) = sv_root; \
- sv_root = (SV*)SvANY(p); \
- ++sv_count; \
+ (p) = PL_sv_root; \
+ PL_sv_root = (SV*)SvANY(p); \
+ ++PL_sv_count; \
} while (0)
#define new_SV(p) do { \
LOCK_SV_MUTEX; \
- if (sv_root) \
+ if (PL_sv_root) \
uproot_SV(p); \
else \
(p) = more_sv(); \
#define del_SV(p) do { \
LOCK_SV_MUTEX; \
- if (debug & 32768) \
+ if (PL_debug & 32768) \
del_sv(p); \
else \
plant_SV(p); \
STATIC void
del_sv(SV *p)
{
- if (debug & 32768) {
+ if (PL_debug & 32768) {
SV* sva;
SV* sv;
SV* svend;
int ok = 0;
- for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+ for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
sv = sva + 1;
svend = &sva[SvREFCNT(sva)];
if (p >= sv && p < svend)
Zero(sva, size, char);
/* The first SV in an arena isn't an SV. */
- SvANY(sva) = (void *) sv_arenaroot; /* ptr to next arena */
+ SvANY(sva) = (void *) PL_sv_arenaroot; /* ptr to next arena */
SvREFCNT(sva) = size / sizeof(SV); /* number of SV slots */
SvFLAGS(sva) = flags; /* FAKE if not to be freed */
- sv_arenaroot = sva;
- sv_root = sva + 1;
+ PL_sv_arenaroot = sva;
+ PL_sv_root = sva + 1;
svend = &sva[SvREFCNT(sva) - 1];
sv = sva + 1;
{
register SV* sv;
- if (nice_chunk) {
- sv_add_arena(nice_chunk, nice_chunk_size, 0);
- nice_chunk = Nullch;
+ if (PL_nice_chunk) {
+ sv_add_arena(PL_nice_chunk, PL_nice_chunk_size, 0);
+ PL_nice_chunk = Nullch;
}
else {
char *chunk; /* must use New here to match call to */
SV* sv;
register SV* svend;
- for (sva = sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
+ for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
svend = &sva[SvREFCNT(sva)];
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) != SVTYPEMASK)
void
sv_clean_objs(void)
{
- in_clean_objs = TRUE;
+ PL_in_clean_objs = TRUE;
visit(FUNC_NAME_TO_PTR(do_clean_objs));
#ifndef DISABLE_DESTRUCTOR_KLUDGE
/* some barnacles may yet remain, clinging to typeglobs */
visit(FUNC_NAME_TO_PTR(do_clean_named_objs));
#endif
- in_clean_objs = FALSE;
+ PL_in_clean_objs = FALSE;
}
STATIC void
do_clean_all(SV *sv)
{
- DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops:\n "), sv_dump(sv));)
+ DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%lx\n", sv) );)
SvFLAGS(sv) |= SVf_BREAK;
SvREFCNT_dec(sv);
}
void
sv_clean_all(void)
{
- in_clean_all = TRUE;
+ PL_in_clean_all = TRUE;
visit(FUNC_NAME_TO_PTR(do_clean_all));
- in_clean_all = FALSE;
+ PL_in_clean_all = FALSE;
}
void
/* Free arenas here, but be careful about fake ones. (We assume
contiguity of the fake ones with the corresponding real ones.) */
- for (sva = sv_arenaroot; sva; sva = svanext) {
+ for (sva = PL_sv_arenaroot; sva; sva = svanext) {
svanext = (SV*) SvANY(sva);
while (svanext && SvFAKE(svanext))
svanext = (SV*) SvANY(svanext);
Safefree((void *)sva);
}
- if (nice_chunk)
- Safefree(nice_chunk);
- nice_chunk = Nullch;
- nice_chunk_size = 0;
- sv_arenaroot = 0;
- sv_root = 0;
+ if (PL_nice_chunk)
+ Safefree(PL_nice_chunk);
+ PL_nice_chunk = Nullch;
+ PL_nice_chunk_size = 0;
+ PL_sv_arenaroot = 0;
+ PL_sv_root = 0;
}
STATIC XPVIV*
new_xiv(void)
{
IV* xiv;
- if (xiv_root) {
- xiv = xiv_root;
- /*
- * See comment in more_xiv() -- RAM.
- */
- xiv_root = *(IV**)xiv;
- return (XPVIV*)((char*)xiv - sizeof(XPV));
- }
- return more_xiv();
+ LOCK_SV_MUTEX;
+ if (!PL_xiv_root)
+ more_xiv();
+ xiv = PL_xiv_root;
+ /*
+ * See comment in more_xiv() -- RAM.
+ */
+ PL_xiv_root = *(IV**)xiv;
+ UNLOCK_SV_MUTEX;
+ return (XPVIV*)((char*)xiv - STRUCT_OFFSET(XPVIV, xiv_iv));
}
STATIC void
del_xiv(XPVIV *p)
{
- IV* xiv = (IV*)((char*)(p) + sizeof(XPV));
- *(IV**)xiv = xiv_root;
- xiv_root = xiv;
+ IV* xiv = (IV*)((char*)(p) + STRUCT_OFFSET(XPVIV, xiv_iv));
+ LOCK_SV_MUTEX;
+ *(IV**)xiv = PL_xiv_root;
+ PL_xiv_root = xiv;
+ UNLOCK_SV_MUTEX;
}
-STATIC XPVIV*
+STATIC void
more_xiv(void)
{
register IV* xiv;
register IV* xivend;
XPV* ptr;
New(705, ptr, 1008/sizeof(XPV), XPV);
- ptr->xpv_pv = (char*)xiv_arenaroot; /* linked list of xiv arenas */
- xiv_arenaroot = ptr; /* to keep Purify happy */
+ ptr->xpv_pv = (char*)PL_xiv_arenaroot; /* linked list of xiv arenas */
+ PL_xiv_arenaroot = ptr; /* to keep Purify happy */
xiv = (IV*) ptr;
xivend = &xiv[1008 / sizeof(IV) - 1];
xiv += (sizeof(XPV) - 1) / sizeof(IV) + 1; /* fudge by size of XPV */
- xiv_root = xiv;
+ PL_xiv_root = xiv;
while (xiv < xivend) {
*(IV**)xiv = (IV *)(xiv + 1);
xiv++;
}
*(IV**)xiv = 0;
- return new_xiv();
}
STATIC XPVNV*
new_xnv(void)
{
double* xnv;
- if (xnv_root) {
- xnv = xnv_root;
- xnv_root = *(double**)xnv;
- return (XPVNV*)((char*)xnv - sizeof(XPVIV));
- }
- return more_xnv();
+ LOCK_SV_MUTEX;
+ if (!PL_xnv_root)
+ more_xnv();
+ xnv = PL_xnv_root;
+ PL_xnv_root = *(double**)xnv;
+ UNLOCK_SV_MUTEX;
+ return (XPVNV*)((char*)xnv - STRUCT_OFFSET(XPVNV, xnv_nv));
}
STATIC void
del_xnv(XPVNV *p)
{
- double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
- *(double**)xnv = xnv_root;
- xnv_root = xnv;
+ double* xnv = (double*)((char*)(p) + STRUCT_OFFSET(XPVNV, xnv_nv));
+ LOCK_SV_MUTEX;
+ *(double**)xnv = PL_xnv_root;
+ PL_xnv_root = xnv;
+ UNLOCK_SV_MUTEX;
}
-STATIC XPVNV*
+STATIC void
more_xnv(void)
{
register double* xnv;
New(711, xnv, 1008/sizeof(double), double);
xnvend = &xnv[1008 / sizeof(double) - 1];
xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
- xnv_root = xnv;
+ PL_xnv_root = xnv;
while (xnv < xnvend) {
*(double**)xnv = (double*)(xnv + 1);
xnv++;
}
*(double**)xnv = 0;
- return new_xnv();
}
STATIC XRV*
new_xrv(void)
{
XRV* xrv;
- if (xrv_root) {
- xrv = xrv_root;
- xrv_root = (XRV*)xrv->xrv_rv;
- return xrv;
- }
- return more_xrv();
+ LOCK_SV_MUTEX;
+ if (!PL_xrv_root)
+ more_xrv();
+ xrv = PL_xrv_root;
+ PL_xrv_root = (XRV*)xrv->xrv_rv;
+ UNLOCK_SV_MUTEX;
+ return xrv;
}
STATIC void
del_xrv(XRV *p)
{
- p->xrv_rv = (SV*)xrv_root;
- xrv_root = p;
+ LOCK_SV_MUTEX;
+ p->xrv_rv = (SV*)PL_xrv_root;
+ PL_xrv_root = p;
+ UNLOCK_SV_MUTEX;
}
-STATIC XRV*
+STATIC void
more_xrv(void)
{
register XRV* xrv;
register XRV* xrvend;
- New(712, xrv_root, 1008/sizeof(XRV), XRV);
- xrv = xrv_root;
+ New(712, PL_xrv_root, 1008/sizeof(XRV), XRV);
+ xrv = PL_xrv_root;
xrvend = &xrv[1008 / sizeof(XRV) - 1];
while (xrv < xrvend) {
xrv->xrv_rv = (SV*)(xrv + 1);
xrv++;
}
xrv->xrv_rv = 0;
- return new_xrv();
}
STATIC XPV*
new_xpv(void)
{
XPV* xpv;
- if (xpv_root) {
- xpv = xpv_root;
- xpv_root = (XPV*)xpv->xpv_pv;
- return xpv;
- }
- return more_xpv();
+ LOCK_SV_MUTEX;
+ if (!PL_xpv_root)
+ more_xpv();
+ xpv = PL_xpv_root;
+ PL_xpv_root = (XPV*)xpv->xpv_pv;
+ UNLOCK_SV_MUTEX;
+ return xpv;
}
STATIC void
del_xpv(XPV *p)
{
- p->xpv_pv = (char*)xpv_root;
- xpv_root = p;
+ LOCK_SV_MUTEX;
+ p->xpv_pv = (char*)PL_xpv_root;
+ PL_xpv_root = p;
+ UNLOCK_SV_MUTEX;
}
-STATIC XPV*
+STATIC void
more_xpv(void)
{
register XPV* xpv;
register XPV* xpvend;
- New(713, xpv_root, 1008/sizeof(XPV), XPV);
- xpv = xpv_root;
+ New(713, PL_xpv_root, 1008/sizeof(XPV), XPV);
+ xpv = PL_xpv_root;
xpvend = &xpv[1008 / sizeof(XPV) - 1];
while (xpv < xpvend) {
xpv->xpv_pv = (char*)(xpv + 1);
xpv++;
}
xpv->xpv_pv = 0;
- return new_xpv();
}
#ifdef PURIFY
cur = 0;
len = 0;
nv = SvNVX(sv);
- iv = I_32(nv);
+ iv = (IV)nv;
magic = 0;
stash = 0;
del_XNV(SvANY(sv));
sv_catpv(t, "WILD");
goto finish;
}
- else if (sv == &sv_undef || sv == &sv_no || sv == &sv_yes) {
- if (sv == &sv_undef) {
+ else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes) {
+ if (sv == &PL_sv_undef) {
sv_catpv(t, "SV_UNDEF");
if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
SVs_GMG|SVs_SMG|SVs_RMG)) &&
SvREADONLY(sv))
goto finish;
}
- else if (sv == &sv_no) {
+ else if (sv == &PL_sv_no) {
sv_catpv(t, "SV_NO");
if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
SVs_GMG|SVs_SMG|SVs_RMG)) &&
while (unref--)
sv_catpv(t, ")");
}
- return SvPV(t, na);
+ return SvPV(t, PL_na);
#else /* DEBUGGING */
return "";
#endif /* DEBUGGING */
s = SvPVX(sv);
if (newlen > SvLEN(sv)) { /* need more room? */
if (SvLEN(sv) && s) {
-#ifdef MYMALLOC
+#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
STRLEN l = malloced_size((void*)SvPVX(sv));
if (newlen <= l) {
SvLEN_set(sv, l);
return s;
} else
-#endif
+#endif
Renew(s,newlen,char);
}
else
{
dTHR;
croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
- op_desc[op->op_type]);
+ op_desc[PL_op->op_type]);
}
}
(void)SvIOK_only(sv); /* validate number */
case SVt_PV:
case SVt_PVIV:
sv_upgrade(sv, SVt_PVNV);
- /* FALL THROUGH */
- case SVt_PVNV:
- case SVt_PVMG:
- case SVt_PVBM:
- case SVt_PVLV:
- if (SvOOK(sv))
- (void)SvOOK_off(sv);
break;
+
case SVt_PVGV:
if (SvFAKE(sv)) {
sv_unglob(sv);
{
dTHR;
croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
- op_name[op->op_type]);
+ op_name[PL_op->op_type]);
}
}
SvNVX(sv) = num;
}
*d = '\0';
- if (op)
- warn("Argument \"%s\" isn't numeric in %s", tmpbuf,
- op_name[op->op_type]);
+ if (PL_op)
+ warner(WARN_NUMERIC, "Argument \"%s\" isn't numeric in %s", tmpbuf,
+ op_name[PL_op->op_type]);
else
- warn("Argument \"%s\" isn't numeric", tmpbuf);
+ warner(WARN_NUMERIC, "Argument \"%s\" isn't numeric", tmpbuf);
}
IV
if (SvPOKp(sv) && SvLEN(sv))
return asIV(sv);
if (!SvROK(sv)) {
- if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+ if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
- if (!localizing)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+ warner(WARN_UNINITIALIZED, warn_uninit);
}
return 0;
}
}
if (SvPOKp(sv) && SvLEN(sv))
return asIV(sv);
- if (dowarn)
- warn(warn_uninit);
+ {
+ dTHR;
+ if (ckWARN(WARN_UNINITIALIZED))
+ warner(WARN_UNINITIALIZED, warn_uninit);
+ }
return 0;
}
}
}
else {
dTHR;
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ warner(WARN_UNINITIALIZED, warn_uninit);
return 0;
}
DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2iv(%ld)\n",
if (SvPOKp(sv) && SvLEN(sv))
return asUV(sv);
if (!SvROK(sv)) {
- if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+ if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
- if (!localizing)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+ warner(WARN_UNINITIALIZED, warn_uninit);
}
return 0;
}
}
if (SvPOKp(sv) && SvLEN(sv))
return asUV(sv);
- if (dowarn)
- warn(warn_uninit);
+ {
+ dTHR;
+ if (ckWARN(WARN_UNINITIALIZED))
+ warner(WARN_UNINITIALIZED, warn_uninit);
+ }
return 0;
}
}
SvUVX(sv) = asUV(sv);
}
else {
- if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+ if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
- if (!localizing)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+ warner(WARN_UNINITIALIZED, warn_uninit);
}
return 0;
}
if (SvNOKp(sv))
return SvNVX(sv);
if (SvPOKp(sv) && SvLEN(sv)) {
- if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
+ dTHR;
+ if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
SET_NUMERIC_STANDARD();
return atof(SvPVX(sv));
if (SvIOKp(sv))
return (double)SvIVX(sv);
if (!SvROK(sv)) {
- if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+ if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
- if (!localizing)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+ warner(WARN_UNINITIALIZED, warn_uninit);
}
return 0;
}
return (double)(unsigned long)SvRV(sv);
}
if (SvREADONLY(sv)) {
+ dTHR;
if (SvPOKp(sv) && SvLEN(sv)) {
- if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
+ if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
SET_NUMERIC_STANDARD();
return atof(SvPVX(sv));
}
if (SvIOKp(sv))
return (double)SvIVX(sv);
- if (dowarn)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED))
+ warner(WARN_UNINITIALIZED, warn_uninit);
return 0.0;
}
}
SvNVX(sv) = (double)SvIVX(sv);
}
else if (SvPOKp(sv) && SvLEN(sv)) {
- if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
+ dTHR;
+ if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
not_a_number(sv);
SET_NUMERIC_STANDARD();
SvNVX(sv) = atof(SvPVX(sv));
}
else {
dTHR;
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ warner(WARN_UNINITIALIZED, warn_uninit);
return 0.0;
}
SvNOK_on(sv);
if (numtype == 1)
return atol(SvPVX(sv));
- if (!numtype && dowarn)
- not_a_number(sv);
+ if (!numtype) {
+ dTHR;
+ if (ckWARN(WARN_NUMERIC))
+ not_a_number(sv);
+ }
SET_NUMERIC_STANDARD();
d = atof(SvPVX(sv));
if (d < 0.0)
if (numtype == 1)
return strtoul(SvPVX(sv), Null(char**), 10);
#endif
- if (!numtype && dowarn)
- not_a_number(sv);
+ if (!numtype) {
+ dTHR;
+ if (ckWARN(WARN_NUMERIC))
+ not_a_number(sv);
+ }
SET_NUMERIC_STANDARD();
return U_V(atof(SvPVX(sv)));
}
goto tokensave;
}
if (!SvROK(sv)) {
- if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+ if (!(SvFLAGS(sv) & SVs_PADTMP)) {
dTHR;
- if (!localizing)
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+ warner(WARN_UNINITIALIZED, warn_uninit);
}
*lp = 0;
return "";
== (SVs_OBJECT|SVs_RMG))
&& strEQ(s=HvNAME(SvSTASH(sv)), "Regexp")
&& (mg = mg_find(sv, 'r'))) {
+ dTHR;
regexp *re = (regexp *)mg->mg_obj;
- *lp = re->prelen;
- return re->precomp;
+ if (!mg->mg_ptr) {
+ char *fptr = "msix";
+ char reflags[6];
+ char ch;
+ int left = 0;
+ int right = 4;
+ U16 reganch = (re->reganch & PMf_COMPILETIME) >> 12;
+
+ while(ch = *fptr++) {
+ if(reganch & 1) {
+ reflags[left++] = ch;
+ }
+ else {
+ reflags[right--] = ch;
+ }
+ reganch >>= 1;
+ }
+ if(left != 4) {
+ reflags[left] = '-';
+ left = 5;
+ }
+
+ mg->mg_len = re->prelen + 4 + left;
+ New(616, mg->mg_ptr, mg->mg_len + 1 + left, char);
+ Copy("(?", mg->mg_ptr, 2, char);
+ Copy(reflags, mg->mg_ptr+2, left, char);
+ Copy(":", mg->mg_ptr+left+2, 1, char);
+ Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char);
+ mg->mg_ptr[mg->mg_len - 1] = ')';
+ mg->mg_ptr[mg->mg_len] = 0;
+ }
+ PL_reginterp_cnt += re->program[0].next_off;
+ *lp = mg->mg_len;
+ return mg->mg_ptr;
}
/* Fall through */
case SVt_NULL:
tsv = Nullsv;
goto tokensave;
}
- if (dowarn)
- warn(warn_uninit);
+ {
+ dTHR;
+ if (ckWARN(WARN_UNINITIALIZED))
+ warner(WARN_UNINITIALIZED, warn_uninit);
+ }
*lp = 0;
return "";
}
}
else {
dTHR;
- if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
- warn(warn_uninit);
+ if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ warner(WARN_UNINITIALIZED, warn_uninit);
*lp = 0;
return "";
}
return;
SV_CHECK_THINKFIRST(dstr);
if (!sstr)
- sstr = &sv_undef;
+ sstr = &PL_sv_undef;
stype = SvTYPE(sstr);
dtype = SvTYPE(dstr);
switch (stype) {
case SVt_NULL:
+ undef_sstr:
if (dtype != SVt_PVGV) {
(void)SvOK_off(dstr);
return;
}
break;
case SVt_IV:
- if (dtype != SVt_IV && dtype < SVt_PVIV) {
- if (dtype < SVt_IV)
+ if (SvIOK(sstr)) {
+ switch (dtype) {
+ case SVt_NULL:
sv_upgrade(dstr, SVt_IV);
- else if (dtype == SVt_NV)
+ break;
+ case SVt_NV:
sv_upgrade(dstr, SVt_PVNV);
- else
+ break;
+ case SVt_RV:
+ case SVt_PV:
sv_upgrade(dstr, SVt_PVIV);
+ break;
+ }
+ (void)SvIOK_only(dstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvTAINT(dstr);
+ return;
}
- break;
+ goto undef_sstr;
+
case SVt_NV:
- if (dtype != SVt_NV && dtype < SVt_PVNV) {
- if (dtype < SVt_NV)
+ if (SvNOK(sstr)) {
+ switch (dtype) {
+ case SVt_NULL:
+ case SVt_IV:
sv_upgrade(dstr, SVt_NV);
- else
+ break;
+ case SVt_RV:
+ case SVt_PV:
+ case SVt_PVIV:
sv_upgrade(dstr, SVt_PVNV);
+ break;
+ }
+ SvNVX(dstr) = SvNVX(sstr);
+ (void)SvNOK_only(dstr);
+ SvTAINT(dstr);
+ return;
}
- break;
+ goto undef_sstr;
+
case SVt_RV:
if (dtype < SVt_RV)
sv_upgrade(dstr, SVt_RV);
SvTYPE(SvRV(sstr)) == SVt_PVGV) {
sstr = SvRV(sstr);
if (sstr == dstr) {
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_on(dstr);
GvMULTI_on(dstr);
return;
case SVt_PVHV:
case SVt_PVCV:
case SVt_PVIO:
- if (op)
+ if (PL_op)
croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0),
- op_name[op->op_type]);
+ op_name[PL_op->op_type]);
else
croak("Bizarre copy of %s", sv_reftype(sstr, 0));
break;
SvFAKE_on(dstr); /* can coerce to non-glob */
}
/* ahem, death to those who redefine active sort subs */
- else if (curstackinfo->si_type == SI_SORT
- && GvCV(dstr) && sortcop == CvSTART(GvCV(dstr)))
+ else if (PL_curstackinfo->si_type == PERLSI_SORT
+ && GvCV(dstr) && PL_sortcop == CvSTART(GvCV(dstr)))
croak("Can't redefine active sort subroutine %s",
GvNAME(dstr));
(void)SvOK_off(dstr);
gp_free((GV*)dstr);
GvGP(dstr) = gp_ref(GvGP(sstr));
SvTAINT(dstr);
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_on(dstr);
GvMULTI_on(dstr);
return;
if (sflags & SVf_ROK) {
if (dtype >= SVt_PV) {
if (dtype == SVt_PVGV) {
- dTHR;
SV *sref = SvREFCNT_inc(SvRV(sstr));
SV *dref = 0;
int intro = GvINTRO(dstr);
Newz(602,gp, 1, GP);
GvGP(dstr) = gp_ref(gp);
GvSV(dstr) = NEWSV(72,0);
- GvLINE(dstr) = curcop->cop_line;
+ GvLINE(dstr) = PL_curcop->cop_line;
GvEGV(dstr) = (GV*)dstr;
}
GvMULTI_on(dstr);
else
dref = (SV*)GvAV(dstr);
GvAV(dstr) = (AV*)sref;
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_AV_on(dstr);
break;
case SVt_PVHV:
else
dref = (SV*)GvHV(dstr);
GvHV(dstr) = (HV*)sref;
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_HV_on(dstr);
break;
case SVt_PVCV:
SvREFCNT_dec(GvCV(dstr));
GvCV(dstr) = Nullcv;
GvCVGEN(dstr) = 0; /* Switch off cacheness. */
- sub_generation++;
+ PL_sub_generation++;
}
SAVESPTR(GvCV(dstr));
}
Nullcv));
/* ahem, death to those who redefine
* active sort subs */
- if (curstackinfo->si_type == SI_SORT &&
- sortcop == CvSTART(cv))
+ if (PL_curstackinfo->si_type == PERLSI_SORT &&
+ PL_sortcop == CvSTART(cv))
croak(
"Can't redefine active sort subroutine %s",
GvENAME((GV*)dstr));
- if (dowarn || (const_changed && const_sv)) {
+ if (ckWARN(WARN_REDEFINE) || (const_changed && const_sv)) {
if (!(CvGV(cv) && GvSTASH(CvGV(cv))
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
"autouse")))
- warn(const_sv ?
+ warner(WARN_REDEFINE, const_sv ?
"Constant subroutine %s redefined"
: "Subroutine %s redefined",
GvENAME((GV*)dstr));
GvCV(dstr) = (CV*)sref;
GvCVGEN(dstr) = 0; /* Switch off cacheness. */
GvASSUMECV_on(dstr);
- sub_generation++;
+ PL_sub_generation++;
}
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_CV_on(dstr);
break;
case SVt_PVIO:
else
dref = (SV*)GvSV(dstr);
GvSV(dstr) = sref;
- if (curcop->cop_stash != GvSTASH(dstr))
+ if (PL_curcop->cop_stash != GvSTASH(dstr))
GvIMPORTED_SV_on(dstr);
break;
}
}
else {
if (dtype == SVt_PVGV) {
- if (dowarn)
- warn("Undefined value assigned to typeglob");
+ if (ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Undefined value assigned to typeglob");
}
else
(void)SvOK_off(dstr);
(void)SvOK_off(sv);
return;
}
+ (void)SvOOK_off(sv);
if (SvPVX(sv))
Safefree(SvPVX(sv));
Renew(ptr, len+1, char);
{
if (SvREADONLY(sv)) {
dTHR;
- if (curcop != &compiling)
+ if (PL_curcop != &PL_compiling)
croak(no_modify);
}
if (SvROK(sv))
if (SvREADONLY(sv)) {
dTHR;
- if (curcop != &compiling && !strchr("gBf", how))
+ if (PL_curcop != &PL_compiling && !strchr("gBf", how))
croak(no_modify);
}
if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
case 'B':
mg->mg_virtual = &vtbl_bm;
break;
+ case 'D':
+ mg->mg_virtual = &vtbl_regdata;
+ break;
+ case 'd':
+ mg->mg_virtual = &vtbl_regdatum;
+ break;
case 'E':
mg->mg_virtual = &vtbl_env;
break;
if (SvOBJECT(sv)) {
dTHR;
- if (defstash) { /* Still have a symbol table? */
+ if (PL_defstash) { /* Still have a symbol table? */
djSP;
GV* destructor;
SV tmpref;
destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
if (destructor) {
ENTER;
- PUSHSTACK(SI_DESTROY);
+ PUSHSTACKi(PERLSI_DESTROY);
SvRV(&tmpref) = SvREFCNT_inc(sv);
EXTEND(SP, 2);
PUSHMARK(SP);
perl_call_sv((SV*)GvCV(destructor),
G_DISCARD|G_EVAL|G_KEEPERR);
SvREFCNT(sv)--;
- POPSTACK();
+ POPSTACK;
LEAVE;
}
} while (SvOBJECT(sv) && SvSTASH(sv) != stash);
SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */
SvOBJECT_off(sv); /* Curse the object. */
if (SvTYPE(sv) != SVt_PVIO)
- --sv_objcount; /* XXX Might want something more general */
+ --PL_sv_objcount; /* XXX Might want something more general */
}
if (SvREFCNT(sv)) {
- if (in_clean_objs)
+ if (PL_in_clean_objs)
croak("DESTROY created new reference to dead object");
/* DESTROY gave object new lease on life */
return;
stash = NULL;
switch (SvTYPE(sv)) {
case SVt_PVIO:
- if (IoIFP(sv) != PerlIO_stdin() &&
+ if (IoIFP(sv) &&
+ IoIFP(sv) != PerlIO_stdin() &&
IoIFP(sv) != PerlIO_stdout() &&
IoIFP(sv) != PerlIO_stderr())
io_close((IO*)sv);
case SVt_PVAV:
av_undef((AV*)sv);
break;
+ case SVt_PVLV:
+ SvREFCNT_dec(LvTARG(sv));
+ goto freescalar;
case SVt_PVGV:
gp_free((GV*)sv);
Safefree(GvNAME(sv));
-- JohnPC, 27 Mar 1998 */
stash = GvSTASH(sv);
/* FALL THROUGH */
- case SVt_PVLV:
case SVt_PVMG:
case SVt_PVNV:
case SVt_PVIV:
if (!sv)
return;
- if (SvREADONLY(sv)) {
- if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
- return;
- }
if (SvREFCNT(sv) == 0) {
if (SvFLAGS(sv) & SVf_BREAK)
return;
- if (in_clean_all) /* All is fair */
+ if (PL_in_clean_all) /* All is fair */
+ return;
+ if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ /* make sure SvREFCNT(sv)==0 happens very seldom */
+ SvREFCNT(sv) = (~(U32)0)/2;
return;
+ }
warn("Attempt to free unreferenced scalar");
return;
}
return;
#ifdef DEBUGGING
if (SvTEMP(sv)) {
- warn("Attempt to free temp prematurely: %s", SvPEEK(sv));
+ warn("Attempt to free temp prematurely: SV 0x%lx", (unsigned long)sv);
return;
}
#endif
+ if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ /* make sure SvREFCNT(sv)==0 happens very seldom */
+ SvREFCNT(sv) = (~(U32)0)/2;
+ return;
+ }
sv_clear(sv);
if (! SvREFCNT(sv))
del_SV(sv);
return len;
}
+STRLEN
+sv_len_utf8(register SV *sv)
+{
+ U8 *s;
+ U8 *send;
+ STRLEN len;
+
+ if (!sv)
+ return 0;
+
+#ifdef NOTYET
+ if (SvGMAGICAL(sv))
+ len = mg_length(sv);
+ else
+#endif
+ s = (U8*)SvPV(sv, len);
+ send = s + len;
+ len = 0;
+ while (s < send) {
+ s += UTF8SKIP(s);
+ len++;
+ }
+ return len;
+}
+
+void
+sv_pos_u2b(register SV *sv, I32* offsetp, I32* lenp)
+{
+ U8 *start;
+ U8 *s;
+ U8 *send;
+ I32 uoffset = *offsetp;
+ STRLEN len;
+
+ if (!sv)
+ return;
+
+ start = s = (U8*)SvPV(sv, len);
+ send = s + len;
+ while (s < send && uoffset--)
+ s += UTF8SKIP(s);
+ *offsetp = s - start;
+ if (lenp) {
+ I32 ulen = *lenp;
+ start = s;
+ while (s < send && ulen--)
+ s += UTF8SKIP(s);
+ *lenp = s - start;
+ }
+ return;
+}
+
+void
+sv_pos_b2u(register SV *sv, I32* offsetp)
+{
+ U8 *s;
+ U8 *send;
+ STRLEN len;
+
+ if (!sv)
+ return;
+
+ s = (U8*)SvPV(sv, len);
+ if (len < *offsetp)
+ croak("panic: bad byte offset");
+ send = s + *offsetp;
+ len = 0;
+ while (s < send) {
+ s += UTF8SKIP(s);
+ ++len;
+ }
+ if (s != send) {
+ warn("Malformed UTF-8 character");
+ --len;
+ }
+ *offsetp = len;
+ return;
+}
+
I32
sv_eq(register SV *str1, register SV *str2)
{
STRLEN len1, len2;
I32 retval;
- if (collation_standard)
+ if (PL_collation_standard)
goto raw_compare;
len1 = 0;
MAGIC *mg;
mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : (MAGIC *) NULL;
- if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != collation_ix) {
+ if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != PL_collation_ix) {
char *s, *xf;
STRLEN len, xlen;
if (SvREADONLY(sv)) {
SAVEFREEPV(xf);
*nxp = xlen;
- return xf + sizeof(collation_ix);
+ return xf + sizeof(PL_collation_ix);
}
if (! mg) {
sv_magic(sv, 0, 'o', 0, 0);
}
if (mg && mg->mg_ptr) {
*nxp = mg->mg_len;
- return mg->mg_ptr + sizeof(collation_ix);
+ return mg->mg_ptr + sizeof(PL_collation_ix);
}
else {
*nxp = 0;
(void)SvUPGRADE(sv, SVt_PV);
SvSCREAM_off(sv);
- if (RsSNARF(rs)) {
+ if (RsSNARF(PL_rs)) {
rsptr = NULL;
rslen = 0;
}
- else if (RsRECORD(rs)) {
+ else if (RsRECORD(PL_rs)) {
I32 recsize, bytesread;
char *buffer;
/* Grab the size of the record we're getting */
- recsize = SvIV(SvRV(rs));
+ recsize = SvIV(SvRV(PL_rs));
(void)SvPOK_only(sv); /* Validate pointer */
- /* Make sure we've got the room to yank in the whole thing */
- if (SvLEN(sv) <= recsize + 3) {
- /* No, so make it bigger */
- SvGROW(sv, recsize + 3);
- }
- buffer = SvPVX(sv); /* Get the location of the final buffer */
+ buffer = SvGROW(sv, recsize + 1);
/* Go yank in */
#ifdef VMS
/* VMS wants read instead of fread, because fread doesn't respect */
bytesread = PerlIO_read(fp, buffer, recsize);
#endif
SvCUR_set(sv, bytesread);
+ buffer[bytesread] = '\0';
return(SvCUR(sv) ? SvPVX(sv) : Nullch);
}
- else if (RsPARA(rs)) {
+ else if (RsPARA(PL_rs)) {
rsptr = "\n\n";
rslen = 2;
}
else
- rsptr = SvPV(rs, rslen);
+ rsptr = SvPV(PL_rs, rslen);
rslast = rslen ? rsptr[rslen - 1] : '\0';
- if (RsPARA(rs)) { /* have to do this both before and after */
+ if (RsPARA(PL_rs)) { /* have to do this both before and after */
do { /* to make sure file boundaries work right */
if (PerlIO_eof(fp))
return 0;
}
}
- if (RsPARA(rs)) { /* have to do this both before and after */
+ if (RsPARA(PL_rs)) { /* have to do this both before and after */
while (i != EOF) { /* to make sure file boundaries work right */
i = PerlIO_getc(fp);
if (i != '\n') {
if (SvTHINKFIRST(sv)) {
if (SvREADONLY(sv)) {
dTHR;
- if (curcop != &compiling)
+ if (PL_curcop != &PL_compiling)
croak(no_modify);
}
if (SvROK(sv)) {
+ IV i;
#ifdef OVERLOAD
- if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
+ if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
#endif /* OVERLOAD */
- sv_unref(sv);
+ i = (IV)SvRV(sv);
+ sv_unref(sv);
+ sv_setiv(sv, i);
}
}
if (SvGMAGICAL(sv))
*(d--) = '0';
}
else {
+#ifdef EBCDIC
+ /* MKS: The original code here died if letters weren't consecutive.
+ * at least it didn't have to worry about non-C locales. The
+ * new code assumes that ('z'-'a')==('Z'-'A'), letters are
+ * arranged in order (although not consecutively) and that only
+ * [A-Za-z] are accepted by isALPHA in the C locale.
+ */
+ if (*d != 'z' && *d != 'Z') {
+ do { ++*d; } while (!isALPHA(*d));
+ return;
+ }
+ *(d--) -= 'z' - 'a';
+#else
++*d;
if (isALPHA(*d))
return;
*(d--) -= 'z' - 'a' + 1;
+#endif
}
}
/* oh,oh, the number grew */
if (SvTHINKFIRST(sv)) {
if (SvREADONLY(sv)) {
dTHR;
- if (curcop != &compiling)
+ if (PL_curcop != &PL_compiling)
croak(no_modify);
}
if (SvROK(sv)) {
+ IV i;
#ifdef OVERLOAD
- if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
+ if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
#endif /* OVERLOAD */
- sv_unref(sv);
+ i = (IV)SvRV(sv);
+ sv_unref(sv);
+ sv_setiv(sv, i);
}
}
if (SvGMAGICAL(sv))
sv_mortalgrow(void)
{
dTHR;
- tmps_max += (tmps_max < 512) ? 128 : 512;
- Renew(tmps_stack, tmps_max, SV*);
+ PL_tmps_max += (PL_tmps_max < 512) ? 128 : 512;
+ Renew(PL_tmps_stack, PL_tmps_max, SV*);
}
SV *
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
sv_setsv(sv,oldstr);
- if (++tmps_ix >= tmps_max)
+ if (++PL_tmps_ix >= PL_tmps_max)
sv_mortalgrow();
- tmps_stack[tmps_ix] = sv;
+ PL_tmps_stack[PL_tmps_ix] = sv;
SvTEMP_on(sv);
return sv;
}
SvANY(sv) = 0;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = SVs_TEMP;
- if (++tmps_ix >= tmps_max)
+ if (++PL_tmps_ix >= PL_tmps_max)
sv_mortalgrow();
- tmps_stack[tmps_ix] = sv;
+ PL_tmps_stack[PL_tmps_ix] = sv;
return sv;
}
dTHR;
if (!sv)
return sv;
- if (SvREADONLY(sv) && curcop != &compiling)
- croak(no_modify);
- if (++tmps_ix >= tmps_max)
+ if (SvREADONLY(sv) && SvIMMORTAL(sv))
+ return sv;
+ if (++PL_tmps_ix >= PL_tmps_max)
sv_mortalgrow();
- tmps_stack[tmps_ix] = sv;
+ PL_tmps_stack[PL_tmps_ix] = sv;
SvTEMP_on(sv);
return sv;
}
}
SV *
-newRV(SV *tmpRef)
+newRV_noinc(SV *tmpRef)
{
dTHR;
register SV *sv;
SvFLAGS(sv) = 0;
sv_upgrade(sv, SVt_RV);
SvTEMP_off(tmpRef);
- SvRV(sv) = SvREFCNT_inc(tmpRef);
+ SvRV(sv) = tmpRef;
SvROK_on(sv);
return sv;
}
-
-
SV *
-Perl_newRV_noinc(SV *tmpRef)
+newRV(SV *tmpRef)
{
- register SV *sv;
-
- sv = newRV(tmpRef);
- SvREFCNT_dec(tmpRef);
- return sv;
+ return newRV_noinc(SvREFCNT_inc(tmpRef));
}
/* make an exact duplicate of old */
}
for (i = 0; i <= (I32) HvMAX(stash); i++) {
for (entry = HvARRAY(stash)[i];
- entry;
- entry = HeNEXT(entry)) {
+ entry;
+ entry = HeNEXT(entry))
+ {
if (!todo[(U8)*HeKEY(entry)])
continue;
gv = (GV*)HeVAL(entry);
sv = GvSV(gv);
+ if (SvTHINKFIRST(sv)) {
+ if (!SvREADONLY(sv) && SvROK(sv))
+ sv_unref(sv);
+ continue;
+ }
(void)SvOK_off(sv);
if (SvTYPE(sv) >= SVt_PV) {
SvCUR_set(sv, 0);
if (GvHV(gv) && !HvNAME(GvHV(gv))) {
hv_clear(GvHV(gv));
#ifndef VMS /* VMS has no environ array */
- if (gv == envgv)
+ if (gv == PL_envgv)
environ[0] = Nullch;
#endif
}
croak(no_usym, "filehandle");
if (SvROK(sv))
return sv_2io(SvRV(sv));
- gv = gv_fetchpv(SvPV(sv,na), FALSE, SVt_PVIO);
+ gv = gv_fetchpv(SvPV(sv,PL_na), FALSE, SVt_PVIO);
if (gv)
io = GvIO(gv);
else
io = 0;
if (!io)
- croak("Bad filehandle: %s", SvPV(sv,na));
+ croak("Bad filehandle: %s", SvPV(sv,PL_na));
break;
}
return io;
if (isGV(sv))
gv = (GV*)sv;
else
- gv = gv_fetchpv(SvPV(sv, na), lref, SVt_PVCV);
+ gv = gv_fetchpv(SvPV(sv, PL_na), lref, SVt_PVCV);
*gvp = gv;
if (!gv)
return Nullcv;
Nullop);
LEAVE;
if (!GvCVu(gv))
- croak("Unable to create sub named \"%s\"", SvPV(sv,na));
+ croak("Unable to create sub named \"%s\"", SvPV(sv,PL_na));
}
return GvCVu(gv);
}
if (SvREADONLY(sv)) {
dTHR;
- if (curcop != &compiling)
+ if (PL_curcop != &PL_compiling)
croak(no_modify);
}
else {
dTHR;
croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
- op_name[op->op_type]);
+ op_name[PL_op->op_type]);
}
}
else
sv_setref_pv(SV *rv, char *classname, void *pv)
{
if (!pv) {
- sv_setsv(rv, &sv_undef);
+ sv_setsv(rv, &PL_sv_undef);
SvSETMAGIC(rv);
}
else
croak(no_modify);
if (SvOBJECT(tmpRef)) {
if (SvTYPE(tmpRef) != SVt_PVIO)
- --sv_objcount;
+ --PL_sv_objcount;
SvREFCNT_dec(SvSTASH(tmpRef));
}
}
SvOBJECT_on(tmpRef);
if (SvTYPE(tmpRef) != SVt_PVIO)
- ++sv_objcount;
+ ++PL_sv_objcount;
(void)SvUPGRADE(tmpRef, SVt_PVMG);
SvSTASH(tmpRef) = (HV*)SvREFCNT_inc(stash);
STRLEN precis = 0;
char esignbuf[4];
+ U8 utf8buf[10];
STRLEN esignlen = 0;
char *eptr = Nullch;
goto string;
case 'c':
+ if (IN_UTF8) {
+ if (args)
+ uv = va_arg(*args, int);
+ else
+ uv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
+
+ eptr = (char*)utf8buf;
+ elen = uv_to_utf8((U8*)eptr, uv) - utf8buf;
+ goto string;
+ }
if (args)
c = va_arg(*args, int);
else
elen = sizeof nullstr - 1;
}
}
- else if (svix < svmax)
+ else if (svix < svmax) {
eptr = SvPVx(svargs[svix++], elen);
+ if (IN_UTF8) {
+ if (has_precis && precis < elen) {
+ I32 p = precis;
+ sv_pos_u2b(svargs[svix - 1], &p, 0); /* sticks at end */
+ precis = p;
+ }
+ if (width) { /* fudge width (can't fudge elen) */
+ width += elen - sv_len_utf8(svargs[svix - 1]);
+ }
+ }
+ }
goto string;
case '_':
default:
unknown:
- if (!args && dowarn &&
- (op->op_type == OP_PRTF || op->op_type == OP_SPRINTF)) {
+ if (!args && ckWARN(WARN_PRINTF) &&
+ (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
SV *msg = sv_newmortal();
sv_setpvf(msg, "Invalid conversion in %s: ",
- (op->op_type == OP_PRTF) ? "printf" : "sprintf");
+ (PL_op->op_type == OP_PRTF) ? "printf" : "sprintf");
if (c)
sv_catpvf(msg, isPRINT(c) ? "\"%%%c\"" : "\"%%\\%03o\"",
c & 0xFF);
else
sv_catpv(msg, "end of string");
- warn("%_", msg); /* yes, this is reentrant */
+ warner(WARN_PRINTF, "%_", msg); /* yes, this is reentrant */
}
/* output mangled stuff ... */
break;
case SVt_PVCV:
if (SvPOK(sv))
- PerlIO_printf(Perl_debug_log, " PROTOTYPE = \"%s\"\n", SvPV(sv,na));
+ PerlIO_printf(Perl_debug_log, " PROTOTYPE = \"%s\"\n", SvPV(sv,PL_na));
/* FALL THROUGH */
case SVt_PVFM:
PerlIO_printf(Perl_debug_log, " STASH = 0x%lx\n", (long)CvSTASH(sv));
https://perl5.git.perl.org / perl5.git / blobdiff