{
dSP;
HV *hv = (HV*)POPs;
- I32 i;
register HE *entry;
- char *tmps;
SV *tmpstr;
+ I32 gimme = GIMME_V;
I32 dokeys = (op->op_type == OP_KEYS);
I32 dovalues = (op->op_type == OP_VALUES);
-
+ I32 realhv = (SvTYPE(hv) == SVt_PVHV);
+
if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
dokeys = dovalues = TRUE;
- if (!hv)
+ if (!hv) {
+ if (op->op_flags & OPf_MOD) { /* lvalue */
+ dTARGET; /* make sure to clear its target here */
+ if (SvTYPE(TARG) == SVt_PVLV)
+ LvTARG(TARG) = Nullsv;
+ PUSHs(TARG);
+ }
RETURN;
+ }
- (void)hv_iterinit(hv); /* always reset iterator regardless */
+ if (realhv)
+ (void)hv_iterinit(hv); /* always reset iterator regardless */
+ else
+ (void)avhv_iterinit((AV*)hv);
-
- if (GIMME != G_ARRAY) {
+
+ if (gimme == G_VOID)
+ RETURN;
+
+ if (gimme == G_SCALAR) {
+ I32 i;
dTARGET;
+ if (op->op_flags & OPf_MOD) { /* lvalue */
+ if (SvTYPE(TARG) < SVt_PVLV) {
+ sv_upgrade(TARG, SVt_PVLV);
+ sv_magic(TARG, Nullsv, 'k', Nullch, 0);
+ }
+ LvTYPE(TARG) = 'k';
+ LvTARG(TARG) = (SV*)hv;
+ PUSHs(TARG);
+ RETURN;
+ }
+
if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
i = HvKEYS(hv);
else {
EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
- while (entry = hv_iternext(hv)) {
+ while (entry = realhv ? hv_iternext(hv) : avhv_iternext((AV*)hv)) {
SPAGAIN;
- if (dokeys) {
- tmps = hv_iterkey(entry,&i); /* won't clobber stack_sp */
- if (!i)
- tmps = "";
- XPUSHs(sv_2mortal(newSVpv(tmps,i)));
- }
+ if (dokeys)
+ XPUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
if (dovalues) {
- tmpstr = NEWSV(45,0);
+ tmpstr = sv_newmortal();
PUTBACK;
- sv_setsv(tmpstr,hv_iterval(hv,entry));
+ sv_setsv(tmpstr,realhv ?
+ hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
+ DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
+ (unsigned long)HeHASH(entry),
+ HvMAX(hv)+1,
+ (unsigned long)(HeHASH(entry) & HvMAX(hv))));
SPAGAIN;
- DEBUG_H( {
- sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
- HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
- sv_setpv(tmpstr,buf);
- } )
- XPUSHs(sv_2mortal(tmpstr));
+ XPUSHs(tmpstr);
}
PUTBACK;
}
OUTPUT:
RETVAL
++>>>> ORIGINAL VERSION
++BOOT:
++ newXS("DB_File::TIEARRAY", XS_DB_File_db_TIEHASH, file);
++
++==== THEIR VERSION
++==== YOUR VERSION
+BOOT:
+ newXS("DB_File::TIEARRAY", XS_DB_File_TIEHASH, file);
+
++<<<<
int
db_DESTROY(db)
DB_File db
CvSTART(cv) = LINKLIST(CvROOT(cv));
CvROOT(cv)->op_next = 0;
peep(CvSTART(cv));
- if (s = strrchr(name,':'))
- s++;
- else
- s = name;
- if (strEQ(s, "BEGIN") && !error_count) {
- line_t oldline = compiling.cop_line;
- SV *oldrs = rs;
- ENTER;
- SAVESPTR(compiling.cop_filegv);
- SAVEI32(perldb);
- if (!beginav)
- beginav = newAV();
- av_push(beginav, (SV *)cv);
- DEBUG_x( dump_sub(gv) );
- rs = SvREFCNT_inc(nrs);
- GvCV(gv) = 0;
- calllist(beginav);
- SvREFCNT_dec(rs);
- rs = oldrs;
- curcop = &compiling;
- curcop->cop_line = oldline; /* might have recursed to yylex */
- LEAVE;
- }
- else if (strEQ(s, "END") && !error_count) {
- if (!endav)
- endav = newAV();
- av_unshift(endav, 1);
- av_store(endav, 0, SvREFCNT_inc(cv));
- }
- else if (strEQ(s, "RESTART") && !error_count) {
- if (!restartav)
- restartav = newAV();
- av_push(restartav, SvREFCNT_inc(cv));
- }
- if (perldb && curstash != debstash) {
- SV *sv;
- SV *tmpstr = sv_newmortal();
+ if (name) {
+ char *s;
+
+ if (perldb && curstash != debstash) {
+ SV *sv = NEWSV(0,0);
+ SV *tmpstr = sv_newmortal();
+ static GV *db_postponed;
+ CV *cv;
+ HV *hv;
+
+ sv_setpvf(sv, "%_:%ld-%ld",
+ GvSV(curcop->cop_filegv),
+ (long)subline, (long)curcop->cop_line);
+ gv_efullname3(tmpstr, gv, Nullch);
+ hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
+ if (!db_postponed) {
+ db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
+ }
+ hv = GvHVn(db_postponed);
+ if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
+ && (cv = GvCV(db_postponed))) {
+ dSP;
+ PUSHMARK(sp);
+ XPUSHs(tmpstr);
+ PUTBACK;
+ perl_call_sv((SV*)cv, G_DISCARD);
+ }
+ }
- sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
- sv = newSVpv(buf,0);
- sv_catpv(sv,"-");
- sprintf(buf,"%ld",(long)curcop->cop_line);
- sv_catpv(sv,buf);
- gv_efullname(tmpstr,gv);
- hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
+ if ((s = strrchr(name,':')))
+ s++;
+ else
+ s = name;
+ if (strEQ(s, "BEGIN")) {
+ I32 oldscope = scopestack_ix;
+ ENTER;
+ SAVESPTR(compiling.cop_filegv);
+ SAVEI16(compiling.cop_line);
+ SAVEI32(perldb);
+ save_svref(&rs);
+ sv_setsv(rs, nrs);
+
+ if (!beginav)
+ beginav = newAV();
+ DEBUG_x( dump_sub(gv) );
+ av_push(beginav, (SV *)cv);
+ GvCV(gv) = 0;
+ call_list(oldscope, beginav);
+
+ curcop = &compiling;
+ LEAVE;
+ }
+ else if (strEQ(s, "END") && !error_count) {
+ if (!endav)
+ endav = newAV();
+ av_unshift(endav, 1);
+ av_store(endav, 0, (SV *)cv);
+ GvCV(gv) = 0;
+ }
++ else if (strEQ(s, "RESTART") && !error_count) {
++ if (!restartav)
++ restartav = newAV();
++ av_push(restartav, SvREFCNT_inc(cv));
++ }
}
- op_free(op);
+
+ done:
copline = NOLINE;
LEAVE_SCOPE(floor);
- if (!op) {
- GvCV(gv) = 0; /* Will remember in SVOP instead. */
- CvANON_on(cv);
- }
return cv;
}
else {
cv = (CV*)NEWSV(1105,0);
sv_upgrade((SV *)cv, SVt_PVCV);
+ if (name) {
+ GvCV(gv) = cv;
+ GvCVGEN(gv) = 0;
+ sub_generation++;
+ }
}
- GvCV(gv) = cv;
- CvGV(cv) = SvREFCNT_inc(gv);
- GvCVGEN(gv) = 0;
+ CvGV(cv) = (GV*)SvREFCNT_inc(gv);
CvFILEGV(cv) = gv_fetchfile(filename);
CvXSUB(cv) = subaddr;
- if (!name)
- s = "__ANON__";
- else if (s = strrchr(name,':'))
- s++;
+
+ if (name) {
+ char *s = strrchr(name,':');
+ if (s)
+ s++;
+ else
+ s = name;
+ if (strEQ(s, "BEGIN")) {
+ if (!beginav)
+ beginav = newAV();
+ av_push(beginav, (SV *)cv);
+ GvCV(gv) = 0;
+ }
+ else if (strEQ(s, "END")) {
+ if (!endav)
+ endav = newAV();
+ av_unshift(endav, 1);
+ av_store(endav, 0, (SV *)cv);
+ GvCV(gv) = 0;
+ }
++ else if (strEQ(s, "RESTART")) {
++ if (!restartav)
++ restartav = newAV();
++ av_push(restartav, (SV *)cv);
++ }
+ }
else
- s = name;
- if (strEQ(s, "BEGIN")) {
- if (!beginav)
- beginav = newAV();
- av_push(beginav, SvREFCNT_inc(gv));
- }
- else if (strEQ(s, "END")) {
- if (!endav)
- endav = newAV();
- av_unshift(endav, 1);
- av_store(endav, 0, SvREFCNT_inc(gv));
- }
- else if (strEQ(s, "RESTART")) {
- if (!restartav)
- restartav = newAV();
- av_push(restartav, SvREFCNT_inc(gv));
- }
- if (!name) {
- GvCV(gv) = 0; /* Will remember elsewhere instead. */
CvANON_on(cv);
- }
+
return cv;
}
IEXT SV * Icurstname; /* name of current package */
IEXT AV * Ibeginav; /* names of BEGIN subroutines */
IEXT AV * Iendav; /* names of END subroutines */
+IEXT AV * Irestartav; /* names of RESTART subroutines */
- IEXT AV * Ipad; /* storage for lexically scoped temporaries */
- IEXT AV * Ipadname; /* variable names for "my" variables */
+ IEXT HV * Istrtab; /* shared string table */
/* memory management */
IEXT SV ** Itmps_stack;
dSP; dTARGET;
HV *hash = (HV*)POPs;
HE *entry;
- I32 i;
- char *tmps;
+ 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);
if (entry) {
- tmps = hv_iterkey(entry, &i); /* won't clobber stack_sp */
- if (!i)
- tmps = "";
- PUSHs(sv_2mortal(newSVpv(tmps, i)));
- if (GIMME == G_ARRAY) {
+ 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);
}
PP(pp_delete)
{
dSP;
+ I32 gimme = GIMME_V;
+ I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
SV *sv;
- SV *tmpsv = POPs;
- HV *hv = (HV*)POPs;
- char *tmps;
- STRLEN len;
- I32 flags = op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0;
-
- tmps = SvPV(tmpsv, len);
- if (SvTYPE(hv) == SVt_PVHV)
- sv = hv_delete(hv, tmps, len, flags);
- else if (SvTYPE(hv) == SVt_PVAV) {
- sv = avhv_delete((AV*)hv, tmps, len, flags);
- } else {
- DIE("Not a HASH reference");
+ HV *hv;
+
+ if (op->op_private & OPpSLICE) {
+ dMARK; dORIGMARK;
+ hv = (HV*)POPs;
- if (SvTYPE(hv) != SVt_PVHV)
- DIE("Not a HASH reference");
++ U32 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)
+ SP = ORIGMARK;
+ else if (gimme == G_SCALAR) {
+ MARK = ORIGMARK;
+ *++MARK = *SP;
+ SP = MARK;
+ }
+ }
+ else {
+ SV *keysv = POPs;
+ hv = (HV*)POPs;
+ if (SvTYPE(hv) != SVt_PVHV)
+ DIE("Not a HASH reference");
+ sv = hv_delete_ent(hv, keysv, discard, 0);
+ if (!sv)
+ sv = &sv_undef;
+ if (!discard)
+ PUSHs(sv);
}
- if (!sv)
- RETPUSHUNDEF;
- PUSHs(sv);
RETURN;
}
dSP;
SV *tmpsv = POPs;
HV *hv = (HV*)POPs;
- char *tmps;
-- STRLEN len;
- tmps = SvPV(tmpsv, len);
- if (SvTYPE(hv) != SVt_PVHV) {
+ if (SvTYPE(hv) == SVt_PVHV) {
- if (hv_exists(hv, tmps, len))
++ if (hv_exists_ent(hv, tmpsv, 0))
+ RETPUSHYES;
+ } else if (SvTYPE(hv) == SVt_PVAV) {
- if (avhv_exists((AV*)hv, tmps, len))
++ if (avhv_exists_ent((AV*)hv, tmpsv, 0))
+ RETPUSHYES;
+ } else {
DIE("Not a HASH reference");
}
- 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;
+ I32 realhv = (SvTYPE(hv) == SVt_PVHV);
- if (SvTYPE(hv) == SVt_PVHV) {
+ if (realhv || SvTYPE(hv) == SVt_PVAV) {
while (++MARK <= SP) {
- STRLEN keylen;
- char *key = SvPV(*MARK, keylen);
-
- svp = realhv ? hv_fetch(hv, key, keylen, lval)
- : avhv_fetch((AV*)hv, key, keylen, lval);
+ 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);
++ }
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) {
}
else {
dTARGET;
+ /* This bit is OK even when hv is really an AV */
- if (HvFILL(hv)) {
- sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
- sv_setpv(TARG, buf);
- }
+ if (HvFILL(hv))
+ sv_setpvf(TARG, "%ld/%ld",
+ (long)HvFILL(hv), (long)HvMAX(hv) + 1);
else
sv_setiv(TARG, 0);
+
SETTARG;
RETURN;
}
PP(pp_helem)
{
dSP;
- SV** svp;
+ HE* he;
++ SV **svp;
SV *keysv = POPs;
- STRLEN keylen;
- char *key = SvPV(keysv, keylen);
HV *hv = (HV*)POPs;
- I32 lval = op->op_flags & OPf_MOD;
+ U32 lval = op->op_flags & OPf_MOD;
+ U32 defer = op->op_private & OPpLVAL_DEFER;
- if (SvTYPE(hv) == SVt_PVHV)
- svp = hv_fetch(hv, key, keylen, lval);
- else if (SvTYPE(hv) == SVt_PVAV)
- svp = avhv_fetch((AV*)hv, key, keylen, lval);
- if (SvTYPE(hv) != SVt_PVHV)
++ if (SvTYPE(hv) == SVt_PVHV) {
++ he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
++ svp = he ? &Heval(he) : 0;
++ }
++ else if (SvTYPE(hv) == SVt_PVAV) {
++ svp = avhv_fetch_ent((AV*)hv, keysv, lval);
++ }
+ else {
RETPUSHUNDEF;
- he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
+ }
++<<<<
if (lval) {
- if (!svp || *svp == &sv_undef)
- DIE(no_helem, key);
- if (op->op_private & OPpLVAL_INTRO)
- save_svref(svp);
- else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
- provide_ref(op, *svp);
- if (!he || HeVAL(he) == &sv_undef) {
++ if (svp || *svp == &sv_undef) {
+ SV* lv;
+ SV* key2;
+ if (!defer)
+ DIE(no_helem, SvPV(keysv, na));
+ lv = sv_newmortal();
+ sv_upgrade(lv, SVt_PVLV);
+ LvTYPE(lv) = 'y';
+ sv_magic(lv, key2 = newSVsv(keysv), 'y', Nullch, 0);
+ SvREFCNT_dec(key2); /* sv_magic() increments refcount */
+ LvTARG(lv) = SvREFCNT_inc(hv);
+ LvTARGLEN(lv) = 1;
+ PUSHs(lv);
+ RETURN;
+ }
+ if (op->op_private & OPpLVAL_INTRO) {
- if (HvNAME(hv) && isGV(HeVAL(he)))
- save_gp((GV*)HeVAL(he), !(op->op_flags & OPf_SPECIAL));
++ if (HvNAME(hv) && isGV(*svp))
++ save_gp((GV*)*svp, !(op->op_flags & OPf_SPECIAL));
+ else
- save_svref(&HeVAL(he));
++ save_svref(svp);
+ }
+ else if (op->op_private & OPpDEREF)
- vivify_ref(HeVAL(he), op->op_private & OPpDEREF);
++ vivify_ref(*svp, op->op_private & OPpDEREF);
}
- PUSHs(he ? HeVAL(he) : &sv_undef);
+ PUSHs(svp ? *svp : &sv_undef);
RETURN;
}
case KEY_my:
in_my = TRUE;
- yylval.ival = 1;
+ s = skipspace(s);
+ if (isIDFIRST(*s)) {
+ s = scan_word(s, tokenbuf, TRUE, &len);
+ in_my_stash = gv_stashpv(tokenbuf, FALSE);
+ if (!in_my_stash) {
+ char tmpbuf[1024];
+ bufptr = s;
+ sprintf(tmpbuf, "No such class %.1000s", tokenbuf);
+ yyerror(tmpbuf);
+ }
+ }
- OPERATOR(LOCAL);
+ OPERATOR(MY);
case KEY_next:
s = force_word(s,WORD,TRUE,FALSE,FALSE);
multi_end = 0;
}
if (in_eval & 2)
- warn("%s",buf);
+ warn("%_", msg);
else if (in_eval)
- sv_catpv(GvSV(errgv),buf);
+ sv_catsv(GvSV(errgv), msg);
else
- fputs(buf,stderr);
+ PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
if (++error_count >= 10)
- croak("%s has too many errors.\n",
- SvPVX(GvSV(curcop->cop_filegv)));
+ croak("%_ has too many errors.\n", GvSV(curcop->cop_filegv));
in_my = 0;
+ in_my_stash = Nullhv;
return 0;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff