From: Gurusamy Sarathy Date: Mon, 10 May 1999 07:49:26 +0000 (+0000) Subject: more Compiler patches from Vishal Bhatia X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=56eca212f2b30bfbbee425e020ba96a43f99cca5;p=p5sagit%2Fp5-mst-13.2.git more Compiler patches from Vishal Bhatia Date: Tue, 27 Apr 1999 23:47:24 PDT Message-ID: <19990428064724.95244.qmail@hotmail.com> Subject: [PATCH 5.005_56] Saving Tied hashes ( C.pm) -- Date: Thu, 29 Apr 1999 18:21:06 -0700 Message-ID: Subject: [PATCH 5.005_56] double constants ( C.pm) -- Date: Mon, 03 May 1999 20:21:31 PDT Message-ID: <19990504032131.81113.qmail@hotmail.com> Subject: [PATCH 5.005_56] Overloading implementation ( Compiler) -- Date: Thu, 06 May 1999 17:57:09 -0700 Message-ID: Subject: Stash.pm p4raw-id: //depot/perl@3359 --- diff --git a/ext/B/B.pm b/ext/B/B.pm index f864883..0bfceaf 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -11,7 +11,7 @@ require Exporter; @ISA = qw(Exporter DynaLoader); @EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname class peekop cast_I32 cstring cchar hash threadsv_names - main_root main_start main_cv svref_2object opnumber + main_root main_start main_cv svref_2object opnumber amagic_generation walkoptree walkoptree_slow walkoptree_exec walksymtable parents comppadlist sv_undef compile_stats timing_info init_av); sub OPf_KIDS (); @@ -750,6 +750,10 @@ Returns the SV object corresponding to the C variable C. Returns the SV object corresponding to the C variable C. +=item amagic_generation + +Returns the SV object corresponding to the C variable C. + =item walkoptree(OP, METHOD) Does a tree-walk of the syntax tree based at OP and calls METHOD on diff --git a/ext/B/B.xs b/ext/B/B.xs index dd50d97..466091d 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -454,6 +454,7 @@ BOOT: #define B_init_av() PL_initav #define B_main_root() PL_main_root #define B_main_start() PL_main_start +#define B_amagic_generation() PL_amagic_generation #define B_comppadlist() (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv)) #define B_sv_undef() &PL_sv_undef #define B_sv_yes() &PL_sv_yes @@ -471,6 +472,9 @@ B_main_root() B::OP B_main_start() +long +B_amagic_generation() + B::AV B_comppadlist() diff --git a/ext/B/B/Bblock.pm b/ext/B/B/Bblock.pm index cb007ff..14001b3 100644 --- a/ext/B/B/Bblock.pm +++ b/ext/B/B/Bblock.pm @@ -21,8 +21,8 @@ sub mark_leader { sub find_leaders { my ($root, $start) = @_; $bblock = {}; - mark_leader($start); - walkoptree($root, "mark_if_leader"); + mark_leader($start) if ( ref $start ne "B::NULL" ); + walkoptree($root, "mark_if_leader") if ((ref $root) ne "B::NULL") ; return $bblock; } @@ -103,6 +103,12 @@ sub B::LISTOP::mark_if_leader { mark_leader($op->next); } +sub B::LISTOP::mark_if_leader { + my $op = shift; + mark_leader($op->first); + mark_leader($op->next); +} + sub B::PMOP::mark_if_leader { my $op = shift; if ($op->ppaddr ne "pp_pushre") { diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm index ec39de2..4aa80a1 100644 --- a/ext/B/B/C.pm +++ b/ext/B/B/C.pm @@ -49,7 +49,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 main_cv init_av opnumber + threadsv_names main_cv init_av opnumber amagic_generation AVf_REAL HEf_SVKEY); use B::Asmdata qw(@specialsv_name); @@ -401,7 +401,9 @@ sub B::NV::save { my ($sv) = @_; my $sym = objsym($sv); return $sym if defined $sym; - $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $sv->NVX)); + my $val= $sv->NVX; + $val .= '.00' if $val =~ /^-?\d+$/; + $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $val)); $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x", $xpvnvsect->index, $sv->REFCNT + 1, $sv->FLAGS)); return savesym($sv, sprintf("&sv_list[%d]", $svsect->index)); @@ -453,8 +455,10 @@ sub B::PVNV::save { $pv = '' unless defined $pv; my $len = length($pv); my ($pvsym, $pvmax) = savepv($pv); + my $val= $sv->NVX; + $val .= '.00' if $val =~ /^-?\d+$/; $xpvnvsect->add(sprintf("%s, %u, %u, %d, %s", - $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX)); + $pvsym, $len, $pvmax, $sv->IVX, $val)); $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x", $xpvnvsect->index, $sv->REFCNT + 1, $sv->FLAGS)); if (!$pv_copy_on_grow) { @@ -524,6 +528,7 @@ sub B::PVMG::save_magic { my ($sv) = @_; #warn sprintf("saving magic for %s (0x%x)\n", class($sv), $$sv); # debug my $stash = $sv->SvSTASH; + $stash->save; if ($$stash) { warn sprintf("xmg_stash = %s (0x%x)\n", $stash->NAME, $$stash) if $debug_mg; @@ -542,6 +547,7 @@ sub B::PVMG::save_magic { class($sv), $$sv, class($obj), $$obj, cchar($type), cstring($ptr)); } + $obj->save; if ($len == HEf_SVKEY){ #The pointer is an SV* $ptrsv=svref_2object($ptr)->save; @@ -884,6 +890,7 @@ sub B::HV::save { } $init->add("}"); } + $hv->save_magic(); return savesym($hv, "(HV*)&sv_list[$sv_list_index]"); } @@ -1297,11 +1304,13 @@ sub save_context my $curpad_sym = (comppadlist->ARRAY)[1]->save; my $inc_hv = svref_2object(\%INC)->save; my $inc_av = svref_2object(\@INC)->save; + my $amagic_generate= amagic_generation; $init->add( "PL_curpad = AvARRAY($curpad_sym);", "GvHV(PL_incgv) = $inc_hv;", "GvAV(PL_incgv) = $inc_av;", "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));", - "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));"); + "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));", + "PL_amagic_generation= $amagic_generate;" ); } sub descend_marked_unused { diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm index 143ae41..649f6e1 100644 --- a/ext/B/B/CC.pm +++ b/ext/B/B/CC.pm @@ -8,7 +8,7 @@ package B::CC; use strict; use B qw(main_start main_root class comppadlist peekop svref_2object - timing_info init_av sv_undef + timing_info init_av sv_undef amagic_generation OPf_WANT_LIST OPf_WANT OPf_MOD OPf_STACKED OPf_SPECIAL OPpASSIGN_BACKWARDS OPpLVAL_INTRO OPpDEREF_AV OPpDEREF_HV OPpDEREF OPpFLIP_LINENUM G_ARRAY G_SCALAR @@ -1424,7 +1424,12 @@ sub cc { warn sprintf("Basic block analysis at %s\n", timing_info); } $leaders = find_leaders($root, $start); - @bblock_todo = ($start, values %$leaders); + my @leaders= keys %$leaders; + if ($#leaders > -1) { + @bblock_todo = ($start, values %$leaders) ; + } else{ + runtime("return PL_op?PL_op->op_next:0;"); + } if ($debug_timings) { warn sprintf("Compilation at %s\n", timing_info); } @@ -1488,6 +1493,7 @@ sub cc_main { my $inc_hv = svref_2object(\%INC)->save; my $inc_av = svref_2object(\@INC)->save; + my $amagic_generate= amagic_generation; return if $errors; if (!defined($module)) { $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}), @@ -1498,6 +1504,7 @@ sub cc_main { "GvAV(PL_incgv) = $inc_av;", "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));", "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));", + "PL_amagic_generation= $amagic_generate;", ); } diff --git a/ext/B/B/Stash.pm b/ext/B/B/Stash.pm index 42c8bc0..828ffac 100644 --- a/ext/B/B/Stash.pm +++ b/ext/B/B/Stash.pm @@ -11,12 +11,15 @@ END { } sub scan{ my $start=shift; + my $prefix=shift; + $prefix = '' unless defined $prefix; my @return; foreach my $key ( keys %{$start}){ +# print $prefix,$key,"\n"; if ($key =~ /::$/){ unless ($start eq ${$start}{$key} or $key eq "B::" ){ - push @return, $key ; - foreach my $subscan ( scan(${$start}{$key})){ + push @return, $key unless omit($prefix.$key); + foreach my $subscan ( scan(${$start}{$key},$prefix.$key)){ push @return, "$key".$subscan; } } @@ -24,6 +27,16 @@ sub scan{ } return @return; } -1; - +sub omit{ + my $module = shift; + my %omit=("DynaLoader::" => 1 , "CORE::" => 1 , + "CORE::GLOBAL::" => 1, "UNIVERSAL::" => 1 ); + return 1 if $omit{$module}; + if ($module eq "IO::" or $module eq "IO::Handle::"){ + $module =~ s/::/\//g; + return 1 unless $INC{$module}; + } + return 0; +} +1; diff --git a/t/harness b/t/harness index 88bcb38..174b318 100644 --- a/t/harness +++ b/t/harness @@ -19,15 +19,43 @@ $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v'; @tests = unless @tests; Test::Harness::runtests @tests; - -%infinite = ('comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 ); +exit(0) unless -e "../testcompile"; + +%infinite = qw( + op/bop.t 1 + lib/hostname.t 1 + ); +#fudge DATA for now. +%datahandle = qw( + lib/bigint.t 1 + lib/bigintpm.t 1 + lib/bigfloat.t 1 + lib/bigfloatpm.t 1 + ); + +my $dhwrapper = <<'EOT'; +open DATA,"<".__FILE__; +until (($_=) =~ /^__END__/) {}; +EOT @tests = grep (!$infinite{$_}, @tests); - -if (-e "../testcompile") -{ - print "The tests ", join(' ', keys(%infinite)), - " generate infinite loops! Skipping!\n"; - - $ENV{'COMPILE_TEST'} = 1; Test::Harness::runtests @tests; +@tests = map { + my $new = $_; + if ($datahandle{$_}) { + $new .= '.t'; + local(*F, *T); + open(F,"<$_") or die "Can't open $_: $!"; + open(T,">$new") or die "Can't open $new: $!"; + print T $dhwrapper, ; + close F; + close T; + } + $new; + } @tests; + +print "The tests ", join(' ', keys(%infinite)), + " generate infinite loops! Skipping!\n"; +$ENV{'COMPILE_TEST'} = 1; Test::Harness::runtests @tests; +foreach (keys %datahandle) { + unlink "$_.t"; }