* 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))
* 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 preprocessor.) --???
+ */
+/*
+ The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE
+ defines are now in config.h. --Andy Dougherty April 1998
*/
#define SIZE16 2
#define SIZE32 4
}
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)
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;
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)) {
}
}
+/* 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;
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;
tmps = SvPV(sv, curlen);
if (pos >= arybase) {
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 */
RETURN;
}
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) {
if (MARK < SP)
sv_setsv(val, *++MARK);
else if (dowarn)
- warn("Odd number of elements in hash list");
+ warn("Odd number of elements in hash assignment");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
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;
U32 i = 0;
if (!strnEQ(s, "0000", 4)) { /* need to grow sv */
- SV *New = newSVpv("0000000000", 10);
+ SV *tmpNew = newSVpv("0000000000", 10);
- sv_catsv(New, sv);
+ sv_catsv(tmpNew, sv);
SvREFCNT_dec(sv); /* free old sv */
- sv = New;
+ sv = tmpNew;
s = SvPV(sv, len);
}
t = s + len - 1;
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);
register char *s = SvPV(sv, len);
char *strend = s + len;
register PMOP *pm;
- register REGEXP *prx;
+ register REGEXP *rx;
register SV *dstr;
register char *m;
I32 iters = 0;
#endif
if (!pm || !s)
DIE("panic: do_split");
- prx = pm->op_pmregexp;
+ rx = pm->op_pmregexp;
TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
(pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
++s;
}
}
- else if (strEQ("^", prx->precomp)) {
+ else if (strEQ("^", rx->precomp)) {
while (--limit) {
/*SUPPRESS 530*/
for (m = s; m < strend && *m != '\n'; m++) ;
s = m;
}
}
- else if (prx->check_substr && !prx->nparens
- && (prx->reganch & ROPT_CHECK_ALL)
- && !(prx->reganch & ROPT_ANCH)) {
- i = SvCUR(prx->check_substr);
- if (i == 1 && !SvTAIL(prx->check_substr)) {
- i = *SvPVX(prx->check_substr);
+ else if (rx->check_substr && !rx->nparens
+ && (rx->reganch & ROPT_CHECK_ALL)
+ && !(rx->reganch & ROPT_ANCH)) {
+ i = SvCUR(rx->check_substr);
+ if (i == 1 && !SvTAIL(rx->check_substr)) {
+ i = *SvPVX(rx->check_substr);
while (--limit) {
/*SUPPRESS 530*/
for (m = s; m < strend && *m != i; m++) ;
#ifndef lint
while (s < strend && --limit &&
(m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
- prx->check_substr)) )
+ rx->check_substr, 0)) )
#endif
{
dstr = NEWSV(31, m-s);
}
}
else {
- maxiters += (strend - s) * prx->nparens;
+ maxiters += (strend - s) * rx->nparens;
while (s < strend && --limit &&
- regexec_flags(prx, s, strend, orig, 1, Nullsv, NULL, 0))
+ CALLREGEXEC(rx, s, strend, orig, 1, Nullsv, NULL, 0))
{
- TAINT_IF(RX_MATCH_TAINTED(prx));
- if (prx->subbase
- && prx->subbase != orig) {
+ TAINT_IF(RX_MATCH_TAINTED(rx));
+ if (rx->subbase
+ && rx->subbase != orig) {
m = s;
s = orig;
- orig = prx->subbase;
+ orig = rx->subbase;
s = orig + (m - s);
strend = s + (strend - m);
}
- m = prx->startp[0];
+ m = rx->startp[0];
dstr = NEWSV(32, m-s);
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
- if (prx->nparens) {
- for (i = 1; i <= prx->nparens; i++) {
- s = prx->startp[i];
- m = prx->endp[i];
+ if (rx->nparens) {
+ for (i = 1; i <= rx->nparens; i++) {
+ s = rx->startp[i];
+ m = rx->endp[i];
if (m && s) {
dstr = NEWSV(33, m-s);
sv_setpvn(dstr, s, m-s);
XPUSHs(dstr);
}
}
- s = prx->endp[0];
+ s = rx->endp[0];
}
}
https://perl5.git.perl.org / perl5.git / blobdiff