(was Re: [PATCH] Re: Report /pro/3gl/CPAN/perl-5.7.1)

[perl5.git] / pp.c

/*    pp.c
 *
 *    Copyright (c) 1991-2001, 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.
 *
 */

/*
 * "It's a big house this, and very peculiar.  Always a bit more to discover,
 * and no knowing what you'll find around a corner.  And Elves, sir!" --Samwise
 */

#include "EXTERN.h"
#define PERL_IN_PP_C
#include "perl.h"

/*
 * The compiler on Concurrent CX/UX systems has a subtle bug which only
 * seems to show up when compiling pp.c - it generates the wrong double
 * precision constant value for (double)UV_MAX when used inline in the body
 * of the code below, so this makes a static variable up front (which the
 * compiler seems to get correct) and uses it in place of UV_MAX below.
 */
#ifdef CXUX_BROKEN_CONSTANT_CONVERT
static double UV_MAX_cxux = ((double)UV_MAX);
#endif

/*
 * Offset for integer pack/unpack.
 *
 * On architectures where I16 and I32 aren't really 16 and 32 bits,
 * which for now are all Crays, pack and unpack have to play games.
 */

/*
 * These values are required for portability of pack() output.
 * If they're not right on your machine, then pack() and unpack()
 * wouldn't work right anyway; you'll need to apply the Cray hack.
 * (I'd like to check them with #if, but you can't use sizeof() in
 * the preprocessor.)  --???
 */
/*
    The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE
    defines are now in config.h.  --Andy Dougherty  April 1998
 */
#define SIZE16 2
#define SIZE32 4

/* CROSSCOMPILE and MULTIARCH are going to affect pp_pack() and pp_unpack().
   --jhi Feb 1999 */

#if SHORTSIZE != SIZE16 || LONGSIZE != SIZE32
#   define PERL_NATINT_PACK
#endif

#if LONGSIZE > 4 && defined(_CRAY)
#  if BYTEORDER == 0x12345678
#    define OFF16(p)	(char*)(p)
#    define OFF32(p)	(char*)(p)
#  else
#    if BYTEORDER == 0x87654321
#      define OFF16(p)	((char*)(p) + (sizeof(U16) - SIZE16))
#      define OFF32(p)	((char*)(p) + (sizeof(U32) - SIZE32))
#    else
       }}}} bad cray byte order
#    endif
#  endif
#  define COPY16(s,p)  (*(p) = 0, Copy(s, OFF16(p), SIZE16, char))
#  define COPY32(s,p)  (*(p) = 0, Copy(s, OFF32(p), SIZE32, char))
#  define COPYNN(s,p,n) (*(p) = 0, Copy(s, (char *)(p), n, char))
#  define CAT16(sv,p)  sv_catpvn(sv, OFF16(p), SIZE16)
#  define CAT32(sv,p)  sv_catpvn(sv, OFF32(p), SIZE32)
#else
#  define COPY16(s,p)  Copy(s, p, SIZE16, char)
#  define COPY32(s,p)  Copy(s, p, SIZE32, char)
#  define COPYNN(s,p,n) Copy(s, (char *)(p), n, char)
#  define CAT16(sv,p)  sv_catpvn(sv, (char*)(p), SIZE16)
#  define CAT32(sv,p)  sv_catpvn(sv, (char*)(p), SIZE32)
#endif

/* variations on pp_null */

/* XXX I can't imagine anyone who doesn't have this actually _needs_
   it, since pid_t is an integral type.
   --AD  2/20/1998
*/
#ifdef NEED_GETPID_PROTO
extern Pid_t getpid (void);
#endif

PP(pp_stub)
{
    dSP;
    if (GIMME_V == G_SCALAR)
	XPUSHs(&PL_sv_undef);
    RETURN;
}

PP(pp_scalar)
{
    return NORMAL;
}

/* Pushy stuff. */

PP(pp_padav)
{
    dSP; dTARGET;
    if (PL_op->op_private & OPpLVAL_INTRO)
	SAVECLEARSV(PL_curpad[PL_op->op_targ]);
    EXTEND(SP, 1);
    if (PL_op->op_flags & OPf_REF) {
	PUSHs(TARG);
	RETURN;
    } else if (LVRET) {
	if (GIMME == G_SCALAR)
	    Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
	PUSHs(TARG);
	RETURN;
    }
    if (GIMME == G_ARRAY) {
	I32 maxarg = AvFILL((AV*)TARG) + 1;
	EXTEND(SP, maxarg);
	if (SvMAGICAL(TARG)) {
	    U32 i;
	    for (i=0; i < maxarg; i++) {
		SV **svp = av_fetch((AV*)TARG, i, FALSE);
		SP[i+1] = (svp) ? *svp : &PL_sv_undef;
	    }
	}
	else {
	    Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
	}
	SP += maxarg;
    }
    else {
	SV* sv = sv_newmortal();
	I32 maxarg = AvFILL((AV*)TARG) + 1;
	sv_setiv(sv, maxarg);
	PUSHs(sv);
    }
    RETURN;
}

PP(pp_padhv)
{
    dSP; dTARGET;
    I32 gimme;

    XPUSHs(TARG);
    if (PL_op->op_private & OPpLVAL_INTRO)
	SAVECLEARSV(PL_curpad[PL_op->op_targ]);
    if (PL_op->op_flags & OPf_REF)
	RETURN;
    else if (LVRET) {
	if (GIMME == G_SCALAR)
	    Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
	RETURN;
    }
    gimme = GIMME_V;
    if (gimme == G_ARRAY) {
	RETURNOP(do_kv());
    }
    else if (gimme == G_SCALAR) {
	SV* sv = sv_newmortal();
	if (HvFILL((HV*)TARG))
	    Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
		      (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1);
	else
	    sv_setiv(sv, 0);
	SETs(sv);
    }
    RETURN;
}

PP(pp_padany)
{
    DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
}

/* Translations. */

PP(pp_rv2gv)
{
    dSP; dTOPss;

    if (SvROK(sv)) {
      wasref:
	tryAMAGICunDEREF(to_gv);

	sv = SvRV(sv);
	if (SvTYPE(sv) == SVt_PVIO) {
	    GV *gv = (GV*) sv_newmortal();
	    gv_init(gv, 0, "", 0, 0);
	    GvIOp(gv) = (IO *)sv;
	    (void)SvREFCNT_inc(sv);
	    sv = (SV*) gv;
	}
	else if (SvTYPE(sv) != SVt_PVGV)
	    DIE(aTHX_ "Not a GLOB reference");
    }
    else {
	if (SvTYPE(sv) != SVt_PVGV) {
	    char *sym;
	    STRLEN len;

	    if (SvGMAGICAL(sv)) {
		mg_get(sv);
		if (SvROK(sv))
		    goto wasref;
	    }
	    if (!SvOK(sv) && sv != &PL_sv_undef) {
		/* If this is a 'my' scalar and flag is set then vivify
		 * NI-S 1999/05/07
		 */
		if (PL_op->op_private & OPpDEREF) {
		    char *name;
		    GV *gv;
		    if (cUNOP->op_targ) {
			STRLEN len;
			SV *namesv = PL_curpad[cUNOP->op_targ];
			name = SvPV(namesv, len);
			gv = (GV*)NEWSV(0,0);
			gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
		    }
		    else {
			name = CopSTASHPV(PL_curcop);
			gv = newGVgen(name);
		    }
		    if (SvTYPE(sv) < SVt_RV)
			sv_upgrade(sv, SVt_RV);
		    SvRV(sv) = (SV*)gv;
		    SvROK_on(sv);
		    SvSETMAGIC(sv);
		    goto wasref;
		}
		if (PL_op->op_flags & OPf_REF ||
		    PL_op->op_private & HINT_STRICT_REFS)
		    DIE(aTHX_ PL_no_usym, "a symbol");
		if (ckWARN(WARN_UNINITIALIZED))
		    report_uninit();
		RETSETUNDEF;
	    }
	    sym = SvPV(sv,len);
	    if ((PL_op->op_flags & OPf_SPECIAL) &&
		!(PL_op->op_flags & OPf_MOD))
	    {
		sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV);
		if (!sv
		    && (!is_gv_magical(sym,len,0)
			|| !(sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV))))
		{
		    RETSETUNDEF;
		}
	    }
	    else {
		if (PL_op->op_private & HINT_STRICT_REFS)
		    DIE(aTHX_ PL_no_symref, sym, "a symbol");
		sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
	    }
	}
    }
    if (PL_op->op_private & OPpLVAL_INTRO)
	save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL));
    SETs(sv);
    RETURN;
}

PP(pp_rv2sv)
{
    dSP; dTOPss;

    if (SvROK(sv)) {
      wasref:
	tryAMAGICunDEREF(to_sv);

	sv = SvRV(sv);
	switch (SvTYPE(sv)) {
	case SVt_PVAV:
	case SVt_PVHV:
	case SVt_PVCV:
	    DIE(aTHX_ "Not a SCALAR reference");
	}
    }
    else {
	GV *gv = (GV*)sv;
	char *sym;
	STRLEN len;

	if (SvTYPE(gv) != SVt_PVGV) {
	    if (SvGMAGICAL(sv)) {
		mg_get(sv);
		if (SvROK(sv))
		    goto wasref;
	    }
	    if (!SvOK(sv)) {
		if (PL_op->op_flags & OPf_REF ||
		    PL_op->op_private & HINT_STRICT_REFS)
		    DIE(aTHX_ PL_no_usym, "a SCALAR");
		if (ckWARN(WARN_UNINITIALIZED))
		    report_uninit();
		RETSETUNDEF;
	    }
	    sym = SvPV(sv, len);
	    if ((PL_op->op_flags & OPf_SPECIAL) &&
		!(PL_op->op_flags & OPf_MOD))
	    {
		gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV);
		if (!gv
		    && (!is_gv_magical(sym,len,0)
			|| !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV))))
		{
		    RETSETUNDEF;
		}
	    }
	    else {
		if (PL_op->op_private & HINT_STRICT_REFS)
		    DIE(aTHX_ PL_no_symref, sym, "a SCALAR");
		gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
	    }
	}
	sv = GvSV(gv);
    }
    if (PL_op->op_flags & OPf_MOD) {
	if (PL_op->op_private & OPpLVAL_INTRO)
	    sv = save_scalar((GV*)TOPs);
	else if (PL_op->op_private & OPpDEREF)
	    vivify_ref(sv, PL_op->op_private & OPpDEREF);
    }
    SETs(sv);
    RETURN;
}

PP(pp_av2arylen)
{
    dSP;
    AV *av = (AV*)TOPs;
    SV *sv = AvARYLEN(av);
    if (!sv) {
	AvARYLEN(av) = sv = NEWSV(0,0);
	sv_upgrade(sv, SVt_IV);
	sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0);
    }
    SETs(sv);
    RETURN;
}

PP(pp_pos)
{
    dSP; dTARGET; dPOPss;

    if (PL_op->op_flags & OPf_MOD || LVRET) {
	if (SvTYPE(TARG) < SVt_PVLV) {
	    sv_upgrade(TARG, SVt_PVLV);
	    sv_magic(TARG, Nullsv, PERL_MAGIC_pos, Nullch, 0);
	}

	LvTYPE(TARG) = '.';
	if (LvTARG(TARG) != sv) {
	    if (LvTARG(TARG))
		SvREFCNT_dec(LvTARG(TARG));
	    LvTARG(TARG) = SvREFCNT_inc(sv);
	}
	PUSHs(TARG);	/* no SvSETMAGIC */
	RETURN;
    }
    else {
	MAGIC* mg;

	if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
	    mg = mg_find(sv, PERL_MAGIC_regex_global);
	    if (mg && mg->mg_len >= 0) {
		I32 i = mg->mg_len;
		if (DO_UTF8(sv))
		    sv_pos_b2u(sv, &i);
		PUSHi(i + PL_curcop->cop_arybase);
		RETURN;
	    }
	}
	RETPUSHUNDEF;
    }
}

PP(pp_rv2cv)
{
    dSP;
    GV *gv;
    HV *stash;

    /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
    /* (But not in defined().) */
    CV *cv = sv_2cv(TOPs, &stash, &gv, !(PL_op->op_flags & OPf_SPECIAL));
    if (cv) {
	if (CvCLONE(cv))
	    cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
	if ((PL_op->op_private & OPpLVAL_INTRO)) {
	    if (gv && GvCV(gv) == cv && (gv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE)))
		cv = GvCV(gv);
	    if (!CvLVALUE(cv))
		DIE(aTHX_ "Can't modify non-lvalue subroutine call");
	}
    }
    else
	cv = (CV*)&PL_sv_undef;
    SETs((SV*)cv);
    RETURN;
}

