ghc-asm.lprl 65.7 KB
Newer Older
1
2
%************************************************************************
%*									*
3
\section[Driver-asm-fiddling]{Fiddling with assembler files}
4
5
6
7
8
9
10
11
12
13
14
15
%*									*
%************************************************************************

Tasks:
\begin{itemize}
\item
Utterly stomp out C functions' prologues and epilogues; i.e., the
stuff to do with the C stack.
\item
Any other required tidying up.
\end{itemize}

16
17
18
19
20
21
22
23
24
25
26
27
General note [chak]: Many regexps are very fragile because they rely on white
space being in the right place.  This caused trouble with gcc 2.95 (at least
on Linux), where the use of white space in .s files generated by gcc suddenly 
changed.  To guarantee compatibility across different versions of gcc, make
sure (at least on i386-.*-linux) that regexps tolerate varying amounts of white
space between an assembler statement and its arguments as well as after a the
comma separating multiple arguments.  

\emph{For the time being, I have corrected the regexps for i386-.*-linux.  I
didn't touch all the regexps for other i386 platforms, as I don't have
a box to test these changes.}

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
HPPA specific notes:
\begin{itemize}
\item
The HP linker is very picky about symbols being in the appropriate
space (code vs. data).  When we mangle the threaded code to put the
info tables just prior to the code, they wind up in code space
rather than data space.  This means that references to *_info from
un-mangled parts of the RTS (e.g. unthreaded GC code) get
unresolved symbols.  Solution:  mini-mangler for .c files on HP.  I
think this should really be triggered in the driver by a new -rts
option, so that user code doesn't get mangled inappropriately.
\item
With reversed tables, jumps are to the _info label rather than to
the _entry label.  The _info label is just an address in code
space, rather than an entry point with the descriptive blob we
talked about yesterday.  As a result, you can't use the call-style
JMP_ macro.  However, some JMP_ macros take _info labels as targets
and some take code entry points within the RTS.  The latter won't
work with the goto-style JMP_ macro.  Sigh.  Solution: Use the goto
style JMP_ macro, and mangle some more assembly, changing all
"RP'literal" and "LP'literal" references to "R'literal" and
"L'literal," so that you get the real address of the code, rather
than the descriptive blob.  Also change all ".word P%literal"
entries in info tables and vector tables to just ".word literal,"
for the same reason.  Advantage: No more ridiculous call sequences.
\end{itemize}

55
56
57
58
59
60
61
62
63
64
65
66
67
68
%************************************************************************
%*									*
\subsection{Top-level code}
%*									*
%************************************************************************

\begin{code}
$TargetPlatform = $TARGETPLATFORM;

($Pgm = $0) =~ s|.*/||;
$ifile = $ARGV[0];
$ofile = $ARGV[1];

if ( $TargetPlatform =~ /^i386-/ ) {
69
70
71
72
73
    if ($ARGV[2] eq '') {
	$StolenX86Regs = 4;
    } else {
        $StolenX86Regs = $ARGV[2];
    }
74
75
76
77
78
79
80
}

&mangle_asm($ifile,$ofile);

exit(0);
\end{code}

81
82
83
84
85
86
%************************************************************************
%*									*
\subsection{Constants for various architectures}
%*									*
%************************************************************************

87
88
89
\begin{code}
sub init_TARGET_STUFF {

90
91
92
93
94
95
    #--------------------------------------------------------#
    if ( $TargetPlatform =~ /^alpha-.*-.*/ ) {

    $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
ken's avatar
ken committed
96
    $T_CONST_LBL    = '^\$L?C(\d+):$'; # regexp for what such a lbl looks like
97
98
    $T_POST_LBL	    = ':';

ken's avatar
ken committed
99
100
    $T_MOVE_DIRVS   = '^(\s*(\$.*\.\.ng:|\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)';
    $T_COPY_DIRVS   = '^\s*(\$.*\.\.ng:|\#|\.(file|globl|ent|loc))';
101

ken's avatar
ken committed
102
    $T_DOT_WORD	    = '\.(long|quad|byte|word)';
rrt's avatar
rrt committed
103
    $T_DOT_GLOBAL   = '^\t\.globl';
104
105
106
    $T_HDR_literal  = "\.rdata\n\t\.align 3\n";
    $T_HDR_misc	    = "\.text\n\t\.align 3\n";
    $T_HDR_data	    = "\.data\n\t\.align 3\n";
107
    $T_HDR_rodata   = "\.rdata\n\t\.align 3\n";
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
    $T_HDR_closure  = "\.data\n\t\.align 3\n";
    $T_HDR_info	    = "\.text\n\t\.align 3\n";
    $T_HDR_entry    = "\.text\n\t\.align 3\n";
    $T_HDR_vector   = "\.text\n\t\.align 3\n";

    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^hppa/ ) {

    $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    = '^L\$C(\d+)$'; # regexp for what such a lbl looks like
    $T_POST_LBL	    = '';

    $T_MOVE_DIRVS   = '^((\s+\.(IMPORT|EXPORT|PARAM).*|\s+\.align\s+\d+|\s+\.(SPACE|SUBSPA)\s+\S+|\s*)\n)';
    $T_COPY_DIRVS   = '^\s+\.(IMPORT|EXPORT)';

125
    $T_DOT_WORD	    = '\.(blockz|word|half|byte)';
rrt's avatar
rrt committed
126
    $T_DOT_GLOBAL   = '^\s+\.EXPORT';
127
128
129
    $T_HDR_literal  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
    $T_HDR_misc	    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
    $T_HDR_data	    = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
130
    $T_HDR_rodata   = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
131
132
133
134
135
136
    $T_HDR_closure  = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
    $T_HDR_info	    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
    $T_HDR_entry    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
    $T_HDR_vector   = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";

    #--------------------------------------------------------#
dons's avatar
dons committed
137
    } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd2|nextstep3|cygwin32|mingw32)$/ ) {
sof's avatar
sof committed
138
				# NeXT added but not tested. CaS
139
140
141
142
143
144

    $T_STABBY	    = 1; # 1 iff .stab things (usually if a.out format)
    $T_US	    = '_'; # _ if symbols have an underscore on the front
    $T_PRE_APP	    = '^#'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^LC(\d+):$';
    $T_POST_LBL	    = ':';
145
146
    $T_X86_PRE_LLBL_PAT = 'L';
    $T_X86_PRE_LLBL	    = 'L';
147
148
    $T_X86_BADJMP   = '^\tjmp [^L\*]';

149
    $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s.*|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*|\.lcomm.*)\n)';
150
    $T_COPY_DIRVS   = '\.(globl|stab|lcomm)';
151
    $T_DOT_WORD	    = '\.(long|word|value|byte|space)';
152
    $T_DOT_GLOBAL   = '\.globl';
rrt's avatar
rrt committed
153
    $T_HDR_literal  = "\.text\n\t\.align 2\n";
154
    $T_HDR_misc	    = "\.text\n\t\.align 2,0x90\n";
rrt's avatar
rrt committed
155
    $T_HDR_data	    = "\.data\n\t\.align 2\n";
156
    $T_HDR_rodata   = "\.text\n\t\.align 2\n";
rrt's avatar
rrt committed
157
    $T_HDR_closure  = "\.data\n\t\.align 2\n";
158
    $T_HDR_info	    = "\.text\n\t\.align 2\n"; # NB: requires padding
159
    $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
160
    $T_HDR_vector   = "\.text\n\t\.align 2\n"; # NB: requires padding
161

162
    #--------------------------------------------------------#
