summaryrefslogtreecommitdiff
path: root/pp.c
diff options
context:
space:
mode:
authorLarry Wall <larry@netlabs.com>1993-10-10 00:00:00 +0000
committerLarry Wall <larry@netlabs.com>1993-10-10 00:00:00 +0000
commit93a17b20b6d176db3f04f51a63b0a781e5ffd11c (patch)
tree764149b1d480d5236d4d62b3228bd57f53a71042 /pp.c
parent79072805bf63abe5b5978b5928ab00d360ea3e7f (diff)
downloadperl-93a17b20b6d176db3f04f51a63b0a781e5ffd11c.tar.gz
perl 5.0 alpha 3
[editor's note: the sparc executables have not been included, and emacs backup files have been removed]
Diffstat (limited to 'pp.c')
-rw-r--r--pp.c585
1 files changed, 379 insertions, 206 deletions
diff --git a/pp.c b/pp.c
index 35d2930f8a..10fb2e6c0d 100644
--- a/pp.c
+++ b/pp.c
@@ -69,6 +69,15 @@ PP(pp_null)
return NORMAL;
}
+PP(pp_stub)
+{
+ dSP;
+ if (GIMME != G_ARRAY) {
+ XPUSHs(&sv_undef);
+ }
+ RETURN;
+}
+
PP(pp_scalar)
{
return NORMAL;
@@ -106,11 +115,6 @@ PP(pp_wantarray)
RETPUSHNO;
}
-PP(pp_word)
-{
- DIE("PP_WORD");
-}
-
PP(pp_const)
{
dSP;
@@ -151,7 +155,7 @@ PP(pp_gvsv)
{
dSP;
EXTEND(sp,1);
- if (op->op_flags & OPf_LOCAL)
+ if (op->op_flags & OPf_INTRO)
PUSHs(save_scalar(cGVOP->op_gv));
else
PUSHs(GvSV(cGVOP->op_gv));
@@ -165,6 +169,39 @@ PP(pp_gv)
RETURN;
}
+PP(pp_padsv)
+{
+ dSP; dTARGET;
+ XPUSHs(TARG);
+ if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO)
+ SvOK_off(TARG);
+ RETURN;
+}
+
+PP(pp_padav)
+{
+ dSP; dTARGET;
+ XPUSHs(TARG);
+ if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO)
+ av_clear(TARG);
+ if (op->op_flags & OPf_LVAL)
+ RETURN;
+ PUTBACK;
+ return pp_rv2av();
+}
+
+PP(pp_padhv)
+{
+ dSP; dTARGET;
+ XPUSHs(TARG);
+ if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO)
+ hv_clear(TARG, FALSE);
+ if (op->op_flags & OPf_LVAL)
+ RETURN;
+ PUTBACK;
+ return pp_rv2hv();
+}
+
PP(pp_pushre)
{
dSP;
@@ -183,10 +220,13 @@ PP(pp_rv2gv)
DIE("Not a glob reference");
}
else {
- if (SvTYPE(sv) != SVt_PVGV)
+ if (SvTYPE(sv) != SVt_PVGV) {
+ if (!SvOK(sv))
+ DIE(no_usym);
sv = (SV*)gv_fetchpv(SvPVn(sv), TRUE);
+ }
}
- if (op->op_flags & OPf_LOCAL) {
+ if (op->op_flags & OPf_INTRO) {
GP *ogp = GvGP(sv);
SSCHECK(3);
@@ -232,11 +272,14 @@ PP(pp_rv2sv)
}
}
else {
- if (SvTYPE(sv) != SVt_PVGV)
+ if (SvTYPE(sv) != SVt_PVGV) {
+ if (!SvOK(sv))
+ DIE(no_usym);
sv = (SV*)gv_fetchpv(SvPVn(sv), TRUE);
+ }
sv = GvSV(sv);
}
- if (op->op_flags & OPf_LOCAL)
+ if (op->op_flags & OPf_INTRO)
SETs(save_scalar((GV*)TOPs));
else
SETs(sv);
@@ -492,7 +535,7 @@ do_readline()
SvCUR(sv)++;
for (tmps = SvPV(sv); *tmps; tmps++)
if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
- index("$&*(){}[]'\";\\|?<>~`", *tmps))
+ strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
break;
if (*tmps && stat(SvPV(sv), &statbuf) < 0) {
POPs; /* Unmatched wildcard? Chuck it... */
@@ -576,7 +619,7 @@ PP(pp_regcomp) {
if (!global && rx)
regfree(rx);
pm->op_pmregexp = Null(REGEXP*); /* crucial if regcomp aborts */
- pm->op_pmregexp = regcomp(t, t+SvCUR(tmpstr),
+ pm->op_pmregexp = regcomp(t, t + SvCUROK(tmpstr),
pm->op_pmflags & PMf_FOLD);
if (!pm->op_pmregexp->prelen && curpm)
pm = curpm;
@@ -601,17 +644,12 @@ PP(pp_match)
register char *s;
char *strend;
SV *tmpstr;
- char *myhint = hint;
I32 global;
I32 safebase;
char *truebase;
register REGEXP *rx = pm->op_pmregexp;
I32 gimme = GIMME;
- hint = Nullch;
- global = pm->op_pmflags & PMf_GLOBAL;
- safebase = (gimme == G_ARRAY) || global;
-
if (op->op_flags & OPf_STACKED)
TARG = POPs;
else {
@@ -619,7 +657,7 @@ PP(pp_match)
EXTEND(SP,1);
}
s = SvPVn(TARG);
- strend = s + SvCUR(TARG);
+ strend = s + SvCUROK(TARG);
if (!s)
DIE("panic: do_match");
@@ -634,6 +672,18 @@ PP(pp_match)
rx = pm->op_pmregexp;
}
truebase = t = s;
+ if (global = pm->op_pmflags & PMf_GLOBAL) {
+ rx->startp[0] = 0;
+ if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
+ MAGIC* mg = mg_find(TARG, 'g');
+ if (mg && mg->mg_ptr) {
+ rx->startp[0] = mg->mg_ptr;
+ rx->endp[0] = mg->mg_ptr + mg->mg_len;
+ }
+ }
+ }
+ safebase = (gimme == G_ARRAY) || global;
+
play_it_again:
if (global && rx->startp[0]) {
t = s = rx->endp[0];
@@ -642,19 +692,7 @@ play_it_again:
if (s > strend)
goto nope;
}
- if (myhint) {
- if (myhint < s || myhint > strend)
- DIE("panic: hint in do_match");
- s = myhint;
- if (rx->regback >= 0) {
- s -= rx->regback;
- if (s < t)
- s = t;
- }
- else
- s = t;
- }
- else if (pm->op_pmshort) {
+ if (pm->op_pmshort) {
if (pm->op_pmflags & PMf_SCANFIRST) {
if (SvSCREAM(TARG)) {
if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
@@ -706,13 +744,8 @@ play_it_again:
pm->op_pmflags |= PMf_USED;
goto gotcha;
}
- else {
- if (global)
- rx->startp[0] = Nullch;
- if (gimme == G_ARRAY)
- RETURN;
- RETPUSHNO;
- }
+ else
+ goto ret_no;
/*NOTREACHED*/
gotcha:
@@ -741,6 +774,17 @@ play_it_again:
RETURN;
}
else {
+ if (global) {
+ MAGIC* mg = 0;
+ if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
+ mg = mg_find(TARG, 'g');
+ if (!mg) {
+ sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
+ mg = mg_find(TARG, 'g');
+ }
+ mg->mg_ptr = rx->startp[0];
+ mg->mg_len = rx->endp[0] - rx->startp[0];
+ }
RETPUSHYES;
}
@@ -770,9 +814,19 @@ yup:
RETPUSHYES;
nope:
- rx->startp[0] = Nullch;
if (pm->op_pmshort)
++BmUSEFUL(pm->op_pmshort);
+
+ret_no:
+ if (global) {
+ if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
+ MAGIC* mg = mg_find(TARG, 'g');
+ if (mg) {
+ mg->mg_ptr = 0;
+ mg->mg_len = 0;
+ }
+ }
+ }
if (gimme == G_ARRAY)
RETURN;
RETPUSHNO;
@@ -810,7 +864,7 @@ PP(pp_subst)
if (!pm || !s)
DIE("panic: do_subst");
- strend = s + SvCUR(TARG);
+ strend = s + SvCUROK(TARG);
maxiters = (strend - s) + 10;
if (!rx->prelen && curpm) {
@@ -819,20 +873,7 @@ PP(pp_subst)
}
safebase = ((!rx || !rx->nparens) && !sawampersand);
orig = m = s;
- if (hint) {
- if (hint < s || hint > strend)
- DIE("panic: hint in do_match");
- s = hint;
- hint = Nullch;
- if (rx->regback >= 0) {
- s -= rx->regback;
- if (s < m)
- s = m;
- }
- else
- s = m;
- }
- else if (pm->op_pmshort) {
+ if (pm->op_pmshort) {
if (pm->op_pmflags & PMf_SCANFIRST) {
if (SvSCREAM(TARG)) {
if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
@@ -871,7 +912,7 @@ PP(pp_subst)
once = !(rpm->op_pmflags & PMf_GLOBAL);
if (rpm->op_pmflags & PMf_CONST) { /* known replacement string? */
c = SvPVn(dstr);
- clen = SvCUR(dstr);
+ clen = SvCUROK(dstr);
if (clen <= rx->minlen) {
/* can do inplace substitution */
if (regexec(rx, s, strend, orig, 0,
@@ -1165,7 +1206,7 @@ PP(pp_aassign)
if (*relem)
sv_setsv(tmpstr,*relem); /* value */
*(relem++) = tmpstr;
- (void)hv_store(hash,tmps,SvCUR(sv),tmpstr,0);
+ (void)hv_store(hash,tmps,SvCUROK(sv),tmpstr,0);
}
}
break;
@@ -1320,7 +1361,7 @@ PP(pp_undef)
RETPUSHUNDEF;
sv = POPs;
- if (SvREADONLY(sv))
+ if (!sv || SvREADONLY(sv))
RETPUSHUNDEF;
switch (SvTYPE(sv)) {
@@ -1330,7 +1371,7 @@ PP(pp_undef)
av_undef((AV*)sv);
break;
case SVt_PVHV:
- hv_undef((HV*)sv);
+ hv_undef((HV*)sv, TRUE);
break;
case SVt_PVCV: {
CV *cv = (CV*)sv;
@@ -1365,7 +1406,7 @@ PP(pp_study)
I32 retval;
s = (unsigned char*)(SvPVn(TARG));
- pos = SvCUR(TARG);
+ pos = SvCUROK(TARG);
if (lastscream)
SvSCREAM_off(lastscream);
lastscream = TARG;
@@ -1557,11 +1598,8 @@ PP(pp_repeat)
SvNOK_off(TARG);
sv_free(tmpstr);
}
- else {
- if (dowarn && SvPOK(SP[1]) && !looks_like_number(SP[1]))
- warn("Right operand of x is not numeric");
+ else
sv_setsv(TARG, &sv_no);
- }
PUSHTARG;
}
RETURN;
@@ -1645,15 +1683,7 @@ PP(pp_ge)
PP(pp_eq)
{
- dSP; double value;
-
- if (dowarn) {
- if ((!SvNIOK(SP[ 0]) && !looks_like_number(SP[ 0])) ||
- (!SvNIOK(SP[-1]) && !looks_like_number(SP[-1])) )
- warn("Possible use of == on string value");
- }
-
- value = POPn;
+ dSP; dPOPnv;
SETs((TOPn == value) ? &sv_yes : &sv_no);
RETURN;
}
@@ -2023,7 +2053,7 @@ PP(pp_substr)
pos = POPi - arybase;
sv = POPs;
tmps = SvPVn(sv); /* force conversion to string */
- curlen = SvCUR(sv);
+ curlen = SvCUROK(sv);
if (pos < 0)
pos += curlen + arybase;
if (pos < 0 || pos > curlen)
@@ -2059,17 +2089,18 @@ PP(pp_vec)
unsigned char *s = (unsigned char*)SvPVn(src);
unsigned long retnum;
I32 len;
+ I32 srclen = SvCUROK(src);
offset *= size; /* turn into bit offset */
len = (offset + size + 7) / 8;
if (offset < 0 || size < 1)
retnum = 0;
- else if (!lvalue && len > SvCUR(src))
+ else if (!lvalue && len > srclen)
retnum = 0;
else {
- if (len > SvCUR(src)) {
+ if (len > srclen) {
SvGROW(src, len);
- (void)memzero(SvPV(src) + SvCUR(src), len - SvCUR(src));
+ (void)memzero(SvPV(src) + srclen, len - srclen);
SvCUR_set(src, len);
}
s = (unsigned char*)SvPVn(src);
@@ -2109,6 +2140,7 @@ PP(pp_index)
I32 retval;
char *tmps;
char *tmps2;
+ I32 biglen;
if (MAXARG < 3)
offset = 0;
@@ -2117,12 +2149,13 @@ PP(pp_index)
little = POPs;
big = POPs;
tmps = SvPVn(big);
+ biglen = SvCUROK(big);
if (offset < 0)
offset = 0;
- else if (offset > SvCUR(big))
- offset = SvCUR(big);
+ else if (offset > biglen)
+ offset = biglen;
if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
- (unsigned char*)tmps + SvCUR(big), little)))
+ (unsigned char*)tmps + biglen, little)))
retval = -1 + arybase;
else
retval = tmps2 - tmps + arybase;
@@ -2148,15 +2181,15 @@ PP(pp_rindex)
tmps2 = SvPVn(little);
tmps = SvPVn(big);
if (MAXARG < 3)
- offset = SvCUR(big);
+ offset = SvCUROK(big);
else
- offset = SvIVn(offstr) - arybase + SvCUR(little);
+ offset = SvIVn(offstr) - arybase + SvCUROK(little);
if (offset < 0)
offset = 0;
- else if (offset > SvCUR(big))
- offset = SvCUR(big);
+ else if (offset > SvCUROK(big))
+ offset = SvCUROK(big);
if (!(tmps2 = rninstr(tmps, tmps + offset,
- tmps2, tmps2 + SvCUR(little))))
+ tmps2, tmps2 + SvCUROK(little))))
retval = -1 + arybase;
else
retval = tmps2 - tmps + arybase;
@@ -2360,7 +2393,7 @@ PP(pp_formline)
I32 itemsize;
I32 fieldsize;
I32 lines = 0;
- bool chopspace = (index(chopset, ' ') != Nullch);
+ bool chopspace = (strchr(chopset, ' ') != Nullch);
char *chophere;
char *linemark;
char *formmark;
@@ -2444,7 +2477,7 @@ PP(pp_formline)
case FF_CHECKNL:
s = SvPVn(sv);
- itemsize = SvCUR(sv);
+ itemsize = SvCUROK(sv);
if (itemsize > fieldsize)
itemsize = fieldsize;
send = chophere = s + itemsize;
@@ -2460,7 +2493,7 @@ PP(pp_formline)
case FF_CHECKCHOP:
s = SvPVn(sv);
- itemsize = SvCUR(sv);
+ itemsize = SvCUROK(sv);
if (itemsize > fieldsize)
itemsize = fieldsize;
send = chophere = s + itemsize;
@@ -2474,7 +2507,7 @@ PP(pp_formline)
else {
if (*s & ~31)
gotsome = TRUE;
- if (index(chopset, *s))
+ if (strchr(chopset, *s))
chophere = s + 1;
}
s++;
@@ -2521,7 +2554,7 @@ PP(pp_formline)
case FF_LINEGLOB:
s = SvPVn(sv);
- itemsize = SvCUR(sv);
+ itemsize = SvCUROK(sv);
if (itemsize) {
gotsome = TRUE;
send = s + itemsize;
@@ -2592,7 +2625,7 @@ PP(pp_formline)
break;
case FF_MORE:
- if (SvCUR(sv)) {
+ if (SvCUROK(sv)) {
arg = fieldsize - itemsize;
if (arg) {
fieldsize -= arg;
@@ -2712,7 +2745,7 @@ PP(pp_uc)
SETs(sv);
}
s = SvPVn(sv);
- send = s + SvCUR(sv);
+ send = s + SvCUROK(sv);
while (s < send) {
if (isascii(*s) && islower(*s))
*s = toupper(*s);
@@ -2735,7 +2768,7 @@ PP(pp_lc)
SETs(sv);
}
s = SvPVn(sv);
- send = s + SvCUR(sv);
+ send = s + SvCUROK(sv);
while (s < send) {
if (isascii(*s) && isupper(*s))
*s = tolower(*s);
@@ -2757,21 +2790,33 @@ PP(pp_rv2av)
if (SvTYPE(av) != SVt_PVAV)
DIE("Not an array reference");
if (op->op_flags & OPf_LVAL) {
- if (op->op_flags & OPf_LOCAL)
+ if (op->op_flags & OPf_INTRO)
av = (AV*)save_svref(sv);
PUSHs((SV*)av);
RETURN;
}
}
else {
- if (SvTYPE(sv) != SVt_PVGV)
- sv = (SV*)gv_fetchpv(SvPVn(sv), TRUE);
- av = GvAVn(sv);
- if (op->op_flags & OPf_LVAL) {
- if (op->op_flags & OPf_LOCAL)
- av = save_ary(sv);
- PUSHs((SV*)av);
- RETURN;
+ if (SvTYPE(sv) == SVt_PVAV) {
+ av = (AV*)sv;
+ if (op->op_flags & OPf_LVAL) {
+ PUSHs((SV*)av);
+ RETURN;
+ }
+ }
+ else {
+ if (SvTYPE(sv) != SVt_PVGV) {
+ if (!SvOK(sv))
+ DIE(no_usym);
+ sv = (SV*)gv_fetchpv(SvPVn(sv), TRUE);
+ }
+ av = GvAVn(sv);
+ if (op->op_flags & OPf_LVAL) {
+ if (op->op_flags & OPf_INTRO)
+ av = save_ary(sv);
+ PUSHs((SV*)av);
+ RETURN;
+ }
}
}
@@ -2808,10 +2853,10 @@ PP(pp_aelem)
if (op->op_flags & OPf_LVAL) {
svp = av_fetch(av, elem, TRUE);
if (!svp || *svp == &sv_undef)
- DIE("Assignment to non-creatable value, subscript %d", elem);
- if (op->op_flags & OPf_LOCAL)
+ DIE(no_aelem, elem);
+ if (op->op_flags & OPf_INTRO)
save_svref(svp);
- else if (!SvOK(*svp)) {
+ else if (SvTYPE(*svp) == SVt_NULL) {
if (op->op_private == OP_RV2HV) {
sv_free(*svp);
*svp = (SV*)newHV(COEFFSIZE);
@@ -2842,8 +2887,8 @@ PP(pp_aslice)
if (lval) {
svp = av_fetch(av, elem, TRUE);
if (!svp || *svp == &sv_undef)
- DIE("Assignment to non-creatable value, subscript \"%d\"",elem);
- if (op->op_flags & OPf_LOCAL)
+ DIE(no_aelem, elem);
+ if (op->op_flags & OPf_INTRO)
save_svref(svp);
}
else {
@@ -2912,7 +2957,7 @@ PP(pp_delete)
DIE("Not an associative array reference");
}
tmps = SvPVn(tmpsv);
- sv = hv_delete(hv, tmps, SvCUR(tmpsv));
+ sv = hv_delete(hv, tmps, SvCUROK(tmpsv));
if (!sv)
RETPUSHUNDEF;
PUSHs(sv);
@@ -2931,21 +2976,33 @@ PP(pp_rv2hv)
if (SvTYPE(hv) != SVt_PVHV)
DIE("Not an associative array reference");
if (op->op_flags & OPf_LVAL) {
- if (op->op_flags & OPf_LOCAL)
+ if (op->op_flags & OPf_INTRO)
hv = (HV*)save_svref(sv);
SETs((SV*)hv);
RETURN;
}
}
else {
- if (SvTYPE(sv) != SVt_PVGV)
- sv = (SV*)gv_fetchpv(SvPVn(sv), TRUE);
- hv = GvHVn(sv);
- if (op->op_flags & OPf_LVAL) {
- if (op->op_flags & OPf_LOCAL)
- hv = save_hash(sv);
- SETs((SV*)hv);
- RETURN;
+ if (SvTYPE(sv) == SVt_PVHV) {
+ hv = (HV*)sv;
+ if (op->op_flags & OPf_LVAL) {
+ SETs((SV*)hv);
+ RETURN;
+ }
+ }
+ else {
+ if (SvTYPE(sv) != SVt_PVGV) {
+ if (!SvOK(sv))
+ DIE(no_usym);
+ sv = (SV*)gv_fetchpv(SvPVn(sv), TRUE);
+ }
+ hv = GvHVn(sv);
+ if (op->op_flags & OPf_LVAL) {
+ if (op->op_flags & OPf_INTRO)
+ hv = save_hash(sv);
+ SETs((SV*)hv);
+ RETURN;
+ }
}
}
@@ -2973,16 +3030,16 @@ PP(pp_helem)
SV** svp;
SV *keysv = POPs;
char *key = SvPVn(keysv);
- I32 keylen = SvPOK(keysv) ? SvCUR(keysv) : 0;
+ I32 keylen = SvCUROK(keysv);
HV *hv = (HV*)POPs;
if (op->op_flags & OPf_LVAL) {
svp = hv_fetch(hv, key, keylen, TRUE);
if (!svp || *svp == &sv_undef)
- DIE("Assignment to non-creatable value, subscript \"%s\"", key);
- if (op->op_flags & OPf_LOCAL)
+ DIE(no_helem, key);
+ if (op->op_flags & OPf_INTRO)
save_svref(svp);
- else if (!SvOK(*svp)) {
+ else if (SvTYPE(*svp) == SVt_NULL) {
if (op->op_private == OP_RV2HV) {
sv_free(*svp);
*svp = (SV*)newHV(COEFFSIZE);
@@ -3009,13 +3066,13 @@ PP(pp_hslice)
while (++MARK <= SP) {
char *key = SvPVnx(*MARK);
- I32 keylen = SvPOK(*MARK) ? SvCUR(*MARK) : 0;
+ I32 keylen = SvCUROK(*MARK);
if (lval) {
svp = hv_fetch(hv, key, keylen, TRUE);
if (!svp || *svp == &sv_undef)
- DIE("Assignment to non-creatable value, subscript \"%s\"", key);
- if (op->op_flags & OPf_LOCAL)
+ DIE(no_helem, key);
+ if (op->op_flags & OPf_INTRO)
save_svref(svp);
}
else {
@@ -3039,9 +3096,9 @@ PP(pp_unpack)
SV *sv;
register char *pat = SvPVn(lstr);
register char *s = SvPVn(rstr);
- char *strend = s + SvCUR(rstr);
+ char *strend = s + SvCUROK(rstr);
char *strbeg = s;
- register char *patend = pat + SvCUR(lstr);
+ register char *patend = pat + SvCUROK(lstr);
I32 datumtype;
register I32 len;
register I32 bits;
@@ -3070,7 +3127,7 @@ PP(pp_unpack)
if (GIMME != G_ARRAY) { /* arrange to do first one only */
/*SUPPRESS 530*/
for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
- if (index("aAbBhH", *patend) || *pat == '%') {
+ if (strchr("aAbBhH", *patend) || *pat == '%') {
patend++;
while (isDIGIT(*patend) || *patend == '*')
patend++;
@@ -3602,8 +3659,8 @@ PP(pp_unpack)
}
if (checksum) {
sv = NEWSV(42, 0);
- if (index("fFdD", datumtype) ||
- (checksum > 32 && index("iIlLN", datumtype)) ) {
+ if (strchr("fFdD", datumtype) ||
+ (checksum > 32 && strchr("iIlLN", datumtype)) ) {
double modf();
double trouble;
@@ -3671,10 +3728,11 @@ PP(pp_pack)
register SV *cat = TARG;
register I32 items;
register char *pat = SvPVnx(*++MARK);
- register char *patend = pat + SvCUR(*MARK);
+ register char *patend = pat + SvCUROK(*MARK);
register I32 len;
I32 datumtype;
SV *fromstr;
+ I32 fromlen;
/*SUPPRESS 442*/
static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
static char *space10 = " ";
@@ -3701,7 +3759,7 @@ PP(pp_pack)
#define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
datumtype = *pat++;
if (*pat == '*') {
- len = index("@Xxu", datumtype) ? 0 : items;
+ len = strchr("@Xxu", datumtype) ? 0 : items;
pat++;
}
else if (isDIGIT(*pat)) {
@@ -3743,13 +3801,14 @@ PP(pp_pack)
case 'a':
fromstr = NEXTFROM;
aptr = SvPVn(fromstr);
+ fromlen = SvCUROK(fromstr);
if (pat[-1] == '*')
- len = SvCUR(fromstr);
- if (SvCUR(fromstr) > len)
+ len = fromlen;
+ if (fromlen > len)
sv_catpvn(cat, aptr, len);
else {
- sv_catpvn(cat, aptr, SvCUR(fromstr));
- len -= SvCUR(fromstr);
+ sv_catpvn(cat, aptr, fromlen);
+ len -= fromlen;
if (datumtype == 'A') {
while (len >= 10) {
sv_catpvn(cat, space10, 10);
@@ -3775,15 +3834,16 @@ PP(pp_pack)
fromstr = NEXTFROM;
saveitems = items;
aptr = SvPVn(fromstr);
+ fromlen = SvCUROK(fromstr);
if (pat[-1] == '*')
- len = SvCUR(fromstr);
+ len = fromlen;
pat = aptr;
aint = SvCUR(cat);
SvCUR(cat) += (len+7)/8;
SvGROW(cat, SvCUR(cat) + 1);
aptr = SvPV(cat) + aint;
- if (len > SvCUR(fromstr))
- len = SvCUR(fromstr);
+ if (len > fromlen)
+ len = fromlen;
aint = len;
items = 0;
if (datumtype == 'B') {
@@ -3833,15 +3893,16 @@ PP(pp_pack)
fromstr = NEXTFROM;
saveitems = items;
aptr = SvPVn(fromstr);
+ fromlen = SvCUROK(fromstr);
if (pat[-1] == '*')
- len = SvCUR(fromstr);
+ len = fromlen;
pat = aptr;
aint = SvCUR(cat);
SvCUR(cat) += (len+1)/2;
SvGROW(cat, SvCUR(cat) + 1);
aptr = SvPV(cat) + aint;
- if (len > SvCUR(fromstr))
- len = SvCUR(fromstr);
+ if (len > fromlen)
+ len = fromlen;
aint = len;
items = 0;
if (datumtype == 'H') {
@@ -4010,21 +4071,21 @@ PP(pp_pack)
case 'u':
fromstr = NEXTFROM;
aptr = SvPVn(fromstr);
- aint = SvCUR(fromstr);
- SvGROW(cat, aint * 4 / 3);
+ fromlen = SvCUROK(fromstr);
+ SvGROW(cat, fromlen * 4 / 3);
if (len <= 1)
len = 45;
else
len = len / 3 * 3;
- while (aint > 0) {
+ while (fromlen > 0) {
I32 todo;
- if (aint > len)
+ if (fromlen > len)
todo = len;
else
- todo = aint;
+ todo = fromlen;
doencodes(cat, aptr, todo);
- aint -= todo;
+ fromlen -= todo;
aptr += todo;
}
break;
@@ -4041,9 +4102,10 @@ PP(pp_split)
{
dSP; dTARG;
AV *ary;
- register I32 limit = POPi;
- register char *s = SvPVn(TOPs);
- char *strend = s + SvCURx(POPs);
+ register I32 limit = POPi; /* note, negative is forever */
+ SV *sv = POPs;
+ register char *s = SvPVn(sv);
+ char *strend = s + SvCUROK(sv);
register PMOP *pm = (PMOP*)POPs;
register SV *dstr;
register char *m;
@@ -4309,12 +4371,12 @@ PP(pp_anonhash)
SvREFCNT(hv) = 0;
while (MARK < SP) {
SV* key = *++MARK;
- SV* val;
char *tmps;
+ SV *val = NEWSV(46, 0);
if (MARK < SP)
- val = *++MARK;
+ sv_setsv(val, *++MARK);
tmps = SvPV(key);
- (void)hv_store(hv,tmps,SvCUR(key),val,0);
+ (void)hv_store(hv,tmps,SvCUROK(key),val,0);
}
SP = ORIGMARK;
XPUSHs((SV*)hv);
@@ -4660,7 +4722,7 @@ PP(pp_sort)
if (GIMME != G_ARRAY) {
SP = MARK;
- RETSETUNDEF;
+ RETPUSHUNDEF;
}
if (op->op_flags & OPf_STACKED) {
@@ -4673,14 +4735,21 @@ PP(pp_sort)
}
else {
cv = sv_2cv(*++MARK, &stash, &gv, 0);
- if (!cv) {
+ if (!(cv && CvROOT(cv))) {
if (gv) {
SV *tmpstr = sv_mortalcopy(&sv_undef);
gv_efullname(tmpstr, gv);
+ if (CvUSERSUB(cv))
+ DIE("Usersub \"%s\" called in sort", SvPV(tmpstr));
DIE("Undefined sort subroutine \"%s\" called",
SvPV(tmpstr));
}
- DIE("Undefined subroutine in sort");
+ if (cv) {
+ if (CvUSERSUB(cv))
+ DIE("Usersub called in sort");
+ DIE("Undefined subroutine in sort");
+ }
+ DIE("Not a subroutine reference in sort");
}
sortcop = CvSTART(cv);
SAVESPTR(CvROOT(cv)->op_ppaddr);
@@ -4766,17 +4835,18 @@ PP(pp_reverse)
dTARGET;
if (SP - MARK > 1)
- do_join(TARG, sv_no, MARK, SP);
+ do_join(TARG, &sv_no, MARK, SP);
else
sv_setsv(TARG, *SP);
up = SvPVn(TARG);
- if (SvCUR(TARG) > 1) {
+ if (SvCUROK(TARG) > 1) {
down = SvPV(TARG) + SvCUR(TARG) - 1;
while (down > up) {
tmp = *up;
*up++ = *down;
*down-- = tmp;
}
+ SvPOK_only(TARG);
}
SP = MARK + 1;
SETTARG;
@@ -5141,7 +5211,7 @@ PP(pp_method)
if (!gv) { /* nothing cached */
char *name = SvPV(((SVOP*)cLOGOP->op_other)->op_sv);
- if (index(name, '\''))
+ if (strchr(name, '\''))
gv = gv_fetchpv(name, FALSE);
else
gv = gv_fetchmethod(SvSTASH(ob),name);
@@ -5170,12 +5240,14 @@ PP(pp_entersubr)
ENTER;
SAVETMPS;
- if (!cv) {
+ if (!(cv && (CvROOT(cv) || CvUSERSUB(cv)))) {
if (gv) {
SV *tmpstr = sv_mortalcopy(&sv_undef);
gv_efullname(tmpstr, gv);
DIE("Undefined subroutine \"%s\" called",SvPV(tmpstr));
}
+ if (cv)
+ DIE("Undefined subroutine called");
DIE("Not a subroutine reference");
}
if ((op->op_private & OPpSUBR_DB) && !CvUSERSUB(cv)) {
@@ -5199,6 +5271,8 @@ PP(pp_entersubr)
}
else {
I32 gimme = GIMME;
+ AV* padlist = CvPADLIST(cv);
+ SV** svp = AvARRAY(padlist);
push_return(op->op_next);
PUSHBLOCK(cx, CXt_SUB, MARK - 1);
PUSHSUB(cx);
@@ -5211,17 +5285,30 @@ PP(pp_entersubr)
if (CvDEPTH(cv) >= 2) { /* save temporaries on recursion? */
if (CvDEPTH(cv) == 100 && dowarn)
warn("Deep recursion on subroutine \"%s\"",GvENAME(gv));
- if (CvDEPTH(cv) > AvFILL(CvPADLIST(cv))) {
+ if (CvDEPTH(cv) > AvFILL(padlist)) {
AV *newpad = newAV();
- I32 ix = AvFILL((AV*)*av_fetch(CvPADLIST(cv), 1, FALSE));
- while (ix > 0)
- av_store(newpad, ix--, NEWSV(0,0));
- av_store(CvPADLIST(cv), CvDEPTH(cv), (SV*)newpad);
- AvFILL(CvPADLIST(cv)) = CvDEPTH(cv);
+ I32 ix = AvFILL((AV*)svp[1]);
+ svp = AvARRAY(svp[0]);
+ while (ix > 0) {
+ if (svp[ix]) {
+ char *name = SvPV(svp[ix]); /* XXX */
+ if (*name == '@')
+ av_store(newpad, ix--, newAV());
+ else if (*name == '%')
+ av_store(newpad, ix--, newHV(COEFFSIZE));
+ else
+ av_store(newpad, ix--, NEWSV(0,0));
+ }
+ else
+ av_store(newpad, ix--, NEWSV(0,0));
+ }
+ av_store(padlist, CvDEPTH(cv), (SV*)newpad);
+ AvFILL(padlist) = CvDEPTH(cv);
+ svp = AvARRAY(padlist);
}
}
SAVESPTR(curpad);
- curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),CvDEPTH(cv),FALSE));
+ curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
RETURNOP(CvSTART(cv));
}
}
@@ -5272,13 +5359,15 @@ PP(pp_caller)
SV *sv;
I32 count = 0;
- if (cxix < 0)
- DIE("There is no caller");
if (MAXARG)
count = POPi;
+ EXTEND(SP, 6);
for (;;) {
- if (cxix < 0)
+ if (cxix < 0) {
+ if (GIMME != G_ARRAY)
+ RETPUSHUNDEF;
RETURN;
+ }
nextcxix = dopoptosub(cxix - 1);
if (DBsub && nextcxix >= 0 &&
cxstack[nextcxix].blk_sub.cv == GvCV(DBsub))
@@ -5288,7 +5377,11 @@ PP(pp_caller)
cxix = nextcxix;
}
cx = &cxstack[cxix];
- EXTEND(SP, 6);
+ if (cx->blk_oldcop == &compiling) {
+ if (GIMME != G_ARRAY)
+ RETPUSHUNDEF;
+ RETURN;
+ }
if (GIMME != G_ARRAY) {
dTARGET;
@@ -5364,7 +5457,7 @@ PP(pp_warn)
char *tmps;
if (SP - MARK != 1) {
dTARGET;
- do_join(TARG, sv_no, MARK, SP);
+ do_join(TARG, &sv_no, MARK, SP);
tmps = SvPVn(TARG);
SP = MARK + 1;
}
@@ -5373,6 +5466,7 @@ PP(pp_warn)
}
if (!tmps || !*tmps) {
SV *error = GvSV(gv_fetchpv("@", TRUE));
+ SvUPGRADE(error, SVt_PV);
if (SvCUR(error))
sv_catpv(error, "\t...caught");
tmps = SvPVn(error);
@@ -5389,7 +5483,7 @@ PP(pp_die)
char *tmps;
if (SP - MARK != 1) {
dTARGET;
- do_join(TARG, sv_no, MARK, SP);
+ do_join(TARG, &sv_no, MARK, SP);
tmps = SvPVn(TARG);
SP = MARK + 1;
}
@@ -5398,6 +5492,7 @@ PP(pp_die)
}
if (!tmps || !*tmps) {
SV *error = GvSV(gv_fetchpv("@", TRUE));
+ SvUPGRADE(error, SVt_PV);
if (SvCUR(error))
sv_catpv(error, "\t...propagated");
tmps = SvPVn(error);
@@ -5427,7 +5522,7 @@ PP(pp_lineseq)
return NORMAL;
}
-PP(pp_curcop)
+PP(pp_nextstate)
{
curcop = (COP*)op;
#ifdef TAINT
@@ -5438,6 +5533,50 @@ PP(pp_curcop)
return NORMAL;
}
+PP(pp_dbstate)
+{
+ curcop = (COP*)op;
+#ifdef TAINT
+ tainted = 0; /* Each statement is presumed innocent */
+#endif
+ stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
+ free_tmps();
+
+ if (op->op_private || SvIVn(DBsingle) || SvIVn(DBsignal) || SvIVn(DBtrace))
+ {
+ SV **sp;
+ register CV *cv;
+ register CONTEXT *cx;
+ I32 gimme = GIMME;
+ I32 hasargs;
+ GV *gv;
+
+ ENTER;
+ SAVETMPS;
+
+ hasargs = 0;
+ gv = DBgv;
+ cv = GvCV(gv);
+ sp = stack_sp;
+ *++sp = Nullsv;
+
+ if (!cv)
+ DIE("No DB'DB routine defined");
+
+ push_return(op->op_next);
+ PUSHBLOCK(cx, CXt_SUB, sp - 1);
+ PUSHSUB(cx);
+ CvDEPTH(cv)++;
+ if (CvDEPTH(cv) >= 2)
+ DIE("DB'DB called recursively");
+ SAVESPTR(curpad);
+ curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE));
+ RETURNOP(CvSTART(cv));
+ }
+ else
+ return NORMAL;
+}
+
PP(pp_unstack)
{
I32 oldsave;
@@ -5747,15 +5886,15 @@ OP **opstack;
if (op->op_flags & OPf_KIDS) {
/* First try all the kids at this level, since that's likeliest. */
for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
- if (kid->op_type == OP_CURCOP && kCOP->cop_label &&
+ if (kid->op_type == OP_NEXTSTATE && kCOP->cop_label &&
strEQ(kCOP->cop_label, label))
return kid;
}
for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
if (kid == lastgotoprobe)
continue;
- if (kid->op_type == OP_CURCOP) {
- if (ops > opstack && ops[-1]->op_type == OP_CURCOP)
+ if (kid->op_type == OP_NEXTSTATE) {
+ if (ops > opstack && ops[-1]->op_type == OP_NEXTSTATE)
*ops = kid;
else
*ops++ = kid;
@@ -5931,12 +6070,16 @@ PP(pp_open)
{
dSP; dTARGET;
GV *gv;
- dPOPss;
+ SV *sv;
char *tmps;
+ if (MAXARG > 1)
+ sv = POPs;
+ else
+ sv = GvSV(TOPs);
gv = (GV*)POPs;
tmps = SvPVn(sv);
- if (do_open(gv, tmps, SvCUR(sv))) {
+ if (do_open(gv, tmps, SvCUROK(sv))) {
GvIO(gv)->lines = 0;
PUSHi( (I32)forkprocess );
}
@@ -7170,7 +7313,7 @@ PP(pp_ssockopt)
switch (optype) {
case OP_GSOCKOPT:
SvCUR_set(sv, 256);
- SvPOK_on(sv);
+ SvPOK_only(sv);
if (getsockopt(fd, lvl, optname, SvPV(sv), (int*)&SvCUR(sv)) < 0)
goto nuts2;
PUSHs(sv);
@@ -7285,7 +7428,7 @@ PP(pp_stat)
#endif
laststatval = stat(SvPVn(statname), &statcache);
if (laststatval < 0) {
- if (dowarn && index(SvPVn(statname), '\n'))
+ if (dowarn && strchr(SvPVn(statname), '\n'))
warn(warn_nl, "stat");
max = 0;
}
@@ -7667,7 +7810,7 @@ PP(pp_fttext)
really_filename:
i = open(SvPVn(sv), 0);
if (i < 0) {
- if (dowarn && index(SvPVn(sv), '\n'))
+ if (dowarn && strchr(SvPVn(sv), '\n'))
warn(warn_nl, "open");
RETPUSHUNDEF;
}
@@ -8660,7 +8803,8 @@ SV *sv;
while (s && s < send) {
SV *tmpstr = NEWSV(85,0);
- t = index(s, '\n');
+ sv_upgrade(tmpstr, SVt_PVMG);
+ t = strchr(s, '\n');
if (t)
t++;
else
@@ -8687,7 +8831,11 @@ doeval()
SAVEINT(padix);
SAVESPTR(curpad);
SAVESPTR(comppad);
+ SAVESPTR(comppadname);
+ SAVEINT(comppadnamefill);
comppad = newAV();
+ comppadname = newAV();
+ comppadnamefill = -1;
av_push(comppad, Nullsv);
curpad = AvARRAY(comppad);
padix = 0;
@@ -8699,12 +8847,18 @@ doeval()
SAVESPTR(curstash);
curstash = newstash;
}
+ SAVESPTR(beginav);
+ beginav = 0;
/* try to compile it */
eval_root = Nullop;
error_count = 0;
curcop = &compiling;
+ rs = "\n";
+ rslen = 1;
+ rschar = '\n';
+ rspara = 0;
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
@@ -8722,14 +8876,27 @@ doeval()
}
if (optype == OP_REQUIRE)
DIE("%s", SvPVnx(GvSV(gv_fetchpv("@",TRUE))));
+ rs = nrs;
+ rslen = nrslen;
+ rschar = nrschar;
+ rspara = (nrslen == 2);
RETPUSHUNDEF;
}
+ rs = nrs;
+ rslen = nrslen;
+ rschar = nrschar;
+ rspara = (nrslen == 2);
compiling.cop_line = 0;
DEBUG_x(dump_eval(eval_root, eval_start));
/* compiled okay, so do it */
+ if (beginav) {
+ calllist(beginav);
+ av_free(beginav);
+ beginav = 0;
+ }
sv_setpv(GvSV(gv_fetchpv("@",TRUE)),"");
RETURNOP(eval_start);
}
@@ -8753,6 +8920,7 @@ PP(pp_require)
sv_setpv(linestr,"");
+ SAVESPTR(rsfp); /* in case we're in a BEGIN */
tmpname = savestr(name);
if (*tmpname == '/' ||
(*tmpname == '.' &&
@@ -8890,6 +9058,7 @@ PP(pp_leaveeval)
}
op_free(eroot);
av_free(comppad);
+ av_free(comppadname);
LEAVE;
sv_setpv(GvSV(gv_fetchpv("@",TRUE)),"");
@@ -9300,10 +9469,10 @@ PP(pp_gservent)
PP(pp_shostent)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_SOCKET
- SETi( sethostent(TOPi) );
- RETURN;
+ sethostent(TOPi);
+ RETSETYES;
#else
DIE(no_sock_func, "sethostent");
#endif
@@ -9311,10 +9480,10 @@ PP(pp_shostent)
PP(pp_snetent)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_SOCKET
- SETi( setnetent(TOPi) );
- RETURN;
+ setnetent(TOPi);
+ RETSETYES;
#else
DIE(no_sock_func, "setnetent");
#endif
@@ -9322,10 +9491,10 @@ PP(pp_snetent)
PP(pp_sprotoent)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_SOCKET
- SETi( setprotoent(TOPi) );
- RETURN;
+ setprotoent(TOPi);
+ RETSETYES;
#else
DIE(no_sock_func, "setprotoent");
#endif
@@ -9333,10 +9502,10 @@ PP(pp_sprotoent)
PP(pp_sservent)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_SOCKET
- SETi( setservent(TOPi) );
- RETURN;
+ setservent(TOPi);
+ RETSETYES;
#else
DIE(no_sock_func, "setservent");
#endif
@@ -9344,10 +9513,11 @@ PP(pp_sservent)
PP(pp_ehostent)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_SOCKET
- XPUSHi( endhostent() );
- RETURN;
+ endhostent();
+ EXTEND(sp,1);
+ RETPUSHYES;
#else
DIE(no_sock_func, "endhostent");
#endif
@@ -9355,10 +9525,11 @@ PP(pp_ehostent)
PP(pp_enetent)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_SOCKET
- XPUSHi( endnetent() );
- RETURN;
+ endnetent();
+ EXTEND(sp,1);
+ RETPUSHYES;
#else
DIE(no_sock_func, "endnetent");
#endif
@@ -9366,10 +9537,11 @@ PP(pp_enetent)
PP(pp_eprotoent)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_SOCKET
- XPUSHi( endprotoent() );
- RETURN;
+ endprotoent();
+ EXTEND(sp,1);
+ RETPUSHYES;
#else
DIE(no_sock_func, "endprotoent");
#endif
@@ -9377,10 +9549,11 @@ PP(pp_eprotoent)
PP(pp_eservent)
{
- dSP; dTARGET;
+ dSP;
#ifdef HAS_SOCKET
- XPUSHi( endservent() );
- RETURN;
+ endservent();
+ EXTEND(sp,1);
+ RETPUSHYES;
#else
DIE(no_sock_func, "endservent");
#endif