[project @ 2000-06-13 15:35:29 by sof]

[ghc-hetmet.git] / ghc / driver / mangler / ghc-asm.lprl

diff --git a/ghc/driver/mangler/ghc-asm.lprl b/ghc/driver/mangler/ghc-asm.lprl
index 65519e7..6c6ac74 100644 (file)
--- a/ghc/driver/mangler/ghc-asm.lprl
+++ b/ghc/driver/mangler/ghc-asm.lprl
@@ -89,7 +89,7 @@ sub init_TARGET_STUFF {
     $T_MOVE_DIRVS   = '^((\s+\.(IMPORT|EXPORT|PARAM).*|\s+\.align\s+\d+|\s+\.(SPACE|SUBSPA)\s+\S+|\s*)\n)';
     $T_COPY_DIRVS   = '^\s+\.(IMPORT|EXPORT)';
 
-    $T_hsc_cc_PAT   = '\.STRING.*\)(hsc|cc) (.*)\\\\x09(.*)\\\\x00';
+    $T_hsc_cc_PAT   = '\.STRING.*\)(hsc|cc) (.*)\\\\x09(.*)\\\\x00"';
     $T_DOT_WORD            = '\.word';
     $T_DOT_GLOBAL   = '^\s+\.EXPORT';
     $T_HDR_literal  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
@@ -892,6 +892,25 @@ sub mangle_asm {
                $consist =~ s/\//./g;
                $consist =~ s/-/_/g;
                $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
+               #
+               # Using a cygnus-2.7-96q4 gcc build on hppas, the 
+               # consistency chunk for ghc_cc_ID often (but not always!)
+               # gets lumped with a bunch of .IMPORT directives containing info on
+               # the code or data space nature of external symbols. We can't
+               # toss these, so once the consistency ID has been turned into
+               # a representable symbol, we substitute it for the symbol
+               # that the string was attached to in the first place (ghc_cc_ID.)
+               # (The original string is also substituted away.)
+               #
+               # This change may affect the code output on other platforms in
+               # adverse ways, hence we restrict this hack hppa targets only.
+               #
+               #    -- 2/98 SOF
+               if ( $TargetPlatform =~ /^hppa/ )  {
+                       $chk[$i] =~ s/^$TUS[@]?ghc.*c_ID$TPOSTLBL/$consist/o;
+                       $chk[$i] =~ s/\t$T_hsc_cc_PAT/$T_HDR_misc/o;
+                       $consist = $chk[$i]; #clumsily
+                }
                print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
 
            } elsif ( $TargetPlatform !~ /^(mips)-/ ) { # we just don't try in those case (ToDo)
@@ -975,8 +994,14 @@ sub mangle_asm {
                    } elsif ( $TargetPlatform =~ /^hppa/ ) {
                        $c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
                    } elsif ( $TargetPlatform =~ /^i386-/ ) {
+                       # Reg alloc depending, gcc generated code may jump to the fast entry point via
+                       # a number of registers.
                        $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%edx\n\tjmp \*\%edx\n//;
+                       $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%ecx\n\tjmp \*\%ecx\n//;
                        $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%eax\n\tjmp \*\%eax\n//;
+                       # The next two only apply if we're not stealing %esi or %edi.
+                       $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%esi\n\tjmp \*\%esi\n// if ($StolenX86Regs < 3);
+                       $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%edi\n\tjmp \*\%edi\n// if ($StolenX86Regs < 4);
                    } elsif ( $TargetPlatform =~ /^mips-/ ) {
                        $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
                    } elsif ( $TargetPlatform =~ /^m68k-/ ) {
@@ -1149,6 +1174,8 @@ sub print_doctored {
     local($exit_patch) = '';
     local($call_entry_patch)= '';
     local($call_exit_patch)    = '';
+    local($gc_call_entry_patch)= '';   # Patches before and after calls to Perform_GC_wrapper
+    local($gc_call_exit_patch) = '';
 
 #OLD:  # first, convert calls to *very magic form*: (ToDo: document
     # for real!)  from
@@ -1238,16 +1265,26 @@ sub print_doctored {
 
     # OK, now we can decide what our patch-up code is going to
     # be:
+
+       # Note funky ".=" stuff; we're *adding* to these _patch guys
     if ( $StolenX86Regs <= 2
         && ( /32\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
        $entry_patch .= "\tmovl \%esi,32(\%ebx)\n";
        $exit_patch  .= "\tmovl 32(\%ebx),\%esi\n";
+
+       $gc_call_entry_patch  .= "\tmovl \%esi,32(\%ebx)\n";
+       $gc_call_exit_patch .= "\tmovl 32(\%ebx),\%esi\n";
+
        # nothing for call_{entry,exit} because %esi is callee-save
     }
     if ( $StolenX86Regs <= 3
         && ( /64\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # SpA (edi)
        $entry_patch .= "\tmovl \%edi,64(\%ebx)\n";
        $exit_patch  .= "\tmovl 64(\%ebx),\%edi\n";
+
+       $gc_call_entry_patch  .= "\tmovl \%edi,64(\%ebx)\n";
+       $gc_call_exit_patch .= "\tmovl 64(\%ebx),\%edi\n";
+
        # nothing for call_{entry,exit} because %edi is callee-save
     }
 #=  if ( $StolenX86Regs <= 4
@@ -1265,7 +1302,14 @@ sub print_doctored {
     # next, here we go with non-%esp patching!
     #
     s/^(\t[a-z])/$entry_patch$1/; # before first instruction
-    s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
+
+# Actually, call_entry_patch and call_exit_patch never get set,
+# so let's nuke this one
+#    s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
+
+# Before calling GC we must set up the exit condition before the call
+# and entry condition when we come back
+    s/^(\tcall ${T_DO_GC}\n(\taddl \$\d+,\%esp\n)?)/$gc_call_exit_patch$1$gc_call_entry_patch/g; # _all_ calls
 
     # fix _all_ non-local jumps:
 
@@ -1363,7 +1407,6 @@ sub init_FUNNY_THINGS {
        "${T_US}UnderflowVect7${T_POST_LBL}", 1,
        "${T_US}UpdErr${T_POST_LBL}", 1,
        "${T_US}UpdatePAP${T_POST_LBL}", 1,
-       "${T_US}WorldStateToken${T_POST_LBL}", 1,
        "${T_US}_Enter_Internal${T_POST_LBL}", 1,
        "${T_US}_PRMarking_MarkNextAStack${T_POST_LBL}", 1,
        "${T_US}_PRMarking_MarkNextBStack${T_POST_LBL}", 1,