#define new_SV() sv = (SV*)safemalloc(sizeof(SV))
#define del_SV(p) free((char*)p)
+void
+sv_add_arena(ptr, size, flags)
+char* ptr;
+U32 size;
+U32 flags;
+{
+ if (!(flags & SVf_FAKE))
+ free(ptr);
+}
+
#else
#define new_SV() \
SV* p;
{
if (debug & 32768) {
+ SV* sva;
SV* sv;
SV* svend;
int ok = 0;
- for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(svend)) {
- svend = &sv[1008 / sizeof(SV)];
+ for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+ sv = sva + 1;
+ svend = &sva[SvREFCNT(sva)];
if (p >= sv && p < svend)
ok = 1;
}
#endif
-static SV*
-more_sv()
+void
+sv_add_arena(ptr, size, flags)
+char* ptr;
+U32 size;
+U32 flags;
{
+ SV* sva = (SV*)ptr;
register SV* sv;
register SV* svend;
- sv_root = (SV*)safemalloc(1012);
- sv = sv_root;
- Zero(sv, 1012, char);
- svend = &sv[1008 / sizeof(SV) - 1];
+ Zero(sva, size, char);
+
+ /* The first SV in an arena isn't an SV. */
+ SvANY(sva) = (void *) 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;
+
+ svend = &sva[SvREFCNT(sva) - 1];
+ sv = sva + 1;
while (sv < svend) {
SvANY(sv) = (void *)(SV*)(sv + 1);
SvFLAGS(sv) = SVTYPEMASK;
sv++;
}
SvANY(sv) = 0;
- sv++;
- SvANY(sv) = (void *) sv_arenaroot;
- sv_arenaroot = sv_root;
+ SvFLAGS(sv) = SVTYPEMASK;
+}
+
+static SV*
+more_sv()
+{
+ sv_add_arena(safemalloc(1008), 1008, 0);
return new_sv();
}
#endif
void
sv_report_used()
{
+ SV* sva;
SV* sv;
register SV* svend;
- for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(sv)) {
- svend = &sv[1008 / sizeof(SV)];
+ for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+ sv = sva + 1;
+ svend = &sva[SvREFCNT(sva)];
while (sv < svend) {
if (SvTYPE(sv) != SVTYPEMASK) {
fprintf(stderr, "****\n");
void
sv_clean_objs()
{
+ SV* sva;
register SV* sv;
register SV* svend;
SV* rv;
- for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(sv)) {
- svend = &sv[1008 / sizeof(SV)];
+ for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+ sv = sva + 1;
+ svend = &sva[SvREFCNT(sva)];
while (sv < svend) {
if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) {
DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
void
sv_clean_all()
{
+ SV* sva;
register SV* sv;
register SV* svend;
- for (sv = sv_arenaroot; sv; sv = (SV *) SvANY(sv)) {
- svend = &sv[1008 / sizeof(SV)];
+ for (sva = sv_arenaroot; sva; sva = (SV*) SvANY(sva)) {
+ sv = sva + 1;
+ svend = &sva[SvREFCNT(sva)];
while (sv < svend) {
if (SvTYPE(sv) != SVTYPEMASK) {
DEBUG_D((fprintf(stderr, "Cleaning loops:\n "), sv_dump(sv));)
}
}
+void
+sv_free_arenas()
+{
+ SV* sva;
+ SV* svanext;
+
+ /* 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) {
+ svanext = (SV*) SvANY(sva);
+ while (svanext && SvFAKE(svanext))
+ svanext = (SV*) SvANY(svanext);
+
+ if (!SvFAKE(sva))
+ Safefree(sva);
+ }
+}
+
static XPVIV*
new_xiv()
{
not_a_number(sv);
return (IV)atol(SvPVX(sv));
}
- return 0;
+ if (!SvROK(sv)) {
+ return 0;
+ }
}
if (SvTHINKFIRST(sv)) {
if (SvROK(sv)) {
}
if (SvIOKp(sv))
return (double)SvIVX(sv);
- return 0;
+ if (!SvROK(sv)) {
+ return 0;
+ }
}
if (SvTHINKFIRST(sv)) {
if (SvROK(sv)) {
Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
goto tokensave;
}
- *lp = 0;
- return "";
+ if (!SvROK(sv)) {
+ *lp = 0;
+ return "";
+ }
}
if (SvTHINKFIRST(sv)) {
if (SvROK(sv)) {
stype = SvTYPE(sstr);
dtype = SvTYPE(dstr);
+ if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) {
+ sv_unglob(dstr); /* so fake GLOB won't perpetuate */
+ sv_setpvn(dstr, "", 0);
+ (void)SvPOK_only(dstr);
+ dtype = SvTYPE(dstr);
+ }
+
#ifdef OVERLOAD
SvAMAGIC_off(dstr);
#endif /* OVERLOAD */
if (dtype < SVt_PVNV)
sv_upgrade(dstr, SVt_PVNV);
break;
+
+ case SVt_PVLV:
+ sv_upgrade(dstr, SVt_PVNV);
+ break;
+
+ case SVt_PVAV:
+ case SVt_PVHV:
+ case SVt_PVCV:
+ case SVt_PVFM:
+ case SVt_PVIO:
+ if (op)
+ croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0),
+ op_name[op->op_type]);
+ else
+ croak("Bizarre copy of %s", sv_reftype(sstr, 0));
+ break;
+
case SVt_PVGV:
if (dtype <= SVt_PVGV) {
- if (dtype < SVt_PVGV) {
+ if (dtype == SVt_PVGV)
+ GvFLAGS(sstr) |= GVf_IMPORTED;
+ else {
char *name = GvNAME(sstr);
STRLEN len = GvNAMELEN(sstr);
sv_upgrade(dstr, SVt_PVGV);
SvFAKE_on(dstr); /* can coerce to non-glob */
}
(void)SvOK_off(dstr);
- if (!GvAV(sstr))
- gv_AVadd(sstr);
- if (!GvHV(sstr))
- gv_HVadd(sstr);
- if (!GvIO(sstr))
- gv_IOadd(sstr);
if (GvGP(dstr))
gp_free(dstr);
GvGP(dstr) = gp_ref(GvGP(sstr));
SAVESPTR(GvCV(dstr));
else {
CV* cv = GvCV(dstr);
- dref = (SV*)cv;
- if (dowarn && cv && sref != dref &&
- !GvCVGEN((GV*)dstr) &&
- (CvROOT(cv) || CvXSUB(cv)) )
- warn("Subroutine %s redefined", GvENAME((GV*)dstr));
+ if (cv) {
+ dref = (SV*)cv;
+ if (dowarn && sref != dref &&
+ !GvCVGEN((GV*)dstr) &&
+ (CvROOT(cv) || CvXSUB(cv)) )
+ warn("Subroutine %s redefined",
+ GvENAME((GV*)dstr));
+ SvFAKE_on(cv);
+ }
}
- GvFLAGS(dstr) |= GVf_IMPORTED;
GvCV(dstr) = (CV*)sref;
break;
default:
GvSV(dstr) = sref;
break;
}
+ if (dref != sref)
+ GvFLAGS(dstr) |= GVf_IMPORTED; /* crude */
if (dref)
SvREFCNT_dec(dref);
if (intro)
junk = SvPV_force(sv, tlen);
SvGROW(sv, tlen + len + 1);
+ if (ptr == junk)
+ ptr = SvPVX(sv);
Move(ptr,SvPVX(sv)+tlen,len,char);
SvCUR(sv) += len;
*SvEND(sv) = '\0';
junk = SvPV_force(sv, tlen);
len = strlen(ptr);
SvGROW(sv, tlen + len + 1);
+ if (ptr == junk)
+ ptr = SvPVX(sv);
Move(ptr,SvPVX(sv)+tlen,len+1,char);
SvCUR(sv) += len;
(void)SvPOK_only(sv); /* validate pointer */
if (SvREADONLY(sv) && curcop != &compiling && !strchr("gB", how))
croak(no_modify);
- if (SvMAGICAL(sv)) {
+ if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
if (how == 't')
mg->mg_len |= 1;
case '.':
mg->mg_virtual = &vtbl_pos;
break;
- case '~': /* reserved for extensions but multiple extensions may clash */
+ case '~': /* Reserved for use by extensions not perl internals. */
+ /* Useful for attaching extension internal data to perl vars. */
+ /* Note that multiple extensions may clash if magical scalars */
+ /* etc holding private data from one are passed to another. */
+ SvRMAGICAL_on(sv);
break;
default:
croak("Don't know how to handle magic of type '%c'", how);
PUSHMARK(SP);
PUSHs(&ref);
PUTBACK;
- perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL);
+ perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
del_XRV(SvANY(&ref));
}
LEAVE;
}
+ else
+ SvREFCNT_dec(SvSTASH(sv));
if (SvOBJECT(sv)) {
SvOBJECT_off(sv); /* Curse the object. */
if (SvTYPE(sv) != SVt_PVIO)
I32 append;
{
register char *bp; /* we're going to steal some values */
-#ifdef USE_STD_STDIO
+#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
register I32 cnt; /* from the stdio struct and put EVERYTHING */
register STDCHAR *ptr; /* in the innermost loop into registers */
STRLEN bpx;
}
} while (i != EOF);
}
-#ifdef USE_STD_STDIO /* Here is some breathtakingly efficient cheating */
- cnt = fp->_cnt; /* get count into register */
+#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
+ /* Here is some breathtakingly efficient cheating */
+ cnt = FILE_cnt(fp); /* get count into register */
(void)SvPOK_only(sv); /* validate pointer */
if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
if (cnt > 80 && SvLEN(sv) > append) {
else
shortbuffered = 0;
bp = SvPVX(sv) + append; /* move these two too to registers */
- ptr = fp->_ptr;
+ ptr = FILE_ptr(fp);
for (;;) {
screamer:
if (cnt > 0) {
continue;
}
- fp->_cnt = cnt; /* deregisterize cnt and ptr */
- fp->_ptr = ptr;
+ FILE_cnt(fp) = cnt; /* deregisterize cnt and ptr */
+ FILE_ptr(fp) = ptr;
i = _filbuf(fp); /* get more characters */
- cnt = fp->_cnt;
- ptr = fp->_ptr; /* reregisterize cnt and ptr */
+ cnt = FILE_cnt(fp);
+ ptr = FILE_ptr(fp); /* reregisterize cnt and ptr */
if (i == EOF) /* all done for ever? */
goto thats_really_all_folks;
thats_really_all_folks:
if (shortbuffered)
cnt += shortbuffered;
- fp->_cnt = cnt; /* put these back or we're in trouble */
- fp->_ptr = ptr;
+ FILE_cnt(fp) = cnt; /* put these back or we're in trouble */
+ FILE_ptr(fp) = ptr;
*bp = '\0';
SvCUR_set(sv, bp - SvPVX(sv)); /* set length */
-#else /* !USE_STD_STDIO */ /* The big, slow, and stupid way */
-
+#else /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
+ /*The big, slow, and stupid way */
{
char buf[8192];
register char * bpe = buf + sizeof(buf) - 3;
}
}
-#endif /* USE_STD_STDIO */
+#endif /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
if (rspara) {
while (i != EOF) {
return;
}
if (!(flags & SVp_POK) || !*SvPVX(sv)) {
- sv_upgrade(sv, SVt_NV);
+ if ((flags & SVTYPEMASK) < SVt_PVNV)
+ sv_upgrade(sv, SVt_NV);
SvNVX(sv) = 1.0;
(void)SvNOK_only(sv);
return;
return;
}
if (!(flags & SVp_POK)) {
- sv_upgrade(sv, SVt_NV);
+ if ((flags & SVTYPEMASK) < SVt_PVNV)
+ sv_upgrade(sv, SVt_NV);
SvNVX(sv) = -1.0;
(void)SvNOK_only(sv);
return;
*st = GvESTASH(gv);
fix_gv:
if (lref && !GvCV(gv)) {
+ SV *tmpsv;
ENTER;
- sv = NEWSV(704,0);
- gv_efullname(sv, gv);
+ tmpsv = NEWSV(704,0);
+ gv_efullname(tmpsv, gv);
newSUB(start_subparse(),
- newSVOP(OP_CONST, 0, sv),
+ newSVOP(OP_CONST, 0, tmpsv),
+ Nullop,
Nullop);
LEAVE;
+ if (!GvCV(gv))
+ croak("Unable to create sub named \"%s\"", SvPV(sv,na));
}
return GvCV(gv);
}
}
else {
if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
- if (SvFAKE(sv))
+ 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]);
}
- s = sv_2pv(sv, lp);
+ else
+ s = sv_2pv(sv, lp);
if (s != SvPVX(sv)) { /* Almost, but not quite, sv_setpvn() */
STRLEN len = *lp;
gp_free(sv);
sv_unmagic(sv, '*');
Safefree(GvNAME(sv));
+ SvMULTI_off(sv);
SvFLAGS(sv) &= ~SVTYPEMASK;
SvFLAGS(sv) |= SVt_PVMG;
}
SvRV(sv) = 0;
SvROK_off(sv);
- SvREFCNT_dec(rv);
+ if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
+ SvREFCNT_dec(rv);
+ else
+ sv_2mortal(rv); /* Schedule for freeing later */
}
#ifdef DEBUGGING
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));
- if (AvREAL(sv))
- fprintf(stderr, " FLAGS = (REAL)\n");
- else
- fprintf(stderr, " FLAGS = ()\n");
+ 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));
projects / p5sagit/p5-mst-13.2.git / blobdiff