/* $RCSfile: sv.c,v $$Revision: 4.1 $$Date: 92/08/07 18:26:45 $
 *
 *    Copyright (c) 1991, 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.
 *
 * $Log:	sv.c,v $
 * Revision 4.1  92/08/07  18:26:45  lwall
 * 
 * Revision 4.0.1.6  92/06/11  21:14:21  lwall
 * patch34: quotes containing subscripts containing variables didn't parse right
 * 
 * Revision 4.0.1.5  92/06/08  15:40:43  lwall
 * patch20: removed implicit int declarations on functions
 * patch20: Perl now distinguishes overlapped copies from non-overlapped
 * patch20: paragraph mode now skips extra newlines automatically
 * patch20: fixed memory leak in doube-quote interpretation
 * patch20: made /\$$foo/ look for literal '$foo'
 * patch20: "$var{$foo'bar}" didn't scan subscript correctly
 * patch20: a splice on non-existent array elements could dump core
 * patch20: running taintperl explicitly now does checks even if $< == $>
 * 
 * Revision 4.0.1.4  91/11/05  18:40:51  lwall
 * patch11: $foo .= <BAR> could overrun malloced memory
 * patch11: \$ didn't always make it through double-quoter to regexp routines
 * patch11: prepared for ctype implementations that don't define isascii()
 * 
 * Revision 4.0.1.3  91/06/10  01:27:54  lwall
 * patch10: $) and $| incorrectly handled in run-time patterns
 * 
 * Revision 4.0.1.2  91/06/07  11:58:13  lwall
 * patch4: new copyright notice
 * patch4: taint check on undefined string could cause core dump
 * 
 * Revision 4.0.1.1  91/04/12  09:15:30  lwall
 * patch1: fixed undefined environ problem
 * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment
 * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo
 * 
 * Revision 4.0  91/03/20  01:39:55  lwall
 * 4.0 baseline.
 * 
 */

#include "EXTERN.h"
#include "perl.h"
#include "perly.h"

static void ucase();
static void lcase();

static SV* more_sv();

static SV*
new_sv()
{
    SV* sv;
    if (sv_root) {
	sv = sv_root;
	sv_root = (SV*)SvANY(sv);
	++sv_count;
	return sv;
    }
    return more_sv();
}

static void
del_sv(p)
SV* p;
{
    SvANY(p) = sv_root;
    sv_root = p;
    --sv_count;
}

static SV*
more_sv()
{
    register int i;
    register SV* sv;
    register SV* svend;
    sv_root = (SV*)safemalloc(1012);
    sv = sv_root;
    svend = &sv[1008 / sizeof(SV) - 1];
    while (sv < svend) {
	SvANY(sv) = (SV*)(sv + 1);
	SvFLAGS(sv) = SVTYPEMASK;
	sv++;
    }
    SvANY(sv) = 0;
    sv++;
    SvANY(sv) = sv_arenaroot;
    sv_arenaroot = sv_root;
    return new_sv();
}

void
sv_report_used()
{
    SV* sv;
    register SV* svend;

    for (sv = sv_arenaroot; sv; sv = SvANY(sv)) {
	svend = &sv[1008 / sizeof(SV)];
	while (sv < svend) {
	    if (SvTYPE(sv) != SVTYPEMASK) {
		fprintf(stderr, "****\n");
		sv_dump(sv);
	    }
	    ++sv;
	}
    }
}

void
sv_clean_refs()
{
    register SV* sv;
    register SV* svend;

    for (sv = sv_arenaroot; sv; sv = SvANY(sv)) {
	svend = &sv[1008 / sizeof(SV)];
	while (sv < svend) {
	    if (SvREFCNT(sv) == 1 && SvROK(sv)) {
		DEBUG_D((fprintf(stderr, "Cleaning ref:\n "), sv_dump(sv));)
		SvFLAGS(SvRV(sv)) |= SVf_BREAK;
		SvFLAGS(sv) |= SVf_BREAK;
		SvREFCNT_dec(sv);
	    }
	    ++sv;
	}
    }
}

void
sv_clean_magic()
{
    register SV* sv;
    register SV* svend;

    for (sv = sv_arenaroot; sv; sv = SvANY(sv)) {
	svend = &sv[1008 / sizeof(SV)];
	while (sv < svend) {
	    if (SvTYPE(sv) != SVTYPEMASK && SvMAGICAL(sv)) {
		DEBUG_D((fprintf(stderr, "Cleaning magic:\n "), sv_dump(sv));)
		SvFLAGS(sv) |= SVf_BREAK;
		sv_unmagic(sv);
		SvREFCNT_dec(sv);
	    }
	    ++sv;
	}
    }
}

void
sv_clean_all()
{
    register SV* sv;
    register SV* svend;

    for (sv = sv_arenaroot; sv; sv = SvANY(sv)) {
	svend = &sv[1008 / sizeof(SV)];
	while (sv < svend) {
	    if (SvTYPE(sv) != SVTYPEMASK) {
		DEBUG_D((fprintf(stderr, "Cleaning loops:\n "), sv_dump(sv));)
		SvFLAGS(sv) |= SVf_BREAK;
		SvREFCNT_dec(sv);
	    }
	    ++sv;
	}
    }
}

static XPVIV* more_xiv();

static XPVIV*
new_xiv()
{
    I32* xiv;
    if (xiv_root) {
	xiv = xiv_root;
	xiv_root = *(I32**)xiv;
	return (XPVIV*)((char*)xiv - sizeof(XPV));
    }
    return more_xiv();
}

static void
del_xiv(p)
XPVIV* p;
{
    I32* xiv = (I32*)((char*)(p) + sizeof(XPV));
    *(I32**)xiv = xiv_root;
    xiv_root = xiv;
}

static XPVIV*
more_xiv()
{
    register int i;
    register I32* xiv;
    register I32* xivend;
    xiv = (I32*)safemalloc(1008);
    xivend = &xiv[1008 / sizeof(I32) - 1];
    xiv += (sizeof(XPV) - 1) / sizeof(I32) + 1;   /* fudge by size of XPV */
    xiv_root = xiv;
    while (xiv < xivend) {
	*(I32**)xiv = (I32*)(xiv + 1); /* XXX busted on Alpha? */
	xiv++;
    }
    *(I32**)xiv = 0;
    return new_xiv();
}

static XPVNV* more_xnv();

static XPVNV*
new_xnv()
{
    double* xnv;
    if (xnv_root) {
	xnv = xnv_root;
	xnv_root = *(double**)xnv;
	return (XPVNV*)((char*)xnv - sizeof(XPVIV));
    }
    return more_xnv();
}

static void
del_xnv(p)
XPVNV* p;
{
    double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
    *(double**)xnv = xnv_root;
    xnv_root = xnv;
}

static XPVNV*
more_xnv()
{
    register int i;
    register double* xnv;
    register double* xnvend;
    xnv = (double*)safemalloc(1008);
    xnvend = &xnv[1008 / sizeof(double) - 1];
    xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
    xnv_root = xnv;
    while (xnv < xnvend) {
	*(double**)xnv = (double*)(xnv + 1);
	xnv++;
    }
    *(double**)xnv = 0;
    return new_xnv();
}

static XRV* more_xrv();

static XRV*
new_xrv()
{
    XRV* xrv;
    if (xrv_root) {
	xrv = xrv_root;
	xrv_root = (XRV*)xrv->xrv_rv;
	return xrv;
    }
    return more_xrv();
}

static void
del_xrv(p)
XRV* p;
{
    p->xrv_rv = (SV*)xrv_root;
    xrv_root = p;
}

static XRV*
more_xrv()
{
    register int i;
    register XRV* xrv;
    register XRV* xrvend;
    xrv_root = (XRV*)safemalloc(1008);
    xrv = xrv_root;
    xrvend = &xrv[1008 / sizeof(XRV) - 1];
    while (xrv < xrvend) {
	xrv->xrv_rv = (SV*)(xrv + 1);
	xrv++;
    }
    xrv->xrv_rv = 0;
    return new_xrv();
}

static XPV* more_xpv();

static XPV*
new_xpv()
{
    XPV* xpv;
    if (xpv_root) {
	xpv = xpv_root;
	xpv_root = (XPV*)xpv->xpv_pv;
	return xpv;
    }
    return more_xpv();
}

static void
del_xpv(p)
XPV* p;
{
    p->xpv_pv = (char*)xpv_root;
    xpv_root = p;
}

static XPV*
more_xpv()
{
    register int i;
    register XPV* xpv;
    register XPV* xpvend;
    xpv_root = (XPV*)safemalloc(1008);
    xpv = xpv_root;
    xpvend = &xpv[1008 / sizeof(XPV) - 1];
    while (xpv < xpvend) {
	xpv->xpv_pv = (char*)(xpv + 1);
	xpv++;
    }
    xpv->xpv_pv = 0;
    return new_xpv();
}

#ifdef PURIFY

#define new_SV() sv = (SV*)safemalloc(sizeof(SV))
#define del_SV(p) free((char*)p)

#else

#define new_SV()			\
    if (sv_root) {			\
	sv = sv_root;			\
	sv_root = (SV*)SvANY(sv);	\
	++sv_count;			\
    }					\
    else				\
	sv = more_sv();
#define del_SV(p)			\
    SvANY(p) = sv_root;			\
    sv_root = p;			\
    --sv_count;

#endif

#ifdef PURIFY
#define new_XIV() (void*)safemalloc(sizeof(XPVIV))
#define del_XIV(p) free((char*)p)
#else
#define new_XIV() new_xiv()
#define del_XIV(p) del_xiv(p)
#endif

#ifdef PURIFY
#define new_XNV() (void*)safemalloc(sizeof(XPVNV))
#define del_XNV(p) free((char*)p)
#else
#define new_XNV() new_xnv()
#define del_XNV(p) del_xnv(p)
#endif