PP(pp_prototype)
{
    dSP;
    CV *cv;
    HV *stash;
    GV *gv;
    SV *ret;

    ret = &PL_sv_undef;
    if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
	char *s = SvPVX(TOPs);
	if (strnEQ(s, "CORE::", 6)) {
	    int code;
	
	    code = keyword(s + 6, SvCUR(TOPs) - 6);
	    if (code < 0) {	/* Overridable. */
#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
		int i = 0, n = 0, seen_question = 0;
		I32 oa;
		char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */

		while (i < MAXO) {	/* The slow way. */
		    if (strEQ(s + 6, PL_op_name[i])
			|| strEQ(s + 6, PL_op_desc[i]))
		    {
			goto found;
		    }
		    i++;
		}
		goto nonesuch;		/* Should not happen... */
	      found:
		oa = PL_opargs[i] >> OASHIFT;
		while (oa) {
		    if (oa & OA_OPTIONAL && !seen_question) {
			seen_question = 1;
			str[n++] = ';';
		    }
		    else if (n && str[0] == ';' && seen_question)
			goto set;	/* XXXX system, exec */
		    if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
			&& (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF
			/* But globs are already references (kinda) */
			&& (oa & (OA_OPTIONAL - 1)) != OA_FILEREF
		    ) {
			str[n++] = '\\';
		    }
		    str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
		    oa = oa >> 4;
		}
		str[n++] = '\0';
		ret = sv_2mortal(newSVpvn(str, n - 1));
	    }
	    else if (code)		/* Non-Overridable */
		goto set;
	    else {			/* None such */
	      nonesuch:
		DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
	    }
	}
    }
    cv = sv_2cv(TOPs, &stash, &gv, FALSE);
    if (cv && SvPOK(cv))
	ret = sv_2mortal(newSVpvn(SvPVX(cv), SvCUR(cv)));
  set:
    SETs(ret);
    RETURN;
}

PP(pp_anoncode)
{
    dSP;
    CV* cv = (CV*)PL_curpad[PL_op->op_targ];
    if (CvCLONE(cv))
	cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
    EXTEND(SP,1);
    PUSHs((SV*)cv);
    RETURN;
}

PP(pp_srefgen)
{
    dSP;
    *SP = refto(*SP);
    RETURN;
}

PP(pp_refgen)
{
    dSP; dMARK;
    if (GIMME != G_ARRAY) {
	if (++MARK <= SP)
	    *MARK = *SP;
	else
	    *MARK = &PL_sv_undef;
	*MARK = refto(*MARK);
	SP = MARK;
	RETURN;
    }
    EXTEND_MORTAL(SP - MARK);
    while (++MARK <= SP)
	*MARK = refto(*MARK);
    RETURN;
}

STATIC SV*
S_refto(pTHX_ SV *sv)
{
    SV* rv;

    if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
	if (LvTARGLEN(sv))
	    vivify_defelem(sv);
	if (!(sv = LvTARG(sv)))
	    sv = &PL_sv_undef;
	else
	    (void)SvREFCNT_inc(sv);
    }
    else if (SvTYPE(sv) == SVt_PVAV) {
	if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
	    av_reify((AV*)sv);
	SvTEMP_off(sv);
	(void)SvREFCNT_inc(sv);
    }
    else if (SvPADTMP(sv))
	sv = newSVsv(sv);
    else {
	SvTEMP_off(sv);
	(void)SvREFCNT_inc(sv);
    }
    rv = sv_newmortal();
    sv_upgrade(rv, SVt_RV);
    SvRV(rv) = sv;
    SvROK_on(rv);
    return rv;
}

PP(pp_ref)
{
    dSP; dTARGET;
    SV *sv;
    char *pv;

    sv = POPs;

    if (sv && SvGMAGICAL(sv))
	mg_get(sv);

    if (!sv || !SvROK(sv))
	RETPUSHNO;

    sv = SvRV(sv);
    pv = sv_reftype(sv,TRUE);
    PUSHp(pv, strlen(pv));
    RETURN;
}

PP(pp_bless)
{
    dSP;
    HV *stash;

    if (MAXARG == 1)
	stash = CopSTASH(PL_curcop);
    else {
	SV *ssv = POPs;
	STRLEN len;
	char *ptr;

	if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
	    Perl_croak(aTHX_ "Attempt to bless into a reference");
	ptr = SvPV(ssv,len);
	if (ckWARN(WARN_MISC) && len == 0)
	    Perl_warner(aTHX_ WARN_MISC,
		   "Explicit blessing to '' (assuming package main)");
	stash = gv_stashpvn(ptr, len, TRUE);
    }

    (void)sv_bless(TOPs, stash);
    RETURN;
}

PP(pp_gelem)
{
    GV *gv;
    SV *sv;
    SV *tmpRef;
    char *elem;
    dSP;
    STRLEN n_a;

    sv = POPs;
    elem = SvPV(sv, n_a);
    gv = (GV*)POPs;
    tmpRef = Nullsv;
    sv = Nullsv;
    switch (elem ? *elem : '\0')
    {
    case 'A':
	if (strEQ(elem, "ARRAY"))
	    tmpRef = (SV*)GvAV(gv);
	break;
    case 'C':
	if (strEQ(elem, "CODE"))
	    tmpRef = (SV*)GvCVu(gv);
	break;
    case 'F':
	if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
	    tmpRef = (SV*)GvIOp(gv);
	else
	if (strEQ(elem, "FORMAT"))
	    tmpRef = (SV*)GvFORM(gv);
	break;
    case 'G':
	if (strEQ(elem, "GLOB"))
	    tmpRef = (SV*)gv;
	break;
    case 'H':
	if (strEQ(elem, "HASH"))
	    tmpRef = (SV*)GvHV(gv);
	break;
    case 'I':
	if (strEQ(elem, "IO"))
	    tmpRef = (SV*)GvIOp(gv);
	break;
    case 'N':
	if (strEQ(elem, "NAME"))
	    sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv));
	break;
    case 'P':
	if (strEQ(elem, "PACKAGE"))
	    sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
	break;
    case 'S':
	if (strEQ(elem, "SCALAR"))
	    tmpRef = GvSV(gv);
	break;
    }
    if (tmpRef)
	sv = newRV(tmpRef);
    if (sv)
	sv_2mortal(sv);
    else
	sv = &PL_sv_undef;
    XPUSHs(sv);
    RETURN;
}

/* Pattern matching */

PP(pp_study)
{
    dSP; dPOPss;
    register unsigned char *s;
    register I32 pos;
    register I32 ch;
    register I32 *sfirst;
    register I32 *snext;
    STRLEN len;

    if (sv == PL_lastscream) {
	if (SvSCREAM(sv))
	    RETPUSHYES;
    }
    else {
	if (PL_lastscream) {
	    SvSCREAM_off(PL_lastscream);
	    SvREFCNT_dec(PL_lastscream);
	}
	PL_lastscream = SvREFCNT_inc(sv);
    }

    s = (unsigned char*)(SvPV(sv, len));
    pos = len;
    if (pos <= 0)
	RETPUSHNO;
    if (pos > PL_maxscream) {
	if (PL_maxscream < 0) {
	    PL_maxscream = pos + 80;
	    New(301, PL_screamfirst, 256, I32);
	    New(302, PL_screamnext, PL_maxscream, I32);
	}
	else {
	    PL_maxscream = pos + pos / 4;
	    Renew(PL_screamnext, PL_maxscream, I32);
	}
    }

    sfirst = PL_screamfirst;
    snext = PL_screamnext;

    if (!sfirst || !snext)
	DIE(aTHX_ "do_study: out of memory");

    for (ch = 256; ch; --ch)
	*sfirst++ = -1;
    sfirst -= 256;

    while (--pos >= 0) {
	ch = s[pos];
	if (sfirst[ch] >= 0)
	    snext[pos] = sfirst[ch] - pos;
	else
	    snext[pos] = -pos;
	sfirst[ch] = pos;
    }

    SvSCREAM_on(sv);
    /* piggyback on m//g magic */
    sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
    RETPUSHYES;
}

PP(pp_trans)
{
    dSP; dTARG;
    SV *sv;

    if (PL_op->op_flags & OPf_STACKED)
	sv = POPs;
    else {
	sv = DEFSV;
	EXTEND(SP,1);
    }
    TARG = sv_newmortal();
    PUSHi(do_trans(sv));
    RETURN;
}

/* Lvalue operators. */

PP(pp_schop)
{
    dSP; dTARGET;
    do_chop(TARG, TOPs);
    SETTARG;
    RETURN;
}

PP(pp_chop)
{
    dSP; dMARK; dTARGET; dORIGMARK;
    while (MARK < SP)
	do_chop(TARG, *++MARK);
    SP = ORIGMARK;
    PUSHTARG;
    RETURN;
}

PP(pp_schomp)
{
    dSP; dTARGET;
    SETi(do_chomp(TOPs));
    RETURN;
}

PP(pp_chomp)
{
    dSP; dMARK; dTARGET;
    register I32 count = 0;

    while (SP > MARK)
	count += do_chomp(POPs);
    PUSHi(count);
    RETURN;
}

PP(pp_defined)
{
    dSP;
    register SV* sv;

    sv = POPs;
    if (!sv || !SvANY(sv))
	RETPUSHNO;
    switch (SvTYPE(sv)) {
    case SVt_PVAV:
	if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
		|| (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
	    RETPUSHYES;
	break;
    case SVt_PVHV:
	if (HvARRAY(sv) || SvGMAGICAL(sv)
		|| (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
	    RETPUSHYES;
	break;
    case SVt_PVCV:
	if (CvROOT(sv) || CvXSUB(sv))
	    RETPUSHYES;
	break;
    default:
	if (SvGMAGICAL(sv))
	    mg_get(sv);
	if (SvOK(sv))
	    RETPUSHYES;
    }
    RETPUSHNO;
}

PP(pp_undef)
{
    dSP;
    SV *sv;

    if (!PL_op->op_private) {
	EXTEND(SP, 1);
	RETPUSHUNDEF;
    }

    sv = POPs;
    if (!sv)
	RETPUSHUNDEF;

    if (SvTHINKFIRST(sv))
	sv_force_normal(sv);

    switch (SvTYPE(sv)) {
    case SVt_NULL:
	break;
    case SVt_PVAV:
	av_undef((AV*)sv);
	break;
    case SVt_PVHV:
	hv_undef((HV*)sv);
	break;
    case SVt_PVCV:
	if (ckWARN(WARN_MISC) && cv_const_sv((CV*)sv))
	    Perl_warner(aTHX_ WARN_MISC, "Constant subroutine %s undefined",
		 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
	/* FALL THROUGH */
    case SVt_PVFM:
	{
	    /* let user-undef'd sub keep its identity */
	    GV* gv = CvGV((CV*)sv);
	    cv_undef((CV*)sv);
	    CvGV((CV*)sv) = gv;
	}
	break;
    case SVt_PVGV:
	if (SvFAKE(sv))
	    SvSetMagicSV(sv, &PL_sv_undef);
	else {
	    GP *gp;
	    gp_free((GV*)sv);
	    Newz(602, gp, 1, GP);
	    GvGP(sv) = gp_ref(gp);
	    GvSV(sv) = NEWSV(72,0);
	    GvLINE(sv) = CopLINE(PL_curcop);
	    GvEGV(sv) = (GV*)sv;
	    GvMULTI_on(sv);
	}
	break;
    default:
	if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
	    (void)SvOOK_off(sv);
	    Safefree(SvPVX(sv));
	    SvPV_set(sv, Nullch);
	    SvLEN_set(sv, 0);
	}
	(void)SvOK_off(sv);
	SvSETMAGIC(sv);
    }

    RETPUSHUNDEF;
}

PP(pp_predec)
{
    dSP;
    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
	DIE(aTHX_ PL_no_modify);
    if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
    	SvIVX(TOPs) != IV_MIN)
    {
	--SvIVX(TOPs);
	SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
    }
    else
	sv_dec(TOPs);
    SvSETMAGIC(TOPs);
    return NORMAL;
}

PP(pp_postinc)
{
    dSP; dTARGET;
    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
	DIE(aTHX_ PL_no_modify);
    sv_setsv(TARG, TOPs);
    if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
    	SvIVX(TOPs) != IV_MAX)
    {
	++SvIVX(TOPs);
	SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
    }
    else
	sv_inc(TOPs);
    SvSETMAGIC(TOPs);
    if (!SvOK(TARG))
	sv_setiv(TARG, 0);
    SETs(TARG);
    return NORMAL;
}

PP(pp_postdec)
{
    dSP; dTARGET;
    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
	DIE(aTHX_ PL_no_modify);
    sv_setsv(TARG, TOPs);
    if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
    	SvIVX(TOPs) != IV_MIN)
    {
	--SvIVX(TOPs);
	SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
    }
    else
	sv_dec(TOPs);
    SvSETMAGIC(TOPs);
    SETs(TARG);
    return NORMAL;
}

