ghc-asm.lprl 53.4 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
150
    $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*|\.lcomm.*)\n)';
    $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
    #--------------------------------------------------------#
dons's avatar
dons committed
163
    } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux|freebsd|netbsd|openbsd)$/ ) {
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
dons's avatar
dons committed
168
		      ($TargetPlatform =~ /-(linux|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
176
    $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)';
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
222
223
224
225
226
227
228

    $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)';
    $T_COPY_DIRVS   = '\.(globl|local)';

    $T_DOT_WORD     = '\.(quad|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";
229
    $T_HDR_rodata   = "\.section\t\.rodata\n\t\.align 8\n";
230
231
232
233
234
    $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";

235
236
237
238
239
240
241
242
243
    #--------------------------------------------------------#
    } 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
244
    $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
245
246
247
248
249
250
251
    $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";
252
    $T_HDR_rodata   = "\.text\n\t\.even\n";
253
254
255
256
257
258
259
260
261
262
263
264
265
266
    $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
267
    $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
268
269
270
    $T_COPY_DIRVS   = '\.(globl|ent)';

    $T_DOT_WORD	    = '\.word';
rrt's avatar
rrt committed
271
    $T_DOT_GLOBAL   = '^\t\.globl';
272
273
274
    $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";
275
    $T_HDR_rodata   = "\t\.rdata\n\t\.align 2\n";
276
277
278
279
280
281
    $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";

    #--------------------------------------------------------#
282
283
    } elsif ( $TargetPlatform =~ /^powerpc-apple-.*/ ) {
				# Apple PowerPC Darwin/MacOS X.
284
    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
285
    $T_US	    = '_'; # _ if symbols have an underscore on the front
286
    $T_PRE_APP	    = 'DOESNT APPLY'; # regexp that says what comes before APP/NO_APP
287
    $T_CONST_LBL    = '^\LC\d+:'; # regexp for what such a lbl looks like
288
289
    $T_POST_LBL	    = ':';

290
291
    $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)';
292

293
    $T_DOT_WORD	    = '\.(long|short|byte|fill|space)';
294
    $T_DOT_GLOBAL   = '\.globl';
sof's avatar
sof committed
295
    $T_HDR_toc      = "\.toc\n";
296
297
298
    $T_HDR_literal  = "\t\.const_data\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";
299
    $T_HDR_rodata   = "\t\.const_data\n\t\.align 2\n";
300
301
302
303
    $T_HDR_closure  = "\t\.const_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";
304

305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
    #--------------------------------------------------------#
    } 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";
323
    $T_HDR_rodata   = "\t\.section\t.rodata\n\t\.align 2\n";
324
325
326
327
328
    $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";

329
    #--------------------------------------------------------#
dons's avatar
dons committed
330
    } elsif ( $TargetPlatform =~ /^sparc-.*-(solaris2|openbsd)/ ) {
331
332
333
334
335
336
337
338
339
340

    $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	    = ':';

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

341
    $T_DOT_WORD	    = '\.(long|word|byte|half|skip|uahalf|uaword)';
rrt's avatar
rrt committed
342
    $T_DOT_GLOBAL   = '^\t\.global';
343
344
345
    $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";
346
    $T_HDR_rodata   = "\.text\n\t\.align 4\n";
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
    $T_HDR_closure  = "\.data\n\t\.align 4\n";
    $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";
368
    $T_HDR_rodata   = "\.text\n\t\.align 4\n";
369
370
371
372
373
    $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";

374
375
376
377
378
379
380
381
382
    #--------------------------------------------------------#
    } 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     = ':';

383
    $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.seg|\.stab.*|\t?\.section.*|\s+\.type.*|\s+\.size.*)\n)';
384
385
386
387
388
389
390
    $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";
391
    $T_HDR_rodata   = "\.text\n\t\.align 4\n";
392
393
394
395
396
    $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";

397
398
399
400
    #--------------------------------------------------------#
    } else {
	print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n";
	exit 1;
401
402
403
404
405
406
407
408
    }

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";
409
410
411
412
413
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";
}
414
415
416
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";
417
print STDERR "T_HDR_literal: $T_HDR_literal\n";
418
419
print STDERR "T_HDR_misc: $T_HDR_misc\n";
print STDERR "T_HDR_data: $T_HDR_data\n";
420
print STDERR "T_HDR_rodata: $T_HDR_rodata\n";
421
422
423
424
425
426
427
428
429
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}

