* have an integral type (except char) small enough to be represented
* in a double without loss; that is, it has no 32-bit type.
*/
-#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
+#if LONGSIZE > 4 && defined(_CRAY) && !defined(_CRAYMPP)
# define BW_BITS 32
# define BW_MASK ((1 << BW_BITS) - 1)
# define BW_SIGN (1 << (BW_BITS - 1))
# define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32)
#endif
+#ifndef PERL_OBJECT
static void doencodes _((SV* sv, char* s, I32 len));
static SV* refto _((SV* sv));
static U32 seed _((void));
+#endif
static bool srand_called = FALSE;
}
LvTYPE(TARG) = '.';
- LvTARG(TARG) = sv;
+ if (LvTARG(TARG) != sv) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(sv);
+ }
PUSHs(TARG); /* no SvSETMAGIC */
RETURN;
}
{
djSP; dMARK;
if (GIMME != G_ARRAY) {
- MARK[1] = *SP;
- SP = MARK + 1;
+ if (++MARK <= SP)
+ *MARK = *SP;
+ else
+ *MARK = &sv_undef;
+ *MARK = refto(*MARK);
+ SP = MARK;
+ RETURN;
}
EXTEND_MORTAL(SP - MARK);
while (++MARK <= SP)
RETURN;
}
-static SV*
+STATIC SV*
refto(SV *sv)
{
SV* rv;
if (MAXARG == 1)
stash = curcop->cop_stash;
- else
- stash = gv_stashsv(POPs, TRUE);
+ else {
+ SV *ssv = POPs;
+ STRLEN len;
+ char *ptr = SvPV(ssv,len);
+ if (dowarn && len == 0)
+ warn("Explicit blessing to '' (assuming package main)");
+ stash = gv_stashpvn(ptr, len, TRUE);
+ }
(void)sv_bless(TOPs, stash);
RETURN;
{
GV *gv;
SV *sv;
- SV *ref;
+ SV *tmpRef;
char *elem;
djSP;
sv = POPs;
elem = SvPV(sv, na);
gv = (GV*)POPs;
- ref = Nullsv;
+ tmpRef = Nullsv;
sv = Nullsv;
switch (elem ? *elem : '\0')
{
case 'A':
if (strEQ(elem, "ARRAY"))
- ref = (SV*)GvAV(gv);
+ tmpRef = (SV*)GvAV(gv);
break;
case 'C':
if (strEQ(elem, "CODE"))
- ref = (SV*)GvCVu(gv);
+ tmpRef = (SV*)GvCVu(gv);
break;
case 'F':
if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
- ref = (SV*)GvIOp(gv);
+ tmpRef = (SV*)GvIOp(gv);
break;
case 'G':
if (strEQ(elem, "GLOB"))
- ref = (SV*)gv;
+ tmpRef = (SV*)gv;
break;
case 'H':
if (strEQ(elem, "HASH"))
- ref = (SV*)GvHV(gv);
+ tmpRef = (SV*)GvHV(gv);
break;
case 'I':
if (strEQ(elem, "IO"))
- ref = (SV*)GvIOp(gv);
+ tmpRef = (SV*)GvIOp(gv);
break;
case 'N':
if (strEQ(elem, "NAME"))
break;
case 'S':
if (strEQ(elem, "SCALAR"))
- ref = GvSV(gv);
+ tmpRef = GvSV(gv);
break;
}
- if (ref)
- sv = newRV(ref);
+ if (tmpRef)
+ sv = newRV(tmpRef);
if (sv)
sv_2mortal(sv);
else
register I32 *snext;
STRLEN len;
- if(unop->op_first && unop->op_first->op_type == OP_PUSHRE) {
- PMOP *pm = (PMOP *)unop->op_first;
- SV *rv = sv_newmortal();
- sv = newSVrv(rv, "Regexp");
- sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0);
- RETURNX(PUSHs(rv));
- }
-
if (sv == lastscream) {
if (SvSCREAM(sv))
RETPUSHYES;
hv_undef((HV*)sv);
break;
case SVt_PVCV:
- if (cv_const_sv((CV*)sv))
+ if (dowarn && cv_const_sv((CV*)sv))
warn("Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
break;
case SVt_PVGV:
if (SvFAKE(sv))
- sv_setsv(sv, &sv_undef);
+ SvSetMagicSV(sv, &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) = curcop->cop_line;
+ GvEGV(sv) = (GV*)sv;
+ GvMULTI_on(sv);
+ }
break;
default:
if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
PP(pp_modulo)
{
- djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
UV left;
UV right;
PP(pp_i_modulo)
{
- djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
}
}
+/* 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
+*/
+#ifndef my_rand
+# define my_rand rand
+#endif
+#ifndef my_srand
+# define my_srand srand
+#endif
+
PP(pp_rand)
{
djSP; dTARGET;
if (value == 0.0)
value = 1.0;
if (!srand_called) {
- (void)srand((unsigned)seed());
+ (void)my_srand((unsigned)seed());
srand_called = TRUE;
}
#if RANDBITS == 31
- value = rand() * value / 2147483648.0;
+ value = my_rand() * value / 2147483648.0;
#else
#if RANDBITS == 16
- value = rand() * value / 65536.0;
+ value = my_rand() * value / 65536.0;
#else
#if RANDBITS == 15
- value = rand() * value / 32768.0;
+ value = my_rand() * value / 32768.0;
#else
- value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
+ value = my_rand() * value / (double)(((unsigned long)1) << RANDBITS);
#endif
#endif
#endif
anum = seed();
else
anum = POPu;
- (void)srand((unsigned)anum);
+ (void)my_srand((unsigned)anum);
srand_called = TRUE;
EXTEND(SP, 1);
RETPUSHYES;
}
-static U32
+STATIC U32
seed(void)
{
/*
I32 lvalue = op->op_flags & OPf_MOD;
char *tmps;
I32 arybase = curcop->cop_arybase;
-
- if (MAXARG > 2)
+ char *repl = 0;
+ STRLEN repl_len;
+
+ SvTAINTED_off(TARG); /* decontaminate */
+ if (MAXARG > 2) {
+ if (MAXARG > 3) {
+ sv = POPs;
+ repl = SvPV(sv, repl_len);
+ }
len = POPi;
+ }
pos = POPi;
sv = POPs;
PUTBACK;
pos -= arybase;
rem = curlen-pos;
fail = rem;
- if (MAXARG > 2) {
- if (len < 0) {
- rem += len;
- if (rem < 0)
- rem = 0;
- }
- else if (rem > len)
- rem = len;
- }
+ if (MAXARG > 2) {
+ if (len < 0) {
+ rem += len;
+ if (rem < 0)
+ rem = 0;
+ }
+ else if (rem > len)
+ rem = len;
+ }
}
else {
- pos += curlen;
- if (MAXARG < 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;
+ pos += curlen;
+ if (MAXARG < 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 (dowarn || lvalue)
+ if (dowarn || lvalue || repl)
warn("substr outside of string");
RETPUSHUNDEF;
}
}
LvTYPE(TARG) = 'x';
- LvTARG(TARG) = sv;
+ if (LvTARG(TARG) != sv) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(sv);
+ }
LvTARGOFF(TARG) = pos;
LvTARGLEN(TARG) = rem;
}
+ else if (repl)
+ sv_insert(sv, pos, rem, repl, repl_len);
}
SPAGAIN;
PUSHs(TARG); /* avoid SvSETMAGIC here */
unsigned long retnum;
I32 len;
+ SvTAINTED_off(TARG); /* decontaminate */
offset *= size; /* turn into bit offset */
len = (offset + size + 7) / 8;
if (offset < 0 || size < 1)
}
LvTYPE(TARG) = 'v';
- LvTARG(TARG) = src;
+ if (LvTARG(TARG) != src) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(src);
+ }
LvTARGOFF(TARG) = offset;
LvTARGLEN(TARG) = size;
}
else if (offset > biglen)
offset = biglen;
if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
- (unsigned char*)tmps + biglen, little)))
+ (unsigned char*)tmps + biglen, little, 0)))
retval = -1 + arybase;
else
retval = tmps2 - tmps + arybase;
while (++MARK <= SP) {
if (hvtype == SVt_PVHV)
sv = hv_delete_ent(hv, *MARK, discard, 0);
- else if (hvtype == SVt_PVAV)
- sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
else
DIE("Not a HASH reference");
*MARK = sv ? sv : &sv_undef;
hv = (HV*)POPs;
if (SvTYPE(hv) == SVt_PVHV)
sv = hv_delete_ent(hv, keysv, discard, 0);
- else if (SvTYPE(hv) == SVt_PVAV)
- sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
else
DIE("Not a HASH reference");
if (!sv)
PP(pp_hslice)
{
djSP; dMARK; dORIGMARK;
- register HE *he;
register HV *hv = (HV*)POPs;
register I32 lval = op->op_flags & OPf_MOD;
I32 realhv = (SvTYPE(hv) == SVt_PVHV);
SV *keysv = *MARK;
SV **svp;
if (realhv) {
- he = hv_fetch_ent(hv, keysv, lval, 0);
+ 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 (!he || HeVAL(he) == &sv_undef)
+ if (!svp || *svp == &sv_undef)
DIE(no_helem, SvPV(keysv, na));
if (op->op_private & OPpLVAL_INTRO)
- save_helem(hv, keysv, &HeVAL(he));
+ save_helem(hv, keysv, svp);
}
- *MARK = he ? HeVAL(he) : &sv_undef;
+ *MARK = svp ? *svp : &sv_undef;
}
}
if (GIMME != G_ARRAY) {
DIE(no_aelem, i);
if (++MARK < SP) {
length = SvIVx(*MARK++);
- if (length < 0)
- length = 0;
+ if (length < 0) {
+ length += AvFILLp(ary) - offset + 1;
+ if (length < 0)
+ length = 0;
+ }
}
else
length = AvMAX(ary) + 1; /* close enough to infinity */
if (AvREAL(ary)) {
EXTEND_MORTAL(length);
for (i = length, dst = MARK; i; i--) {
- if (!SvIMMORTAL(*dst))
- sv_2mortal(*dst); /* free them eventualy */
+ sv_2mortal(*dst); /* free them eventualy */
dst++;
}
}
else {
*MARK = AvARRAY(ary)[offset+length-1];
if (AvREAL(ary)) {
- if (!SvIMMORTAL(*MARK))
- sv_2mortal(*MARK);
+ sv_2mortal(*MARK);
for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
SvREFCNT_dec(*dst++); /* free them now */
}
if (AvREAL(ary)) {
EXTEND_MORTAL(length);
for (i = length, dst = MARK; i; i--) {
- if (!SvIMMORTAL(*dst))
- sv_2mortal(*dst); /* free them eventualy */
+ sv_2mortal(*dst); /* free them eventualy */
dst++;
}
}
else if (length--) {
*MARK = tmparyval[length];
if (AvREAL(ary)) {
- if (!SvIMMORTAL(*MARK))
- sv_2mortal(*MARK);
+ sv_2mortal(*MARK);
while (length-- > 0)
SvREFCNT_dec(tmparyval[length]);
}
djSP;
AV *av = (AV*)POPs;
SV *sv = av_pop(av);
- if (!SvIMMORTAL(sv) && AvREAL(av))
+ if (AvREAL(av))
(void)sv_2mortal(sv);
PUSHs(sv);
RETURN;
EXTEND(SP, 1);
if (!sv)
RETPUSHUNDEF;
- if (!SvIMMORTAL(sv) && AvREAL(av))
+ if (AvREAL(av))
(void)sv_2mortal(sv);
PUSHs(sv);
RETURN;
RETURN;
}
-static SV *
+STATIC SV *
mul128(SV *sv, U8 m)
{
STRLEN len;
Copy(s, &aint, 1, int);
s += sizeof(int);
sv = NEWSV(40, 0);
+#ifdef __osf__
+ /* Without the dummy below unpack("i", pack("i",-1))
+ * return 0xFFffFFff instead of -1 for Digital Unix V4.0
+ * cc with optimization turned on */
+ (aint) ?
+ sv_setiv(sv, (IV)aint) :
+#endif
sv_setiv(sv, (IV)aint);
PUSHs(sv_2mortal(sv));
}
break;
#ifdef HAS_QUAD
case 'q':
+ along = (strend - s) / sizeof(Quad_t);
+ if (len > along)
+ len = along;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
}
break;
case 'Q':
+ along = (strend - s) / sizeof(Quad_t);
+ if (len > along)
+ len = along;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0) {
s += sizeof(unsigned Quad_t);
}
sv = NEWSV(43, 0);
- if (aquad <= UV_MAX)
+ if (auquad <= UV_MAX)
sv_setuv(sv, (UV)auquad);
else
sv_setnv(sv, (double)auquad);
RETURN;
}
-static void
+STATIC void
doencodes(register SV *sv, register char *s, register I32 len)
{
char hunk[5];
sv_catpvn(sv, "\n", 1);
}
-static SV *
+STATIC SV *
is_an_int(char *s, STRLEN l)
{
SV *result = newSVpv("", l);
return (result);
}
-static int
+STATIC int
div128(SV *pnum, bool *done)
/* must be '\0' terminated */
#ifndef lint
while (s < strend && --limit &&
(m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
- rx->check_substr)) )
+ rx->check_substr, 0)) )
#endif
{
dstr = NEWSV(31, m-s);
else {
maxiters += (strend - s) * rx->nparens;
while (s < strend && --limit &&
- regexec_flags(rx, s, strend, orig, 1, Nullsv, NULL, 0))
+ CALLREGEXEC(rx, s, strend, orig, 1, Nullsv, NULL, 0))
{
TAINT_IF(RX_MATCH_TAINTED(rx));
if (rx->subbase
https://perl5.git.perl.org / perl5.git / blobdiff