X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdriver%2Fmangler%2Fghc-asm.lprl;h=e53680e8782313f69a46711635ab91b28ffc9e1f;hb=fb7a723bfd7650a705cb226e07c5b08b7a8e9279;hp=fb89415f257cfab82a8fa560907c6b5456577336;hpb=179c48f7e17a705308ca220b4280fe61d8365ed0;p=ghc-hetmet.git

diff --git a/ghc/driver/mangler/ghc-asm.lprl b/ghc/driver/mangler/ghc-asm.lprl
index fb89415..e53680e 100644
--- a/ghc/driver/mangler/ghc-asm.lprl
+++ b/ghc/driver/mangler/ghc-asm.lprl
@@ -93,14 +93,14 @@ sub init_TARGET_STUFF {
     $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
     $T_US	    = ''; # _ if symbols have an underscore on the front
     $T_PRE_APP	    = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^\$C(\d+):$'; # regexp for what such a lbl looks like
+    $T_CONST_LBL    = '^\$L?C(\d+):$'; # regexp for what such a lbl looks like
     $T_POST_LBL	    = ':';
 
     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)';
     $T_COPY_DIRVS   = '^\s*(\#|\.(file|globl|ent|loc))';
 
     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
-    $T_DOT_WORD	    = '\.quad';
+    $T_DOT_WORD	    = '\.(long|quad|byte|word)';
     $T_DOT_GLOBAL   = '^\t\.globl';
     $T_HDR_literal  = "\.rdata\n\t\.align 3\n";
     $T_HDR_misc	    = "\.text\n\t\.align 3\n";