#ifdef PURIFY
#define new_XRV() (void*)safemalloc(sizeof(XRV))
#define del_XRV(p) free((char*)p)
#else
#define new_XRV() new_xrv()
#define del_XRV(p) del_xrv(p)
#endif

#ifdef PURIFY
#define new_XPV() (void*)safemalloc(sizeof(XPV))
#define del_XPV(p) free((char*)p)
#else
#define new_XPV() new_xpv()
#define del_XPV(p) del_xpv(p)
#endif

#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
#define del_XPVIV(p) free((char*)p)

#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
#define del_XPVNV(p) free((char*)p)

#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
#define del_XPVMG(p) free((char*)p)

#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
#define del_XPVLV(p) free((char*)p)

#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
#define del_XPVAV(p) free((char*)p)

#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
#define del_XPVHV(p) free((char*)p)

#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
#define del_XPVCV(p) free((char*)p)

#define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
#define del_XPVGV(p) free((char*)p)

#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
#define del_XPVBM(p) free((char*)p)

#define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
#define del_XPVFM(p) free((char*)p)

#define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
#define del_XPVIO(p) free((char*)p)

bool
sv_upgrade(sv, mt)
register SV* sv;
U32 mt;
{
    char*	pv;
    U32		cur;
    U32		len;
    I32		iv;
    double	nv;
    MAGIC*	magic;
    HV*		stash;

    if (SvTYPE(sv) == mt)
	return TRUE;

    switch (SvTYPE(sv)) {
    case SVt_NULL:
	pv	= 0;
	cur	= 0;
	len	= 0;
	iv	= 0;
	nv	= 0.0;
	magic	= 0;
	stash	= 0;
	break;
    case SVt_IV:
	pv	= 0;
	cur	= 0;
	len	= 0;
	iv	= SvIVX(sv);
	nv	= (double)SvIVX(sv);
	del_XIV(SvANY(sv));
	magic	= 0;
	stash	= 0;
	if (mt == SVt_NV)
	    mt = SVt_PVNV;
	else if (mt < SVt_PVIV)
	    mt = SVt_PVIV;
	break;
    case SVt_NV:
	pv	= 0;
	cur	= 0;
	len	= 0;
	nv	= SvNVX(sv);
	iv	= I_32(nv);
	magic	= 0;
	stash	= 0;
	del_XNV(SvANY(sv));
	SvANY(sv) = 0;
	if (mt < SVt_PVNV)
	    mt = SVt_PVNV;
	break;
    case SVt_RV:
	pv	= (char*)SvRV(sv);
	cur	= 0;
	len	= 0;
	iv	= (I32)pv;
	nv	= (double)(unsigned long)pv;
	del_XRV(SvANY(sv));
	magic	= 0;
	stash	= 0;
	break;
    case SVt_PV:
	nv = 0.0;
	pv	= SvPVX(sv);
	cur	= SvCUR(sv);
	len	= SvLEN(sv);
	iv	= 0;
	nv	= 0.0;
	magic	= 0;
	stash	= 0;
	del_XPV(SvANY(sv));
	break;
    case SVt_PVIV:
	nv = 0.0;
	pv	= SvPVX(sv);
	cur	= SvCUR(sv);
	len	= SvLEN(sv);
	iv	= SvIVX(sv);
	nv	= 0.0;
	magic	= 0;
	stash	= 0;
	del_XPVIV(SvANY(sv));
	break;
    case SVt_PVNV:
	nv = SvNVX(sv);
	pv	= SvPVX(sv);
	cur	= SvCUR(sv);
	len	= SvLEN(sv);
	iv	= SvIVX(sv);
	nv	= SvNVX(sv);
	magic	= 0;
	stash	= 0;
	del_XPVNV(SvANY(sv));
	break;
    case SVt_PVMG:
	pv	= SvPVX(sv);
	cur	= SvCUR(sv);
	len	= SvLEN(sv);
	iv	= SvIVX(sv);
	nv	= SvNVX(sv);
	magic	= SvMAGIC(sv);
	stash	= SvSTASH(sv);
	del_XPVMG(SvANY(sv));
	break;
    default:
	croak("Can't upgrade that kind of scalar");
    }

    switch (mt) {
    case SVt_NULL:
	croak("Can't upgrade to undef");
    case SVt_IV:
	SvANY(sv) = new_XIV();
	SvIVX(sv)	= iv;
	break;
    case SVt_NV:
	SvANY(sv) = new_XNV();
	SvNVX(sv)	= nv;
	break;
    case SVt_RV:
	SvANY(sv) = new_XRV();
	SvRV(sv) = (SV*)pv;
	SvOK_on(sv);
	break;
    case SVt_PV:
	SvANY(sv) = new_XPV();
	SvPVX(sv)	= pv;
	SvCUR(sv)	= cur;
	SvLEN(sv)	= len;
	break;
    case SVt_PVIV:
	SvANY(sv) = new_XPVIV();
	SvPVX(sv)	= pv;
	SvCUR(sv)	= cur;
	SvLEN(sv)	= len;
	SvIVX(sv)	= iv;
	if (SvNIOK(sv))
	    SvIOK_on(sv);
	SvNOK_off(sv);
	break;
    case SVt_PVNV:
	SvANY(sv) = new_XPVNV();
	SvPVX(sv)	= pv;
	SvCUR(sv)	= cur;
	SvLEN(sv)	= len;
	SvIVX(sv)	= iv;
	SvNVX(sv)	= nv;
	break;
    case SVt_PVMG:
	SvANY(sv) = new_XPVMG();
	SvPVX(sv)	= pv;
	SvCUR(sv)	= cur;
	SvLEN(sv)	= len;
	SvIVX(sv)	= iv;
	SvNVX(sv)	= nv;
	SvMAGIC(sv)	= magic;
	SvSTASH(sv)	= stash;
	break;
    case SVt_PVLV:
	SvANY(sv) = new_XPVLV();
	SvPVX(sv)	= pv;
	SvCUR(sv)	= cur;
	SvLEN(sv)	= len;
	SvIVX(sv)	= iv;
	SvNVX(sv)	= nv;
	SvMAGIC(sv)	= magic;
	SvSTASH(sv)	= stash;
	LvTARGOFF(sv)	= 0;
	LvTARGLEN(sv)	= 0;
	LvTARG(sv)	= 0;
	LvTYPE(sv)	= 0;
	break;
    case SVt_PVAV:
	SvANY(sv) = new_XPVAV();
	if (pv)
	    Safefree(pv);
	AvARRAY(sv)	= 0;
	AvMAX(sv)	= 0;
	AvFILL(sv)	= 0;
	SvIVX(sv)	= 0;
	SvNVX(sv)	= 0.0;
	SvMAGIC(sv)	= magic;
	SvSTASH(sv)	= stash;
	AvALLOC(sv)	= 0;
	AvARYLEN(sv)	= 0;
	AvFLAGS(sv)	= 0;
	break;
    case SVt_PVHV:
	SvANY(sv) = new_XPVHV();
	if (pv)
	    Safefree(pv);
	SvPVX(sv)	= 0;
	HvFILL(sv)	= 0;
	HvMAX(sv)	= 0;
	HvKEYS(sv)	= 0;
	SvNVX(sv)	= 0.0;
	SvMAGIC(sv)	= magic;
	SvSTASH(sv)	= stash;
	HvRITER(sv)	= 0;
	HvEITER(sv)	= 0;
	HvPMROOT(sv)	= 0;
	HvNAME(sv)	= 0;
	break;
    case SVt_PVCV:
	SvANY(sv) = new_XPVCV();
	SvPVX(sv)	= pv;
	SvCUR(sv)	= cur;
	SvLEN(sv)	= len;
	SvIVX(sv)	= iv;
	SvNVX(sv)	= nv;
	SvMAGIC(sv)	= magic;
	SvSTASH(sv)	= stash;
	CvSTASH(sv)	= 0;
	CvSTART(sv)	= 0;
	CvROOT(sv)	= 0;
	CvUSERSUB(sv)	= 0;
	CvUSERINDEX(sv)	= 0;
	CvFILEGV(sv)	= 0;
	CvDEPTH(sv)	= 0;
	CvPADLIST(sv)	= 0;
	CvDELETED(sv)	= 0;
	break;
    case SVt_PVGV:
	SvANY(sv) = new_XPVGV();
	SvPVX(sv)	= pv;
	SvCUR(sv)	= cur;
	SvLEN(sv)	= len;
	SvIVX(sv)	= iv;
	SvNVX(sv)	= nv;
	SvMAGIC(sv)	= magic;
	SvSTASH(sv)	= stash;
	GvGP(sv)	= 0;
	GvNAME(sv)	= 0;
	GvNAMELEN(sv)	= 0;
	GvSTASH(sv)	= 0;
	break;
    case SVt_PVBM:
	SvANY(sv) = new_XPVBM();
	SvPVX(sv)	= pv;
	SvCUR(sv)	= cur;
	SvLEN(sv)	= len;
	SvIVX(sv)	= iv;
	SvNVX(sv)	= nv;
	SvMAGIC(sv)	= magic;
	SvSTASH(sv)	= stash;
	BmRARE(sv)	= 0;
	BmUSEFUL(sv)	= 0;
	BmPREVIOUS(sv)	= 0;
	break;
    case SVt_PVFM:
	SvANY(sv) = new_XPVFM();
	SvPVX(sv)	= pv;
	SvCUR(sv)	= cur;
	SvLEN(sv)	= len;
	SvIVX(sv)	= iv;
	SvNVX(sv)	= nv;
	SvMAGIC(sv)	= magic;
	SvSTASH(sv)	= stash;
	FmLINES(sv)	= 0;
	break;
    case SVt_PVIO:
	SvANY(sv) = new_XPVIO();
	SvPVX(sv)	= pv;
	SvCUR(sv)	= cur;
	SvLEN(sv)	= len;
	SvIVX(sv)	= iv;
	SvNVX(sv)	= nv;
	SvMAGIC(sv)	= magic;
	SvSTASH(sv)	= stash;
	IoIFP(sv)	= 0;
	IoOFP(sv)	= 0;
	IoDIRP(sv)	= 0;
	IoLINES(sv)	= 60;
	IoPAGE(sv)	= 0;
	IoPAGE_LEN(sv)	= 0;
	IoLINES_LEFT(sv)= 0;
	IoTOP_NAME(sv)	= 0;
	IoTOP_GV(sv)	= 0;
	IoFMT_NAME(sv)	= 0;
	IoFMT_GV(sv)	= 0;
	IoBOTTOM_NAME(sv)= 0;
	IoBOTTOM_GV(sv)	= 0;
	IoSUBPROCESS(sv)= 0;
	IoTYPE(sv)	= 0;
	IoFLAGS(sv)	= 0;
	break;
    }
    SvFLAGS(sv) &= ~SVTYPEMASK;
    SvFLAGS(sv) |= mt;
    return TRUE;
}