/* Ordinary operators. */

PP(pp_pow)
{
    dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
    {
      dPOPTOPnnrl;
      SETn( Perl_pow( left, right) );
      RETURN;
    }
}

PP(pp_multiply)
{
    dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
#ifdef PERL_PRESERVE_IVUV
    SvIV_please(TOPs);
    if (SvIOK(TOPs)) {
	/* Unless the left argument is integer in range we are going to have to
	   use NV maths. Hence only attempt to coerce the right argument if
	   we know the left is integer.  */
	/* Left operand is defined, so is it IV? */
	SvIV_please(TOPm1s);
	if (SvIOK(TOPm1s)) {
	    bool auvok = SvUOK(TOPm1s);
	    bool buvok = SvUOK(TOPs);
	    const UV topmask = (~ (UV)0) << (4 * sizeof (UV));
	    const UV botmask = ~((~ (UV)0) << (4 * sizeof (UV)));
	    UV alow;
	    UV ahigh;
	    UV blow;
	    UV bhigh;

	    if (auvok) {
		alow = SvUVX(TOPm1s);
	    } else {
		IV aiv = SvIVX(TOPm1s);
		if (aiv >= 0) {
		    alow = aiv;
		    auvok = TRUE; /* effectively it's a UV now */
		} else {
		    alow = -aiv; /* abs, auvok == false records sign */
		}
	    }
	    if (buvok) {
		blow = SvUVX(TOPs);
	    } else {
		IV biv = SvIVX(TOPs);
		if (biv >= 0) {
		    blow = biv;
		    buvok = TRUE; /* effectively it's a UV now */
		} else {
		    blow = -biv; /* abs, buvok == false records sign */
		}
	    }

	    /* If this does sign extension on unsigned it's time for plan B  */
	    ahigh = alow >> (4 * sizeof (UV));
	    alow &= botmask;
	    bhigh = blow >> (4 * sizeof (UV));
	    blow &= botmask;
	    if (ahigh && bhigh) {
		/* eg 32 bit is at least 0x10000 * 0x10000 == 0x100000000
		   which is overflow. Drop to NVs below.  */
	    } else if (!ahigh && !bhigh) {
		/* eg 32 bit is at most 0xFFFF * 0xFFFF == 0xFFFE0001
		   so the unsigned multiply cannot overflow.  */
		UV product = alow * blow;
		if (auvok == buvok) {
		    /* -ve * -ve or +ve * +ve gives a +ve result.  */
		    SP--;
		    SETu( product );
		    RETURN;
		} else if (product <= (UV)IV_MIN) {
		    /* 2s complement assumption that (UV)-IV_MIN is correct.  */
		    /* -ve result, which could overflow an IV  */
		    SP--;
		    SETi( -product );
		    RETURN;
		} /* else drop to NVs below. */
	    } else {
		/* One operand is large, 1 small */
		UV product_middle;
		if (bhigh) {
		    /* swap the operands */
		    ahigh = bhigh;
		    bhigh = blow; /* bhigh now the temp var for the swap */
		    blow = alow;
		    alow = bhigh;
		}
		/* now, ((ahigh * blow) << half_UV_len) + (alow * blow)
		   multiplies can't overflow. shift can, add can, -ve can.  */
		product_middle = ahigh * blow;
		if (!(product_middle & topmask)) {
		    /* OK, (ahigh * blow) won't lose bits when we shift it.  */
		    UV product_low;
		    product_middle <<= (4 * sizeof (UV));
		    product_low = alow * blow;

		    /* as for pp_add, UV + something mustn't get smaller.
		       IIRC ANSI mandates this wrapping *behaviour* for
		       unsigned whatever the actual representation*/
		    product_low += product_middle;
		    if (product_low >= product_middle) {
			/* didn't overflow */
			if (auvok == buvok) {
			    /* -ve * -ve or +ve * +ve gives a +ve result.  */
			    SP--;
			    SETu( product_low );
			    RETURN;
			} else if (product_low <= (UV)IV_MIN) {
			    /* 2s complement assumption again  */
			    /* -ve result, which could overflow an IV  */
			    SP--;
			    SETi( -product_low );
			    RETURN;
			} /* else drop to NVs below. */
		    }
		} /* product_middle too large */
	    } /* ahigh && bhigh */
	} /* SvIOK(TOPm1s) */
    } /* SvIOK(TOPs) */
#endif
    {
      dPOPTOPnnrl;
      SETn( left * right );
      RETURN;
    }
}

PP(pp_divide)
{
    dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
    {
      dPOPPOPnnrl;
      NV value;
      if (right == 0.0)
	DIE(aTHX_ "Illegal division by zero");
#ifdef SLOPPYDIVIDE
      /* insure that 20./5. == 4. */
      {
	IV k;
	if ((NV)I_V(left)  == left &&
	    (NV)I_V(right) == right &&
	    (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
	    value = k;
	}
	else {
	    value = left / right;
	}
      }
#else
      value = left / right;
#endif
      PUSHn( value );
      RETURN;
    }
}

PP(pp_modulo)
{
    dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
    {
	UV left;
	UV right;
	bool left_neg;
	bool right_neg;
	bool use_double = 0;
	NV dright;
	NV dleft;

	if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
	    IV i = SvIVX(POPs);
	    right = (right_neg = (i < 0)) ? -i : i;
	}
	else {
	    dright = POPn;
	    use_double = 1;
	    right_neg = dright < 0;
	    if (right_neg)
		dright = -dright;
	}

	if (!use_double && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
	    IV i = SvIVX(POPs);
	    left = (left_neg = (i < 0)) ? -i : i;
	}
	else {
	    dleft = POPn;
	    if (!use_double) {
		use_double = 1;
		dright = right;
	    }
	    left_neg = dleft < 0;
	    if (left_neg)
		dleft = -dleft;
	}

	if (use_double) {
	    NV dans;

#if 1
/* Somehow U_V is pessimized even if CASTFLAGS is 0 */
#  if CASTFLAGS & 2
#    define CAST_D2UV(d) U_V(d)
#  else
#    define CAST_D2UV(d) ((UV)(d))
#  endif
	    /* Tried to do this only in the case DOUBLESIZE <= UV_SIZE,
	     * or, in other words, precision of UV more than of NV.
	     * But in fact the approach below turned out to be an
	     * optimization - floor() may be slow */
	    if (dright <= UV_MAX && dleft <= UV_MAX) {
		right = CAST_D2UV(dright);
		left  = CAST_D2UV(dleft);
		goto do_uv;
	    }
#endif

	    /* Backward-compatibility clause: */
	    dright = Perl_floor(dright + 0.5);
	    dleft  = Perl_floor(dleft + 0.5);

	    if (!dright)
		DIE(aTHX_ "Illegal modulus zero");

	    dans = Perl_fmod(dleft, dright);
	    if ((left_neg != right_neg) && dans)
		dans = dright - dans;
	    if (right_neg)
		dans = -dans;
	    sv_setnv(TARG, dans);
	}
	else {
	    UV ans;

	do_uv:
	    if (!right)
		DIE(aTHX_ "Illegal modulus zero");

	    ans = left % right;
	    if ((left_neg != right_neg) && ans)
		ans = right - ans;
	    if (right_neg) {
		/* XXX may warn: unary minus operator applied to unsigned type */
		/* could change -foo to be (~foo)+1 instead	*/
		if (ans <= ~((UV)IV_MAX)+1)
		    sv_setiv(TARG, ~ans+1);
		else
		    sv_setnv(TARG, -(NV)ans);
	    }
	    else
		sv_setuv(TARG, ans);
	}
	PUSHTARG;
	RETURN;
    }
}

PP(pp_repeat)
{
  dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
  {
    register IV count = POPi;
    if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
	dMARK;
	I32 items = SP - MARK;
	I32 max;

	max = items * count;
	MEXTEND(MARK, max);
	if (count > 1) {
	    while (SP > MARK) {
		if (*SP)
		    SvTEMP_off((*SP));
		SP--;
	    }
	    MARK++;
	    repeatcpy((char*)(MARK + items), (char*)MARK,
		items * sizeof(SV*), count - 1);
	    SP += max;
	}
	else if (count <= 0)
	    SP -= items;
    }
    else {	/* Note: mark already snarfed by pp_list */
	SV *tmpstr = POPs;
	STRLEN len;
	bool isutf;

	SvSetSV(TARG, tmpstr);
	SvPV_force(TARG, len);
	isutf = DO_UTF8(TARG);
	if (count != 1) {
	    if (count < 1)
		SvCUR_set(TARG, 0);
	    else {
		SvGROW(TARG, (count * len) + 1);
		repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
		SvCUR(TARG) *= count;
	    }
	    *SvEND(TARG) = '\0';
	}
	if (isutf)
	    (void)SvPOK_only_UTF8(TARG);
	else
	    (void)SvPOK_only(TARG);

	if (PL_op->op_private & OPpREPEAT_DOLIST) {
	    /* The parser saw this as a list repeat, and there
	       are probably several items on the stack. But we're
	       in scalar context, and there's no pp_list to save us
	       now. So drop the rest of the items -- robin@kitsite.com
	     */
	    dMARK;
	    SP = MARK;
	}
	PUSHTARG;
    }
    RETURN;
  }
}

PP(pp_subtract)
{
    dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
    useleft = USE_LEFT(TOPm1s);
#ifdef PERL_PRESERVE_IVUV
    /* See comments in pp_add (in pp_hot.c) about Overflow, and how
       "bad things" happen if you rely on signed integers wrapping.  */
    SvIV_please(TOPs);
    if (SvIOK(TOPs)) {
	/* Unless the left argument is integer in range we are going to have to
	   use NV maths. Hence only attempt to coerce the right argument if
	   we know the left is integer.  */
	register UV auv;
	bool auvok;
	bool a_valid = 0;

	if (!useleft) {
	    auv = 0;
	    a_valid = auvok = 1;
	    /* left operand is undef, treat as zero.  */
	} else {
	    /* Left operand is defined, so is it IV? */
	    SvIV_please(TOPm1s);
	    if (SvIOK(TOPm1s)) {
		if ((auvok = SvUOK(TOPm1s)))
		    auv = SvUVX(TOPm1s);
		else {
		    register IV aiv = SvIVX(TOPm1s);
		    if (aiv >= 0) {
			auv = aiv;
			auvok = 1;	/* Now acting as a sign flag.  */
		    } else { /* 2s complement assumption for IV_MIN */
			auv = (UV)-aiv;
		    }
		}
		a_valid = 1;
	    }
	}
	if (a_valid) {
	    bool result_good = 0;
	    UV result;
	    register UV buv;
	    bool buvok = SvUOK(TOPs);
	
	    if (buvok)
		buv = SvUVX(TOPs);
	    else {
		register IV biv = SvIVX(TOPs);
		if (biv >= 0) {
		    buv = biv;
		    buvok = 1;
		} else
		    buv = (UV)-biv;
	    }
	    /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
	       else "IV" now, independant of how it came in.
	       if a, b represents positive, A, B negative, a maps to -A etc
	       a - b =>  (a - b)
	       A - b => -(a + b)
	       a - B =>  (a + b)
	       A - B => -(a - b)
	       all UV maths. negate result if A negative.
	       subtract if signs same, add if signs differ. */

	    if (auvok ^ buvok) {
		/* Signs differ.  */
		result = auv + buv;
		if (result >= auv)
		    result_good = 1;
	    } else {
		/* Signs same */
		if (auv >= buv) {
		    result = auv - buv;
		    /* Must get smaller */
		    if (result <= auv)
			result_good = 1;
		} else {
		    result = buv - auv;
		    if (result <= buv) {
			/* result really should be -(auv-buv). as its negation
			   of true value, need to swap our result flag  */
			auvok = !auvok;
			result_good = 1;
		    }
		}
	    }
	    if (result_good) {
		SP--;
		if (auvok)
		    SETu( result );
		else {
		    /* Negate result */
		    if (result <= (UV)IV_MIN)
			SETi( -(IV)result );
		    else {
			/* result valid, but out of range for IV.  */
			SETn( -(NV)result );
		    }
		}
		RETURN;
	    } /* Overflow, drop through to NVs.  */
	}
    }
#endif
    useleft = USE_LEFT(TOPm1s);
    {
	dPOPnv;
	if (!useleft) {
	    /* left operand is undef, treat as zero - value */
	    SETn(-value);
	    RETURN;
	}
	SETn( TOPn - value );
	RETURN;
    }
}

