This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Mark more static Encode data structures as const.
[perl5.git] / ext / Encode / bin / enc2xs
1 #!./perl
2 BEGIN {
3     # @INC poking  no longer needed w/ new MakeMaker and Makefile.PL's
4     # with $ENV{PERL_CORE} set
5     # In case we need it in future...
6     require Config; import Config;
7 }
8 use strict;
9 use warnings;
10 use Getopt::Std;
11 my @orig_ARGV = @ARGV;
12 our $VERSION  = do { my @r = (q$Revision: 2.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
13
14 # These may get re-ordered.
15 # RAW is a do_now as inserted by &enter
16 # AGG is an aggreagated do_now, as built up by &process
17
18 use constant {
19   RAW_NEXT => 0,
20   RAW_IN_LEN => 1,
21   RAW_OUT_BYTES => 2,
22   RAW_FALLBACK => 3,
23
24   AGG_MIN_IN => 0,
25   AGG_MAX_IN => 1,
26   AGG_OUT_BYTES => 2,
27   AGG_NEXT => 3,
28   AGG_IN_LEN => 4,
29   AGG_OUT_LEN => 5,
30   AGG_FALLBACK => 6,
31 };
32
33 # (See the algorithm in encengine.c - we're building structures for it)
34
35 # There are two sorts of structures.
36 # "do_now" (an array, two variants of what needs storing) is whatever we need
37 # to do now we've read an input byte.
38 # It's housed in a "do_next" (which is how we got to it), and in turn points
39 # to a "do_next" which contains all the "do_now"s for the next input byte.
40
41 # There will be a "do_next" which is the start state.
42 # For a single byte encoding it's the only "do_next" - each "do_now" points
43 # back to it, and each "do_now" will cause bytes. There is no state.
44
45 # For a multi-byte encoding where all characters in the input are the same
46 # length, then there will be a tree of "do_now"->"do_next"->"do_now"
47 # branching out from the start state, one step for each input byte.
48 # The leaf "do_now"s will all be at the same distance from the start state,
49 # only the leaf "do_now"s cause output bytes, and they in turn point back to
50 # the start state.
51
52 # For an encoding where there are varaible length input byte sequences, you
53 # will encounter a leaf "do_now" sooner for the shorter input sequences, but
54 # as before the leaves will point back to the start state.
55
56 # The system will cope with escape encodings (imagine them as a mostly
57 # self-contained tree for each escape state, and cross links between trees
58 # at the state-switching characters) but so far no input format defines these.
59
60 # The system will also cope with having output "leaves" in the middle of
61 # the bifurcating branches, not just at the extremities, but again no
62 # input format does this yet.
63
64 # There are two variants of the "do_now" structure. The first, smaller variant
65 # is generated by &enter as the input file is read. There is one structure
66 # for each input byte. Say we are mapping a single byte encoding to a
67 # single byte encoding, with  "ABCD" going "abcd". There will be
68 # 4 "do_now"s, {"A" => [...,"a",...], "B" => [...,"b",...], "C"=>..., "D"=>...}
69
70 # &process then walks the tree, building aggregate "do_now" structres for
71 # adjacent bytes where possible. The aggregate is for a contiguous range of
72 # bytes which each produce the same length of output, each move to the
73 # same next state, and each have the same fallback flag.
74 # So our 4 RAW "do_now"s above become replaced by a single structure
75 # containing:
76 # ["A", "D", "abcd", 1, ...]
77 # ie, for an input byte $_ in "A".."D", output 1 byte, found as
78 # substr ("abcd", (ord $_ - ord "A") * 1, 1)
79 # which maps very nicely into pointer arithmetic in C for encengine.c
80
81 sub encode_U
82 {
83  # UTF-8 encode long hand - only covers part of perl's range
84  ## my $uv = shift;
85  # chr() works in native space so convert value from table
86  # into that space before using chr().
87  my $ch = chr(utf8::unicode_to_native($_[0]));
88  # Now get core perl to encode that the way it likes.
89  utf8::encode($ch);
90  return $ch;
91 }
92
93 sub encode_S
94 {
95  # encode single byte
96  ## my ($ch,$page) = @_; return chr($ch);
97  return chr $_[0];
98 }
99
100 sub encode_D
101 {
102  # encode double byte MS byte first
103  ## my ($ch,$page) = @_; return chr($page).chr($ch);
104  return chr ($_[1]) . chr $_[0];
105 }
106
107 sub encode_M
108 {
109  # encode Multi-byte - single for 0..255 otherwise double
110  ## my ($ch,$page) = @_;
111  ## return &encode_D if $page;
112  ## return &encode_S;
113  return chr ($_[1]) . chr $_[0] if $_[1];
114  return chr $_[0];
115 }
116
117 my %encode_types = (U => \&encode_U,
118                     S => \&encode_S,
119                     D => \&encode_D,
120                     M => \&encode_M,
121                    );
122
123 # Win32 does not expand globs on command line
124 eval "\@ARGV = map(glob(\$_),\@ARGV)" if ($^O eq 'MSWin32');
125
126 my %opt;
127 # I think these are:
128 # -Q to disable the duplicate codepoint test
129 # -S make mapping errors fatal
130 # -q to remove comments written to output files
131 # -O to enable the (brute force) substring optimiser
132 # -o <output> to specify the output file name (else it's the first arg)
133 # -f <inlist> to give a file with a list of input files (else use the args)
134 # -n <name> to name the encoding (else use the basename of the input file.
135 getopts('CM:SQqOo:f:n:',\%opt);
136
137 $opt{M} and make_makefile_pl($opt{M}, @ARGV);
138 $opt{C} and make_configlocal_pm($opt{C}, @ARGV);
139
140 # This really should go first, else the die here causes empty (non-erroneous)
141 # output files to be written.
142 my @encfiles;
143 if (exists $opt{'f'}) {
144     # -F is followed by name of file containing list of filenames
145     my $flist = $opt{'f'};
146     open(FLIST,$flist) || die "Cannot open $flist:$!";
147     chomp(@encfiles = <FLIST>);
148     close(FLIST);
149 } else {
150     @encfiles = @ARGV;
151 }
152
153 my $cname = (exists $opt{'o'}) ? $opt{'o'} : shift(@ARGV);
154 chmod(0666,$cname) if -f $cname && !-w $cname;
155 open(C,">$cname") || die "Cannot open $cname:$!";
156
157 my $dname = $cname;
158 my $hname = $cname;
159
160 my ($doC,$doEnc,$doUcm,$doPet);
161
162 if ($cname =~ /\.(c|xs)$/i) # VMS may have upcased filenames with DECC$ARGV_PARSE_STYLE defined
163  {
164   $doC = 1;
165   $dname =~ s/(\.[^\.]*)?$/.exh/;
166   chmod(0666,$dname) if -f $cname && !-w $dname;
167   open(D,">$dname") || die "Cannot open $dname:$!";
168   $hname =~ s/(\.[^\.]*)?$/.h/;
169   chmod(0666,$hname) if -f $cname && !-w $hname;
170   open(H,">$hname") || die "Cannot open $hname:$!";
171
172   foreach my $fh (\*C,\*D,\*H)
173   {
174    print $fh <<"END" unless $opt{'q'};
175 /*
176  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
177  This file was autogenerated by:
178  $^X $0 @orig_ARGV
179 */
180 END
181   }
182
183   if ($cname =~ /(\w+)\.xs$/)
184    {
185     print C "#include <EXTERN.h>\n";
186     print C "#include <perl.h>\n";
187     print C "#include <XSUB.h>\n";
188     print C "#define U8 U8\n";
189    }
190   print C "#include \"encode.h\"\n\n";
191
192  }
193 elsif ($cname =~ /\.enc$/)
194  {
195   $doEnc = 1;
196  }
197 elsif ($cname =~ /\.ucm$/)
198  {
199   $doUcm = 1;
200  }
201 elsif ($cname =~ /\.pet$/)
202  {
203   $doPet = 1;
204  }
205
206 my %encoding;
207 my %strings;
208 my $string_acc;
209 my %strings_in_acc;
210
211 my $saved = 0;
212 my $subsave = 0;
213 my $strings = 0;
214
215 sub cmp_name
216 {
217  if ($a =~ /^.*-(\d+)/)
218   {
219    my $an = $1;
220    if ($b =~ /^.*-(\d+)/)
221     {
222      my $r = $an <=> $1;
223      return $r if $r;
224     }
225   }
226  return $a cmp $b;
227 }
228
229
230 foreach my $enc (sort cmp_name @encfiles)
231  {
232   my ($name,$sfx) = $enc =~ /^.*?([\w-]+)\.(enc|ucm)$/;
233   $name = $opt{'n'} if exists $opt{'n'};
234   if (open(E,$enc))
235    {
236     if ($sfx eq 'enc')
237      {
238       compile_enc(\*E,lc($name));
239      }
240     else
241      {
242       compile_ucm(\*E,lc($name));
243      }
244    }
245   else
246    {
247     warn "Cannot open $enc for $name:$!";
248    }
249  }
250
251 if ($doC)
252  {
253   print STDERR "Writing compiled form\n";
254   foreach my $name (sort cmp_name keys %encoding)
255    {
256     my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
257     process($name.'_utf8',$e2u);
258     addstrings(\*C,$e2u);
259
260     process('utf8_'.$name,$u2e);
261     addstrings(\*C,$u2e);
262    }
263   outbigstring(\*C,"enctable");
264   foreach my $name (sort cmp_name keys %encoding)
265    {
266     my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
267     outtable(\*C,$e2u, "enctable");
268     outtable(\*C,$u2e, "enctable");
269
270     # push(@{$encoding{$name}},outstring(\*C,$e2u->{Cname}.'_def',$erep));
271    }
272   foreach my $enc (sort cmp_name keys %encoding)
273    {
274     # my ($e2u,$u2e,$rep,$min_el,$max_el,$rsym) = @{$encoding{$enc}};
275     my ($e2u,$u2e,$rep,$min_el,$max_el) = @{$encoding{$enc}};
276     #my @info = ($e2u->{Cname},$u2e->{Cname},$rsym,length($rep),$min_el,$max_el);
277     my $replen = 0; 
278     $replen++ while($rep =~ /\G\\x[0-9A-Fa-f]/g);
279     my @info = ($e2u->{Cname},$u2e->{Cname},qq((U8 *)"$rep"),$replen,$min_el,$max_el);
280     my $sym = "${enc}_encoding";
281     $sym =~ s/\W+/_/g;
282     print C "const encode_t $sym = \n";
283     # This is to make null encoding work -- dankogai
284     for (my $i = (scalar @info) - 1;  $i >= 0; --$i){
285         $info[$i] ||= 1;
286     }
287     # end of null tweak -- dankogai
288     print C " {",join(',',@info,"{\"$enc\",(const char *)0}"),"};\n\n";
289    }
290
291   foreach my $enc (sort cmp_name keys %encoding)
292    {
293     my $sym = "${enc}_encoding";
294     $sym =~ s/\W+/_/g;
295     print H "extern encode_t $sym;\n";
296     print D " Encode_XSEncoding(aTHX_ &$sym);\n";
297    }
298
299   if ($cname =~ /(\w+)\.xs$/)
300    {
301     my $mod = $1;
302     print C <<'END';
303
304 static void
305 Encode_XSEncoding(pTHX_ encode_t *enc)
306 {
307  dSP;
308  HV *stash = gv_stashpv("Encode::XS", TRUE);
309  SV *sv    = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))),stash);
310  int i = 0;
311  PUSHMARK(sp);
312  XPUSHs(sv);
313  while (enc->name[i])
314   {
315    const char *name = enc->name[i++];
316    XPUSHs(sv_2mortal(newSVpvn(name,strlen(name))));
317   }
318  PUTBACK;
319  call_pv("Encode::define_encoding",G_DISCARD);
320  SvREFCNT_dec(sv);
321 }
322
323 END
324
325     print C "\nMODULE = Encode::$mod\tPACKAGE = Encode::$mod\n\n";
326     print C "BOOT:\n{\n";
327     print C "#include \"$dname\"\n";
328     print C "}\n";
329    }
330   # Close in void context is bad, m'kay
331   close(D) or warn "Error closing '$dname': $!";
332   close(H) or warn "Error closing '$hname': $!";
333
334   my $perc_saved    = $saved/($strings + $saved) * 100;
335   my $perc_subsaved = $subsave/($strings + $subsave) * 100;
336   printf STDERR "%d bytes in string tables\n",$strings;
337   printf STDERR "%d bytes (%.3g%%) saved spotting duplicates\n",
338     $saved, $perc_saved              if $saved;
339   printf STDERR "%d bytes (%.3g%%) saved using substrings\n",
340     $subsave, $perc_subsaved         if $subsave;
341  }
342 elsif ($doEnc)
343  {
344   foreach my $name (sort cmp_name keys %encoding)
345    {
346     my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
347     output_enc(\*C,$name,$e2u);
348    }
349  }
350 elsif ($doUcm)
351  {
352   foreach my $name (sort cmp_name keys %encoding)
353    {
354     my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
355     output_ucm(\*C,$name,$u2e,$erep,$min_el,$max_el);
356    }
357  }
358
359 # writing half meg files and then not checking to see if you just filled the
360 # disk is bad, m'kay
361 close(C) or die "Error closing '$cname': $!";
362
363 # End of the main program.
364
365 sub compile_ucm
366 {
367  my ($fh,$name) = @_;
368  my $e2u = {};
369  my $u2e = {};
370  my $cs;
371  my %attr;
372  while (<$fh>)
373   {
374    s/#.*$//;
375    last if /^\s*CHARMAP\s*$/i;
376    if (/^\s*<(\w+)>\s+"?([^"]*)"?\s*$/i) # " # Grrr
377     {
378      $attr{$1} = $2;
379     }
380   }
381  if (!defined($cs =  $attr{'code_set_name'}))
382   {
383    warn "No <code_set_name> in $name\n";
384   }
385  else
386   {
387    $name = $cs unless exists $opt{'n'};
388   }
389  my $erep;
390  my $urep;
391  my $max_el;
392  my $min_el;
393  if (exists $attr{'subchar'})
394   {
395    #my @byte;
396    #$attr{'subchar'} =~ /^\s*/cg;
397    #push(@byte,$1) while $attr{'subchar'} =~ /\G\\x([0-9a-f]+)/icg;
398    #$erep = join('',map(chr(hex($_)),@byte));
399    $erep = $attr{'subchar'}; 
400    $erep =~ s/^\s+//; $erep =~ s/\s+$//;
401   }
402  print "Reading $name ($cs)\n";
403  my $nfb = 0;
404  my $hfb = 0;
405  while (<$fh>)
406   {
407    s/#.*$//;
408    last if /^\s*END\s+CHARMAP\s*$/i;
409    next if /^\s*$/;
410    my (@uni, @byte) = ();
411    my ($uni, $byte, $fb) = m/^(\S+)\s+(\S+)\s+(\S+)\s+/o
412        or die "Bad line: $_";
413    while ($uni =~  m/\G<([U0-9a-fA-F\+]+)>/g){
414        push @uni, map { substr($_, 1) } split(/\+/, $1);
415    }
416    while ($byte =~ m/\G\\x([0-9a-fA-F]+)/g){
417        push @byte, $1;
418    }
419    if (@uni)
420     {
421      my $uch =  join('', map { encode_U(hex($_)) } @uni );
422      my $ech = join('',map(chr(hex($_)),@byte));
423      my $el  = length($ech);
424      $max_el = $el if (!defined($max_el) || $el > $max_el);
425      $min_el = $el if (!defined($min_el) || $el < $min_el);
426      if (length($fb))
427       {
428        $fb = substr($fb,1);
429        $hfb++;
430       }
431      else
432       {
433        $nfb++;
434        $fb = '0';
435       }
436      # $fb is fallback flag
437      # 0 - round trip safe
438      # 1 - fallback for unicode -> enc
439      # 2 - skip sub-char mapping
440      # 3 - fallback enc -> unicode
441      enter($u2e,$uch,$ech,$u2e,$fb+0) if ($fb =~ /[01]/);
442      enter($e2u,$ech,$uch,$e2u,$fb+0) if ($fb =~ /[03]/);
443     }
444    else
445     {
446      warn $_;
447     }
448   }
449  if ($nfb && $hfb)
450   {
451    die "$nfb entries without fallback, $hfb entries with\n";
452   }
453  $encoding{$name} = [$e2u,$u2e,$erep,$min_el,$max_el];
454 }
455
456
457
458 sub compile_enc
459 {
460  my ($fh,$name) = @_;
461  my $e2u = {};
462  my $u2e = {};
463
464  my $type;
465  while ($type = <$fh>)
466   {
467    last if $type !~ /^\s*#/;
468   }
469  chomp($type);
470  return if $type eq 'E';
471  # Do the hash lookup once, rather than once per function call. 4% speedup.
472  my $type_func = $encode_types{$type};
473  my ($def,$sym,$pages) = split(/\s+/,scalar(<$fh>));
474  warn "$type encoded $name\n";
475  my $rep = '';
476  # Save a defined test by setting these to defined values.
477  my $min_el = ~0; # A very big integer
478  my $max_el = 0;  # Anything must be longer than 0
479  {
480   my $v = hex($def);
481   $rep = &$type_func($v & 0xFF, ($v >> 8) & 0xffe);
482  }
483  my $errors;
484  my $seen;
485  # use -Q to silence the seen test. Makefile.PL uses this by default.
486  $seen = {} unless $opt{Q};
487  do
488   {
489    my $line = <$fh>;
490    chomp($line);
491    my $page = hex($line);
492    my $ch = 0;
493    my $i = 16;
494    do
495     {
496      # So why is it 1% faster to leave the my here?
497      my $line = <$fh>;
498      $line =~ s/\r\n$/\n/;
499      die "$.:${line}Line should be exactly 65 characters long including
500      newline (".length($line).")" unless length ($line) == 65;
501      # Split line into groups of 4 hex digits, convert groups to ints
502      # This takes 65.35         
503      # map {hex $_} $line =~ /(....)/g
504      # This takes 63.75 (2.5% less time)
505      # unpack "n*", pack "H*", $line
506      # There's an implicit loop in map. Loops are bad, m'kay. Ops are bad, m'kay
507      # Doing it as while ($line =~ /(....)/g) took 74.63
508      foreach my $val (unpack "n*", pack "H*", $line)
509       {
510        next if $val == 0xFFFD;
511        my $ech = &$type_func($ch,$page);
512        if ($val || (!$ch && !$page))
513         {
514          my $el  = length($ech);
515          $max_el = $el if $el > $max_el;
516          $min_el = $el if $el < $min_el;
517          my $uch = encode_U($val);
518          if ($seen) {
519            # We're doing the test.
520            # We don't need to read this quickly, so storing it as a scalar,
521            # rather than 3 (anon array, plus the 2 scalars it holds) saves
522            # RAM and may make us faster on low RAM systems. [see __END__]
523            if (exists $seen->{$uch})
524              {
525                warn sprintf("U%04X is %02X%02X and %04X\n",
526                             $val,$page,$ch,$seen->{$uch});
527                $errors++;
528              }
529            else
530              {
531                $seen->{$uch} = $page << 8 | $ch;
532              }
533          }
534          # Passing 2 extra args each time is 3.6% slower!
535          # Even with having to add $fallback ||= 0 later
536          enter_fb0($e2u,$ech,$uch);
537          enter_fb0($u2e,$uch,$ech);
538         }
539        else
540         {
541          # No character at this position
542          # enter($e2u,$ech,undef,$e2u);
543         }
544        $ch++;
545       }
546     } while --$i;
547   } while --$pages;
548  die "\$min_el=$min_el, \$max_el=$max_el - seems we read no lines"
549    if $min_el > $max_el;
550  die "$errors mapping conflicts\n" if ($errors && $opt{'S'});
551  $encoding{$name} = [$e2u,$u2e,$rep,$min_el,$max_el];
552 }
553
554 # my ($a,$s,$d,$t,$fb) = @_;
555 sub enter {
556   my ($current,$inbytes,$outbytes,$next,$fallback) = @_;
557   # state we shift to after this (multibyte) input character defaults to same
558   # as current state.
559   $next ||= $current;
560   # Making sure it is defined seems to be faster than {no warnings;} in
561   # &process, or passing it in as 0 explicity.
562   # XXX $fallback ||= 0;
563
564   # Start at the beginning and work forwards through the string to zero.
565   # effectively we are removing 1 character from the front each time
566   # but we don't actually edit the string. [this alone seems to be 14% speedup]
567   # Hence -$pos is the length of the remaining string.
568   my $pos = -length $inbytes;
569   while (1) {
570     my $byte = substr $inbytes, $pos, 1;
571     #  RAW_NEXT => 0,
572     #  RAW_IN_LEN => 1,
573     #  RAW_OUT_BYTES => 2,
574     #  RAW_FALLBACK => 3,
575     # to unicode an array would seem to be better, because the pages are dense.
576     # from unicode can be very sparse, favouring a hash.
577     # hash using the bytes (all length 1) as keys rather than ord value,
578     # as it's easier to sort these in &process.
579
580     # It's faster to always add $fallback even if it's undef, rather than
581     # choosing between 3 and 4 element array. (hence why we set it defined
582     # above)
583     my $do_now = $current->{Raw}{$byte} ||= [{},-$pos,'',$fallback];
584     # When $pos was -1 we were at the last input character.
585     unless (++$pos) {
586       $do_now->[RAW_OUT_BYTES] = $outbytes;
587       $do_now->[RAW_NEXT] = $next;
588       return;
589     }
590     # Tail recursion. The intermdiate state may not have a name yet.
591     $current = $do_now->[RAW_NEXT];
592   }
593 }
594
595 # This is purely for optimistation. It's just &enter hard coded for $fallback
596 # of 0, using only a 3 entry array ref to save memory for every entry.
597 sub enter_fb0 {
598   my ($current,$inbytes,$outbytes,$next) = @_;
599   $next ||= $current;
600
601   my $pos = -length $inbytes;
602   while (1) {
603     my $byte = substr $inbytes, $pos, 1;
604     my $do_now = $current->{Raw}{$byte} ||= [{},-$pos,''];
605     unless (++$pos) {
606       $do_now->[RAW_OUT_BYTES] = $outbytes;
607       $do_now->[RAW_NEXT] = $next;
608       return;
609     }
610     $current = $do_now->[RAW_NEXT];
611   }
612 }
613
614 sub process
615 {
616   my ($name,$a) = @_;
617   $name =~ s/\W+/_/g;
618   $a->{Cname} = $name;
619   my $raw = $a->{Raw};
620   my ($l, $agg_max_in, $agg_next, $agg_in_len, $agg_out_len, $agg_fallback);
621   my @ent;
622   $agg_max_in = 0;
623   foreach my $key (sort keys %$raw) {
624     #  RAW_NEXT => 0,
625     #  RAW_IN_LEN => 1,
626     #  RAW_OUT_BYTES => 2,
627     #  RAW_FALLBACK => 3,
628     my ($next, $in_len, $out_bytes, $fallback) = @{$raw->{$key}};
629     # Now we are converting from raw to aggregate, switch from 1 byte strings
630     # to numbers
631     my $b = ord $key;
632     $fallback ||= 0;
633     if ($l &&
634         # If this == fails, we're going to reset $agg_max_in below anyway.
635         $b == ++$agg_max_in &&
636         # References in numeric context give the pointer as an int.
637         $agg_next == $next &&
638         $agg_in_len == $in_len &&
639         $agg_out_len == length $out_bytes &&
640         $agg_fallback == $fallback
641         # && length($l->[AGG_OUT_BYTES]) < 16
642        ) {
643       #     my $i = ord($b)-ord($l->[AGG_MIN_IN]);
644       # we can aggregate this byte onto the end.
645       $l->[AGG_MAX_IN] = $b;
646       $l->[AGG_OUT_BYTES] .= $out_bytes;
647     } else {
648       # AGG_MIN_IN => 0,
649       # AGG_MAX_IN => 1,
650       # AGG_OUT_BYTES => 2,
651       # AGG_NEXT => 3,
652       # AGG_IN_LEN => 4,
653       # AGG_OUT_LEN => 5,
654       # AGG_FALLBACK => 6,
655       # Reset the last thing we saw, plus set 5 lexicals to save some derefs.
656       # (only gains .6% on euc-jp  -- is it worth it?)
657       push @ent, $l = [$b, $agg_max_in = $b, $out_bytes, $agg_next = $next,
658                        $agg_in_len = $in_len, $agg_out_len = length $out_bytes,
659                        $agg_fallback = $fallback];
660     }
661     if (exists $next->{Cname}) {
662       $next->{'Forward'} = 1 if $next != $a;
663     } else {
664       process(sprintf("%s_%02x",$name,$b),$next);
665     }
666   }
667   # encengine.c rules say that last entry must be for 255
668   if ($agg_max_in < 255) {
669     push @ent, [1+$agg_max_in, 255,undef,$a,0,0];
670   }
671   $a->{'Entries'} = \@ent;
672 }
673
674
675 sub addstrings
676 {
677  my ($fh,$a) = @_;
678  my $name = $a->{'Cname'};
679  # String tables
680  foreach my $b (@{$a->{'Entries'}})
681   {
682    next unless $b->[AGG_OUT_LEN];
683    $strings{$b->[AGG_OUT_BYTES]} = undef;
684   }
685  if ($a->{'Forward'})
686   {
687    my $var = $^O eq 'MacOS' ? 'extern' : 'static';
688    print $fh "$var const encpage_t $name\[",scalar(@{$a->{'Entries'}}),"];\n";
689   }
690  $a->{'DoneStrings'} = 1;
691  foreach my $b (@{$a->{'Entries'}})
692   {
693    my ($s,$e,$out,$t,$end,$l) = @$b;
694    addstrings($fh,$t) unless $t->{'DoneStrings'};
695   }
696 }
697
698 sub outbigstring
699 {
700   my ($fh,$name) = @_;
701
702   $string_acc = '';
703
704   # Make the big string in the string accumulator. Longest first, on the hope
705   # that this makes it more likely that we find the short strings later on.
706   # Not sure if it helps sorting strings of the same length lexcically.
707   foreach my $s (sort {length $b <=> length $a || $a cmp $b} keys %strings) {
708     my $index = index $string_acc, $s;
709     if ($index >= 0) {
710       $saved += length($s);
711       $strings_in_acc{$s} = $index;
712     } else {
713     OPTIMISER: {
714         if ($opt{'O'}) {
715           my $sublength = length $s;
716           while (--$sublength > 0) {
717             # progressively lop characters off the end, to see if the start of
718             # the new string overlaps the end of the accumulator.
719             if (substr ($string_acc, -$sublength)
720                 eq substr ($s, 0, $sublength)) {
721               $subsave += $sublength;
722               $strings_in_acc{$s} = length ($string_acc) - $sublength;
723               # append the last bit on the end.
724               $string_acc .= substr ($s, $sublength);
725               last OPTIMISER;
726             }
727             # or if the end of the new string overlaps the start of the
728             # accumulator
729             next unless substr ($string_acc, 0, $sublength)
730               eq substr ($s, -$sublength);
731             # well, the last $sublength characters of the accumulator match.
732             # so as we're prepending to the accumulator, need to shift all our
733             # existing offsets forwards
734             $_ += $sublength foreach values %strings_in_acc;
735             $subsave += $sublength;
736             $strings_in_acc{$s} = 0;
737             # append the first bit on the start.
738             $string_acc = substr ($s, 0, -$sublength) . $string_acc;
739             last OPTIMISER;
740           }
741         }
742         # Optimiser (if it ran) found nothing, so just going have to tack the
743         # whole thing on the end.
744         $strings_in_acc{$s} = length $string_acc;
745         $string_acc .= $s;
746       };
747     }
748   }
749
750   $strings = length $string_acc;
751   my $definition = "\nstatic const U8 $name\[$strings] = { " .
752     join(',',unpack "C*",$string_acc);
753   # We have a single long line. Split it at convenient commas.
754   print $fh $1, "\n" while $definition =~ /\G(.{74,77},)/gcs;
755   print $fh substr ($definition, pos $definition), " };\n";
756 }
757
758 sub findstring {
759   my ($name,$s) = @_;
760   my $offset = $strings_in_acc{$s};
761   die "Can't find string " . join (',',unpack "C*",$s) . " in accumulator"
762     unless defined $offset;
763   "$name + $offset";
764 }
765
766 sub outtable
767 {
768  my ($fh,$a,$bigname) = @_;
769  my $name = $a->{'Cname'};
770  $a->{'Done'} = 1;
771  foreach my $b (@{$a->{'Entries'}})
772   {
773    my ($s,$e,$out,$t,$end,$l) = @$b;
774    outtable($fh,$t,$bigname) unless $t->{'Done'};
775   }
776  print $fh "\nstatic const encpage_t $name\[",
777    scalar(@{$a->{'Entries'}}), "] = {\n";
778  foreach my $b (@{$a->{'Entries'}})
779   {
780    my ($sc,$ec,$out,$t,$end,$l,$fb) = @$b;
781    # $end |= 0x80 if $fb; # what the heck was on your mind, Nick?  -- Dan
782    print  $fh "{";
783    if ($l)
784     {
785      printf $fh findstring($bigname,$out);
786     }
787    else
788     {
789      print  $fh "0";
790     }
791    print  $fh ",",$t->{Cname};
792    printf $fh ",0x%02x,0x%02x,$l,$end},\n",$sc,$ec;
793   }
794  print $fh "};\n";
795 }
796
797 sub output_enc
798 {
799  my ($fh,$name,$a) = @_;
800  die "Changed - fix me for new structure";
801  foreach my $b (sort keys %$a)
802   {
803    my ($s,$e,$out,$t,$end,$l,$fb) = @{$a->{$b}};
804   }
805 }
806
807 sub decode_U
808 {
809  my $s = shift;
810 }
811
812 my @uname;
813 sub char_names
814 {
815  my $s = do "unicore/Name.pl";
816  die "char_names: unicore/Name.pl: $!\n" unless defined $s;
817  pos($s) = 0;
818  while ($s =~ /\G([0-9a-f]+)\t([0-9a-f]*)\t(.*?)\s*\n/igc)
819   {
820    my $name = $3;
821    my $s = hex($1);
822    last if $s >= 0x10000;
823    my $e = length($2) ? hex($2) : $s;
824    for (my $i = $s; $i <= $e; $i++)
825     {
826      $uname[$i] = $name;
827 #    print sprintf("U%04X $name\n",$i);
828     }
829   }
830 }
831
832 sub output_ucm_page
833 {
834   my ($cmap,$a,$t,$pre) = @_;
835   # warn sprintf("Page %x\n",$pre);
836   my $raw = $t->{Raw};
837   foreach my $key (sort keys %$raw) {
838     #  RAW_NEXT => 0,
839     #  RAW_IN_LEN => 1,
840     #  RAW_OUT_BYTES => 2,
841     #  RAW_FALLBACK => 3,
842     my ($next, $in_len, $out_bytes, $fallback) = @{$raw->{$key}};
843     my $u = ord $key;
844     $fallback ||= 0;
845
846     if ($next != $a && $next != $t) {
847       output_ucm_page($cmap,$a,$next,(($pre|($u &0x3F)) << 6)&0xFFFF);
848     } elsif (length $out_bytes) {
849       if ($pre) {
850         $u = $pre|($u &0x3f);
851       }
852       my $s = sprintf "<U%04X> ",$u;
853       #foreach my $c (split(//,$out_bytes)) {
854       #  $s .= sprintf "\\x%02X",ord($c);
855       #}
856       # 9.5% faster changing that loop to this:
857       $s .= sprintf +("\\x%02X" x length $out_bytes), unpack "C*", $out_bytes;
858       $s .= sprintf " |%d # %s\n",($fallback ? 1 : 0),$uname[$u];
859       push(@$cmap,$s);
860     } else {
861       warn join(',',$u, @{$raw->{$key}},$a,$t);
862     }
863   }
864 }
865
866 sub output_ucm
867 {
868  my ($fh,$name,$h,$rep,$min_el,$max_el) = @_;
869  print $fh "# $0 @orig_ARGV\n" unless $opt{'q'};
870  print $fh "<code_set_name> \"$name\"\n";
871  char_names();
872  if (defined $min_el)
873   {
874    print $fh "<mb_cur_min> $min_el\n";
875   }
876  if (defined $max_el)
877   {
878    print $fh "<mb_cur_max> $max_el\n";
879   }
880  if (defined $rep)
881   {
882    print $fh "<subchar> ";
883    foreach my $c (split(//,$rep))
884     {
885      printf $fh "\\x%02X",ord($c);
886     }
887    print $fh "\n";
888   }
889  my @cmap;
890  output_ucm_page(\@cmap,$h,$h,0);
891  print $fh "#\nCHARMAP\n";
892  foreach my $line (sort { substr($a,8) cmp substr($b,8) } @cmap)
893   {
894    print $fh $line;
895   }
896  print $fh "END CHARMAP\n";
897 }
898
899 use vars qw(
900     $_Enc2xs
901     $_Version
902     $_Inc
903     $_E2X 
904     $_Name
905     $_TableFiles
906     $_Now
907 );
908
909 sub find_e2x{
910     eval { require File::Find; };
911     my (@inc, %e2x_dir);
912     for my $inc (@INC){
913         push @inc, $inc unless $inc eq '.'; #skip current dir
914     }
915     File::Find::find(
916              sub {
917                  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
918                      $atime,$mtime,$ctime,$blksize,$blocks)
919                      = lstat($_) or return;
920                  -f _ or return;
921                  if (/^.*\.e2x$/o){
922                      no warnings 'once';
923                      $e2x_dir{$File::Find::dir} ||= $mtime;
924                  }
925                  return;
926              }, @inc);
927     warn join("\n", keys %e2x_dir), "\n";
928     for my $d (sort {$e2x_dir{$a} <=> $e2x_dir{$b}} keys %e2x_dir){
929         $_E2X = $d;
930         # warn "$_E2X => ", scalar localtime($e2x_dir{$d});
931         return $_E2X;
932     }
933 }
934
935 sub make_makefile_pl
936 {
937     eval { require Encode; };
938     $@ and die "You need to install Encode to use enc2xs -M\nerror: $@\n";
939     # our used for variable expanstion
940     $_Enc2xs = $0;
941     $_Version = $VERSION;
942     $_E2X = find_e2x();
943     $_Name = shift;
944     $_TableFiles = join(",", map {qq('$_')} @_);
945     $_Now = scalar localtime();
946
947     eval { require File::Spec; };
948     _print_expand(File::Spec->catfile($_E2X,"Makefile_PL.e2x"),"Makefile.PL");
949     _print_expand(File::Spec->catfile($_E2X,"_PM.e2x"),        "$_Name.pm");
950     _print_expand(File::Spec->catfile($_E2X,"_T.e2x"),         "t/$_Name.t");
951     _print_expand(File::Spec->catfile($_E2X,"README.e2x"),     "README");
952     _print_expand(File::Spec->catfile($_E2X,"Changes.e2x"),    "Changes");
953     exit;
954 }
955
956 use vars qw(
957             $_ModLines
958             $_LocalVer
959             );
960
961 sub make_configlocal_pm
962 {
963     eval { require Encode; };
964     $@ and die "Unable to require Encode: $@\n";
965     eval { require File::Spec; };
966     # our used for variable expanstion
967     my %in_core = map {$_=>1}('ascii','iso-8859-1','utf8');
968     my %LocalMod = ();
969     for my $d (@INC){
970         my $inc = File::Spec->catfile($d, "Encode");
971         -d $inc or next;
972         opendir my $dh, $inc or die "$inc:$!";
973         warn "Checking $inc...\n";
974         for my $f (grep /\.pm$/o, readdir($dh)){
975             -f File::Spec->catfile($inc, "$f") or next;
976             $INC{"Encode/$f"} and next;
977             warn "require Encode/$f;\n";
978             eval { require "Encode/$f"; };
979             $@ and die "Can't require Encode/$f: $@\n";
980             for my $enc (Encode->encodings()){
981                 no warnings 'once';
982                 $in_core{$enc} and next;
983                 $Encode::Config::ExtModule{$enc} and next;
984                 my $mod = "Encode/$f"; 
985                 $mod =~ s/\.pm$//o; $mod =~ s,/,::,og;
986                 $LocalMod{$enc} ||= $mod;
987             }
988         }
989     }
990     $_ModLines = "";
991     for my $enc (sort keys %LocalMod){
992         $_ModLines .= 
993             qq(\$Encode::ExtModule{'$enc'} =\t"$LocalMod{$enc}";\n);
994     }
995     warn $_ModLines;
996     $_LocalVer = _mkversion();
997     $_E2X = find_e2x();
998     $_Inc = $INC{"Encode.pm"}; $_Inc =~ s/\.pm$//o;    
999     _print_expand(File::Spec->catfile($_E2X,"ConfigLocal_PM.e2x"),    
1000                   File::Spec->catfile($_Inc,"ConfigLocal.pm"),
1001                   1);
1002     exit;
1003 }
1004
1005 sub _mkversion{
1006     my ($ss,$mm,$hh,$dd,$mo,$yyyy) = localtime();
1007     $yyyy += 1900, $mo +=1;
1008     return sprintf("v%04d.%04d.%04d", $yyyy, $mo*100+$dd, $hh*100+$mm);
1009 }
1010
1011 sub _print_expand{
1012     eval { require File::Basename; };
1013     $@ and die "File::Basename needed.  Are you on miniperl?;\nerror: $@\n";
1014     File::Basename->import();
1015     my ($src, $dst, $clobber) = @_;
1016     if (!$clobber and -e $dst){
1017         warn "$dst exists. skipping\n";
1018         return;
1019     }
1020     warn "Generating $dst...\n";
1021     open my $in, $src or die "$src : $!";
1022     if ((my $d = dirname($dst)) ne '.'){
1023         -d $d or mkdir $d, 0755 or die  "mkdir $d : $!";
1024     }      
1025     open my $out, ">$dst" or die "$!";
1026     my $asis = 0;
1027     while (<$in>){ 
1028         if (/^#### END_OF_HEADER/){
1029             $asis = 1; next;
1030         }         
1031         s/(\$_[A-Z][A-Za-z0-9]+)_/$1/gee unless $asis;
1032         print $out $_;
1033     }
1034 }
1035 __END__
1036
1037 =head1 NAME
1038
1039 enc2xs -- Perl Encode Module Generator
1040
1041 =head1 SYNOPSIS
1042
1043   enc2xs -[options]
1044   enc2xs -M ModName mapfiles...
1045   enc2xs -C
1046
1047 =head1 DESCRIPTION
1048
1049 F<enc2xs> builds a Perl extension for use by Encode from either
1050 Unicode Character Mapping files (.ucm) or Tcl Encoding Files (.enc).
1051 Besides being used internally during the build process of the Encode
1052 module, you can use F<enc2xs> to add your own encoding to perl.
1053 No knowledge of XS is necessary.
1054
1055 =head1 Quick Guide
1056
1057 If you want to know as little about Perl as possible but need to
1058 add a new encoding, just read this chapter and forget the rest.
1059
1060 =over 4
1061
1062 =item 0.
1063
1064 Have a .ucm file ready.  You can get it from somewhere or you can write
1065 your own from scratch or you can grab one from the Encode distribution
1066 and customize it.  For the UCM format, see the next Chapter.  In the
1067 example below, I'll call my theoretical encoding myascii, defined
1068 in I<my.ucm>.  C<$> is a shell prompt.
1069
1070   $ ls -F
1071   my.ucm
1072
1073 =item 1.
1074
1075 Issue a command as follows;
1076
1077   $ enc2xs -M My my.ucm
1078   generating Makefile.PL
1079   generating My.pm
1080   generating README
1081   generating Changes
1082
1083 Now take a look at your current directory.  It should look like this.
1084
1085   $ ls -F
1086   Makefile.PL   My.pm         my.ucm        t/
1087
1088 The following files were created.
1089
1090   Makefile.PL - MakeMaker script
1091   My.pm       - Encode submodule
1092   t/My.t      - test file
1093
1094 =over 4
1095
1096 =item 1.1.
1097
1098 If you want *.ucm installed together with the modules, do as follows;
1099
1100   $ mkdir Encode
1101   $ mv *.ucm Encode
1102   $ enc2xs -M My Encode/*ucm
1103
1104 =back
1105
1106 =item 2.
1107
1108 Edit the files generated.  You don't have to if you have no time AND no
1109 intention to give it to someone else.  But it is a good idea to edit
1110 the pod and to add more tests.
1111
1112 =item 3.
1113
1114 Now issue a command all Perl Mongers love:
1115
1116   $ perl Makefile.PL
1117   Writing Makefile for Encode::My
1118
1119 =item 4.
1120
1121 Now all you have to do is make.
1122
1123   $ make
1124   cp My.pm blib/lib/Encode/My.pm
1125   /usr/local/bin/perl /usr/local/bin/enc2xs -Q -O \
1126     -o encode_t.c -f encode_t.fnm
1127   Reading myascii (myascii)
1128   Writing compiled form
1129   128 bytes in string tables
1130   384 bytes (75%) saved spotting duplicates
1131   1 bytes (0.775%) saved using substrings
1132   ....
1133   chmod 644 blib/arch/auto/Encode/My/My.bs
1134   $
1135
1136 The time it takes varies depending on how fast your machine is and
1137 how large your encoding is.  Unless you are working on something big
1138 like euc-tw, it won't take too long.
1139
1140 =item 5.
1141
1142 You can "make install" already but you should test first.
1143
1144   $ make test
1145   PERL_DL_NONLAZY=1 /usr/local/bin/perl -Iblib/arch -Iblib/lib \
1146     -e 'use Test::Harness  qw(&runtests $verbose); \
1147     $verbose=0; runtests @ARGV;' t/*.t
1148   t/My....ok
1149   All tests successful.
1150   Files=1, Tests=2,  0 wallclock secs
1151    ( 0.09 cusr + 0.01 csys = 0.09 CPU)
1152
1153 =item 6.
1154
1155 If you are content with the test result, just "make install"
1156
1157 =item 7.
1158
1159 If you want to add your encoding to Encode's demand-loading list
1160 (so you don't have to "use Encode::YourEncoding"), run
1161
1162   enc2xs -C
1163
1164 to update Encode::ConfigLocal, a module that controls local settings.
1165 After that, "use Encode;" is enough to load your encodings on demand.
1166
1167 =back
1168
1169 =head1 The Unicode Character Map
1170
1171 Encode uses the Unicode Character Map (UCM) format for source character
1172 mappings.  This format is used by IBM's ICU package and was adopted
1173 by Nick Ing-Simmons for use with the Encode module.  Since UCM is
1174 more flexible than Tcl's Encoding Map and far more user-friendly,
1175 this is the recommended formet for Encode now.
1176
1177 A UCM file looks like this.
1178
1179   #
1180   # Comments
1181   #
1182   <code_set_name> "US-ascii" # Required
1183   <code_set_alias> "ascii"   # Optional
1184   <mb_cur_min> 1             # Required; usually 1
1185   <mb_cur_max> 1             # Max. # of bytes/char
1186   <subchar> \x3F             # Substitution char
1187   #
1188   CHARMAP
1189   <U0000> \x00 |0 # <control>
1190   <U0001> \x01 |0 # <control>
1191   <U0002> \x02 |0 # <control>
1192   ....
1193   <U007C> \x7C |0 # VERTICAL LINE
1194   <U007D> \x7D |0 # RIGHT CURLY BRACKET
1195   <U007E> \x7E |0 # TILDE
1196   <U007F> \x7F |0 # <control>
1197   END CHARMAP
1198
1199 =over 4
1200
1201 =item *
1202
1203 Anything that follows C<#> is treated as a comment.
1204
1205 =item *
1206
1207 The header section continues until a line containing the word
1208 CHARMAP. This section has a form of I<E<lt>keywordE<gt> value>, one
1209 pair per line.  Strings used as values must be quoted. Barewords are
1210 treated as numbers.  I<\xXX> represents a byte.
1211
1212 Most of the keywords are self-explanatory. I<subchar> means
1213 substitution character, not subcharacter.  When you decode a Unicode
1214 sequence to this encoding but no matching character is found, the byte
1215 sequence defined here will be used.  For most cases, the value here is
1216 \x3F; in ASCII, this is a question mark.
1217
1218 =item *
1219
1220 CHARMAP starts the character map section.  Each line has a form as
1221 follows:
1222
1223   <UXXXX> \xXX.. |0 # comment
1224     ^     ^      ^
1225     |     |      +- Fallback flag
1226     |     +-------- Encoded byte sequence
1227     +-------------- Unicode Character ID in hex
1228
1229 The format is roughly the same as a header section except for the
1230 fallback flag: | followed by 0..3.   The meaning of the possible
1231 values is as follows:
1232
1233 =over 4
1234
1235 =item |0 
1236
1237 Round trip safe.  A character decoded to Unicode encodes back to the
1238 same byte sequence.  Most characters have this flag.
1239
1240 =item |1
1241
1242 Fallback for unicode -> encoding.  When seen, enc2xs adds this
1243 character for the encode map only.
1244
1245 =item |2 
1246
1247 Skip sub-char mapping should there be no code point.
1248
1249 =item |3 
1250
1251 Fallback for encoding -> unicode.  When seen, enc2xs adds this
1252 character for the decode map only.
1253
1254 =back
1255
1256 =item *
1257
1258 And finally, END OF CHARMAP ends the section.
1259
1260 =back
1261
1262 When you are manually creating a UCM file, you should copy ascii.ucm
1263 or an existing encoding which is close to yours, rather than write
1264 your own from scratch.
1265
1266 When you do so, make sure you leave at least B<U0000> to B<U0020> as
1267 is, unless your environment is EBCDIC.
1268
1269 B<CAVEAT>: not all features in UCM are implemented.  For example,
1270 icu:state is not used.  Because of that, you need to write a perl
1271 module if you want to support algorithmical encodings, notably
1272 the ISO-2022 series.  Such modules include L<Encode::JP::2022_JP>,
1273 L<Encode::KR::2022_KR>, and L<Encode::TW::HZ>.
1274
1275 =head2 Coping with duplicate mappings
1276
1277 When you create a map, you SHOULD make your mappings round-trip safe.
1278 That is, C<encode('your-encoding', decode('your-encoding', $data)) eq
1279 $data> stands for all characters that are marked as C<|0>.  Here is
1280 how to make sure:
1281
1282 =over 4
1283
1284 =item * 
1285
1286 Sort your map in Unicode order.
1287
1288 =item *
1289
1290 When you have a duplicate entry, mark either one with '|1' or '|3'.
1291   
1292 =item * 
1293
1294 And make sure the '|1' or '|3' entry FOLLOWS the '|0' entry.
1295
1296 =back
1297
1298 Here is an example from big5-eten.
1299
1300   <U2550> \xF9\xF9 |0
1301   <U2550> \xA2\xA4 |3
1302
1303 Internally Encoding -> Unicode and Unicode -> Encoding Map looks like
1304 this;
1305
1306   E to U               U to E
1307   --------------------------------------
1308   \xF9\xF9 => U2550    U2550 => \xF9\xF9
1309   \xA2\xA4 => U2550
1310  
1311 So it is round-trip safe for \xF9\xF9.  But if the line above is upside
1312 down, here is what happens.
1313
1314   E to U               U to E
1315   --------------------------------------
1316   \xA2\xA4 => U2550    U2550 => \xF9\xF9
1317   (\xF9\xF9 => U2550 is now overwritten!)
1318
1319 The Encode package comes with F<ucmlint>, a crude but sufficient
1320 utility to check the integrity of a UCM file.  Check under the
1321 Encode/bin directory for this.
1322
1323 When in doubt, you can use F<ucmsort>, yet another utility under
1324 Encode/bin directory.
1325
1326 =head1 Bookmarks
1327
1328 =over 4
1329
1330 =item *
1331
1332 ICU Home Page 
1333 L<http://oss.software.ibm.com/icu/>
1334
1335 =item *
1336
1337 ICU Character Mapping Tables
1338 L<http://oss.software.ibm.com/icu/charset/>
1339
1340 =item *
1341
1342 ICU:Conversion Data
1343 L<http://oss.software.ibm.com/icu/userguide/conversion-data.html>
1344
1345 =back
1346
1347 =head1 SEE ALSO
1348
1349 L<Encode>,
1350 L<perlmod>,
1351 L<perlpod>
1352
1353 =cut
1354
1355 # -Q to disable the duplicate codepoint test
1356 # -S make mapping errors fatal
1357 # -q to remove comments written to output files
1358 # -O to enable the (brute force) substring optimiser
1359 # -o <output> to specify the output file name (else it's the first arg)
1360 # -f <inlist> to give a file with a list of input files (else use the args)
1361 # -n <name> to name the encoding (else use the basename of the input file.
1362
1363 With %seen holding array refs:
1364
1365       865.66 real        28.80 user         8.79 sys
1366       7904  maximum resident set size
1367       1356  average shared memory size
1368      18566  average unshared data size
1369        229  average unshared stack size
1370      46080  page reclaims
1371      33373  page faults
1372
1373 With %seen holding simple scalars:
1374
1375       342.16 real        27.11 user         3.54 sys
1376       8388  maximum resident set size
1377       1394  average shared memory size
1378      14969  average unshared data size
1379        236  average unshared stack size
1380      28159  page reclaims
1381       9839  page faults
1382
1383 Yes, 5 minutes is faster than 15. Above is for CP936 in CN. Only difference is
1384 how %seen is storing things its seen. So it is pathalogically bad on a 16M
1385 RAM machine, but it's going to help even on modern machines.
1386 Swapping is bad, m'kay :-)