if (SvROK(sv)) {
wasref:
sv = SvRV(sv);
- if (SvTYPE(sv) != SVt_PVGV)
+ if (SvTYPE(sv) == SVt_PVIO) {
+ GV *gv = (GV*) sv_newmortal();
+ gv_init(gv, 0, "", 0, 0);
+ GvIOp(gv) = (IO *)sv;
+ SvREFCNT_inc(sv);
+ sv = (SV*) gv;
+ } else if (SvTYPE(sv) != SVt_PVGV)
DIE("Not a GLOB reference");
}
else {
if (op->op_flags & OPf_SPECIAL) {
GvGP(sv)->gp_refcnt++; /* will soon be assigned */
- GvFLAGS(sv) |= GVf_INTRO;
+ GvINTRO_on(sv);
}
else {
GP *gp;
GvREFCNT(sv) = 1;
GvSV(sv) = NEWSV(72,0);
GvLINE(sv) = curcop->cop_line;
- GvEGV(sv) = sv;
+ GvEGV(sv) = (GV*)sv;
}
}
SETs(sv);
}
}
else {
- GV *gv = sv;
+ GV *gv = (GV*)sv;
char *sym;
if (SvTYPE(gv) != SVt_PVGV) {
sym = SvPV(sv, na);
if (op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a SCALAR");
- gv = (SV*)gv_fetchpv(sym, TRUE, SVt_PV);
+ gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
}
sv = GvSV(gv);
}
CV* cv = (CV*)cSVOP->op_sv;
EXTEND(SP,1);
- if (SvFLAGS(cv) & SVpcv_CLONE) {
+ if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
- }
PUSHs((SV*)cv);
RETURN;
char *pv;
sv = POPs;
+
+ if (sv && SvGMAGICAL(sv))
+ mg_get(sv);
+
if (!sv || !SvROK(sv))
RETPUSHNO;
{
dSP;
if (SvIOK(TOPs)) {
- --SvIVX(TOPs);
- SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+ if (SvIVX(TOPs) == IV_MIN) {
+ sv_setnv(TOPs, (double)SvIVX(TOPs) - 1.0);
+ }
+ else {
+ --SvIVX(TOPs);
+ SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+ }
}
else
sv_dec(TOPs);
dSP; dTARGET;
sv_setsv(TARG, TOPs);
if (SvIOK(TOPs)) {
- ++SvIVX(TOPs);
- SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+ if (SvIVX(TOPs) == IV_MAX) {
+ sv_setnv(TOPs, (double)SvIVX(TOPs) + 1.0);
+ }
+ else {
+ ++SvIVX(TOPs);
+ SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+ }
}
else
sv_inc(TOPs);
dSP; dTARGET;
sv_setsv(TARG, TOPs);
if (SvIOK(TOPs)) {
- --SvIVX(TOPs);
- SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+ if (SvIVX(TOPs) == IV_MIN) {
+ sv_setnv(TOPs, (double)SvIVX(TOPs) - 1.0);
+ }
+ else {
+ --SvIVX(TOPs);
+ SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+ }
}
else
sv_dec(TOPs);
{
dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
{
- register unsigned long tmpulong;
- register long tmplong;
- I32 value;
+ register IV value;
+ register UV uval;
- tmpulong = (unsigned long) POPn;
- if (tmpulong == 0L)
+ uval = POPn;
+ if (!uval)
DIE("Illegal modulus zero");
value = TOPn;
- if (value >= 0.0)
- value = (I32)(((unsigned long)value) % tmpulong);
+ if (value >= 0)
+ value = (UV)value % uval;
else {
- tmplong = (long)value;
- value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
+ value = (uval - ((UV)(-value - 1) % uval)) - 1;
}
SETi(value);
RETURN;
if (SvNIOKp(left) || SvNIOKp(right)) {
unsigned long value = U_L(SvNV(left));
value = value & U_L(SvNV(right));
- SETn((double)value);
+ if ((IV)value == value)
+ SETi(value);
+ else
+ SETn((double)value);
}
else {
do_vop(op->op_type, TARG, left, right);
if (SvNIOKp(left) || SvNIOKp(right)) {
unsigned long value = U_L(SvNV(left));
value = value ^ U_L(SvNV(right));
- SETn((double)value);
+ if ((IV)value == value)
+ SETi(value);
+ else
+ SETn((double)value);
}
else {
do_vop(op->op_type, TARG, left, right);
if (SvNIOKp(left) || SvNIOKp(right)) {
unsigned long value = U_L(SvNV(left));
value = value | U_L(SvNV(right));
- SETn((double)value);
+ if ((IV)value == value)
+ SETi(value);
+ else
+ SETn((double)value);
}
else {
do_vop(op->op_type, TARG, left, right);
register I32 anum;
if (SvNIOKp(sv)) {
- IV iv = ~SvIV(sv);
- if (iv < 0)
- SETn( (double) ~U_L(SvNV(sv)) );
+ UV value = ~SvIV(sv);
+ if ((IV)value == value)
+ SETi(value);
else
- SETi( iv );
+ SETn((double)value);
}
else {
register char *tmps;
{
dSP;
I32 anum;
- Time_t when;
if (MAXARG < 1) {
+#ifdef VMS
+# include <starlet.h>
+ unsigned int when[2];
+ _ckvmssts(sys$gettim(when));
+ anum = when[0] ^ when[1];
+#else
+# if defined(I_SYS_TIME) && !defined(PLAN9)
+ struct timeval when;
+ gettimeofday(&when,(struct timezone *) 0);
+ anum = when.tv_sec ^ when.tv_usec;
+# else
+ Time_t when;
(void)time(&when);
anum = 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));
+#endif
}
else
anum = POPi;
rem = len;
sv_setpvn(TARG, tmps, rem);
if (lvalue) { /* it's an lvalue! */
- if (!SvGMAGICAL(sv))
- (void)SvPOK_only(sv);
+ if (!SvGMAGICAL(sv)) {
+ if (SvROK(sv)) {
+ SvPV_force(sv,na);
+ if (dowarn)
+ warn("Attempt to use reference as lvalue in substr");
+ }
+ if (SvOK(sv)) /* is it defined ? */
+ (void)SvPOK_only(sv);
+ else
+ sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
+ }
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
sv_magic(TARG, Nullsv, 'x', Nullch, 0);
dSP; dTARGET;
HV *hash = (HV*)POPs;
HE *entry;
- I32 i;
- char *tmps;
PUTBACK;
entry = hv_iternext(hash); /* might clobber stack_sp */
EXTEND(SP, 2);
if (entry) {
- tmps = hv_iterkey(entry, &i); /* won't clobber stack_sp */
- if (!i)
- tmps = "";
- PUSHs(sv_2mortal(newSVpv(tmps, i)));
+ PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
if (GIMME == G_ARRAY) {
PUTBACK;
sv_setsv(TARG, hv_iterval(hash, entry)); /* might clobber stack_sp */
SV *sv;
SV *tmpsv = POPs;
HV *hv = (HV*)POPs;
- char *tmps;
STRLEN len;
if (SvTYPE(hv) != SVt_PVHV) {
DIE("Not a HASH reference");
}
- tmps = SvPV(tmpsv, len);
- sv = hv_delete(hv, tmps, len,
- op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0);
+ sv = hv_delete_ent(hv, tmpsv,
+ (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0);
if (!sv)
RETPUSHUNDEF;
PUSHs(sv);
dSP;
SV *tmpsv = POPs;
HV *hv = (HV*)POPs;
- char *tmps;
STRLEN len;
if (SvTYPE(hv) != SVt_PVHV) {
DIE("Not a HASH reference");
}
- tmps = SvPV(tmpsv, len);
- if (hv_exists(hv, tmps, len))
+ if (hv_exists_ent(hv, tmpsv, 0))
RETPUSHYES;
RETPUSHNO;
}
PP(pp_hslice)
{
dSP; dMARK; dORIGMARK;
- register SV **svp;
+ register HE *he;
register HV *hv = (HV*)POPs;
register I32 lval = op->op_flags & OPf_MOD;
if (SvTYPE(hv) == SVt_PVHV) {
while (++MARK <= SP) {
- STRLEN keylen;
- char *key = SvPV(*MARK, keylen);
+ SV *keysv = *MARK;
- svp = hv_fetch(hv, key, keylen, lval);
+ he = hv_fetch_ent(hv, keysv, lval, 0);
if (lval) {
- if (!svp || *svp == &sv_undef)
- DIE(no_helem, key);
+ if (!he || HeVAL(he) == &sv_undef)
+ DIE(no_helem, SvPV(keysv, na));
if (op->op_private & OPpLVAL_INTRO)
- save_svref(svp);
+ save_svref(&HeVAL(he));
}
- *MARK = svp ? *svp : &sv_undef;
+ *MARK = he ? HeVAL(he) : &sv_undef;
}
}
if (GIMME != G_ARRAY) {
while (MARK < SP) {
SV* key = *++MARK;
- char *tmps;
SV *val = NEWSV(46, 0);
if (MARK < SP)
sv_setsv(val, *++MARK);
else
warn("Odd number of elements in hash list");
- tmps = SvPV(key,len);
- (void)hv_store(hv,tmps,len,val,0);
+ (void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
XPUSHs((SV*)hv);
Copy(s, &auint, 1, unsigned int);
s += sizeof(unsigned int);
sv = NEWSV(41, 0);
- sv_setiv(sv, (I32)auint);
+ if (auint <= I32_MAX)
+ sv_setiv(sv, (I32)auint);
+ else
+ sv_setnv(sv, (double)auint);
PUSHs(sv_2mortal(sv));
}
}
PUSHs(sv_2mortal(sv));
}
break;
+ case 'w':
+ along = (strend - s) / sizeof(char);
+ if (len > along)
+ len = along;
+ EXTEND(SP, len);
+ {
+ I8 bytes = 0;
+
+ auint = 0;
+ while (len > 0) {
+ if (s >= strend) {
+ if (auint) {
+ DIE("Unterminated compressed integer");
+ } else {
+ break;
+ }
+ }
+ auint = (auint << 7) | (*s & 0x7f);
+ if (!(*s & 0x80)) {
+ sv = NEWSV(40, 0);
+ sv_setiv(sv, (I32) auint);
+ PUSHs(sv_2mortal(sv));
+ len--;
+ auint = 0;
+ bytes = 0;
+ } else if (++bytes >= sizeof(auint)) { /* promote to double */
+ adouble = auint;
+
+ while (*s & 0x80) {
+ adouble = (adouble * 128) + (*(++s) & 0x7f);
+ if (s >= strend) {
+ DIE("Unterminated compressed integer");
+ }
+ }
+ sv = NEWSV(40, 0);
+ sv_setnv(sv, adouble);
+ PUSHs(sv_2mortal(sv));
+ len--;
+ auint = 0;
+ bytes = 0;
+ }
+ s++;
+ }
+ }
+ break;
case 'P':
EXTEND(SP, 1);
if (sizeof(char*) > strend - s)
case 'u':
along = (strend - s) * 3 / 4;
sv = NEWSV(42, along);
+ if (along)
+ SvPOK_on(sv);
while (s < strend && *s > ' ' && *s < 'a') {
I32 a, b, c, d;
char hunk[4];
sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
}
break;
+ case 'w':
+ while (len-- > 0) {
+ fromstr = NEXTFROM;
+ adouble = floor((double)SvNV(fromstr));
+
+ if (adouble < 268435456) { /* we can use integers */
+ unsigned char buf[4]; /* buffer for compressed int */
+ unsigned char *in = buf + 3;
+ auint = U_I(adouble);
+ do {
+ *(in--) = (unsigned char) ((auint & 0x7f) | 0x80);
+ auint >>= 7;
+ } while (auint);
+ buf[3] &= 0x7f; /* clear continue bit */
+ sv_catpvn(cat, (char*) in+1, buf+3-in);
+ } else {
+ unsigned char buf[sizeof(double)*2]; /* buffer for compressed int */
+ I8 msize = sizeof(double)*2; /* 8/7 would be enough */
+ unsigned char *in = buf + msize -1;
+ if (adouble<0) {
+ croak("Cannot compress negative numbers");
+ }
+ do {
+ double next = adouble/128;
+ *in = (unsigned char) (adouble - floor(next)*128);
+ *in |= 0x80; /* set continue bit */
+ if (--in < buf) { /* this cannot happen ;-) */
+ croak ("Cannot compress integer");
+ }
+ adouble = next;
+ } while (floor(adouble)>0); /* floor() not necessary? */
+ buf[msize-1] &= 0x7f; /* clear continue bit */
+ sv_catpvn(cat, (char*) in+1, buf+msize-in-1);
+ }
+ }
+ break;
case 'i':
while (len-- > 0) {
fromstr = NEXTFROM;
I32 origlimit = limit;
I32 realarray = 0;
I32 base;
- AV *oldstack = stack;
+ AV *oldstack = curstack;
register REGEXP *rx = pm->op_pmregexp;
I32 gimme = GIMME;
I32 oldsave = savestack_ix;
av_extend(ary,0);
av_clear(ary);
/* temporarily switch stacks */
- SWITCHSTACK(stack, ary);
+ SWITCHSTACK(curstack, ary);
}
base = SP - stack_base;
orig = s;
iters++;
}
else if (!origlimit) {
- while (iters > 0 && SvCUR(TOPs) == 0)
+ while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
iters--, SP--;
}
if (realarray) {