163
    } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux|gnu|freebsd|netbsd|openbsd|kfreebsdgnu)$/ ) {
164
165
166

    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
    $T_US	    = ''; # _ if symbols have an underscore on the front
rrt's avatar
rrt committed
167
    $T_PRE_APP	    = # regexp that says what comes before APP/NO_APP
168
		      ($TargetPlatform =~ /-(linux|gnu|freebsd|netbsd|openbsd)$/) ? '#' : '/' ;
169
    $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
170
    $T_POST_LBL	    = ':';
171
172
    $T_X86_PRE_LLBL_PAT = '\.L';
    $T_X86_PRE_LLBL	    = '.L';
173
    $T_X86_BADJMP   = '^\tjmp\s+[^\.\*]';
174

175
    $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s.*|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
176
    $T_COPY_DIRVS   = '^\s*\.(globl|type|size|local)';
177

178
    $T_DOT_WORD	    = '\.(long|value|word|byte|zero)';
179
180
    $T_DOT_GLOBAL   = '\.globl';
    $T_HDR_literal  = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
181
    $T_HDR_misc	    = "\.text\n\t\.align 4\n";
182
183
184
185
    $T_HDR_data	    = "\.data\n\t\.align 4\n";
    $T_HDR_rodata   = "\.section\t\.rodata\n\t\.align 4\n";
    $T_HDR_closure  = "\.data\n\t\.align 4\n";
    $T_HDR_info	    = "\.text\n\t\.align 4\n";
186
    $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
187
    $T_HDR_vector   = "\.text\n\t\.align 4\n"; # NB: requires padding
188

189
190
191
192
193
194
195
196
197
    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^ia64-.*-linux$/ ) {

    $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      = '#';
    $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
    $T_POST_LBL     = ':';

198
    $T_MOVE_DIRVS   = '^(\s*\.(global|proc|pred\.safe_across_calls|text|data|section|subsection|align|size|type|ident)\s+.*\n)';
199
200
201
202
203
204
205
    $T_COPY_DIRVS   = '\.(global|proc)';

    $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_data     = "\.data\n\t\.align 8\n";
206
    $T_HDR_rodata   = "\.section\t\.rodata\n\t\.align 8\n";
207
208
209
210
211
    $T_HDR_closure  = "\.data\n\t\.align 8\n";
    $T_HDR_info     = "\.text\n\t\.align 8\n";
    $T_HDR_entry    = "\.text\n\t\.align 16\n";
    $T_HDR_vector   = "\.text\n\t\.align 8\n";

212
    #--------------------------------------------------------#
dons's avatar
dons committed
213
    } elsif ( $TargetPlatform =~ /^x86_64-.*-(linux|openbsd)$/ ) {
214
215
216
217
218
219
220
221

    $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      = '#';
    $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
    $T_POST_LBL     = ':';

    $T_MOVE_DIRVS   = '^(\s*\.(globl|text|data|section|align|size|type|ident|local)\s+.*\n)';
222
    $T_COPY_DIRVS   = '\.(globl|type|size|local)';
223
224
225

    $T_DOT_WORD     = '\.(quad|long|value|byte|zero)';
    $T_DOT_GLOBAL   = '\.global';
226
227

    $T_HDR_literal16 = "\.section\t\.rodata.cst16\n\t.align 16\n";
228
    $T_HDR_literal  = "\.section\t\.rodata\n";
229

230
231
    $T_HDR_misc     = "\.text\n\t\.align 8\n";
    $T_HDR_data     = "\.data\n\t\.align 8\n";
232
    $T_HDR_rodata   = "\.section\t\.rodata\n\t\.align 8\n";
233
234
235
236
237
238
239
240

	# the assembler on x86_64/Linux refuses to generate code for
	#   .quad  x - y
	# where x is in the text section and y in the rodata section.
	# It works if y is in the text section, though.  This is probably
	# going to cause difficulties for PIC, I imagine.
    $T_HDR_relrodata= "\.text\n\t\.align 8\n";

241
242
243
244
245
    $T_HDR_closure  = "\.data\n\t\.align 8\n";
    $T_HDR_info     = "\.text\n\t\.align 8\n";
    $T_HDR_entry    = "\.text\n\t\.align 8\n";
    $T_HDR_vector   = "\.text\n\t\.align 8\n";

246
247
248
249
250
251
252
253
254
    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^m68k-.*-sunos4/ ) {

    $T_STABBY	    = 1; # 1 iff .stab things (usually if a.out format)
    $T_US	    = '_'; # _ if symbols have an underscore on the front
    $T_PRE_APP	    = '^# MAY NOT APPLY'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^LC(\d+):$';
    $T_POST_LBL	    = ':';

rrt's avatar
rrt committed
255
    $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
256
257
258
259
260
261
262
    $T_COPY_DIRVS   = '\.(globl|proc|stab)';

    $T_DOT_WORD	    = '\.long';
    $T_DOT_GLOBAL   = '\.globl';
    $T_HDR_literal  = "\.text\n\t\.even\n";
    $T_HDR_misc	    = "\.text\n\t\.even\n";
    $T_HDR_data	    = "\.data\n\t\.even\n";
263
    $T_HDR_rodata   = "\.text\n\t\.even\n";
264
265
266
267
268
269
270
271
272
273
274
275
276
277
    $T_HDR_closure  = "\.data\n\t\.even\n";
    $T_HDR_info	    = "\.text\n\t\.even\n";
    $T_HDR_entry    = "\.text\n\t\.even\n";
    $T_HDR_vector   = "\.text\n\t\.even\n";

    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^mips-.*/ ) {

    $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	    = '^\s*#'; # 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	    = ':';

rrt's avatar
rrt committed
278
    $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
279
280
281
    $T_COPY_DIRVS   = '\.(globl|ent)';

    $T_DOT_WORD	    = '\.word';
rrt's avatar
rrt committed
282
    $T_DOT_GLOBAL   = '^\t\.globl';
283
284
285
    $T_HDR_literal  = "\t\.rdata\n\t\.align 2\n";
    $T_HDR_misc	    = "\t\.text\n\t\.align 2\n";
    $T_HDR_data	    = "\t\.data\n\t\.align 2\n";
286
    $T_HDR_rodata   = "\t\.rdata\n\t\.align 2\n";
287
288
289
290
291
292
    $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";

    #--------------------------------------------------------#
293
    } elsif ( $TargetPlatform =~ /^powerpc-apple-darwin.*/ ) {
294
				# Apple PowerPC Darwin/MacOS X.
295
    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
296
    $T_US	    = '_'; # _ if symbols have an underscore on the front
297
    $T_PRE_APP	    = 'DOESNT APPLY'; # regexp that says what comes before APP/NO_APP
298
    $T_CONST_LBL    = '^\LC\d+:'; # regexp for what such a lbl looks like
299
300
    $T_POST_LBL	    = ':';

301
302
    $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)';
303

304
    $T_DOT_WORD	    = '\.(long|short|byte|fill|space)';
305
    $T_DOT_GLOBAL   = '\.globl';
sof's avatar
sof committed
306
    $T_HDR_toc      = "\.toc\n";
307
    $T_HDR_literal  = "\t\.const\n\t\.align 2\n";
308
309
    $T_HDR_misc	    = "\t\.text\n\t\.align 2\n";
    $T_HDR_data	    = "\t\.data\n\t\.align 2\n";
310
311
312
    $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";
313
314
315
    $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";
316

317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^i386-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_X86_PRE_LLBL_PAT = 'L';
    $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_COPY_DIRVS   = '\.(globl|lcomm)';

    $T_DOT_WORD	    = '\.(long|short|byte|fill|space)';
    $T_DOT_GLOBAL   = '\.globl';
    $T_HDR_toc      = "\.toc\n";
335
336
    $T_HDR_literal16= "\t\.literal8\n\t\.align 4\n";
    $T_HDR_literal  = "\t\.const\n\t\.align 4\n";
337
338
339
340
341
342
343
344
345
    $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";

