no_comment

10 files changed, 155 insertions, 45 deletions

diff --git a/perl-install/resize_fat/.cvsignore b/perl-install/resize_fat/.cvsignore
new file mode 100644
index 000000000..3001c7424
--- /dev/null
+++ b/perl-install/resize_fat/.cvsignore
@@ -0,0 +1,5 @@
+blib
+pm_to_blib
+Makefile_c
+c_rewritten.c
+c_rewritten.bs
diff --git a/perl-install/resize_fat/Makefile b/perl-install/resize_fat/Makefile
index 34c257a4e..4b41e1bef 100644
--- a/perl-install/resize_fat/Makefile
+++ b/perl-install/resize_fat/Makefile
@@ -1,12 +1,10 @@
-PRODUCT = libresize
-TARSOURCE = $(PRODUCT).tar.bz2
+.PHONY: clean
 
-.PHONY: clean tar
+c_rewritten: %: %.xs
+	test -e Makefile_c || perl Makefile.PL
+	$(MAKE) -f Makefile_c
+	rm ../auto/resize_fat ; ln -s ../resize_fat/blib/arch/auto ../auto/resize_fat
 
 clean:
-	rm -f *~ TAGS $(TARSOURCE)
-
-tar: clean
-	cp -f ../common.pm .
-	cd .. ; tar cfy $(TARSOURCE) $(PRODUCT) ; mv $(TARSOURCE) $(PRODUCT)
-	rm -f common.pm
+	test ! -e Makefile_c || $(MAKE) -f Makefile_c clean
+	rm -f *~
diff --git a/perl-install/resize_fat/Makefile.PL b/perl-install/resize_fat/Makefile.PL
new file mode 100644
index 000000000..712f4e395
--- /dev/null
+++ b/perl-install/resize_fat/Makefile.PL
@@ -0,0 +1,13 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+WriteMakefile(
+    'MAKEFILE'  => 'Makefile_c',
+    'NAME'	=> 'c_rewritten',
+    'OPTIMIZE'  => '-Os',
+    'VERSION_FROM' => 'c_rewritten.pm', # finds $VERSION
+    'LIBS'	=> '',   # e.g., '-lm' 
+    'DEFINE'	=> '',     # e.g., '-DHAVE_SOMETHING' 
+    'INC'	=> '',     # e.g., '-I/usr/include/other' 
+);
diff --git a/perl-install/resize_fat/any.pm b/perl-install/resize_fat/any.pm
index 6acd0b52c..7d7d006fa 100644
--- a/perl-install/resize_fat/any.pm
+++ b/perl-install/resize_fat/any.pm
@@ -57,7 +57,8 @@ sub max_size($) {
 #- Each FAT entry is flagged as either FREE, FILE or DIRECTORY.
 sub flag_clusters {
     my ($fs) = @_;
-    my ($cluster, $entry, $type);
+    my ($cluster, $entry, $type, $nb_dirs);
+    my $fat_flag_map = "\0" x ($fs->{nb_clusters} + 2);
 
     my $f = sub {
 	($entry) = @_;
@@ -69,14 +70,11 @@ sub flag_clusters {
 	    $type = $DIRECTORY;
 	} else { return }
 
-	for (; !resize_fat::fat::is_eof($cluster); $cluster = resize_fat::fat::next($fs, $cluster)) {
-	    $cluster == 0 and die "Bad FAT: unterminated chain for $entry->{name}\n";
-	    $fs->{fat_flag_map}[$cluster] and die "Bad FAT: cluster $cluster is cross-linked for $entry->{name}\n";
-	    $fs->{fat_flag_map}[$cluster] = $type;
-	    $fs->{clusters}{count}{dirs}++ if $type == $DIRECTORY;
-	}
+	my $nb = resize_fat::c_rewritten::checkFat($fat_flag_map, $cluster, $type, $entry->{name});
+	$nb_dirs += $nb if $type == $DIRECTORY;
+	0;
     };
-    $fs->{fat_flag_map} = [ ($FREE) x ($fs->{nb_clusters} + 2) ];
-    $fs->{clusters}{count}{dirs} = 0;
     resize_fat::directory::traverse_all($fs, $f);
+    $fs->{fat_flag_map} = $fat_flag_map;
+    $fs->{clusters}{count}{dirs} = $nb_dirs;
 }
diff --git a/perl-install/resize_fat/c_rewritten.pm b/perl-install/resize_fat/c_rewritten.pm
new file mode 100644
index 000000000..1f5f505c7
--- /dev/null
+++ b/perl-install/resize_fat/c_rewritten.pm
@@ -0,0 +1,14 @@
+package resize_fat::c_rewritten;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+require DynaLoader;
+
+@ISA = qw(DynaLoader);
+$VERSION = '0.01';
+
+bootstrap resize_fat::c_rewritten $VERSION;
+
+1;
+
diff --git a/perl-install/resize_fat/c_rewritten.xs b/perl-install/resize_fat/c_rewritten.xs
new file mode 100644
index 000000000..a42f3d133
--- /dev/null
+++ b/perl-install/resize_fat/c_rewritten.xs
@@ -0,0 +1,90 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* set by scan_fat, used by next */
+short *fat = NULL;
+int type_size, nb_clusters, bad_cluster_value;
+char *fat_flag_map;
+
+unsigned int next(unsigned int cluster) {
+  short *p = fat + type_size * cluster;
+  if (cluster > nb_clusters + 2) croak("fat::next: cluster %d outside filesystem", cluster);
+  return type_size == 1 ? *p : *((unsigned int *) p);
+}
+
+MODULE = resize_fat::c_rewritten PACKAGE = resize_fat::c_rewritten
+
+void
+scan_fat(fat_, nb_clusters_, type_size_)
+  char *fat_
+  int nb_clusters_
+  int type_size_
+  PPCODE:
+  unsigned int v;  
+  int free = 0, bad = 0, used = 0;
+  short *p;
+  
+  fat = (short*) fat_; type_size = type_size_; nb_clusters = nb_clusters_;
+  bad_cluster_value = type_size ? 0xffffff7 : 0xfff7;
+
+  if (type_size % 16) fprintf(stderr, "unable to handle type_size"), exit(1);
+  type_size /= 16;
+
+  for (p = fat + 2 * type_size; p < fat + type_size * (nb_clusters + 2); p += type_size) {
+    v = type_size == 1 ? *p : *((unsigned int *) p);
+
+    if (v == 0) free++;
+    else if (v == bad_cluster_value) bad++;
+  }
+  used = nb_clusters - free - bad;
+  EXTEND(SP, 3);
+  PUSHs(sv_2mortal(newSViv(free)));
+  PUSHs(sv_2mortal(newSViv(bad)));
+  PUSHs(sv_2mortal(newSViv(used)));
+
+unsigned int
+next(unused, cluster)
+  void *unused
+  unsigned int cluster
+  CODE:
+  RETVAL = next(cluster);
+  OUTPUT:
+  RETVAL
+
+int
+checkFat(fat_flag_map_, cluster, type, name)
+  char *fat_flag_map_
+  unsigned int cluster
+  int type
+  char *name
+  CODE:
+  int nb = 0;
+  fat_flag_map = fat_flag_map_;
+
+  for (; cluster < bad_cluster_value; cluster = next(cluster)) {
+    if (cluster == 0) croak("Bad FAT: unterminated chain for %s\n", name);
+
+    if (fat_flag_map[cluster]) croak("Bad FAT: cluster $cluster is cross-linked for %s\n", name);
+    fat_flag_map[cluster] = type;
+    nb++;
+  }
+  RETVAL = nb;
+  OUTPUT:
+  RETVAL
+
+unsigned int
+flag(cluster)
+  unsigned int cluster
+  CODE:
+  RETVAL = fat_flag_map[cluster];
+  OUTPUT:
+  RETVAL
+
+void
+set_flag(cluster, flag)
+  unsigned int cluster
+  int flag
+  CODE:
+  fat_flag_map[cluster] = flag;
+
diff --git a/perl-install/resize_fat/dir_entry.pm b/perl-install/resize_fat/dir_entry.pm
index cfee23dae..0739b0951 100644
--- a/perl-install/resize_fat/dir_entry.pm
+++ b/perl-install/resize_fat/dir_entry.pm
@@ -21,14 +21,9 @@ sub set_cluster($$) {
     $entry->{first_cluster_high} = $val >> 16 if $resize_fat::isFAT32;
 }
 
-sub is_directory_raw($) {
-    my ($entry) = @_;
-    !is_special_entry($entry) && $entry->{attributes} & $DIRECTORY_ATTR;
-}
-
 sub is_directory($) {
     my ($entry) = @_;
-    is_directory_raw($entry) && $entry->{name} !~ /^\.\.? /;
+    $entry->{attributes} & $DIRECTORY_ATTR && $entry->{name} !~ /^\.\.? / && !is_special_entry($entry);
 }
 
 sub is_volume($) {
diff --git a/perl-install/resize_fat/directory.pm b/perl-install/resize_fat/directory.pm
index 46e810021..f62203e50 100644
--- a/perl-install/resize_fat/directory.pm
+++ b/perl-install/resize_fat/directory.pm
@@ -24,10 +24,11 @@ my @fields = (
     'first_cluster',
     'length',
 );
+my $psizeof_format = psizeof($format);
 
 1;
 
-sub entry_size { psizeof($format) }
+sub entry_size { $psizeof_format }
 
 #- call `f' for each entry of the directory
 #- if f return true, then modification in the entry are taken back
@@ -35,7 +36,7 @@ sub traverse($$$) {
     my ($fs, $directory, $f) = @_;
 
     for (my $i = 0;; $i++) {
-	my $raw = \substr($directory, $i * psizeof($format), psizeof($format));
+	my $raw = \substr($directory, $i * $psizeof_format, $psizeof_format);
 
 	#- empty entry means end of directory
 	$$raw =~ /^\0*$/ and return $directory;
diff --git a/perl-install/resize_fat/fat.pm b/perl-install/resize_fat/fat.pm
index e6039077a..67c64165c 100644
--- a/perl-install/resize_fat/fat.pm
+++ b/perl-install/resize_fat/fat.pm
@@ -5,6 +5,7 @@ use strict;
 
 use resize_fat::any;
 use resize_fat::io;
+use resize_fat::c_rewritten;
 
 1;
 
@@ -20,15 +21,8 @@ sub read($) {
 
     $fs->{fat} = $fs->{fats}[0];
 
-    my ($free, $bad, $used) = (0, 0, 0);
-
-    for (my $i = 2; $i < $fs->{nb_clusters} + 2; $i++) {
-	my $cluster = &next($fs, $i);
-	if ($cluster == 0) { $free++; }
-	elsif ($cluster == $resize_fat::bad_cluster_value) { $bad++; }
-	else { $used++; }
-    }
-    @{$fs->{clusters}{count}}{qw(free bad used)} = ($free, $bad, $used);
+    @{$fs->{clusters}{count}}{qw(free bad used)} =
+      resize_fat::c_rewritten::scan_fat($fs->{fat}, $fs->{nb_clusters}, $fs->{fs_type_size});
 }
 
 sub write($) {
@@ -61,7 +55,7 @@ sub allocate_remap {
     $fs->{last_free_cluster} = 2;
     for ($cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
 	if ($cluster < $cut_point) {
-	    if ($fs->{fat_flag_map}[$cluster] == $resize_fat::any::DIRECTORY) {
+	    if (resize_fat::c_rewritten::flag($cluster) == $resize_fat::any::DIRECTORY) {
 		&$get_new();
 	    } else {
 		$new_cluster = $cluster;
@@ -80,7 +74,7 @@ sub update {
     my ($fs) = @_;
 
     for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
-	 if ($fs->{fat_flag_map}[$cluster]) {
+	 if (resize_fat::c_rewritten::flag($cluster)) {
 	     my $old_next = &next($fs, $cluster);
 	     my $new      = $fs->{fat_remap}[$cluster];
 	     my $new_next = $fs->{fat_remap}[$old_next];
@@ -100,6 +94,7 @@ sub update {
 #- are done in count.c
 sub check($) {
     my ($fs) = @_;
+    return;
     foreach (@{$fs->{fats}}) {
 	$_ eq $fs->{fats}[0] or die "FAT tables do not match";
     }
@@ -118,12 +113,13 @@ sub endianness($$) {
     $r;
 }
 
-sub next($$) {
-    my ($fs, $cluster) = @_;
-    $cluster > $fs->{nb_clusters} + 2 and die "fat::next: cluster $cluster outside filesystem";
-    endianness(vec($fs->{fat}, $cluster, $fs->{fs_type_size}), $fs->{fs_type_size});
+#-sub next($$) {
+#-    my ($fs, $cluster) = @_;
+#-    $cluster > $fs->{nb_clusters} + 2 and die "fat::next: cluster $cluster outside filesystem";
+#-    endianness(vec($fs->{fat}, $cluster, $fs->{fs_type_size}), $fs->{fs_type_size});
+#-}
+*next = \&resize_fat::c_rewritten::next;
 
-}
 sub set_next($$$) {
     my ($fs, $cluster, $new_v) = @_;
     $cluster > $fs->{nb_clusters} + 2 and die "fat::set_next: cluster $cluster outside filesystem";
diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm
index 1e5ac62be..762d18bca 100644
--- a/perl-install/resize_fat/main.pm
+++ b/perl-install/resize_fat/main.pm
@@ -64,7 +64,7 @@ sub copy_clusters {
 	}
     };
     for (; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
-	$fs->{fat_flag_map}[$cluster] == $resize_fat::any::FILE or next;
+	resize_fat::c_rewritten::flag($cluster) == $resize_fat::any::FILE or next;
 	push @buffer, $fs->{fat_remap}[$cluster], resize_fat::io::read_cluster($fs, $cluster);
 	@buffer > 50 and &$flush();
     }
@@ -78,11 +78,11 @@ sub construct_dir_tree {
     if ($resize_fat::isFAT32) {
 	#- fat32's root must remain in the first 64k clusters
 	#- so don't set it as DIRECTORY, it will be specially handled
-	$fs->{fat_flag_map}[$fs->{fat32_root_dir_cluster}] = $resize_fat::any::FREE;
+	resize_fat::c_rewritten::set_flag($fs->{fat32_root_dir_cluster}, $resize_fat::any::FREE);
     }
 
     for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
-	$fs->{fat_flag_map}[$cluster] == $resize_fat::any::DIRECTORY or next;
+	resize_fat::c_rewritten::flag($cluster) == $resize_fat::any::DIRECTORY or next;
 
       resize_fat::io::write_cluster($fs,
 				    $fs->{fat_remap}[$cluster],