From: Gurusamy Sarathy Date: Fri, 29 Oct 1999 03:00:21 +0000 (+0000) Subject: usurp GVOP slot for new PADOP (one small step to making optree X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7934575e193741c310ddb7f01d6d07c9981c3d29;p=p5sagit%2Fp5-mst-13.2.git usurp GVOP slot for new PADOP (one small step to making optree shareable across interpreters) p4raw-id: //depot/perl@4484 --- diff --git a/bytecode.pl b/bytecode.pl index 7d9b223..63fc738 100644 --- a/bytecode.pl +++ b/bytecode.pl @@ -9,7 +9,7 @@ my %alias_to = ( U8 => [qw(char)], ); -my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP GVOP PVOP LOOP COP); +my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); # Nullsv *must* come first in the following so that the condition # ($$sv == 0) can continue to be used to test (sv == Nullsv). @@ -393,7 +393,7 @@ pregcomp PL_op pvcontents x op_pmflags cPMOP->op_pmflags U16 op_pmpermflags cPMOP->op_pmpermflags U16 op_sv cSVOP->op_sv svindex -op_gv *(SV**)&cGVOP->op_gv svindex +op_padix cPADOP->op_padix PADOFFSET op_pv cPVOP->op_pv pvcontents op_pv_tr cPVOP->op_pv op_tr_array op_redoop cLOOP->op_redoop opindex diff --git a/doio.c b/doio.c index 123815d..d9fd6df 100644 --- a/doio.c +++ b/doio.c @@ -1044,7 +1044,7 @@ Perl_my_stat(pTHX) if (PL_op->op_flags & OPf_REF) { EXTEND(SP,1); - tmpgv = cGVOP->op_gv; + tmpgv = (GV*)cSVOP->op_sv; do_fstat: io = GvIO(tmpgv); if (io && IoIFP(io)) { @@ -1097,7 +1097,7 @@ Perl_my_lstat(pTHX) STRLEN n_a; if (PL_op->op_flags & OPf_REF) { EXTEND(SP,1); - if (cGVOP->op_gv == PL_defgv) { + if ((GV*)cSVOP->op_sv == PL_defgv) { if (PL_laststype != OP_LSTAT) Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat"); return PL_laststatval; diff --git a/dump.c b/dump.c index f2f75f0..9acb927 100644 --- a/dump.c +++ b/dump.c @@ -512,11 +512,11 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) switch (o->op_type) { case OP_GVSV: case OP_GV: - if (cGVOPo->op_gv) { + if (cSVOPo->op_sv) { SV *tmpsv = NEWSV(0,0); ENTER; SAVEFREESV(tmpsv); - gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch); + gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch); Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a)); LEAVE; } @@ -570,6 +570,15 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) case OP_SUBST: do_pmop_dump(level, file, cPMOPo); break; + case OP_LEAVE: + case OP_LEAVEEVAL: + case OP_LEAVESUB: + case OP_LEAVESUBLV: + case OP_LEAVEWRITE: + case OP_SCOPE: + if (o->op_private & OPpREFCOUNTED) + Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ); + break; default: break; } diff --git a/ext/B/B.pm b/ext/B/B.pm index 2187e59..08361d7 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -40,7 +40,7 @@ use strict; @B::LOGOP::ISA = 'B::UNOP'; @B::LISTOP::ISA = 'B::BINOP'; @B::SVOP::ISA = 'B::OP'; -@B::GVOP::ISA = 'B::OP'; +@B::PADOP::ISA = 'B::OP'; @B::PVOP::ISA = 'B::OP'; @B::CVOP::ISA = 'B::OP'; @B::LOOP::ISA = 'B::LISTOP'; @@ -549,7 +549,7 @@ C (corresponding to the C function C). =head2 OP-RELATED CLASSES B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP, -B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP. +B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP. These classes correspond in the obvious way to the underlying C structures of similar names. The inheritance hierarchy mimics the underlying C "inheritance". Access @@ -648,13 +648,15 @@ This returns the op description from the global C PL_op_desc array =item sv +=item gv + =back -=head2 B::GVOP METHOD +=head2 B::PADOP METHOD =over 4 -=item gv +=item padix =back diff --git a/ext/B/B.xs b/ext/B/B.xs index 2d6145d..73f35ae 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -56,7 +56,7 @@ typedef enum { OPc_LISTOP, /* 5 */ OPc_PMOP, /* 6 */ OPc_SVOP, /* 7 */ - OPc_GVOP, /* 8 */ + OPc_PADOP, /* 8 */ OPc_PVOP, /* 9 */ OPc_CVOP, /* 10 */ OPc_LOOP, /* 11 */ @@ -72,7 +72,7 @@ static char *opclassnames[] = { "B::LISTOP", "B::PMOP", "B::SVOP", - "B::GVOP", + "B::PADOP", "B::PVOP", "B::CVOP", "B::LOOP", @@ -117,8 +117,8 @@ cc_opclass(pTHX_ OP *o) case OA_SVOP: return OPc_SVOP; - case OA_GVOP: - return OPc_GVOP; + case OA_PADOP: + return OPc_PADOP; case OA_PVOP_OR_SVOP: /* @@ -155,10 +155,10 @@ cc_opclass(pTHX_ OP *o) * return OPc_UNOP so that walkoptree can find our children. If * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set * (no argument to the operator) it's an OP; with OPf_REF set it's - * a GVOP (and op_gv is the GV for the filehandle argument). + * an SVOP (and op_sv is the GV for the filehandle argument). */ return ((o->op_flags & OPf_KIDS) ? OPc_UNOP : - (o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP); + (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP); case OA_LOOPEXOP: /* @@ -345,7 +345,7 @@ typedef LOGOP *B__LOGOP; typedef LISTOP *B__LISTOP; typedef PMOP *B__PMOP; typedef SVOP *B__SVOP; -typedef GVOP *B__GVOP; +typedef PADOP *B__PADOP; typedef PVOP *B__PVOP; typedef LOOP *B__LOOP; typedef COP *B__COP; @@ -575,7 +575,7 @@ char * OP_desc(o) B::OP o -U16 +PADOFFSET OP_targ(o) B::OP o @@ -680,22 +680,38 @@ PMOP_precomp(o) sv_setpvn(ST(0), rx->precomp, rx->prelen); #define SVOP_sv(o) o->op_sv +#define SVOP_gv(o) ((SvTYPE(o->op_sv) == SVt_PVGV) \ + ? (GV*)o->op_sv : Nullgv) MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_ - B::SV SVOP_sv(o) B::SVOP o -#define GVOP_gv(o) o->op_gv +B::GV +SVOP_gv(o) + B::SVOP o -MODULE = B PACKAGE = B::GVOP PREFIX = GVOP_ +#define PADOP_padix(o) o->op_padix +#define PADOP_sv(o) (o->op_padix ? PL_curpad[o->op_padix] : Nullsv) +#define PADOP_gv(o) ((o->op_padix \ + && SvTYPE(PL_curpad[o->op_padix]) == SVt_PVGV) \ + ? (GV*)PL_curpad[o->op_padix] : Nullgv) +MODULE = B PACKAGE = B::PADOP PREFIX = PADOP_ + +PADOFFSET +PADOP_padix(o) + B::PADOP o + +B::SV +PADOP_sv(o) + B::PADOP o B::GV -GVOP_gv(o) - B::GVOP o +PADOP_gv(o) + B::PADOP o MODULE = B PACKAGE = B::PVOP PREFIX = PVOP_ diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm index 1d0e7ed..e0d6132 100644 --- a/ext/B/B/Asmdata.pm +++ b/ext/B/B/Asmdata.pm @@ -14,7 +14,7 @@ use Exporter; @EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name); use vars qw(%insn_data @insn_name @optype @specialsv_name); -@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP GVOP PVOP LOOP COP); +@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); @specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no); # XXX insn_data is initialised this way because with a large @@ -122,7 +122,7 @@ $insn_data{pregcomp} = [98, \&PUT_pvcontents, "GET_pvcontents"]; $insn_data{op_pmflags} = [99, \&PUT_U16, "GET_U16"]; $insn_data{op_pmpermflags} = [100, \&PUT_U16, "GET_U16"]; $insn_data{op_sv} = [101, \&PUT_svindex, "GET_svindex"]; -$insn_data{op_gv} = [102, \&PUT_svindex, "GET_svindex"]; +$insn_data{op_padix} = [102, \&PUT_U32, "GET_U32"]; $insn_data{op_pv} = [103, \&PUT_pvcontents, "GET_pvcontents"]; $insn_data{op_pv_tr} = [104, \&PUT_op_tr_array, "GET_op_tr_array"]; $insn_data{op_redoop} = [105, \&PUT_opindex, "GET_opindex"]; diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm index 5694531..cde9924 100644 --- a/ext/B/B/Bytecode.pm +++ b/ext/B/B/Bytecode.pm @@ -226,13 +226,11 @@ sub B::SVOP::bytecode { $sv->bytecode; } -sub B::GVOP::bytecode { +sub B::PADOP::bytecode { my $op = shift; - my $gv = $op->gv; - my $gvix = $gv->objix; + my $padix = $op->padix; $op->B::OP::bytecode; - print "op_gv $gvix\n"; - $gv->bytecode; + print "op_padix $padix\n"; } sub B::PVOP::bytecode { diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm index b57d1ad..31ecb53 100644 --- a/ext/B/B/C.pm +++ b/ext/B/B/C.pm @@ -83,7 +83,7 @@ BEGIN { # Code sections my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect, - $gvopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect, + $padopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect, $pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect ); @@ -276,17 +276,17 @@ sub B::SVOP::save { savesym($op, sprintf("(OP*)&svop_list[%d]", $svopsect->index)); } -sub B::GVOP::save { +sub B::PADOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - my $gvsym = $op->gv->save; - $gvopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullgv", + $padopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullgv", ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op_seq, $op->flags, $op->private)); - $init->add(sprintf("gvop_list[%d].op_gv = %s;", $gvopsect->index, $gvsym)); - savesym($op, sprintf("(OP*)&gvop_list[%d]", $gvopsect->index)); + $init->add(sprintf("padop_list[%d].op_padix = %ld;", + $padopsect->index, $op->padix)); + savesym($op, sprintf("(OP*)&padop_list[%d]", $padopsect->index)); } sub B::COP::save { @@ -951,7 +951,7 @@ sub output_all { my $init_name = shift; my $section; my @sections = ($opsect, $unopsect, $binopsect, $logopsect, $condopsect, - $listopsect, $pmopsect, $svopsect, $gvopsect, $pvopsect, + $listopsect, $pmopsect, $svopsect, $padopsect, $pvopsect, $loopsect, $copsect, $svsect, $xpvsect, $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect); @@ -1399,7 +1399,7 @@ sub save_main { sub init_sections { my @sections = (init => \$init, decl => \$decl, sym => \$symsect, binop => \$binopsect, condop => \$condopsect, - cop => \$copsect, gvop => \$gvopsect, + cop => \$copsect, padop => \$padopsect, listop => \$listopsect, logop => \$logopsect, loop => \$loopsect, op => \$opsect, pmop => \$pmopsect, pvop => \$pvopsect, svop => \$svopsect, unop => \$unopsect, diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm index 8910068..a61f6df 100644 --- a/ext/B/B/Debug.pm +++ b/ext/B/B/Debug.pm @@ -86,11 +86,10 @@ sub B::PVOP::debug { printf "\top_pv\t\t0x%x\n", $op->pv; } -sub B::GVOP::debug { +sub B::PADOP::debug { my ($op) = @_; $op->B::OP::debug(); - printf "\top_gv\t\t0x%x\n", ${$op->gv}; - $op->gv->debug; + printf "\top_padix\t\t%ld\n", $op->padix; } sub B::CVOP::debug { diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index ede68f5..c5d3ce9 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -1109,7 +1109,7 @@ sub ftst { # Genuine `-X' filetests are exempt from the LLAFR, but not # l?stat(); for the sake of clarity, give'em all parens return $self->maybe_parens_unop($name, $op->first, $cx); - } elsif (class($op) eq "GVOP") { + } elsif (class($op) eq "SVOP") { return $self->maybe_parens_func($name, $self->pp_gv($op, 1), $cx, 16); } else { # I don't think baseop filetests ever survive ck_ftst, but... return $name; diff --git a/ext/B/B/Lint.pm b/ext/B/B/Lint.pm index 67abe3d..3a47142 100644 --- a/ext/B/B/Lint.pm +++ b/ext/B/B/Lint.pm @@ -232,7 +232,7 @@ sub B::LOOP::lint { } } -sub B::GVOP::lint { +sub B::SVOP::lint { my $op = shift; if ($check{dollar_underscore} && $op->name eq "gvsv" && $op->gv->NAME eq "_") @@ -241,11 +241,11 @@ sub B::GVOP::lint { } if ($check{private_names}) { my $opname = $op->name; - my $gv = $op->gv; - if (($opname eq "gv" || $opname eq "gvsv") - && $gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash) - { - warning('Illegal reference to private name %s', $gv->NAME); + if (($opname eq "gv" || $opname eq "gvsv") { + my $gv = $op->gv; + if ($gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash) { + warning('Illegal reference to private name %s', $gv->NAME); + } } } if ($check{undefined_subs}) { diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm index bc9d943..66b5cfc 100644 --- a/ext/B/B/Terse.pm +++ b/ext/B/B/Terse.pm @@ -54,10 +54,9 @@ sub B::SVOP::terse { $op->sv->terse(0); } -sub B::GVOP::terse { +sub B::PADOP::terse { my ($op, $level) = @_; - print indent($level), peekop($op), " "; - $op->gv->terse(0); + print indent($level), peekop($op), " ", $op->padix, "\n"; } sub B::PMOP::terse { diff --git a/ext/B/typemap b/ext/B/typemap index febadf8..bafba1c 100644 --- a/ext/B/typemap +++ b/ext/B/typemap @@ -7,7 +7,7 @@ B::LOGOP T_OP_OBJ B::LISTOP T_OP_OBJ B::PMOP T_OP_OBJ B::SVOP T_OP_OBJ -B::GVOP T_OP_OBJ +B::PADOP T_OP_OBJ B::PVOP T_OP_OBJ B::CVOP T_OP_OBJ B::LOOP T_OP_OBJ @@ -30,6 +30,7 @@ B::IO T_SV_OBJ B::MAGIC T_MG_OBJ SSize_t T_IV STRLEN T_IV +PADOFFSET T_UV INPUT T_OP_OBJ diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c index 60dc98d..19b79ac 100644 --- a/ext/ByteLoader/byterun.c +++ b/ext/ByteLoader/byterun.c @@ -34,7 +34,7 @@ static int optype_size[] = { sizeof(LISTOP), sizeof(PMOP), sizeof(SVOP), - sizeof(GVOP), + sizeof(PADOP), sizeof(PVOP), sizeof(LOOP), sizeof(COP) @@ -779,11 +779,11 @@ byterun(pTHXo_ struct bytestream bs) cSVOP->op_sv = arg; break; } - case INSN_OP_GV: /* 102 */ + case INSN_OP_PADIX: /* 102 */ { - svindex arg; - BGET_svindex(arg); - *(SV**)&cGVOP->op_gv = arg; + PADOFFSET arg; + BGET_U32(arg); + cPADOP->op_padix = arg; break; } case INSN_OP_PV: /* 103 */ diff --git a/ext/ByteLoader/byterun.h b/ext/ByteLoader/byterun.h index 3b8f776..d8f6c0e 100644 --- a/ext/ByteLoader/byterun.h +++ b/ext/ByteLoader/byterun.h @@ -118,7 +118,7 @@ enum { INSN_OP_PMFLAGS, /* 99 */ INSN_OP_PMPERMFLAGS, /* 100 */ INSN_OP_SV, /* 101 */ - INSN_OP_GV, /* 102 */ + INSN_OP_PADIX, /* 102 */ INSN_OP_PV, /* 103 */ INSN_OP_PV_TR, /* 104 */ INSN_OP_REDOOP, /* 105 */ @@ -145,7 +145,7 @@ enum { OPt_LISTOP, /* 4 */ OPt_PMOP, /* 5 */ OPt_SVOP, /* 6 */ - OPt_GVOP, /* 7 */ + OPt_PADOP, /* 7 */ OPt_PVOP, /* 8 */ OPt_LOOP, /* 9 */ OPt_COP /* 10 */ diff --git a/op.c b/op.c index b8006a1..3e25ef8 100644 --- a/op.c +++ b/op.c @@ -21,7 +21,13 @@ #include "keywords.h" /* #define PL_OP_SLAB_ALLOC */ - + +/* XXXXXX testing */ +#define OP_REFCNT_LOCK NOOP +#define OP_REFCNT_UNLOCK NOOP +#define OpREFCNT_set(o,n) NOOP +#define OpREFCNT_dec(o) 0 + #ifdef PL_OP_SLAB_ALLOC #define SLAB_SIZE 8192 static char *PL_OpPtr = NULL; @@ -640,6 +646,26 @@ Perl_op_free(pTHX_ OP *o) if (!o || o->op_seq == (U16)-1) return; + if (o->op_private & OPpREFCOUNTED) { + switch (o->op_type) { + case OP_LEAVESUB: + case OP_LEAVESUBLV: + case OP_LEAVEEVAL: + case OP_LEAVE: + case OP_SCOPE: + case OP_LEAVEWRITE: + OP_REFCNT_LOCK; + if (OpREFCNT_dec(o)) { + OP_REFCNT_UNLOCK; + return; + } + OP_REFCNT_UNLOCK; + break; + default: + break; + } + } + if (o->op_flags & OPf_KIDS) { for (kid = cUNOPo->op_first; kid; kid = nextkid) { nextkid = kid->op_sibling; /* Get before next freeing kid */ @@ -691,8 +717,8 @@ S_op_clear(pTHX_ OP *o) case OP_GVSV: case OP_GV: case OP_AELEMFAST: - SvREFCNT_dec(cGVOPo->op_gv); - cGVOPo->op_gv = Nullgv; + SvREFCNT_dec(cSVOPo->op_sv); + cSVOPo->op_sv = Nullsv; break; case OP_CONST: SvREFCNT_dec(cSVOPo->op_sv); @@ -1331,7 +1357,7 @@ Perl_mod(pTHX_ OP *o, I32 type) break; } - cv = GvCV(kGVOP->op_gv); + cv = GvCV((GV*)kSVOP->op_sv); if (!cv) goto restore_2cv; if (CvLVALUE(cv)) @@ -1957,6 +1983,8 @@ Perl_newPROG(pTHX_ OP *o) ((PL_in_eval & EVAL_KEEPERR) ? OPf_SPECIAL : 0), o); PL_eval_start = linklist(PL_eval_root); + PL_eval_root->op_private |= OPpREFCOUNTED; + OpREFCNT_set(PL_eval_root, 1); PL_eval_root->op_next = 0; peep(PL_eval_start); } @@ -1966,6 +1994,8 @@ Perl_newPROG(pTHX_ OP *o) PL_main_root = scope(sawparens(scalarvoid(o))); PL_curcop = &PL_compiling; PL_main_start = LINKLIST(PL_main_root); + PL_main_root->op_private |= OPpREFCOUNTED; + OpREFCNT_set(PL_main_root, 1); PL_main_root->op_next = 0; peep(PL_main_start); PL_compcv = 0; @@ -2785,7 +2815,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) } #else if (curop->op_type == OP_GV) { - GV *gv = ((GVOP*)curop)->op_gv; + GV *gv = (GV*)((SVOP*)curop)->op_sv; repl_has_vars = 1; if (strchr("&`'123456789+", *GvENAME(gv))) break; @@ -2869,18 +2899,7 @@ OP * Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv) { dTHR; - GVOP *gvop; - NewOp(1101, gvop, 1, GVOP); - gvop->op_type = type; - gvop->op_ppaddr = PL_ppaddr[type]; - gvop->op_gv = (GV*)SvREFCNT_inc(gv); - gvop->op_next = (OP*)gvop; - gvop->op_flags = flags; - if (PL_opargs[type] & OA_RETSCALAR) - scalar((OP*)gvop); - if (PL_opargs[type] & OA_TARGET) - gvop->op_targ = pad_alloc(type, SVs_PADTMP); - return CHECKOP(type, gvop); + return newSVOP(type, flags, SvREFCNT_inc(gv)); } OP * @@ -3119,7 +3138,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) { if (PL_opargs[curop->op_type] & OA_DANGEROUS) { if (curop->op_type == OP_GV) { - GV *gv = ((GVOP*)curop)->op_gv; + GV *gv = (GV*)((SVOP*)curop)->op_sv; if (gv == PL_defgv || SvCUR(gv) == PL_generation) break; SvCUR(gv) = PL_generation; @@ -3171,7 +3190,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) { tmpop = ((UNOP*)left)->op_first; if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) { - pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv; + pm->op_pmreplroot = (OP*)((SVOP*)tmpop)->op_sv; pm->op_pmflags |= PMf_ONCE; tmpop = cUNOPo->op_first; /* to list (nulled) */ tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */ @@ -4326,12 +4345,14 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } } - if(CvLVALUE(cv)) { + if (CvLVALUE(cv)) { CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block)); } else { CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); } + CvROOT(cv)->op_private |= OPpREFCOUNTED; + OpREFCNT_set(CvROOT(cv), 1); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); @@ -4553,6 +4574,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) } CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); + CvROOT(cv)->op_private |= OPpREFCOUNTED; + OpREFCNT_set(CvROOT(cv), 1); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); @@ -5667,11 +5690,11 @@ S_simplify_sort(pTHX_ OP *o) if (kUNOP->op_first->op_type != OP_GV) return; kid = kUNOP->op_first; /* get past rv2sv */ - if (GvSTASH(kGVOP->op_gv) != PL_curstash) + if (GvSTASH((GV*)kSVOP->op_sv) != PL_curstash) return; - if (strEQ(GvNAME(kGVOP->op_gv), "a")) + if (strEQ(GvNAME((GV*)kSVOP->op_sv), "a")) reversed = 0; - else if(strEQ(GvNAME(kGVOP->op_gv), "b")) + else if(strEQ(GvNAME((GV*)kSVOP->op_sv), "b")) reversed = 1; else return; @@ -5682,10 +5705,10 @@ S_simplify_sort(pTHX_ OP *o) if (kUNOP->op_first->op_type != OP_GV) return; kid = kUNOP->op_first; /* get past rv2sv */ - if (GvSTASH(kGVOP->op_gv) != PL_curstash + if (GvSTASH((GV*)kSVOP->op_sv) != PL_curstash || ( reversed - ? strNE(GvNAME(kGVOP->op_gv), "a") - : strNE(GvNAME(kGVOP->op_gv), "b"))) + ? strNE(GvNAME((GV*)kSVOP->op_sv), "a") + : strNE(GvNAME((GV*)kSVOP->op_sv), "b"))) return; o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL); if (reversed) @@ -6084,11 +6107,11 @@ Perl_peep(pTHX_ register OP *o) o->op_type = OP_AELEMFAST; o->op_ppaddr = PL_ppaddr[OP_AELEMFAST]; o->op_private = (U8)i; - GvAVn(((GVOP*)o)->op_gv); + GvAVn((GV*)((SVOP*)o)->op_sv); } } else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) { - GV *gv = cGVOPo->op_gv; + GV *gv = (GV*)cSVOPo->op_sv; if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) { /* XXX could check prototype here instead of just carping */ SV *sv = sv_newmortal(); diff --git a/op.h b/op.h index c6938c9..d34435b 100644 --- a/op.h +++ b/op.h @@ -94,6 +94,9 @@ typedef U32 PADOFFSET; /* Private for lvalues */ #define OPpLVAL_INTRO 128 /* Lvalue must be localized or lvalue sub */ +/* Private for OP_LEAVE, OP_LEAVESUB, OP_LEAVESUBLV and OP_LEAVEWRITE */ +#define OPpREFCOUNTED 64 /* op_targ carries a refcount */ + /* Private for OP_AASSIGN */ #define OPpASSIGN_COMMON 64 /* Left & right have syms in common. */ @@ -235,9 +238,9 @@ struct svop { SV * op_sv; }; -struct gvop { +struct padop { BASEOP - GV * op_gv; + PADOFFSET op_padix; }; struct pvop { @@ -261,7 +264,7 @@ struct loop { #define cLOGOP ((LOGOP*)PL_op) #define cPMOP ((PMOP*)PL_op) #define cSVOP ((SVOP*)PL_op) -#define cGVOP ((GVOP*)PL_op) +#define cPADOP ((PADOP*)PL_op) #define cPVOP ((PVOP*)PL_op) #define cCOP ((COP*)PL_op) #define cLOOP ((LOOP*)PL_op) @@ -272,7 +275,7 @@ struct loop { #define cLOGOPo ((LOGOP*)o) #define cPMOPo ((PMOP*)o) #define cSVOPo ((SVOP*)o) -#define cGVOPo ((GVOP*)o) +#define cPADOPo ((PADOP*)o) #define cPVOPo ((PVOP*)o) #define cCVOPo ((CVOP*)o) #define cCOPo ((COP*)o) @@ -284,7 +287,7 @@ struct loop { #define kLOGOP ((LOGOP*)kid) #define kPMOP ((PMOP*)kid) #define kSVOP ((SVOP*)kid) -#define kGVOP ((GVOP*)kid) +#define kPADOP ((PADOP*)kid) #define kPVOP ((PVOP*)kid) #define kCOP ((COP*)kid) #define kLOOP ((LOOP*)kid) @@ -314,7 +317,7 @@ struct loop { #define OA_LISTOP (4 << OCSHIFT) #define OA_PMOP (5 << OCSHIFT) #define OA_SVOP (6 << OCSHIFT) -#define OA_GVOP (7 << OCSHIFT) +#define OA_PADOP (7 << OCSHIFT) #define OA_PVOP_OR_SVOP (8 << OCSHIFT) #define OA_LOOP (9 << OCSHIFT) #define OA_COP (10 << OCSHIFT) diff --git a/opcode.h b/opcode.h index 419dea7..c2bb457 100644 --- a/opcode.h +++ b/opcode.h @@ -1458,8 +1458,8 @@ EXT U32 PL_opargs[] = { 0x00000004, /* pushmark */ 0x00000014, /* wantarray */ 0x00000c04, /* const */ - 0x00000e44, /* gvsv */ - 0x00000e44, /* gv */ + 0x00000c44, /* gvsv */ + 0x00000c44, /* gv */ 0x00022440, /* gelem */ 0x00000044, /* padsv */ 0x00000040, /* padav */ @@ -1578,7 +1578,7 @@ EXT U32 PL_opargs[] = { 0x0001368e, /* lc */ 0x0001378e, /* quotemeta */ 0x00000248, /* rv2av */ - 0x00026e04, /* aelemfast */ + 0x00026c04, /* aelemfast */ 0x00026404, /* aelem */ 0x00046801, /* aslice */ 0x00009600, /* each */ diff --git a/opcode.pl b/opcode.pl index 0b91f3c..c9174f2 100755 --- a/opcode.pl +++ b/opcode.pl @@ -184,7 +184,7 @@ END '@', 4, # listop '/', 5, # pmop '$', 6, # svop - '*', 7, # gvop + '#', 7, # padop '"', 8, # pvop_or_svop '{', 9, # loop ';', 10, # cop @@ -350,8 +350,8 @@ wantarray wantarray ck_null is0 const constant item ck_svconst s$ -gvsv scalar variable ck_null ds* -gv glob value ck_null ds* +gvsv scalar variable ck_null ds$ +gv glob value ck_null ds$ gelem glob elem ck_null d2 S S padsv private variable ck_null ds0 padav private array ck_null d0 @@ -511,7 +511,7 @@ quotemeta quotemeta ck_fun fsTu% S? # Arrays. rv2av array dereference ck_rvconst dt1 -aelemfast constant array element ck_null s* A S +aelemfast constant array element ck_null s$ A S aelem array element ck_null s2 A S aslice array slice ck_null m@ A L diff --git a/perl.h b/perl.h index 0370634..d19842b 100644 --- a/perl.h +++ b/perl.h @@ -1389,7 +1389,7 @@ typedef struct listop LISTOP; typedef struct logop LOGOP; typedef struct pmop PMOP; typedef struct svop SVOP; -typedef struct gvop GVOP; +typedef struct padop PADOP; typedef struct pvop PVOP; typedef struct loop LOOP; diff --git a/pp_hot.c b/pp_hot.c index a7fd9dc..6f9528a 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -58,9 +58,9 @@ PP(pp_gvsv) djSP; EXTEND(SP,1); if (PL_op->op_private & OPpLVAL_INTRO) - PUSHs(save_scalar(cGVOP->op_gv)); + PUSHs(save_scalar((GV*)cSVOP->op_sv)); else - PUSHs(GvSV(cGVOP->op_gv)); + PUSHs(GvSV((GV*)cSVOP->op_sv)); RETURN; } @@ -95,7 +95,7 @@ PP(pp_stringify) PP(pp_gv) { djSP; - XPUSHs((SV*)cGVOP->op_gv); + XPUSHs(cSVOP->op_sv); RETURN; } diff --git a/pp_sys.c b/pp_sys.c index 271d0ca..9c73980 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -411,7 +411,7 @@ PP(pp_indread) PP(pp_rcatline) { - PL_last_in_gv = cGVOP->op_gv; + PL_last_in_gv = (GV*)cSVOP->op_sv; return do_readline(); } @@ -2412,7 +2412,7 @@ PP(pp_stat) STRLEN n_a; if (PL_op->op_flags & OPf_REF) { - tmpgv = cGVOP->op_gv; + tmpgv = (GV*)cSVOP->op_sv; do_fstat: if (tmpgv != PL_defgv) { PL_laststype = OP_STAT; @@ -2857,7 +2857,7 @@ PP(pp_fttty) STRLEN n_a; if (PL_op->op_flags & OPf_REF) - gv = cGVOP->op_gv; + gv = (GV*)cSVOP->op_sv; else if (isGV(TOPs)) gv = (GV*)POPs; else if (SvROK(TOPs) && isGV(SvRV(TOPs))) @@ -2898,7 +2898,7 @@ PP(pp_fttext) STRLEN n_a; if (PL_op->op_flags & OPf_REF) - gv = cGVOP->op_gv; + gv = (GV*)cSVOP->op_sv; else if (isGV(TOPs)) gv = (GV*)POPs; else if (SvROK(TOPs) && isGV(SvRV(TOPs))) @@ -2949,7 +2949,7 @@ PP(pp_fttext) else { if (ckWARN(WARN_UNOPENED)) Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>", - GvENAME(cGVOP->op_gv)); + GvENAME((GV*)cSVOP->op_sv)); SETERRNO(EBADF,RMS$_IFI); RETPUSHUNDEF; } diff --git a/regexec.c b/regexec.c index c51ddee..1dbdc59 100644 --- a/regexec.c +++ b/regexec.c @@ -1404,7 +1404,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } break; default: - croak("panic: unknown regstclass %d", (int)OP(c)); + Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c)); break; } } diff --git a/run.c b/run.c index 38c35e0..a6391e9 100644 --- a/run.c +++ b/run.c @@ -71,9 +71,9 @@ Perl_debop(pTHX_ OP *o) break; case OP_GVSV: case OP_GV: - if (cGVOPo->op_gv) { + if (cSVOPo->op_sv) { sv = NEWSV(0,0); - gv_fullname3(sv, cGVOPo->op_gv, Nullch); + gv_fullname3(sv, (GV*)cSVOPo->op_sv, Nullch); PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a)); SvREFCNT_dec(sv); }