346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^powerpc-.*-linux/ ) {
				# PowerPC Linux
    $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	    = '^#'; # 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*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
    $T_COPY_DIRVS   = '^\s*\.(globl|type|size|local)';

    $T_DOT_WORD	    = '\.(long|short|byte|fill|space)';
    $T_DOT_GLOBAL   = '\.globl';
    $T_HDR_toc      = "\.toc\n";
    $T_HDR_literal  = "\t\.section\t.rodata\n\t\.align 2\n";
    $T_HDR_misc	    = "\t\.text\n\t\.align 2\n";
    $T_HDR_data	    = "\t\.data\n\t\.align 2\n";
364
    $T_HDR_rodata   = "\t\.section\t.rodata\n\t\.align 2\n";
365
366
367
368
369
    $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";

370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^powerpc64-.*-linux/ ) {
				# PowerPC 64 Linux
    $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	    = '^#'; # 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*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
    $T_COPY_DIRVS   = '^\s*\.(globl|type|size|local)';

    $T_DOT_WORD	    = '\.(long|short|byte|fill|space)';
    $T_DOT_GLOBAL   = '\.globl';
    $T_HDR_toc      = "\.toc\n";
    $T_HDR_literal  = "\t\.section\t\".toc\",\"aw\"\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\.section\t.rodata\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";

394
    #--------------------------------------------------------#
dons's avatar
dons committed
395
    } elsif ( $TargetPlatform =~ /^sparc-.*-(solaris2|openbsd)/ ) {
396
397
398
399
400
401
402

    $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	    = 'DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
    $T_POST_LBL	    = ':';

403
404
    $T_MOVE_DIRVS   =  '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\s+\.local\s+\S+|\.text|\.data|\.stab.*|\s*\.section.*|\s+\.type.*|\s+\.size.*)\n)';
    $T_COPY_DIRVS   = '\.(global|local|proc|stab)';
405

406
    $T_DOT_WORD	    = '\.(long|word|byte|half|skip|uahalf|uaword)';
rrt's avatar
rrt committed
407
    $T_DOT_GLOBAL   = '^\t\.global';
408
409
410
    $T_HDR_literal  = "\.text\n\t\.align 8\n";
    $T_HDR_misc	    = "\.text\n\t\.align 4\n";
    $T_HDR_data	    = "\.data\n\t\.align 8\n";
411
    $T_HDR_rodata   = "\.text\n\t\.align 4\n";
412
    $T_HDR_closure  = "\.data\n\t\.align 4\n";
413
    $T_HDR_info     = "\.text\n\t\.align 4\n";
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
    $T_HDR_entry    = "\.text\n\t\.align 4\n";
    $T_HDR_vector   = "\.text\n\t\.align 4\n";

    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^sparc-.*-sunos4/ ) {

    $T_STABBY	    = 1; # 1 iff .stab things (usually if a.out format)
    $T_US	    = '_'; # _ if symbols have an underscore on the front
    $T_PRE_APP	    = '^# DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^LC(\d+):$';
    $T_POST_LBL	    = ':';

    $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*)\n)';
    $T_COPY_DIRVS   = '\.(global|proc|stab)';

    $T_DOT_WORD	    = '\.word';
    $T_DOT_GLOBAL   = '^\t\.global';
    $T_HDR_literal  = "\.text\n\t\.align 8\n";
    $T_HDR_misc	    = "\.text\n\t\.align 4\n";
    $T_HDR_data	    = "\.data\n\t\.align 8\n";
434
    $T_HDR_rodata   = "\.text\n\t\.align 4\n";
435
436
437
438
439
    $T_HDR_closure  = "\.data\n\t\.align 4\n";
    $T_HDR_info	    = "\.text\n\t\.align 4\n";
    $T_HDR_entry    = "\.text\n\t\.align 4\n";
    $T_HDR_vector   = "\.text\n\t\.align 4\n";

440
441
442
443
444
445
446
447
448
    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^sparc-.*-linux/ ) {
    $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      = '#'; # regexp that says what comes before APP/NO_APP
                           # Probably doesn't apply anyway
    $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
    $T_POST_LBL     = ':';

449
    $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)';
450
451
452
453
454
455
456
    $T_COPY_DIRVS   = '\.(global|globl|proc|stab)';

    $T_DOT_WORD     = '\.(long|word|nword|xword|byte|half|short|skip|uahalf|uaword)';
    $T_DOT_GLOBAL   = '^\t\.global';
    $T_HDR_literal  = "\.text\n\t\.align 8\n";
    $T_HDR_misc     = "\.text\n\t\.align 4\n";
    $T_HDR_data     = "\.data\n\t\.align 8\n";
457
    $T_HDR_rodata   = "\.text\n\t\.align 4\n";
458
459
460
461
462
    $T_HDR_closure  = "\.data\n\t\.align 4\n";
    $T_HDR_info     = "\.text\n\t\.align 4\n";
    $T_HDR_entry    = "\.text\n\t\.align 4\n";
    $T_HDR_vector   = "\.text\n\t\.align 4\n";

463
464
465
466
    #--------------------------------------------------------#
    } else {
	print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n";
	exit 1;
467
468
    }

469
470
471
472
473
474
    if($T_HDR_relrodata eq "") {
            # default values:
            # relrodata defaults to rodata.
        $T_HDR_relrodata = $T_HDR_rodata;
    }

475
476
477
478
479
480
if ( 0 ) {
print STDERR "T_STABBY: $T_STABBY\n";
print STDERR "T_US: $T_US\n";
print STDERR "T_PRE_APP: $T_PRE_APP\n";
print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
print STDERR "T_POST_LBL: $T_POST_LBL\n";
481
482
483
484
485
if ( $TargetPlatform =~ /^i386-/ ) {
    print STDERR "T_X86_PRE_LLBL_PAT: $T_X86_PRE_LLBL_PAT\n";
    print STDERR "T_X86_PRE_LLBL: $T_X86_PRE_LLBL\n";
    print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
}
486
487
488
print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
489
print STDERR "T_HDR_literal: $T_HDR_literal\n";
490
491
print STDERR "T_HDR_misc: $T_HDR_misc\n";
print STDERR "T_HDR_data: $T_HDR_data\n";
492
print STDERR "T_HDR_rodata: $T_HDR_rodata\n";
493
494
495
496
497
498
499
500
501
print STDERR "T_HDR_closure: $T_HDR_closure\n";
print STDERR "T_HDR_info: $T_HDR_info\n";
print STDERR "T_HDR_entry: $T_HDR_entry\n";
print STDERR "T_HDR_vector: $T_HDR_vector\n";
}

}
\end{code}

502
503
504
505
506
507
%************************************************************************
%*									*
\subsection{Mangle away}
%*									*
%************************************************************************