430
431
432
433
434
435
%************************************************************************
%*									*
\subsection{Mangle away}
%*									*
%************************************************************************

436
437
438
439
440
441
442
\begin{code}
sub mangle_asm {
    local($in_asmf, $out_asmf) = @_;

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


445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
    &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
460
    %entrychk = ();	# ditto, its entry code
461
    %closurechk = ();	# ditto, the (static) closure
462
    %srtchk = ();	# ditto, its SRT (for top-level things)
463
464
    %infochk = (); 	# given a symbol base, say what chunk its info tbl is in
    %vectorchk = ();    # ditto, return vector table
465
    $EXTERN_DECLS = '';	# .globl <foo> .text (MIPS only)
466

467
    $i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
468
469

    while (<INASM>) {
rrt's avatar
rrt committed
470
	tr/\r//d if $TargetPlatform =~ /-mingw32$/; # In case Perl doesn't convert line endings
471
	next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
472
	next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
473
	next if /^\t\.def.*endef$/;
474
	next if /${T_PRE_APP}(NO_)?APP/o; 
475
476
    	next if /^;/ && $TargetPlatform =~ /^hppa/;

477
	next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|ia64)-/;
478
479

	if ( $TargetPlatform =~ /^mips-/ 
ken's avatar
ken committed
480
	  && /^\t\.(globl\S+\.text|comm\t)/ ) {
481
	    $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
482
483
484
485
486
487
488
489
490
491
492
	# 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
493
494
495
496
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

497
498
	# Labels ending "_str": these are literal strings.
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_str${T_POST_LBL}$/ ) {
499
500
501
502
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'rodata';
	    $chksymb[$i] = '';

503
	} elsif ( /^\s+/ ) { # most common case first -- a simple line!
504
505
506
507
	    # duplicated from the bottom

	    $chk[$i] .= $_;

508
509
510
511
512
513
514
515
516
517
	} 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] .= $_;

518
	} elsif ( /$T_CONST_LBL/o ) {
519
520
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'literal';
521
522
	    $chksymb[$i] = $1;

523
	} elsif ( /^${T_US}__stg_split_marker(\d*)${T_POST_LBL}$/o ) {
524
525
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'splitmarker';
526
527
	    $chksymb[$i] = $1;

528
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/o ) {
529
	    $symb = $1;
530
531
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'infotbl';
532
533
534
535
536
537
	    $chksymb[$i] = $symb;

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

	    $infochk{$symb} = $i;

538
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_(entry|ret)${T_POST_LBL}$/o ) {
539
	    $chk[++$i]   = $_;
540
	    $chkcat[$i]  = 'entry';
541
542
	    $chksymb[$i] = $1;

543
	    $entrychk{$1} = $i;
544

545
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/o ) {
546
547
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'closure';
548
549
550
551
	    $chksymb[$i] = $1;

	    $closurechk{$1} = $i;

552
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_srt${T_POST_LBL}$/o ) {
553
554
555
556
557
558
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'srt';
	    $chksymb[$i] = $1;

	    $srtchk{$1} = $i;

559
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_ct${T_POST_LBL}$/o ) {
560
561
562
563
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

564
	} elsif ( /^(${T_US}__gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/o ) {
565
566
	    ; # toss it

567
568
569
570
	} 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
571
	       ) {
572
573
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
574
575
	    $chksymb[$i] = '';

576
577
578
	} elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) {
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'bss';
sof's avatar
sof committed
579
580
  	    $chksymb[$i] = '';

581
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_cc(s)?${T_POST_LBL}$/o ) {
sof's avatar
sof committed
582
583
584
585
586
            # all CC_ symbols go in the data section...
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

587
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_(alt|dflt)${T_POST_LBL}$/o ) {
588
589
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'misc';
590
	    $chksymb[$i] = '';
591
	} elsif ( /^${T_US}([A-Za-z0-9_]+)_vtbl${T_POST_LBL}$/o ) {
592
593
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'vector';
594
595
596
597
598
	    $chksymb[$i] = $1;

	    $vectorchk{$1} = $i;

	} elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