char *
sv_peek(sv)
register SV *sv;
{
    char *t = tokenbuf;
    *t = '\0';

  retry:
    if (!sv) {
	strcpy(t, "VOID");
	return tokenbuf;
    }
    else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
	strcpy(t, "WILD");
	return tokenbuf;
    }
    else if (SvREFCNT(sv) == 0 && !SvREADONLY(sv)) {
	strcpy(t, "UNREF");
	return tokenbuf;
    }
    else {
	switch (SvTYPE(sv)) {
	default:
	    strcpy(t,"FREED");
	    return tokenbuf;
	    break;

	case SVt_NULL:
	    strcpy(t,"UNDEF");
	    return tokenbuf;
	case SVt_IV:
	    strcpy(t,"IV");
	    break;
	case SVt_NV:
	    strcpy(t,"NV");
	    break;
	case SVt_RV:
	    *t++ = '\\';
	    if (t - tokenbuf > 10) {
		strcpy(tokenbuf + 3,"...");
		return tokenbuf;
	    }
	    sv = (SV*)SvRV(sv);
	    goto retry;
	case SVt_PV:
	    strcpy(t,"PV");
	    break;
	case SVt_PVIV:
	    strcpy(t,"PVIV");
	    break;
	case SVt_PVNV:
	    strcpy(t,"PVNV");
	    break;
	case SVt_PVMG:
	    strcpy(t,"PVMG");
	    break;
	case SVt_PVLV:
	    strcpy(t,"PVLV");
	    break;
	case SVt_PVAV:
	    strcpy(t,"AV");
	    break;
	case SVt_PVHV:
	    strcpy(t,"HV");
	    break;
	case SVt_PVCV:
	    if (CvGV(sv))
		sprintf(t, "CV(%s)", GvNAME(CvGV(sv)));
	    else
		strcpy(t, "CV()");
	    return tokenbuf;
	case SVt_PVGV:
	    strcpy(t,"GV");
	    break;
	case SVt_PVBM:
	    strcpy(t,"BM");
	    break;
	case SVt_PVFM:
	    strcpy(t,"FM");
	    break;
	case SVt_PVIO:
	    strcpy(t,"IO");
	    break;
	}
    }
    t += strlen(t);

    if (SvPOK(sv)) {
	if (!SvPVX(sv))
	    return "(null)";
	if (SvOOK(sv))
	    sprintf(t,"(%ld+\"%0.127s\")",(long)SvIVX(sv),SvPVX(sv));
	else
	    sprintf(t,"(\"%0.127s\")",SvPVX(sv));
    }
    else if (SvNOK(sv))
	sprintf(t,"(%g)",SvNVX(sv));
    else if (SvIOK(sv))
	sprintf(t,"(%ld)",(long)SvIVX(sv));
    else
	strcpy(t,"()");
    return tokenbuf;
}

int
sv_backoff(sv)
register SV *sv;
{
    assert(SvOOK(sv));
    if (SvIVX(sv)) {
	char *s = SvPVX(sv);
	SvLEN(sv) += SvIVX(sv);
	SvPVX(sv) -= SvIVX(sv);
	SvIV_set(sv, 0);
	Move(s, SvPVX(sv), SvCUR(sv)+1, char);
    }
    SvFLAGS(sv) &= ~SVf_OOK;
}

char *
sv_grow(sv,newlen)
register SV *sv;
#ifndef DOSISH
register I32 newlen;
#else
unsigned long newlen;
#endif
{
    register char *s;

#ifdef MSDOS
    if (newlen >= 0x10000) {
	fprintf(stderr, "Allocation too large: %lx\n", newlen);
	my_exit(1);
    }
#endif /* MSDOS */
    if (SvTHINKFIRST(sv)) {
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (SvTYPE(sv) < SVt_PV) {
	sv_upgrade(sv, SVt_PV);
	s = SvPVX(sv);
    }
    else if (SvOOK(sv)) {	/* pv is offset? */
	sv_backoff(sv);
	s = SvPVX(sv);
	if (newlen > SvLEN(sv))
	    newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
    }
    else
	s = SvPVX(sv);
    if (newlen > SvLEN(sv)) {		/* need more room? */
        if (SvLEN(sv))
	    Renew(s,newlen,char);
        else
	    New(703,s,newlen,char);
	SvPV_set(sv, s);
        SvLEN_set(sv, newlen);
    }
    return s;
}

void
sv_setiv(sv,i)
register SV *sv;
I32 i;
{
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    switch (SvTYPE(sv)) {
    case SVt_NULL:
	sv_upgrade(sv, SVt_IV);
	break;
    case SVt_NV:
	sv_upgrade(sv, SVt_PVNV);
	break;
    case SVt_RV:
    case SVt_PV:
	sv_upgrade(sv, SVt_PVIV);
	break;
    }
    SvIVX(sv) = i;
    SvIOK_only(sv);			/* validate number */
    SvTAINT(sv);
}

void
sv_setnv(sv,num)
register SV *sv;
double num;
{
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (SvTYPE(sv) < SVt_NV)
	sv_upgrade(sv, SVt_NV);
    else if (SvTYPE(sv) < SVt_PVNV)
	sv_upgrade(sv, SVt_PVNV);
    else if (SvPOK(sv)) {
	SvOOK_off(sv);
    }
    SvNVX(sv) = num;
    SvNOK_only(sv);			/* validate number */
    SvTAINT(sv);
}

I32
sv_2iv(sv)
register SV *sv;
{
    if (!sv)
	return 0;
    if (SvGMAGICAL(sv)) {
	mg_get(sv);
	if (SvIOKp(sv))
	    return SvIVX(sv);
	if (SvNOKp(sv))
	    return (I32)SvNVX(sv);
	if (SvPOKp(sv) && SvLEN(sv))
	    return (I32)atol(SvPVX(sv));
	return 0;
    }
    if (SvTHINKFIRST(sv)) {
	if (SvROK(sv))
	    return (I32)SvRV(sv);
#ifdef TOOSTRICT
	if (SvREADONLY(sv)) {
	    if (SvNOK(sv))
		return (I32)SvNVX(sv);
	    if (SvPOK(sv) && SvLEN(sv))
		return (I32)atol(SvPVX(sv));
	    if (dowarn)
		warn(warn_uninit);
	    return 0;
	}
#endif
    }
    switch (SvTYPE(sv)) {
    case SVt_NULL:
	sv_upgrade(sv, SVt_IV);
	return SvIVX(sv);
    case SVt_PV:
	sv_upgrade(sv, SVt_PVIV);
	break;
    case SVt_NV:
	sv_upgrade(sv, SVt_PVNV);
	break;
    }
    if (SvNOK(sv))
	SvIVX(sv) = (I32)SvNVX(sv);
    else if (SvPOK(sv) && SvLEN(sv)) {
	if (dowarn && !looks_like_number(sv)) {
	    if (op)
		warn("Argument wasn't numeric for \"%s\"",op_name[op->op_type]);
	    else
		warn("Argument wasn't numeric");
	}
	SvIVX(sv) = (I32)atol(SvPVX(sv));
    }
    else  {
	if (dowarn)
	    warn(warn_uninit);
	SvUPGRADE(sv, SVt_IV);
	SvIVX(sv) = 0;
    }
    SvIOK_on(sv);
    DEBUG_c((stderr,"0x%lx 2iv(%ld)\n",sv,(long)SvIVX(sv)));
    return SvIVX(sv);
}

double
sv_2nv(sv)
register SV *sv;
{
    if (!sv)
	return 0.0;
    if (SvGMAGICAL(sv)) {
	mg_get(sv);
	if (SvNOKp(sv))
	    return SvNVX(sv);
	if (SvPOKp(sv) && SvLEN(sv))
	    return atof(SvPVX(sv));
	if (SvIOKp(sv))
	    return (double)SvIVX(sv);
	return 0;
    }
    if (SvTHINKFIRST(sv)) {
	if (SvROK(sv))
	    return (double)(unsigned long)SvRV(sv);
#ifdef TOOSTRICT
	if (SvREADONLY(sv)) {
	    if (SvPOK(sv) && SvLEN(sv))
		return atof(SvPVX(sv));
	    if (SvIOK(sv))
		return (double)SvIVX(sv);
	    if (dowarn)
		warn(warn_uninit);
	    return 0.0;
	}
#endif
    }
    if (SvTYPE(sv) < SVt_NV) {
	if (SvTYPE(sv) == SVt_IV)
	    sv_upgrade(sv, SVt_PVNV);
	else
	    sv_upgrade(sv, SVt_NV);
	DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvNVX(sv)));
    }
    else if (SvTYPE(sv) < SVt_PVNV)
	sv_upgrade(sv, SVt_PVNV);
    if (SvIOK(sv) &&
	    (!SvPOK(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
    {
	SvNVX(sv) = (double)SvIVX(sv);
    }
    else if (SvPOK(sv) && SvLEN(sv)) {
	if (dowarn && !SvIOK(sv) && !looks_like_number(sv)) {
	    if (op)
		warn("Argument wasn't numeric for \"%s\"",op_name[op->op_type]);
	    else
		warn("Argument wasn't numeric");
	}
	SvNVX(sv) = atof(SvPVX(sv));
    }
    else  {
	if (dowarn)
	    warn(warn_uninit);
	SvNVX(sv) = 0.0;
    }
    SvNOK_on(sv);
    DEBUG_c((stderr,"0x%lx 2nv(%g)\n",sv,SvNVX(sv)));
    return SvNVX(sv);
}

char *
sv_2pv(sv, lp)
register SV *sv;
STRLEN *lp;
{
    register char *s;
    int olderrno;

    if (!sv) {
	*lp = 0;
	return "";
    }
    if (SvGMAGICAL(sv)) {
	mg_get(sv);
	if (SvPOKp(sv)) {
	    *lp = SvCUR(sv);
	    return SvPVX(sv);
	}
	if (SvIOKp(sv)) {
	    (void)sprintf(tokenbuf,"%ld",SvIVX(sv));
	    *lp = strlen(tokenbuf);
	    return tokenbuf;
	}
	if (SvNOKp(sv)) {
	    (void)sprintf(tokenbuf,"%.20g",SvNVX(sv));
	    *lp = strlen(tokenbuf);
	    return tokenbuf;
	}
	*lp = 0;
	return "";
    }
    if (SvTHINKFIRST(sv)) {
	if (SvROK(sv)) {
	    sv = (SV*)SvRV(sv);
	    if (!sv)
		s = "NULLREF";
	    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_PVBM:
		case SVt_PVMG:	s = "SCALAR";			break;
		case SVt_PVLV:	s = "LVALUE";			break;
		case SVt_PVAV:	s = "ARRAY";			break;
		case SVt_PVHV:	s = "HASH";			break;
		case SVt_PVCV:	s = "CODE";			break;
		case SVt_PVGV:	s = "GLOB";			break;
		case SVt_PVFM:	s = "FORMATLINE";		break;
		case SVt_PVIO:	s = "FILEHANDLE";		break;
		default:	s = "UNKNOWN";			break;
		}
		if (SvOBJECT(sv))
		    sprintf(tokenbuf, "%s=%s(0x%lx)",
				HvNAME(SvSTASH(sv)), s, (unsigned long)sv);
		else
		    sprintf(tokenbuf, "%s(0x%lx)", s, (unsigned long)sv);
		s = tokenbuf;
	    }
	    *lp = strlen(s);
	    return s;
	}
#ifdef TOOSTRICT
	if (SvREADONLY(sv)) {
	    if (SvIOK(sv)) {
		(void)sprintf(tokenbuf,"%ld",SvIVX(sv));
		*lp = strlen(tokenbuf);
		return tokenbuf;
	    }
	    if (SvNOK(sv)) {
		(void)sprintf(tokenbuf,"%.20g",SvNVX(sv));
		*lp = strlen(tokenbuf);
		return tokenbuf;
	    }
	    if (dowarn)
		warn(warn_uninit);
	    *lp = 0;
	    return "";
	}
#endif
    }
    if (!SvUPGRADE(sv, SVt_PV))
	return 0;
    if (SvNOK(sv)) {
	if (SvTYPE(sv) < SVt_PVNV)
	    sv_upgrade(sv, SVt_PVNV);
	SvGROW(sv, 28);
	s = SvPVX(sv);
	olderrno = errno;	/* some Xenix systems wipe out errno here */
#if defined(scs) && defined(ns32000)
	gcvt(SvNVX(sv),20,s);
#else
#ifdef apollo
	if (SvNVX(sv) == 0.0)
	    (void)strcpy(s,"0");
	else
#endif /*apollo*/
	(void)sprintf(s,"%.20g",SvNVX(sv));
#endif /*scs*/
	errno = olderrno;
	while (*s) s++;
#ifdef hcx
	if (s[-1] == '.')
	    s--;
#endif
    }
    else if (SvIOK(sv)) {
	if (SvTYPE(sv) < SVt_PVIV)
	    sv_upgrade(sv, SVt_PVIV);
	SvGROW(sv, 11);
	s = SvPVX(sv);
	olderrno = errno;	/* some Xenix systems wipe out errno here */
	(void)sprintf(s,"%ld",SvIVX(sv));
	errno = olderrno;
	while (*s) s++;
    }
    else {
	if (dowarn)
	    warn(warn_uninit);
	sv_grow(sv, 1);
	s = SvPVX(sv);
    }
    *s = '\0';
    *lp = s - SvPVX(sv);
    SvCUR_set(sv, *lp);
    SvPOK_on(sv);
    DEBUG_c((stderr,"0x%lx 2pv(%s)\n",sv,SvPVX(sv)));
    return SvPVX(sv);
}