508
509
510
511
512
513
514
\begin{code}
sub mangle_asm {
    local($in_asmf, $out_asmf) = @_;

    # multi-line regexp matching:
    local($*) = 1;
    local($i, $c);
sof's avatar
sof committed
515
516


517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
    &init_TARGET_STUFF();
    &init_FUNNY_THINGS();

    open(INASM, "< $in_asmf")
	|| &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
    open(OUTASM,"> $out_asmf")
	|| &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");

    # read whole file, divide into "chunks":
    #	record some info about what we've found...

    @chk = ();		# contents of the chunk
    $numchks = 0;	# number of them
    @chkcat = ();	# what category of thing in each chunk
    @chksymb = ();	# what symbol(base) is defined in this chunk
532
    %entrychk = ();	# ditto, its entry code
533
    %closurechk = ();	# ditto, the (static) closure
534
    %srtchk = ();	# ditto, its SRT (for top-level things)
535
536
    %infochk = (); 	# given a symbol base, say what chunk its info tbl is in
    %vectorchk = ();    # ditto, return vector table
537
    $EXTERN_DECLS = '';	# .globl <foo> .text (MIPS only)
538

539
    $i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
540
541

    while (<INASM>) {
rrt's avatar
rrt committed
542
	tr/\r//d if $TargetPlatform =~ /-mingw32$/; # In case Perl doesn't convert line endings
543
	next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
544
	next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
545
	next if /^\t\.def.*endef$/;
546
	next if /${T_PRE_APP}(NO_)?APP/o; 
547
548
    	next if /^;/ && $TargetPlatform =~ /^hppa/;

549
	next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|ia64)-/;
550
551

	if ( $TargetPlatform =~ /^mips-/ 
ken's avatar
ken committed
552
	  && /^\t\.(globl\S+\.text|comm\t)/ ) {
553
	    $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
554
555
556
557
558
559
560
561
562
563
564
	# Treat .comm variables as data.  These show up in two (known) places:
	#
	#    - the module_registered variable used in the __stginit fragment.
	#      even though these are declared static and initialised, gcc 3.3
	#      likes to make them .comm, presumably to save space in the
	#      object file.
	#
	#    - global variables used to pass arguments from C to STG in
	#      a foreign export.  (is this still true? --SDM)
	# 
	} elsif ( /^\t\.comm.*$/ ) {
sof's avatar
sof committed
565
566
567
568
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

569
570
	# Labels ending "_str": these are literal strings.
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_str${T_POST_LBL}$/ ) {
571
572
573
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'rodata';
	    $chksymb[$i] = '';
574
575
        } elsif ( $TargetPlatform =~ /-darwin/
                && (/^\s*\.subsections_via_symbols/
576
                  ||/^\s*\.no_dead_strip.*/)) {
577
578
579
580
581
            # Don't allow Apple's linker to do any dead-stripping of symbols
            # in this file, because it will mess up info-tables in mangled
            # code.
            # The .no_dead_strip directives are actually put there by
            # the gcc3 "used" attribute on entry points.
582
        
583
        } elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && ( 
584
		   /^\s*\.picsymbol_stub/
585
586
		|| /^\s*\.section __TEXT,__picsymbol_stub\d,.*/
		|| /^\s*\.section __TEXT,__picsymbolstub\d,.*/
587
		|| /^\s*\.symbol_stub/
588
589
		|| /^\s*\.section __TEXT,__symbol_stub\d,.*/
		|| /^\s*\.section __TEXT,__symbolstub\d,.*/
590
591
592
593
594
595
596
		|| /^\s*\.lazy_symbol_pointer/
		|| /^\s*\.non_lazy_symbol_pointer/ ))
	{
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'dyld';
	    $chksymb[$i] = '';

597
	} elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && $chkcat[$i] eq 'dyld' && /^\s*\.data/)
598
599
600
601
602
	{	# non_lazy_symbol_ptrs that point to local symbols
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'dyld';
	    $chksymb[$i] = '';

603
	} elsif ( /^\s+/ ) { # most common case first -- a simple line!
604
605
606
607
	    # duplicated from the bottom

	    $chk[$i] .= $_;

608
609
610
611
612
613
614
615
616
	} elsif ( /\.\.ng:$/ && $TargetPlatform =~ /^alpha-/ ) {
	    # Alphas: Local labels not to be confused with new chunks
	    $chk[$i] .= $_;
	# NB: all the rest start with a non-space

	} elsif ( $TargetPlatform =~ /^mips-/
	       && /^\d+:/ ) { # a funny-looking very-local label
	    $chk[$i] .= $_;

617
	} elsif ( /$T_CONST_LBL/o ) {
618
619
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'literal';
620
621
	    $chksymb[$i] = $1;

622
	} elsif ( /^${T_US}__stg_split_marker(\d*)${T_POST_LBL}$/o ) {
623
624
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'splitmarker';
625
626
	    $chksymb[$i] = $1;

627
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/o ) {
628
	    $symb = $1;
629
630
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'infotbl';
631
632
633
634
635
636
	    $chksymb[$i] = $symb;

	    die "Info table already? $symb; $i\n" if defined($infochk{$symb});

	    $infochk{$symb} = $i;

637
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_(entry|ret)${T_POST_LBL}$/o ) {
638
	    $chk[++$i]   = $_;
639
	    $chkcat[$i]  = 'entry';
640
641
	    $chksymb[$i] = $1;

642
	    $entrychk{$1} = $i;
643

644
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/o ) {
645
646
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'closure';
647
648
649
650
	    $chksymb[$i] = $1;

	    $closurechk{$1} = $i;

651
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_srt${T_POST_LBL}$/o ) {
652
653
654
655
656
657
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'srt';
	    $chksymb[$i] = $1;

	    $srtchk{$1} = $i;

658
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_ct${T_POST_LBL}$/o ) {
659
660
661
662
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

663
664
665
666
667
	} elsif ( /^${T_US}(stg_ap_stack_entries|stg_stack_save_entries|stg_arg_bitmaps)${T_POST_LBL}$/o ) {
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

668
	} elsif ( /^(${T_US}__gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/o ) {
669
670
	    ; # toss it

671
672
673
674
	} elsif ( /^${T_US}[A-Za-z0-9_]+\.\d+${T_POST_LBL}$/o
	       || /^${T_US}.*_CAT${T_POST_LBL}$/o 		# PROF: _entryname_CAT
	       || /^${T_US}.*_done${T_POST_LBL}$/o		# PROF: _module_done
	       || /^${T_US}_module_registered${T_POST_LBL}$/o	# PROF: _module_registered
675
	       ) {
676
677
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
678
679
	    $chksymb[$i] = '';

680
681
682
	} elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) {
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'bss';
sof's avatar
sof committed
683
684
  	    $chksymb[$i] = '';

685
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_cc(s)?${T_POST_LBL}$/o ) {
sof's avatar
sof committed
686
687
688
689
690
            # all CC_ symbols go in the data section...
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

691
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_(alt|dflt)${T_POST_LBL}$/o ) {
692
693
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'misc';
694
	    $chksymb[$i] = '';
695
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_vtbl${T_POST_LBL}$/o ) {
696
697
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'vector';
698
699
700
701
702
	    $chksymb[$i] = $1;

	    $vectorchk{$1} = $i;

	} elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
chak's avatar
chak committed
703
704
705
706
707
708
709
710
	     &&   /^[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
711
	    $chk[++$i]   = $_;
chak's avatar
chak committed
712
	    $chkcat[$i]  = 'misc';
713
714
	    $chksymb[$i] = $1;

715
716
717
718
719
720
721
722
723
        } elsif ( $TargetPlatform =~ /^i386-apple-darwin/ && /^(___i686\.get_pc_thunk\.[abcd]x):/o) {
                # To handle PIC on Darwin/x86, we need to appropriately pass through
                # the get_pc_thunk functions. The need to be put into a special section
                # marked as coalesced (otherwise the .weak_definition doesn't work
                # on Darwin).
            $chk[++$i]   = $_;
            $chkcat[$i]  = 'get_pc_thunk';
            $chksymb[$i] = $1;

724
	} elsif ( /^${T_US}[A-Za-z0-9_]/o
725
		&& ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
726
727
728
		   || ! /^L\$\d+$/ ) 
		&& ( $TargetPlatform !~ /^powerpc64/ # we need to avoid local labels in this case
		   || ! /^\.L\d+:$/ ) ) {
729
730
	    local($thing);
	    chop($thing = $_);
731
	    $thing =~ s/:$//;
732
733
734
	    $chk[++$i]   = $_;
	    $chksymb[$i] = '';
	    if (
735
		       /^${T_US}stg_.*${T_POST_LBL}$/o          # RTS internals
sof's avatar
sof committed
736
		    || /^${T_US}__stg_.*${T_POST_LBL}$/o        # more RTS internals
737
		    || /^${T_US}__fexp_.*${T_POST_LBL}$/o       # foreign export
738
		    || /^${T_US}.*_slow${T_POST_LBL}$/o         # slow entry
ken's avatar
ken committed
739
		    || /^${T_US}__stginit.*${T_POST_LBL}$/o     # __stginit<module>
740
		    || /^${T_US}.*_btm${T_POST_LBL}$/o          # large bitmaps
741
		    || /^${T_US}.*_fast${T_POST_LBL}$/o         # primops
742
                    || /^_uname:/o			        # x86/Solaris2
743
744
745
746
747
748
749
750
		)
            {
	    	$chkcat[$i]  = 'misc';
            } elsif (
		       /^${T_US}.*_srtd${T_POST_LBL}$/o          # large bitmaps
		    || /^${T_US}.*_closure_tbl${T_POST_LBL}$/o  # closure tables
                )
            {
751
                $chkcat[$i] = 'relrodata';
752
753
754
755
756
            } else
            {
	        print STDERR "Warning: retaining unknown function \`$thing' in output from C compiler\n";
	    	$chkcat[$i]  = 'unknown';
	    }
757

758
759
760
761
762
763
764
765
766
767
	} elsif ( $TargetPlatform =~ /^powerpc-.*-linux/ && /^\.LCTOC1 = /o ) {
		# PowerPC Linux's large-model PIC (-fPIC) generates a gobal offset
		# table "by hand". Be sure to copy it over.
		# Note that this label and all entries in the table should actually
		# go into the .got2 section, but it isn't easy to distinguish them
		# from other constant literals (.LC\d+), so we just put everything
		# in .rodata.
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'literal';
	    $chksymb[$i] = 'LCTOC1';
768
769
770
771
772
773
774
	} else { # simple line (duplicated at the top)

	    $chk[$i] .= $_;
	}
    }
    $numchks = $#chk + 1;

