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);
) {
SvIOK_on(sv); /* Can this go wrong with rounding? NWC */
DEBUG_c(PerlIO_printf(Perl_debug_log,
- "0x%"UVxf" iv(%g => %"IVdf") (precise)\n",
+ "0x%"UVxf" iv(%"NVgf" => %"IVdf") (precise)\n",
PTR2UV(sv),
SvNVX(sv),
SvIVX(sv)));
that PV->IV would be better than PV->NV->IV
flags already correct - don't set public IOK. */
DEBUG_c(PerlIO_printf(Perl_debug_log,
- "0x%"UVxf" iv(%g => %"IVdf") (imprecise)\n",
+ "0x%"UVxf" iv(%"NVgf" => %"IVdf") (imprecise)\n",
PTR2UV(sv),
SvNVX(sv),
SvIVX(sv)));
) {
SvIOK_on(sv); /* Can this go wrong with rounding? NWC */
DEBUG_c(PerlIO_printf(Perl_debug_log,
- "0x%"UVxf" uv(%g => %"IVdf") (precise)\n",
+ "0x%"UVxf" uv(%"NVgf" => %"IVdf") (precise)\n",
PTR2UV(sv),
SvNVX(sv),
SvIVX(sv)));
that PV->IV would be better than PV->NV->IV
flags already correct - don't set public IOK. */
DEBUG_c(PerlIO_printf(Perl_debug_log,
- "0x%"UVxf" uv(%g => %"IVdf") (imprecise)\n",
+ "0x%"UVxf" uv(%"NVgf" => %"IVdf") (imprecise)\n",
PTR2UV(sv),
SvNVX(sv),
SvIVX(sv)));
}
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);
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
CvROOT(dstr) = OpREFCNT_inc(CvROOT(sstr));
CvXSUB(dstr) = CvXSUB(sstr);
CvXSUBANY(dstr) = CvXSUBANY(sstr);
+ if (CvCONST(sstr)) {
+ CvXSUBANY(dstr).any_ptr = GvUNIQUE(CvGV(sstr)) ?
+ SvREFCNT_inc(CvXSUBANY(sstr).any_ptr) :
+ sv_dup_inc(CvXSUBANY(sstr).any_ptr, param);
+ }
CvGV(dstr) = gv_dup(CvGV(sstr), param);
if (param->flags & CLONEf_COPY_STACKS) {
CvDEPTH(dstr) = CvDEPTH(sstr);
/* 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
*/
/* XXX the above needs expanding by someone who actually understands it ! */
+EXTERN_C PerlInterpreter *
+perl_clone_host(PerlInterpreter* proto_perl, UV flags);
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_e_script = sv_dup_inc(proto_perl->Ie_script, param);
PL_perldb = proto_perl->Iperldb;
PL_perl_destruct_level = proto_perl->Iperl_destruct_level;
+ PL_exit_flags = proto_perl->Iexit_flags;
/* magical thingies */
/* XXX time(&PL_basetime) when asked for? */
PL_reg_re = (regexp*)NULL;
PL_reg_ganch = Nullch;
PL_reg_sv = Nullsv;
+ 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 */
projects / p5sagit/p5-mst-13.2.git / blobdiff