/* sv.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
static void del_xnv _((XPVNV* p));
static void del_xpv _((XPV* p));
static void del_xrv _((XRV* p));
-static void sv_mortalgrow _((void));
static void sv_unglob _((SV* sv));
-static void sv_check_thinkfirst _((SV *sv));
#ifndef PURIFY
static void *my_safemalloc(MEM_SIZE size);
#endif /* PERL_OBJECT */
-#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv)
+#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_force_normal(sv)
#ifdef PURIFY
-#define new_SV(p) \
- do { \
- LOCK_SV_MUTEX; \
- (p) = (SV*)safemalloc(sizeof(SV)); \
- reg_add(p); \
- UNLOCK_SV_MUTEX; \
- } while (0)
-
-#define del_SV(p) \
- do { \
- LOCK_SV_MUTEX; \
- reg_remove(p); \
- Safefree((char*)(p)); \
- UNLOCK_SV_MUTEX; \
- } while (0)
+#define new_SV(p) \
+ STMT_START { \
+ LOCK_SV_MUTEX; \
+ (p) = (SV*)safemalloc(sizeof(SV)); \
+ reg_add(p); \
+ UNLOCK_SV_MUTEX; \
+ SvANY(p) = 0; \
+ SvREFCNT(p) = 1; \
+ SvFLAGS(p) = 0; \
+ } STMT_END
+
+#define del_SV(p) \
+ STMT_START { \
+ LOCK_SV_MUTEX; \
+ reg_remove(p); \
+ Safefree((char*)(p)); \
+ UNLOCK_SV_MUTEX; \
+ } STMT_END
static SV **registry;
static I32 registry_size;
#define REGHASH(sv,size) ((((U32)(sv)) >> 2) % (size))
#define REG_REPLACE(sv,a,b) \
- do { \
- void* p = sv->sv_any; \
- I32 h = REGHASH(sv, registry_size); \
- I32 i = h; \
- while (registry[i] != (a)) { \
- if (++i >= registry_size) \
- i = 0; \
- if (i == h) \
- die("SV registry bug"); \
- } \
- registry[i] = (b); \
- } while (0)
+ STMT_START { \
+ void* p = sv->sv_any; \
+ I32 h = REGHASH(sv, registry_size); \
+ I32 i = h; \
+ while (registry[i] != (a)) { \
+ if (++i >= registry_size) \
+ i = 0; \
+ if (i == h) \
+ die("SV registry bug"); \
+ } \
+ registry[i] = (b); \
+ } STMT_END
#define REG_ADD(sv) REG_REPLACE(sv,Nullsv,sv)
#define REG_REMOVE(sv) REG_REPLACE(sv,sv,Nullsv)
* "A time to plant, and a time to uproot what was planted..."
*/
-#define plant_SV(p) \
- do { \
- SvANY(p) = (void *)PL_sv_root; \
- SvFLAGS(p) = SVTYPEMASK; \
- PL_sv_root = (p); \
- --PL_sv_count; \
- } while (0)
+#define plant_SV(p) \
+ STMT_START { \
+ SvANY(p) = (void *)PL_sv_root; \
+ SvFLAGS(p) = SVTYPEMASK; \
+ PL_sv_root = (p); \
+ --PL_sv_count; \
+ } STMT_END
/* sv_mutex must be held while calling uproot_SV() */
-#define uproot_SV(p) \
- do { \
- (p) = PL_sv_root; \
- PL_sv_root = (SV*)SvANY(p); \
- ++PL_sv_count; \
- } while (0)
-
-#define new_SV(p) do { \
- LOCK_SV_MUTEX; \
- if (PL_sv_root) \
- uproot_SV(p); \
- else \
- (p) = more_sv(); \
- UNLOCK_SV_MUTEX; \
- } while (0)
+#define uproot_SV(p) \
+ STMT_START { \
+ (p) = PL_sv_root; \
+ PL_sv_root = (SV*)SvANY(p); \
+ ++PL_sv_count; \
+ } STMT_END
+
+#define new_SV(p) \
+ STMT_START { \
+ LOCK_SV_MUTEX; \
+ if (PL_sv_root) \
+ uproot_SV(p); \
+ else \
+ (p) = more_sv(); \
+ UNLOCK_SV_MUTEX; \
+ SvANY(p) = 0; \
+ SvREFCNT(p) = 1; \
+ SvFLAGS(p) = 0; \
+ } STMT_END
#ifdef DEBUGGING
-#define del_SV(p) do { \
- LOCK_SV_MUTEX; \
- if (PL_debug & 32768) \
- del_sv(p); \
- else \
- plant_SV(p); \
- UNLOCK_SV_MUTEX; \
- } while (0)
+#define del_SV(p) \
+ STMT_START { \
+ LOCK_SV_MUTEX; \
+ if (PL_debug & 32768) \
+ del_sv(p); \
+ else \
+ plant_SV(p); \
+ UNLOCK_SV_MUTEX; \
+ } STMT_END
STATIC void
del_sv(SV *p)
break;
case SVt_PVGV:
- if (SvFAKE(sv)) {
- sv_unglob(sv);
- break;
- }
- /* FALL THROUGH */
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
break;
case SVt_PVGV:
- if (SvFAKE(sv)) {
- sv_unglob(sv);
- break;
- }
- /* FALL THROUGH */
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
}
char *
+sv_2pv_nolen(register SV *sv)
+{
+ STRLEN n_a;
+ return sv_2pv(sv, &n_a);
+}
+
+char *
sv_2pv(register SV *sv, STRLEN *lp)
{
register char *s;
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);
- }
-
SvAMAGIC_off(dstr);
/* There's a lot of redundancy below but we're going for speed here */
}
}
if (stype == SVt_PVLV)
- SvUPGRADE(dstr, SVt_PVNV);
+ (void)SvUPGRADE(dstr, SVt_PVNV);
else
- SvUPGRADE(dstr, stype);
+ (void)SvUPGRADE(dstr, stype);
}
sflags = SvFLAGS(sstr);
(void)SvOK_off(sv);
return;
}
- if (SvTYPE(sv) >= SVt_PV) {
- if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
- sv_unglob(sv);
- }
- else
- sv_upgrade(sv, SVt_PV);
+ (void)SvUPGRADE(sv, SVt_PV);
SvGROW(sv, len + 1);
dptr = SvPVX(sv);
return;
}
len = strlen(ptr);
- if (SvTYPE(sv) >= SVt_PV) {
- if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
- sv_unglob(sv);
- }
- else
- sv_upgrade(sv, SVt_PV);
+ (void)SvUPGRADE(sv, SVt_PV);
SvGROW(sv, len + 1);
Move(ptr,SvPVX(sv),len+1,char);
SvSETMAGIC(sv);
}
-STATIC void
-sv_check_thinkfirst(register SV *sv)
+void
+sv_force_normal(register SV *sv)
{
if (SvREADONLY(sv)) {
dTHR;
}
if (SvROK(sv))
sv_unref(sv);
+ else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
+ sv_unglob(sv);
}
void
}
void
-sv_catpvn(register SV *sv, register char *ptr, register STRLEN len)
+sv_catpvn(register SV *sv, register const char *ptr, register STRLEN len)
{
STRLEN tlen;
char *junk;
}
void
-sv_catpvn_mg(register SV *sv, register char *ptr, register STRLEN len)
+sv_catpvn_mg(register SV *sv, register const char *ptr, register STRLEN len)
{
sv_catpvn(sv,ptr,len);
SvSETMAGIC(sv);
}
void
-sv_catpv(register SV *sv, register char *ptr)
+sv_catpv(register SV *sv, register const char *ptr)
{
register STRLEN len;
STRLEN tlen;
}
void
-sv_catpv_mg(register SV *sv, register char *ptr)
+sv_catpv_mg(register SV *sv, register const char *ptr)
{
sv_catpv(sv,ptr);
SvSETMAGIC(sv);
register SV *sv;
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 1;
- SvFLAGS(sv) = 0;
if (len) {
sv_upgrade(sv, SVt_PV);
SvGROW(sv, len + 1);
/* name is assumed to contain an SV* if (name && namelen == HEf_SVKEY) */
void
-sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen)
+sv_magic(register SV *sv, SV *obj, int how, const char *name, I32 namlen)
{
MAGIC* mg;
} while (SvOBJECT(sv) && SvSTASH(sv) != stash);
del_XRV(SvANY(&tmpref));
+
+ if (SvREFCNT(sv)) {
+ if (PL_in_clean_objs)
+ croak("DESTROY created new reference to dead object '%s'",
+ HvNAME(stash));
+ /* DESTROY gave object new lease on life */
+ return;
+ }
}
if (SvOBJECT(sv)) {
if (SvTYPE(sv) != SVt_PVIO)
--PL_sv_objcount; /* XXX Might want something more general */
}
- if (SvREFCNT(sv)) {
- if (PL_in_clean_objs)
- croak("DESTROY created new reference to dead object");
- /* DESTROY gave object new lease on life */
- return;
- }
}
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
mg_free(sv);
IoIFP(sv) != PerlIO_stdin() &&
IoIFP(sv) != PerlIO_stdout() &&
IoIFP(sv) != PerlIO_stderr())
+ {
io_close((IO*)sv);
+ }
+ if (IoDIRP(sv)) {
+ PerlDir_close(IoDIRP(sv));
+ IoDIRP(sv) = 0;
+ }
Safefree(IoTOP_NAME(sv));
Safefree(IoFMT_NAME(sv));
Safefree(IoBOTTOM_NAME(sv));
SV_CHECK_THINKFIRST(sv);
(void)SvUPGRADE(sv, SVt_PV);
+
SvSCREAM_off(sv);
if (RsSNARF(PL_rs)) {
* hopefully we won't free it until it has been assigned to a
* permanent location. */
-STATIC void
-sv_mortalgrow(void)
-{
- dTHR;
- PL_tmps_max += (PL_tmps_max < 512) ? 128 : 512;
- Renew(PL_tmps_stack, PL_tmps_max, SV*);
-}
-
SV *
sv_mortalcopy(SV *oldstr)
{
register SV *sv;
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 1;
- SvFLAGS(sv) = 0;
sv_setsv(sv,oldstr);
- if (++PL_tmps_ix >= PL_tmps_max)
- sv_mortalgrow();
- PL_tmps_stack[PL_tmps_ix] = sv;
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = sv;
SvTEMP_on(sv);
return sv;
}
register SV *sv;
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 1;
SvFLAGS(sv) = SVs_TEMP;
- if (++PL_tmps_ix >= PL_tmps_max)
- sv_mortalgrow();
- PL_tmps_stack[PL_tmps_ix] = sv;
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = sv;
return sv;
}
return sv;
if (SvREADONLY(sv) && SvIMMORTAL(sv))
return sv;
- if (++PL_tmps_ix >= PL_tmps_max)
- sv_mortalgrow();
- PL_tmps_stack[PL_tmps_ix] = sv;
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = sv;
SvTEMP_on(sv);
return sv;
}
SV *
-newSVpv(char *s, STRLEN len)
+newSVpv(const char *s, STRLEN len)
{
register SV *sv;
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 1;
- SvFLAGS(sv) = 0;
if (!len)
len = strlen(s);
sv_setpvn(sv,s,len);
}
SV *
-newSVpvn(char *s, STRLEN len)
+newSVpvn(const char *s, STRLEN len)
{
register SV *sv;
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 1;
- SvFLAGS(sv) = 0;
sv_setpvn(sv,s,len);
return sv;
}
va_list args;
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 1;
- SvFLAGS(sv) = 0;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
register SV *sv;
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 1;
- SvFLAGS(sv) = 0;
sv_setnv(sv,n);
return sv;
}
register SV *sv;
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 1;
- SvFLAGS(sv) = 0;
sv_setiv(sv,i);
return sv;
}
register SV *sv;
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 1;
- SvFLAGS(sv) = 0;
sv_upgrade(sv, SVt_RV);
SvTEMP_off(tmpRef);
SvRV(sv) = tmpRef;
return Nullsv;
}
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 1;
- SvFLAGS(sv) = 0;
if (SvTEMP(old)) {
SvTEMP_off(old);
sv_setsv(sv,old);
}
char *
+sv_pv(SV *sv)
+{
+ STRLEN n_a;
+
+ if (SvPOK(sv))
+ return SvPVX(sv);
+
+ return sv_2pv(sv, &n_a);
+}
+
+char *
sv_pvn(SV *sv, STRLEN *lp)
{
if (SvPOK(sv)) {
{
char *s;
- if (SvREADONLY(sv)) {
- dTHR;
- if (PL_curcop != &PL_compiling)
- croak(PL_no_modify);
- }
+ if (SvTHINKFIRST(sv) && !SvROK(sv))
+ sv_force_normal(sv);
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 {
- dTHR;
- croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
- PL_op_name[PL_op->op_type]);
- }
+ dTHR;
+ croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
+ PL_op_name[PL_op->op_type]);
}
else
s = sv_2pv(sv, lp);
}
int
-sv_isa(SV *sv, char *name)
+sv_isa(SV *sv, const char *name)
{
if (!sv)
return 0;
}
SV*
-newSVrv(SV *rv, char *classname)
+newSVrv(SV *rv, const char *classname)
{
dTHR;
SV *sv;
new_SV(sv);
- SvANY(sv) = 0;
- SvREFCNT(sv) = 0;
- SvFLAGS(sv) = 0;
SV_CHECK_THINKFIRST(rv);
SvAMAGIC_off(rv);
sv_upgrade(rv, SVt_RV);
(void)SvOK_off(rv);
- SvRV(rv) = SvREFCNT_inc(sv);
+ SvRV(rv) = sv;
SvROK_on(rv);
if (classname) {
}
SV*
-sv_setref_pv(SV *rv, char *classname, void *pv)
+sv_setref_pv(SV *rv, const char *classname, void *pv)
{
if (!pv) {
sv_setsv(rv, &PL_sv_undef);
}
SV*
-sv_setref_iv(SV *rv, char *classname, IV iv)
+sv_setref_iv(SV *rv, const char *classname, IV iv)
{
sv_setiv(newSVrv(rv,classname), iv);
return rv;
}
SV*
-sv_setref_nv(SV *rv, char *classname, double nv)
+sv_setref_nv(SV *rv, const char *classname, double nv)
{
sv_setnv(newSVrv(rv,classname), nv);
return rv;
}
SV*
-sv_setref_pvn(SV *rv, char *classname, char *pv, I32 n)
+sv_setref_pvn(SV *rv, const char *classname, char *pv, STRLEN n)
{
sv_setpvn(newSVrv(rv,classname), pv, n);
return rv;
projects / p5sagit/p5-mst-13.2.git / blobdiff