775
776
777
    # 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;
ken's avatar
ken committed
778

779
780
781
782
783
784
785
786
    # the division into chunks is imperfect;
    # we throw some things over the fence into the next
    # chunk.
    #
    # also, there are things we would like to know
    # about the whole module before we start spitting
    # output.

sof's avatar
sof committed
787
    local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
ken's avatar
ken committed
788
    local($FIRST_TOSSABLE ) = ($TargetPlatform =~ /^(hppa|mips-)/) ? 1 : 0;
789
790
791
792
793

#   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
ken's avatar
ken committed
794
    # spits a ".quad 0" in after the very first ".rdata"; we
795
796
797
798
799
    # detect this special case (tossing the ".quad 0")!
    local($magic_rdata_seen) = 0;
  
    # HPPAs, MIPSen: also start medding at chunk 1

ken's avatar
ken committed
800
    for ($i = $FIRST_TOSSABLE; $i < $numchks; $i++) {
801
802
803
804
	$c = $chk[$i]; # convenience copy

#	print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;

805
806
	# toss all prologue stuff; HPPA is pretty weird
	# (see elsewhere)
807
808
	$c = &hppa_mash_prologue($c) if $TargetPlatform =~ /^hppa-/;

809
810
811
812
	# be slightly paranoid to make sure there's
	# nothing surprising in there
	if ( $c =~ /--- BEGIN ---/ ) {
	    if (($p, $r) = split(/--- BEGIN ---/, $c)) {
813

814
815
816
817
		# remove junk whitespace around the split point
		$p =~ s/\t+$//;
		$r =~ s/^\s*\n//;

818
		if ($TargetPlatform =~ /^i386-/) {
819
820
821
822
823
824
		    if ($p =~ /^\tsubl\s+\$(\d+),\s*\%esp\n/) {
			if ($1 >= 8192) {
			    die "Error: reserved stack space exceeded!\n  Possible workarounds: compile with -fasm, or try another version of gcc.\n"
			}
		    }

825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
		# gcc 3.4.3 puts this kind of stuff in the prologue, eg.
		# when compiling PrimOps.cmm with -optc-O2:
		#        xorl    %ecx, %ecx
		#        xorl    %edx, %edx
		#        movl    %ecx, 16(%esp)
		#        movl    %edx, 20(%esp)
		# but then the code of the function doesn't assume
		# anything about the contnets of these stack locations.
		# I think it's to do with the use of inline functions for
		# PK_Word64() and friends, where gcc is initialising the
		# contents of the struct to zero, and failing to optimise
		# away the initialisation.  Let's live dangerously and
		# discard these initalisations.

		    $p =~ s/^\tpushl\s+\%e(di|si|bx)\n//g;
		    $p =~ s/^\txorl\s+\%e(ax|cx|dx),\s*\%e(ax|cx|dx)\n//g;
		    $p =~ s/^\tmovl\s+\%e(ax|cx|dx|si|di),\s*\d*\(\%esp\)\n//g;
		    $p =~ s/^\tmovl\s+\$\d+,\s*\d*\(\%esp\)\n//g;
843
		    $p =~ s/^\tsubl\s+\$\d+,\s*\%esp\n//;
844
                    $p =~ s/^\tmovl\s+\$\d+,\s*\%eax\n\tcall\s+__alloca\n// if ($TargetPlatform =~ /^.*-(cygwin32|mingw32)/);
845

846
847
848
849
850
851
852
853
854
855
856
857
858
859
                    if ($TargetPlatform =~ /^i386-apple-darwin/) {
                        $pcrel_label = $p;
                        $pcrel_label =~ s/(.|\n)*^(\"?L\d+\$pb\"?):\n(.|\n)*/$2/ or $pcrel_label = "";
                        $pcrel_reg = $p;
                        $pcrel_reg =~ s/(.|\n)*.*___i686\.get_pc_thunk\.([abcd]x)\n(.|\n)*/$2/ or $pcrel_reg = "";
                        $p =~ s/^\s+call\s+___i686\.get_pc_thunk\..x//;
                        $p =~ s/^\"?L\d+\$pb\"?:\n//;

                        if ($pcrel_reg eq "bx") {
                            # Bad gcc. Goes and uses %ebx, our BaseReg, for PIC. Bad gcc.
                            die "Darwin/x86: -fPIC -via-C doesn't work yet, use -fasm. Aborting."
                        }
                    }

860
861
862
863
864
		} elsif ($TargetPlatform =~ /^x86_64-/) {
		    $p =~ s/^\tpushq\s+\%r(bx|bp|12|13|14)\n//g;
		    $p =~ s/^\tmovq\s+\%r(bx|bp|12|13|14),\s*\d*\(\%rsp\)\n//g;
		    $p =~ s/^\tsubq\s+\$\d+,\s*\%rsp\n//;

865
866
		} elsif ($TargetPlatform =~ /^ia64-/) {
		    $p =~ s/^\t\.prologue .*\n//;
867
		    $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, 3[12], \d+, 0\n//;
868
869
		    $p =~ s/^\t\.fframe \d+\n\tadds r12 = -\d+, r12\n//;
		    $p =~ s/^\t\.save rp, r\d+\n\tmov r\d+ = b0\n//;
870
		    $p =~ s/^\t\.(mii|mmi)\n//g;	# bundling is no longer sensible
871
872
		    $p =~ s/^\t;;\n//g;		# discard stops
		    $p =~ s/^\t\/\/.*\n//g;	# gcc inserts timings in // comments
873
874
875
876
877
878

		    # GCC 3.3 saves r1 in the prologue, move this to the body
		    if ($p =~ /^\tmov r\d+ = r1\n/) {
			  $p = $` . $';
			  $r = $& . $r;
		    }
879
880
		} elsif ($TargetPlatform =~ /^m68k-/) {
		    $p =~ s/^\tlink a6,#-?\d.*\n//;
sof's avatar
sof committed
881
882
883
884
885
 		    $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;    
 				# The above showed up in the asm code,
 				# so I added it here.
 				# I hope it's correct.
 				# CaS
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
		    $p =~ s/^\tmovel d2,sp\@-\n//;
		    $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
		    $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
		} elsif ($TargetPlatform =~ /^mips-/) {
		    # the .frame/.mask/.fmask that we use is the same
		    # as that produced by GCC for miniInterpret; this
		    # gives GDB some chance of figuring out what happened
		    $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
		    $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
		    $p =~ s/^\t\.(mask|fmask).*\n//g;
		    $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
		    $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
		    $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
		    $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
		    $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
		    $p =~ s/__FRAME__/$FRAME/;
902
		} elsif ($TargetPlatform =~ /^powerpc-apple-darwin.*/) {
903
		    $pcrel_label = $p;
904
		    $pcrel_label =~ s/(.|\n)*^(\"?L\d+\$pb\"?):\n(.|\n)*/$2/ or $pcrel_label = "";
905
906

		    $p =~ s/^\tmflr r0\n//;
907
 		    $p =~ s/^\tbl saveFP # f\d+\n//;
908
 		    $p =~ s/^\tbl saveFP ; save f\d+-f\d+\n//;
909
		    $p =~ s/^\"?L\d+\$pb\"?:\n//;
910
911
912
913
914
 		    $p =~ s/^\tstmw r\d+,-\d+\(r1\)\n//;
   		    $p =~ s/^\tstfd f\d+,-\d+\(r1\)\n//g;
 		    $p =~ s/^\tstw r0,\d+\(r1\)\n//g;
  		    $p =~ s/^\tstwu r1,-\d+\(r1\)\n//; 
  		    $p =~ s/^\tstw r\d+,-\d+\(r1\)\n//g; 
915
916
917
  		    $p =~ s/^\tbcl 20,31,L\d+\$pb\n//;
  		    $p =~ s/^L\d+\$pb:\n//;
  		    $p =~ s/^\tmflr r31\n//;
918
919
920
921
922
923

		    # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
		    # under some circumstances, only when generating position dependent code.
		    # I have no idea why, and I don't think it is necessary, so let's toss it.
		    $p =~ s/^\tli r\d+,0\n//g;
		    $p =~ s/^\tstw r\d+,\d+\(r1\)\n//g;
924
925
926
927
928
929
930
		} elsif ($TargetPlatform =~ /^powerpc-.*-linux/) {
		    $p =~ s/^\tmflr 0\n//;
		    $p =~ s/^\tstmw \d+,\d+\(1\)\n//;
   		    $p =~ s/^\tstfd \d+,\d+\(1\)\n//g;
 		    $p =~ s/^\tstw r0,8\(1\)\n//;
  		    $p =~ s/^\tstwu 1,-\d+\(1\)\n//; 
  		    $p =~ s/^\tstw \d+,\d+\(1\)\n//g; 
931
932
933
934
935
936
937
938
939
940
                    
                        # GCC's "large-model" PIC (-fPIC)
		    $pcrel_label = $p;
		    $pcrel_label =~ s/(.|\n)*^.LCF(\d+):\n(.|\n)*/$2/ or $pcrel_label = "";

                    $p =~ s/^\tbcl 20,31,.LCF\d+\n//;
                    $p =~ s/^.LCF\d+:\n//;
                    $p =~ s/^\tmflr 30\n//;
                    $p =~ s/^\tlwz 0,\.LCL\d+-\.LCF\d+\(30\)\n//;
                    $p =~ s/^\tadd 30,0,30\n//;
941
942
943
944
945
946

		    # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
		    # under some circumstances, only when generating position dependent code.
		    # I have no idea why, and I don't think it is necessary, so let's toss it.
		    $p =~ s/^\tli \d+,0\n//g;
		    $p =~ s/^\tstw \d+,\d+\(1\)\n//g;
947
948
949
950
951
952
953
954
955
956
957
958
959
960
		} elsif ($TargetPlatform =~ /^powerpc64-.*-linux/) {
		    $p =~ s/^\tmr 31,1\n//;
		    $p =~ s/^\tmflr 0\n//;
		    $p =~ s/^\tstmw \d+,\d+\(1\)\n//;
   		    $p =~ s/^\tstfd \d+,-?\d+\(1\)\n//g;
 		    $p =~ s/^\tstd r0,8\(1\)\n//;
  		    $p =~ s/^\tstdu 1,-\d+\(1\)\n//; 
  		    $p =~ s/^\tstd \d+,-?\d+\(1\)\n//g; 
                    
		    # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
		    # under some circumstances, only when generating position dependent code.
		    # I have no idea why, and I don't think it is necessary, so let's toss it.
		    $p =~ s/^\tli \d+,0\n//g;
		    $p =~ s/^\tstd \d+,\d+\(1\)\n//g;
961
962
963
		} else {
		    print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
		}
964
965
966
		
		# HWL HACK: dont die, just print a warning
		#print stderr  "HWL: this should die! Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
967
		die "Prologue junk?: $p\n" if $p =~ /^\s+[^\s\.]/;
968
		
969
                # For PIC, we want to keep part of the prologue
970
		if ($TargetPlatform =~ /^powerpc-apple-darwin.*/ && $pcrel_label ne "") {
971
		    # Darwin: load the current instruction pointer into register r31
972
973
		    $p .= "bcl 20,31,$pcrel_label\n";
		    $p .= "$pcrel_label:\n";
974
		    $p .= "\tmflr r31\n";
975
976
977
978
979
980
981
		} elsif ($TargetPlatform =~ /^powerpc-.*-linux/ && $pcrel_label ne "") {
                    # Linux: load the GOT pointer into register 30
                    $p .= "\tbcl 20,31,.LCF$pcrel_label\n";
                    $p .= ".LCF$pcrel_label:\n";
                    $p .= "\tmflr 30\n";
                    $p .= "\tlwz 0,.LCL$pcrel_label-.LCF$pcrel_label(30)\n";
                    $p .= "\tadd 30,0,30\n";
982
983
984
                } elsif ($TargetPlatform =~ /^i386-apple-darwin.*/ && $pcrel_label ne "") {
                    $p .= "\tcall ___i686.get_pc_thunk.$pcrel_reg\n";
                    $p .= "$pcrel_label:\n";
985
                }
986
		
987
988
989
990
991
		# glue together what's left
		$c = $p . $r;
	    }
	}

rrt's avatar
rrt committed
992
993
994
995
996
	if ( $TargetPlatform =~ /^mips-/ ) {
	    # MIPS: first, this basic sequence may occur "--- END ---" or not
	    $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
	}

997
998
999
	# toss all epilogue stuff; again, paranoidly
	if ( $c =~ /--- END ---/ ) {
	    if (($r, $e) = split(/--- END ---/, $c)) {
1000
1001
		if ($TargetPlatform =~ /^i386-/) {
		    $e =~ s/^\tret\n//;
1002
1003
1004
1005
1006
1007
		    $e =~ s/^\tpopl\s+\%edi\n//;
		    $e =~ s/^\tpopl\s+\%esi\n//;
		    $e =~ s/^\tpopl\s+\%edx\n//;
		    $e =~ s/^\tpopl\s+\%ecx\n//;
		    $e =~ s/^\taddl\s+\$\d+,\s*\%esp\n//;
		    $e =~ s/^\tsubl\s+\$-\d+,\s*\%esp\n//;
1008
1009
1010
1011
1012
1013
1014
1015
		} elsif ($TargetPlatform =~ /^ia64-/) {
		    $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
1016
1017
1018
1019
1020
1021
1022
1023
		} elsif ($TargetPlatform =~ /^m68k-/) {
		    $e =~ s/^\tunlk a6\n//;
		    $e =~ s/^\trts\n//;
		} elsif ($TargetPlatform =~ /^mips-/) {
		    $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
		    $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
		    $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
		    $e =~ s/^\tj\t\$31\n//;
1024
 		} elsif ($TargetPlatform =~ /^powerpc-apple-darwin.*/) {
1025
  		    $e =~ s/^\taddi r1,r1,\d+\n//;
1026
1027
  		    $e =~ s/^\tlwz r\d+,\d+\(r1\)\n//; 
  		    $e =~ s/^\tlmw r\d+,-\d+\(r1\)\n//;
1028
1029
 		    $e =~ s/^\tmtlr r0\n//;
  		    $e =~ s/^\tblr\n//;
1030
  		    $e =~ s/^\tb restFP ;.*\n//;
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
 		} elsif ($TargetPlatform =~ /^powerpc64-.*-linux/) {
		    $e =~ s/^\tmr 3,0\n//;
		    $e =~ s/^\taddi 1,1,\d+\n//;
		    $e =~ s/^\tld 0,16\(1\)\n//;
		    $e =~ s/^\tmtlr 0\n//;

		    # callee-save registers
		    $e =~ s/^\tld \d+,-?\d+\(1\)\n//g;
		    $e =~ s/^\tlfd \d+,-?\d+\(1\)\n//g;

		    # get rid of the debug junk along with the blr
		    $e =~ s/^\tblr\n\t.long .*\n\t.byte .*\n//;

		    # incase we missed it with the last one get the blr alone
		    $e =~ s/^\tblr\n//;
1046
1047
1048
		} else {
		    print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
		}
1049

1050
		print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/;
1051
1052
1053

		# glue together what's left
		$c = $r . $e;
1054
		$c =~ s/\n\t\n/\n/; # junk blank line
1055
1056
1057
	    }
	}

1058
1059
	# On SPARCs, we don't do --- BEGIN/END ---, we just
	# toss the register-windowing save/restore/ret* instructions
1060
1061
	# directly unless they've been generated by function definitions in header
	# files on Solaris:
1062
	if ( $TargetPlatform =~ /^sparc-/ ) {
1063
1064
1065
	    if ( ! ( $TargetPlatform =~ /solaris2$/ && $chkcat[$i] eq 'unknown' )) {
	    	$c =~ s/^\t(save.*|restore.*|ret|retl)\n//g;
	    }
1066
1067
1068
1069
1070
1071
	    # throw away PROLOGUE comments
	    $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
	}

	# On Alphas, the prologue mangling is done a little later (below)

1072
    	# toss all calls to __DISCARD__
1073
	$c =~ s/^\t(call|jbsr|jal)\s+${T_US}__DISCARD__\n//go;
ken's avatar
ken committed
1074
	$c =~ s/^\tjsr\s+\$26\s*,\s*${T_US}__DISCARD__\n//go if $TargetPlatform =~ /^alpha-/;
1075
	$c =~ s/^\tbl\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /^powerpc-apple-darwin.*/;
1076
	$c =~ s/^\tbl\s+__DISCARD__(\@plt)?\n//go if $TargetPlatform =~ /^powerpc-.*-linux/;
1077
	$c =~ s/^\tbl\s+\.__DISCARD__\n\s+nop\n//go if $TargetPlatform =~ /^powerpc64-.*-linux/;
1078
	$c =~ s/^\tcall\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /i386-apple-darwin.*/;
1079

1080
	# IA64: mangle tailcalls into jumps here
1081
1082
1083
1084
1085
1086
1087
	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/) {
		# 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);
	    }
	}
1088

1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
	# MIPS: that may leave some gratuitous asm macros around
	# (no harm done; but we get rid of them to be tidier)
	$c =~ s/^\t\.set\tnoreorder\n\t\.set\tnomacro\n\taddu\t(\S+)\n\t\.set\tmacro\n\t\.set\treorder\n/\taddu\t$1\n/
	    if $TargetPlatform =~ /^mips-/;

    	# toss stack adjustment after DoSparks
    	$c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g
		if $TargetPlatform =~ /^m68k-/; # this looks old...

	if ( $TargetPlatform =~ /^alpha-/ &&
	   ! $magic_rdata_seen &&
	   $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
	    $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
	    $magic_rdata_seen = 1;
	}

	# pick some end-things and move them to the next chunk
1106
1107
1108
1109

	# pin a funny end-thing on (for easier matching):
	$c .= 'FUNNY#END#THING';

1110
	while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/o ) {
sof's avatar
sof committed
1111

rrt's avatar
rrt committed
1112
	    $to_move = $1;
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123

	    # on x86 we try not to copy any directives into a literal
	    # chunk, rather we keep looking for the next real chunk.  This
	    # is because we get things like
	    #
	    #    .globl blah_closure
	    #    .LC32
	    #    	.string "..."
	    #    blah_closure:
	    #		...
            #
1124
	    if ( $TargetPlatform =~ /^(i386|sparc|powerpc)/ && $to_move =~ /${T_COPY_DIRVS}/ ) {
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
		$j = $i + 1;
		while ( $j < $numchks  && $chk[$j] =~ /$T_CONST_LBL/) {
			$j++;
		}
		if ( $j < $numchks ) {
			$chk[$j] = $to_move . $chk[$j];
	        }
	    }

	    elsif ( $i < ($numchks - 1)
1135
	      && ( $to_move =~ /${T_COPY_DIRVS}/
1136
	        || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
1137
1138
1139
1140
		$chk[$i + 1] = $to_move . $chk[$i + 1];
		# otherwise they're tossed
	    }

1141
	    $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o;
1142
1143
	}

1144
1145
1146
    	if ( $TargetPlatform =~ /^alpha-/ && $c =~ /^\t\.ent\s+(\S+)/ ) {
    	    $ent = $1;
	    # toss all prologue stuff, except for loading gp, and the ..ng address
ken's avatar
ken committed
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
	    unless ($c =~ /\.ent.*\n\$.*\.\.ng:/) {
		if (($p, $r) = split(/^\t\.prologue/, $c)) {
		    if (($keep, $junk) = split(/\.\.ng:/, $p)) {
			$keep =~ s/^\t\.frame.*\n/\t.frame \$30,0,\$26,0\n/;
			$keep =~ s/^\t\.(mask|fmask).*\n//g;
			$c = $keep . "..ng:\n";
		    } else {
			print STDERR "malformed code block ($ent)?\n"
		    }
		}
		$c .= "\t.prologue" . $r;
	    }
1159
1160
    	}
  
1161
1162
1163
1164
1165
1166
1167
	$c =~ s/FUNNY#END#THING//;

#	print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;

	$chk[$i] = $c; # update w/ convenience copy
    }

ken's avatar
ken committed
1168
1169
1170
1171
    # 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;

1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
    if ( $TargetPlatform =~ /^alpha-/ ) {
	# print out the header stuff first
	$chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
	print OUTASM $chk[0];

    } elsif ( $TargetPlatform =~ /^hppa/ ) {
	print OUTASM $chk[0];

    } elsif ( $TargetPlatform =~ /^mips-/ ) {
	$chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];

	# get rid of horrible "<dollar>Revision: .*$" strings
	local(@lines0) = split(/\n/, $chk[0]);
	local($z) = 0;
	while ( $z <= $#lines0 ) {
	    if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
		undef($lines0[$z]);
		$z++;
		while ( $z <= $#lines0 ) {
		    undef($lines0[$z]);
		    last if $lines0[$z] =~ /[,\t]0x0$/;
		    $z++;
		}
	    }
	    $z++;
	}
	$chk[0] = join("\n", @lines0);
	$chk[0] =~ s/\n\n+/\n/;
	print OUTASM $chk[0];
    }

    # print out all the literal strings next
1204
    for ($i = 0; $i < $numchks; $i++) {
1205
	if ( $chkcat[$i] eq 'literal' ) {
1206
1207
1208

	    # HACK: try to detect 16-byte constants and align them
	    # on a 16-byte boundary.  x86_64 sometimes needs 128-bit
1209
1210
1211
	    # aligned constants, and so does Darwin/x86.
	    if ( $TargetPlatform =~ /^x86_64/
                || $TargetPlatform =~ /^i386-apple-darwin/ ) { 
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
		$z = $chk[$i];
 		if ($z =~ /(\.long.*\n.*\.long.*\n.*\.long.*\n.*\.long|\.quad.*\n.*\.quad)/) {
		    print OUTASM $T_HDR_literal16;
		} else {
		    print OUTASM $T_HDR_literal;
		}
 	    } else {
		print OUTASM $T_HDR_literal;
	    }

	    print OUTASM $chk[$i];
1223
1224
	    print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter

1225
1226
1227
1228
	    $chkcat[$i] = 'DONE ALREADY';
	}
    }

1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
    # on the HPPA, print out all the bss next
    if ( $TargetPlatform =~ /^hppa/ ) {
	for ($i = 1; $i < $numchks; $i++) {
	    if ( $chkcat[$i] eq 'bss' ) {
		print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
		print OUTASM $chk[$i];

		$chkcat[$i] = 'DONE ALREADY';
	    }
	}
    }

    for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
1242
1243
1244
1245
#	print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";

	next if $chkcat[$i] eq 'DONE ALREADY';

1246
	if ( $chkcat[$i] eq 'misc' || $chkcat[$i] eq 'unknown' ) {
1247
1248
	    if ($chk[$i] ne '') {
		print OUTASM $T_HDR_misc;
sof's avatar
sof committed
1249
 		&print_doctored($chk[$i], 0);
1250
	    }
1251
1252
1253
1254
1255

	} elsif ( $chkcat[$i] eq 'toss' ) {
	    print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";

	} elsif ( $chkcat[$i] eq 'data' ) {
1256
1257
1258
1259
	    if ($chk[$i] ne '') {
		print OUTASM $T_HDR_data;
		print OUTASM $chk[$i];
	    }
1260
1261
1262

	} elsif ( $chkcat[$i] eq 'splitmarker' ) {
	    # we can just re-constitute this one...
1263
1264
1265
	    # NB: we emit _three_ underscores no matter what,
	    # so ghc-split doesn't have to care.
	    print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
1266
1267

	} elsif ( $chkcat[$i] eq 'closure'
1268
	       || $chkcat[$i] eq 'srt'
1269
	       || $chkcat[$i] eq 'infotbl'
1270
	       || $chkcat[$i] eq 'entry') { # do them in that order
1271
1272
1273
1274
1275
1276
1277
1278
1279
	    $symb = $chksymb[$i];

	    # CLOSURE
	    if ( defined($closurechk{$symb}) ) {
		print OUTASM $T_HDR_closure;
		print OUTASM $chk[$closurechk{$symb}];
		$chkcat[$closurechk{$symb}] = 'DONE ALREADY';
	    }

1280
1281
	    # SRT
	    if ( defined($srtchk{$symb}) ) {
1282
		print OUTASM $T_HDR_relrodata;
1283
1284
1285
1286
		print OUTASM $chk[$srtchk{$symb}];
		$chkcat[$srtchk{$symb}] = 'DONE ALREADY';
	    }

1287
1288
1289
1290
	    # INFO TABLE
	    if ( defined($infochk{$symb}) ) {

		print OUTASM $T_HDR_info;
1291
1292
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                
1293
1294
1295
1296
1297
		# entry code will be put here!

		$chkcat[$infochk{$symb}] = 'DONE ALREADY';
	    }

1298
	    # ENTRY POINT
1299
	    if ( defined($entrychk{$symb}) ) {
1300

1301
		$c = $chk[$entrychk{$symb}];
1302

1303
1304
1305
		# If this is an entry point with an info table,
                # eliminate the entry symbol and all directives involving it.
		if (defined($infochk{$symb}) && $TargetPlatform !~ /^ia64-/) {
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
			@o = ();
			foreach $l (split(/\n/,$c)) {
			    next if $l =~ /^.*$symb_(entry|ret)${T_POST_LBL}/;

			    # If we have .type/.size direrctives involving foo_entry,
			    # then make them refer to foo_info instead.  The information
			    # in these directives is used by the cachegrind annotator,
			    # so it is worthwhile keeping.
			    if ($l =~ /^\s*\.(type|size).*$symb_(entry|ret)/) {
				$l =~ s/$symb(_entry|_ret)/${symb}_info/g;
				push(@o,$l);
				next;
			    }
1319
                            next if $l =~ /^\s*\..*$symb.*\n?/;
1320
1321
1322
			    push(@o,$l);
			}
			$c = join("\n",@o) . "\n";
1323
1324
		}

1325
1326
1327
1328
		print OUTASM $T_HDR_entry;

		&print_doctored($c, 1); # NB: the 1!!!

1329
		$chkcat[$entrychk{$symb}] = 'DONE ALREADY';
1330
1331
	    }
	    
1332
	} elsif ( $chkcat[$i] eq 'vector' ) {
1333
1334
1335
1336
1337
	    $symb = $chksymb[$i];

	    # VECTOR TABLE
	    if ( defined($vectorchk{$symb}) ) {
		print OUTASM $T_HDR_vector;
1338
1339
		print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);

1340
1341
		# direct return code will be put here!
		$chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
1342
1343
1344
1345
1346
1347
1348
1349
1350

	    } elsif ( $TargetPlatform =~ /^alpha-/ ) {
		# Alphas: the commented nop is for the splitter, to ensure
		# that no module ends with a label as the very last
		# thing.  (The linker will adjust the label to point
		# to the first code word of the next module linked in,
		# even if alignment constraints cause the label to move!)

		print OUTASM "\t# nop\n";
1351
1352
	    }
	    
1353
1354
1355
1356
 	} elsif ( $chkcat[$i] eq 'rodata' ) {
		print OUTASM $T_HDR_rodata;
		print OUTASM $chk[$i];
		$chkcat[$i] = 'DONE ALREADY';
1357
1358
1359
1360
 	} elsif ( $chkcat[$i] eq 'relrodata' ) {
		print OUTASM $T_HDR_relrodata;
		print OUTASM $chk[$i];
		$chkcat[$i] = 'DONE ALREADY';
sof's avatar
sof committed
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
 	} elsif ( $chkcat[$i] eq 'toc' ) {
            # silly optimisation to print tocs, since they come in groups...
 	    print OUTASM $T_HDR_toc;
            local($j)	= $i;
            while ($chkcat[$j] eq 'toc')
              { if (   $chk[$j] !~ /\.tc UpdatePAP\[TC\]/ # not needed: always turned into a jump.
                   ) 
                {
                  print OUTASM $chk[$j];
                }
                $chkcat[$j] = 'DONE ALREADY';
                $j++;
 	    }
 	    
1375
1376
 	} elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && $chkcat[$i] eq 'dyld' ) {
	    # apple-darwin: dynamic linker stubs
1377
1378
1379
1380
	    if($chk[$i] !~ /\.indirect_symbol ___DISCARD__/)
	    {	# print them out unchanged, but remove the stubs for __DISCARD__
		print OUTASM $chk[$i];
	    }
1381
1382
1383
1384
        } elsif ( $TargetPlatform =~ /^i386-apple-darwin.*/ && $chkcat[$i] eq 'get_pc_thunk' ) {
            # i386-apple-darwin: __i686.get_pc_thunk.[abcd]x
            print OUTASM ".section __TEXT,__textcoal_nt,coalesced,no_toc\n";
            print OUTASM $chk[$i];
1385
1386
1387
1388
	} else {
	    &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
	}
    }
rrt's avatar
rrt committed
1389
1390
1391

    print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/;

1392
1393
1394
1395
1396
1397
    # finished
    close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
    close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
}
\end{code}

1398
\begin{code}
1399
sub hppa_mash_prologue { # OK, epilogue, too
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
    local($_) = @_;

    # toss all prologue stuff
    s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;

    # Lie about our .CALLINFO
    s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;

    # Get rid of P'

    s/LP'/L'/g;
    s/RP'/R'/g;

    # toss all epilogue stuff
    s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;

    # Sorry; we moved the _info stuff to the code segment.
    s/_info,DATA/_info,CODE/g;

    return($_);
}
\end{code}

1423
1424
1425
1426
\begin{code}
sub print_doctored {
    local($_, $need_fallthru_patch) = @_;

1427
1428
1429
1430
1431
1432
1433
1434
    if ( $TargetPlatform =~ /^x86_64-/ ) {
	    # Catch things like
	    #	
	    #    movq -4(%ebp), %rax
	    #    jmp  *%rax
	    # 
	    # and optimise:
	    #
1435
1436
	    s/^\tmovq\s+(-?\d*\(\%r(bx|bp|13)\)),\s*(\%r(ax|cx|dx|10|11))\n\tjmp\s+\*\3/\tjmp\t\*$1/g;
	    s/^\tmovl\s+\$${T_US}(.*),\s*(\%e(ax|cx|si|di))\n\tjmp\s+\*\%r\3/\tjmp\t$T_US$1/g;
1437
1438
    }

1439
    if ( $TargetPlatform !~ /^i386-/ 
1440
      || ! /^\t[a-z]/  # no instructions in here, apparently
ken's avatar
ken committed
1441
      || /^${T_US}__stginit_[A-Za-z0-9_]+${T_POST_LBL}/) {
1442
1443
1444
	print OUTASM $_;
	return;
    }
1445

1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470