* C.pm: Try AUTOLOAD for 5.8. Not yet ready. (test 27)

* perlcc: improve help. use Pod::Usage as module, not via cmdline.
  fix previous installation quirks.
* assemble: improve pod. make it installable.
* disassemble: make it installable.
* cc_harness: ditto
* Makefile.PL: added script/* as EXE_FILES to install them


git-svn-id: http://perl-compiler.googlecode.com/svn/trunk@189 ed534f1a-1453-0410-ab30-dfc593a8b23c

Changes

@@ -6,8 +6,13 @@
 
 1.08	?? rurban
 	Adapt coding guidelines, add C and cperl coda. Reformat sources.
-	* C.pm: Try AUTOLOAD for 5.8
-	* perlcc: improve help. use Pod::Usage as module, not via cmdline
+	* C.pm: Try AUTOLOAD for 5.8. Not yet ready. (test 27)
+	* perlcc: improve help. use Pod::Usage as module, not via cmdline. 
+	fix previous installation quirks.
+	* assemble: improve pod. make it installable.
+	* disassemble: make it installable.
+	* cc_harness: ditto
+	* Makefile.PL: added script/* as EXE_FILES to install them
 
 1.07	2009-12-19 rurban
 	* C.pm: fix fbm_compile (INDEX) for >= 5.10. gv_list is already a pointer.

Makefile.PL

@@ -1,27 +1,28 @@
 use ExtUtils::MakeMaker;
 use Config;
 use File::Spec;
-#use 5.008;
+use 5.006;
 
 my $core = grep { $_ eq 'PERL_CORE=1' } @ARGV;
 
 WriteMakefile(
-    NAME	    => "B::C",
-    VERSION_FROM    => "lib/B/C.pm",
-	         # 'scripts/assemble','scripts/disassemble',
-    PL_FILES => {'script/perlcc.PL'  => '$(INST_BIN)/perlcc' },
+    NAME	 => "B::C",
+    VERSION_FROM => "lib/B/C.pm",
+    PL_FILES   => { 'script/perlcc.PL'    => 'script/perlcc' },
+    EXE_FILES  => [qw(script/perlcc script/cc_harness script/assemble script/disassemble)],
     #PREREQ_PM => {'B::Concise' => '0.66',
-    #	          'B'          => '1.0901'},
-    'AUTHOR' => 'Malcolm Beattie <mbeattie@sable.ox.ac.uk>, Reini Urban <rurban@cpan.org>',
-    'ABSTRACT' => 'perl compiler',
-#   ($ExtUtils::MakeMaker::VERSION gt '6.31' ?
-#    ('EXTRA_META'  => "recommends:\n" .
-#     "    B::Debug:    1.11\n"
-#    ) : ()),
+    #	           'B'          => '1.0901'},
+    'AUTHOR'   => 'Malcolm Beattie <mbeattie@sable.ox.ac.uk>, Reini Urban <rurban@cpan.org>',
+    'ABSTRACT' => 'Perl compiler',
+    # ($ExtUtils::MakeMaker::VERSION gt '6.31' ?
+    #    ('EXTRA_META'  => "recommends:\n" .
+    #     "    B::Debug:    1.11\n"
+    #    ) : ()),
     SIGN  => 1,
     clean => { FILES =>
                "bytecode[0-9]* ccode[0-9]* cccode[0-9]* ".
- 	       "*.core *.stackdump a.out *.cee *.c *.asm *.dbg *.plc *.concise *~ dll.base dll.exp"},
+ 	       "*.core *.stackdump a.out *.cee *.c *.asm *.dbg *.plc ".
+               "*.concise *~ dll.base dll.exp"},
 );
 
 sub headerpath {
@@ -36,7 +37,7 @@ sub headerpath {
 package MY;
 
 sub libscan {
-  # ignore temp testing files
+  # Ignore temp testing files
   return 0 if $_[1] =~ /^(.svn|jit.*|i386|.*\.orig|bytecode.*\.pl|c?ccode\d+\..*|regen_lib\.pl)$/;
   # Ignore Bytecode on 5.6 for now. The 5.6 CORE module produces better code (until fixed :)
   # Not even the Byteloader works for 5.6 assembled code. The Disassembler does not stop at ret.
@@ -54,13 +55,7 @@ sub depend {
     my $asmdata = File::Spec->catfile('lib', 'B', 'Asmdata.pm');
     my $byterun_c = File::Spec->catfile('ByteLoader', 'byterun.c');
     my $byterun_h = File::Spec->catfile('ByteLoader', 'byterun.h');
-    my $perlcc_inst = File::Spec->catfile('$(INST_BIN)', 'perlcc');
-    my $perlcc_exp = File::Spec->catfile('script', 'perlcc.PL');
     my $result = "
-$perlcc_inst :: $perlcc_exp
-	\$(MKPATH) \$(INST_BIN)
-	\$(CP) $perlcc_exp $perlcc_inst
-
 C.c : C.xs Makefile
 
 $asmdata : bytecode.pl @headers Makefile

lib/B/C.pm

@@ -1466,23 +1466,16 @@ sub try_autoload {
   warn sprintf( "No definition for sub %s::%s. Try Autoload\n", $cvstashname, $cvname )
     if $verbose;
 
-  # XXX Todo Search and call ::AUTOLOAD (test 27, 5.8)
+  # XXX Search and call ::AUTOLOAD (=> ROOT and XSUB) (test 27, 5.8)
   no strict 'refs';
   my $auto = \&{"$cvstashname\::AUTOLOAD"};
-  if (0 and defined $auto and ref $auto eq 'CODE' and !$PERL510) {
-    ${"$cvstashname\::AUTOLOAD"} = "$cvstashname\::$cvname";
-    svref_2object( \*{"$cvstashname\::AUTOLOAD"} )->save;
-    return 1;
-
+  if (defined $auto and ref $auto eq 'CODE' and !$PERL510) {
     # Tweaked version of __PACKAGE__::AUTOLOAD
     ${"$cvstashname\::AUTOLOAD"} = "$cvstashname\::$cvname";
     eval { &$auto() };
     unless ($@) {
-      # now we have to set cv->ROOT and cv->XSUB somehow
-      #my $goto = \&{"$cvstashname\::$cvname"};
-      #my $cv = bless $goto, "B::CV";
-      #$cv->save;
-      return $auto;
+      my $cv = svref_2object( $auto );
+      return $cv;
     }
   }
 
@@ -1601,12 +1594,14 @@ sub B::CV::save {
     if $debug{cv};
   if ( !$$root && !$cvxsub ) {
     if ( my $auto = try_autoload( $cvstashname, $cvname ) ) {
-      if (ref $auto eq 'B::CV') { # XXX this does not work yet
-	$cv = $auto;
+      if (ref $auto eq 'B::CV') { # explicit goto
+        $root   = $auto->ROOT;
+        $cvxsub = $auto->XSUB;
+      } else {
+        # Recalculated root and xsub
+        $root   = $cv->ROOT;
+        $cvxsub = $cv->XSUB;
       }
-      # Recalculate root and xsub
-      $root   = $cv->ROOT;
-      $cvxsub = $cv->XSUB;
       if ( $$root || $cvxsub ) {
         warn "Successful forced autoload\n" if $verbose;
       }
@@ -1643,6 +1638,9 @@ sub B::CV::save {
     warn sprintf( "done saving op tree for CV 0x%x, name %s, root 0x%x => start=%s\n",
       $$cv, $ppname, $$root, $startfield )
       if $debug{cv};
+    # XXX missing cv_start for AUTOLOAD
+    $startfield = objsym($root->next) unless $startfield; # autoload has only root
+    $startfield = "(OP*)Nullany" unless $startfield;
     if ($$padlist) {
       warn sprintf( "saving PADLIST 0x%x for CV 0x%x\n", $$padlist, $$cv )
         if $debug{cv};
@@ -1702,7 +1700,7 @@ sub B::CV::save {
     $symsect->add(
       sprintf("XPVCVIX$xpvcv_ix\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, \"\", %d, s\\_%x, (CV*)s\\_%x, 0x%x",
         cstring($pv),      length($pv),    $cv->IVX,
-        $cv->NVX,  $startfield,       ${ $cv->ROOT }, $cv->DEPTH,
+        $cv->NVX,  $startfield,       $$root, $cv->DEPTH,
         $$padlist, ${ $cv->OUTSIDE }, $cv->CvFLAGS
       )
     );
@@ -1712,7 +1710,7 @@ sub B::CV::save {
     $symsect->add(
       sprintf("XPVCVIX$xpvcv_ix\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, \"\", %d, s\\_%x, (CV*)s\\_%x, 0x%x, 0x%x",
         cstring($pv),      length($pv),    $cv->IVX,
-        $cv->NVX,  $startfield,       ${ $cv->ROOT }, $cv->DEPTH,
+        $cv->NVX,  $startfield,       $$root, $cv->DEPTH,
         $$padlist, ${ $cv->OUTSIDE }, $cv->CvFLAGS,   $cv->OUTSIDE_SEQ
       )
     );

script/assemble

@@ -10,18 +10,18 @@ assemble - Assemble Perl bytecode
 
 =head1 SYNOPSIS
 
-  assemble [-d] [filename] [outfilename]
+  assemble [-d] [bytecode.asm | -] [bytecode.plc]
 
 =head1 DESCRIPTION
 
-Compiles a perl script to binary bytecode assembler.
+Compiles an ascii bytecode as produced by L<disassemble> to binary bytecode assembler.
 
-bytecode is a binary file wih either the magic 4 bytes 'PLBC'
+C<bytecode> is a binary file wih either the magic 4 bytes 'PLBC'
 at the start, or something like "#! /usr/bin/perl\n
-use ByteLoader '0.07'"
+use ByteLoader '0.07'", typically with the F<.plc> or F<.pmc> extension.
 
 If filename is -, the input is read from STDIN and
-you can still provide an outfilename.
+you can still provide an output filename.
 
 =head1 OPTION -d
 

t/cc.t

@@ -37,9 +37,10 @@ my @todo = (15,18,21,25,27,29,30); #5.8.9
 #  @todo = (15,18,21,25,27,29,30) if $] < 5.007;
 @todo = (15,18,21,25,29,30)       if $] >= 5.010;
 @todo = (15,16,18,21,25,29,30)    if $] >= 5.011;
+push @todo, (12) if $] >= 5.011003;
 
 # skip core dump causing known limitations, like custom sort or runtime labels
-my @skip = $AUTHOR ? () : (29);
+my @skip = $AUTHOR ? () : (25,29,30);
 
 my %todo = map { $_ => 1 } @todo;
 my %skip = map { $_ => 1 } @skip;

t/cc_o1.t

@@ -36,6 +36,7 @@ my @todo = (15,18,21,25..27,29,30); # 5.8
 #  @todo = (15,18,21,25..27,29,30) if $] < 5.007;
 @todo = (15,18,21,25,26,29,30)     if $] >= 5.010;
 @todo = (15,16,18,21,25,26,29,30)  if $] >= 5.011;
+push @todo, (12) if $] >= 5.011003;
 
 # skip core dump causing known limitations, like custom sort or runtime labels
 my @skip = $AUTHOR ? () : (25,29,30);

t/testc.sh

@@ -202,10 +202,10 @@ result[24]='ok'
 # <=5.6 qsort needs two more passes here than >=5.8 merge_sort
 tests[25]='print sort { print $i++," "; $b <=> $a } 1..4'
 result[25]="0 1 2 3`$PERL -e'print (($] < 5.007) ? q( 4 5) : q())'` 4321";
-# lvalue
+# lvalue sub
 tests[26]='sub a:lvalue{my $a=26; ${\(bless \$a)}}sub b:lvalue{${\shift}}; print ${a(b)}';
 result[26]="26";
-# import test. AUTOLOAD
+# import test, AUTOLOAD
 tests[27]='use Fcntl; print "ok" if ( &Fcntl::O_WRONLY );'
 result[27]='ok'
 # require $fname
@@ -214,7 +214,7 @@ result[28]='ok'
 # use test
 tests[29]='use IO;print "ok"'
 result[29]='ok'
-# run-time context of ..
+# run-time context of .., fails in CC
 tests[30]='@a=(4,6,1,0,0,1);sub range{(shift @a)..(shift @a)}print range();while(@a){print scalar(range())}'
 result[30]='456123E0'