Ticket #1150: ghc-asm.lprl.patch

File ghc-asm.lprl.patch, 8.9 KB (added by heatsink, 7 years ago)

Patch to GHC 6.6 mangler, verified on ia64 with GCC 3.2

Line 
1*** ghc-6.6/driver/mangler/ghc-asm.lprl Tue Oct 10 14:03:52 2006
2--- ../ghc-local/ghc-6.6/driver/mangler/ghc-asm.lprl    Sat Feb 24 23:50:20 2007
3***************
4*** 201,207 ****
5      $T_DOT_WORD     = '\.(long|value|byte|zero)';
6      $T_DOT_GLOBAL   = '\.global';
7      $T_HDR_literal  = "\.section\t\.rodata\n";
8!     $T_HDR_misc     = "\.text\n\t\.align 8\n";
9      $T_HDR_data     = "\.data\n\t\.align 8\n";
10      $T_HDR_rodata   = "\.section\t\.rodata\n\t\.align 8\n";
11      $T_HDR_closure  = "\.data\n\t\.align 8\n";
12--- 201,207 ----
13      $T_DOT_WORD     = '\.(long|value|byte|zero)';
14      $T_DOT_GLOBAL   = '\.global';
15      $T_HDR_literal  = "\.section\t\.rodata\n";
16!     $T_HDR_misc     = "\.text\n\t\.align 16\n";  # May contain code; align like 'entry'
17      $T_HDR_data     = "\.data\n\t\.align 8\n";
18      $T_HDR_rodata   = "\.section\t\.rodata\n\t\.align 8\n";
19      $T_HDR_closure  = "\.data\n\t\.align 8\n";
20***************
21*** 878,884 ****
22                    $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, 3[12], \d+, 0\n//;
23                    $p =~ s/^\t\.fframe \d+\n\tadds r12 = -\d+, r12\n//;
24                    $p =~ s/^\t\.save rp, r\d+\n\tmov r\d+ = b0\n//;
25!                   $p =~ s/^\t\.(mii|mmi)\n//g;        # bundling is no longer sensible
26                    $p =~ s/^\t;;\n//g;         # discard stops
27                    $p =~ s/^\t\/\/.*\n//g;     # gcc inserts timings in // comments
28 
29--- 878,906 ----
30                    $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, 3[12], \d+, 0\n//;
31                    $p =~ s/^\t\.fframe \d+\n\tadds r12 = -\d+, r12\n//;
32                    $p =~ s/^\t\.save rp, r\d+\n\tmov r\d+ = b0\n//;
33!
34!                   # Remove .proc and .body directives
35!                   $p =~ s/^\t\.proc [a-zA-Z0-9_#.]+\n//;
36!                   $p =~ s/^\t\.body\n//;
37!                   # If there's a label, move it to the body
38!                   if ($p =~ /^[a-zA-Z0-9#.]+:\n/) {
39!                       $p = $` . $';
40!                       $r = $& . $r;
41!                     }
42!                   # Remove floating-point spill instructions.  This is actually a bad
43!                   # thing to remove, because we will be putting junk into the floating-point
44!                   # registers and this will be visible to the caller.
45!                   # Only fp registers 2-5 and 16-31 may be spilled.
46!                   if ($p =~ s/^\tstf\.spill \[r1[4-9]\] = f([2-5]|1[6-9]|2[0-9]|30|31)(, [0-9]+)?\n//g) {
47!                       # Being paranoid, only try to remove these if we saw a spill
48!                       # operation.
49!                       $p =~ s/^\tmov r1[4-9] = r12\n//;
50!                       $p =~ s/^\tadds r1[4-9] = -[0-9]+, r12\n//g;
51!                       $p =~ s/^\t\.save\.f 0x[0-9a-fA-F]\n//g;
52!                   }
53!
54!                   $p =~ s/^\tnop\.[mifb]\s+0\n//g; # remove nop instructions
55!                   $p =~ s/^\t\.(mii|mmi|mfi)\n//g;    # bundling is no longer sensible
56                    $p =~ s/^\t;;\n//g;         # discard stops
57                    $p =~ s/^\t\/\/.*\n//g;     # gcc inserts timings in // comments
58 
59***************
60*** 887,892 ****
61--- 909,919 ----
62                          $p = $` . $';
63                          $r = $& . $r;
64                    }
65+                   # GCC 3.2 saves pr in the prologue, move this to the body
66+                   if ($p =~ /^\tmov r\d+ = pr\n/) {
67+                         $p = $` . $';
68+                         $r = $& . $r;
69+                   }
70                } elsif ($TargetPlatform =~ /^m68k-/) {
71                    $p =~ s/^\tlink a6,#-?\d.*\n//;
72                    $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;   
73***************
74*** 1008,1013 ****
75--- 1035,1043 ----
76        # toss all epilogue stuff; again, paranoidly
77        if ( $c =~ /--- END ---/ ) {
78            if (($r, $e) = split(/--- END ---/, $c)) {
79+               # rtail holds code that is after the epilogue in the assembly-code layout
80+               # and should not be filtered as part of the epilogue.
81+               $rtail = "";
82                if ($TargetPlatform =~ /^i386-/) {
83                    $e =~ s/^\tret\n//;
84                    $e =~ s/^\tpopl\s+\%edi\n//;
85***************
86*** 1017,1029 ****
87                    $e =~ s/^\taddl\s+\$\d+,\s*\%esp\n//;
88                    $e =~ s/^\tsubl\s+\$-\d+,\s*\%esp\n//;
89                } elsif ($TargetPlatform =~ /^ia64-/) {
90                    $e =~ s/^\tmov ar\.pfs = r\d+\n//;
91                    $e =~ s/^\tmov b0 = r\d+\n//;
92                    $e =~ s/^\t\.restore sp\n\tadds r12 = \d+, r12\n//;
93!                   $e =~ s/^\tbr\.ret\.sptk\.many b0\n//;
94!                   $e =~ s/^\t\.(mii|mmi|mib)\n//g;    # bundling is no longer sensible
95!                   $e =~ s/^\t;;\n//g;                 # discard stops - stop at end of body is sufficient
96                    $e =~ s/^\t\/\/.*\n//g;             # gcc inserts timings in // comments
97                } elsif ($TargetPlatform =~ /^m68k-/) {
98                    $e =~ s/^\tunlk a6\n//;
99                    $e =~ s/^\trts\n//;
100--- 1047,1100 ----
101                    $e =~ s/^\taddl\s+\$\d+,\s*\%esp\n//;
102                    $e =~ s/^\tsubl\s+\$-\d+,\s*\%esp\n//;
103                } elsif ($TargetPlatform =~ /^ia64-/) {
104+                   # GCC may have put the function's epilogue code in the _middle_ of the function.
105+                   # We try to detect that here and extract the code that belongs to the
106+                   # body of the function.  We'll put that code back after cleaning up
107+                   # the epilogue.
108+                   # The epilogue is first split into:
109+                   #     $e,    the epilogue code (up to the return instruction)
110+                   #     $rtail, the rest of the function body
111+                   #     $edir,  the directives following the function
112+                   #             (everything starting with .endp)
113+                   # The return instruction and endp directive are stripped in the process.
114+                   if (!(($e, $rtail) = split(/^\tbr\.ret\.sptk\.many b0\n/, $e))) {
115+                       die "Epilogue doesn't seem to have one return instruction: $e\n";
116+                   }
117+                   if (!(($rtail, $edir) = split(/^\t\.endp [a-zA-Z0-9_#.]+\n/, $rtail))) {
118+                       die "Epilogue doesn't seem to have one endp directive: $e\n";
119+                   }
120+                   # print STDERR "Epilogue: $e\n";
121+                   # print STDERR "Code tail: $rtail\n";
122+                   # print STDERR "Directives: $edir\n";
123+
124+                   # If a return value is saved here, move it to the function body
125+                   if ($e =~ /^\tmov r8 = r14\n/) {
126+                       $e = $` . $';
127+                       $r = $r . $&;
128+                     }
129+
130+                   # Remove floating-point fill instructions.  This is actually a bad
131+                   # thing to remove, because we will be putting junk into the floating-point
132+                   # registers and this will be visible to the caller.
133+                   # Only fp registers 2-5 and 16-31 may be restored.
134+                   if ($e =~ s/^\tldf\.fill f([2-5]|1[6-9]|2[0-9]|30|31) = \[r1[4-9]\](, [0-9]+)?\n//g) {
135+                       # Being paranoid, only try to remove this if we saw a fill
136+                       # operation.
137+                       $e =~ s/^\tadds r1[4-9] = [0-9]+, r12//g;
138+                   }
139+
140+                   $e =~ s/^\tnop\.[mifb]\s+0\n//g; # remove nop instructions
141                    $e =~ s/^\tmov ar\.pfs = r\d+\n//;
142                    $e =~ s/^\tmov b0 = r\d+\n//;
143                    $e =~ s/^\t\.restore sp\n\tadds r12 = \d+, r12\n//;
144!                   #$e =~ s/^\tbr\.ret\.sptk\.many b0\n//; # already removed
145!                   $e =~ s/^\t\.(mii|mmi|mfi|mib)\n//g; # bundling is no longer sensible
146!                   $e =~ s/^\t;;\n//g;                 # discard stops - stop at end of body is sufficient
147                    $e =~ s/^\t\/\/.*\n//g;             # gcc inserts timings in // comments
148+
149+                   # Tack edir onto the end of rtail.  Some of the directives in edir are relevant to
150+                   # the next chunk.
151+                   $rtail .= $edir;
152                } elsif ($TargetPlatform =~ /^m68k-/) {
153                    $e =~ s/^\tunlk a6\n//;
154                    $e =~ s/^\trts\n//;
155***************
156*** 1061,1067 ****
157                print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/;
158 
159                # glue together what's left
160!               $c = $r . $e;
161                $c =~ s/\n\t\n/\n/; # junk blank line
162            }
163        }
164--- 1132,1138 ----
165                print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/;
166 
167                # glue together what's left
168!               $c = $r . $e . $rtail;
169                $c =~ s/\n\t\n/\n/; # junk blank line
170            }
171        }
172***************
173*** 1090,1100 ****
174 
175        # IA64: mangle tailcalls into jumps here
176        if ($TargetPlatform =~ /^ia64-/) {
177!           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/) {
178                # Eek, the gcc optimiser is getting smarter... if we see a jump to the --- TAILCALL ---
179                # marker then we reapply the substitution at the source sites
180                $c =~ s/^\tbr \.L$2\n/\t--- TAILCALL ---\n/g if ($2);
181            }
182        }
183 
184        # MIPS: that may leave some gratuitous asm macros around
185--- 1161,1189 ----
186 
187        # IA64: mangle tailcalls into jumps here
188        if ($TargetPlatform =~ /^ia64-/) {
189!           # Example of what is mangled:
190!           #   br.call.sptk.many b0 = b6
191!           #.L211
192!           #   ;;
193!           #   .mmi
194!           #   mov r1 = r32
195!           #   ;;
196!           #   nop.m 0
197!           #   nop.i 0
198!           #   ;;
199!           #   --- TAILCALL --
200!           #   ;;
201!           #.L123
202!           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/) {
203                # Eek, the gcc optimiser is getting smarter... if we see a jump to the --- TAILCALL ---
204                # marker then we reapply the substitution at the source sites
205                $c =~ s/^\tbr \.L$2\n/\t--- TAILCALL ---\n/g if ($2);
206            }
207+
208+           # Verify that all instances of TAILCALL were processed
209+           if ($c =~ /^\t--- TAILCALL ---\n/) {
210+             die "Unmangled TAILCALL tokens remain after mangling"
211+           }
212        }
213 
214        # MIPS: that may leave some gratuitous asm macros around