Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

B-C-1.04_09

git-svn-id: http://perl-compiler.googlecode.com/svn/trunk@10 ed534f1a-1453-0410-ab30-dfc593a8b23c
  • Loading branch information...
commit 085dfc74de4a1a45888f1601fd7151748c069cc0 1 parent 178a2ce
@rurban authored
View
4 Changes
@@ -1,6 +1,10 @@
Started with B-C-1.04_01. The perl compiler was previously in CORE.
TODO: Try to get info about earlier versions.
+1.04_09 2008-02-23 rurban
+ * make t/test*.sh PERL independent
+ * fixed B::C GV init crashes (SvPOK assertion)
+
1.04_08 2008-02-22 rurban
* fixed t/b.t tests for 5.11 (REGEXP, ref RV => IV)
* fixed Makefile.PL deps to ignore the interim .pl files
View
2  META.yml
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: B-C
-version: 1.04_08
+version: 1.04_09
abstract: ~
license: ~
author: ~
View
2  Makefile.PL
@@ -1,7 +1,7 @@
use ExtUtils::MakeMaker;
use Config;
use File::Spec;
-use 5.009005;
+#use 5.009005;
my $core = grep { $_ eq 'PERL_CORE=1' } @ARGV;
View
1  NOTES
@@ -23,6 +23,7 @@ C backend invocation
A prints AV information on saving
C prints CV information on saving
M prints MAGIC information on saving
+ G prints GV information on saving
-f Force optimisations on or off one at a time.
cog Copy-on-grow: PVs declared and initialised statically
no-cog No copy-on-grow
View
4 bytecode.pl
@@ -351,6 +351,8 @@ =head1 DESCRIPTION
A simple mapping of the op type number to its type (like 'COP' or 'BINOP').
+Since Perl version 5.10 defined in L<B>.
+
=item @specialsv_name
my $sv_name = $specialsv_name[$sv_index];
@@ -360,6 +362,8 @@ =head1 DESCRIPTION
This array maps that number back to the name of the SV (like 'Nullsv'
or '&PL_sv_undef').
+Since Perl version 5.10 defined in L<B>.
+
=back
=head1 AUTHOR
View
4 lib/B/Asmdata.pm
@@ -223,6 +223,8 @@ Suitable for using with %insn_data like so:
A simple mapping of the op type number to its type (like 'COP' or 'BINOP').
+Since Perl version 5.10 defined in L<B>.
+
=item @specialsv_name
my $sv_name = $specialsv_name[$sv_index];
@@ -232,6 +234,8 @@ B::SPECIAL and are referred to by a number from the specialsv_list.
This array maps that number back to the name of the SV (like 'Nullsv'
or '&PL_sv_undef').
+Since Perl version 5.10 defined in L<B>.
+
=back
=head1 AUTHOR
View
60 lib/B/C.pm
@@ -1,6 +1,7 @@
# C.pm
#
# Copyright (c) 1996, 1997, 1998 Malcolm Beattie
+# Copyright (c) 2008 Reini Urban
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
@@ -8,7 +9,7 @@
package B::C;
-our $VERSION = '1.04_08';
+our $VERSION = '1.04_09';
package B::C::Section;
@@ -218,7 +219,7 @@ my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect,
$padopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
$pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect,
$xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect,
- $xrvsect, $xpvbmsect, $xpviosect );
+ $xrvsect, $xpvbmsect, $xpviosect, $heksect );
my @op_sections = \( $binopsect, $condopsect, $copsect, $padopsect, $listopsect,
$logopsect, $loopsect, $opsect, $pmopsect, $pvopsect, $svopsect,
$unopsect );
@@ -324,6 +325,16 @@ sub save_pv_or_rv {
return ( $savesym, $pvmax, $len, $pv );
}
+# FIXME! global string table
+sub save_hek {
+ my $str = shift;
+ my $len = length $str;
+ my $hash = 0; # let hv compute it
+ # (HEK*)ptr_table_fetch(PL_ptr_table, source);
+ # FIXME!
+ $heksect->add("hv_store(PL_strtab, \"$str\", $len, NULL, $hash);");
+}
+
# see also init_op_ppaddr below; initializes the ppaddt to the
# OpTYPE; init_op_ppaddr iterates over the ops and sets
# op_ppaddr to PL_ppaddr[op_ppaddr]; this avoids an explicit assignmente
@@ -362,7 +373,7 @@ sub B::OP::fake_ppaddr {
else { $static = '0, 0, 0, 0, 0'; } # opt latefree latefreed attached spare
sub B::OP::_save_common_middle {
my $op = shift;
- my $madprop = $mad ? (" ".($B::VERSION < 1.1801 ? 0:$op->madprop) . ",") : "";
+ my $madprop = $mad ? (" ".($B::VERSION < 1.1801 ? 0 : $op->madprop) . ",") : "";
sprintf ("%s,%s %u, %u, $static, 0x%x, 0x%x",
$op->fake_ppaddr, $madprop, $op->targ, $op->type,
$op->flags, $op->private);
@@ -1129,12 +1140,28 @@ sub B::GV::save {
$egvsym = $egv->save;
}
}
- $init->add(qq[$sym = gv_fetchpv($name, TRUE, SVt_PV);],
- sprintf("SvFLAGS($sym) = 0x%x;", $gv->FLAGS ),
+ $init->add(qq[$sym = gv_fetchpv($name, TRUE, SVt_PV);]);
+ # XXX hack Remove SVpgv_GP (GV has a valid GP) SvFLAGS(sv) &= ~SVpgv_GP
+ # 5.8 had SvFLAGS 0x600d, 5.11 has 0x8009
+ my $svflags = $gv->FLAGS;
+ if ($gv->isGV_with_GP and $is_empty) {
+ warn(sprintf("gv[$name]_with_GP: 0x%x %s %s %s\n", $gv->FLAGS,
+ $gv->FILE, $gv->FILEGV, $gv->GP)) if $debug_gv;
+ $svflags = $gv->FLAGS && 0x8000 ? $gv->FLAGS - 0x8000 : $gv->FLAGS;
+ warn("Removing empty GP from $name\n") if $debug_gv;
+ } elsif (!$is_empty) {
+ $init->add(sprintf("GvGP($sym) = Perl_newGP(aTHX_ $sym); /* 0x%x */", $gv->GP));
+ # $svflags = $gv->FLAGS && 0x400 ? $gv->FLAGS : $gv->FLAGS + 0x400;
+ warn(sprintf("Setting GvGP of $name: 0x%x %s %s %s\n", $svflags,
+ $gv->FILE, $gv->FILEGV, $gv->GP)) if $debug_gv;
+ }
+ $init->add(sprintf("SvFLAGS($sym) = 0x%x;", $svflags ),
sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS));
$init->add(sprintf("GvLINE($sym) = %u;", $gv->LINE)) unless $is_empty;
- # XXX hack for when Perl accesses PVX of GVs
- $init->add("SvPVX($sym) = emptystring;\n");
+ # XXX hack for when Perl accesses PVX of GVs, only if SvPOK
+ #if (!($svflags && 0x400)) {
+ $init->add("if (SvPOK($sym)) SvPVX($sym) = emptystring;\n") unless $is_empty;
+ #}
# Shouldn't need to do save_magic since gv_fetchpv handles that
#$gv->save_magic;
# XXX will always be > 1!!!
@@ -1148,7 +1175,7 @@ sub B::GV::save {
if ($gvrefcnt > 1) {
$init->add(sprintf("GvREFCNT($sym) += %u;", $gvrefcnt - 1));
}
- # some non-alphavetic globs require some parts to be saved
+ # some non-alphabetic globs require some parts to be saved
# ( ex. %!, but not $! )
sub Save_HV() { 1 }
sub Save_AV() { 2 }
@@ -1205,18 +1232,22 @@ sub B::GV::save {
$init->add("\tcv=perl_get_cv($origname,TRUE);");
$init->add("\tGvCV($sym)=cv;");
$init->add("\tSvREFCNT_inc((SV *)cv);");
- $init->add("}");
+ $init->add("}");
} else {
$init->add(sprintf("GvCV($sym) = (CV*)(%s);", $gvcv->save));
warn "GV::save &$name\n" if $debug_gv;
}
}
- if ($] < 5.009) {
+ if ($] > 5.009) {
+ my $file = cstring($gv->FILE);
+ $heksect->add($file);
+ $init->add(sprintf("GvFILE_HEK($sym) = share_hek(%s,%u,0);",
+ $file, length($file)));
+ warn "GV::save GvFILE_HEK(*$name) = share_hek($file)\n" if $debug_gv;
+ } else {
$init->add(sprintf("GvFILE($sym) = %s;", cstring($gv->FILE)));
- } else {
- $init->add(sprintf("GvFILE_HEK($sym) = %s;", cstring($gv->FILE)));
+ warn "GV::save GvFILE(*$name) = ".cstring($gv->FILE)."\n" if $debug_gv;
}
- warn "GV::save GvFILE".($[ < 5.009 ? "" : "_HEK")."(*$name)\n" if $debug_gv;
my $gvform = $gv->FORM;
if ($$gvform && $savefields&Save_FORM) {
$gvform->save;
@@ -1740,7 +1771,7 @@ xs_init(pTHX)
dTARG;
dSP;
EOT
- print "\n#undef USE_DYNAMIC_LOADING"; # REMOVEME! boot_ symbols not linked!
+ print "\n#undef USE_DYNAMIC_LOADING /* temp. HACK! */"; # REMOVEME! boot_ symbols not linked!
print "\n#ifdef USE_DYNAMIC_LOADING";
print qq/\n\tnewXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);/;
print "\n#endif\n" ;
@@ -2062,6 +2093,7 @@ sub save_main {
sub init_sections {
my @sections = (decl => \$decl, sym => \$symsect,
+ hek => \$heksect,
binop => \$binopsect, condop => \$condopsect,
cop => \$copsect, padop => \$padopsect,
listop => \$listopsect, logop => \$logopsect,
View
7 script/perlcc.PL
@@ -173,7 +173,6 @@ sub parse_argv {
'c', # Compile only
'h', # Help me
'S', # Dump C files
- 'r', # run the resulting executable
'T', # run the backend using perl -T
't', # run the backend using perl -t
'static', # Dirty hack to enable -shared/-static
@@ -300,9 +299,9 @@ sub compile_cstyle {
vprint 1, "Compiling...";
vprint 1, "Calling $command";
- my ($output_r, $error_r) = spawnit($command);
- my @output = @$output_r;
- my @error = @$error_r;
+ my ($output_r, $error_r) = spawnit($command);
+ my @output = @$output_r;
+ my @error = @$error_r;
if (@error && $? != 0) {
_die("$0: $Input did not compile, which can't happen:\n@error\n");
View
24 t/testc.sh
@@ -1,19 +1,31 @@
-OCMD="perl5.11.0 -Mblib -MO=C,-DcACMSG,"
-CCMD="gcc -pipe -DDEBUGGING -DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -fno-strict-aliasing -I/usr/lib/perl5/5.11/i686-cygwin/CORE -O0 -g"
-LCMD=" -Wl,--enable-auto-import -Wl,--export-all-symbols -L/usr/lib/perl5/5.11/i686-cygwin/CORE -lperl -ldl -lcrypt -lgdbm_compat"
+#!/bin/sh
+# use the actual perl from the Makefile (perld, perl5.11.0, ...)
+PERL=`grep "^PERL =" Makefile|cut -c8-`
+# if $] < 5.9 then remove -Mblib
+# OCMD="$PERL -Mblib -MO=C,-DcACMSG,"
+OCMD="$PERL `$PERL -e'print (($] < 5.009004) ? q() : q(-Mblib))'` -MO=C,-DcACMSG,"
+CCMD="$PERL script/cc_harness -g"
+LCMD=
+#CCMD="gcc -pipe -DDEBUGGING -DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -fno-strict-aliasing -I/usr/lib/perl5/5.11/i686-cygwin/CORE -O0 -g"
+#LCMD=" -Wl,--enable-auto-import -Wl,--export-all-symbols -L/usr/lib/perl5/5.11/i686-cygwin/CORE -lperl -ldl -lcrypt -lgdbm_compat"
make
echo "print 'hi'" > ccode1.pl
echo ${OCMD}-occode1.c ccode1.pl
${OCMD}-occode1.c ccode1.pl
+echo $CCMD ccode1.c -c -E -o ccode1.cee
+$CCMD ccode1.c -c -E -o ccode1.cee
echo $CCMD ccode1.c $LCMD -o ccode1.exe
$CCMD ccode1.c $LCMD -o ccode1.exe
-$CCMD ccode1.c -E -o ccode1.cee
+test -x ccode1 || exit
+./ccode1 || exit
-test -e ccode1.exe || exit
echo "for (1,2,3) { print if /\d/ }" > ccode2.pl
echo ${OCMD}-occode2.c ccode2.pl
${OCMD}-occode2.c ccode2.pl
+echo $CCMD ccode2.c -c -E -o ccode2.cee
+$CCMD ccode2.c -c -E -o ccode2.cee
echo $CCMD ccode2.c $LCMD -o ccode2.exe
$CCMD ccode2.c $LCMD -o ccode2.exe
-$CCMD ccode2.c -E -o ccode2.cee
+test -x ccode2 || exit
+./ccode2
View
8 t/testplc.sh
@@ -1,5 +1,7 @@
#!/bin/sh
-PERL=perl5.11.0
+# use the actual perl from the Makefile (perld, perl5.10.0, perl5.8.8, perl5.11.0, ...)
+PERL=`grep "^PERL =" Makefile|cut -c8-`
+#PERL=perl5.11.0
OCMD="$PERL -Mblib -MO=Bytecode,"
ICMD="$PERL -Mblib -MByteLoader"
@@ -36,7 +38,7 @@ $PERL -Mblib -MO=Concise bytecode2.pl > bytecode2.concise
echo ${ICMD} bytecode2.plc
${ICMD} bytecode2.plc
fi
-#only if ByteLoader installed
+#only if ByteLoader installed in @INC
if false; then
echo ${OCMD}-H,-obytecode2.plc bytecode2.pl
${OCMD}-H,-obytecode2.plc bytecode2.pl
@@ -51,4 +53,4 @@ echo "package MY::Test;" > bytecode1.pm
echo "print 'hi'" >> bytecode1.pm
echo ${OCMD}-m,-obytecode1.pmc bytecode1.pm
${OCMD}-obytecode1.pmc bytecode1.pm
-fi
+fi
Please sign in to comment.
Something went wrong with that request. Please try again.