/* This function is only called on magical items */
bool
sv_2bool(sv)
register SV *sv;
{
    if (SvGMAGICAL(sv))
	mg_get(sv);

    if (SvROK(sv))
	return SvRV(sv) != 0;
    if (SvPOKp(sv)) {
	register XPV* Xpv;
	if ((Xpv = (XPV*)SvANY(sv)) &&
		(*Xpv->xpv_pv > '0' ||
		Xpv->xpv_cur > 1 ||
		(Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
	    return 1;
	else
	    return 0;
    }
    else {
	if (SvIOKp(sv))
	    return SvIVX(sv) != 0;
	else {
	    if (SvNOKp(sv))
		return SvNVX(sv) != 0.0;
	    else
		return FALSE;
	}
    }
}

/* Note: sv_setsv() should not be called with a source string that needs
 * to be reused, since it may destroy the source string if it is marked
 * as temporary.
 */

void
sv_setsv(dstr,sstr)
SV *dstr;
register SV *sstr;
{
    register U32 sflags;
    register int dtype;
    register int stype;

    if (sstr == dstr)
	return;
    if (SvTHINKFIRST(dstr)) {
	if (SvREADONLY(dstr) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(dstr))
	    sv_unref(dstr);
    }
    if (!sstr)
	sstr = &sv_undef;
    stype = SvTYPE(sstr);
    dtype = SvTYPE(dstr);

    /* There's a lot of redundancy below but we're going for speed here */

    switch (stype) {
    case SVt_NULL:
	SvOK_off(dstr);
	return;
    case SVt_IV:
	if (dtype <= SVt_PV) {
	    if (dtype < SVt_IV)
		sv_upgrade(dstr, SVt_IV);
	    else if (dtype == SVt_PV)
		sv_upgrade(dstr, SVt_PVIV);
	    else if (dtype == SVt_NV)
		sv_upgrade(dstr, SVt_PVNV);
	}
	break;
    case SVt_NV:
	if (dtype <= SVt_PVIV) {
	    if (dtype < SVt_NV)
		sv_upgrade(dstr, SVt_NV);
	    else if (dtype == SVt_PV)
		sv_upgrade(dstr, SVt_PVNV);
	    else if (dtype == SVt_PVIV)
		sv_upgrade(dstr, SVt_PVNV);
	}
	break;
    case SVt_RV:
	if (dtype < SVt_RV)
	    sv_upgrade(dstr, SVt_RV);
	break;
    case SVt_PV:
	if (dtype < SVt_PV)
	    sv_upgrade(dstr, SVt_PV);
	break;
    case SVt_PVIV:
	if (dtype < SVt_PVIV)
	    sv_upgrade(dstr, SVt_PVIV);
	break;
    case SVt_PVNV:
	if (dtype < SVt_PVNV)
	    sv_upgrade(dstr, SVt_PVNV);
	break;
    case SVt_PVGV:
	if (dtype <= SVt_PVGV) {
	    if (dtype < SVt_PVGV)
		sv_upgrade(dstr, SVt_PVGV);
	    SvOK_off(dstr);
	    if (!GvAV(sstr))
		gv_AVadd(sstr);
	    if (!GvHV(sstr))
		gv_HVadd(sstr);
	    if (!GvIO(sstr))
		GvIO(sstr) = newIO();
	    if (GvGP(dstr))
		gp_free(dstr);
	    GvGP(dstr) = gp_ref(GvGP(sstr));
	    SvTAINT(dstr);
	    return;
	}
	/* FALL THROUGH */

    default:
	if (dtype < stype)
	    sv_upgrade(dstr, stype);
	if (SvGMAGICAL(sstr))
	    mg_get(sstr);
    }

    sflags = SvFLAGS(sstr);

    if (sflags & SVf_ROK) {
	if (dtype >= SVt_PV) {
	    if (dtype == SVt_PVGV) {
		SV *sref = SvREFCNT_inc(SvRV(sstr));
		SV *dref = 0;
		GP *oldgp = GvGP(dstr);
		GP *gp;

		switch (SvTYPE(sref)) {
		case SVt_PVAV:
		    dref = (SV*)GvAV(dstr);
		    GvAV(dstr) = (AV*)sref;
		    break;
		case SVt_PVHV:
		    dref = (SV*)GvHV(dstr);
		    GvHV(dstr) = (HV*)sref;
		    break;
		case SVt_PVCV:
		    dref = (SV*)GvCV(dstr);
		    GvCV(dstr) = (CV*)sref;
		    break;
		default:
		    dref = (SV*)GvSV(dstr);
		    GvSV(dstr) = sref;
		    break;
		}
		if (dref)
		    SvREFCNT_dec(dref);
		SvTAINT(dstr);
		return;
	    }
	    if (SvPVX(dstr))
		Safefree(SvPVX(dstr));
	}
	SvOK_off(dstr);
	SvRV(dstr) = SvREFCNT_inc(SvRV(sstr));
	SvROK_on(dstr);
	++sv_rvcount;
	if (sflags & SVp_NOK) {
	    SvNOK_on(dstr);
	    SvNVX(dstr) = SvNVX(sstr);
	}
	if (sflags & SVp_IOK) {
	    SvIOK_on(dstr);
	    SvIVX(dstr) = SvIVX(sstr);
	}
    }
    else if (sflags & SVp_POK) {

	/*
	 * Check to see if we can just swipe the string.  If so, it's a
	 * possible small lose on short strings, but a big win on long ones.
	 * It might even be a win on short strings if SvPVX(dstr)
	 * has to be allocated and SvPVX(sstr) has to be freed.
	 */

	if (SvTEMP(sstr)) {		/* slated for free anyway? */
	    if (SvPOK(dstr)) {
		SvOOK_off(dstr);
		Safefree(SvPVX(dstr));
	    }
	    SvPV_set(dstr, SvPVX(sstr));
	    SvLEN_set(dstr, SvLEN(sstr));
	    SvCUR_set(dstr, SvCUR(sstr));
	    SvPOK_only(dstr);
	    SvTEMP_off(dstr);
	    SvPV_set(sstr, Nullch);
	    SvLEN_set(sstr, 0);
	    SvPOK_off(sstr);			/* wipe out any weird flags */
	    SvPVX(sstr) = 0;			/* so sstr frees uneventfully */
	}
	else {					/* have to copy actual string */
	    STRLEN len = SvCUR(sstr);

	    SvGROW(dstr, len + 1);		/* inlined from sv_setpvn */
	    Move(SvPVX(sstr),SvPVX(dstr),len,char);
	    SvCUR_set(dstr, len);
	    *SvEND(dstr) = '\0';
	    SvPOK_only(dstr);
	}
	/*SUPPRESS 560*/
	if (sflags & SVp_NOK) {
	    SvNOK_on(dstr);
	    SvNVX(dstr) = SvNVX(sstr);
	}
	if (sflags & SVp_IOK) {
	    SvIOK_on(dstr);
	    SvIVX(dstr) = SvIVX(sstr);
	}
    }
    else if (sflags & SVp_NOK) {
	SvNVX(dstr) = SvNVX(sstr);
	SvNOK_only(dstr);
	if (SvIOK(sstr)) {
	    SvIOK_on(dstr);
	    SvIVX(dstr) = SvIVX(sstr);
	}
    }
    else if (sflags & SVp_IOK) {
	SvIOK_only(dstr);
	SvIVX(dstr) = SvIVX(sstr);
    }
    else {
	SvOK_off(dstr);
    }
    SvTAINT(dstr);
}

void
sv_setpvn(sv,ptr,len)
register SV *sv;
register char *ptr;
register STRLEN len;
{
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (!ptr) {
	SvOK_off(sv);
	return;
    }
    if (!SvUPGRADE(sv, SVt_PV))
	return;
    SvGROW(sv, len + 1);
    if (ptr)
	Move(ptr,SvPVX(sv),len,char);
    SvCUR_set(sv, len);
    *SvEND(sv) = '\0';
    SvPOK_only(sv);		/* validate pointer */
    SvTAINT(sv);
}

void
sv_setpv(sv,ptr)
register SV *sv;
register char *ptr;
{
    register STRLEN len;

    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (!ptr) {
	SvOK_off(sv);
	return;
    }
    len = strlen(ptr);
    if (!SvUPGRADE(sv, SVt_PV))
	return;
    SvGROW(sv, len + 1);
    Move(ptr,SvPVX(sv),len+1,char);
    SvCUR_set(sv, len);
    SvPOK_only(sv);		/* validate pointer */
    SvTAINT(sv);
}

void
sv_usepvn(sv,ptr,len)
register SV *sv;
register char *ptr;
register STRLEN len;
{
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (!SvUPGRADE(sv, SVt_PV))
	return;
    if (!ptr) {
	SvOK_off(sv);
	return;
    }
    if (SvPVX(sv))
	Safefree(SvPVX(sv));
    Renew(ptr, len+1, char);
    SvPVX(sv) = ptr;
    SvCUR_set(sv, len);
    SvLEN_set(sv, len+1);
    *SvEND(sv) = '\0';
    SvPOK_only(sv);		/* validate pointer */
    SvTAINT(sv);
}

void
sv_chop(sv,ptr)	/* like set but assuming ptr is in sv */
register SV *sv;
register char *ptr;
{
    register STRLEN delta;

    if (!ptr || !SvPOK(sv))
	return;
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (SvTYPE(sv) < SVt_PVIV)
	sv_upgrade(sv,SVt_PVIV);

    if (!SvOOK(sv)) {
	SvIVX(sv) = 0;
	SvFLAGS(sv) |= SVf_OOK;
    }
    SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVp_IOK|SVp_NOK);
    delta = ptr - SvPVX(sv);
    SvLEN(sv) -= delta;
    SvCUR(sv) -= delta;
    SvPVX(sv) += delta;
    SvIVX(sv) += delta;
}

void
sv_catpvn(sv,ptr,len)
register SV *sv;
register char *ptr;
register STRLEN len;
{
    STRLEN tlen;
    char *s;
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv)) {
	    s = SvPV(sv, tlen);
	    sv_unref(sv);
	    sv_setpvn(sv, s, tlen);
	}
    }
    s = SvPV(sv, tlen);
    SvGROW(sv, tlen + len + 1);
    Move(ptr,SvPVX(sv)+tlen,len,char);
    SvCUR(sv) += len;
    *SvEND(sv) = '\0';
    SvPOK_only(sv);		/* validate pointer */
    SvTAINT(sv);
}

