#endif
/*
- * Types used in bitwise operations.
- *
- * Normally we'd just use IV and UV. However, some hardware and
- * software combinations (e.g. Alpha and current OSF/1) don't have a
- * floating-point type to use for NV that has adequate bits to fully
- * hold an IV/UV. (In other words, sizeof(long) == sizeof(double).)
- *
- * It just so happens that "int" is the right size almost everywhere.
- */
-typedef int IBW;
-typedef unsigned UBW;
-
-/*
- * Mask used after bitwise operations.
- *
- * There is at least one realm (Cray word machines) that doesn't
- * 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 LONGSIZE > 4 && defined(_CRAY)
-# define BW_BITS 32
-# define BW_MASK ((1 << BW_BITS) - 1)
-# define BW_SIGN (1 << (BW_BITS - 1))
-# define BWi(i) (((i) & BW_SIGN) ? ((i) | ~BW_MASK) : ((i) & BW_MASK))
-# define BWu(u) ((u) & BW_MASK)
-#else
-# define BWi(i) (i)
-# define BWu(u) (u)
-#endif
-
-/*
* Offset for integer pack/unpack.
*
* On architectures where I16 and I32 aren't really 16 and 32 bits,
seen_question = 1;
str[n++] = ';';
}
- else if (seen_question)
+ else if (n && str[0] == ';' && seen_question)
goto set; /* XXXX system, exec */
if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
&& (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
djSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
{
dPOPTOPnnrl;
- SETn( pow( left, right) );
+ SETn( Perl_pow( left, right) );
RETURN;
}
}
#endif
/* Backward-compatibility clause: */
- dright = floor(dright + 0.5);
- dleft = floor(dleft + 0.5);
+ dright = Perl_floor(dright + 0.5);
+ dleft = Perl_floor(dleft + 0.5);
if (!dright)
DIE(aTHX_ "Illegal modulus zero");
{
djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
{
- IBW shift = POPi;
+ IV shift = POPi;
if (PL_op->op_private & HINT_INTEGER) {
- IBW i = TOPi;
- i = BWi(i) << shift;
- SETi(BWi(i));
+ IV i = TOPi;
+ SETi(i << shift);
}
else {
- UBW u = TOPu;
- u <<= shift;
- SETu(BWu(u));
+ UV u = TOPu;
+ SETu(u << shift);
}
RETURN;
}
{
djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
{
- IBW shift = POPi;
+ IV shift = POPi;
if (PL_op->op_private & HINT_INTEGER) {
- IBW i = TOPi;
- i = BWi(i) >> shift;
- SETi(BWi(i));
+ IV i = TOPi;
+ SETi(i >> shift);
}
else {
- UBW u = TOPu;
- u >>= shift;
- SETu(BWu(u));
+ UV u = TOPu;
+ SETu(u >> shift);
}
RETURN;
}
{
dPOPTOPnnrl;
I32 value;
+#ifdef __osf__ /* XXX fix in 5.6.1 --jhi */
+#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
+#define Perl_isnan isnanl
+#else
+#define Perl_isnan isnan
+#endif
+#endif
+#ifdef __osf__ /* XXX fix in 5.6.1 --jhi */
+ 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)
SETs(&PL_sv_undef);
RETURN;
}
+#endif
SETi(value);
RETURN;
}
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
- IBW value = SvIV(left) & SvIV(right);
- SETi(BWi(value));
+ IV i = SvIV(left) & SvIV(right);
+ SETi(i);
}
else {
- UBW value = SvUV(left) & SvUV(right);
- SETu(BWu(value));
+ UV u = SvUV(left) & SvUV(right);
+ SETu(u);
}
}
else {
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
- IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
- SETi(BWi(value));
+ IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
+ SETi(i);
}
else {
- UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
- SETu(BWu(value));
+ UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
+ SETu(u);
}
}
else {
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
- IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
- SETi(BWi(value));
+ IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
+ SETi(i);
}
else {
- UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
- SETu(BWu(value));
+ UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
+ SETu(u);
}
}
else {
dTOPss;
if (SvGMAGICAL(sv))
mg_get(sv);
- if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN)
- SETi(-SvIVX(sv));
- else if (SvNIOKp(sv))
+ if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv)) {
+ if (SvIsUV(sv)) {
+ if (SvIVX(sv) == IV_MIN) {
+ 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;
+ }
+ }
+ if (SvNIOKp(sv))
SETn(-SvNV(sv));
else if (SvPOKp(sv)) {
STRLEN len;
dTOPss;
if (SvNIOKp(sv)) {
if (PL_op->op_private & HINT_INTEGER) {
- IBW value = ~SvIV(sv);
- SETi(BWi(value));
+ IV i = ~SvIV(sv);
+ SETi(i);
}
else {
- UBW value = ~SvUV(sv);
- SETu(BWu(value));
+ UV u = ~SvUV(sv);
+ SETu(u);
}
}
else {
SV **tmparyval = 0;
MAGIC *mg;
- if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
register SV *sv = &PL_sv_undef;
MAGIC *mg;
- if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
register I32 i = 0;
MAGIC *mg;
- if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
int i;
for (i = 0; i < sizeof(PL_uuemap); i += 1)
- PL_uudmap[PL_uuemap[i]] = i;
+ PL_uudmap[(U8)PL_uuemap[i]] = i;
/*
* Because ' ' and '`' map to the same value,
* we need to decode them both the same.
char hunk[4];
hunk[3] = '\0';
- len = PL_uudmap[*s++] & 077;
+ len = PL_uudmap[*(U8*)s++] & 077;
while (len > 0) {
if (s < strend && ISUUCHAR(*s))
- a = PL_uudmap[*s++] & 077;
+ a = PL_uudmap[*(U8*)s++] & 077;
else
a = 0;
if (s < strend && ISUUCHAR(*s))
- b = PL_uudmap[*s++] & 077;
+ b = PL_uudmap[*(U8*)s++] & 077;
else
b = 0;
if (s < strend && ISUUCHAR(*s))
- c = PL_uudmap[*s++] & 077;
+ c = PL_uudmap[*(U8*)s++] & 077;
else
c = 0;
if (s < strend && ISUUCHAR(*s))
- d = PL_uudmap[*s++] & 077;
+ d = PL_uudmap[*(U8*)s++] & 077;
else
d = 0;
hunk[0] = (a << 2) | (b >> 4);
len = 1;
if (*pat == '/') {
++pat;
- if (*pat != 'a' && *pat != 'A' && *pat != 'Z' || pat[1] != '*')
+ if ((*pat != 'a' && *pat != 'A' && *pat != 'Z') || pat[1] != '*')
DIE(aTHX_ "/ must be followed by a*, A* or Z*");
lengthcode = sv_2mortal(newSViv(sv_len(items > 0
? *MARK : &PL_sv_no)));
DIE(aTHX_ "Cannot compress negative numbers");
if (
-#ifdef BW_BITS
- adouble <= BW_MASK
-#else
#ifdef CXUX_BROKEN_CONSTANT_CONVERT
adouble <= UV_MAX_cxux
#else
adouble <= UV_MAX
#endif
-#endif
)
{
char buf[1 + sizeof(UV)];
av_extend(ary,0);
av_clear(ary);
SPAGAIN;
- if (mg = SvTIED_mg((SV*)ary, 'P')) {
+ if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)ary, mg));
}
PP(pp_threadsv)
{
- djSP;
#ifdef USE_THREADS
+ djSP;
EXTEND(SP, 1);
if (PL_op->op_private & OPpLVAL_INTRO)
PUSHs(*save_threadsv(PL_op->op_targ));
https://perl5.git.perl.org / perl5.git / blobdiff