chak's avatar
chak committed
599
600
601
602
603
604
605
606
	     &&   /^[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
607
	    $chk[++$i]   = $_;
chak's avatar
chak committed
608
	    $chkcat[$i]  = 'misc';
609
610
	    $chksymb[$i] = $1;

611
	} elsif ( /^${T_US}[A-Za-z0-9_]/o
612
		&& ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
613
		   || ! /^L\$\d+$/ ) ) {
614
615
	    local($thing);
	    chop($thing = $_);
616
617
	    $thing =~ s/:$//;
	    print STDERR "Warning: retaining unknown function \`$thing' in output from C compiler\n"
sof's avatar
sof committed
618
		unless # $KNOWN_FUNNY_THING{$thing}
619
		       /^${T_US}stg_.*${T_POST_LBL}$/o          # RTS internals
sof's avatar
sof committed
620
		    || /^${T_US}__stg_.*${T_POST_LBL}$/o        # more RTS internals
621
		    || /^${T_US}__fexp_.*${T_POST_LBL}$/o       # foreign export
622
		    || /^${T_US}.*_slow${T_POST_LBL}$/o         # slow entry
ken's avatar
ken committed
623
		    || /^${T_US}__stginit.*${T_POST_LBL}$/o     # __stginit<module>
624
		    || /^${T_US}.*_btm${T_POST_LBL}$/o          # large bitmaps
625
		    || /^${T_US}.*_srtd${T_POST_LBL}$/o          # large bitmaps
626
		    || /^${T_US}.*_fast${T_POST_LBL}$/o         # primops
chak's avatar
chak committed
627
628
		    || /^${T_US}.*_closure_tbl${T_POST_LBL}$/o  # closure tables
                    || /^_uname:/o;			        # x86/Solaris2
629
630
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'misc';
631
	    $chksymb[$i] = '';
632

633
634
635
636
637
638
639
	} elsif ( $TargetPlatform =~ /^powerpc-apple-.*/ && ( 
		   /^\.picsymbol_stub/
		|| /^\.section __TEXT,__picsymbol_stub1,.*/
		|| /^\.symbol_stub/
		|| /^\.section __TEXT,__symbol_stub1,.*/
		|| /^\.lazy_symbol_pointer/
		|| /^\.non_lazy_symbol_pointer/ ))
640
641
642
643
	{
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'dyld';
	    $chksymb[$i] = '';
644
	} elsif ( $TargetPlatform =~ /^powerpc-apple-.*/ && /^\.data/ && $chkcat[$i] eq 'dyld')
