diff --git a/Changes b/Changes index 41f8dfbfa..d6077ddfa 100755 --- a/Changes +++ b/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 diff --git a/META.yml b/META.yml index 51722601b..13de054e2 100755 --- a/META.yml +++ b/META.yml @@ -1,6 +1,6 @@ --- #YAML:1.0 name: B-C -version: 1.04_08 +version: 1.04_09 abstract: ~ license: ~ author: ~ diff --git a/Makefile.PL b/Makefile.PL index 1a6ebc5be..1e927f92e 100755 --- a/Makefile.PL +++ b/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; diff --git a/NOTES b/NOTES index 4d85c3925..313955e26 100755 --- a/NOTES +++ b/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 diff --git a/bytecode.pl b/bytecode.pl index 5b29710b2..4cf48b0d5 100755 --- a/bytecode.pl +++ b/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. + =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. + =back =head1 AUTHOR diff --git a/lib/B/Asmdata.pm b/lib/B/Asmdata.pm index 155f89410..e1eb9bf3d 100755 --- a/lib/B/Asmdata.pm +++ b/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. + =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. + =back =head1 AUTHOR diff --git a/lib/B/C.pm b/lib/B/C.pm index b2ddd60e0..c5802fa05 100755 --- a/lib/B/C.pm +++ b/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, diff --git a/script/perlcc.PL b/script/perlcc.PL index 361069edf..a92882f4b 100755 --- a/script/perlcc.PL +++ b/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"); diff --git a/t/testc.sh b/t/testc.sh index b3cd9f02f..0d3873638 100755 --- a/t/testc.sh +++ b/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 diff --git a/t/testplc.sh b/t/testplc.sh index 785a02365..5e1fee092 100755 --- a/t/testplc.sh +++ b/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 \ No newline at end of file +fi