void
sv_catsv(dstr,sstr)
SV *dstr;
register SV *sstr;
{
    char *s;
    STRLEN len;
    if (!sstr)
	return;
    if (s = SvPV(sstr, len))
	sv_catpvn(dstr,s,len);
}

void
sv_catpv(sv,ptr)
register SV *sv;
register char *ptr;
{
    register STRLEN len;
    STRLEN tlen;
    char *s;

    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (!ptr)
	return;
    s = SvPV(sv, tlen);
    len = strlen(ptr);
    SvGROW(sv, tlen + len + 1);
    Move(ptr,SvPVX(sv)+tlen,len+1,char);
    SvCUR(sv) += len;
    SvPOK_only(sv);		/* validate pointer */
    SvTAINT(sv);
}

SV *
#ifdef LEAKTEST
newSV(x,len)
I32 x;
#else
newSV(len)
#endif
STRLEN len;
{
    register SV *sv;
    
    new_SV();
    SvANY(sv) = 0;
    SvREFCNT(sv) = 1;
    SvFLAGS(sv) = 0;
    if (len) {
	sv_upgrade(sv, SVt_PV);
	SvGROW(sv, len + 1);
    }
    return sv;
}

void
#ifndef STANDARD_C
sv_magic(sv, obj, how, name, namlen)
register SV *sv;
SV *obj;
char how;
char *name;
I32 namlen;
#else
sv_magic(register SV *sv, SV *obj, char how, char *name, I32 namlen)
#endif /* STANDARD_C */
{
    MAGIC* mg;
    
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
    }
    if (SvMAGICAL(sv)) {
	if (SvMAGIC(sv) && mg_find(sv, how))
	    return;
    }
    else {
	if (!SvUPGRADE(sv, SVt_PVMG))
	    return;
    }
    Newz(702,mg, 1, MAGIC);
    mg->mg_moremagic = SvMAGIC(sv);

    SvMAGIC(sv) = mg;
    if (obj == sv)
	mg->mg_obj = obj;
    else
	mg->mg_obj = SvREFCNT_inc(obj);
    mg->mg_type = how;
    mg->mg_len = namlen;
    if (name && namlen >= 0)
	mg->mg_ptr = nsavestr(name, namlen);
    switch (how) {
    case 0:
	mg->mg_virtual = &vtbl_sv;
	break;
    case 'B':
	mg->mg_virtual = &vtbl_bm;
	break;
    case 'E':
	mg->mg_virtual = &vtbl_env;
	break;
    case 'e':
	mg->mg_virtual = &vtbl_envelem;
	break;
    case 'g':
	mg->mg_virtual = &vtbl_mglob;
	break;
    case 'I':
	mg->mg_virtual = &vtbl_isa;
	break;
    case 'i':
	mg->mg_virtual = &vtbl_isaelem;
	break;
    case 'L':
	mg->mg_virtual = 0;
	break;
    case 'l':
	mg->mg_virtual = &vtbl_dbline;
	break;
    case 'P':
	mg->mg_virtual = &vtbl_pack;
	break;
    case 'p':
	mg->mg_virtual = &vtbl_packelem;
	break;
    case 'S':
	mg->mg_virtual = &vtbl_sig;
	break;
    case 's':
	mg->mg_virtual = &vtbl_sigelem;
	break;
    case 't':
	mg->mg_virtual = &vtbl_taint;
	break;
    case 'U':
	mg->mg_virtual = &vtbl_uvar;
	break;
    case 'v':
	mg->mg_virtual = &vtbl_vec;
	break;
    case 'x':
	mg->mg_virtual = &vtbl_substr;
	break;
    case '*':
	mg->mg_virtual = &vtbl_glob;
	break;
    case '#':
	mg->mg_virtual = &vtbl_arylen;
	break;
    default:
	croak("Don't know how to handle magic of type '%c'", how);
    }
    mg_magical(sv);
    if (SvGMAGICAL(sv))
	SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
}