PP(pp_left_shift)
{
    dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
    {
      IV shift = POPi;
      if (PL_op->op_private & HINT_INTEGER) {
	IV i = TOPi;
	SETi(i << shift);
      }
      else {
	UV u = TOPu;
	SETu(u << shift);
      }
      RETURN;
    }
}

PP(pp_right_shift)
{
    dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
    {
      IV shift = POPi;
      if (PL_op->op_private & HINT_INTEGER) {
	IV i = TOPi;
	SETi(i >> shift);
      }
      else {
	UV u = TOPu;
	SETu(u >> shift);
      }
      RETURN;
    }
}

PP(pp_lt)
{
    dSP; tryAMAGICbinSET(lt,0);
#ifdef PERL_PRESERVE_IVUV
    SvIV_please(TOPs);
    if (SvIOK(TOPs)) {
	SvIV_please(TOPm1s);
	if (SvIOK(TOPm1s)) {
	    bool auvok = SvUOK(TOPm1s);
	    bool buvok = SvUOK(TOPs);
	
	    if (!auvok && !buvok) { /* ## IV < IV ## */
		IV aiv = SvIVX(TOPm1s);
		IV biv = SvIVX(TOPs);
		
		SP--;
		SETs(boolSV(aiv < biv));
		RETURN;
	    }
	    if (auvok && buvok) { /* ## UV < UV ## */
		UV auv = SvUVX(TOPm1s);
		UV buv = SvUVX(TOPs);
		
		SP--;
		SETs(boolSV(auv < buv));
		RETURN;
	    }
	    if (auvok) { /* ## UV < IV ## */
		UV auv;
		IV biv;
		
		biv = SvIVX(TOPs);
		SP--;
		if (biv < 0) {
		    /* As (a) is a UV, it's >=0, so it cannot be < */
		    SETs(&PL_sv_no);
		    RETURN;
		}
		auv = SvUVX(TOPs);
		if (auv >= (UV) IV_MAX) {
		    /* As (b) is an IV, it cannot be > IV_MAX */
		    SETs(&PL_sv_no);
		    RETURN;
		}
		SETs(boolSV(auv < (UV)biv));
		RETURN;
	    }
	    { /* ## IV < UV ## */
		IV aiv;
		UV buv;
		
		aiv = SvIVX(TOPm1s);
		if (aiv < 0) {
		    /* As (b) is a UV, it's >=0, so it must be < */
		    SP--;
		    SETs(&PL_sv_yes);
		    RETURN;
		}
		buv = SvUVX(TOPs);
		SP--;
		if (buv > (UV) IV_MAX) {
		    /* As (a) is an IV, it cannot be > IV_MAX */
		    SETs(&PL_sv_yes);
		    RETURN;
		}
		SETs(boolSV((UV)aiv < buv));
		RETURN;
	    }
	}
    }
#endif
    {
      dPOPnv;
      SETs(boolSV(TOPn < value));
      RETURN;
    }
}

PP(pp_gt)
{
    dSP; tryAMAGICbinSET(gt,0);
#ifdef PERL_PRESERVE_IVUV
    SvIV_please(TOPs);
    if (SvIOK(TOPs)) {
	SvIV_please(TOPm1s);
	if (SvIOK(TOPm1s)) {
	    bool auvok = SvUOK(TOPm1s);
	    bool buvok = SvUOK(TOPs);
	
	    if (!auvok && !buvok) { /* ## IV > IV ## */
		IV aiv = SvIVX(TOPm1s);
		IV biv = SvIVX(TOPs);
		
		SP--;
		SETs(boolSV(aiv > biv));
		RETURN;
	    }
	    if (auvok && buvok) { /* ## UV > UV ## */
		UV auv = SvUVX(TOPm1s);
		UV buv = SvUVX(TOPs);
		
		SP--;
		SETs(boolSV(auv > buv));
		RETURN;
	    }
	    if (auvok) { /* ## UV > IV ## */
		UV auv;
		IV biv;
		
		biv = SvIVX(TOPs);
		SP--;
		if (biv < 0) {
		    /* As (a) is a UV, it's >=0, so it must be > */
		    SETs(&PL_sv_yes);
		    RETURN;
		}
		auv = SvUVX(TOPs);
		if (auv > (UV) IV_MAX) {
		    /* As (b) is an IV, it cannot be > IV_MAX */
		    SETs(&PL_sv_yes);
		    RETURN;
		}
		SETs(boolSV(auv > (UV)biv));
		RETURN;
	    }
	    { /* ## IV > UV ## */
		IV aiv;
		UV buv;
		
		aiv = SvIVX(TOPm1s);
		if (aiv < 0) {
		    /* As (b) is a UV, it's >=0, so it cannot be > */
		    SP--;
		    SETs(&PL_sv_no);
		    RETURN;
		}
		buv = SvUVX(TOPs);
		SP--;
		if (buv >= (UV) IV_MAX) {
		    /* As (a) is an IV, it cannot be > IV_MAX */
		    SETs(&PL_sv_no);
		    RETURN;
		}
		SETs(boolSV((UV)aiv > buv));
		RETURN;
	    }
	}
    }
#endif
    {
      dPOPnv;
      SETs(boolSV(TOPn > value));
      RETURN;
    }
}

PP(pp_le)
{
    dSP; tryAMAGICbinSET(le,0);
#ifdef PERL_PRESERVE_IVUV
    SvIV_please(TOPs);
    if (SvIOK(TOPs)) {
	SvIV_please(TOPm1s);
	if (SvIOK(TOPm1s)) {
	    bool auvok = SvUOK(TOPm1s);
	    bool buvok = SvUOK(TOPs);
	
	    if (!auvok && !buvok) { /* ## IV <= IV ## */
		IV aiv = SvIVX(TOPm1s);
		IV biv = SvIVX(TOPs);
		
		SP--;
		SETs(boolSV(aiv <= biv));
		RETURN;
	    }
	    if (auvok && buvok) { /* ## UV <= UV ## */
		UV auv = SvUVX(TOPm1s);
		UV buv = SvUVX(TOPs);
		
		SP--;
		SETs(boolSV(auv <= buv));
		RETURN;
	    }
	    if (auvok) { /* ## UV <= IV ## */
		UV auv;
		IV biv;
		
		biv = SvIVX(TOPs);
		SP--;
		if (biv < 0) {
		    /* As (a) is a UV, it's >=0, so a cannot be <= */
		    SETs(&PL_sv_no);
		    RETURN;
		}
		auv = SvUVX(TOPs);
		if (auv > (UV) IV_MAX) {
		    /* As (b) is an IV, it cannot be > IV_MAX */
		    SETs(&PL_sv_no);
		    RETURN;
		}
		SETs(boolSV(auv <= (UV)biv));
		RETURN;
	    }
	    { /* ## IV <= UV ## */
		IV aiv;
		UV buv;
		
		aiv = SvIVX(TOPm1s);
		if (aiv < 0) {
		    /* As (b) is a UV, it's >=0, so a must be <= */
		    SP--;
		    SETs(&PL_sv_yes);
		    RETURN;
		}
		buv = SvUVX(TOPs);
		SP--;
		if (buv >= (UV) IV_MAX) {
		    /* As (a) is an IV, it cannot be > IV_MAX */
		    SETs(&PL_sv_yes);
		    RETURN;
		}
		SETs(boolSV((UV)aiv <= buv));
		RETURN;
	    }
	}
    }
#endif
    {
      dPOPnv;
      SETs(boolSV(TOPn <= value));
      RETURN;
    }
}

PP(pp_ge)
{
    dSP; tryAMAGICbinSET(ge,0);
#ifdef PERL_PRESERVE_IVUV
    SvIV_please(TOPs);
    if (SvIOK(TOPs)) {
	SvIV_please(TOPm1s);
	if (SvIOK(TOPm1s)) {
	    bool auvok = SvUOK(TOPm1s);
	    bool buvok = SvUOK(TOPs);
	
	    if (!auvok && !buvok) { /* ## IV >= IV ## */
		IV aiv = SvIVX(TOPm1s);
		IV biv = SvIVX(TOPs);
		
		SP--;
		SETs(boolSV(aiv >= biv));
		RETURN;
	    }
	    if (auvok && buvok) { /* ## UV >= UV ## */
		UV auv = SvUVX(TOPm1s);
		UV buv = SvUVX(TOPs);
		
		SP--;
		SETs(boolSV(auv >= buv));
		RETURN;
	    }
	    if (auvok) { /* ## UV >= IV ## */
		UV auv;
		IV biv;
		
		biv = SvIVX(TOPs);
		SP--;
		if (biv < 0) {
		    /* As (a) is a UV, it's >=0, so it must be >= */
		    SETs(&PL_sv_yes);
		    RETURN;
		}
		auv = SvUVX(TOPs);
		if (auv >= (UV) IV_MAX) {
		    /* As (b) is an IV, it cannot be > IV_MAX */
		    SETs(&PL_sv_yes);
		    RETURN;
		}
		SETs(boolSV(auv >= (UV)biv));
		RETURN;
	    }
	    { /* ## IV >= UV ## */
		IV aiv;
		UV buv;
		
		aiv = SvIVX(TOPm1s);
		if (aiv < 0) {
		    /* As (b) is a UV, it's >=0, so a cannot be >= */
		    SP--;
		    SETs(&PL_sv_no);
		    RETURN;
		}
		buv = SvUVX(TOPs);
		SP--;
		if (buv > (UV) IV_MAX) {
		    /* As (a) is an IV, it cannot be > IV_MAX */
		    SETs(&PL_sv_no);
		    RETURN;
		}
		SETs(boolSV((UV)aiv >= buv));
		RETURN;
	    }
	}
    }
#endif
    {
      dPOPnv;
      SETs(boolSV(TOPn >= value));
      RETURN;
    }
}

PP(pp_ne)
{
    dSP; tryAMAGICbinSET(ne,0);
#ifndef NV_PRESERVES_UV
    if (SvROK(TOPs) && SvROK(TOPm1s)) {
	SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s)));
	RETURN;
    }
#endif
#ifdef PERL_PRESERVE_IVUV
    SvIV_please(TOPs);
    if (SvIOK(TOPs)) {
	SvIV_please(TOPm1s);
	if (SvIOK(TOPm1s)) {
	    bool auvok = SvUOK(TOPm1s);
	    bool buvok = SvUOK(TOPs);
	
	    if (!auvok && !buvok) { /* ## IV <=> IV ## */
		IV aiv = SvIVX(TOPm1s);
		IV biv = SvIVX(TOPs);
		
		SP--;
		SETs(boolSV(aiv != biv));
		RETURN;
	    }
	    if (auvok && buvok) { /* ## UV != UV ## */
		UV auv = SvUVX(TOPm1s);
		UV buv = SvUVX(TOPs);
		
		SP--;
		SETs(boolSV(auv != buv));
		RETURN;
	    }
	    {			/* ## Mixed IV,UV ## */
		IV iv;
		UV uv;
		
		/* != is commutative so swap if needed (save code) */
		if (auvok) {
		    /* swap. top of stack (b) is the iv */
		    iv = SvIVX(TOPs);
		    SP--;
		    if (iv < 0) {
			/* As (a) is a UV, it's >0, so it cannot be == */
			SETs(&PL_sv_yes);
			RETURN;
		    }
		    uv = SvUVX(TOPs);
		} else {
		    iv = SvIVX(TOPm1s);
		    SP--;
		    if (iv < 0) {
			/* As (b) is a UV, it's >0, so it cannot be == */
			SETs(&PL_sv_yes);
			RETURN;
		    }
		    uv = SvUVX(*(SP+1)); /* Do I want TOPp1s() ? */
		}
		/* we know iv is >= 0 */
		if (uv > (UV) IV_MAX) {
		    SETs(&PL_sv_yes);
		    RETURN;
		}
		SETs(boolSV((UV)iv != uv));
		RETURN;
	    }
	}
    }
#endif
    {
      dPOPnv;
      SETs(boolSV(TOPn != value));
      RETURN;
    }
}

