More Encode tweaks:

[p5sagit/p5-mst-13.2.git] / ext / Encode / compile

diff --git a/ext/Encode/compile b/ext/Encode/compile
index 13498d1..ee6d778 100755 (executable)
--- a/ext/Encode/compile
+++ b/ext/Encode/compile
@@ -1,7 +1,7 @@
 #!../../perl -w
 BEGIN {
-    unshift @INC, '../../lib';
-    $ENV{PATH} .= ';../..' if $^O eq 'MSWin32';
+    unshift @INC, qw(../../lib ../../../lib);
+    $ENV{PATH} .= ';../..;../../..' if $^O eq 'MSWin32';
 }
 use strict;
 use Getopt::Std;
@@ -46,14 +46,14 @@ sub encode_M
 eval "\@ARGV = map(glob(\$_),\@ARGV)" if ($^O eq 'MSWin32');
 
 my %opt;
-getopts('qo:f:n:',\%opt);
+getopts('qOo:f:n:',\%opt);
 my $cname = (exists $opt{'o'}) ? $opt{'o'} : shift(@ARGV);
 chmod(0666,$cname) if -f $cname && !-w $cname;
 open(C,">$cname") || die "Cannot open $cname:$!";
 
 
 my $dname = $cname;
-$dname =~ s/(\.[^\.]*)?$/.def/;
+$dname =~ s/(\.[^\.]*)?$/_def.h/;
 
 my ($doC,$doEnc,$doUcm,$doPet);
 
@@ -73,7 +73,7 @@ if ($cname =~ /\.(c|xs)$/)
 /*
  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  This file was autogenerated by:
- $^X $0 $cname @orig_ARGV
+ $^X $0 @orig_ARGV
 */
 END
   }
@@ -117,6 +117,9 @@ else
 
 my %encoding;
 my %strings;
+my $saved = 0;
+my $subsave = 0;
+my $strings = 0;
 
 sub cmp_name
 {
@@ -156,6 +159,7 @@ foreach my $enc (sort cmp_name @encfiles)
 
 if ($doC)
  {
+  print STDERR "Writing compiled form\n";
   foreach my $name (sort cmp_name keys %encoding)
    {
     my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
@@ -186,7 +190,7 @@ if ($doC)
     my $mod = $1;
     print C <<'END';
 
-void
+static void
 Encode_XSEncoding(pTHX_ encode_t *enc)
 {
  dSP;
@@ -214,6 +218,9 @@ END
    }
   close(D);
   close(H);
+  printf STDERR "%d bytes in string tables\n",$strings;
+  printf STDERR "%d bytes (%.3g%%) saved spotting duplicates\n",$saved,100*$saved/$strings if $saved;
+  printf STDERR "%d bytes (%.3g%%) saved using substrings\n",$subsave,100*$subsave/$strings if $subsave;
  }
 elsif ($doEnc)
  {
@@ -235,6 +242,7 @@ elsif ($doUcm)
 close(C);
 
 
+
 sub compile_ucm
 {
  my ($fh,$name) = @_;
@@ -270,7 +278,7 @@ sub compile_ucm
    push(@byte,$1) while $attr{'subchar'} =~ /\G\\x([0-9a-f]+)/icg;
    $erep = join('',map(chr(hex($_)),@byte));
   }
- print "Scanning $name ($cs)\n";
+ print "Reading $name ($cs)\n";
  my $nfb = 0;
  my $hfb = 0;
  while (<$fh>)
@@ -414,23 +422,34 @@ sub enter
   }
 }
 
+
+
 sub outstring
 {
  my ($fh,$name,$s) = @_;
  my $sym = $strings{$s};
- unless ($sym)
+ if ($sym)
   {
-   foreach my $o (keys %strings)
-    {
-     my $i = index($o,$s);
-     if ($i >= 0)
-      {
-       $sym = $strings{$o};
-       $sym .= sprintf("+0x%02x",$i) if ($i);
-       return $sym;
-      }
-    }
+   $saved += length($s);
+  }
+ else
+  {
+   if ($opt{'O'}) {
+       foreach my $o (keys %strings)
+        {
+         my $i = index($o,$s);
+         if ($i >= 0)
+          {
+           $sym = $strings{$o};
+           $sym .= sprintf("+0x%02x",$i) if ($i);
+           $subsave += length($s);
+           $strings{$s} = $sym;
+           return $sym;
+          }
+        }
+   }
    $strings{$s} = $sym = $name;
+   $strings += length($s);
    printf $fh "\nstatic const U8 %s[%d] =\n",$name,length($s);
    # Do in chunks of 16 chars to constrain line length
    # Assumes ANSI C adjacent string litteral concatenation