int
#ifndef STANDARD_C
sv_unmagic(sv, type)
SV* sv;
char type;
#else
sv_unmagic(SV *sv, char type)
#endif /* STANDARD_C */
{
    MAGIC* mg;
    MAGIC** mgp;
    if (!SvMAGICAL(sv))
	return 0;
    mgp = &SvMAGIC(sv);
    for (mg = *mgp; mg; mg = *mgp) {
	if (mg->mg_type == type) {
	    MGVTBL* vtbl = mg->mg_virtual;
	    *mgp = mg->mg_moremagic;
	    if (vtbl && vtbl->svt_free)
		(*vtbl->svt_free)(sv, mg);
	    if (mg->mg_ptr && mg->mg_type != 'g')
		Safefree(mg->mg_ptr);
	    SvREFCNT_dec(mg->mg_obj);
	    Safefree(mg);
	}
	else
	    mgp = &mg->mg_moremagic;
    }
    if (!SvMAGIC(sv)) {
	SvMAGICAL_off(sv);
	SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
    }

    return 0;
}

void
sv_insert(bigstr,offset,len,little,littlelen)
SV *bigstr;
STRLEN offset;
STRLEN len;
char *little;
STRLEN littlelen;
{
    register char *big;
    register char *mid;
    register char *midend;
    register char *bigend;
    register I32 i;

    if (!bigstr)
	croak("Can't modify non-existent substring");
    if (SvTHINKFIRST(bigstr)) {
	if (SvREADONLY(bigstr) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(bigstr))
	    sv_unref(bigstr);
    }
    SvPOK_only(bigstr);

    i = littlelen - len;
    if (i > 0) {			/* string might grow */
	if (!SvUPGRADE(bigstr, SVt_PV))
	    return;
	SvGROW(bigstr, SvCUR(bigstr) + i + 1);
	big = SvPVX(bigstr);
	mid = big + offset + len;
	midend = bigend = big + SvCUR(bigstr);
	bigend += i;
	*bigend = '\0';
	while (midend > mid)		/* shove everything down */
	    *--bigend = *--midend;
	Move(little,big+offset,littlelen,char);
	SvCUR(bigstr) += i;
	SvSETMAGIC(bigstr);
	return;
    }
    else if (i == 0) {
	Move(little,SvPVX(bigstr)+offset,len,char);
	SvSETMAGIC(bigstr);
	return;
    }

    big = SvPVX(bigstr);
    mid = big + offset;
    midend = mid + len;
    bigend = big + SvCUR(bigstr);

    if (midend > bigend)
	croak("panic: sv_insert");

    if (mid - big > bigend - midend) {	/* faster to shorten from end */
	if (littlelen) {
	    Move(little, mid, littlelen,char);
	    mid += littlelen;
	}
	i = bigend - midend;
	if (i > 0) {
	    Move(midend, mid, i,char);
	    mid += i;
	}
	*mid = '\0';
	SvCUR_set(bigstr, mid - big);
    }
    /*SUPPRESS 560*/
    else if (i = mid - big) {	/* faster from front */
	midend -= littlelen;
	mid = midend;
	sv_chop(bigstr,midend-i);
	big += i;
	while (i--)
	    *--midend = *--big;
	if (littlelen)
	    Move(little, mid, littlelen,char);
    }
    else if (littlelen) {
	midend -= littlelen;
	sv_chop(bigstr,midend);
	Move(little,midend,littlelen,char);
    }
    else {
	sv_chop(bigstr,midend);
    }
    SvSETMAGIC(bigstr);
}

/* make sv point to what nstr did */

void
sv_replace(sv,nsv)
register SV *sv;
register SV *nsv;
{
    U32 refcnt = SvREFCNT(sv);
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (SvREFCNT(nsv) != 1)
	warn("Reference miscount in sv_replace()");
    if (SvMAGICAL(sv)) {
	SvUPGRADE(nsv, SVt_PVMG);
	SvMAGIC(nsv) = SvMAGIC(sv);
	SvMAGICAL_on(nsv);
	SvMAGICAL_off(sv);
	SvMAGIC(sv) = 0;
    }
    SvREFCNT(sv) = 0;
    sv_clear(sv);
    StructCopy(nsv,sv,SV);
    SvREFCNT(sv) = refcnt;
    del_SV(nsv);
}

void
sv_clear(sv)
register SV *sv;
{
    assert(sv);
    assert(SvREFCNT(sv) == 0);

    if (SvOBJECT(sv)) {
	dSP;
	BINOP myop;		/* fake syntax tree node */
	GV* destructor;

	SvOBJECT_off(sv);		/* Curse the object. */

	ENTER;
	SAVETMPS;
	SAVESPTR(curcop);
	SAVESPTR(op);
	curcop = &compiling;
	curstash = SvSTASH(sv);
	destructor = gv_fetchpv("DESTROY", FALSE);

	if (destructor && GvCV(destructor)) {
	    SV ref;
	    Zero(&ref, 1, SV);
	    sv_upgrade(&ref, SVt_RV);
	    SvRV(&ref) = SvREFCNT_inc(sv);
	    SvROK_on(&ref);

	    op = (OP*)&myop;
	    Zero(op, 1, OP);
	    myop.op_last = (OP*)&myop;
	    myop.op_flags = OPf_STACKED;
	    myop.op_next = Nullop;

	    EXTEND(SP, 2);
	    PUSHs((SV*)destructor);
	    pp_pushmark();
	    PUSHs(&ref);
	    PUTBACK;
	    op = pp_entersubr();
	    if (op)
		run();
	    stack_sp--;
	    SvREFCNT(sv) = 0;
	}
	SvREFCNT_dec(SvSTASH(sv));
	LEAVE;
    }
    switch (SvTYPE(sv)) {
    case SVt_PVIO:
	Safefree(IoTOP_NAME(sv));
	Safefree(IoFMT_NAME(sv));
	Safefree(IoBOTTOM_NAME(sv));
	goto freemagic;
    case SVt_PVFM:
	goto freemagic;
    case SVt_PVBM:
	goto freemagic;
    case SVt_PVGV:
	gp_free(sv);
	goto freemagic;
    case SVt_PVCV:
	cv_clear((CV*)sv);
	goto freemagic;
    case SVt_PVHV:
	hv_clear((HV*)sv);
	SvPVX(sv)= 0;
	goto freemagic;
    case SVt_PVAV:
	av_clear((AV*)sv);
	SvPVX(sv)= 0;
	goto freemagic;
    case SVt_PVLV:
	goto freemagic;
    case SVt_PVMG:
      freemagic:
	if (SvMAGICAL(sv))
	    mg_free(sv);
    case SVt_PVNV:
    case SVt_PVIV:
	SvOOK_off(sv);
	/* FALL THROUGH */
    case SVt_PV:
	if (SvROK(sv))
	    SvREFCNT_dec(SvRV(sv));
	else if (SvPVX(sv))
	    Safefree(SvPVX(sv));
	break;
    case SVt_NV:
	break;
    case SVt_IV:
	break;
    case SVt_RV:
	SvREFCNT_dec(SvRV(sv));
	break;
    case SVt_NULL:
	break;
    }

    switch (SvTYPE(sv)) {
    case SVt_NULL:
	break;
    case SVt_IV:
	del_XIV(SvANY(sv));
	break;
    case SVt_NV:
	del_XNV(SvANY(sv));
	break;
    case SVt_RV:
	del_XRV(SvANY(sv));
	break;
    case SVt_PV:
	del_XPV(SvANY(sv));
	break;
    case SVt_PVIV:
	del_XPVIV(SvANY(sv));
	break;
    case SVt_PVNV:
	del_XPVNV(SvANY(sv));
	break;
    case SVt_PVMG:
	del_XPVMG(SvANY(sv));
	break;
    case SVt_PVLV:
	del_XPVLV(SvANY(sv));
	break;
    case SVt_PVAV:
	del_XPVAV(SvANY(sv));
	break;
    case SVt_PVHV:
	del_XPVHV(SvANY(sv));
	break;
    case SVt_PVCV:
	del_XPVCV(SvANY(sv));
	break;
    case SVt_PVGV:
	del_XPVGV(SvANY(sv));
	break;
    case SVt_PVBM:
	del_XPVBM(SvANY(sv));
	break;
    case SVt_PVFM:
	del_XPVFM(SvANY(sv));
	break;
    case SVt_PVIO:
	del_XPVIO(SvANY(sv));
	break;
    }
    SvFLAGS(sv) |= SVTYPEMASK;
}

SV *
sv_newref(sv)
SV* sv;
{
    if (sv)
	SvREFCNT(sv)++;
    return sv;
}

void
sv_free(sv)
SV *sv;
{
    if (!sv)
	return;
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv)) {
	    if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
		return;
	}
    }
    if (SvREFCNT(sv) == 0 && !(SvFLAGS(sv) & SVf_BREAK)) {
	warn("Attempt to free unreferenced scalar");
	return;
    }
    if (--SvREFCNT(sv) > 0)
	return;
#ifdef DEBUGGING
    if (SvTEMP(sv)) {
	warn("Attempt to free temp prematurely");
	return;
    }
#endif
    sv_clear(sv);
    del_SV(sv);
}

STRLEN
sv_len(sv)
register SV *sv;
{
    char *s;
    STRLEN len;

    if (!sv)
	return 0;

    if (SvGMAGICAL(sv))
	len = mg_len(sv);
    else
	s = SvPV(sv, len);
    return len;
}

I32
sv_eq(str1,str2)
register SV *str1;
register SV *str2;
{
    char *pv1;
    STRLEN cur1;
    char *pv2;
    STRLEN cur2;

    if (!str1) {
	pv1 = "";
	cur1 = 0;
    }
    else
	pv1 = SvPV(str1, cur1);

    if (!str2)
	return !cur1;
    else
	pv2 = SvPV(str2, cur2);

    if (cur1 != cur2)
	return 0;

    return !bcmp(pv1, pv2, cur1);
}