645
646
647
648
	{	# non_lazy_symbol_ptrs that point to local symbols
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'dyld';
	    $chksymb[$i] = '';
649
650
651
652
653
654
655
	} else { # simple line (duplicated at the top)

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

656
657
658
    # 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
659

660
661
662
663
664
665
666
667
    # 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
668
    local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
ken's avatar
ken committed
669
    local($FIRST_TOSSABLE ) = ($TargetPlatform =~ /^(hppa|mips-)/) ? 1 : 0;
670
671
672
673
674

#   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
675
    # spits a ".quad 0" in after the very first ".rdata"; we
676
677
678
679
680
    # 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
681
    for ($i = $FIRST_TOSSABLE; $i < $numchks; $i++) {
682
683
684
685
	$c = $chk[$i]; # convenience copy

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

686
687
	# toss all prologue stuff; HPPA is pretty weird
	# (see elsewhere)
688
689
	$c = &hppa_mash_prologue($c) if $TargetPlatform =~ /^hppa-/;

690
691
692
693
	# be slightly paranoid to make sure there's
	# nothing surprising in there
	if ( $c =~ /--- BEGIN ---/ ) {
	    if (($p, $r) = split(/--- BEGIN ---/, $c)) {
694

695
696
697
698
		# remove junk whitespace around the split point
		$p =~ s/\t+$//;
		$r =~ s/^\s*\n//;

699
		if ($TargetPlatform =~ /^i386-/) {
700
701
702
		    $p =~ s/^\tpushl\s+\%edi\n//;
		    $p =~ s/^\tpushl\s+\%esi\n//;
		    $p =~ s/^\tpushl\s+\%ebx\n//;
703
704
		    $p =~ s/^\tmovl\s+\%esi,\s*\d*\(\%esp\)\n//;
		    $p =~ s/^\tmovl\s+\%edi,\s*\d*\(\%esp\)\n//;
705
706
		    $p =~ s/^\tsubl\s+\$\d+,\s*\%esp\n//;
                    $p =~ s/^\tmovl\s+\$\d+,\s*\%eax\n\tcall\s+__alloca\n// if ($TargetPlatform =~ /^.*-cygwin32/);
707
708
709
710

		    # GCC 3.1 is in the habit of adding spurious writes to the
		    # stack in the prologue.  Just to be on the safe side,
		    # chuck these over the fence into the main code.
711
		    while ($p =~ /^\tmovl\s+\$\d+,\s*\d*\(\%esp\)\n/) {
712
713
714
715
716
			  # print "Spurious instruction: $&";
			  $p = $` . $';
			  $r = $& . $r;
		    }

717
718
719
720
721
		} 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//;

722
723
		} elsif ($TargetPlatform =~ /^ia64-/) {
		    $p =~ s/^\t\.prologue .*\n//;
724
		    $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, 3[12], \d+, 0\n//;
725
726
		    $p =~ s/^\t\.fframe \d+\n\tadds r12 = -\d+, r12\n//;
		    $p =~ s/^\t\.save rp, r\d+\n\tmov r\d+ = b0\n//;
727
		    $p =~ s/^\t\.(mii|mmi)\n//g;	# bundling is no longer sensible
728
729
		    $p =~ s/^\t;;\n//g;		# discard stops
		    $p =~ s/^\t\/\/.*\n//g;	# gcc inserts timings in // comments
730
731
732
733
734
735

		    # GCC 3.3 saves r1 in the prologue, move this to the body
		    if ($p =~ /^\tmov r\d+ = r1\n/) {
			  $p = $` . $';
			  $r = $& . $r;
		    }
736
737
		} elsif ($TargetPlatform =~ /^m68k-/) {
		    $p =~ s/^\tlink a6,#-?\d.*\n//;
sof's avatar
sof committed
738
739
740
741
742
 		    $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
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
		    $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/;
759
		} elsif ($TargetPlatform =~ /^powerpc-apple-.*/) {
760
761
762
763
		    $pcrel_label = $p;
		    $pcrel_label =~ s/(.|\n)*^(L\d+\$pb):\n(.|\n)*/$2/ or $pcrel_label = "";

		    $p =~ s/^\tmflr r0\n//;
764
 		    $p =~ s/^\tbl saveFP # f\d+\n//;
765
766
 		    $p =~ s/^\tbl saveFP ; save f\d+-f\d+\n//;
		    $p =~ s/^L\d+\$pb:\n//;
767
768
769
770
771
 		    $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; 
772
773
774
  		    $p =~ s/^\tbcl 20,31,L\d+\$pb\n//;
  		    $p =~ s/^L\d+\$pb:\n//;
  		    $p =~ s/^\tmflr r31\n//;
775
776
777
778
779
780

		    # 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;
781
782
783
784
785
786
787
788
789
790
791
792
793
		} 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; 

		    # 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;
794
795
796
		} else {
		    print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
		}
797
798
799
		
		# HWL HACK: dont die, just print a warning
		#print stderr  "HWL: this should die! Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
800
		die "Prologue junk?: $p\n" if $p =~ /^\s+[^\s\.]/;
801
802
803
804
805
806
		
		if ($TargetPlatform =~ /^powerpc-apple-.*/ && $pcrel_label ne "") {
		    # on PowerPC, we have to keep a part of the prologue
		    # (which loads the current instruction pointer into register r31)
		    $p .= "bcl 20,31,$pcrel_label\n";
		    $p .= "$pcrel_label:\n";
807
		    $p .= "\tmflr r31\n";
808
		}
809
		
810
811
812
813
814
		# glue together what's left
		$c = $p . $r;
	    }
	}

rrt's avatar
rrt committed
815
816
817
818
819
	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/;
	}

820
821
822
	# toss all epilogue stuff; again, paranoidly
	if ( $c =~ /--- END ---/ ) {
	    if (($r, $e) = split(/--- END ---/, $c)) {
823
824
		if ($TargetPlatform =~ /^i386-/) {
		    $e =~ s/^\tret\n//;
825
826
827
828
829
830
		    $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//;
831
832
833
834
835
836
837
838
		} 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
839
840
841
842
843
844
845
846
		} 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//;
847
848
849
850
851
852
 		} elsif ($TargetPlatform =~ /^powerpc-apple-.*/) {
  		    $e =~ s/^\taddi r1,r1,\d+\n//;
  		    $e =~ s/^\tcal r1,\d+\(r1\)\n//;
  		    $e =~ s/^\tlw?z? r\d+,\d+\(r1\)\n//; 
 		    $e =~ s/^\tmtlr r0\n//;
  		    $e =~ s/^\tblr\n//;
853
  		    $e =~ s/^\tb restFP ;.*\n//;
854
855
856
		} else {
		    print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
		}