PP(pp_ncmp)
{
    dSP; dTARGET; tryAMAGICbin(ncmp,0);
#ifndef NV_PRESERVES_UV
    if (SvROK(TOPs) && SvROK(TOPm1s)) {
	SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
	RETURN;
    }
#endif
#ifdef PERL_PRESERVE_IVUV
    /* Fortunately it seems NaN isn't IOK */
    SvIV_please(TOPs);
    if (SvIOK(TOPs)) {
	SvIV_please(TOPm1s);
	if (SvIOK(TOPm1s)) {
	    bool leftuvok = SvUOK(TOPm1s);
	    bool rightuvok = SvUOK(TOPs);
	    I32 value;
	    if (!leftuvok && !rightuvok) { /* ## IV <=> IV ## */
		IV leftiv = SvIVX(TOPm1s);
		IV rightiv = SvIVX(TOPs);
		
		if (leftiv > rightiv)
		    value = 1;
		else if (leftiv < rightiv)
		    value = -1;
		else
		    value = 0;
	    } else if (leftuvok && rightuvok) { /* ## UV <=> UV ## */
		UV leftuv = SvUVX(TOPm1s);
		UV rightuv = SvUVX(TOPs);
		
		if (leftuv > rightuv)
		    value = 1;
		else if (leftuv < rightuv)
		    value = -1;
		else
		    value = 0;
	    } else if (leftuvok) { /* ## UV <=> IV ## */
		UV leftuv;
		IV rightiv;
		
		rightiv = SvIVX(TOPs);
		if (rightiv < 0) {
		    /* As (a) is a UV, it's >=0, so it cannot be < */
		    value = 1;
		} else {
		    leftuv = SvUVX(TOPm1s);
		    if (leftuv > (UV) IV_MAX) {
			/* As (b) is an IV, it cannot be > IV_MAX */
			value = 1;
		    } else if (leftuv > (UV)rightiv) {
			value = 1;
		    } else if (leftuv < (UV)rightiv) {
			value = -1;
		    } else {
			value = 0;
		    }
		}
	    } else { /* ## IV <=> UV ## */
		IV leftiv;
		UV rightuv;
		
		leftiv = SvIVX(TOPm1s);
		if (leftiv < 0) {
		    /* As (b) is a UV, it's >=0, so it must be < */
		    value = -1;
		} else {
		    rightuv = SvUVX(TOPs);
		    if (rightuv > (UV) IV_MAX) {
			/* As (a) is an IV, it cannot be > IV_MAX */
			value = -1;
		    } else if (leftiv > (UV)rightuv) {
			value = 1;
		    } else if (leftiv < (UV)rightuv) {
			value = -1;
		    } else {
			value = 0;
		    }
		}
	    }
	    SP--;
	    SETi(value);
	    RETURN;
	}
    }
#endif
    {
      dPOPTOPnnrl;
      I32 value;

#ifdef Perl_isnan
      if (Perl_isnan(left) || Perl_isnan(right)) {
	  SETs(&PL_sv_undef);
	  RETURN;
       }
      value = (left > right) - (left < right);
#else
      if (left == right)
	value = 0;
      else if (left < right)
	value = -1;
      else if (left > right)
	value = 1;
      else {
	SETs(&PL_sv_undef);
	RETURN;
      }
#endif
      SETi(value);
      RETURN;
    }
}

PP(pp_slt)
{
    dSP; tryAMAGICbinSET(slt,0);
    {
      dPOPTOPssrl;
      int cmp = ((PL_op->op_private & OPpLOCALE)
		 ? sv_cmp_locale(left, right)
		 : sv_cmp(left, right));
      SETs(boolSV(cmp < 0));
      RETURN;
    }
}

PP(pp_sgt)
{
    dSP; tryAMAGICbinSET(sgt,0);
    {
      dPOPTOPssrl;
      int cmp = ((PL_op->op_private & OPpLOCALE)
		 ? sv_cmp_locale(left, right)
		 : sv_cmp(left, right));
      SETs(boolSV(cmp > 0));
      RETURN;
    }
}

PP(pp_sle)
{
    dSP; tryAMAGICbinSET(sle,0);
    {
      dPOPTOPssrl;
      int cmp = ((PL_op->op_private & OPpLOCALE)
		 ? sv_cmp_locale(left, right)
		 : sv_cmp(left, right));
      SETs(boolSV(cmp <= 0));
      RETURN;
    }
}

PP(pp_sge)
{
    dSP; tryAMAGICbinSET(sge,0);
    {
      dPOPTOPssrl;
      int cmp = ((PL_op->op_private & OPpLOCALE)
		 ? sv_cmp_locale(left, right)
		 : sv_cmp(left, right));
      SETs(boolSV(cmp >= 0));
      RETURN;
    }
}

PP(pp_seq)
{
    dSP; tryAMAGICbinSET(seq,0);
    {
      dPOPTOPssrl;
      SETs(boolSV(sv_eq(left, right)));
      RETURN;
    }
}

PP(pp_sne)
{
    dSP; tryAMAGICbinSET(sne,0);
    {
      dPOPTOPssrl;
      SETs(boolSV(!sv_eq(left, right)));
      RETURN;
    }
}

PP(pp_scmp)
{
    dSP; dTARGET;  tryAMAGICbin(scmp,0);
    {
      dPOPTOPssrl;
      int cmp = ((PL_op->op_private & OPpLOCALE)
		 ? sv_cmp_locale(left, right)
		 : sv_cmp(left, right));
      SETi( cmp );
      RETURN;
    }
}

PP(pp_bit_and)
{
    dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
    {
      dPOPTOPssrl;
      if (SvNIOKp(left) || SvNIOKp(right)) {
	if (PL_op->op_private & HINT_INTEGER) {
	  IV i = SvIV(left) & SvIV(right);
	  SETi(i);
	}
	else {
	  UV u = SvUV(left) & SvUV(right);
	  SETu(u);
	}
      }
      else {
	do_vop(PL_op->op_type, TARG, left, right);
	SETTARG;
      }
      RETURN;
    }
}

PP(pp_bit_xor)
{
    dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
    {
      dPOPTOPssrl;
      if (SvNIOKp(left) || SvNIOKp(right)) {
	if (PL_op->op_private & HINT_INTEGER) {
	  IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
	  SETi(i);
	}
	else {
	  UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
	  SETu(u);
	}
      }
      else {
	do_vop(PL_op->op_type, TARG, left, right);
	SETTARG;
      }
      RETURN;
    }
}

PP(pp_bit_or)
{
    dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
    {
      dPOPTOPssrl;
      if (SvNIOKp(left) || SvNIOKp(right)) {
	if (PL_op->op_private & HINT_INTEGER) {
	  IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
	  SETi(i);
	}
	else {
	  UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
	  SETu(u);
	}
      }
      else {
	do_vop(PL_op->op_type, TARG, left, right);
	SETTARG;
      }
      RETURN;
    }
}

PP(pp_negate)
{
    dSP; dTARGET; tryAMAGICun(neg);
    {
	dTOPss;
	int flags = SvFLAGS(sv);
	if (SvGMAGICAL(sv))
	    mg_get(sv);
	if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
	    /* It's publicly an integer, or privately an integer-not-float */
	oops_its_an_int:
	    if (SvIsUV(sv)) {
		if (SvIVX(sv) == IV_MIN) {
		    /* 2s complement assumption. */
		    SETi(SvIVX(sv));	/* special case: -((UV)IV_MAX+1) == IV_MIN */
		    RETURN;
		}
		else if (SvUVX(sv) <= IV_MAX) {
		    SETi(-SvIVX(sv));
		    RETURN;
		}
	    }
	    else if (SvIVX(sv) != IV_MIN) {
		SETi(-SvIVX(sv));
		RETURN;
	    }
#ifdef PERL_PRESERVE_IVUV
	    else {
		SETu((UV)IV_MIN);
		RETURN;
	    }
#endif
	}
	if (SvNIOKp(sv))
	    SETn(-SvNV(sv));
	else if (SvPOKp(sv)) {
	    STRLEN len;
	    char *s = SvPV(sv, len);
	    if (isIDFIRST(*s)) {
		sv_setpvn(TARG, "-", 1);
		sv_catsv(TARG, sv);
	    }
	    else if (*s == '+' || *s == '-') {
		sv_setsv(TARG, sv);
		*SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
	    }
	    else if (DO_UTF8(sv) && UTF8_IS_START(*s) && isIDFIRST_utf8((U8*)s)) {
		sv_setpvn(TARG, "-", 1);
		sv_catsv(TARG, sv);
	    }
	    else {
	      SvIV_please(sv);
	      if (SvIOK(sv))
		goto oops_its_an_int;
	      sv_setnv(TARG, -SvNV(sv));
	    }
	    SETTARG;
	}
	else
	    SETn(-SvNV(sv));
    }
    RETURN;
}

PP(pp_not)
{
    dSP; tryAMAGICunSET(not);
    *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
    return NORMAL;
}

PP(pp_complement)
{
    dSP; dTARGET; tryAMAGICun(compl);
    {
      dTOPss;
      if (SvNIOKp(sv)) {
	if (PL_op->op_private & HINT_INTEGER) {
	  IV i = ~SvIV(sv);
	  SETi(i);
	}
	else {
	  UV u = ~SvUV(sv);
	  SETu(u);
	}
      }
      else {
	register U8 *tmps;
	register I32 anum;
	STRLEN len;

	SvSetSV(TARG, sv);
	tmps = (U8*)SvPV_force(TARG, len);
	anum = len;
	if (SvUTF8(TARG)) {
	  /* Calculate exact length, let's not estimate. */
	  STRLEN targlen = 0;
	  U8 *result;
	  U8 *send;
	  STRLEN l;
	  UV nchar = 0;
	  UV nwide = 0;

	  send = tmps + len;
	  while (tmps < send) {
	    UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
	    tmps += UTF8SKIP(tmps);
	    targlen += UNISKIP(~c);
	    nchar++;
	    if (c > 0xff)
		nwide++;
	  }

	  /* Now rewind strings and write them. */
	  tmps -= len;

	  if (nwide) {
	      Newz(0, result, targlen + 1, U8);
	      while (tmps < send) {
		  UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
		  tmps += UTF8SKIP(tmps);
		  result = uvchr_to_utf8(result, ~c);
	      }
	      *result = '\0';
	      result -= targlen;
	      sv_setpvn(TARG, (char*)result, targlen);
	      SvUTF8_on(TARG);
	  }
	  else {
	      Newz(0, result, nchar + 1, U8);
	      while (tmps < send) {
		  U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY);
		  tmps += UTF8SKIP(tmps);
		  *result++ = ~c;
	      }
	      *result = '\0';
	      result -= nchar;
	      sv_setpvn(TARG, (char*)result, nchar);
	  }
	  Safefree(result);
	  SETs(TARG);
	  RETURN;
	}
#ifdef LIBERAL
	{
	    register long *tmpl;
	    for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
		*tmps = ~*tmps;
	    tmpl = (long*)tmps;
	    for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
		*tmpl = ~*tmpl;
	    tmps = (U8*)tmpl;
	}
#endif
	for ( ; anum > 0; anum--, tmps++)
	    *tmps = ~*tmps;

	SETs(TARG);
      }
      RETURN;
    }
}

/* integer versions of some of the above */

PP(pp_i_multiply)
{
    dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
    {
      dPOPTOPiirl;
      SETi( left * right );
      RETURN;
    }
}

PP(pp_i_divide)
{
    dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
    {
      dPOPiv;
      if (value == 0)
	DIE(aTHX_ "Illegal division by zero");
      value = POPi / value;
      PUSHi( value );
      RETURN;
    }
}

PP(pp_i_modulo)
{
    dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
    {
      dPOPTOPiirl;
      if (!right)
	DIE(aTHX_ "Illegal modulus zero");
      SETi( left % right );
      RETURN;
    }
}

PP(pp_i_add)
{
    dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
    {
      dPOPTOPiirl_ul;
      SETi( left + right );
      RETURN;
    }
}

PP(pp_i_subtract)
{
    dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
    {
      dPOPTOPiirl_ul;
      SETi( left - right );
      RETURN;
    }
}

PP(pp_i_lt)
{
    dSP; tryAMAGICbinSET(lt,0);
    {
      dPOPTOPiirl;
      SETs(boolSV(left < right));
      RETURN;
    }
}

PP(pp_i_gt)
{
    dSP; tryAMAGICbinSET(gt,0);
    {
      dPOPTOPiirl;
      SETs(boolSV(left > right));
      RETURN;
    }
}

PP(pp_i_le)
{
    dSP; tryAMAGICbinSET(le,0);
    {
      dPOPTOPiirl;
      SETs(boolSV(left <= right));
      RETURN;
    }
}

PP(pp_i_ge)
{
    dSP; tryAMAGICbinSET(ge,0);
    {
      dPOPTOPiirl;
      SETs(boolSV(left >= right));
      RETURN;
    }
}

