* in a double without loss; that is, it has no 32-bit type.
*/
#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
-# define BWBITS 32
-# define BWMASK ((1 << BWBITS) - 1)
-# define BWSIGN (1 << (BWBITS - 1))
+# 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
}
else if (gimme == G_SCALAR) {
SV* sv = sv_newmortal();
- if (HvFILL((HV*)TARG)) {
- sprintf(buf, "%ld/%ld",
- (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG)+1);
- sv_setpv(sv, buf);
- }
+ if (HvFILL((HV*)TARG))
+ sv_setpvf(sv, "%ld/%ld",
+ (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1);
else
sv_setiv(sv, 0);
SETs(sv);
else if (SvPADTMP(sv))
sv = newSVsv(sv);
else {
+ dTHR; /* just for SvREFCNT_inc */
SvTEMP_off(sv);
(void)SvREFCNT_inc(sv);
}
IBW shift = POPi;
if (op->op_private & HINT_INTEGER) {
IBW i = TOPi;
- i <<= shift;
+ i = BWi(i) << shift;
SETi(BWi(i));
}
else {
IBW shift = POPi;
if (op->op_private & HINT_INTEGER) {
IBW i = TOPi;
- i >>= shift;
+ i = BWi(i) >> shift;
SETi(BWi(i));
}
else {
#define SEED_C3 269
#define SEED_C5 26107
+ dTHR;
U32 u;
#ifdef VMS
# include <starlet.h>
HV *hash = (HV*)POPs;
HE *entry;
I32 gimme = GIMME_V;
+ I32 realhv = (SvTYPE(hash) == SVt_PVHV);
PUTBACK;
- entry = hv_iternext(hash); /* might clobber stack_sp */
+ /* might clobber stack_sp */
+ entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
SPAGAIN;
EXTEND(SP, 2);
PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
if (gimme == G_ARRAY) {
PUTBACK;
- sv_setsv(TARG, hv_iterval(hash, entry)); /* might hit stack_sp */
+ /* might clobber stack_sp */
+ sv_setsv(TARG, realhv ?
+ hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry));
SPAGAIN;
PUSHs(TARG);
}
if (op->op_private & OPpSLICE) {
dMARK; dORIGMARK;
+ U32 hvtype;
hv = (HV*)POPs;
- if (SvTYPE(hv) != SVt_PVHV)
- DIE("Not a HASH reference");
+ hvtype = SvTYPE(hv);
while (++MARK <= SP) {
- sv = hv_delete_ent(hv, *MARK, discard, 0);
+ 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;
}
if (discard)
else {
SV *keysv = POPs;
hv = (HV*)POPs;
- if (SvTYPE(hv) != SVt_PVHV)
+ 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");
- sv = hv_delete_ent(hv, keysv, discard, 0);
if (!sv)
sv = &sv_undef;
if (!discard)
dSP;
SV *tmpsv = POPs;
HV *hv = (HV*)POPs;
- STRLEN len;
- if (SvTYPE(hv) != SVt_PVHV) {
+ if (SvTYPE(hv) == SVt_PVHV) {
+ if (hv_exists_ent(hv, tmpsv, 0))
+ RETPUSHYES;
+ } else if (SvTYPE(hv) == SVt_PVAV) {
+ if (avhv_exists_ent((AV*)hv, tmpsv, 0))
+ RETPUSHYES;
+ } else {
DIE("Not a HASH reference");
}
- if (hv_exists_ent(hv, tmpsv, 0))
- RETPUSHYES;
RETPUSHNO;
}
register HE *he;
register HV *hv = (HV*)POPs;
register I32 lval = op->op_flags & OPf_MOD;
+ I32 realhv = (SvTYPE(hv) == SVt_PVHV);
- if (SvTYPE(hv) == SVt_PVHV) {
+ if (realhv || SvTYPE(hv) == SVt_PVAV) {
while (++MARK <= SP) {
SV *keysv = *MARK;
-
- he = hv_fetch_ent(hv, keysv, lval, 0);
+ SV **svp;
+ if (realhv) {
+ 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)
DIE(no_helem, SvPV(keysv, na));
}
while (pat < patend) {
reparse:
- datumtype = *pat++;
+ datumtype = *pat++ & 0xFF;
+ if (isSPACE(datumtype))
+ continue;
if (pat >= patend)
len = 1;
else if (*pat == '*') {
len = (datumtype != '@');
switch(datumtype) {
default:
- croak("Invalid type in unpack: '%c'", datumtype);
+ croak("Invalid type in unpack: '%c'", (int)datumtype);
case '%':
if (len == 1 && pat[-1] != '1')
len = 16;
auv = 0;
}
else if (++bytes >= sizeof(UV)) { /* promote to string */
- char decn[sizeof(UV) * 3 + 1];
char *t;
- (void) sprintf(decn, "%0*ld",
- (int)sizeof(decn) - 1, auv);
- sv = newSVpv(decn, 0);
+ sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
while (s < strend) {
sv = mul128(sv, *s & 0x7f);
if (!(*s++ & 0x80)) {
sv_setpvn(cat, "", 0);
while (pat < patend) {
#define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
- datumtype = *pat++;
+ datumtype = *pat++ & 0xFF;
+ if (isSPACE(datumtype))
+ continue;
if (*pat == '*') {
len = strchr("@Xxu", datumtype) ? 0 : items;
pat++;
len = 1;
switch(datumtype) {
default:
- croak("Invalid type in pack: '%c'", datumtype);
+ croak("Invalid type in pack: '%c'", (int)datumtype);
case '%':
DIE("%% may only be used in unpack");
case '@':
if (adouble < 0)
croak("Cannot compress negative numbers");
- if (adouble <= UV_MAX) {
+ if (
+#ifdef BW_BITS
+ adouble <= BW_MASK
+#else
+ adouble <= UV_MAX
+#endif
+ )
+ {
char buf[1 + sizeof(UV)];
char *in = buf + sizeof(buf);
UV auv = U_V(adouble);;
if (pm->op_pmreplroot)
ary = GvAVn((GV*)pm->op_pmreplroot);
else if (gimme != G_ARRAY)
+#ifdef USE_THREADS
+ ary = (AV*)curpad[0];
+#else
ary = GvAVn(defgv);
+#endif /* USE_THREADS */
else
ary = Nullav;
if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
RETPUSHUNDEF;
}
+#ifdef USE_THREADS
+void
+unlock_condpair(svv)
+void *svv;
+{
+ dTHR;
+ MAGIC *mg = mg_find((SV*)svv, 'm');
+
+ if (!mg)
+ croak("panic: unlock_condpair unlocking non-mutex");
+ MUTEX_LOCK(MgMUTEXP(mg));
+ if (MgOWNER(mg) != thr)
+ croak("panic: unlock_condpair unlocking mutex that we don't own");
+ MgOWNER(mg) = 0;
+ COND_SIGNAL(MgOWNERCONDP(mg));
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+}
+#endif /* USE_THREADS */
+
+PP(pp_lock)
+{
+ dSP;
+#ifdef USE_THREADS
+ dTOPss;
+ MAGIC *mg;
+
+ if (SvROK(sv))
+ sv = SvRV(sv);
+
+ mg = condpair_magic(sv);
+ MUTEX_LOCK(MgMUTEXP(mg));
+ if (MgOWNER(mg) == thr)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ else {
+ while (MgOWNER(mg))
+ COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
+ MgOWNER(mg) = thr;
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ save_destructor(unlock_condpair, sv);
+ }
+#endif /* USE_THREADS */
+ RETURN;
+}
projects / p5sagit/p5-mst-13.2.git / blobdiff