implement C<goto &func> and other fixes (via private mail)

	Message-Id: <19981022055904.20083.qmail@hotmail.com>
	Subject: [PATCH 5.005_52] More fixes for B

p4raw-id: //depot/perl@2072

diff --git a/ext/B/B.pm b/ext/B/B.pm
index d5137d4..562f56b 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -530,6 +530,8 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>).
 
 =item XSUBANY
 
+=item CvFLAGS
+
 =back
 
 =head2 B::HV METHODS

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 8dbc915..855b3fd 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1164,6 +1164,13 @@ CvXSUBANY(cv)
     CODE:
        ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
 
+MODULE = B    PACKAGE = B::CV
+
+U8
+CvFLAGS(cv)
+      B::CV   cv
+
+
 MODULE = B     PACKAGE = B::HV         PREFIX = Hv
 
 STRLEN

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 0b7d6eb..1e999e7 100644 (file)
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -13,7 +13,7 @@ use Exporter ();
 
 use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
         class cstring cchar svref_2object compile_stats comppadlist hash
-        threadsv_names);
+        threadsv_names main_cv );
 use B::Asmdata qw(@specialsv_name);
 
 use FileHandle;
@@ -596,10 +596,15 @@ sub B::CV::save {
        warn sprintf("No definition for sub %s::%s (unable to autoload)\n",
                     $cvstashname, $cvname); # debug
     }
-    $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%x, (CV*)s\\_%x, 0",
+    $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%x, (CV*)s\\_%x, 0x%x",
                          $xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
                          $cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH,
-                         $$padlist, ${$cv->OUTSIDE}));
+                        $$padlist, ${$cv->OUTSIDE}, $cv->CvFLAGS));
+
+    if (${$cv->OUTSIDE} == ${main_cv()}){
+       $init->add(sprintf("CvOUTSIDE(s\\_%x)=PL_main_cv;",$$cv));
+    }
+
     if ($$gv) {
        $gv->save;
        $init->add(sprintf("CvGV(s\\_%x) = s\\_%x;",$$cv,$$gv));
@@ -1091,6 +1096,7 @@ sub save_unused_subs {
 }
 
 sub save_main {
+    my $curpad_nam = (comppadlist->ARRAY)[0]->save;
     my $curpad_sym = (comppadlist->ARRAY)[1]->save;
     walkoptree(main_root, "save");
     warn "done main optree, walking symtable for extras\n" if $debug_cv;
@@ -1098,7 +1104,10 @@ sub save_main {
 
     $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
               sprintf("PL_main_start = s\\_%x;", ${main_start()}),
-              "PL_curpad = AvARRAY($curpad_sym);");
+              "PL_curpad = AvARRAY($curpad_sym);",
+               "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
+               "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
+
     output_boilerplate();
     print "\n";
     output_all("perl_init");

diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index 7194819..c58a832 100644 (file)
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -946,13 +946,25 @@ sub pp_entersub {
     write_back_lexicals(REGISTER|TEMPORARY);
     write_back_stack();
     my $sym = doop($op);
-    runtime("if (PL_op != ($sym)->op_next) PL_op = (*PL_op->op_ppaddr)(ARGS);");
-    runtime("SPAGAIN;");
+    runtime("while (PL_op != ($sym)->op_next && PL_op != (OP*)0 ){");
+    runtime("PL_op = (*PL_op->op_ppaddr)(ARGS);");
+    runtime("SPAGAIN;}");
     $know_op = 0;
     invalidate_lexicals(REGISTER|TEMPORARY);
     return $op->next;
 }
 
+sub pp_goto{
+
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    write_back_lexicals() unless $skip_lexicals{$ppname};
+    write_back_stack() unless $skip_stack{$ppname};
+    my $sym=doop($op);
+    runtime("if (PL_op != ($sym)->op_next && PL_op != (OP*)0){return PL_op;}");
+    invalidate_lexicals() unless $skip_invalidate{$ppname};
+    return $op->next;
+}
 sub pp_enterwrite {
     my $op = shift;
     pp_entersub($op);
@@ -1375,6 +1387,7 @@ sub cc_obj {
 
 sub cc_main {
     my @comppadlist = comppadlist->ARRAY;
+    my $curpad_nam = $comppadlist[0]->save;
     my $curpad_sym = $comppadlist[1]->save;
     my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
     save_unused_subs(@unused_sub_packages);
@@ -1384,7 +1397,9 @@ sub cc_main {
     if (!defined($module)) {
        $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
                   "PL_main_start = $start;",
-                  "PL_curpad = AvARRAY($curpad_sym);");
+                  "PL_curpad = AvARRAY($curpad_sym);",
+                  "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
+                  "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
     }
     output_boilerplate();
     print "\n";