PP(pp_i_eq)
{
    dSP; tryAMAGICbinSET(eq,0);
    {
      dPOPTOPiirl;
      SETs(boolSV(left == right));
      RETURN;
    }
}

PP(pp_i_ne)
{
    dSP; tryAMAGICbinSET(ne,0);
    {
      dPOPTOPiirl;
      SETs(boolSV(left != right));
      RETURN;
    }
}

PP(pp_i_ncmp)
{
    dSP; dTARGET; tryAMAGICbin(ncmp,0);
    {
      dPOPTOPiirl;
      I32 value;

      if (left > right)
	value = 1;
      else if (left < right)
	value = -1;
      else
	value = 0;
      SETi(value);
      RETURN;
    }
}

PP(pp_i_negate)
{
    dSP; dTARGET; tryAMAGICun(neg);
    SETi(-TOPi);
    RETURN;
}

/* High falutin' math. */

PP(pp_atan2)
{
    dSP; dTARGET; tryAMAGICbin(atan2,0);
    {
      dPOPTOPnnrl;
      SETn(Perl_atan2(left, right));
      RETURN;
    }
}

PP(pp_sin)
{
    dSP; dTARGET; tryAMAGICun(sin);
    {
      NV value;
      value = POPn;
      value = Perl_sin(value);
      XPUSHn(value);
      RETURN;
    }
}

PP(pp_cos)
{
    dSP; dTARGET; tryAMAGICun(cos);
    {
      NV value;
      value = POPn;
      value = Perl_cos(value);
      XPUSHn(value);
      RETURN;
    }
}

/* Support Configure command-line overrides for rand() functions.
   After 5.005, perhaps we should replace this by Configure support
   for drand48(), random(), or rand().  For 5.005, though, maintain
   compatibility by calling rand() but allow the user to override it.
   See INSTALL for details.  --Andy Dougherty  15 July 1998
*/
/* Now it's after 5.005, and Configure supports drand48() and random(),
   in addition to rand().  So the overrides should not be needed any more.
   --Jarkko Hietaniemi	27 September 1998
 */

#ifndef HAS_DRAND48_PROTO
extern double drand48 (void);
#endif

PP(pp_rand)
{
    dSP; dTARGET;
    NV value;
    if (MAXARG < 1)
	value = 1.0;
    else
	value = POPn;
    if (value == 0.0)
	value = 1.0;
    if (!PL_srand_called) {
	(void)seedDrand01((Rand_seed_t)seed());
	PL_srand_called = TRUE;
    }
    value *= Drand01();
    XPUSHn(value);
    RETURN;
}

PP(pp_srand)
{
    dSP;
    UV anum;
    if (MAXARG < 1)
	anum = seed();
    else
	anum = POPu;
    (void)seedDrand01((Rand_seed_t)anum);
    PL_srand_called = TRUE;
    EXTEND(SP, 1);
    RETPUSHYES;
}

STATIC U32
S_seed(pTHX)
{
    /*
     * This is really just a quick hack which grabs various garbage
     * values.  It really should be a real hash algorithm which
     * spreads the effect of every input bit onto every output bit,
     * if someone who knows about such things would bother to write it.
     * Might be a good idea to add that function to CORE as well.
     * No numbers below come from careful analysis or anything here,
     * except they are primes and SEED_C1 > 1E6 to get a full-width
     * value from (tv_sec * SEED_C1 + tv_usec).  The multipliers should
     * probably be bigger too.
     */
#if RANDBITS > 16
#  define SEED_C1	1000003
#define   SEED_C4	73819
#else
#  define SEED_C1	25747
#define   SEED_C4	20639
#endif
#define   SEED_C2	3
#define   SEED_C3	269
#define   SEED_C5	26107

#ifndef PERL_NO_DEV_RANDOM
    int fd;
#endif
    U32 u;
#ifdef VMS
#  include <starlet.h>
    /* when[] = (low 32 bits, high 32 bits) of time since epoch
     * in 100-ns units, typically incremented ever 10 ms.        */
    unsigned int when[2];
#else
#  ifdef HAS_GETTIMEOFDAY
    struct timeval when;
#  else
    Time_t when;
#  endif
#endif

/* This test is an escape hatch, this symbol isn't set by Configure. */
#ifndef PERL_NO_DEV_RANDOM
#ifndef PERL_RANDOM_DEVICE
   /* /dev/random isn't used by default because reads from it will block
    * if there isn't enough entropy available.  You can compile with
    * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
    * is enough real entropy to fill the seed. */
#  define PERL_RANDOM_DEVICE "/dev/urandom"
#endif
    fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
    if (fd != -1) {
    	if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
	    u = 0;
	PerlLIO_close(fd);
	if (u)
	    return u;
    }
#endif

#ifdef VMS
    _ckvmssts(sys$gettim(when));
    u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
#else
#  ifdef HAS_GETTIMEOFDAY
    gettimeofday(&when,(struct timezone *) 0);
    u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
#  else
    (void)time(&when);
    u = (U32)SEED_C1 * when;
#  endif
#endif
    u += SEED_C3 * (U32)PerlProc_getpid();
    u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
#ifndef PLAN9           /* XXX Plan9 assembler chokes on this; fix needed  */
    u += SEED_C5 * (U32)PTR2UV(&when);
#endif
    return u;
}

PP(pp_exp)
{
    dSP; dTARGET; tryAMAGICun(exp);
    {
      NV value;
      value = POPn;
      value = Perl_exp(value);
      XPUSHn(value);
      RETURN;
    }
}

PP(pp_log)
{
    dSP; dTARGET; tryAMAGICun(log);
    {
      NV value;
      value = POPn;
      if (value <= 0.0) {
	SET_NUMERIC_STANDARD();
	DIE(aTHX_ "Can't take log of %g", value);
      }
      value = Perl_log(value);
      XPUSHn(value);
      RETURN;
    }
}

PP(pp_sqrt)
{
    dSP; dTARGET; tryAMAGICun(sqrt);
    {
      NV value;
      value = POPn;
      if (value < 0.0) {
	SET_NUMERIC_STANDARD();
	DIE(aTHX_ "Can't take sqrt of %g", value);
      }
      value = Perl_sqrt(value);
      XPUSHn(value);
      RETURN;
    }
}

PP(pp_int)
{
    dSP; dTARGET; tryAMAGICun(int);
    {
      NV value;
      IV iv = TOPi; /* attempt to convert to IV if possible. */
      /* XXX it's arguable that compiler casting to IV might be subtly
	 different from modf (for numbers inside (IV_MIN,UV_MAX)) in which
	 else preferring IV has introduced a subtle behaviour change bug. OTOH
	 relying on floating point to be accurate is a bug.  */

      if (SvIOK(TOPs)) {
	if (SvIsUV(TOPs)) {
	    UV uv = TOPu;
	    SETu(uv);
	} else
	    SETi(iv);
      } else {
	  value = TOPn;
	  if (value >= 0.0) {
	      if (value < (NV)UV_MAX + 0.5) {
		  SETu(U_V(value));
	      } else {
#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
		  (void)Perl_modf(value, &value);
#else
		  double tmp = (double)value;
		  (void)Perl_modf(tmp, &tmp);
		  value = (NV)tmp;
#endif
		  SETn(value);
	      }
	  }
	  else {
	      if (value > (NV)IV_MIN - 0.5) {
		  SETi(I_V(value));
	      } else {
#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
		  (void)Perl_modf(-value, &value);
		  value = -value;
#else
		  double tmp = (double)value;
		  (void)Perl_modf(-tmp, &tmp);
		  value = -(NV)tmp;
#endif
		  SETn(value);
	      }
	  }
      }
    }
    RETURN;
}

PP(pp_abs)
{
    dSP; dTARGET; tryAMAGICun(abs);
    {
      /* This will cache the NV value if string isn't actually integer  */
      IV iv = TOPi;

      if (SvIOK(TOPs)) {
	/* IVX is precise  */
	if (SvIsUV(TOPs)) {
	  SETu(TOPu);	/* force it to be numeric only */
	} else {
	  if (iv >= 0) {
	    SETi(iv);
	  } else {
	    if (iv != IV_MIN) {
	      SETi(-iv);
	    } else {
	      /* 2s complement assumption. Also, not really needed as
		 IV_MIN and -IV_MIN should both be %100...00 and NV-able  */
	      SETu(IV_MIN);
	    }
	  }
	}
      } else{
	NV value = TOPn;
	if (value < 0.0)
	  value = -value;
	SETn(value);
      }
    }
    RETURN;
}

PP(pp_hex)
{
    dSP; dTARGET;
    char *tmps;
    STRLEN argtype;
    STRLEN len;

    tmps = (SvPVx(POPs, len));
    argtype = 1;		/* allow underscores */
    XPUSHn(scan_hex(tmps, len, &argtype));
    RETURN;
}

PP(pp_oct)
{
    dSP; dTARGET;
    NV value;
    STRLEN argtype;
    char *tmps;
    STRLEN len;

    tmps = (SvPVx(POPs, len));
    while (*tmps && len && isSPACE(*tmps))
       tmps++, len--;
    if (*tmps == '0')
       tmps++, len--;
    argtype = 1;		/* allow underscores */
    if (*tmps == 'x')
       value = scan_hex(++tmps, --len, &argtype);
    else if (*tmps == 'b')
       value = scan_bin(++tmps, --len, &argtype);
    else
       value = scan_oct(tmps, len, &argtype);
    XPUSHn(value);
    RETURN;
}

/* String stuff. */

PP(pp_length)
{
    dSP; dTARGET;
    SV *sv = TOPs;

    if (DO_UTF8(sv))
	SETi(sv_len_utf8(sv));
    else
	SETi(sv_len(sv));
    RETURN;
}

PP(pp_substr)
{
    dSP; dTARGET;
    SV *sv;
    I32 len;
    STRLEN curlen;
    STRLEN utf8_curlen;
    I32 pos;
    I32 rem;
    I32 fail;
    I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
    char *tmps;
    I32 arybase = PL_curcop->cop_arybase;
    SV *repl_sv = NULL;
    char *repl = 0;
    STRLEN repl_len;
    int num_args = PL_op->op_private & 7;
    bool repl_need_utf8_upgrade = FALSE;
    bool repl_is_utf8 = FALSE;

    SvTAINTED_off(TARG);			/* decontaminate */
    SvUTF8_off(TARG);				/* decontaminate */
    if (num_args > 2) {
	if (num_args > 3) {
	    repl_sv = POPs;
	    repl = SvPV(repl_sv, repl_len);
	    repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
	}
	len = POPi;
    }
    pos = POPi;
    sv = POPs;
    PUTBACK;
    if (repl_sv) {
	if (repl_is_utf8) {
	    if (!DO_UTF8(sv))
		sv_utf8_upgrade(sv);
	}
	else if (DO_UTF8(sv))
	    repl_need_utf8_upgrade = TRUE;
    }
    tmps = SvPV(sv, curlen);
    if (DO_UTF8(sv)) {
        utf8_curlen = sv_len_utf8(sv);
	if (utf8_curlen == curlen)
	    utf8_curlen = 0;
	else
	    curlen = utf8_curlen;
    }
    else
	utf8_curlen = 0;

    if (pos >= arybase) {
	pos -= arybase;
	rem = curlen-pos;
	fail = rem;
	if (num_args > 2) {
	    if (len < 0) {
		rem += len;
		if (rem < 0)
		    rem = 0;
	    }
	    else if (rem > len)
		     rem = len;
	}
    }
    else {
	pos += curlen;
	if (num_args < 3)
	    rem = curlen;
	else if (len >= 0) {
	    rem = pos+len;
	    if (rem > (I32)curlen)
		rem = curlen;
	}
	else {
	    rem = curlen+len;
	    if (rem < pos)
		rem = pos;
	}
	if (pos < 0)
	    pos = 0;
	fail = rem;
	rem -= pos;
    }
    if (fail < 0) {
	if (lvalue || repl)
	    Perl_croak(aTHX_ "substr outside of string");
	if (ckWARN(WARN_SUBSTR))
	    Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
	RETPUSHUNDEF;
    }
    else {
	I32 upos = pos;
	I32 urem = rem;
	if (utf8_curlen)
	    sv_pos_u2b(sv, &pos, &rem);
	tmps += pos;
	sv_setpvn(TARG, tmps, rem);
#ifdef USE_LOCALE_COLLATE
	sv_unmagic(TARG, PERL_MAGIC_collxfrm);
#endif
	if (utf8_curlen)
	    SvUTF8_on(TARG);
	if (repl) {
	    SV* repl_sv_copy = NULL;

	    if (repl_need_utf8_upgrade) {
		repl_sv_copy = newSVsv(repl_sv);
		sv_utf8_upgrade(repl_sv_copy);
		repl = SvPV(repl_sv_copy, repl_len);
		repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
	    }
	    sv_insert(sv, pos, rem, repl, repl_len);
	    if (repl_is_utf8)
		SvUTF8_on(sv);
	    if (repl_sv_copy)
		SvREFCNT_dec(repl_sv_copy);
	}
	else if (lvalue) {		/* it's an lvalue! */
	    if (!SvGMAGICAL(sv)) {
		if (SvROK(sv)) {
		    STRLEN n_a;
		    SvPV_force(sv,n_a);
		    if (ckWARN(WARN_SUBSTR))
			Perl_warner(aTHX_ WARN_SUBSTR,
				"Attempt to use reference as lvalue in substr");
		}
		if (SvOK(sv))		/* is it defined ? */
		    (void)SvPOK_only_UTF8(sv);
		else
		    sv_setpvn(sv,"",0);	/* avoid lexical reincarnation */
	    }

	    if (SvTYPE(TARG) < SVt_PVLV) {
		sv_upgrade(TARG, SVt_PVLV);
		sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
	    }

	    LvTYPE(TARG) = 'x';
	    if (LvTARG(TARG) != sv) {
		if (LvTARG(TARG))
		    SvREFCNT_dec(LvTARG(TARG));
		LvTARG(TARG) = SvREFCNT_inc(sv);
	    }
	    LvTARGOFF(TARG) = upos;
	    LvTARGLEN(TARG) = urem;
	}
    }
    SPAGAIN;
    PUSHs(TARG);		/* avoid SvSETMAGIC here */
    RETURN;
}

