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 {
GP *ogp = GvGP(sv);
SSCHECK(3);
- SSPUSHPTR(sv);
+ SSPUSHPTR(SvREFCNT_inc(sv));
SSPUSHPTR(ogp);
SSPUSHINT(SAVEt_GP);
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);
RETURN;
}
-PP(pp_sv2len)
-{
- dSP; dTARGET;
- dPOPss;
- PUSHi(sv_len(sv));
- RETURN;
-}
-
PP(pp_rv2sv)
{
dSP; dTOPss;
}
}
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);
}
if (op->op_flags & OPf_MOD) {
if (op->op_private & OPpLVAL_INTRO)
sv = save_scalar((GV*)TOPs);
- else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
- if (SvGMAGICAL(sv))
- mg_get(sv);
- if (!SvOK(sv)) {
- (void)SvUPGRADE(sv, SVt_RV);
- SvRV(sv) = (op->op_private & OPpDEREF_HV ?
- (SV*)newHV() : (SV*)newAV());
- SvROK_on(sv);
- SvSETMAGIC(sv);
- }
- }
+ else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
+ provide_ref(op, sv);
}
SETs(sv);
RETURN;
GV *gv;
HV *stash;
- /* We always try to add a non-existent subroutine in case of AUTOLOAD. */
- CV *cv = sv_2cv(TOPs, &stash, &gv, TRUE);
+ /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
+ /* (But not in defined().) */
+ CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
+ if (!cv)
+ cv = (CV*)&sv_undef;
SETs((SV*)cv);
RETURN;
}
+PP(pp_prototype)
+{
+ dSP;
+ CV *cv;
+ HV *stash;
+ GV *gv;
+ SV *ret;
+
+ ret = &sv_undef;
+ cv = sv_2cv(TOPs, &stash, &gv, FALSE);
+ if (cv && SvPOK(cv)) {
+ char *p = SvPVX(cv);
+ ret = sv_2mortal(newSVpv(p ? p : "", SvLEN(cv)));
+ }
+ SETs(ret);
+ RETURN;
+}
+
PP(pp_anoncode)
{
dSP;
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;
MARK[1] = *SP;
SP = MARK + 1;
}
+ EXTEND_MORTAL(SP - MARK);
while (MARK < SP) {
sv = *++MARK;
rv = sv_newmortal();
char *pv;
sv = POPs;
+
+ if (sv && SvGMAGICAL(sv))
+ mg_get(sv);
+
if (!sv || !SvROK(sv))
- RETPUSHUNDEF;
+ RETPUSHNO;
sv = SvRV(sv);
pv = sv_reftype(sv,TRUE);
PP(pp_study)
{
- dSP; dTARGET;
+ dSP; dPOPss;
register unsigned char *s;
register I32 pos;
register I32 ch;
I32 retval;
STRLEN len;
- s = (unsigned char*)(SvPV(TARG, len));
+ s = (unsigned char*)(SvPV(sv, len));
pos = len;
- if (lastscream)
- SvSCREAM_off(lastscream);
- lastscream = TARG;
+ if (sv == lastscream)
+ SvSCREAM_off(sv);
+ else {
+ if (lastscream) {
+ SvSCREAM_off(lastscream);
+ SvREFCNT_dec(lastscream);
+ }
+ lastscream = SvREFCNT_inc(sv);
+ }
if (pos <= 0) {
retval = 0;
goto ret;
else
snext[pos] = -pos;
sfirst[ch] = pos;
-
- /* If there were any case insensitive searches, we must assume they
- * all are. This speeds up insensitive searches much more than
- * it slows down sensitive ones.
- */
- if (sawi)
- sfirst[fold[ch]] = pos;
}
- SvSCREAM_on(TARG);
+ SvSCREAM_on(sv);
+ sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */
retval = 1;
ret:
XPUSHs(sv_2mortal(newSViv((I32)retval)));
RETPUSHNO;
switch (SvTYPE(sv)) {
case SVt_PVAV:
- if (AvMAX(sv) >= 0)
+ if (AvMAX(sv) >= 0 || SvRMAGICAL(sv))
RETPUSHYES;
break;
case SVt_PVHV:
- if (HvARRAY(sv))
+ if (HvARRAY(sv) || SvRMAGICAL(sv))
RETPUSHYES;
break;
case SVt_PVCV:
cv_undef((CV*)sv);
sub_generation++;
break;
+ case SVt_PVGV:
+ if (SvFAKE(sv)) {
+ sv_setsv(sv, &sv_undef);
+ break;
+ }
default:
- if (sv != GvSV(defgv)) {
- if (SvPOK(sv) && SvLEN(sv)) {
- (void)SvOOK_off(sv);
- Safefree(SvPVX(sv));
- SvPV_set(sv, Nullch);
- SvLEN_set(sv, 0);
- }
- (void)SvOK_off(sv);
- SvSETMAGIC(sv);
+ if (SvPOK(sv) && SvLEN(sv)) {
+ (void)SvOOK_off(sv);
+ Safefree(SvPVX(sv));
+ SvPV_set(sv, Nullch);
+ SvLEN_set(sv, 0);
}
+ (void)SvOK_off(sv);
+ SvSETMAGIC(sv);
}
RETPUSHUNDEF;
PP(pp_predec)
{
dSP;
- if (SvIOK(TOPs)) {
+ if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+ SvIVX(TOPs) != IV_MIN)
+ {
--SvIVX(TOPs);
- SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+ SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else
sv_dec(TOPs);
{
dSP; dTARGET;
sv_setsv(TARG, TOPs);
- if (SvIOK(TOPs)) {
+ if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+ SvIVX(TOPs) != IV_MAX)
+ {
++SvIVX(TOPs);
- SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+ SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else
sv_inc(TOPs);
{
dSP; dTARGET;
sv_setsv(TARG, TOPs);
- if (SvIOK(TOPs)) {
+ if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+ SvIVX(TOPs) != IV_MIN)
+ {
--SvIVX(TOPs);
- SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+ SvFLAGS(TOPs) &= ~(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;
{
dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
{
- dPOPTOPiirl;
- SETi( left << right );
- RETURN;
+ IV shift = POPi;
+ if (op->op_private & HINT_INTEGER) {
+ IV i = TOPi;
+ SETi( i << shift );
+ }
+ else {
+ UV u = TOPu;
+ SETu( u << shift );
+ }
+ RETURN;
}
}
{
dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
{
- dPOPTOPiirl;
- SETi( left >> right );
+ IV shift = POPi;
+ if (op->op_private & HINT_INTEGER) {
+ IV i = TOPi;
+ SETi( i >> shift );
+ }
+ else {
+ UV u = TOPu;
+ SETu( u >> shift );
+ }
RETURN;
}
}
dSP; tryAMAGICbinSET(slt,0);
{
dPOPTOPssrl;
- SETs( sv_cmp(left, right) < 0 ? &sv_yes : &sv_no );
+ int cmp = ((op->op_private & OPpLOCALE)
+ ? sv_cmp_locale(left, right)
+ : sv_cmp(left, right));
+ SETs( cmp < 0 ? &sv_yes : &sv_no );
RETURN;
}
}
dSP; tryAMAGICbinSET(sgt,0);
{
dPOPTOPssrl;
- SETs( sv_cmp(left, right) > 0 ? &sv_yes : &sv_no );
+ int cmp = ((op->op_private & OPpLOCALE)
+ ? sv_cmp_locale(left, right)
+ : sv_cmp(left, right));
+ SETs( cmp > 0 ? &sv_yes : &sv_no );
RETURN;
}
}
dSP; tryAMAGICbinSET(sle,0);
{
dPOPTOPssrl;
- SETs( sv_cmp(left, right) <= 0 ? &sv_yes : &sv_no );
+ int cmp = ((op->op_private & OPpLOCALE)
+ ? sv_cmp_locale(left, right)
+ : sv_cmp(left, right));
+ SETs( cmp <= 0 ? &sv_yes : &sv_no );
RETURN;
}
}
dSP; tryAMAGICbinSET(sge,0);
{
dPOPTOPssrl;
- SETs( sv_cmp(left, right) >= 0 ? &sv_yes : &sv_no );
+ int cmp = ((op->op_private & OPpLOCALE)
+ ? sv_cmp_locale(left, right)
+ : sv_cmp(left, right));
+ SETs( cmp >= 0 ? &sv_yes : &sv_no );
RETURN;
}
}
dSP; tryAMAGICbinSET(sne,0);
{
dPOPTOPssrl;
- SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
+ bool ne = ((op->op_private & OPpLOCALE)
+ ? (sv_cmp_locale(left, right) != 0)
+ : !sv_eq(left, right));
+ SETs( ne ? &sv_yes : &sv_no );
RETURN;
}
}
dSP; dTARGET; tryAMAGICbin(scmp,0);
{
dPOPTOPssrl;
- SETi( sv_cmp(left, right) );
+ int cmp = ((op->op_private & OPpLOCALE)
+ ? sv_cmp_locale(left, right)
+ : sv_cmp(left, right));
+ SETi( cmp );
RETURN;
}
}
-PP(pp_bit_and) {
+PP(pp_bit_and)
+{
dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
{
dPOPTOPssrl;
- if (SvNIOK(left) || SvNIOK(right)) {
- unsigned long value = U_L(SvNV(left));
- value = value & U_L(SvNV(right));
- SETn((double)value);
+ if (SvNIOKp(left) || SvNIOKp(right)) {
+ UV value = SvUV(left) & SvUV(right);
+ if (op->op_private & HINT_INTEGER)
+ SETi( (IV)value );
+ else
+ SETu( value );
}
else {
do_vop(op->op_type, TARG, left, right);
dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
{
dPOPTOPssrl;
- if (SvNIOK(left) || SvNIOK(right)) {
- unsigned long value = U_L(SvNV(left));
- value = value ^ U_L(SvNV(right));
- SETn((double)value);
+ if (SvNIOKp(left) || SvNIOKp(right)) {
+ UV value = SvUV(left) ^ SvUV(right);
+ if (op->op_private & HINT_INTEGER)
+ SETi( (IV)value );
+ else
+ SETu( value );
}
else {
do_vop(op->op_type, TARG, left, right);
dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
{
dPOPTOPssrl;
- if (SvNIOK(left) || SvNIOK(right)) {
- unsigned long value = U_L(SvNV(left));
- value = value | U_L(SvNV(right));
- SETn((double)value);
+ if (SvNIOKp(left) || SvNIOKp(right)) {
+ UV value = SvUV(left) | SvUV(right);
+ if (op->op_private & HINT_INTEGER)
+ SETi( (IV)value );
+ else
+ SETu( value );
}
else {
do_vop(op->op_type, TARG, left, right);
dSP; dTARGET; tryAMAGICun(neg);
{
dTOPss;
- if (SvNIOK(sv))
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
+ if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN)
+ SETi(-SvIVX(sv));
+ else if (SvNIOKp(sv))
SETn(-SvNV(sv));
- else if (SvPOK(sv)) {
+ else if (SvPOKp(sv)) {
STRLEN len;
char *s = SvPV(sv, len);
- if (isALPHA(*s) || *s == '_') {
+ if (isIDFIRST(*s)) {
sv_setpvn(TARG, "-", 1);
sv_catsv(TARG, sv);
}
sv_setnv(TARG, -SvNV(sv));
SETTARG;
}
+ else
+ SETn(-SvNV(sv));
}
RETURN;
}
dSP; dTARGET; tryAMAGICun(compl);
{
dTOPss;
- register I32 anum;
-
- if (SvNIOK(sv)) {
- IV iv = ~SvIV(sv);
- if (iv < 0)
- SETn( (double) ~U_L(SvNV(sv)) );
+ if (SvNIOKp(sv)) {
+ UV value = ~SvUV(sv);
+ if (op->op_private & HINT_INTEGER)
+ SETi( (IV)value );
else
- SETi( iv );
+ SETu( value );
}
else {
register char *tmps;
register long *tmpl;
+ register I32 anum;
STRLEN len;
SvSetSV(TARG, sv);
{
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;
{
double value;
value = POPn;
- if (value <= 0.0)
+ if (value <= 0.0) {
+ NUMERIC_STANDARD();
DIE("Can't take log of %g", value);
+ }
value = log(value);
XPUSHn(value);
RETURN;
{
double value;
value = POPn;
- if (value < 0.0)
+ if (value < 0.0) {
+ NUMERIC_STANDARD();
DIE("Can't take sqrt of %g", value);
+ }
value = sqrt(value);
XPUSHn(value);
RETURN;
I32 argtype;
tmps = POPp;
- XPUSHi( scan_hex(tmps, 99, &argtype) );
+ XPUSHu(scan_hex(tmps, 99, &argtype));
RETURN;
}
PP(pp_oct)
{
dSP; dTARGET;
- I32 value;
+ UV value;
I32 argtype;
char *tmps;
tmps = POPp;
- while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
+ while (*tmps && isSPACE(*tmps))
+ tmps++;
+ if (*tmps == '0')
tmps++;
if (*tmps == 'x')
- value = (I32)scan_hex(++tmps, 99, &argtype);
+ value = scan_hex(++tmps, 99, &argtype);
else
- value = (I32)scan_oct(tmps, 99, &argtype);
- XPUSHi(value);
+ value = scan_oct(tmps, 99, &argtype);
+ XPUSHu(value);
RETURN;
}
rem = len;
sv_setpvn(TARG, tmps, rem);
if (lvalue) { /* it's an lvalue! */
- (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);
PP(pp_sprintf)
{
dSP; dMARK; dORIGMARK; dTARGET;
+#ifdef LC_NUMERIC
+ if (op->op_private & OPpLOCALE)
+ NUMERIC_LOCAL();
+ else
+ NUMERIC_STANDARD();
+#endif /* LC_NUMERIC */
do_sprintf(TARG, SP-MARK, MARK+1);
+ TAINT_IF(SvTAINTED(TARG));
SP = ORIGMARK;
PUSHTARG;
RETURN;
SETs(sv);
}
s = SvPV_force(sv, na);
- if (isLOWER(*s))
- *s = toUPPER(*s);
+ if (*s) {
+ if (op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ *s = toUPPER_LC(*s);
+ }
+ else
+ *s = toUPPER(*s);
+ }
RETURN;
}
SETs(sv);
}
s = SvPV_force(sv, na);
- if (isUPPER(*s))
- *s = toLOWER(*s);
+ if (*s) {
+ if (op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ *s = toLOWER_LC(*s);
+ }
+ else
+ *s = toLOWER(*s);
+ }
SETs(sv);
RETURN;
dSP;
SV *sv = TOPs;
register char *s;
- register char *send;
STRLEN len;
if (!SvPADTMP(sv)) {
sv = TARG;
SETs(sv);
}
+
s = SvPV_force(sv, len);
- send = s + len;
- while (s < send) {
- if (isLOWER(*s))
- *s = toUPPER(*s);
- s++;
+ if (len) {
+ register char *send = s + len;
+
+ if (op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ for (; s < send; s++)
+ *s = toUPPER_LC(*s);
+ }
+ else {
+ for (; s < send; s++)
+ *s = toUPPER(*s);
+ }
}
RETURN;
}
dSP;
SV *sv = TOPs;
register char *s;
- register char *send;
STRLEN len;
if (!SvPADTMP(sv)) {
sv = TARG;
SETs(sv);
}
+
s = SvPV_force(sv, len);
- send = s + len;
- while (s < send) {
- if (isUPPER(*s))
- *s = toLOWER(*s);
- s++;
+ if (len) {
+ register char *send = s + len;
+
+ if (op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ for (; s < send; s++)
+ *s = toLOWER_LC(*s);
+ }
+ else {
+ for (; s < send; s++)
+ *s = toLOWER(*s);
+ }
}
RETURN;
}
if (len) {
(void)SvUPGRADE(TARG, SVt_PV);
- SvGROW(TARG, len * 2);
+ SvGROW(TARG, (len * 2) + 1);
d = SvPVX(TARG);
while (len--) {
if (!isALNUM(*s))
{
dSP; dTARGET;
HV *hash = (HV*)POPs;
- HE *entry = hv_iternext(hash);
- I32 i;
- char *tmps;
+ HE *entry;
+
+ PUTBACK;
+ entry = hv_iternext(hash); /* might clobber stack_sp */
+ SPAGAIN;
EXTEND(SP, 2);
if (entry) {
- tmps = hv_iterkey(entry, &i);
- if (!i)
- tmps = "";
- PUSHs(sv_2mortal(newSVpv(tmps, i)));
+ PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
if (GIMME == G_ARRAY) {
- sv_setsv(TARG, hv_iterval(hash, entry));
+ PUTBACK;
+ sv_setsv(TARG, hv_iterval(hash, entry)); /* might clobber stack_sp */
+ SPAGAIN;
PUSHs(TARG);
}
}
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) {
SV **firstlelem = stack_base + POPMARK + 1;
register SV **firstrelem = lastlelem + 1;
I32 arybase = curcop->cop_arybase;
+ I32 lval = op->op_flags & OPf_MOD;
+ I32 is_something_there = lval;
register I32 max = lastrelem - lastlelem;
register SV **lelem;
if (ix >= max || !(*lelem = firstrelem[ix]))
*lelem = &sv_undef;
}
+ if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem)))
+ is_something_there = TRUE;
}
- SP = lastlelem;
+ if (is_something_there)
+ SP = lastlelem;
+ else
+ SP = firstlelem - 1;
RETURN;
}
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);
MEXTEND(MARK, length);
Copy(AvARRAY(ary)+offset, MARK, length, SV*);
if (AvREAL(ary)) {
+ EXTEND_MORTAL(length);
for (i = length, dst = MARK; i; i--)
sv_2mortal(*dst++); /* free them eventualy */
}
if (length) {
Copy(tmparyval, MARK, length, SV*);
if (AvREAL(ary)) {
+ EXTEND_MORTAL(length);
for (i = length, dst = MARK; i; i--)
sv_2mortal(*dst++); /* free them eventualy */
}
RETURN;
}
+static SV *
+mul128(sv, m)
+ SV *sv;
+ U8 m;
+{
+ STRLEN len;
+ char *s = SvPV(sv, len);
+ char *t;
+ U32 i = 0;
+
+ if (!strnEQ(s, "0000", 4)) { /* need to grow sv */
+ SV *new = newSVpv("0000000000", 10);
+
+ sv_catsv(new, sv);
+ SvREFCNT_dec(sv); /* free old sv */
+ sv = new;
+ s = SvPV(sv, len);
+ }
+ t = s + len - 1;
+ while (!*t) /* trailing '\0'? */
+ t--;
+ while (t > s) {
+ i = ((*t - '0') << 7) + m;
+ *(t--) = '0' + (i % 10);
+ m = i / 10;
+ }
+ return (sv);
+}
+
/* Explosives and implosives. */
PP(pp_unpack)
}
else {
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
aint = *s++;
if (aint >= 128) /* fake up signed chars */
}
else {
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
auint = *s++ & 255;
sv = NEWSV(37, 0);
}
else {
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
Copy(s, &ashort, 1, I16);
s += sizeof(I16);
}
else {
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
Copy(s, &aushort, 1, U16);
s += sizeof(U16);
}
else {
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
Copy(s, &aint, 1, int);
s += sizeof(int);
}
else {
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
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));
}
}
}
else {
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
Copy(s, &along, 1, I32);
s += sizeof(I32);
}
else {
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
Copy(s, &aulong, 1, U32);
s += sizeof(U32);
if (len > along)
len = along;
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
if (sizeof(char*) > strend - s)
break;
PUSHs(sv_2mortal(sv));
}
break;
+ case 'w':
+ EXTEND(SP, len);
+ EXTEND_MORTAL(len);
+ {
+ UV auv = 0;
+ U32 bytes = 0;
+
+ while ((len > 0) && (s < strend)) {
+ auv = (auv << 7) | (*s & 0x7f);
+ if (!(*s++ & 0x80)) {
+ bytes = 0;
+ sv = NEWSV(40, 0);
+ sv_setuv(sv, auv);
+ PUSHs(sv_2mortal(sv));
+ len--;
+ auv = 0;
+ }
+ else if (++bytes >= sizeof(UV)) { /* promote to string */
+ char decn[sizeof(UV) * 3 + 1];
+ char *t;
+
+ (void) sprintf(decn, "%0*ld", sizeof(decn) - 1, auv);
+ sv = newSVpv(decn, 0);
+ while (s < strend) {
+ sv = mul128(sv, *s & 0x7f);
+ if (!(*s++ & 0x80)) {
+ bytes = 0;
+ break;
+ }
+ }
+ t = SvPV(sv, na);
+ while (*t == '0')
+ t++;
+ sv_chop(sv, t);
+ PUSHs(sv_2mortal(sv));
+ len--;
+ auv = 0;
+ }
+ }
+ if ((s >= strend) && bytes)
+ croak("Unterminated compressed integer");
+ }
+ break;
case 'P':
EXTEND(SP, 1);
if (sizeof(char*) > strend - s)
#ifdef HAS_QUAD
case 'q':
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
if (s + sizeof(Quad_t) > strend)
aquad = 0;
break;
case 'Q':
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
if (s + sizeof(unsigned Quad_t) > strend)
auquad = 0;
}
else {
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
Copy(s, &afloat, 1, float);
s += sizeof(float);
}
else {
EXTEND(SP, len);
+ EXTEND_MORTAL(len);
while (len-- > 0) {
Copy(s, &adouble, 1, double);
s += sizeof(double);
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(sv, "\n", 1);
}
+static SV *
+is_an_int(s, l)
+ char *s;
+ STRLEN l;
+{
+ SV *result = newSVpv("", l);
+ char *result_c = SvPV(result, na); /* convenience */
+ char *out = result_c;
+ bool skip = 1;
+ bool ignore = 0;
+
+ while (*s) {
+ switch (*s) {
+ case ' ':
+ break;
+ case '+':
+ if (!skip) {
+ SvREFCNT_dec(result);
+ return (NULL);
+ }
+ break;
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ skip = 0;
+ if (!ignore) {
+ *(out++) = *s;
+ }
+ break;
+ case '.':
+ ignore = 1;
+ break;
+ default:
+ SvREFCNT_dec(result);
+ return (NULL);
+ }
+ s++;
+ }
+ *(out++) = '\0';
+ SvCUR_set(result, out - result_c);
+ return (result);
+}
+
+static int
+div128(pnum, done)
+ SV *pnum; /* must be '\0' terminated */
+ bool *done;
+{
+ STRLEN len;
+ char *s = SvPV(pnum, len);
+ int m = 0;
+ int r = 0;
+ char *t = s;
+
+ *done = 1;
+ while (*t) {
+ int i;
+
+ i = m * 10 + (*t - '0');
+ m = i & 0x7F;
+ r = (i >> 7); /* r < 10 */
+ if (r) {
+ *done = 0;
+ }
+ *(t++) = '0' + r;
+ }
+ *(t++) = '\0';
+ SvCUR_set(pnum, (STRLEN) (t - s));
+ return (m);
+}
+
+
PP(pp_pack)
{
dSP; dMARK; dORIGMARK; dTARGET;
sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
}
break;
+ case 'w':
+ while (len-- > 0) {
+ fromstr = NEXTFROM;
+ adouble = floor(SvNV(fromstr));
+
+ if (adouble < 0)
+ croak("Cannot compress negative numbers");
+
+ if (adouble <= UV_MAX) {
+ char buf[1 + sizeof(UV)];
+ char *in = buf + sizeof(buf);
+ UV auv = U_V(adouble);;
+
+ do {
+ *--in = (auv & 0x7f) | 0x80;
+ auv >>= 7;
+ } while (auv);
+ buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
+ sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
+ }
+ else if (SvPOKp(fromstr)) { /* decimal string arithmetics */
+ char *from, *result, *in;
+ SV *norm;
+ STRLEN len;
+ bool done;
+
+ /* Copy string and check for compliance */
+ from = SvPV(fromstr, len);
+ if ((norm = is_an_int(from, len)) == NULL)
+ croak("can compress only unsigned integer");
+
+ New('w', result, len, char);
+ in = result + len;
+ done = FALSE;
+ while (!done)
+ *--in = div128(norm, &done) | 0x80;
+ result[len - 1] &= 0x7F; /* clear continue bit */
+ sv_catpvn(cat, in, (result + len) - in);
+ SvREFCNT_dec(norm); /* free norm */
+ }
+ else if (SvNOKp(fromstr)) {
+ char buf[sizeof(double) * 2]; /* 8/7 <= 2 */
+ char *in = buf + sizeof(buf);
+
+ do {
+ double next = floor(adouble / 128);
+ *--in = (unsigned char)(adouble - (next * 128)) | 0x80;
+ if (--in < buf) /* this cannot happen ;-) */
+ croak ("Cannot compress integer");
+ adouble = next;
+ } while (adouble > 0);
+ buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
+ sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
+ }
+ else
+ croak("Cannot compress non integer");
+ }
+ 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;
if (!pm || !s)
DIE("panic: do_split");
+
+ TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
+ (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
+
if (pm->op_pmreplroot)
ary = GvAVn((GV*)pm->op_pmreplroot);
else if (gimme != G_ARRAY)
av_extend(ary,0);
av_clear(ary);
/* temporarily switch stacks */
- SWITCHSTACK(stack, ary);
+ SWITCHSTACK(curstack, ary);
}
base = SP - stack_base;
orig = s;
if (pm->op_pmflags & PMf_SKIPWHITE) {
- while (isSPACE(*s))
- s++;
+ if (pm->op_pmflags & PMf_LOCALE) {
+ while (isSPACE_LC(*s))
+ s++;
+ }
+ else {
+ while (isSPACE(*s))
+ s++;
+ }
+ }
+ if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+ SAVEINT(multiline);
+ multiline = pm->op_pmflags & PMf_MULTILINE;
}
+
if (!limit)
limit = maxiters + 2;
if (pm->op_pmflags & PMf_WHITE) {
while (--limit) {
- /*SUPPRESS 530*/
- for (m = s; m < strend && !isSPACE(*m); m++) ;
+ m = s;
+ while (m < strend &&
+ !((pm->op_pmflags & PMf_LOCALE)
+ ? isSPACE_LC(*m) : isSPACE(*m)))
+ ++m;
if (m >= strend)
break;
+
dstr = NEWSV(30, m-s);
sv_setpvn(dstr, s, m-s);
if (!realarray)
sv_2mortal(dstr);
XPUSHs(dstr);
- /*SUPPRESS 530*/
- for (s = m + 1; s < strend && isSPACE(*s); s++) ;
+
+ s = m + 1;
+ while (s < strend &&
+ ((pm->op_pmflags & PMf_LOCALE)
+ ? isSPACE_LC(*s) : isSPACE(*s)))
+ ++s;
}
}
else if (strEQ("^", rx->precomp)) {
else if (pm->op_pmshort) {
i = SvCUR(pm->op_pmshort);
if (i == 1) {
- I32 fold = (pm->op_pmflags & PMf_FOLD);
i = *SvPVX(pm->op_pmshort);
- if (fold && isUPPER(i))
- i = toLOWER(i);
while (--limit) {
- if (fold) {
- for ( m = s;
- m < strend && *m != i &&
- (!isUPPER(*m) || toLOWER(*m) != i);
- m++) /*SUPPRESS 530*/
- ;
- }
- else /*SUPPRESS 530*/
- for (m = s; m < strend && *m != i; m++) ;
+ /*SUPPRESS 530*/
+ for (m = s; m < strend && *m != i; m++) ;
if (m >= strend)
break;
dstr = NEWSV(30, m-s);
else {
maxiters += (strend - s) * rx->nparens;
while (s < strend && --limit &&
- regexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
+ pregexec(rx, s, strend, orig, 1, Nullsv, TRUE))
+ {
+ TAINT_IF(rx->exec_tainted);
if (rx->subbase
&& rx->subbase != orig) {
m = s;
s = rx->endp[0];
}
}
+ LEAVE_SCOPE(oldsave);
iters = (SP - stack_base) - base;
if (iters > maxiters)
DIE("Split loop");
iters++;
}
else if (!origlimit) {
- while (iters > 0 && SvCUR(TOPs) == 0)
+ while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
iters--, SP--;
}
if (realarray) {
projects / p5sagit/p5-mst-13.2.git / blobdiff