Re: create_archive_ia32.pl (ddf)

[Etienne Robillard]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Hi,

| address@hidden:~/src/hurd/fabrica/fabrica-archive$ ld --verbose  | grep i386
|    elf_i386
|    i386linux
| OUTPUT_FORMAT("elf32-i386", "elf32-i386",
|               "elf32-i386")
| OUTPUT_ARCH(i386)
| SEARCH_DIR("/usr/i386-linux/lib"); SEARCH_DIR("/usr/lib");
SEARCH_DIR("/usr/l   l/lib"); SEARCH_DIR("/lib");
|
| As you can see ld reports the interesting info on line 3 and 4 instead
| of 2 and 3.  I think you should grep for OUTPUT_FORMAT and OUTPUT_ARCH
| to make it more robust.
I've tried and failed that too ;)

I think it's because OUTPUT_FORMAT is somewhat curved with a new-line
separator, making it quite difficult to match as a whole/string.

Does grepping for 'elf32' works on your system?

Consider this:
none>perl -le 'print grep{/elf32/} qx{ ld --verbose };'

OUTPUT_FORMAT("elf32-i386", "elf32-i386",
~              "elf32-i386")
~    /* .gnu.warning sections are handled specially by elf32.em.  */


Patch follows, some of you might want to try it out :)

Thanks,
erob
-----BEGIN PGP SIGNATURE-----

iD8DBQFA2gonfhO/J4JSDfYRAsQGAKCFq9KTNNDNHZsZ7YHNEozNtgSWFACgjekc
AZrK1mcqk/HpURo+wR0ned8=
=z0hF
-----END PGP SIGNATURE-----

--- create_archive_x86.pl       Wed Jun 23 16:38:11 2004
+++ b/create_archive_x86.pl     Wed Jun 23 18:26:44 2004
@@ -23,16 +23,22 @@
 
 # Define the target architecture here (e.g: 'i386')
 my $ARCH       =       q{i386};
-my $arch_file_name = "fabrica-archive-ldscript";
+
+# Define the archive format here
+my $FORMAT     =       q{elf32};
+
+# XXX Documentation needed
+my $ARCH_FILENAME      = "fabrica-archive-ldscript";
 
 # See perlsub: Temporary values via local()
-local *ARCHFILE;
-open(ARCHFILE, ">$arch_file_name") || die "cannot create $arch_file_name: $!";
+local *ARCHFILE        = open_filehandle($ARCH_FILENAME) || die "$!";
 
 # These formats need to be extracted from the default linker script
 # that can be retrieved from the ld --verbose output. 
-print ARCHFILE "OUTPUT_FORMAT(\"elf32-i386\")\n";
-print ARCHFILE "OUTPUT_ARCH(i386)\n\n";
+my $OUTPUT_FORMAT      = output_format($FORMAT,$ARCH);
+my $OUTPUT_ARCH                = output_arch($ARCH); 
+
+print ARCHFILE $OUTPUT_FORMAT,$OUTPUT_ARCH,"\n\n";
 
 # This must be defined to the minimal page size on the system.
 print ARCHFILE "page_size = 0x1000;\n\n";
@@ -49,20 +55,21 @@
 
 # One for each input file.
 foreach my $file_name (@ARGV) {
-    my @name = split("/", $file_name);
-    print ARCHFILE "INPUT(\"$name[-1]\")\n";
+    my @names = split("/", $file_name);
+    print ARCHFILE "INPUT(\"$names[-1]\")\n";
 }
 
 print ARCHFILE "\n";
-
 print ARCHFILE "SECTIONS\n";
 print ARCHFILE "{\n";
 print ARCHFILE "  . = SIZEOF_HEADERS;\n\n";
+
 foreach my $file_name (@ARGV) {
-    my @name = split("/", $file_name);
-    print ARCHFILE "  $name[-1] ALIGN(page_size): { \"$name[-1]\" }\n"; 
+    my @names = split("/", $file_name);
+    print ARCHFILE "  $names[-1] ALIGN(page_size): { \"$name[-1]\" }\n"; 
 }
 print ARCHFILE "\n";
+
 # This moves the ELF section headers out of the last page of the
 # last file as a precaution.  Might not be necessary. 
 print ARCHFILE "  foo ALIGN(page_size): { BYTE(1) }\n";
@@ -71,19 +78,77 @@
 print ARCHFILE "  :file_list\n";
 print ARCHFILE "}\n";
 
-close(ARCHFILE) || die "can't close  $arch_file_name: $!";
+close(ARCHFILE) || die "can't close  $ARCH_FILENAME: $!";
+
+##########################################################
+# Private methods; Don't touch anything beyond this point!
+
+# Attempts to return OUTPUT_FORMAT while preserving the ld --verbose 
+# aspect. 
+# XXX - Of course the script can fake others values for ARCH and FORMAT,
+# but this is currently not implemented.
+sub output_format 
+{ 
+       my ($format,$arch) = @_;
+       my $ld_verbose = 'ld --verbose';
+       my $string = "";
+       @_ = grep { 
+               if ($format,$arch) { 
+                       $string = qr{($format)-$arch};
+               } elsif ($arch) { 
+                       # XXX - insert other formats here. 
+                       warn "using default elf32 format!\n" 
+                               unless ( $string = qr{(elf32)-$arch} );
+               } else { 
+                       warn "invalid format detected: $@";
+               }
+               m#$string#;
+       } qx { $ld_verbose };
+       return join('',$_[0],$_[1]) or die "output format: $!";
+}
+
+#XXX
+sub output_arch 
+{
+        my $arch = shift; 
+        unless (defined $arch) { 
+               return "OUTPUT_ARCH($arch)" or die "error with output arch: $!";
+       } elsif (defined $ARCH) { 
+               return "OUTPUT_ARCH($ARCH)" or die "error with ouput arch: $!";
+       };
+}
+
+#XXX
+sub open_filehandle 
+{
+       my $filename = shift; 
+       local *FH; 
+       open (FH, ">$filename") or die "error opening $filename: $!";
+       return *FH; 
+}
 
 1;
-__END__;
+__END__
 
 =head1 NAME 
 
-create_archive_x86.pl - perl script for creating a boot archive.
+F<create_archive_x86.pl> - perl script for creating a boot archive.
 
 =head1 SYNOPSIS 
 
-       <define this package methods and constructors into this block>
+I<insert methods and constructors here..>
 
 =head1 DESCRIPTION 
 
-       <small and updated description of what this package should do>
+I<small overview of what this script does, how it's works, etc>
+
+=head1 AUTHORS 
+
+Daniel Wagner, L<wagi at gmx.ch> 
+
+=head1 SEE ALSO
+
+perl(1), L4  
+
+=cut 
+