I32
sv_cmp(str1,str2)
register SV *str1;
register SV *str2;
{
    I32 retval;
    char *pv1;
    STRLEN cur1;
    char *pv2;
    STRLEN cur2;

    if (!str1) {
	pv1 = "";
	cur1 = 0;
    }
    else
	pv1 = SvPV(str1, cur1);

    if (!str2) {
	pv2 = "";
	cur2 = 0;
    }
    else
	pv2 = SvPV(str2, cur2);

    if (!cur1)
	return cur2 ? -1 : 0;
    if (!cur2)
	return 1;

    if (cur1 < cur2) {
	/*SUPPRESS 560*/
	if (retval = memcmp(pv1, pv2, cur1))
	    return retval < 0 ? -1 : 1;
	else
	    return -1;
    }
    /*SUPPRESS 560*/
    else if (retval = memcmp(pv1, pv2, cur2))
	return retval < 0 ? -1 : 1;
    else if (cur1 == cur2)
	return 0;
    else
	return 1;
}

char *
sv_gets(sv,fp,append)
register SV *sv;
register FILE *fp;
I32 append;
{
    register char *bp;		/* we're going to steal some values */
    register I32 cnt;		/*  from the stdio struct and put EVERYTHING */
    register STDCHAR *ptr;	/*   in the innermost loop into registers */
    register I32 newline = rschar;/* (assuming >= 6 registers) */
    I32 i;
    STRLEN bpx;
    I32 shortbuffered;

    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (!SvUPGRADE(sv, SVt_PV))
	return;
    if (rspara) {		/* have to do this both before and after */
	do {			/* to make sure file boundaries work right */
	    i = getc(fp);
	    if (i != '\n') {
		ungetc(i,fp);
		break;
	    }
	} while (i != EOF);
    }
#ifdef STDSTDIO		/* Here is some breathtakingly efficient cheating */
    cnt = fp->_cnt;			/* get count into register */
    SvPOK_only(sv);			/* validate pointer */
    if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
	if (cnt > 80 && SvLEN(sv) > append) {
	    shortbuffered = cnt - SvLEN(sv) + append + 1;
	    cnt -= shortbuffered;
	}
	else {
	    shortbuffered = 0;
	    SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */
	}
    }
    else
	shortbuffered = 0;
    bp = SvPVX(sv) + append;		/* move these two too to registers */
    ptr = fp->_ptr;
    for (;;) {
      screamer:
	if (cnt > 0) {
	    while (--cnt >= 0) {		 /* this */	/* eat */
		if ((*bp++ = *ptr++) == newline) /* really */	/* dust */
		    goto thats_all_folks;	 /* screams */	/* sed :-) */ 
	    }
	}
	
	if (shortbuffered) {			/* oh well, must extend */
	    cnt = shortbuffered;
	    shortbuffered = 0;
	    bpx = bp - SvPVX(sv);	/* prepare for possible relocation */
	    SvCUR_set(sv, bpx);
	    SvGROW(sv, SvLEN(sv) + append + cnt + 2);
	    bp = SvPVX(sv) + bpx;	/* reconstitute our pointer */
	    continue;
	}

	fp->_cnt = cnt;			/* deregisterize cnt and ptr */
	fp->_ptr = ptr;
	i = _filbuf(fp);		/* get more characters */
	cnt = fp->_cnt;
	ptr = fp->_ptr;			/* reregisterize cnt and ptr */

	bpx = bp - SvPVX(sv);	/* prepare for possible relocation */
	SvCUR_set(sv, bpx);
	SvGROW(sv, bpx + cnt + 2);
	bp = SvPVX(sv) + bpx;	/* reconstitute our pointer */

	if (i == newline) {		/* all done for now? */
	    *bp++ = i;
	    goto thats_all_folks;
	}
	else if (i == EOF)		/* all done for ever? */
	    goto thats_really_all_folks;
	*bp++ = i;			/* now go back to screaming loop */
    }

thats_all_folks:
    if (rslen > 1 && (bp - SvPVX(sv) < rslen || bcmp(bp - rslen, rs, rslen)))
	goto screamer;	/* go back to the fray */
thats_really_all_folks:
    if (shortbuffered)
	cnt += shortbuffered;
    fp->_cnt = cnt;			/* put these back or we're in trouble */
    fp->_ptr = ptr;
    *bp = '\0';
    SvCUR_set(sv, bp - SvPVX(sv));	/* set length */

#else /* !STDSTDIO */	/* The big, slow, and stupid way */

    {
	char buf[8192];
	register char * bpe = buf + sizeof(buf) - 3;

screamer:
	bp = buf;
	while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;

	if (append)
	    sv_catpvn(sv, buf, bp - buf);
	else
	    sv_setpvn(sv, buf, bp - buf);
	if (i != EOF			/* joy */
	    &&
	    (i != newline
	     ||
	     (rslen > 1
	      &&
	      (SvCUR(sv) < rslen
	       ||
	       bcmp(SvPVX(sv) + SvCUR(sv) - rslen, rs, rslen)
	      )
	     )
	    )
	   )
	{
	    append = -1;
	    goto screamer;
	}
    }

#endif /* STDSTDIO */

    if (rspara) {
        while (i != EOF) {
	    i = getc(fp);
	    if (i != '\n') {
		ungetc(i,fp);
		break;
	    }
	}
    }
    return SvCUR(sv) - append ? SvPVX(sv) : Nullch;
}

void
sv_inc(sv)
register SV *sv;
{
    register char *d;
    int flags;

    if (!sv)
	return;
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (SvGMAGICAL(sv))
	mg_get(sv);
    flags = SvFLAGS(sv);
    if (flags & SVp_IOK) {
	++SvIVX(sv);
	SvIOK_only(sv);
	return;
    }
    if (flags & SVp_NOK) {
	SvNVX(sv) += 1.0;
	SvNOK_only(sv);
	return;
    }
    if (!(flags & SVp_POK) || !*SvPVX(sv)) {
	if (!SvUPGRADE(sv, SVt_NV))
	    return;
	SvNVX(sv) = 1.0;
	SvNOK_only(sv);
	return;
    }
    d = SvPVX(sv);
    while (isALPHA(*d)) d++;
    while (isDIGIT(*d)) d++;
    if (*d) {
        sv_setnv(sv,atof(SvPVX(sv)) + 1.0);  /* punt */
	return;
    }
    d--;
    while (d >= SvPVX(sv)) {
	if (isDIGIT(*d)) {
	    if (++*d <= '9')
		return;
	    *(d--) = '0';
	}
	else {
	    ++*d;
	    if (isALPHA(*d))
		return;
	    *(d--) -= 'z' - 'a' + 1;
	}
    }
    /* oh,oh, the number grew */
    SvGROW(sv, SvCUR(sv) + 2);
    SvCUR(sv)++;
    for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--)
	*d = d[-1];
    if (isDIGIT(d[1]))
	*d = '1';
    else
	*d = d[1];
}

void
sv_dec(sv)
register SV *sv;
{
    int flags;

    if (!sv)
	return;
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
	if (SvROK(sv))
	    sv_unref(sv);
    }
    if (SvGMAGICAL(sv))
	mg_get(sv);
    flags = SvFLAGS(sv);
    if (flags & SVp_IOK) {
	--SvIVX(sv);
	SvIOK_only(sv);
	return;
    }
    if (flags & SVp_NOK) {
	SvNVX(sv) -= 1.0;
	SvNOK_only(sv);
	return;
    }
    if (!(flags & SVp_POK)) {
	if (!SvUPGRADE(sv, SVt_NV))
	    return;
	SvNVX(sv) = -1.0;
	SvNOK_only(sv);
	return;
    }
    sv_setnv(sv,atof(SvPVX(sv)) - 1.0);
}

/* Make a string that will exist for the duration of the expression
 * evaluation.  Actually, it may have to last longer than that, but
 * hopefully we won't free it until it has been assigned to a
 * permanent location. */

static void
sv_mortalgrow()
{
    tmps_max += 128;
    Renew(tmps_stack, tmps_max, SV*);
}

SV *
sv_mortalcopy(oldstr)
SV *oldstr;
{
    register SV *sv;

    new_SV();
    SvANY(sv) = 0;
    SvREFCNT(sv) = 1;
    SvFLAGS(sv) = 0;
    sv_setsv(sv,oldstr);
    if (++tmps_ix >= tmps_max)
	sv_mortalgrow();
    tmps_stack[tmps_ix] = sv;
    SvTEMP_on(sv);
    return sv;
}

SV *
sv_newmortal()
{
    register SV *sv;

    new_SV();
    SvANY(sv) = 0;
    SvREFCNT(sv) = 1;
    SvFLAGS(sv) = SVs_TEMP;
    if (++tmps_ix >= tmps_max)
	sv_mortalgrow();
    tmps_stack[tmps_ix] = sv;
    return sv;
}

/* same thing without the copying */

SV *
sv_2mortal(sv)
register SV *sv;
{
    if (!sv)
	return sv;
    if (SvTHINKFIRST(sv)) {
	if (SvREADONLY(sv) && curcop != &compiling)
	    croak(no_modify);
    }
    if (++tmps_ix >= tmps_max)
	sv_mortalgrow();
    tmps_stack[tmps_ix] = sv;
    SvTEMP_on(sv);
    return sv;
}

SV *
newSVpv(s,len)
char *s;
STRLEN len;
{
    register SV *sv;

    new_SV();
    SvANY(sv) = 0;
    SvREFCNT(sv) = 1;
    SvFLAGS(sv) = 0;
    if (!len)
	len = strlen(s);
    sv_setpvn(sv,s,len);
    return sv;
}

SV *
newSVnv(n)
double n;
{
    register SV *sv;

    new_SV();
    SvANY(sv) = 0;
    SvREFCNT(sv) = 1;
    SvFLAGS(sv) = 0;
    sv_setnv(sv,n);
    return sv;
}

SV *
newSViv(i)
I32 i;
{
    register SV *sv;

    new_SV();
    SvANY(sv) = 0;
    SvREFCNT(sv) = 1;
    SvFLAGS(sv) = 0;
    sv_setiv(sv,i);
    return sv;
}

/* make an exact duplicate of old */