@@ -433,7 +433,7 @@ sub mangle_asm {
 	last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-|^rs6000-/;
 
 	if ( $TargetPlatform =~ /^mips-/ 
-	  && /^\t\.(globl \S+ \.text|comm\t)/ ) {
+	  && /^\t\.(globl\S+\.text|comm\t)/ ) {
 	    $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
   
 	# As a temporary solution for compiling "foreign export" declarations,
@@ -569,18 +569,16 @@ sub mangle_asm {
 	    $chksymb[$i] = '';
 
 	} elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
-	     &&   /^(_uname|uname|stat|fstat):/ ) {
-	    # for some utterly bizarre reason, this platform
-	    # likes to drop little local C routines with these names
-	    # into each and every .o file that #includes the
-	    # relevant system .h file.  Yuck.  We just don't
-	    # tolerate them in .hc files (which we are processing
-	    # here).  If you need to call one of these things from
-	    # Haskell, make a call to your own C wrapper, then
-	    # put that C wrapper (which calls one of these) in a
-	    # plain .c file.  WDP 95/12
+	     &&   /^[A-Za-z0-9][A-Za-z0-9_]*:/ ) {
+            # Some Solaris system headers contain function definitions (as
+	    # opposed to mere prototypes), which end up in the .hc file when
+	    # a Haskell module foreign imports the corresponding system 
+	    # functions (most notably stat()).  We put them into the text 
+            # segment.  Note that this currently does not extend to function
+	    # names starting with an underscore. 
+	    # - chak 7/2001
 	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'toss';
+	    $chkcat[$i]  = 'misc';
 	    $chksymb[$i] = $1;
 
 	} elsif ( /^${T_US}[A-Za-z0-9_]/o
@@ -590,13 +588,14 @@ sub mangle_asm {
 		   || ! /^(L\.\.\d+|LT\.\..*):$/ ) ) {
 	    local($thing);
 	    chop($thing = $_);
-	    print "Funny global thing?: $_"
+	    print STDERR "Funny global thing?: $_"
 		unless $KNOWN_FUNNY_THING{$thing}
 		    || /^${T_US}stg_.*${T_POST_LBL}$/o          # RTS internals
 		    || /^${T_US}__fexp_.*${T_POST_LBL}$/o       # foreign export
-		    || /^${T_US}__init.*${T_POST_LBL}$/o        # __init<module>
+		    || /^${T_US}__stginit.*${T_POST_LBL}$/o     # __stginit<module>
 		    || /^${T_US}.*_btm${T_POST_LBL}$/o          # large bitmaps
-		    || /^${T_US}.*_closure_tbl${T_POST_LBL}$/o; # closure tables
+		    || /^${T_US}.*_closure_tbl${T_POST_LBL}$/o  # closure tables
+                    || /^_uname:/o;			        # x86/Solaris2
 	    $chk[++$i]   = $_;
 	    $chkcat[$i]  = 'misc';
             if ($TargetPlatform =~ /^powerpc-|^rs6000-/) 
@@ -610,6 +609,10 @@ sub mangle_asm {
     }
     $numchks = $#chk + 1;
 
+    # open CHUNKS, ">/tmp/chunks1" or die "Cannot open /tmp/chunks1: $!\n";
+    # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] }
+    # close CHUNKS;
+
     # the division into chunks is imperfect;
     # we throw some things over the fence into the next
     # chunk.
@@ -619,12 +622,13 @@ sub mangle_asm {
     # output.
 
     local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
+    local($FIRST_TOSSABLE ) = ($TargetPlatform =~ /^(hppa|mips-)/) ? 1 : 0;
 
 #   print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n";
 
     # Alphas: NB: we start meddling at chunk 1, not chunk 0
     # The first ".rdata" is quite magical; as of GCC 2.7.x, it
-    # spits a ".quad 0" in after the v first ".rdata"; we
+    # spits a ".quad 0" in after the very first ".rdata"; we
     # detect this special case (tossing the ".quad 0")!
     local($magic_rdata_seen) = 0;
   
@@ -661,7 +665,7 @@ sub mangle_asm {
     }
     };
 
-    for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
+    for ($i = $FIRST_TOSSABLE; $i < $numchks; $i++) {
 	$c = $chk[$i]; # convenience copy
 
 #	print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
@@ -763,7 +767,7 @@ sub mangle_asm {
 		    print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
 		}
 
-		print "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/
+		print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/
 		   && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 
 		# glue together what's left
@@ -861,6 +865,10 @@ sub mangle_asm {
 	$chk[$i] = $c; # update w/ convenience copy
     }
 
+    # open CHUNKS, ">/tmp/chunks2" or die "Cannot open /tmp/chunks2: $!\n";
+    # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] }
+    # close CHUNKS;
+
     if ( $TargetPlatform =~ /^alpha-/ ) {
 	# print out the header stuff first
 	$chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
@@ -937,7 +945,7 @@ sub mangle_asm {
                 };
  		&print_doctored($chk[$i], 0);
                 if ($TargetPlatform =~ /^powerpc-|^rs6000-/ && $printDS) { 
-#ok                   if ($chksymb[$i] !~ /\__init_Main/) {
+#ok                   if ($chksymb[$i] !~ /\__stginit_Main/) {
   		     print OUTASM "\.csect ${chksymb[$i]}[DS]\n"; 	
   		     print OUTASM "${p}TOC[tc0], 0\n";
 #ok                   }
@@ -1218,7 +1226,7 @@ sub print_doctored {
 
     if ( $TargetPlatform !~ /^i386-/ 
       || ! /^\t[a-z]/  # no instructions in here, apparently
-      || /^${T_US}__init_[A-Za-z0-9_]+${T_POST_LBL}/) {
+      || /^${T_US}__stginit_[A-Za-z0-9_]+${T_POST_LBL}/) {
 	print OUTASM $_;
 	return;
     }
@@ -1419,9 +1427,13 @@ sub rev_tbl {
 
     # Alphas:If we have anonymous text (not part of a procedure), the
     # linker may complain about missing exception information.  Bleh.
+    # To suppress this, we place a .ent/.end pair around the code.
+    # At the same time, we have to be careful and not enclose any leading
+    # .file/.loc directives.
     if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
-    	$before = "\t.ent $1\n" . $before;
-    	$after .= "\t.end $1\n";
+        local ($ident) = $1;
+        $before =~ s/^((\s*\.(file|loc)\s+[^\n]*\n)*)/$1\t.ent $ident\n/;
+    	$after .= "\t.end $ident\n";
     }
 
     $tbl = $before