857

858
		print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/;
859
860
861

		# glue together what's left
		$c = $r . $e;
862
		$c =~ s/\n\t\n/\n/; # junk blank line
863
864
865
	    }
	}

866
867
868
869
	# On SPARCs, we don't do --- BEGIN/END ---, we just
	# toss the register-windowing save/restore/ret* instructions
	# directly:
	if ( $TargetPlatform =~ /^sparc-/ ) {
870
	    $c =~ s/^\t(save.*|restore.*|ret|retl)\n//g;
871
872
873
874
875
876
	    # 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)

877
    	# toss all calls to __DISCARD__
878
	$c =~ s/^\t(call|jbsr|jal)\s+${T_US}__DISCARD__\n//go;
ken's avatar
ken committed
879
	$c =~ s/^\tjsr\s+\$26\s*,\s*${T_US}__DISCARD__\n//go if $TargetPlatform =~ /^alpha-/;
880
	$c =~ s/^\tbl\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /^powerpc-apple-.*/;
881
	$c =~ s/^\tbl\s+__DISCARD__\n//go if $TargetPlatform =~ /^powerpc-.*-linux/;
882

883
	# IA64: mangle tailcalls into jumps here
884
885
886
887
888
889
890
	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);
	    }
	}
891

892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
	# 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
909
910
911
912

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

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

rrt's avatar
rrt committed
915
	    $to_move = $1;
916
917
918
919
920
921
922
923
924
925
926

	    # 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:
	    #		...
            #
927
	    if ( $TargetPlatform =~ /^(i386|sparc|powerpc)/ && $to_move =~ /${T_COPY_DIRVS}/ ) {
928
929
930
931
932
933
934
935
936
937
		$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)
938
	      && ( $to_move =~ /${T_COPY_DIRVS}/
939
	        || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
940
941
942
943
		$chk[$i + 1] = $to_move . $chk[$i + 1];
		# otherwise they're tossed
	    }

944
	    $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o;
945
946
	}

947
948
949
    	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
950
951
952
953
954
955
956
957
958
959
960
961
	    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;
	    }
962
963
    	}
  
964
965
966
967
968
969
970
	$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
971
972
973
974
    # 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;

975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
    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
1007
    for ($i = 0; $i < $numchks; $i++) {
1008
1009
1010
1011
	if ( $chkcat[$i] eq 'literal' ) {
	    print OUTASM $T_HDR_literal, $chk[$i];
	    print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter

1012
1013
1014
1015
	    $chkcat[$i] = 'DONE ALREADY';
	}
    }

1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
    # 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++) {
1029
1030
1031
1032
1033
#	print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";

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

	if ( $chkcat[$i] eq 'misc' ) {
1034
1035
	    if ($chk[$i] ne '') {
		print OUTASM $T_HDR_misc;
sof's avatar
sof committed
1036
 		&print_doctored($chk[$i], 0);
1037
	    }
1038
1039
1040
1041
1042

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

	} elsif ( $chkcat[$i] eq 'data' ) {
1043
1044
1045
1046
	    if ($chk[$i] ne '') {
		print OUTASM $T_HDR_data;
		print OUTASM $chk[$i];
	    }
1047
1048
1049

	} elsif ( $chkcat[$i] eq 'splitmarker' ) {
	    # we can just re-constitute this one...
1050
1051
1052
	    # 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";
1053
1054

	} elsif ( $chkcat[$i] eq 'closure'
1055
	       || $chkcat[$i] eq 'srt'
1056
	       || $chkcat[$i] eq 'infotbl'
1057
	       || $chkcat[$i] eq 'entry') { # do them in that order
1058
1059
1060
1061
1062
1063
1064
1065
1066
	    $symb = $chksymb[$i];

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

1067
1068
	    # SRT
	    if ( defined($srtchk{$symb}) ) {
1069
		print OUTASM $T_HDR_rodata;
1070
1071
1072
1073
		print OUTASM $chk[$srtchk{$symb}];
		$chkcat[$srtchk{$symb}] = 'DONE ALREADY';
	    }

1074
1075
1076
1077
	    # INFO TABLE
	    if ( defined($infochk{$symb}) ) {

		print OUTASM $T_HDR_info;
1078
1079
                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
                
1080
1081
1082
1083
1084
		# entry code will be put here!

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

1085
	    # ENTRY POINT
1086
	    if ( defined($entrychk{$symb}) ) {
1087

1088
		$c = $chk[$entrychk{$symb}];
1089

1090
1091
1092
1093
1094
1095
1096
		# 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-/) {
			$c =~ s/^.*$symb_(entry|ret)${T_POST_LBL}\n//;
			$c =~ s/^\s*\..*$symb.*\n//g;
		}

1097
1098
1099
1100
		print OUTASM $T_HDR_entry;

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

1101
		$chkcat[$entrychk{$symb}] = 'DONE ALREADY';
1102
1103
	    }
	    
1104
	} elsif ( $chkcat[$i] eq 'vector' ) {
1105
1106
1107
1108
1109
	    $symb = $chksymb[$i];

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

1112
1113
		# direct return code will be put here!
		$chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
1114
1115
1116
1117
1118
1119
1120
1121
1122

	    } 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";