PP(pp_vec)
{
    dSP; dTARGET;
    register IV size   = POPi;
    register IV offset = POPi;
    register SV *src = POPs;
    I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;

    SvTAINTED_off(TARG);		/* decontaminate */
    if (lvalue) {			/* it's an lvalue! */
	if (SvTYPE(TARG) < SVt_PVLV) {
	    sv_upgrade(TARG, SVt_PVLV);
	    sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0);
	}
	LvTYPE(TARG) = 'v';
	if (LvTARG(TARG) != src) {
	    if (LvTARG(TARG))
		SvREFCNT_dec(LvTARG(TARG));
	    LvTARG(TARG) = SvREFCNT_inc(src);
	}
	LvTARGOFF(TARG) = offset;
	LvTARGLEN(TARG) = size;
    }

    sv_setuv(TARG, do_vecget(src, offset, size));
    PUSHs(TARG);
    RETURN;
}

PP(pp_index)
{
    dSP; dTARGET;
    SV *big;
    SV *little;
    I32 offset;
    I32 retval;
    char *tmps;
    char *tmps2;
    STRLEN biglen;
    I32 arybase = PL_curcop->cop_arybase;

    if (MAXARG < 3)
	offset = 0;
    else
	offset = POPi - arybase;
    little = POPs;
    big = POPs;
    tmps = SvPV(big, biglen);
    if (offset > 0 && DO_UTF8(big))
	sv_pos_u2b(big, &offset, 0);
    if (offset < 0)
	offset = 0;
    else if (offset > biglen)
	offset = biglen;
    if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
      (unsigned char*)tmps + biglen, little, 0)))
	retval = -1;
    else
	retval = tmps2 - tmps;
    if (retval > 0 && DO_UTF8(big))
	sv_pos_b2u(big, &retval);
    PUSHi(retval + arybase);
    RETURN;
}

PP(pp_rindex)
{
    dSP; dTARGET;
    SV *big;
    SV *little;
    STRLEN blen;
    STRLEN llen;
    I32 offset;
    I32 retval;
    char *tmps;
    char *tmps2;
    I32 arybase = PL_curcop->cop_arybase;

    if (MAXARG >= 3)
	offset = POPi;
    little = POPs;
    big = POPs;
    tmps2 = SvPV(little, llen);
    tmps = SvPV(big, blen);
    if (MAXARG < 3)
	offset = blen;
    else {
	if (offset > 0 && DO_UTF8(big))
	    sv_pos_u2b(big, &offset, 0);
	offset = offset - arybase + llen;
    }
    if (offset < 0)
	offset = 0;
    else if (offset > blen)
	offset = blen;
    if (!(tmps2 = rninstr(tmps,  tmps  + offset,
			  tmps2, tmps2 + llen)))
	retval = -1;
    else
	retval = tmps2 - tmps;
    if (retval > 0 && DO_UTF8(big))
	sv_pos_b2u(big, &retval);
    PUSHi(retval + arybase);
    RETURN;
}

PP(pp_sprintf)
{
    dSP; dMARK; dORIGMARK; dTARGET;
    do_sprintf(TARG, SP-MARK, MARK+1);
    TAINT_IF(SvTAINTED(TARG));
    SP = ORIGMARK;
    PUSHTARG;
    RETURN;
}

PP(pp_ord)
{
    dSP; dTARGET;
    SV *argsv = POPs;
    STRLEN len;
    U8 *s = (U8*)SvPVx(argsv, len);

    XPUSHu(DO_UTF8(argsv) ? utf8_to_uvchr(s, 0) : (*s & 0xff));
    RETURN;
}

PP(pp_chr)
{
    dSP; dTARGET;
    char *tmps;
    UV value = POPu;

    (void)SvUPGRADE(TARG,SVt_PV);

    if (value > 255 && !IN_BYTE) {
	SvGROW(TARG, UNISKIP(value)+1);
	tmps = (char*)uvchr_to_utf8((U8*)SvPVX(TARG), value);
	SvCUR_set(TARG, tmps - SvPVX(TARG));
	*tmps = '\0';
	(void)SvPOK_only(TARG);
	SvUTF8_on(TARG);
	XPUSHs(TARG);
	RETURN;
    }

    SvGROW(TARG,2);
    SvCUR_set(TARG, 1);
    tmps = SvPVX(TARG);
    *tmps++ = value;
    *tmps = '\0';
    (void)SvPOK_only(TARG);
    XPUSHs(TARG);
    RETURN;
}

PP(pp_crypt)
{
    dSP; dTARGET; dPOPTOPssrl;
    STRLEN n_a;
#ifdef HAS_CRYPT
    char *tmps = SvPV(left, n_a);
#ifdef FCRYPT
    sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
#else
    sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
#endif
#else
    DIE(aTHX_
      "The crypt() function is unimplemented due to excessive paranoia.");
#endif
    SETs(TARG);
    RETURN;
}

PP(pp_ucfirst)
{
    dSP;
    SV *sv = TOPs;
    register U8 *s;
    STRLEN slen;

    if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
	STRLEN ulen;
	U8 tmpbuf[UTF8_MAXLEN+1];
	U8 *tend;
	UV uv;

	if (PL_op->op_private & OPpLOCALE) {
	    TAINT;
	    SvTAINTED_on(sv);
	    uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
	}
	else
	    uv = toTITLE_utf8(s);
	
	tend = uvchr_to_utf8(tmpbuf, uv);

	if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
	    dTARGET;
	    sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
	    sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
	    SvUTF8_on(TARG);
	    SETs(TARG);
	}
	else {
	    s = (U8*)SvPV_force(sv, slen);
	    Copy(tmpbuf, s, ulen, U8);
	}
    }
    else {
	if (!SvPADTMP(sv) || SvREADONLY(sv)) {
	    dTARGET;
	    SvUTF8_off(TARG);				/* decontaminate */
	    sv_setsv(TARG, sv);
	    sv = TARG;
	    SETs(sv);
	}
	s = (U8*)SvPV_force(sv, slen);
	if (*s) {
	    if (PL_op->op_private & OPpLOCALE) {
		TAINT;
		SvTAINTED_on(sv);
		*s = toUPPER_LC(*s);
	    }
	    else
		*s = toUPPER(*s);
	}
    }
    if (SvSMAGICAL(sv))
	mg_set(sv);
    RETURN;
}

PP(pp_lcfirst)
{
    dSP;
    SV *sv = TOPs;
    register U8 *s;
    STRLEN slen;

    if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
	STRLEN ulen;
	U8 tmpbuf[UTF8_MAXLEN+1];
	U8 *tend;
	UV uv;

	if (PL_op->op_private & OPpLOCALE) {
	    TAINT;
	    SvTAINTED_on(sv);
	    uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
	}
	else
	    uv = toLOWER_utf8(s);
	
	tend = uvchr_to_utf8(tmpbuf, uv);

	if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
	    dTARGET;
	    sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
	    sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
	    SvUTF8_on(TARG);
	    SETs(TARG);
	}
	else {
	    s = (U8*)SvPV_force(sv, slen);
	    Copy(tmpbuf, s, ulen, U8);
	}
    }
    else {
	if (!SvPADTMP(sv) || SvREADONLY(sv)) {
	    dTARGET;
	    SvUTF8_off(TARG);				/* decontaminate */
	    sv_setsv(TARG, sv);
	    sv = TARG;
	    SETs(sv);
	}
	s = (U8*)SvPV_force(sv, slen);
	if (*s) {
	    if (PL_op->op_private & OPpLOCALE) {
		TAINT;
		SvTAINTED_on(sv);
		*s = toLOWER_LC(*s);
	    }
	    else
		*s = toLOWER(*s);
	}
    }
    if (SvSMAGICAL(sv))
	mg_set(sv);
    RETURN;
}