SV *
newSVsv(old)
register SV *old;
{
    register SV *sv;

    if (!old)
	return Nullsv;
    if (SvTYPE(old) == SVTYPEMASK) {
	warn("semi-panic: attempt to dup freed string");
	return Nullsv;
    }
    new_SV();
    SvANY(sv) = 0;
    SvREFCNT(sv) = 1;
    SvFLAGS(sv) = 0;
    if (SvTEMP(old)) {
	SvTEMP_off(old);
	sv_setsv(sv,old);
	SvTEMP_on(old);
    }
    else
	sv_setsv(sv,old);
    return sv;
}

void
sv_reset(s,stash)
register char *s;
HV *stash;
{
    register HE *entry;
    register GV *gv;
    register SV *sv;
    register I32 i;
    register PMOP *pm;
    register I32 max;
    char todo[256];

    if (!*s) {		/* reset ?? searches */
	for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
	    pm->op_pmflags &= ~PMf_USED;
	}
	return;
    }

    /* reset variables */

    if (!HvARRAY(stash))
	return;

    Zero(todo, 256, char);
    while (*s) {
	i = *s;
	if (s[1] == '-') {
	    s += 2;
	}
	max = *s++;
	for ( ; i <= max; i++) {
	    todo[i] = 1;
	}
	for (i = 0; i <= HvMAX(stash); i++) {
	    for (entry = HvARRAY(stash)[i];
	      entry;
	      entry = entry->hent_next) {
		if (!todo[(U8)*entry->hent_key])
		    continue;
		gv = (GV*)entry->hent_val;
		sv = GvSV(gv);
		SvOK_off(sv);
		if (SvTYPE(sv) >= SVt_PV) {
		    SvCUR_set(sv, 0);
		    SvTAINT(sv);
		    if (SvPVX(sv) != Nullch)
			*SvPVX(sv) = '\0';
		}
		if (GvAV(gv)) {
		    av_clear(GvAV(gv));
		}
		if (GvHV(gv)) {
		    hv_clear(GvHV(gv));
		    if (gv == envgv)
			environ[0] = Nullch;
		}
	    }
	}
    }
}

CV *
sv_2cv(sv, st, gvp, lref)
SV *sv;
HV **st;
GV **gvp;
I32 lref;
{
    GV *gv;
    CV *cv;

    if (!sv)
	return *gvp = Nullgv, Nullcv;
    switch (SvTYPE(sv)) {
    case SVt_RV:
      is_rv:
	cv = (CV*)SvRV(sv);
	if (SvTYPE(cv) != SVt_PVCV)
	    croak("Not a subroutine reference");
	*gvp = Nullgv;
	*st = CvSTASH(cv);
	return cv;
    case SVt_PVCV:
	*st = CvSTASH(sv);
	*gvp = Nullgv;
	return (CV*)sv;
    case SVt_PVHV:
    case SVt_PVAV:
	*gvp = Nullgv;
	return Nullcv;
    case SVt_PVGV:
	gv = (GV*)sv;
	*st = GvESTASH(gv);
	goto fix_gv;

    default:
	if (SvROK(sv))
	    goto is_rv;
	if (isGV(sv))
	    gv = (GV*)sv;
	else
	    gv = gv_fetchpv(SvPV(sv, na), lref);
	*gvp = gv;
	if (!gv)
	    return Nullcv;
	*st = GvESTASH(gv);
    fix_gv:
	if (lref && !GvCV(gv)) {
	    sv = NEWSV(0,0);
	    gv_efullname(sv, gv);
	    newSUB(savestack_ix,
		   newSVOP(OP_CONST, 0, sv),
		   Nullop);
	}
	return GvCV(gv);
    }
}

#ifndef SvTRUE
I32
SvTRUE(sv)
register SV *sv;
{
    if (!sv)
	return 0;
    if (SvGMAGICAL(sv))
	mg_get(sv);
    if (SvPOK(sv)) {
	register XPV* Xpv;
	if ((Xpv = (XPV*)SvANY(sv)) &&
		(*Xpv->xpv_pv > '0' ||
		Xpv->xpv_cur > 1 ||
		(Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
	    return 1;
	else
	    return 0;
    }
    else {
	if (SvIOK(sv))
	    return SvIVX(sv) != 0;
	else {
	    if (SvNOK(sv))
		return SvNVX(sv) != 0.0;
	    else
		return sv_2bool(sv);
	}
    }
}
#endif /* SvTRUE */

#ifndef SvNV
double SvNV(Sv)
register SV *Sv;
{
    if (SvNOK(Sv))
	return SvNVX(Sv);
    if (SvIOK(Sv))
	return (double)SvIVX(Sv);
    return sv_2nv(Sv);
}
#endif /* SvNV */

#ifdef CRIPPLED_CC
char *
sv_pvn(sv, lp)
SV *sv;
STRLEN *lp;
{
    if (SvPOK(sv))
	return SvPVX(sv)
    return sv_2pv(sv, lp);
}
#endif

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*
sv_setptrobj(rv, ptr, name)
SV *rv;
void *ptr;
char *name;
{
    HV *stash;
    SV *sv;

    if (!ptr)
	return rv;

    new_SV();
    SvANY(sv) = 0;
    SvREFCNT(sv) = 1;
    SvFLAGS(sv) = 0;
    sv_setnv(sv, (double)(unsigned long)ptr);
    sv_upgrade(rv, SVt_RV);
    SvRV(rv) = SvREFCNT_inc(sv);
    SvROK_on(rv);
    ++sv_rvcount;

    stash = fetch_stash(newSVpv(name,0), TRUE);
    SvOBJECT_on(sv);
    SvUPGRADE(sv, SVt_PVMG);
    SvSTASH(sv) = (HV*)SvREFCNT_inc(stash);

    return rv;
}

void
sv_unref(sv)
SV* sv;
{
    SvREFCNT_dec(SvRV(sv));
    SvRV(sv) = 0;
    SvROK_off(sv);
    --sv_rvcount;
}

#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_OK)		strcat(d, "OK,");
    if (flags & SVf_OOK)	strcat(d, "OOK,");
    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 = %.20g\n", SvNVX(sv));
    if (SvROK(sv)) {
	fprintf(stderr, "  RV = 0x%lx\n", 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",
		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", 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", LvTARG(sv));
	sv_dump(LvTARG(sv));
	break;
    case SVt_PVAV:
	fprintf(stderr, "  ARRAY = 0x%lx\n", AvARRAY(sv));
	fprintf(stderr, "  ALLOC = 0x%lx\n", AvALLOC(sv));
	fprintf(stderr, "  FILL = %ld\n", (long)AvFILL(sv));
	fprintf(stderr, "  MAX = %ld\n", (long)AvMAX(sv));
	fprintf(stderr, "  ARYLEN = 0x%lx\n", AvARYLEN(sv));
	if (AvREAL(sv))
	    fprintf(stderr, "  FLAGS = (REAL)\n");
	else
	    fprintf(stderr, "  FLAGS = ()\n");
	break;
    case SVt_PVHV:
	fprintf(stderr, "  ARRAY = 0x%lx\n", 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", HvEITER(sv));
	if (HvPMROOT(sv))
	    fprintf(stderr, "  PMROOT = 0x%lx\n", 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", CvSTASH(sv));
	fprintf(stderr, "  START = 0x%lx\n", CvSTART(sv));
	fprintf(stderr, "  ROOT = 0x%lx\n", CvROOT(sv));
	fprintf(stderr, "  USERSUB = 0x%lx\n", CvUSERSUB(sv));
	fprintf(stderr, "  USERINDEX = %ld\n", (long)CvUSERINDEX(sv));
	fprintf(stderr, "  FILEGV = 0x%lx\n", CvFILEGV(sv));
	fprintf(stderr, "  DEPTH = %ld\n", (long)CvDEPTH(sv));
	fprintf(stderr, "  PADLIST = 0x%lx\n", CvPADLIST(sv));
	fprintf(stderr, "  DELETED = %ld\n", (long)CvDELETED(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", GvSTASH(sv));
	fprintf(stderr, "  GP = 0x%lx\n", GvGP(sv));
	fprintf(stderr, "    SV = 0x%lx\n", GvSV(sv));
	fprintf(stderr, "    REFCNT = %ld\n", (long)GvREFCNT(sv));
	fprintf(stderr, "    IO = 0x%lx\n", GvIO(sv));
	fprintf(stderr, "    FORM = 0x%lx\n", GvFORM(sv));
	fprintf(stderr, "    AV = 0x%lx\n", GvAV(sv));
	fprintf(stderr, "    HV = 0x%lx\n", GvHV(sv));
	fprintf(stderr, "    CV = 0x%lx\n", GvCV(sv));
	fprintf(stderr, "    CVGEN = 0x%lx\n", 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", GvSTASH(sv));
	fprintf(stderr, "    EGV = 0x%lx\n", GvEGV(sv));
	break;
    case SVt_PVIO:
	fprintf(stderr, "  IFP = 0x%lx\n", IoIFP(sv));
	fprintf(stderr, "  OFP = 0x%lx\n", IoOFP(sv));
	fprintf(stderr, "  DIRP = 0x%lx\n", 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", IoTOP_GV(sv));
	fprintf(stderr, "  FMT_NAME = %s\n", IoFMT_NAME(sv));
	fprintf(stderr, "  FMT_GV = 0x%lx\n", IoFMT_GV(sv));
	fprintf(stderr, "  BOTTOM_NAME = %s\n", IoBOTTOM_NAME(sv));
	fprintf(stderr, "  BOTTOM_GV = 0x%lx\n", IoBOTTOM_GV(sv));
	fprintf(stderr, "  SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv));
	fprintf(stderr, "  TYPE = %c\n", IoTYPE(sv));
	fprintf(stderr, "  FLAGS = 0x%lx\n", IoFLAGS(sv));
	break;
    }
}
#endif