1123
1124
	    }
	    
1125
1126
1127
1128
1129
 	} elsif ( $chkcat[$i] eq 'rodata' ) {
		print OUTASM $T_HDR_rodata;
		print OUTASM $chk[$i];
		$chkcat[$i] = 'DONE ALREADY';

sof's avatar
sof committed
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
 	} 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++;
 	    }
 	    
1144
1145
1146
1147
1148
1149
 	} elsif ( $TargetPlatform =~ /^powerpc-apple-.*/ && $chkcat[$i] eq 'dyld' ) {
	    # powerpc-apple: dynamic linker stubs
	    if($chk[$i] !~ /\.indirect_symbol ___DISCARD__/)
	    {	# print them out unchanged, but remove the stubs for __DISCARD__
		print OUTASM $chk[$i];
	    }
1150
1151
1152
1153
	} else {
	    &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
	}
    }
rrt's avatar
rrt committed
1154
1155
1156

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

1157
1158
1159
1160
1161
1162
    # 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}

1163
\begin{code}
1164
sub hppa_mash_prologue { # OK, epilogue, too
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
    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}

1188
1189
1190
1191
1192
\begin{code}
sub print_doctored {
    local($_, $need_fallthru_patch) = @_;

    if ( $TargetPlatform !~ /^i386-/ 
1193
      || ! /^\t[a-z]/  # no instructions in here, apparently
ken's avatar
ken committed
1194
      || /^${T_US}__stginit_[A-Za-z0-9_]+${T_POST_LBL}/) {
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
	print OUTASM $_;
	return;
    }
    # OK, must do some x86 **HACKING**

    local($entry_patch)	= '';
    local($exit_patch)	= '';

    # gotta watch out for weird instructions that
    # invisibly smash various regs:
    #   rep*	%ecx used for counting
    #   scas*	%edi used for destination index
    #   cmps*	%e[sd]i used for indices
    #   loop*	%ecx used for counting
    #
    # SIGH.

    # We cater for:
    #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
    #
    #  * GCC used an "STG reg" for its own purposes
    #
    #  * some secret uses of machine reg, requiring STG reg
    #    to be saved/restored

    # The most dangerous "GCC uses" of an "STG reg" are when
    # the reg holds the target of a jmp -- it's tricky to
    # insert the patch-up code before we get to the target!
    # So here we change the jmps:

    # --------------------------------------------------------
    # it can happen that we have jumps of the form...
    #   jmp *<something involving %esp>
    # or
    #   jmp <something involving another naughty register...>
    #
    # a reasonably-common case is:
    #
    #   movl $_blah,<bad-reg>
    #   jmp  *<bad-reg>
    #
1236

1237
    s/^\tmovl\s+\$${T_US}(.*),\s*(\%e[abcd]x)\n\tjmp\s+\*\2/\tjmp $T_US$1/g;
1238
1239

    if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
1240
	s/^\tmovl\s+(.*),\s*\%esi\n\tjmp\s+\*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1241
	s/^\tjmp\s+\*(.*\(.*\%esi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1242
	s/^\tjmp\s+\*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
1243
	die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
1244
	    if /(jmp|call)\s+.*\%esi/;
1245
1246
    }
    if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
1247
	s/^\tmovl\s+(.*),\s*\%edi\n\tjmp\s+\*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1248
	s/^\tjmp\s+\*(.*\(.*\%edi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1249
	s/^\tjmp\s+\*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
1250
	die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
1251
	    if /(jmp|call)\s+.*\%edi/;
1252
1253
1254
1255
    }

    # OK, now we can decide what our patch-up code is going to
    # be:
sof's avatar
sof committed
1256

sof's avatar
sof committed
1257
1258
    # Offsets into register table - you'd better update these magic
    # numbers should you change its contents!
1259
    # local($OFFSET_R1)=0;  No offset for R1 in new RTS.
1260
    local($OFFSET_Hp)=88;
sof's avatar
sof committed
1261

sof's avatar
sof committed
1262
	# Note funky ".=" stuff; we're *adding* to these _patch guys
1263
    if ( $StolenX86Regs <= 2
1264
1265
1266
	 && ( /[^0-9]\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
	$entry_patch .= "\tmovl \%esi,(\%ebx)\n";
	$exit_patch  .= "\tmovl (\%ebx),\%esi\n";
sof's avatar
sof committed
1267

1268
1269
1270
	# nothing for call_{entry,exit} because %esi is callee-save
    }
    if ( $StolenX86Regs <= 3
1271
1272
1273
	 && ( /${OFFSET_Hp}\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # Hp (edi)
	$entry_patch .= "\tmovl \%edi,${OFFSET_Hp}(\%ebx)\n";
	$exit_patch  .= "\tmovl ${OFFSET_Hp}(\%ebx),\%edi\n";
sof's avatar
sof committed
1274

1275
1276
	# nothing for call_{entry,exit} because %edi is callee-save
    }
1277

1278
1279
1280
1281
    # --------------------------------------------------------
    # next, here we go with non-%esp patching!
    #
    s/^(\t[a-z])/$entry_patch$1/; # before first instruction
sof's avatar
sof committed
1282
1283
1284

# Before calling GC we must set up the exit condition before the call
# and entry condition when we come back
1285
1286
1287

    # fix _all_ non-local jumps:

1288
1289
    s/^\tjmp\s+\*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
    s/^\tjmp\s+${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
1290

1291
    s/^(\tjmp\s+.*\n)/$exit_patch$1/g; # here's the fix...
1292

1293
1294
    s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/go;
    s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/go;
1295

1296
1297
    if ($StolenX86Regs == 2 ) {
	die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_" 
1298
	    if /^\t(jmp|call)\s+.*\%e(si|di)/;
1299
1300
    } elsif ($StolenX86Regs == 3 ) {
	die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_" 
1301
	    if /^\t(jmp|call)\s+.*\%edi/;
1302
1303
1304
1305
1306
    }

    # --------------------------------------------------------
    # that's it -- print it
    #
1307
    #die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320

    print OUTASM $_;

    if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
	print OUTASM $exit_patch;
	# ToDo: make it not print if there is a "jmp" at the end
    }
}
\end{code}

\begin{code}
sub init_FUNNY_THINGS {
    %KNOWN_FUNNY_THING = (
1321
1322
	# example
	# "${T_US}stg_.*{T_POST_LBL}", 1,  
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
    );
}
\end{code}

The following table reversal is used for both info tables and return
vectors.  In both cases, we remove the first entry from the table,
reverse the table, put the label at the end, and paste some code
(that which is normally referred to by the first entry in the table)
right after the table itself.  (The code pasting is done elsewhere.)

\begin{code}
sub rev_tbl {
    local($symb, $tbl, $discard1) = @_;

1337
1338
    return ($tbl) if ($TargetPlatform =~ /^ia64-/);

1339
1340
    local($before) = '';
    local($label) = '';
1341
    local(@imports) = (); # hppa only
1342
1343
1344
    local(@words) = ();
    local($after) = '';
    local(@lines) = split(/\n/, $tbl);
ken's avatar
ken committed
1345
    local($i, $j);
1346
1347

    # Deal with the header...
1348
    for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t?${T_DOT_WORD}\s+/o; $i++) {
1349
	$label .= $lines[$i] . "\n",
1350
1351
1352
	    next if $lines[$i] =~ /^[A-Za-z0-9_]+_info${T_POST_LBL}$/o
		 || $lines[$i] =~ /${T_DOT_GLOBAL}/o
		 || $lines[$i] =~ /^${T_US}\S+_vtbl${T_POST_LBL}$/o;
1353
1354
1355
1356

	$before .= $lines[$i] . "\n"; # otherwise...
    }

1357
    # Grab the table data...
1358
    if ( $TargetPlatform !~ /^hppa/ ) {
1359
	for ( ; $i <= $#lines && $lines[$i] =~ /^\t?${T_DOT_WORD}\s+/o; $i++) {
1360
1361
1362
	    push(@words, $lines[$i]);
	}
    } else { # hppa weirdness
1363
	for ( ; $i <= $#lines && $lines[$i] =~ /^\s+(${T_DOT_WORD}|\.IMPORT)/; $i++) {
1364
1365
1366
1367
1368
1369
1370
1371
1372
	    if ($lines[$i] =~ /^\s+\.IMPORT/) {
		push(@imports, $lines[$i]);
	    } else {
		# We don't use HP's ``function pointers''
		# We just use labels in code space, like normal people
		$lines[$i] =~ s/P%//;
		push(@words, $lines[$i]);
	    }
	}
1373
    }
1374

1375
1376
1377
1378
    # Now throw away any initial zero word from the table.  This is a hack
    # that lets us reduce the size of info tables when the SRT field is not
    # needed: see comments StgFunInfoTable in InfoTables.h.
    #
1379
1380
1381
    # The .zero business is for Linux/ELF.
    # The .skip business is for Sparc/Solaris/ELF.
    # The .blockz business is for HPPA.
1382
1383
1384
1385
1386
#    if ($discard1) {
#	if ($words[0] =~ /^\t?(${T_DOT_WORD}\s+0|\.zero\s+4|\.skip\s+4|\.blockz\s+4)/) {
#		shift(@words);
#    	}
#    }
1387
1388
1389
1390
1391

    for (; $i <= $#lines; $i++) {
	$after .= $lines[$i] . "\n";
    }

ken's avatar
ken committed
1392
    # Alphas: If we have anonymous text (not part of a procedure), the
1393
    # linker may complain about missing exception information.  Bleh.
ken's avatar
ken committed
1394
1395
1396
    # To suppress this, we place a .ent/.end pair around the code.
    # At the same time, we have to be careful and not enclose any leading
    # .file/.loc directives.
1397
    if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
ken's avatar
ken committed
1398
1399
1400
        local ($ident) = $1;
        $before =~ s/^((\s*\.(file|loc)\s+[^\n]*\n)*)/$1\t.ent $ident\n/;
    	$after .= "\t.end $ident\n";
1401
1402
    }

ken's avatar
ken committed
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
    # Alphas: The heroic Simon Marlow found a bug in the Digital UNIX
    # assembler (!) wherein .quad constants inside .text sections are
    # first narrowed to 32 bits then sign-extended back to 64 bits.
    # This obviously screws up our 64-bit bitmaps, so we work around
    # the bug by replacing .quad with .align 3 + .long + .long [ccshan]
    if ( $TargetPlatform =~ /^alpha-/ ) {
	foreach (@words) {
	    if (/^\s*\.quad\s+([-+0-9].*\S)\s*$/ && length $1 >= 10) {
		local ($number) = $1;
		if ($number =~ /^([-+])?(0x?)?([0-9]+)$/) {
		    local ($sign, $base, $digits) = ($1, $2, $3);
		    $base = (10, 8, 16)[length $base];
		    local ($hi, $lo) = (0, 0);
sof's avatar
sof committed
1416
		    foreach $i (split(//, $digits)) {
ken's avatar
ken committed
1417
1418
1419
1420
1421
1422
1423
			$j = $lo * $base + $i;
			$lo = $j % 4294967296;
			$hi = $hi * $base + ($j - $lo) / 4294967296;
		    }
		    ($hi, $lo) = (4294967295 - $hi, 4294967296 - $lo)
			if $sign eq "-";
		    $_ = "\t.align 3\n\t.long $lo\n\t.long $hi\n";
ken's avatar
ken committed
1424
		    # printf STDERR "TURNING %s into 0x %08x %08x\n", $number, $hi, $lo;
ken's avatar
ken committed
1425
1426
1427
1428
1429
1430
1431
1432
		} else {
		    print STDERR "Cannot handle \".quad $number\" in info table\n";
		    exit 1;
		}
	    }
	}
    }

1433
1434
    $tbl = $before
	 . (($TargetPlatform !~ /^hppa/) ? '' : join("\n", @imports) . "\n")
1435
	 . join("\n", @words) . "\n"
1436
	 . $label . $after;
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446

#   print STDERR "before=$before\n";
#   print STDERR "label=$label\n";