X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=driver%2Fmangler%2Fghc-asm.lprl;h=941d608a792e631f36efc51696c17f003b98358a;hb=aee2068e034aca6ddaf6f20f85902137ecf718b7;hp=902593ea7f1a52467fe9a9f79e6f84ffce6b89db;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/driver/mangler/ghc-asm.lprl b/driver/mangler/ghc-asm.lprl index 902593e..941d608 100644 --- a/driver/mangler/ghc-asm.lprl +++ b/driver/mangler/ghc-asm.lprl @@ -201,7 +201,7 @@ sub init_TARGET_STUFF { $T_DOT_WORD = '\.(long|value|byte|zero)'; $T_DOT_GLOBAL = '\.global'; $T_HDR_literal = "\.section\t\.rodata\n"; - $T_HDR_misc = "\.text\n\t\.align 8\n"; + $T_HDR_misc = "\.text\n\t\.align 16\n"; # May contain code; align like 'entry' $T_HDR_data = "\.data\n\t\.align 8\n"; $T_HDR_rodata = "\.section\t\.rodata\n\t\.align 8\n"; $T_HDR_closure = "\.data\n\t\.align 8\n"; @@ -298,7 +298,7 @@ sub init_TARGET_STUFF { $T_CONST_LBL = '^\LC\d+:'; # regexp for what such a lbl looks like $T_POST_LBL = ':'; - $T_MOVE_DIRVS = '^(\s*(\.align \d+|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)'; + $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s.*|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)'; $T_COPY_DIRVS = '\.(globl|lcomm)'; $T_DOT_WORD = '\.(long|short|byte|fill|space)'; @@ -326,7 +326,7 @@ sub init_TARGET_STUFF { $T_X86_PRE_LLBL = 'L'; $T_X86_BADJMP = '^\tjmp [^L\*]'; - $T_MOVE_DIRVS = '^(\s*(\.align \d+|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)'; + $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s.*|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)'; $T_COPY_DIRVS = '\.(globl|lcomm)'; $T_DOT_WORD = '\.(long|short|byte|fill|space)'; @@ -344,6 +344,32 @@ sub init_TARGET_STUFF { $T_HDR_vector = "\t\.text\n\t\.align 2\n"; #--------------------------------------------------------# + } elsif ( $TargetPlatform =~ /^x86_64-apple-darwin.*/ ) { + # Apple PowerPC Darwin/MacOS X. + $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 = 'DOESNT APPLY'; # regexp that says what comes before APP/NO_APP + $T_CONST_LBL = '^\LC\d+:'; # regexp for what such a lbl looks like + $T_POST_LBL = ':'; + + $T_MOVE_DIRVS = '^(\s*(\.align \d+|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)'; + $T_COPY_DIRVS = '\.(globl|lcomm)'; + + $T_DOT_WORD = '\.(quad|long|short|byte|fill|space)'; + $T_DOT_GLOBAL = '\.globl'; + $T_HDR_toc = "\.toc\n"; + $T_HDR_literal16= "\t\.literal8\n\t\.align 4\n"; + $T_HDR_literal = "\t\.const\n\t\.align 4\n"; + $T_HDR_misc = "\t\.text\n\t\.align 2\n"; + $T_HDR_data = "\t\.data\n\t\.align 2\n"; + $T_HDR_rodata = "\t\.const\n\t\.align 2\n"; + $T_HDR_relrodata= "\t\.const_data\n\t\.align 2\n"; + $T_HDR_closure = "\t\.data\n\t\.align 2\n"; + $T_HDR_info = "\t\.text\n\t\.align 2\n"; + $T_HDR_entry = "\t\.text\n\t\.align 2\n"; + $T_HDR_vector = "\t\.text\n\t\.align 2\n"; + + #--------------------------------------------------------# } elsif ( $TargetPlatform =~ /^powerpc-.*-linux/ ) { # PowerPC Linux $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) @@ -446,8 +472,8 @@ sub init_TARGET_STUFF { $T_CONST_LBL = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like $T_POST_LBL = ':'; - $T_MOVE_DIRVS = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.seg|\.stab.*|\s+?\.section.*|\s+\.type.*|\s+\.size.*)\n)'; - $T_COPY_DIRVS = '\.(global|globl|proc|stab)'; + $T_MOVE_DIRVS = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\s+\.local\s+\S+|\.text|\.data|\.seg|\.stab.*|\s+?\.section.*|\s+\.type.*|\s+\.size.*)\n)'; + $T_COPY_DIRVS = '\.(global|local|globl|proc|stab)'; $T_DOT_WORD = '\.(long|word|nword|xword|byte|half|short|skip|uahalf|uaword)'; $T_DOT_GLOBAL = '^\t\.global'; @@ -699,6 +725,12 @@ sub mangle_asm { $chkcat[$i] = 'data'; $chksymb[$i] = ''; + } elsif ( /^${T_US}([A-Za-z0-9_]+)_hpc${T_POST_LBL}$/o ) { + # hpc shares tick boxes across modules + $chk[++$i] = $_; + $chkcat[$i] = 'data'; + $chksymb[$i] = ''; + } elsif ( /^${T_US}([A-Za-z0-9_]+)_(alt|dflt)${T_POST_LBL}$/o ) { $chk[++$i] = $_; $chkcat[$i] = 'misc'; @@ -782,6 +814,8 @@ sub mangle_asm { } } $numchks = $#chk + 1; + $chk[$numchks] = ''; # We might push .note.GNU-stack into this + $chkcat[$numchks] = 'verbatim'; # If we do, write it straight back out # open CHUNKS, ">/tmp/chunks1" or die "Cannot open /tmp/chunks1: $!\n"; # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] } @@ -878,15 +912,42 @@ sub mangle_asm { $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, 3[12], \d+, 0\n//; $p =~ s/^\t\.fframe \d+\n\tadds r12 = -\d+, r12\n//; $p =~ s/^\t\.save rp, r\d+\n\tmov r\d+ = b0\n//; - $p =~ s/^\t\.(mii|mmi)\n//g; # bundling is no longer sensible + + # Remove .proc and .body directives + $p =~ s/^\t\.proc [a-zA-Z0-9_#.]+\n//; + $p =~ s/^\t\.body\n//; + # If there's a label, move it to the body + if ($p =~ /^[a-zA-Z0-9#.]+:\n/) { + $p = $` . $'; + $r = $& . $r; + } + # Remove floating-point spill instructions. This is actually a bad + # thing to remove, because we will be putting junk into the floating-point + # registers and this will be visible to the caller. + # Only fp registers 2-5 and 16-31 may be spilled. + if ($p =~ s/^\tstf\.spill \[r1[4-9]\] = f([2-5]|1[6-9]|2[0-9]|30|31)(, [0-9]+)?\n//g) { + # Being paranoid, only try to remove these if we saw a spill + # operation. + $p =~ s/^\tmov r1[4-9] = r12\n//; + $p =~ s/^\tadds r1[4-9] = -[0-9]+, r12\n//g; + $p =~ s/^\t\.save\.f 0x[0-9a-fA-F]\n//g; + } + + $p =~ s/^\tnop\.[mifb]\s+0\n//g; # remove nop instructions + $p =~ s/^\t\.(mii|mmi|mfi)\n//g; # bundling is no longer sensible $p =~ s/^\t;;\n//g; # discard stops $p =~ s/^\t\/\/.*\n//g; # gcc inserts timings in // comments - # GCC 3.3 saves r1 in the prologue, move this to the body - if ($p =~ /^\tmov r\d+ = r1\n/) { - $p = $` . $'; - $r = $& . $r; - } + # GCC 3.3 saves r1 in the prologue, move this to the body + if ($p =~ /^\tmov r\d+ = r1\n/) { + $p = $` . $'; + $r = $& . $r; + } + # GCC 3.2 saves pr in the prologue, move this to the body + if ($p =~ /^\tmov r\d+ = pr\n/) { + $p = $` . $'; + $r = $& . $r; + } } elsif ($TargetPlatform =~ /^m68k-/) { $p =~ s/^\tlink a6,#-?\d.*\n//; $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//; @@ -923,8 +984,8 @@ sub mangle_asm { $p =~ s/^\tstw r0,\d+\(r1\)\n//g; $p =~ s/^\tstwu r1,-\d+\(r1\)\n//; $p =~ s/^\tstw r\d+,-\d+\(r1\)\n//g; - $p =~ s/^\tbcl 20,31,L\d+\$pb\n//; - $p =~ s/^L\d+\$pb:\n//; + $p =~ s/^\tbcl 20,31,\"?L\d+\$pb\"?\n//; + $p =~ s/^\"?L\d+\$pb\"?:\n//; $p =~ s/^\tmflr r31\n//; # This is bad: GCC 3 seems to zero-fill some local variables in the prologue @@ -1008,6 +1069,9 @@ sub mangle_asm { # toss all epilogue stuff; again, paranoidly if ( $c =~ /--- END ---/ ) { if (($r, $e) = split(/--- END ---/, $c)) { + # rtail holds code that is after the epilogue in the assembly-code + # layout and should not be filtered as part of the epilogue. + $rtail = ""; if ($TargetPlatform =~ /^i386-/) { $e =~ s/^\tret\n//; $e =~ s/^\tpopl\s+\%edi\n//; @@ -1017,13 +1081,56 @@ sub mangle_asm { $e =~ s/^\taddl\s+\$\d+,\s*\%esp\n//; $e =~ s/^\tsubl\s+\$-\d+,\s*\%esp\n//; } elsif ($TargetPlatform =~ /^ia64-/) { + # GCC may have put the function's epilogue code in the _middle_ + # of the function. We try to detect that here and extract the + # code that belongs to the body of the function. We'll put that + # code back after cleaning up the epilogue. + # The epilogue is first split into: + # $e, the epilogue code (up to the return instruction) + # $rtail, the rest of the function body + # $edir, the directives following the function + # (everything starting with .endp) + # The return instruction and endp directive are stripped in the + # process. + if (!(($e, $rtail) = split(/^\tbr\.ret\.sptk\.many b0\n/, $e))) { + die "Epilogue doesn't seem to have one return instruction: $e\n"; + } + if (!(($rtail, $edir) = split(/^\t\.endp [a-zA-Z0-9_#.]+\n/, $rtail))) { + die "Epilogue doesn't seem to have one endp directive: $e\n"; + } + # print STDERR "Epilogue: $e\n"; + # print STDERR "Code tail: $rtail\n"; + # print STDERR "Directives: $edir\n"; + + # If a return value is saved here, move it to the function body + if ($e =~ /^\tmov r8 = r14\n/) { + $e = $` . $'; + $r = $r . $&; + } + + # Remove floating-point fill instructions. This is actually a bad + # thing to remove, because we will be putting junk into the + # floating-point registers and this will be visible to the caller. + # Only fp registers 2-5 and 16-31 may be restored. + if ($e =~ s/^\tldf\.fill f([2-5]|1[6-9]|2[0-9]|30|31) = \[r1[4-9]\](, [0-9]+)?\n//g) { + # Being paranoid, only try to remove this if we saw a fill + # operation. + $e =~ s/^\tadds r1[4-9] = [0-9]+, r12//g; + } + + $e =~ s/^\tnop\.[mifb]\s+0\n//g; # remove nop instructions + $e =~ s/^\tmov ar\.pfs = r\d+\n//; $e =~ s/^\tmov b0 = r\d+\n//; $e =~ s/^\t\.restore sp\n\tadds r12 = \d+, r12\n//; - $e =~ s/^\tbr\.ret\.sptk\.many b0\n//; - $e =~ s/^\t\.(mii|mmi|mib)\n//g; # bundling is no longer sensible - $e =~ s/^\t;;\n//g; # discard stops - stop at end of body is sufficient - $e =~ s/^\t\/\/.*\n//g; # gcc inserts timings in // comments + #$e =~ s/^\tbr\.ret\.sptk\.many b0\n//; # already removed + $e =~ s/^\t\.(mii|mmi|mfi|mib)\n//g; # bundling is no longer sensible + $e =~ s/^\t;;\n//g; # discard stops - stop at end of body is sufficient + $e =~ s/^\t\/\/.*\n//g; # gcc inserts timings in // comments + + # Tack edir onto the end of rtail. Some of the directives in + # edir are relevant to the next chunk. + $rtail .= $edir; } elsif ($TargetPlatform =~ /^m68k-/) { $e =~ s/^\tunlk a6\n//; $e =~ s/^\trts\n//; @@ -1061,7 +1168,7 @@ sub mangle_asm { print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/; # glue together what's left - $c = $r . $e; + $c = $r . $e . $rtail; $c =~ s/\n\t\n/\n/; # junk blank line } } @@ -1090,11 +1197,29 @@ sub mangle_asm { # IA64: mangle tailcalls into jumps here if ($TargetPlatform =~ /^ia64-/) { - while ($c =~ s/^\tbr\.call\.sptk\.many b0 = (.*)\n(?:^\.L([0-9]*):\n)?(?:\t;;\n)?(?:\tmov r1 = r\d+\n)?(?:\t;;\n)?\t--- TAILCALL ---\n(?:\t;;\n\tbr \.L\d+\n)?/\tbr\.few $1\n/) { + # Example of what is mangled: + # br.call.sptk.many b0 = b6 + #.L211 + # ;; + # .mmi + # mov r1 = r32 + # ;; + # nop.m 0 + # nop.i 0 + # ;; + # --- TAILCALL -- + # ;; + #.L123 + while ($c =~ s/^\tbr\.call\.sptk\.many b0 = (.*)\n(?:^\.L([0-9]*):\n)?(?:\t;;\n)?(?:\t\.(?:mii|mmi|mfi|mfb)\n)?(?:\tmov r1 = r\d+\n)?(?:\t;;\n)?(?:\tnop\.[mifb] \d+\n)*\t--- TAILCALL ---\n(?:\t;;\n\tbr \.L\d+\n)?/\tbr\.few $1\n/) { # Eek, the gcc optimiser is getting smarter... if we see a jump to the --- TAILCALL --- # marker then we reapply the substitution at the source sites $c =~ s/^\tbr \.L$2\n/\t--- TAILCALL ---\n/g if ($2); } + + # Verify that all instances of TAILCALL were processed + if ($c =~ /^\t--- TAILCALL ---\n/) { + die "Unmangled TAILCALL tokens remain after mangling" + } } # MIPS: that may leave some gratuitous asm macros around @@ -1142,12 +1267,18 @@ sub mangle_asm { } } - elsif ( $i < ($numchks - 1) - && ( $to_move =~ /${T_COPY_DIRVS}/ - || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) { - $chk[$i + 1] = $to_move . $chk[$i + 1]; - # otherwise they're tossed - } + elsif ( ( $i < ($numchks - 1) + && ( $to_move =~ /${T_COPY_DIRVS}/ + || ( $TargetPlatform =~ /^hppa/ + && $to_move =~ /align/ + && $chkcat[$i+1] eq 'literal') + ) + ) + || ($to_move =~ /^[ \t]*\.section[ \t]+\.note\.GNU-stack,/) + ) { + $chk[$i + 1] = $to_move . $chk[$i + 1]; + # otherwise they're tossed + } $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o; } @@ -1249,7 +1380,8 @@ sub mangle_asm { } } - for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) { + # $numchks + 1 as we have the extra one for .note.GNU-stack + for ($i = $FIRST_MANGLABLE; $i < $numchks + 1; $i++) { # print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n"; next if $chkcat[$i] eq 'DONE ALREADY'; @@ -1260,6 +1392,9 @@ sub mangle_asm { &print_doctored($chk[$i], 0); } + } elsif ( $chkcat[$i] eq 'verbatim' ) { + print OUTASM $chk[$i]; + } elsif ( $chkcat[$i] eq 'toss' ) { print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n"; @@ -1724,6 +1859,20 @@ sub rev_tbl { } } + if ( $TargetPlatform =~ /x86_64-apple-darwin/ ) { + # Tack a label to the front of the info table, too. + # For now, this just serves to work around a crash in Apple's new + # 64-bit linker (it seems to assume that there is no data before the + # first label in a section). + + # The plan for the future is to do this on all Darwin platforms, and + # to add a reference to this label after the entry code, just as the + # NCG does, so we can enable dead-code-stripping in the linker without + # losing our info tables. (Hence the name _dsp, for dead-strip preventer) + + $before .= "\n${infoname}_dsp:\n"; + } + $tbl = $before . (($TargetPlatform !~ /^hppa/) ? '' : join("\n", @imports) . "\n") . join("\n", @words) . "\n"