PP(pp_uc)
{
    dSP;
    SV *sv = TOPs;
    register U8 *s;
    STRLEN len;

    if (DO_UTF8(sv)) {
	dTARGET;
	STRLEN ulen;
	register U8 *d;
	U8 *send;

	s = (U8*)SvPV(sv,len);
	if (!len) {
	    SvUTF8_off(TARG);				/* decontaminate */
	    sv_setpvn(TARG, "", 0);
	    SETs(TARG);
	}
	else {
	    (void)SvUPGRADE(TARG, SVt_PV);
	    SvGROW(TARG, (len * 2) + 1);
	    (void)SvPOK_only(TARG);
	    d = (U8*)SvPVX(TARG);
	    send = s + len;
	    if (PL_op->op_private & OPpLOCALE) {
		TAINT;
		SvTAINTED_on(TARG);
		while (s < send) {
		    d = uvchr_to_utf8(d, toUPPER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
		    s += ulen;
		}
	    }
	    else {
		while (s < send) {
		    d = uvchr_to_utf8(d, toUPPER_utf8( s ));
		    s += UTF8SKIP(s);
		}
	    }
	    *d = '\0';
	    SvUTF8_on(TARG);
	    SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
	    SETs(TARG);
	}
    }
    else {
	if (!SvPADTMP(sv) || SvREADONLY(sv)) {
	    dTARGET;
	    SvUTF8_off(TARG);				/* decontaminate */
	    sv_setsv(TARG, sv);
	    sv = TARG;
	    SETs(sv);
	}
	s = (U8*)SvPV_force(sv, len);
	if (len) {
	    register U8 *send = s + len;

	    if (PL_op->op_private & OPpLOCALE) {
		TAINT;
		SvTAINTED_on(sv);
		for (; s < send; s++)
		    *s = toUPPER_LC(*s);
	    }
	    else {
		for (; s < send; s++)
		    *s = toUPPER(*s);
	    }
	}
    }
    if (SvSMAGICAL(sv))
	mg_set(sv);
    RETURN;
}

PP(pp_lc)
{
    dSP;
    SV *sv = TOPs;
    register U8 *s;
    STRLEN len;

    if (DO_UTF8(sv)) {
	dTARGET;
	STRLEN ulen;
	register U8 *d;
	U8 *send;

	s = (U8*)SvPV(sv,len);
	if (!len) {
	    SvUTF8_off(TARG);				/* decontaminate */
	    sv_setpvn(TARG, "", 0);
	    SETs(TARG);
	}
	else {
	    (void)SvUPGRADE(TARG, SVt_PV);
	    SvGROW(TARG, (len * 2) + 1);
	    (void)SvPOK_only(TARG);
	    d = (U8*)SvPVX(TARG);
	    send = s + len;
	    if (PL_op->op_private & OPpLOCALE) {
		TAINT;
		SvTAINTED_on(TARG);
		while (s < send) {
		    d = uvchr_to_utf8(d, toLOWER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
		    s += ulen;
		}
	    }
	    else {
		while (s < send) {
		    d = uvchr_to_utf8(d, toLOWER_utf8(s));
		    s += UTF8SKIP(s);
		}
	    }
	    *d = '\0';
	    SvUTF8_on(TARG);
	    SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
	    SETs(TARG);
	}
    }
    else {
	if (!SvPADTMP(sv) || SvREADONLY(sv)) {
	    dTARGET;
	    SvUTF8_off(TARG);				/* decontaminate */
	    sv_setsv(TARG, sv);
	    sv = TARG;
	    SETs(sv);
	}

	s = (U8*)SvPV_force(sv, len);
	if (len) {
	    register U8 *send = s + len;

	    if (PL_op->op_private & OPpLOCALE) {
		TAINT;
		SvTAINTED_on(sv);
		for (; s < send; s++)
		    *s = toLOWER_LC(*s);
	    }
	    else {
		for (; s < send; s++)
		    *s = toLOWER(*s);
	    }
	}
    }
    if (SvSMAGICAL(sv))
	mg_set(sv);
    RETURN;
}

PP(pp_quotemeta)
{
    dSP; dTARGET;
    SV *sv = TOPs;
    STRLEN len;
    register char *s = SvPV(sv,len);
    register char *d;

    SvUTF8_off(TARG);				/* decontaminate */
    if (len) {
	(void)SvUPGRADE(TARG, SVt_PV);
	SvGROW(TARG, (len * 2) + 1);
	d = SvPVX(TARG);
	if (DO_UTF8(sv)) {
	    while (len) {
		if (UTF8_IS_CONTINUED(*s)) {
		    STRLEN ulen = UTF8SKIP(s);
		    if (ulen > len)
			ulen = len;
		    len -= ulen;
		    while (ulen--)
			*d++ = *s++;
		}
		else {
		    if (!isALNUM(*s))
			*d++ = '\\';
		    *d++ = *s++;
		    len--;
		}
	    }
	    SvUTF8_on(TARG);
	}
	else {
	    while (len--) {
		if (!isALNUM(*s))
		    *d++ = '\\';
		*d++ = *s++;
	    }
	}
	*d = '\0';
	SvCUR_set(TARG, d - SvPVX(TARG));
	(void)SvPOK_only_UTF8(TARG);
    }
    else
	sv_setpvn(TARG, s, len);
    SETs(TARG);
    if (SvSMAGICAL(TARG))
	mg_set(TARG);
    RETURN;
}

/* Arrays. */

PP(pp_aslice)
{
    dSP; dMARK; dORIGMARK;
    register SV** svp;
    register AV* av = (AV*)POPs;
    register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
    I32 arybase = PL_curcop->cop_arybase;
    I32 elem;

    if (SvTYPE(av) == SVt_PVAV) {
	if (lval && PL_op->op_private & OPpLVAL_INTRO) {
	    I32 max = -1;
	    for (svp = MARK + 1; svp <= SP; svp++) {
		elem = SvIVx(*svp);
		if (elem > max)
		    max = elem;
	    }
	    if (max > AvMAX(av))
		av_extend(av, max);
	}
	while (++MARK <= SP) {
	    elem = SvIVx(*MARK);

	    if (elem > 0)
		elem -= arybase;
	    svp = av_fetch(av, elem, lval);
	    if (lval) {
		if (!svp || *svp == &PL_sv_undef)
		    DIE(aTHX_ PL_no_aelem, elem);
		if (PL_op->op_private & OPpLVAL_INTRO)
		    save_aelem(av, elem, svp);
	    }
	    *MARK = svp ? *svp : &PL_sv_undef;
	}
    }
    if (GIMME != G_ARRAY) {
	MARK = ORIGMARK;
	*++MARK = *SP;
	SP = MARK;
    }
    RETURN;
}

/* Associative arrays. */

PP(pp_each)
{
    dSP;
    HV *hash = (HV*)POPs;
    HE *entry;
    I32 gimme = GIMME_V;
    I32 realhv = (SvTYPE(hash) == SVt_PVHV);

    PUTBACK;
    /* might clobber stack_sp */
    entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
    SPAGAIN;

    EXTEND(SP, 2);
    if (entry) {
	PUSHs(hv_iterkeysv(entry));	/* won't clobber stack_sp */
	if (gimme == G_ARRAY) {
	    SV *val;
	    PUTBACK;
	    /* might clobber stack_sp */
	    val = realhv ?
		  hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
	    SPAGAIN;
	    PUSHs(val);
	}
    }
    else if (gimme == G_SCALAR)
	RETPUSHUNDEF;

    RETURN;
}

PP(pp_values)
{
    return do_kv();
}

PP(pp_keys)
{
    return do_kv();
}

PP(pp_delete)
{
    dSP;
    I32 gimme = GIMME_V;
    I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
    SV *sv;
    HV *hv;

    if (PL_op->op_private & OPpSLICE) {
	dMARK; dORIGMARK;
	U32 hvtype;
	hv = (HV*)POPs;
	hvtype = SvTYPE(hv);
	if (hvtype == SVt_PVHV) {			/* hash element */
	    while (++MARK <= SP) {
		sv = hv_delete_ent(hv, *MARK, discard, 0);
		*MARK = sv ? sv : &PL_sv_undef;
	    }
	}
	else if (hvtype == SVt_PVAV) {
	    if (PL_op->op_flags & OPf_SPECIAL) {	/* array element */
		while (++MARK <= SP) {
		    sv = av_delete((AV*)hv, SvIV(*MARK), discard);
		    *MARK = sv ? sv : &PL_sv_undef;
		}
	    }
	    else {					/* pseudo-hash element */
		while (++MARK <= SP) {
		    sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
		    *MARK = sv ? sv : &PL_sv_undef;
		}
	    }
	}
	else
	    DIE(aTHX_ "Not a HASH reference");
	if (discard)
	    SP = ORIGMARK;
	else if (gimme == G_SCALAR) {
	    MARK = ORIGMARK;
	    *++MARK = *SP;
	    SP = MARK;
	}
    }
    else {
	SV *keysv = POPs;
	hv = (HV*)POPs;
	if (SvTYPE(hv) == SVt_PVHV)
	    sv = hv_delete_ent(hv, keysv, discard, 0);
	else if (SvTYPE(hv) == SVt_PVAV) {
	    if (PL_op->op_flags & OPf_SPECIAL)
		sv = av_delete((AV*)hv, SvIV(keysv), discard);
	    else
		sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
	}
	else
	    DIE(aTHX_ "Not a HASH reference");
	if (!sv)
	    sv = &PL_sv_undef;
	if (!discard)
	    PUSHs(sv);
    }
    RETURN;
}

PP(pp_exists)
{
    dSP;
    SV *tmpsv;
    HV *hv;

    if (PL_op->op_private & OPpEXISTS_SUB) {
	GV *gv;
	CV *cv;
	SV *sv = POPs;
	cv = sv_2cv(sv, &hv, &gv, FALSE);
	if (cv)
	    RETPUSHYES;
	if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
	    RETPUSHYES;
	RETPUSHNO;
    }
    tmpsv = POPs;
    hv = (HV*)POPs;
    if (SvTYPE(hv) == SVt_PVHV) {
	if (hv_exists_ent(hv, tmpsv, 0))
	    RETPUSHYES;
    }
    else if (SvTYPE(hv) == SVt_PVAV) {
	if (PL_op->op_flags & OPf_SPECIAL) {		/* array element */
	    if (av_exists((AV*)hv, SvIV(tmpsv)))
		RETPUSHYES;
	}
	else if (avhv_exists_ent((AV*)hv, tmpsv, 0))	/* pseudo-hash element */
	    RETPUSHYES;
    }
    else {
	DIE(aTHX_ "Not a HASH reference");
    }
    RETPUSHNO;
}

PP(pp_hslice)
{
    dSP; dMARK; dORIGMARK;
    register HV *hv = (HV*)POPs;
    register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
    I32 realhv = (SvTYPE(hv) == SVt_PVHV);

    if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
	DIE(aTHX_ "Can't localize pseudo-hash element");

    if (realhv || SvTYPE(hv) == SVt_PVAV) {
	while (++MARK <= SP) {
	    SV *keysv = *MARK;
	    SV **svp;
	    I32 preeminent = SvRMAGICAL(hv) ? 1 :
				realhv ? hv_exists_ent(hv, keysv, 0)
				       : avhv_exists_ent((AV*)hv, keysv, 0);
	    if (realhv) {
		HE *he = hv_fetch_ent(hv, keysv, lval, 0);
		svp = he ? &HeVAL(he) : 0;
	    }
	    else {
		svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
	    }
	    if (lval) {
		if (!svp || *svp == &PL_sv_undef) {
		    STRLEN n_a;
		    DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
		}
		if (PL_op->op_private & OPpLVAL_INTRO) {
		    if (preeminent)
		        save_helem(hv, keysv, svp);
		    else {
			STRLEN keylen;
			char *key = SvPV(keysv, keylen);
			SAVEDELETE(hv, savepvn(key,keylen), keylen);
		    }
                }
	    }
	    *MARK = svp ? *svp : &PL_sv_undef;
	}
    }
    if (GIMME != G_ARRAY) {
	MARK = ORIGMARK;
	*++MARK = *SP;
	SP = MARK;
    }
    RETURN;
}

/* List operators. */

PP(pp_list)
{
    dSP; dMARK;
    if (GIMME != G_ARRAY) {
	if (++MARK <= SP)
	    *MARK = *SP;		/* unwanted list, return last item */
	else
	    *MARK = &PL_sv_undef;
	SP = MARK;
    }
    RETURN;
}

PP(pp_lslice)
{
    dSP;
    SV **lastrelem = PL_stack_sp;
    SV **lastlelem = PL_stack_base + POPMARK;
    SV **firstlelem = PL_stack_base + POPMARK + 1;
    register SV **firstrelem = lastlelem + 1;
    I32 arybase = PL_curcop->cop_arybase;
    I32 lval = PL_op->op_flags & OPf_MOD;
    I32 is_something_there = lval;

    register I32 max = lastrelem - lastlelem;
    register SV **lelem;
    register I32 ix;

    if (GIMME != G_ARRAY) {
	ix = SvIVx(*lastlelem);
	if (ix < 0)
	    ix += max;
	else
	    ix -= arybase;
	if (ix < 0 || ix >= max)
	    *firstlelem = &PL_sv_undef;
	else
	    *firstlelem = firstrelem[ix];
	SP = firstlelem;
	RETURN;
    }

    if (max == 0) {
	SP = firstlelem - 1;
	RETURN;
    }

    for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
	ix = SvIVx(*lelem);
	if (ix < 0)
	    ix += max;
	else
	    ix -= arybase;
	if (ix < 0 || ix >= max)
	    *lelem = &PL_sv_undef;
	else {
	    is_something_there = TRUE;
	    if (!(*lelem = firstrelem[ix]))
		*lelem = &PL_sv_undef;
	}
    }
    if (is_something_there)
	SP = lastlelem;
    else
	SP = firstlelem - 1;
    RETURN;
}

PP(pp_anonlist)
{
    dSP; dMARK; dORIGMARK;
    I32 items = SP - MARK;
    SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
    SP = ORIGMARK;		/* av_make() might realloc stack_sp */
    XPUSHs(av);
    RETURN;
}

PP(pp_anonhash)
{
    dSP; dMARK; dORIGMARK;
    HV* hv = (HV*)sv_2mortal((SV*)newHV());

    while (MARK < SP) {
	SV* key = *++MARK;
	SV *val = NEWSV(46, 0);
	if (MARK < SP)
	    sv_setsv(val, *++MARK);
	else if (ckWARN(WARN_MISC))
	    Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
	(void)hv_store_ent(hv,key,val,0);
    }
    SP = ORIGMARK;
    XPUSHs((SV*)hv);
    RETURN;
}

PP(pp_splice)
{
    dSP; dMARK; dORIGMARK;
    register AV *ary = (AV*)*++MARK;
    register SV **src;
    register SV **dst;
    register I32 i;
    register I32 offset;
    register I32 length;
    I32 newlen;
    I32 after;
    I32 diff;
    SV **tmparyval = 0;
    MAGIC *mg;

    if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
	*MARK-- = SvTIED_obj((SV*)ary, mg);
	PUSHMARK(MARK);
	PUTBACK;
	ENTER;
	call_method("SPLICE",GIMME_V);
	LEAVE;
	SPAGAIN;
	RETURN;
    }

    SP++;

    if (++MARK < SP) {
	offset = i = SvIVx(*MARK);
	if (offset < 0)
	    offset += AvFILLp(ary) + 1;
	else
	    offset -= PL_curcop->cop_arybase;
	if (offset < 0)
	    DIE(aTHX_ PL_no_aelem, i);