+STRLEN *lp;
+{
+ if (SvPOK(sv)) {
+ *lp = SvCUR(sv);
+ return SvPVX(sv);
+ }
+ return sv_2pv(sv, lp);
+}
+#endif
+
+char *
+sv_pvn_force(sv, lp)
+SV *sv;
+STRLEN *lp;
+{
+ char *s;
+
+ if (SvREADONLY(sv) && curcop != &compiling)
+ croak(no_modify);
+
+ if (SvPOK(sv)) {
+ *lp = SvCUR(sv);
+ }
+ else {
+ if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
+ if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) {
+ sv_unglob(sv);
+ s = SvPVX(sv);
+ *lp = SvCUR(sv);
+ }
+ else
+ croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
+ op_name[op->op_type]);
+ }
+ else
+ s = sv_2pv(sv, lp);
+ if (s != SvPVX(sv)) { /* Almost, but not quite, sv_setpvn() */
+ STRLEN len = *lp;
+
+ if (SvROK(sv))
+ sv_unref(sv);
+ (void)SvUPGRADE(sv, SVt_PV); /* Never FALSE */
+ SvGROW(sv, len + 1);
+ Move(s,SvPVX(sv),len,char);
+ SvCUR_set(sv, len);
+ *SvEND(sv) = '\0';
+ }
+ if (!SvPOK(sv)) {
+ SvPOK_on(sv); /* validate pointer */
+ SvTAINT(sv);
+ DEBUG_c(fprintf(stderr,"0x%lx 2pv(%s)\n",
+ (unsigned long)sv,SvPVX(sv)));
+ }
+ }
+ return SvPVX(sv);
+}
+
+char *
+sv_reftype(sv, ob)
+SV* sv;
+int ob;
+{
+ if (ob && SvOBJECT(sv))
+ return HvNAME(SvSTASH(sv));
+ else {
+ switch (SvTYPE(sv)) {
+ case SVt_NULL:
+ case SVt_IV:
+ case SVt_NV:
+ case SVt_RV:
+ case SVt_PV:
+ case SVt_PVIV:
+ case SVt_PVNV:
+ case SVt_PVMG:
+ case SVt_PVBM:
+ if (SvROK(sv))
+ return "REF";
+ else
+ return "SCALAR";
+ case SVt_PVLV: return "LVALUE";
+ case SVt_PVAV: return "ARRAY";
+ case SVt_PVHV: return "HASH";
+ case SVt_PVCV: return "CODE";
+ case SVt_PVGV: return "GLOB";
+ case SVt_PVFM: return "FORMLINE";
+ default: return "UNKNOWN";
+ }
+ }
+}
+
+int
+sv_isobject(sv)
+SV *sv;
+{
+ if (!SvROK(sv))
+ return 0;
+ sv = (SV*)SvRV(sv);
+ if (!SvOBJECT(sv))
+ return 0;
+ return 1;
+}
+
+int
+sv_isa(sv, name)
+SV *sv;
+char *name;
+{
+ if (!SvROK(sv))
+ return 0;
+ sv = (SV*)SvRV(sv);
+ if (!SvOBJECT(sv))
+ return 0;
+
+ return strEQ(HvNAME(SvSTASH(sv)), name);
+}
+
+SV*
+newSVrv(rv, classname)
+SV *rv;
+char *classname;
+{
+ SV *sv;
+
+ new_SV();
+ SvANY(sv) = 0;
+ SvREFCNT(sv) = 0;
+ SvFLAGS(sv) = 0;
+ sv_upgrade(rv, SVt_RV);
+ SvRV(rv) = SvREFCNT_inc(sv);
+ SvROK_on(rv);
+
+ if (classname) {
+ HV* stash = gv_stashpv(classname, TRUE);
+ (void)sv_bless(rv, stash);
+ }
+ return sv;
+}
+
+SV*
+sv_setref_pv(rv, classname, pv)
+SV *rv;
+char *classname;
+void* pv;
+{
+ if (!pv)
+ sv_setsv(rv, &sv_undef);
+ else
+ sv_setiv(newSVrv(rv,classname), (IV)pv);
+ return rv;
+}
+
+SV*
+sv_setref_iv(rv, classname, iv)
+SV *rv;
+char *classname;
+IV iv;
+{
+ sv_setiv(newSVrv(rv,classname), iv);
+ return rv;
+}
+
+SV*
+sv_setref_nv(rv, classname, nv)
+SV *rv;
+char *classname;
+double nv;
+{
+ sv_setnv(newSVrv(rv,classname), nv);
+ return rv;
+}
+
+SV*
+sv_setref_pvn(rv, classname, pv, n)
+SV *rv;
+char *classname;
+char* pv;
+I32 n;
+{
+ sv_setpvn(newSVrv(rv,classname), pv, n);
+ return rv;
+}
+
+SV*
+sv_bless(sv,stash)
+SV* sv;
+HV* stash;
+{
+ SV *ref;
+ if (!SvROK(sv))
+ croak("Can't bless non-reference value");
+ ref = SvRV(sv);
+ if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
+ if (SvREADONLY(ref))
+ croak(no_modify);
+ if (SvOBJECT(ref) && SvTYPE(ref) != SVt_PVIO)
+ --sv_objcount;
+ }
+ SvOBJECT_on(ref);
+ ++sv_objcount;
+ (void)SvUPGRADE(ref, SVt_PVMG);
+ SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
+
+#ifdef OVERLOAD
+ SvAMAGIC_off(sv);
+ if (Gv_AMG(stash)) {
+ SvAMAGIC_on(sv);
+ }
+#endif /* OVERLOAD */
+
+ return sv;
+}
+
+static void
+sv_unglob(sv)
+SV* sv;
+{
+ assert(SvTYPE(sv) == SVt_PVGV);
+ SvFAKE_off(sv);
+ if (GvGP(sv))
+ gp_free(sv);
+ sv_unmagic(sv, '*');
+ Safefree(GvNAME(sv));
+ GvMULTI_off(sv);
+ SvFLAGS(sv) &= ~SVTYPEMASK;
+ SvFLAGS(sv) |= SVt_PVMG;
+}
+
+void
+sv_unref(sv)
+SV* sv;
+{
+ SV* rv = SvRV(sv);
+
+ SvRV(sv) = 0;
+ SvROK_off(sv);
+ if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
+ SvREFCNT_dec(rv);
+ else
+ sv_2mortal(rv); /* Schedule for freeing later */
+}
+
+#ifdef DEBUGGING
+void
+sv_dump(sv)
+SV* sv;
+{
+ char tmpbuf[1024];
+ char *d = tmpbuf;
+ U32 flags;
+ U32 type;
+
+ if (!sv) {
+ fprintf(stderr, "SV = 0\n");
+ return;
+ }
+
+ flags = SvFLAGS(sv);
+ type = SvTYPE(sv);
+
+ sprintf(d, "(0x%lx)\n REFCNT = %ld\n FLAGS = (",
+ (unsigned long)SvANY(sv), (long)SvREFCNT(sv));
+ d += strlen(d);
+ if (flags & SVs_PADBUSY) strcat(d, "PADBUSY,");
+ if (flags & SVs_PADTMP) strcat(d, "PADTMP,");
+ if (flags & SVs_PADMY) strcat(d, "PADMY,");
+ if (flags & SVs_TEMP) strcat(d, "TEMP,");
+ if (flags & SVs_OBJECT) strcat(d, "OBJECT,");
+ if (flags & SVs_GMG) strcat(d, "GMG,");
+ if (flags & SVs_SMG) strcat(d, "SMG,");
+ if (flags & SVs_RMG) strcat(d, "RMG,");
+ d += strlen(d);
+
+ if (flags & SVf_IOK) strcat(d, "IOK,");
+ if (flags & SVf_NOK) strcat(d, "NOK,");
+ if (flags & SVf_POK) strcat(d, "POK,");
+ if (flags & SVf_ROK) strcat(d, "ROK,");
+ if (flags & SVf_OOK) strcat(d, "OOK,");
+ if (flags & SVf_FAKE) strcat(d, "FAKE,");
+ if (flags & SVf_READONLY) strcat(d, "READONLY,");
+ d += strlen(d);
+
+ if (flags & SVp_IOK) strcat(d, "pIOK,");
+ if (flags & SVp_NOK) strcat(d, "pNOK,");
+ if (flags & SVp_POK) strcat(d, "pPOK,");
+ if (flags & SVp_SCREAM) strcat(d, "SCREAM,");
+ d += strlen(d);
+ if (d[-1] == ',')
+ d--;
+ *d++ = ')';
+ *d = '\0';
+
+ fprintf(stderr, "SV = ");
+ switch (type) {
+ case SVt_NULL:
+ fprintf(stderr,"NULL%s\n", tmpbuf);
+ return;
+ case SVt_IV:
+ fprintf(stderr,"IV%s\n", tmpbuf);
+ break;
+ case SVt_NV:
+ fprintf(stderr,"NV%s\n", tmpbuf);
+ break;
+ case SVt_RV:
+ fprintf(stderr,"RV%s\n", tmpbuf);
+ break;
+ case SVt_PV:
+ fprintf(stderr,"PV%s\n", tmpbuf);
+ break;
+ case SVt_PVIV:
+ fprintf(stderr,"PVIV%s\n", tmpbuf);
+ break;
+ case SVt_PVNV:
+ fprintf(stderr,"PVNV%s\n", tmpbuf);
+ break;
+ case SVt_PVBM:
+ fprintf(stderr,"PVBM%s\n", tmpbuf);
+ break;
+ case SVt_PVMG:
+ fprintf(stderr,"PVMG%s\n", tmpbuf);
+ break;
+ case SVt_PVLV:
+ fprintf(stderr,"PVLV%s\n", tmpbuf);
+ break;
+ case SVt_PVAV:
+ fprintf(stderr,"PVAV%s\n", tmpbuf);
+ break;
+ case SVt_PVHV:
+ fprintf(stderr,"PVHV%s\n", tmpbuf);
+ break;
+ case SVt_PVCV:
+ fprintf(stderr,"PVCV%s\n", tmpbuf);
+ break;
+ case SVt_PVGV:
+ fprintf(stderr,"PVGV%s\n", tmpbuf);
+ break;
+ case SVt_PVFM:
+ fprintf(stderr,"PVFM%s\n", tmpbuf);
+ break;
+ case SVt_PVIO:
+ fprintf(stderr,"PVIO%s\n", tmpbuf);
+ break;
+ default:
+ fprintf(stderr,"UNKNOWN%s\n", tmpbuf);
+ return;
+ }
+ if (type >= SVt_PVIV || type == SVt_IV)
+ fprintf(stderr, " IV = %ld\n", (long)SvIVX(sv));
+ if (type >= SVt_PVNV || type == SVt_NV)
+ fprintf(stderr, " NV = %.*g\n", DBL_DIG, SvNVX(sv));
+ if (SvROK(sv)) {
+ fprintf(stderr, " RV = 0x%lx\n", (long)SvRV(sv));
+ sv_dump(SvRV(sv));
+ return;
+ }
+ if (type < SVt_PV)
+ return;
+ if (type <= SVt_PVLV) {
+ if (SvPVX(sv))
+ fprintf(stderr, " PV = 0x%lx \"%s\"\n CUR = %ld\n LEN = %ld\n",
+ (long)SvPVX(sv), SvPVX(sv), (long)SvCUR(sv), (long)SvLEN(sv));
+ else
+ fprintf(stderr, " PV = 0\n");
+ }
+ if (type >= SVt_PVMG) {
+ if (SvMAGIC(sv)) {
+ fprintf(stderr, " MAGIC = 0x%lx\n", (long)SvMAGIC(sv));
+ }
+ if (SvSTASH(sv))
+ fprintf(stderr, " STASH = %s\n", HvNAME(SvSTASH(sv)));
+ }
+ switch (type) {
+ case SVt_PVLV:
+ fprintf(stderr, " TYPE = %c\n", LvTYPE(sv));
+ fprintf(stderr, " TARGOFF = %ld\n", (long)LvTARGOFF(sv));
+ fprintf(stderr, " TARGLEN = %ld\n", (long)LvTARGLEN(sv));
+ fprintf(stderr, " TARG = 0x%lx\n", (long)LvTARG(sv));
+ sv_dump(LvTARG(sv));
+ break;
+ case SVt_PVAV:
+ fprintf(stderr, " ARRAY = 0x%lx\n", (long)AvARRAY(sv));
+ fprintf(stderr, " ALLOC = 0x%lx\n", (long)AvALLOC(sv));
+ fprintf(stderr, " FILL = %ld\n", (long)AvFILL(sv));
+ fprintf(stderr, " MAX = %ld\n", (long)AvMAX(sv));
+ fprintf(stderr, " ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
+ flags = AvFLAGS(sv);
+ d = tmpbuf;
+ if (flags & AVf_REAL) strcat(d, "REAL,");
+ if (flags & AVf_REIFY) strcat(d, "REIFY,");
+ if (flags & AVf_REUSED) strcat(d, "REUSED,");
+ if (*d)
+ d[strlen(d)-1] = '\0';
+ fprintf(stderr, " FLAGS = (%s)\n", d);
+ break;
+ case SVt_PVHV:
+ fprintf(stderr, " ARRAY = 0x%lx\n",(long)HvARRAY(sv));
+ fprintf(stderr, " KEYS = %ld\n", (long)HvKEYS(sv));
+ fprintf(stderr, " FILL = %ld\n", (long)HvFILL(sv));
+ fprintf(stderr, " MAX = %ld\n", (long)HvMAX(sv));
+ fprintf(stderr, " RITER = %ld\n", (long)HvRITER(sv));
+ fprintf(stderr, " EITER = 0x%lx\n",(long) HvEITER(sv));
+ if (HvPMROOT(sv))
+ fprintf(stderr, " PMROOT = 0x%lx\n",(long)HvPMROOT(sv));
+ if (HvNAME(sv))
+ fprintf(stderr, " NAME = \"%s\"\n", HvNAME(sv));
+ break;
+ case SVt_PVFM:
+ case SVt_PVCV:
+ fprintf(stderr, " STASH = 0x%lx\n", (long)CvSTASH(sv));
+ fprintf(stderr, " START = 0x%lx\n", (long)CvSTART(sv));
+ fprintf(stderr, " ROOT = 0x%lx\n", (long)CvROOT(sv));
+ fprintf(stderr, " XSUB = 0x%lx\n", (long)CvXSUB(sv));
+ fprintf(stderr, " XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32);
+ fprintf(stderr, " FILEGV = 0x%lx\n", (long)CvFILEGV(sv));
+ fprintf(stderr, " DEPTH = %ld\n", (long)CvDEPTH(sv));
+ fprintf(stderr, " PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
+ fprintf(stderr, " OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
+ if (type == SVt_PVFM)
+ fprintf(stderr, " LINES = %ld\n", (long)FmLINES(sv));
+ break;
+ case SVt_PVGV:
+ fprintf(stderr, " NAME = %s\n", GvNAME(sv));
+ fprintf(stderr, " NAMELEN = %ld\n", (long)GvNAMELEN(sv));
+ fprintf(stderr, " STASH = 0x%lx\n", (long)GvSTASH(sv));
+ fprintf(stderr, " GP = 0x%lx\n", (long)GvGP(sv));
+ fprintf(stderr, " SV = 0x%lx\n", (long)GvSV(sv));
+ fprintf(stderr, " REFCNT = %ld\n", (long)GvREFCNT(sv));
+ fprintf(stderr, " IO = 0x%lx\n", (long)GvIOp(sv));
+ fprintf(stderr, " FORM = 0x%lx\n", (long)GvFORM(sv));
+ fprintf(stderr, " AV = 0x%lx\n", (long)GvAV(sv));
+ fprintf(stderr, " HV = 0x%lx\n", (long)GvHV(sv));
+ fprintf(stderr, " CV = 0x%lx\n", (long)GvCV(sv));
+ fprintf(stderr, " CVGEN = 0x%lx\n", (long)GvCVGEN(sv));
+ fprintf(stderr, " LASTEXPR = %ld\n", (long)GvLASTEXPR(sv));
+ fprintf(stderr, " LINE = %ld\n", (long)GvLINE(sv));
+ fprintf(stderr, " FLAGS = 0x%x\n", (int)GvFLAGS(sv));
+ fprintf(stderr, " STASH = 0x%lx\n", (long)GvSTASH(sv));
+ fprintf(stderr, " EGV = 0x%lx\n", (long)GvEGV(sv));
+ break;
+ case SVt_PVIO:
+ fprintf(stderr, " IFP = 0x%lx\n", (long)IoIFP(sv));
+ fprintf(stderr, " OFP = 0x%lx\n", (long)IoOFP(sv));
+ fprintf(stderr, " DIRP = 0x%lx\n", (long)IoDIRP(sv));
+ fprintf(stderr, " LINES = %ld\n", (long)IoLINES(sv));
+ fprintf(stderr, " PAGE = %ld\n", (long)IoPAGE(sv));
+ fprintf(stderr, " PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv));
+ fprintf(stderr, " LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv));
+ fprintf(stderr, " TOP_NAME = %s\n", IoTOP_NAME(sv));
+ fprintf(stderr, " TOP_GV = 0x%lx\n", (long)IoTOP_GV(sv));
+ fprintf(stderr, " FMT_NAME = %s\n", IoFMT_NAME(sv));
+ fprintf(stderr, " FMT_GV = 0x%lx\n", (long)IoFMT_GV(sv));
+ fprintf(stderr, " BOTTOM_NAME = %s\n", IoBOTTOM_NAME(sv));
+ fprintf(stderr, " BOTTOM_GV = 0x%lx\n", (long)IoBOTTOM_GV(sv));
+ fprintf(stderr, " SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv));
+ fprintf(stderr, " TYPE = %c\n", IoTYPE(sv));
+ fprintf(stderr, " FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
+ break;
+ }
+}
+#else
+void
+sv_dump(sv)
+SV* sv;