svend = &sva[SvREFCNT(sva)];
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) != SVTYPEMASK && SvREFCNT(sv)) {
- (FCALL)(aTHXo_ sv);
+ (FCALL)(aTHX_ sv);
++visited;
}
}
/* called by sv_report_used() for each live SV */
static void
-do_report_used(pTHXo_ SV *sv)
+do_report_used(pTHX_ SV *sv)
{
if (SvTYPE(sv) != SVTYPEMASK) {
PerlIO_printf(Perl_debug_log, "****\n");
/* called by sv_clean_objs() for each live SV */
static void
-do_clean_objs(pTHXo_ SV *sv)
+do_clean_objs(pTHX_ SV *sv)
{
SV* rv;
#ifndef DISABLE_DESTRUCTOR_KLUDGE
static void
-do_clean_named_objs(pTHXo_ SV *sv)
+do_clean_named_objs(pTHX_ SV *sv)
{
if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
if ( SvOBJECT(GvSV(sv)) ||
/* called by sv_clean_all() for each live SV */
static void
-do_clean_all(pTHXo_ SV *sv)
+do_clean_all(pTHX_ SV *sv)
{
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
SvFLAGS(sv) |= SVf_BREAK;
{
if (PL_op)
Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit,
- " in ", PL_op_desc[PL_op->op_type]);
+ " in ", OP_DESC(PL_op));
else
Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit, "", "");
}
case SVt_PVFM:
case SVt_PVIO:
Perl_croak(aTHX_ "Can't coerce %s to integer in %s", sv_reftype(sv,0),
- PL_op_desc[PL_op->op_type]);
+ OP_DESC(PL_op));
}
(void)SvIOK_only(sv); /* validate number */
SvIVX(sv) = i;
case SVt_PVFM:
case SVt_PVIO:
Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0),
- PL_op_name[PL_op->op_type]);
+ OP_NAME(PL_op));
}
SvNVX(sv) = num;
(void)SvNOK_only(sv); /* validate number */
if (PL_op)
Perl_warner(aTHX_ WARN_NUMERIC,
"Argument \"%s\" isn't numeric in %s", tmpbuf,
- PL_op_desc[PL_op->op_type]);
+ OP_DESC(PL_op));
else
Perl_warner(aTHX_ WARN_NUMERIC,
"Argument \"%s\" isn't numeric", tmpbuf);
}
else if (SvTYPE(sv) < SVt_PVNV)
sv_upgrade(sv, SVt_PVNV);
- if (SvNOKp(sv) && !(SvIOK(sv) || SvPOK(sv))) {
- SvNOK_on(sv);
+ if (SvNOKp(sv)) {
+ return SvNVX(sv);
}
- else if (SvIOKp(sv)) {
+ if (SvIOKp(sv)) {
SvNVX(sv) = SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv);
#ifdef NV_PRESERVES_UV
SvNOK_on(sv);
if (first && ch > 255) {
if (PL_op)
Perl_warner(aTHX_ WARN_UTF8, "Wide character in byte %s",
- PL_op_desc[PL_op->op_type]);
+ OP_DESC(PL_op);
else
Perl_warner(aTHX_ WARN_UTF8, "Wide character in byte");
first = 0;
else {
if (PL_op)
Perl_croak(aTHX_ "Wide character in %s",
- PL_op_desc[PL_op->op_type]);
+ OP_DESC(PL_op));
else
Perl_croak(aTHX_ "Wide character");
}
case SVt_PVIO:
if (PL_op)
Perl_croak(aTHX_ "Bizarre copy of %s in %s", sv_reftype(sstr, 0),
- PL_op_name[PL_op->op_type]);
+ OP_NAME(PL_op));
else
Perl_croak(aTHX_ "Bizarre copy of %s", sv_reftype(sstr, 0));
break;
case PERL_MAGIC_dbline:
mg->mg_virtual = &PL_vtbl_dbline;
break;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
case PERL_MAGIC_mutex:
mg->mg_virtual = &PL_vtbl_mutex;
break;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
#ifdef USE_LOCALE_COLLATE
case PERL_MAGIC_collxfrm:
mg->mg_virtual = &PL_vtbl_collxfrm;
}
if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
/* It's publicly an integer, or privately an integer-not-float */
+#ifdef PERL_PRESERVE_IVUV
oops_its_int:
+#endif
if (SvIsUV(sv)) {
if (SvUVX(sv) == UV_MAX)
sv_setnv(sv, (NV)UV_MAX + 1.0);
flags = SvFLAGS(sv);
if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
/* It's publicly an integer, or privately an integer-not-float */
+#ifdef PERL_PRESERVE_IVUV
oops_its_int:
+#endif
if (SvIsUV(sv)) {
if (SvUVX(sv) == 0) {
(void)SvIOK_only(sv);
return sv_2pv(sv, lp);
}
+/* For -DCRIPPLED_CC only. See also C<sv_2pv_flags()>.
+ */
+
+char *
+Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
+{
+ if (SvPOK(sv)) {
+ *lp = SvCUR(sv);
+ return SvPVX(sv);
+ }
+ return sv_2pv_flags(sv, lp, 0);
+}
+
/*
=for apidoc sv_pvn_force
else {
if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),
- PL_op_name[PL_op->op_type]);
+ OP_NAME(PL_op));
}
else
s = sv_2pv_flags(sv, lp, flags);
#if defined(USE_ITHREADS)
-#if defined(USE_THREADS)
-# include "error: USE_THREADS and USE_ITHREADS are incompatible"
+#if defined(USE_5005THREADS)
+# include "error: USE_5005THREADS and USE_ITHREADS are incompatible"
#endif
#ifndef GpREFCNT_inc
/* see if it is part of the interpreter structure */
if (v >= (void*)proto_perl && v < (void*)(proto_perl+1))
- ret = (void*)(((char*)aTHXo) + (((char*)v) - (char*)proto_perl));
+ ret = (void*)(((char*)aTHX) + (((char*)v) - (char*)proto_perl));
else
ret = v;
I32 i;
char *c = NULL;
void (*dptr) (void*);
- void (*dxptr) (pTHXo_ void*);
+ void (*dxptr) (pTHX_ void*);
OP *o;
Newz(54, nss, max, ANY);
TOPPTR(nss,ix) = gp = gp_dup(gp, param);
(void)GpREFCNT_inc(gp);
gv = (GV*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = gv_dup_inc(c, param);
+ TOPPTR(nss,ix) = gv_dup_inc(gv, param);
c = (char*)POPPTR(ss,ix);
TOPPTR(nss,ix) = pv_dup(c);
iv = POPIV(ss,ix);
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */
dxptr = POPDXPTR(ss,ix);
- TOPDXPTR(nss,ix) = (void (*)(pTHXo_ void*))any_dup((void *)dxptr, proto_perl);
+ TOPDXPTR(nss,ix) = (void (*)(pTHX_ void*))any_dup((void *)dxptr, proto_perl);
break;
case SAVEt_REGCONTEXT:
case SAVEt_ALLOC:
return nss;
}
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
/*
=for apidoc perl_clone
PerlInterpreter *
perl_clone(PerlInterpreter *proto_perl, UV flags)
{
-#ifdef PERL_OBJECT
- CPerlObj *pPerl = (CPerlObj*)proto_perl;
-#endif
-
#ifdef PERL_IMPLICIT_SYS
/* perlhost.h so we need to call into it
IV i;
clone_params* param = (clone_params*) malloc(sizeof(clone_params));
-
-
-# ifdef PERL_OBJECT
- CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO,
- ipD, ipS, ipP);
- PERL_SET_THX(pPerl);
-# else /* !PERL_OBJECT */
PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
PERL_SET_THX(my_perl);
-# ifdef DEBUGGING
+# ifdef DEBUGGING
memset(my_perl, 0xab, sizeof(PerlInterpreter));
PL_markstack = 0;
PL_scopestack = 0;
PL_savestack = 0;
PL_retstack = 0;
PL_sig_pending = 0;
-# else /* !DEBUGGING */
+# else /* !DEBUGGING */
Zero(my_perl, 1, PerlInterpreter);
-# endif /* DEBUGGING */
+# endif /* DEBUGGING */
/* host pointers */
PL_Mem = ipM;
PL_Dir = ipD;
PL_Sock = ipS;
PL_Proc = ipP;
-# endif /* PERL_OBJECT */
#else /* !PERL_IMPLICIT_SYS */
IV i;
clone_params* param = (clone_params*) malloc(sizeof(clone_params));
SvFLAGS(&PL_sv_undef) = SVf_READONLY|SVt_NULL;
ptr_table_store(PL_ptr_table, &proto_perl->Isv_undef, &PL_sv_undef);
-#ifdef PERL_OBJECT
- SvUPGRADE(&PL_sv_no, SVt_PVNV);
-#else
SvANY(&PL_sv_no) = new_XPVNV();
-#endif
SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
SvFLAGS(&PL_sv_no) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
SvPVX(&PL_sv_no) = SAVEPVN(PL_No, 0);
SvNVX(&PL_sv_no) = 0;
ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
-#ifdef PERL_OBJECT
- SvUPGRADE(&PL_sv_yes, SVt_PVNV);
-#else
SvANY(&PL_sv_yes) = new_XPVNV();
-#endif
SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
SvFLAGS(&PL_sv_yes) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
SvPVX(&PL_sv_yes) = SAVEPVN(PL_Yes, 1);
PL_reg_re = (regexp*)NULL;
PL_reg_ganch = Nullch;
PL_reg_sv = Nullsv;
- PL_reg_sv_utf8 = FALSE;
+ PL_reg_match_utf8 = FALSE;
PL_reg_magic = (MAGIC*)NULL;
PL_reg_oldpos = 0;
PL_reg_oldcurpm = (PMOP*)NULL;
SvREFCNT_dec(param->stashes);
Safefree(param);
-#ifdef PERL_OBJECT
- return (PerlInterpreter*)pPerl;
-#else
return my_perl;
-#endif
}
-#else /* !USE_ITHREADS */
-
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
#endif /* USE_ITHREADS */