/* pp.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, 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.
typedef int IBW;
typedef unsigned UBW;
-static SV* refto _((SV* sv));
static void doencodes _((SV* sv, char* s, I32 len));
+static SV* refto _((SV* sv));
+static U32 seed _((void));
+
+static bool srand_called = FALSE;
/* variations on pp_null */
else {
SV* sv = sv_newmortal();
if (HvFILL((HV*)TARG)) {
- sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
+ sprintf(buf, "%ld/%ld",
+ (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG)+1);
sv_setpv(sv, buf);
}
else
if (op->op_flags & OPf_REF ||
op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a symbol");
+ if (dowarn)
+ warn(warn_uninit);
RETSETUNDEF;
}
sym = SvPV(sv, na);
if (op->op_flags & OPf_REF ||
op->op_private & HINT_STRICT_REFS)
DIE(no_usym, "a SCALAR");
+ if (dowarn)
+ warn(warn_uninit);
RETSETUNDEF;
}
sym = SvPV(sv, na);
register I32 ch;
register I32 *sfirst;
register I32 *snext;
- I32 retval;
STRLEN len;
- s = (unsigned char*)(SvPV(sv, len));
- pos = len;
- if (sv == lastscream)
- SvSCREAM_off(sv);
+ if (sv == lastscream) {
+ if (SvSCREAM(sv))
+ RETPUSHYES;
+ }
else {
if (lastscream) {
SvSCREAM_off(lastscream);
}
lastscream = SvREFCNT_inc(sv);
}
- if (pos <= 0) {
- retval = 0;
- goto ret;
- }
+
+ s = (unsigned char*)(SvPV(sv, len));
+ pos = len;
+ if (pos <= 0)
+ RETPUSHNO;
if (pos > maxscream) {
if (maxscream < 0) {
maxscream = pos + 80;
SvSCREAM_on(sv);
sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */
- retval = 1;
- ret:
- XPUSHs(sv_2mortal(newSViv((I32)retval)));
- RETURN;
+ RETPUSHYES;
}
PP(pp_trans)
dSP;
SV *sv;
- if (!op->op_private)
+ if (!op->op_private) {
+ EXTEND(SP, 1);
RETPUSHUNDEF;
+ }
sv = POPs;
if (!sv)
hv_undef((HV*)sv);
break;
case SVt_PVCV:
+ if (!CvANON((CV*)sv) && cv_const_sv((CV*)sv))
+ warn("Constant subroutine %s undefined",
+ GvENAME(CvGV((CV*)sv)));
+ /* FALL THROUGH */
+ case SVt_PVFM:
cv_undef((CV*)sv);
- sub_generation++;
break;
case SVt_PVGV:
- if (SvFAKE(sv)) {
- sv_setsv(sv, &sv_undef);
- break;
- }
+ if (SvFAKE(sv))
+ sv_setsv(sv, &sv_undef);
+ break;
default:
- if (SvPOK(sv) && SvLEN(sv)) {
+ if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
(void)SvOOK_off(sv);
Safefree(SvPVX(sv));
SvPV_set(sv, Nullch);
PP(pp_predec)
{
dSP;
+ if (SvREADONLY(TOPs))
+ croak(no_modify);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MIN)
{
PP(pp_postinc)
{
dSP; dTARGET;
+ if (SvREADONLY(TOPs))
+ croak(no_modify);
sv_setsv(TARG, TOPs);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MAX)
PP(pp_postdec)
{
dSP; dTARGET;
+ if(SvREADONLY(TOPs))
+ croak(no_modify);
sv_setsv(TARG, TOPs);
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MIN)
{
dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
{
- dPOPTOPnnrl_ul;
+ dPOPTOPnnrl;
SETn( pow( left, right) );
RETURN;
}
{
dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
{
- dPOPTOPnnrl_ul;
+ dPOPTOPnnrl;
SETn( left * right );
RETURN;
}
{
dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
- dPOPPOPnnrl_ul;
+ dPOPPOPnnrl;
double value;
if (right == 0.0)
DIE("Illegal division by zero");
SETi( left % right );
}
else {
- register double left = USE_LEFT(TOPs) ? SvNV(TOPs) : 0.0;
+ register double left = TOPn;
if (left < 0.0)
SETu( (right - (U_V(-left) - 1) % right) - 1 );
else
if (SvROK(tmpstr))
sv_unref(tmpstr);
}
- if (USE_LEFT(tmpstr) || SvTYPE(tmpstr) > SVt_PVMG) {
- SvSetSV(TARG, tmpstr);
- SvPV_force(TARG, len);
- 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';
+ SvSetSV(TARG, tmpstr);
+ SvPV_force(TARG, len);
+ 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;
}
- (void)SvPOK_only(TARG);
+ *SvEND(TARG) = '\0';
}
- else
- sv_setsv(TARG, &sv_no);
+ (void)SvPOK_only(TARG);
PUSHTARG;
}
RETURN;
dPOPTOPnnrl;
I32 value;
- if (left > right)
- value = 1;
+ if (left == right)
+ value = 0;
else if (left < right)
value = -1;
- else
- value = 0;
+ else if (left > right)
+ value = 1;
+ else {
+ SETs(&sv_undef);
+ RETURN;
+ }
SETi(value);
RETURN;
}
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
if (op->op_private & HINT_INTEGER) {
- IBW value = SvIV(left) ^ SvIV(right);
+ IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
SETi( value );
}
else {
- UBW value = SvUV(left) ^ SvUV(right);
+ UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
SETu( value );
}
}
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
if (op->op_private & HINT_INTEGER) {
- IBW value = SvIV(left) | SvIV(right);
+ IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
SETi( value );
}
else {
- UBW value = SvUV(left) | SvUV(right);
+ UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
SETu( value );
}
}
dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
{
dPOPTOPiirl;
+ if (!right)
+ DIE("Illegal modulus zero");
SETi( left % right );
RETURN;
}
value = POPn;
if (value == 0.0)
value = 1.0;
+ if (!srand_called) {
+ (void)srand((unsigned)seed());
+ srand_called = TRUE;
+ }
#if RANDBITS == 31
value = rand() * value / 2147483648.0;
#else
PP(pp_srand)
{
dSP;
- I32 anum;
+ UV anum;
+ if (MAXARG < 1)
+ anum = seed();
+ else
+ anum = POPu;
+ (void)srand((unsigned)anum);
+ srand_called = TRUE;
+ EXTEND(SP, 1);
+ RETPUSHYES;
+}
- if (MAXARG < 1) {
+static U32
+seed()
+{
+ U32 u;
#ifdef VMS
# include <starlet.h>
- unsigned int when[2];
- _ckvmssts(sys$gettim(when));
- anum = when[0] ^ when[1];
+ unsigned int when[2];
+ _ckvmssts(sys$gettim(when));
+ u = when[0] ^ when[1];
#else
# ifdef HAS_GETTIMEOFDAY
- struct timeval when;
- gettimeofday(&when,(struct timezone *) 0);
- anum = when.tv_sec ^ when.tv_usec;
+ struct timeval when;
+ gettimeofday(&when,(struct timezone *) 0);
+ u = when.tv_sec ^ when.tv_usec;
# else
- Time_t when;
- (void)time(&when);
- anum = when;
+ Time_t when;
+ (void)time(&when);
+ u = when;
# endif
#endif
-#if !defined(PLAN9) /* XXX Plan9 assembler chokes on this; fix coming soon */
- /* 17-Jul-1996 bailey@genetics.upenn.edu */
- /* What is a good hashing algorithm here? */
- anum ^= ( ( 269 * (U32)getpid())
- ^ (26107 * (U32)&when)
- ^ (73819 * (U32)stack_sp));
+#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */
+ /* What is a good hashing algorithm here? */
+ u ^= ( ( 269 * (U32)getpid())
+ ^ (26107 * (U32)&when)
+ ^ (73819 * (U32)stack_sp));
#endif
- }
- else
- anum = POPi;
- (void)srand(anum);
- EXTEND(SP, 1);
- RETPUSHYES;
+ return u;
}
PP(pp_exp)
PP(pp_int)
{
dSP; dTARGET;
- double value;
- value = POPn;
- if (value >= 0.0)
- (void)modf(value, &value);
- else {
- (void)modf(-value, &value);
- value = -value;
+ {
+ double value = TOPn;
+ IV iv;
+
+ if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
+ iv = SvIVX(TOPs);
+ SETi(iv);
+ }
+ else {
+ if (value >= 0.0)
+ (void)modf(value, &value);
+ else {
+ (void)modf(-value, &value);
+ value = -value;
+ }
+ iv = I_V(value);
+ if (iv == value)
+ SETi(iv);
+ else
+ SETn(value);
+ }
}
- XPUSHn(value);
RETURN;
}
{
dSP; dTARGET; tryAMAGICun(abs);
{
- double value;
- value = POPn;
-
- if (value < 0.0)
- value = -value;
-
- XPUSHn(value);
- RETURN;
+ double value = TOPn;
+ IV iv;
+
+ if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
+ (iv = SvIVX(TOPs)) != IV_MIN) {
+ if (iv < 0)
+ iv = -iv;
+ SETi(iv);
+ }
+ else {
+ if (value < 0.0)
+ value = -value;
+ SETn(value);
+ }
}
+ RETURN;
}
PP(pp_hex)
}
}
- sv_setiv(TARG, (I32)retnum);
+ sv_setiv(TARG, (IV)retnum);
PUSHs(TARG);
RETURN;
}
if (ix >= max || !(*lelem = firstrelem[ix]))
*lelem = &sv_undef;
}
- if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem)))
+ if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem)))
is_something_there = TRUE;
}
if (is_something_there)
PP(pp_anonlist)
{
- dSP; dMARK;
+ dSP; dMARK; dORIGMARK;
I32 items = SP - MARK;
- SP = MARK;
- XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1)));
+ SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
+ SP = ORIGMARK; /* av_make() might realloc stack_sp */
+ XPUSHs(av);
RETURN;
}
if (aint >= 128) /* fake up signed chars */
aint -= 256;
sv = NEWSV(36, 0);
- sv_setiv(sv, (I32)aint);
+ sv_setiv(sv, (IV)aint);
PUSHs(sv_2mortal(sv));
}
}
while (len-- > 0) {
auint = *s++ & 255;
sv = NEWSV(37, 0);
- sv_setiv(sv, (I32)auint);
+ sv_setiv(sv, (IV)auint);
PUSHs(sv_2mortal(sv));
}
}
Copy(s, &ashort, 1, I16);
s += sizeof(I16);
sv = NEWSV(38, 0);
- sv_setiv(sv, (I32)ashort);
+ sv_setiv(sv, (IV)ashort);
PUSHs(sv_2mortal(sv));
}
}
if (datumtype == 'v')
aushort = vtohs(aushort);
#endif
- sv_setiv(sv, (I32)aushort);
+ sv_setiv(sv, (IV)aushort);
PUSHs(sv_2mortal(sv));
}
}
Copy(s, &aint, 1, int);
s += sizeof(int);
sv = NEWSV(40, 0);
- sv_setiv(sv, (I32)aint);
+ sv_setiv(sv, (IV)aint);
PUSHs(sv_2mortal(sv));
}
}
Copy(s, &auint, 1, unsigned int);
s += sizeof(unsigned int);
sv = NEWSV(41, 0);
- if (auint <= I32_MAX)
- sv_setiv(sv, (I32)auint);
- else
- sv_setnv(sv, (double)auint);
+ sv_setuv(sv, (UV)auint);
PUSHs(sv_2mortal(sv));
}
}
Copy(s, &along, 1, I32);
s += sizeof(I32);
sv = NEWSV(42, 0);
- sv_setiv(sv, (I32)along);
+ sv_setiv(sv, (IV)along);
PUSHs(sv_2mortal(sv));
}
}
while (len-- > 0) {
Copy(s, &aulong, 1, U32);
s += sizeof(U32);
- sv = NEWSV(43, 0);
#ifdef HAS_NTOHL
if (datumtype == 'N')
aulong = ntohl(aulong);
if (datumtype == 'V')
aulong = vtohl(aulong);
#endif
- sv_setnv(sv, (double)aulong);
+ sv = NEWSV(43, 0);
+ sv_setuv(sv, (UV)aulong);
PUSHs(sv_2mortal(sv));
}
}
char decn[sizeof(UV) * 3 + 1];
char *t;
- (void) sprintf(decn, "%0*ld", sizeof(decn) - 1, auv);
+ (void) sprintf(decn, "%0*ld",
+ (int)sizeof(decn) - 1, auv);
sv = newSVpv(decn, 0);
while (s < strend) {
sv = mul128(sv, *s & 0x7f);
s += sizeof(unsigned Quad_t);
}
sv = NEWSV(43, 0);
- sv_setiv(sv, (IV)auquad);
+ sv_setuv(sv, (UV)auquad);
PUSHs(sv_2mortal(sv));
}
break;
STRLEN len;
register char *s = SvPV(sv, len);
char *strend = s + len;
- register PMOP *pm = (PMOP*)POPs;
+ register PMOP *pm;
+ register REGEXP *rx;
register SV *dstr;
register char *m;
I32 iters = 0;
I32 realarray = 0;
I32 base;
AV *oldstack = curstack;
- register REGEXP *rx = pm->op_pmregexp;
I32 gimme = GIMME;
I32 oldsave = savestack_ix;
+#ifdef DEBUGGING
+ Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
+#else
+ pm = (PMOP*)POPs;
+#endif
if (!pm || !s)
DIE("panic: do_split");
+ rx = pm->op_pmregexp;
TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
(pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
s = m;
}
}
- else if (pm->op_pmshort) {
+ else if (pm->op_pmshort && !rx->nparens) {
i = SvCUR(pm->op_pmshort);
if (i == 1) {
i = *SvPVX(pm->op_pmshort);
https://perl5.git.perl.org / perl5.git / blobdiff