Permalink
Browse files

Bytecode: save_cq => save_begin+save_init_end: moved push_begin upfro…

…nt for the same

	    init order (44).
	  added option -i includeall which adds no BEGIN require ops, but adds 
	    all included symbols.
perlcc: better --staticxs libname on darwin
testplc.sh: test also other options: -s, -k, -i
bytecode.t: run tests with -H


git-svn-id: http://perl-compiler.googlecode.com/svn/trunk@990 ed534f1a-1453-0410-ab30-dfc593a8b23c
  • Loading branch information...
Reini Urban
Reini Urban committed Apr 22, 2011
1 parent 18f7cb3 commit 92ae860fcf468ab64d23f520271d83004c3548db
Showing with 153 additions and 102 deletions.
  1. +9 −4 Changes
  2. +78 −55 lib/B/Bytecode.pm
  3. +2 −2 log.modules-5.006002d-nt
  4. +3 −4 perloptree.pod
  5. +6 −3 script/perlcc.PL
  6. +11 −14 t/bytecode.t
  7. +3 −4 t/cc_last.t
  8. +41 −16 t/testplc.sh
View
13 Changes
@@ -4,10 +4,15 @@
quite fine with Perl 5.6 and 5.8
1.32 2011-04-?? rurban
-
- * Bytecode.pm (1.11): fixed const xsub xsubany ptr >=5.10 <5.14 (27)
- * C.pm (1.32): check PERL_TRACK_MEMPOOL for AV malloc (25)
- fixed init chunk splitting for CV and -fav-init2 (if >10000 lines)
+ more darwin and bytecode fixes.
+
+ * Bytecode.pm (1.11): fixed const xsub xsubany ptr >=5.10 <5.14 (27).
+ save_cq => save_begin+save_init_end: moved push_begin upfront for the same
+ init order (44).
+ added option -i includeall which adds no BEGIN require ops, but adds
+ all included symbols.
+ * C.pm (1.32): check PERL_TRACK_MEMPOOL for AV malloc (25).
+ fixed init chunk splitting for CV and -fav-init2, if >10000 lines.
* Makefile.PL: move cc_runtime.h installation to make install step
(sudo). Tested ok on darwin gcc, does use -I. internally.
* cc_runtime.h: renamed from cc_runtime514.h
View
@@ -52,8 +52,8 @@ my $PERL510 = ( $] >= 5.009005 );
my $PERL512 = ( $] >= 5.011 );
#my $PERL514 = ( $] >= 5.013002 );
my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/);
-our ($quiet, %debug);
-my ( $varix, $opix, $savebegins, %walked, %files, @cloop );
+our ($quiet, $includeall, $savebegins);
+my ( $varix, $opix, %debug, %walked, %files, @cloop );
my %strtab = ( 0, 0 );
my %svtab = ( 0, 0 );
my %optab = ( 0, 0 );
@@ -483,7 +483,7 @@ sub B::PVNV::bsave {
sub B::PVMG::domagic {
my ( $sv, $ix ) = @_;
- nice1 '-MAGICAL-'; # XXX TODO no empty line before
+ nice1 '-MAGICAL-'; # no empty line before
my @mglist = $sv->MAGIC;
my ( @mgix, @namix );
for (@mglist) {
@@ -569,7 +569,8 @@ sub B::CV::bsave {
my $outsideix = $cv->OUTSIDE->ix;
my $startix = $cv->START->opwalk;
my $rootix = $cv->ROOT->ix;
- my $xsubanyix = ($cv->CONST and !$PERL56) ? $cv->XSUBANY->ix : 0;
+ # TODO 5.14 will need CvGV_set to add backref magic
+ my $xsubanyix = ($cv->CONST and !$PERL56) ? $cv->XSUBANY->ix : 0;
$cv->B::PVMG::bsave($ix);
asm "xcv_stash", $stashix;
@@ -640,7 +641,6 @@ sub B::GV::desired {
eval "require B::Debug;";
$gv->debug;
}
- #unless ($] > 5.013005 and $hv->NAME eq 'B')
$files{ $gv->FILE } && $gv->LINE
|| ${ $cv = $gv->CV } && $files{ $cv->FILE }
|| ${ $form = $gv->FORM } && $files{ $form->FILE };
@@ -666,30 +666,13 @@ sub B::HV::bwalk {
if ($] > 5.013005 and $hv->NAME eq 'B') { # see above. omit B prototypes
return;
}
- # XXX Not working! Special init for empty (null-string) prototypes
- # Note: not found constants are &PL_sv_yes, found typically IV
- if ($PERL510 and 0 and $v->SvTYPE == $SVt_PV and !$v->PVX) {
- nice "[emptyCONST $tix]";
- B::Assembler::maxsvix($tix) if $debug{A};
- asm "newpv", pvstring ($hv->NAME . "::" . $k);
- # Beware of special gv_fetchpv GV_* flags.
- # gv_fetchpvx uses only GV_ADD, which fails e.g. with *Fcntl::O_SHLOCK,
- # if "Your vendor has not defined Fcntl macro O_SHLOCK"
- asm "gv_fetchpvn_flags", 1 << 7 + $SVt_PV,
- "f:0x81<<7+t:PV";# GVf_IMPORTED_CV+INTRO
- $svtab{$$v} = $varix = $tix;
- asm "sv_flags", $v->FLAGS, ashex($v->FLAGS);
- $v->bsave( $tix++ );
- #$tix++;
- } else {
- nice "[prototype $tix]";
- B::Assembler::maxsvix($tix) if $debug{A};
- asm "gv_fetchpvx", cstring ($hv->NAME . "::" . $k);
- $svtab{$$v} = $varix = $tix;
- # we need the sv_flags before, esp. for DEBUGGING asserts
- asm "sv_flags", $v->FLAGS, ashex($v->FLAGS);
- $v->bsave( $tix++ );
- }
+ nice "[prototype $tix]";
+ B::Assembler::maxsvix($tix) if $debug{A};
+ asm "gv_fetchpvx", cstring ($hv->NAME . "::" . $k);
+ $svtab{$$v} = $varix = $tix;
+ # we need the sv_flags before, esp. for DEBUGGING asserts
+ asm "sv_flags", $v->FLAGS, ashex($v->FLAGS);
+ $v->bsave( $tix++ );
}
}
}
@@ -1010,9 +993,19 @@ sub B::OP::opwalk {
}
}
-sub save_cq {
+# Do run-time requires with -s savebegin and without -i includeall.
+# Otherwise all side-effects of BEGIN blocks are already in the current
+# compiled code.
+# -s or !-i will have smaller code, but run-time access of dependent modules
+# such as with python, where all modules are byte-compiled.
+# With -i the behaviour is similar to the C or CC compiler, where everything
+# is packed into one file.
+# Redo only certain ops, such as push @INC ""; unshift @INC "" (TODO *INC)
+# use/require defs and boot sections are already included.
+sub save_begin {
my $av;
- if ( ( $av = begin_av )->isa("B::AV") ) {
+ if ( ( $av = begin_av )->isa("B::AV") and $av->ARRAY) {
+ nice '<push_begin>';
if ($savebegins) {
for ( $av->ARRAY ) {
next unless $_->FILE eq $0;
@@ -1025,36 +1018,44 @@ sub save_cq {
# XXX BEGIN { goto A while 1; A: }
for ( my $op = $_->START ; $$op ; $op = $op->next ) {
- # special cases for:
+ # special case only for @INC manip
# 1. push|unshift @INC, "libpath"
- if ($op->name =~ /^(unshift|push)$/) {
- asm "push_begin", $_->ix;
+ if ($op->name =~ /^(unshift|push)$/) { # XXX need to check for @INC
+ nice1 '<unshift|push in BEGIN>';
+ asm "push_begin", $_->ix if $_;
last;
}
- # 2. use|require ... unless in tests
- next unless $op->name eq 'require' ||
-
- # this kludge needed for tests
- $op->name eq 'gv' && do {
- my $gv =
- class($op) eq 'SVOP'
- ? $op->gv
- : ( ( $_->PADLIST->ARRAY )[1]->ARRAY )[ $op->padix ];
- $$gv && $gv->NAME =~ /use_ok|plan/;
- };
- asm "push_begin", $_->ix;
- last;
+ # 2. no use|require
+ if (!$includeall) {
+ next if $op->name eq 'require';
+ # this kludge needed for tests
+ $op->name eq 'gv' && do {
+ my $gv = class($op) eq 'SVOP'
+ ? $op->gv
+ : ( ( $_->PADLIST->ARRAY )[1]->ARRAY )[ $op->padix ];
+ $$gv && $gv->NAME =~ /use_ok|plan/;
+ };
+ nice1 '<require in BEGIN>';
+ asm "push_begin", $_->ix if $_;
+ last;
+ }
}
}
}
}
- if ( ( $av = init_av )->isa("B::AV") ) {
+}
+
+sub save_init_end {
+ my $av;
+ if ( ( $av = init_av )->isa("B::AV") and $av->ARRAY ) {
+ nice '<push_init>';
for ( $av->ARRAY ) {
next unless $_->FILE eq $0;
asm "push_init", $_->ix;
}
}
- if ( ( $av = end_av )->isa("B::AV") ) {
+ if ( ( $av = end_av )->isa("B::AV") and $av->ARRAY ) {
+ nice '<push_end>';
for ( $av->ARRAY ) {
next unless $_->FILE eq $0;
asm "push_end", $_->ix;
@@ -1094,6 +1095,11 @@ sub compile {
my ( $head, $scan, $T_inhinc, $keep_syn, $module );
my $cwd = '';
$files{$0} = 1;
+ # includeall mode (without require):
+ if ($includeall) {
+ # add imported symbols => values %INC
+ $files{$_} = 1 for values %INC;
+ }
sub keep_syn {
$keep_syn = 1;
@@ -1147,6 +1153,9 @@ use ByteLoader '$ByteLoader::VERSION';
elsif (/^-f(.*)$/) {
$files{$1} = 1;
}
+ elsif (/^-i/) {
+ $includeall = 1;
+ }
elsif (/^-D(.*)$/) {
$debug{$1}++;
}
@@ -1201,6 +1210,8 @@ use ByteLoader '$ByteLoader::VERSION';
print $head if $head;
newasm sub { print @_ };
+ save_begin;
+ nice '<end_begin>';
if (!$PERL56) {
defstash->bwalk;
} else {
@@ -1231,7 +1242,7 @@ use ByteLoader '$ByteLoader::VERSION';
if !$PERL56 and warnhook->ix;
nice '<incav>';
asm "incav", inc_gv->AV->ix if $T_inhinc;
- save_cq;
+ save_init_end;
asm "incav", inc_gv->AV->ix if $T_inhinc;
asm "dowarn", dowarn unless $PERL56;
@@ -1283,6 +1294,7 @@ the sourcecode in memory.
=item B<-H>
Prepend a C<use ByteLoader VERSION;> line to the produced bytecode.
+This way you will not need to add C<-MByteLoader> to your perl command-line.
=item B<-b>
@@ -1322,6 +1334,19 @@ C<main_root>, C<main_cv> and C<curpad> are omitted.
"use package." Might be needed of the package is not automatically detected.
+=item B<-f>I<file>
+
+Include file. If not -i define all symbols in the given included
+source file. -i adds all included files.
+
+=item B<-i> includeall
+
+Include all used packages and its symbols. Does no run-time require from
+BEGIN blocks (C<use> package).
+
+This creates bigger and more independent code, but is more error prone and
+does not support pre-compiled C<.pmc> modules.
+
=item B<-q>
Be quiet.
@@ -1342,17 +1367,17 @@ Set the COP file - for running within the CORE testsuite.
OPs, prints each OP as it's processed
-=item B<-D>I<M>
+=item B<-DM>
Debugging flag for more verbose STDERR output.
B<M> for Magic and Matches.
-=item B<-D>I<G>
+=item B<-DG>
Debug GV's
-=item B<-D>I<A>
+=item B<-DA>
Set developer B<A>ssertions, to help find possible obj-indices out of range.
@@ -1393,8 +1418,6 @@ Special GV's fail.
There are also undocumented bugs and options.
-THIS CODE IS HIGHLY EXPERIMENTAL. USE AT YOUR OWN RISK.
-
=head1 AUTHORS
Originally written by Malcolm Beattie 1996 and
View
@@ -1,6 +1,6 @@
-# B::C::VERSION = 1.32 r979
+# B::C::VERSION = 1.32 r989 M
# perlversion = 5.006002d-nt
-# path = /usr/local/bin/perl5.6.2d-nt
+# path = /usr/local/bin/perl5.6.2
# platform = cygwin 32bit
# non-threaded perl
pass Exporter
View
@@ -6,7 +6,7 @@ perloptree - The Perl op tree
Various material about the internal Perl compilation representation
during parsing and optimization, before the actual execution
-begins. The B<"B" op tree>.
+begins, represented as C<B> objects, the B<"B" op tree>.
The well-known L<perlguts.pod> focuses more on the internal
representation of the variables, but not so on the structure, the
@@ -16,8 +16,7 @@ And we have L<perlhack.pod>, which shows e.g. ways to hack into
the op tree structure within the debugger. It focuses on getting
people to start patching and hacking on the CORE, not
understanding or writing compiler backends or optimizations,
-which the op tree mainly is used for. Btw., this here is merely
-prose around the source comments. But who reads source?
+which the op tree mainly is used for.
=head1 Brief Summary
@@ -47,7 +46,7 @@ of the following to be called (oversimplifying a bit):
See also L<perlhack.pod#Op Trees>
-The simplest type of an op structure is C<OP>, a L</BASEOP>: this
+The simpliest type of an op structure is C<OP>, a L</BASEOP>: this
has no children. Unary operators, L</UNOP>s, have one child, and
this is pointed to by the C<op_first> field. Binary operators
(L</BINOP>s) have not only an C<op_first> field but also an
View
@@ -430,13 +430,16 @@ sub compile_cstyle {
if ($l) {
$l = substr($l,1);
if ($^O eq 'darwin' and $l =~/\.bundle$/) {
- $dylib = $l; $dylib =~ s/\.bundle$/.a/;
- $dylib = basename($dylib) unless -w $dylib;
+ $dylib = $l;
+ $dylib =~ s/\.bundle$/.a/;
+ $dylib =~ s{^.*/auto/}{};
+ $dylib =~ s{/.+?(/[^/]+)}{$1};
+ $dylib =~ s{/}{_}g;
if (-e $dylib) {
vprint 2, "Using static ".$dylib;
} else {
vprint 1, "Creating static ".$dylib;
- vprint 5, "libtool -static ".$l." -o ".$dylib;
+ vprint 4, "libtool -static ".$l." -o ".$dylib;
system("libtool","-static",$l,"-o",$dylib);
}
$l = "./".$dylib;
Oops, something went wrong.

0 comments on commit 92ae860

Please sign in to comment.