/* 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)
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);
break;
case SVt_PVGV:
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);
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)
}
}
- sv_setiv(TARG, (I32)retnum);
+ sv_setiv(TARG, (IV)retnum);
PUSHs(TARG);
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;
https://perl5.git.perl.org / perl5.git / blobdiff