[project @ 1996-06-27 15:55:53 by partain]
[ghc.git] / ghc / driver / ghc-asm.lprl
1 %************************************************************************
2 %*                                                                      *
3 \section[Driver-asm-fiddling]{Fiddling with assembler files}
4 %*                                                                      *
5 %************************************************************************
6
7 Tasks:
8 \begin{itemize}
9 \item
10 Utterly stomp out C functions' prologues and epilogues; i.e., the
11 stuff to do with the C stack.
12 \item
13 Any other required tidying up.
14 \end{itemize}
15
16 HPPA specific notes:
17 \begin{itemize}
18 \item
19 The HP linker is very picky about symbols being in the appropriate
20 space (code vs. data).  When we mangle the threaded code to put the
21 info tables just prior to the code, they wind up in code space
22 rather than data space.  This means that references to *_info from
23 un-mangled parts of the RTS (e.g. unthreaded GC code) get
24 unresolved symbols.  Solution:  mini-mangler for .c files on HP.  I
25 think this should really be triggered in the driver by a new -rts
26 option, so that user code doesn't get mangled inappropriately.
27 \item
28 With reversed tables, jumps are to the _info label rather than to
29 the _entry label.  The _info label is just an address in code
30 space, rather than an entry point with the descriptive blob we
31 talked about yesterday.  As a result, you can't use the call-style
32 JMP_ macro.  However, some JMP_ macros take _info labels as targets
33 and some take code entry points within the RTS.  The latter won't
34 work with the goto-style JMP_ macro.  Sigh.  Solution: Use the goto
35 style JMP_ macro, and mangle some more assembly, changing all
36 "RP'literal" and "LP'literal" references to "R'literal" and
37 "L'literal," so that you get the real address of the code, rather
38 than the descriptive blob.  Also change all ".word P%literal"
39 entries in info tables and vector tables to just ".word literal,"
40 for the same reason.  Advantage: No more ridiculous call sequences.
41 \end{itemize}
42
43 %************************************************************************
44 %*                                                                      *
45 \subsection{Constants for various architectures}
46 %*                                                                      *
47 %************************************************************************
48
49 \begin{code}
50 sub init_TARGET_STUFF {
51
52     #--------------------------------------------------------#
53     if ( $TargetPlatform =~ /^alpha-.*-.*/ ) {
54
55     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
56     $T_US           = ''; # _ if symbols have an underscore on the front
57     $T_DO_GC        = 'PerformGC_wrapper';
58     $T_PRE_APP      = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
59     $T_CONST_LBL    = '^\$C(\d+):$'; # regexp for what such a lbl looks like
60     $T_POST_LBL     = ':';
61
62     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)';
63     $T_COPY_DIRVS   = '^\s*(\#|\.(file|globl|ent|loc))';
64
65     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
66     $T_DOT_WORD     = '\.quad';
67     $T_DOT_GLOBAL   = "\t\.globl";
68     $T_HDR_literal  = "\.rdata\n\t\.align 3\n";
69     $T_HDR_misc     = "\.text\n\t\.align 3\n";
70     $T_HDR_data     = "\.data\n\t\.align 3\n";
71     $T_HDR_consist  = "\.text\n";
72     $T_HDR_closure  = "\.data\n\t\.align 3\n";
73     $T_HDR_info     = "\.text\n\t\.align 3\n";
74     $T_HDR_entry    = "\.text\n\t\.align 3\n";
75     $T_HDR_fast     = "\.text\n\t\.align 3\n";
76     $T_HDR_vector   = "\.text\n\t\.align 3\n";
77     $T_HDR_direct   = "\.text\n\t\.align 3\n";
78
79     #--------------------------------------------------------#
80     } elsif ( $TargetPlatform =~ /^hppa/ ) {
81
82     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
83     $T_US           = ''; # _ if symbols have an underscore on the front
84     $T_DO_GC        = 'PerformGC_wrapper';
85     $T_PRE_APP      = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
86     $T_CONST_LBL    = '^L\$C(\d+)$'; # regexp for what such a lbl looks like
87     $T_POST_LBL     = '';
88
89     $T_MOVE_DIRVS   = '^((\s+\.(IMPORT|EXPORT|PARAM).*|\s+\.align\s+\d+|\s+\.(SPACE|SUBSPA)\s+\S+|\s*)\n)';
90     $T_COPY_DIRVS   = '^\s+\.(IMPORT|EXPORT)';
91
92     $T_hsc_cc_PAT   = '\.STRING.*\)(hsc|cc) (.*)\\\\x09(.*)\\\\x00';
93     $T_DOT_WORD     = '\.word';
94     $T_DOT_GLOBAL   = '\s+\.EXPORT';
95     $T_HDR_literal  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
96     $T_HDR_misc     = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
97     $T_HDR_data     = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
98     $T_HDR_consist  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
99     $T_HDR_closure  = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
100     $T_HDR_info     = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
101     $T_HDR_entry    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
102     $T_HDR_fast     = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
103     $T_HDR_vector   = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
104     $T_HDR_direct   = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
105
106     #--------------------------------------------------------#
107     } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd)/ ) {
108
109     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
110     $T_US           = '_'; # _ if symbols have an underscore on the front
111     $T_DO_GC        = '_PerformGC_wrapper';
112     $T_PRE_APP      = '^#'; # regexp that says what comes before APP/NO_APP
113     $T_CONST_LBL    = '^LC(\d+):$';
114     $T_POST_LBL     = ':';
115     $T_X86_PRE_LLBL_PAT = 'L';
116     $T_X86_PRE_LLBL         = 'L';
117     $T_X86_BADJMP   = '^\tjmp [^L\*]';
118
119     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*)\n)';
120     $T_COPY_DIRVS   = '\.(globl|stab)';
121     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
122     $T_DOT_WORD     = '\.long';
123     $T_DOT_GLOBAL   = '\.globl';
124     $T_HDR_literal  = "\.text\n\t\.align 2\n"; # .align 4 is 486-cache friendly
125     $T_HDR_misc     = "\.text\n\t\.align 2,0x90\n";
126     $T_HDR_data     = "\.data\n\t\.align 2\n"; # ToDo: change align??
127     $T_HDR_consist  = "\.text\n";
128     $T_HDR_closure  = "\.data\n\t\.align 2\n"; # ToDo: change align?
129     $T_HDR_info     = "\.text\n\t\.align 2\n"; # NB: requires padding
130     $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
131     $T_HDR_fast     = "\.text\n\t\.align 2,0x90\n";
132     $T_HDR_vector   = "\.text\n\t\.align 2\n"; # NB: requires padding
133     $T_HDR_direct   = "\.text\n\t\.align 2,0x90\n";
134
135     #--------------------------------------------------------#
136     } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux)$/ ) {
137
138     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
139     $T_US           = ''; # _ if symbols have an underscore on the front
140     $T_DO_GC        = 'PerformGC_wrapper';
141     $T_PRE_APP      = '/'; # regexp that says what comes before APP/NO_APP
142     $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
143     $T_POST_LBL     = ':';
144     $T_X86_PRE_LLBL_PAT = '\.L';
145     $T_X86_PRE_LLBL         = '.L';
146     $T_X86_BADJMP   = '^\tjmp [^\.\*]';
147
148     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.Lfe.*\n\t\.size\s+.*|\.size\s+.*|\.ident.*)\n)';
149     $T_COPY_DIRVS   = '\.(globl)';
150
151     $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
152     $T_DOT_WORD     = '\.long';
153     $T_DOT_GLOBAL   = '\.globl';
154     $T_HDR_literal  = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
155     $T_HDR_misc     = "\.text\n\t\.align 16\n";
156     $T_HDR_data     = "\.data\n\t\.align 4\n"; # ToDo: change align??
157     $T_HDR_consist  = "\.text\n";
158     $T_HDR_closure  = "\.data\n\t\.align 4\n"; # ToDo: change align?
159     $T_HDR_info     = "\.text\n\t\.align 16\n"; # NB: requires padding
160     $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
161     $T_HDR_fast     = "\.text\n\t\.align 16\n";
162     $T_HDR_vector   = "\.text\n\t\.align 16\n"; # NB: requires padding
163     $T_HDR_direct   = "\.text\n\t\.align 16\n";
164
165     #--------------------------------------------------------#
166     } elsif ( $TargetPlatform =~ /^m68k-.*-sunos4/ ) {
167
168     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
169     $T_US           = '_'; # _ if symbols have an underscore on the front
170     $T_DO_GC        = '_PerformGC_wrapper';
171     $T_PRE_APP      = '^# MAY NOT APPLY'; # regexp that says what comes before APP/NO_APP
172     $T_CONST_LBL    = '^LC(\d+):$';
173     $T_POST_LBL     = ':';
174
175     $T_MOVE_DIRVS   = '(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
176     $T_COPY_DIRVS   = '\.(globl|proc|stab)';
177     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
178
179     $T_DOT_WORD     = '\.long';
180     $T_DOT_GLOBAL   = '\.globl';
181     $T_HDR_literal  = "\.text\n\t\.even\n";
182     $T_HDR_misc     = "\.text\n\t\.even\n";
183     $T_HDR_data     = "\.data\n\t\.even\n";
184     $T_HDR_consist  = "\.text\n";
185     $T_HDR_closure  = "\.data\n\t\.even\n";
186     $T_HDR_info     = "\.text\n\t\.even\n";
187     $T_HDR_entry    = "\.text\n\t\.even\n";
188     $T_HDR_fast     = "\.text\n\t\.even\n";
189     $T_HDR_vector   = "\.text\n\t\.even\n";
190     $T_HDR_direct   = "\.text\n\t\.even\n";
191
192     #--------------------------------------------------------#
193     } elsif ( $TargetPlatform =~ /^mips-.*/ ) {
194
195     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
196     $T_US           = ''; # _ if symbols have an underscore on the front
197     $T_DO_GC        = 'PerformGC_wrapper';
198     $T_PRE_APP      = '^\s*#'; # regexp that says what comes before APP/NO_APP
199     $T_CONST_LBL    = '^\$LC(\d+):$'; # regexp for what such a lbl looks like
200     $T_POST_LBL     = ':';
201
202     $T_MOVE_DIRVS   = '(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
203     $T_COPY_DIRVS   = '\.(globl|ent)';
204
205     $T_hsc_cc_PAT   = 'I WAS TOO LAZY TO DO THIS BIT (WDP 95/05)';
206     $T_DOT_WORD     = '\.word';
207     $T_DOT_GLOBAL   = '\t\.globl';
208     $T_HDR_literal  = "\t\.rdata\n\t\.align 2\n";
209     $T_HDR_misc     = "\t\.text\n\t\.align 2\n";
210     $T_HDR_data     = "\t\.data\n\t\.align 2\n";
211     $T_HDR_consist  = 'TOO LAZY TO DO THIS TOO';
212     $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
213     $T_HDR_info     = "\t\.text\n\t\.align 2\n";
214     $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
215     $T_HDR_fast     = "\t\.text\n\t\.align 2\n";
216     $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
217     $T_HDR_direct   = "\t\.text\n\t\.align 2\n";
218
219     #--------------------------------------------------------#
220     } elsif ( $TargetPlatform =~ /^powerpc-.*/ ) {
221
222     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
223     $T_US           = '\.'; # _ if symbols have an underscore on the front
224     $T_DO_GC        = 'PerformGC_wrapper';
225     $T_PRE_APP      = 'NOT APPLICABLE'; # regexp that says what comes before APP/NO_APP
226     $T_CONST_LBL    = '^LC\.\.(\d+):$'; # regexp for what such a lbl looks like
227     $T_POST_LBL     = ':';
228
229     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.Lfe.*\n\t\.size\s+.*|\.size\s+.*|\.ident.*)\n)';
230     $T_COPY_DIRVS   = '\.(globl)';
231
232     $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
233     $T_DOT_WORD     = '\.long';
234     $T_DOT_GLOBAL   = '\.globl';
235     $T_HDR_literal  = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
236     $T_HDR_misc     = "\.text\n\t\.align 16\n";
237     $T_HDR_data     = "\.data\n\t\.align 4\n"; # ToDo: change align??
238     $T_HDR_consist  = "\.text\n";
239     $T_HDR_closure  = "\.data\n\t\.align 4\n"; # ToDo: change align?
240     $T_HDR_info     = "\.text\n\t\.align 16\n"; # NB: requires padding
241     $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
242     $T_HDR_fast     = "\.text\n\t\.align 16\n";
243     $T_HDR_vector   = "\.text\n\t\.align 16\n"; # NB: requires padding
244     $T_HDR_direct   = "\.text\n\t\.align 16\n";
245
246     #--------------------------------------------------------#
247     } elsif ( $TargetPlatform =~ /^sparc-.*-solaris2/ ) {
248
249     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
250     $T_US           = ''; # _ if symbols have an underscore on the front
251     $T_DO_GC        = 'PerformGC_wrapper';
252     $T_PRE_APP      = 'DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
253     $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
254     $T_POST_LBL     = ':';
255
256     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*|\.section.*|\s+\.type.*|\s+\.size.*)\n)';
257     $T_COPY_DIRVS   = '\.(global|proc|stab)';
258
259     $T_hsc_cc_PAT   = '\.asciz.*\)(hsc|cc) (.*)\\\\t(.*)"';
260     $T_DOT_WORD     = '\.word';
261     $T_DOT_GLOBAL   = '\.global';
262     $T_HDR_literal  = "\.text\n\t\.align 8\n";
263     $T_HDR_misc     = "\.text\n\t\.align 4\n";
264     $T_HDR_data     = "\.data\n\t\.align 8\n";
265     $T_HDR_consist  = "\.text\n";
266     $T_HDR_closure  = "\.data\n\t\.align 4\n";
267     $T_HDR_info     = "\.text\n\t\.align 4\n";
268     $T_HDR_entry    = "\.text\n\t\.align 4\n";
269     $T_HDR_fast     = "\.text\n\t\.align 4\n";
270     $T_HDR_vector   = "\.text\n\t\.align 4\n";
271     $T_HDR_direct   = "\.text\n\t\.align 4\n";
272
273     #--------------------------------------------------------#
274     } elsif ( $TargetPlatform =~ /^sparc-.*-sunos4/ ) {
275
276     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
277     $T_US           = '_'; # _ if symbols have an underscore on the front
278     $T_DO_GC        = '_PerformGC_wrapper';
279     $T_PRE_APP      = '^# DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
280     $T_CONST_LBL    = '^LC(\d+):$';
281     $T_POST_LBL     = ':';
282
283     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*)\n)';
284     $T_COPY_DIRVS   = '\.(global|proc|stab)';
285     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
286
287     $T_DOT_WORD     = '\.word';
288     $T_DOT_GLOBAL   = '^\t\.global';
289     $T_HDR_literal  = "\.text\n\t\.align 8\n";
290     $T_HDR_misc     = "\.text\n\t\.align 4\n";
291     $T_HDR_data     = "\.data\n\t\.align 8\n";
292     $T_HDR_consist  = "\.text\n";
293     $T_HDR_closure  = "\.data\n\t\.align 4\n";
294     $T_HDR_info     = "\.text\n\t\.align 4\n";
295     $T_HDR_entry    = "\.text\n\t\.align 4\n";
296     $T_HDR_fast     = "\.text\n\t\.align 4\n";
297     $T_HDR_vector   = "\.text\n\t\.align 4\n";
298     $T_HDR_direct   = "\.text\n\t\.align 4\n";
299
300     #--------------------------------------------------------#
301     } else {
302         print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n";
303         exit 1;
304     }
305
306 if ( 0 ) {
307 print STDERR "T_STABBY: $T_STABBY\n";
308 print STDERR "T_US: $T_US\n";
309 print STDERR "T_DO_GC: $T_DO_GC\n";
310 print STDERR "T_PRE_APP: $T_PRE_APP\n";
311 print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
312 print STDERR "T_POST_LBL: $T_POST_LBL\n";
313 if ( $TargetPlatform =~ /^i386-/ ) {
314     print STDERR "T_X86_PRE_LLBL_PAT: $T_X86_PRE_LLBL_PAT\n";
315     print STDERR "T_X86_PRE_LLBL: $T_X86_PRE_LLBL\n";
316     print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
317 }
318 print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
319 print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
320 print STDERR "T_hsc_cc_PAT: $T_hsc_cc_PAT\n";
321 print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
322 print STDERR "T_HDR_literal: $T_HDR_literal\n";
323 print STDERR "T_HDR_misc: $T_HDR_misc\n";
324 print STDERR "T_HDR_data: $T_HDR_data\n";
325 print STDERR "T_HDR_consist: $T_HDR_consist\n";
326 print STDERR "T_HDR_closure: $T_HDR_closure\n";
327 print STDERR "T_HDR_info: $T_HDR_info\n";
328 print STDERR "T_HDR_entry: $T_HDR_entry\n";
329 print STDERR "T_HDR_fast: $T_HDR_fast\n";
330 print STDERR "T_HDR_vector: $T_HDR_vector\n";
331 print STDERR "T_HDR_direct: $T_HDR_direct\n";
332 }
333
334 }
335 \end{code}
336
337 %************************************************************************
338 %*                                                                      *
339 \subsection{Mangle away}
340 %*                                                                      *
341 %************************************************************************
342
343 \begin{code}
344 sub mangle_asm {
345     local($in_asmf, $out_asmf) = @_;
346
347     # multi-line regexp matching:
348     local($*) = 1;
349     local($i, $c);
350     &init_TARGET_STUFF();
351     &init_FUNNY_THINGS();
352
353     open(INASM, "< $in_asmf")
354         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
355     open(OUTASM,"> $out_asmf")
356         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
357
358     # read whole file, divide into "chunks":
359     #   record some info about what we've found...
360
361     @chk = ();          # contents of the chunk
362     $numchks = 0;       # number of them
363     @chkcat = ();       # what category of thing in each chunk
364     @chksymb = ();      # what symbol(base) is defined in this chunk
365     %slowchk = ();      # ditto, its regular "slow" entry code
366     %fastchk = ();      # ditto, fast entry code
367     %closurechk = ();   # ditto, the (static) closure
368     %infochk = ();      # given a symbol base, say what chunk its info tbl is in
369     %vectorchk = ();    # ditto, return vector table
370     %directchk = ();    # ditto, direct return code
371     $EXTERN_DECLS = ''; # .globl <foo> .text (MIPS only)
372
373     $i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
374
375     while (<INASM>) {
376         next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
377         next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
378         next if /${T_PRE_APP}(NO_)?APP/o;
379
380         next if /^;/ && $TargetPlatform =~ /^hppa/;
381
382         next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^mips-/;
383
384         if ( $TargetPlatform =~ /^mips-/ 
385           && /^\t\.(globl \S+ \.text|comm\t)/ ) {
386             $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
387   
388         } elsif ( /^\s+/ ) { # most common case first -- a simple line!
389             # duplicated from the bottom
390
391             $chk[$i] .= $_;
392
393         } elsif ( /\.\.ng:$/ && $TargetPlatform =~ /^alpha-/ ) {
394             # Alphas: Local labels not to be confused with new chunks
395             $chk[$i] .= $_;
396   
397         # NB: all the rest start with a non-space
398
399         } elsif ( $TargetPlatform =~ /^mips-/
400                && /^\d+:/ ) { # a funny-looking very-local label
401             $chk[$i] .= $_;
402
403         } elsif ( /$T_CONST_LBL/o ) {
404             $chk[++$i]   = $_;
405             $chkcat[$i]  = 'literal';
406             $chksymb[$i] = $1;
407
408         } elsif ( /^${T_US}__stg_split_marker(\d+)${T_POST_LBL}$/o ) {
409             $chk[++$i]   = $_;
410             $chkcat[$i]  = 'splitmarker';
411             $chksymb[$i] = $1;
412
413         } elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/o ) {
414             $symb = $1;
415             $chk[++$i]   = $_;
416             $chkcat[$i]  = 'infotbl';
417             $chksymb[$i] = $symb;
418
419             die "Info table already? $symb; $i\n" if defined($infochk{$symb});
420
421             $infochk{$symb} = $i;
422
423         } elsif ( /^${T_US}([A-Za-z0-9_]+)_entry${T_POST_LBL}$/o ) {
424             $chk[++$i]   = $_;
425             $chkcat[$i]  = 'slow';
426             $chksymb[$i] = $1;
427
428             $slowchk{$1} = $i;
429
430         } elsif ( /^${T_US}([A-Za-z0-9_]+)_fast\d+${T_POST_LBL}$/o ) {
431             $chk[++$i]   = $_;
432             $chkcat[$i]  = 'fast';
433             $chksymb[$i] = $1;
434
435             $fastchk{$1} = $i;
436
437         } elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/o ) {
438             $chk[++$i]   = $_;
439             $chkcat[$i]  = 'closure';
440             $chksymb[$i] = $1;
441
442             $closurechk{$1} = $i;
443
444         } elsif ( /^${T_US}ghc.*c_ID${T_POST_LBL}/o ) {
445             $chk[++$i]  = $_;
446             $chkcat[$i] = 'consist';
447
448         } elsif ( /^(${T_US}__gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/o ) {
449             ; # toss it
450
451         } elsif ( /^${T_US}ErrorIO_call_count${T_POST_LBL}$/o   # HACK!!!!
452                || /^${T_US}[A-Za-z0-9_]+\.\d+${T_POST_LBL}$/o
453                || /^${T_US}.*_CAT${T_POST_LBL}$/o               # PROF: _entryname_CAT
454                || /^${T_US}CC_.*_struct${T_POST_LBL}$/o         # PROF: _CC_ccident_struct
455                || /^${T_US}.*_done${T_POST_LBL}$/o              # PROF: _module_done
456                || /^${T_US}_module_registered${T_POST_LBL}$/o   # PROF: _module_registered
457                ) {
458             $chk[++$i]   = $_;
459             $chkcat[$i]  = 'data';
460             $chksymb[$i] = '';
461
462         } elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) {
463             $chk[++$i]   = $_;
464             $chkcat[$i]  = 'bss';
465             $chksymb[$i] = $1;
466
467         } elsif ( /^${T_US}(ret_|djn_)/o ) {
468             $chk[++$i]   = $_;
469             $chkcat[$i]  = 'misc';
470             $chksymb[$i] = '';
471
472         } elsif ( /^${T_US}vtbl_([A-Za-z0-9_]+)${T_POST_LBL}$/o ) {
473             $chk[++$i]   = $_;
474             $chkcat[$i]  = 'vector';
475             $chksymb[$i] = $1;
476
477             $vectorchk{$1} = $i;
478
479         } elsif ( /^${T_US}([A-Za-z0-9_]+)DirectReturn${T_POST_LBL}$/o ) {
480             $chk[++$i]   = $_;
481             $chkcat[$i]  = 'direct';
482             $chksymb[$i] = $1;
483
484             $directchk{$1} = $i;
485
486         } elsif ( /^${T_US}[A-Za-z0-9_]+_upd${T_POST_LBL}$/o ) {
487             $chk[++$i]   = $_;
488             $chkcat[$i]  = 'misc';
489             $chksymb[$i] = '';
490
491         } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
492              &&   /^(_uname|uname|stat|fstat):/ ) {
493             # for some utterly bizarre reason, this platform
494             # likes to drop little local C routines with these names
495             # into each and every .o file that #includes the
496             # relevant system .h file.  Yuck.  We just don't
497             # tolerate them in .hc files (which we are processing
498             # here).  If you need to call one of these things from
499             # Haskell, make a call to your own C wrapper, then
500             # put that C wrapper (which calls one of these) in a
501             # plain .c file.  WDP 95/12
502             $chk[++$i]   = $_;
503             $chkcat[$i]  = 'toss';
504             $chksymb[$i] = $1;
505
506         } elsif ( /^${T_US}[A-Za-z0-9_]/o
507                 && ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
508                    || /^L\$\d+$/ ) ) {
509             local($thing);
510             chop($thing = $_);
511             print STDERR "Funny global thing?: $_"
512                 unless $KNOWN_FUNNY_THING{$thing}
513                     || /^${T_US}_(PRIn|PRStart).*${T_POST_LBL}$/o # pointer reversal GC routines
514                     || /^${T_US}CC_.*${T_POST_LBL}$/o           # PROF: _CC_ccident
515                     || /^${T_US}_reg.*${T_POST_LBL}$/o;         # PROF: __reg<module>
516             $chk[++$i]   = $_;
517             $chkcat[$i]  = 'misc';
518             $chksymb[$i] = '';
519
520         } else { # simple line (duplicated at the top)
521
522             $chk[$i] .= $_;
523         }
524     }
525     $numchks = $#chk + 1;
526
527     # the division into chunks is imperfect;
528     # we throw some things over the fence into the next
529     # chunk.
530     #
531     # also, there are things we would like to know
532     # about the whole module before we start spitting
533     # output.
534
535     local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
536
537 #   print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n";
538
539     # Alphas: NB: we start meddling at chunk 1, not chunk 0
540     # The first ".rdata" is quite magical; as of GCC 2.7.x, it
541     # spits a ".quad 0" in after the v first ".rdata"; we
542     # detect this special case (tossing the ".quad 0")!
543     local($magic_rdata_seen) = 0;
544   
545     # HPPAs, MIPSen: also start medding at chunk 1
546
547     for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
548         $c = $chk[$i]; # convenience copy
549
550 #       print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
551
552         # toss all prologue stuff; HPPA is pretty weird
553         # (see elsewhere)
554         $c = &mash_hppa_prologue($c) if $TargetPlatform =~ /^hppa/;
555
556         # be slightly paranoid to make sure there's
557         # nothing surprising in there
558         if ( $c =~ /--- BEGIN ---/ ) {
559             if (($p, $r) = split(/--- BEGIN ---/, $c)) {
560
561                 if ($TargetPlatform =~ /^i386-/) {
562                     $p =~ s/^\tpushl \%edi\n//;
563                     $p =~ s/^\tpushl \%esi\n//;
564                     $p =~ s/^\tsubl \$\d+,\%esp\n//;
565                 } elsif ($TargetPlatform =~ /^m68k-/) {
566                     $p =~ s/^\tlink a6,#-?\d.*\n//;
567                     $p =~ s/^\tmovel d2,sp\@-\n//;
568                     $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
569                     $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
570                 } elsif ($TargetPlatform =~ /^mips-/) {
571                     # the .frame/.mask/.fmask that we use is the same
572                     # as that produced by GCC for miniInterpret; this
573                     # gives GDB some chance of figuring out what happened
574                     $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
575                     $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
576                     $p =~ s/^\t\.(mask|fmask).*\n//g;
577                     $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
578                     $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
579                     $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
580                     $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
581                     $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
582                     $p =~ s/__FRAME__/$FRAME/;
583                 } else {
584                     print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
585                 }
586
587                 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
588
589                 # glue together what's left
590                 $c = $p . $r;
591             }
592         }
593
594         # toss all epilogue stuff; again, paranoidly
595         if ( $c =~ /--- END ---/ ) {
596             if (($r, $e) = split(/--- END ---/, $c)) {
597                 if ($TargetPlatform =~ /^i386-/) {
598                     $e =~ s/^\tret\n//;
599                     $e =~ s/^\tpopl \%edi\n//;
600                     $e =~ s/^\tpopl \%esi\n//;
601                     $e =~ s/^\taddl \$\d+,\%esp\n//;
602                 } elsif ($TargetPlatform =~ /^m68k-/) {
603                     $e =~ s/^\tunlk a6\n//;
604                     $e =~ s/^\trts\n//;
605                 } elsif ($TargetPlatform =~ /^mips-/) {
606                     $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
607                     $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
608                     $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
609                     $e =~ s/^\tj\t\$31\n//;
610                 } else {
611                     print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
612                 }
613                 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/;
614
615                 # glue together what's left
616                 $c = $r . $e;
617                 $c =~ s/\n\t\n/\n/; # junk blank line
618             }
619         }
620
621         # On SPARCs, we don't do --- BEGIN/END ---, we just
622         # toss the register-windowing save/restore/ret* instructions
623         # directly:
624         if ( $TargetPlatform =~ /^sparc-/ ) {
625             $c =~ s/^\t(save .*|restore|ret|retl)\n//g;
626             # throw away PROLOGUE comments
627             $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
628         }
629
630         # On Alphas, the prologue mangling is done a little later (below)
631
632         # toss all calls to __DISCARD__
633         $c =~ s/^\t(call|jbsr|jal) ${T_US}__DISCARD__\n//go;
634
635         # MIPS: that may leave some gratuitous asm macros around
636         # (no harm done; but we get rid of them to be tidier)
637         $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/
638             if $TargetPlatform =~ /^mips-/;
639
640         # toss stack adjustment after DoSparks
641         $c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g
642                 if $TargetPlatform =~ /^m68k-/; # this looks old...
643
644         if ( $TargetPlatform =~ /^alpha-/ &&
645            ! $magic_rdata_seen &&
646            $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
647             $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
648             $magic_rdata_seen = 1;
649         }
650
651         # pick some end-things and move them to the next chunk
652
653         # pin a funny end-thing on (for easier matching):
654         $c .= 'FUNNY#END#THING';
655
656         while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/o ) {
657             $to_move = $1;
658
659             if ( $i < ($numchks - 1)
660               && ( $to_move =~ /${T_COPY_DIRVS}/
661                 || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
662                 $chk[$i + 1] = $to_move . $chk[$i + 1];
663                 # otherwise they're tossed
664             }
665
666             $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o;
667         }
668
669         if ( $TargetPlatform =~ /^alpha-/ && $c =~ /^\t\.ent\s+(\S+)/ ) {
670             $ent = $1;
671             # toss all prologue stuff, except for loading gp, and the ..ng address
672             if (($p, $r) = split(/^\t\.prologue/, $c)) {
673                 if (($keep, $junk) = split(/\.\.ng:/, $p)) {
674                     $c = $keep . "..ng:\n";
675                 } else {
676                     print STDERR "malformed code block ($ent)?\n"
677                 }
678             }
679             $c .= "\t.frame \$30,0,\$26,0\n\t.prologue" . $r;
680         }
681   
682         $c =~ s/FUNNY#END#THING//;
683
684 #       print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;
685
686         $chk[$i] = $c; # update w/ convenience copy
687     }
688
689     if ( $TargetPlatform =~ /^alpha-/ ) {
690         # print out the header stuff first
691         $chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
692         print OUTASM $chk[0];
693
694     } elsif ( $TargetPlatform =~ /^hppa/ ) {
695         print OUTASM $chk[0];
696
697     } elsif ( $TargetPlatform =~ /^mips-/ ) {
698         $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
699
700         # get rid of horrible "<dollar>Revision: .*$" strings
701         local(@lines0) = split(/\n/, $chk[0]);
702         local($z) = 0;
703         while ( $z <= $#lines0 ) {
704             if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
705                 undef($lines0[$z]);
706                 $z++;
707                 while ( $z <= $#lines0 ) {
708                     undef($lines0[$z]);
709                     last if $lines0[$z] =~ /[,\t]0x0$/;
710                     $z++;
711                 }
712             }
713             $z++;
714         }
715         $chk[0] = join("\n", @lines0);
716         $chk[0] =~ s/\n\n+/\n/;
717         print OUTASM $chk[0];
718     }
719
720     # print out all the literal strings next
721     for ($i = 0; $i < $numchks; $i++) {
722         if ( $chkcat[$i] eq 'literal' ) {
723             print OUTASM $T_HDR_literal, $chk[$i];
724             print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter
725
726             $chkcat[$i] = 'DONE ALREADY';
727         }
728     }
729
730     # on the HPPA, print out all the bss next
731     if ( $TargetPlatform =~ /^hppa/ ) {
732         for ($i = 1; $i < $numchks; $i++) {
733             if ( $chkcat[$i] eq 'bss' ) {
734                 print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
735                 print OUTASM $chk[$i];
736
737                 $chkcat[$i] = 'DONE ALREADY';
738             }
739         }
740     }
741
742     for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
743 #       print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
744
745         next if $chkcat[$i] eq 'DONE ALREADY';
746
747         if ( $chkcat[$i] eq 'misc' ) {
748             if ($chk[$i] ne '') {
749                 print OUTASM $T_HDR_misc;
750                 &print_doctored($chk[$i], 0);
751             }
752
753         } elsif ( $chkcat[$i] eq 'toss' ) {
754             print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";
755
756         } elsif ( $chkcat[$i] eq 'data' ) {
757             if ($chk[$i] ne '') {
758                 print OUTASM $T_HDR_data;
759                 print OUTASM $chk[$i];
760             }
761
762         } elsif ( $chkcat[$i] eq 'consist' ) {
763             if ( $chk[$i] =~ /$T_hsc_cc_PAT/o ) {
764                 local($consist) = "$1.$2.$3";
765                 $consist =~ s/,/./g;
766                 $consist =~ s/\//./g;
767                 $consist =~ s/-/_/g;
768                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
769                 print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n"
770                     if $TargetPlatform !~ /^mips-/; # we just don't try in that case
771             } else {
772                 print STDERR "Couldn't grok consistency: ", $chk[$i];
773             }
774
775         } elsif ( $chkcat[$i] eq 'splitmarker' ) {
776             # we can just re-constitute this one...
777             # NB: we emit _three_ underscores no matter what,
778             # so ghc-split doesn't have to care.
779             print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
780
781         } elsif ( $chkcat[$i] eq 'closure'
782                || $chkcat[$i] eq 'infotbl'
783                || $chkcat[$i] eq 'slow'
784                || $chkcat[$i] eq 'fast' ) { # do them in that order
785             $symb = $chksymb[$i];
786
787             # CLOSURE
788             if ( defined($closurechk{$symb}) ) {
789                 print OUTASM $T_HDR_closure;
790                 print OUTASM $chk[$closurechk{$symb}];
791                 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
792             }
793
794             # INFO TABLE
795             if ( defined($infochk{$symb}) ) {
796
797                 print OUTASM $T_HDR_info;
798                 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
799                 # entry code will be put here!
800
801                 # paranoia
802                 if ( $chk[$infochk{$symb}] =~ /${T_DOT_WORD}\s+([A-Za-z0-9_]+_entry)$/o
803                   && $1 ne "${T_US}${symb}_entry" ) {
804                     print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
805                 }
806
807                 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
808             }
809
810             # STD ENTRY POINT
811             if ( defined($slowchk{$symb}) ) {
812
813                 # teach it to drop through to the fast entry point:
814                 $c = $chk[$slowchk{$symb}];
815
816                 if ( defined($fastchk{$symb}) ) {
817                     if ( $TargetPlatform =~ /^alpha-/ ) {
818                         $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
819                     } elsif ( $TargetPlatform =~ /^hppa/ ) {
820                         $c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
821                     } elsif ( $TargetPlatform =~ /^i386-/ ) {
822                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%edx\n\tjmp \*\%edx\n//;
823                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%eax\n\tjmp \*\%eax\n//;
824                     } elsif ( $TargetPlatform =~ /^mips-/ ) {
825                         $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
826                     } elsif ( $TargetPlatform =~ /^m68k-/ ) {
827                         $c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n\tnop\n//;
828                         $c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n//;
829                     } elsif ( $TargetPlatform =~ /^sparc-/ ) {
830                         $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n\tnop\n//;
831                         $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n(\t[a-z].*\n)/$1/;
832                     } else {
833                         print STDERR "$Pgm: mystery slow-fast dropthrough: $TargetPlatform\n";
834                     }
835                 }
836
837                 if ( $TargetPlatform !~ /^(alpha-|hppa|mips-)/ ) {
838                     # On alphas, hppa: no very good way to look for "dangling"
839                     # references to fast-entry point.
840                     # (questionable re hppa and mips...)
841                     print STDERR "still has jump to fast entry point:\n$c"
842                         if $c =~ /${T_US}${symb}_fast/; # NB: paranoia
843                 }
844
845                 print OUTASM $T_HDR_entry;
846
847                 &print_doctored($c, 1); # NB: the 1!!!
848
849                 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
850             }
851             
852             # FAST ENTRY POINT
853             if ( defined($fastchk{$symb}) ) {
854                 if ( ! defined($slowchk{$symb})
855                    # ToDo: the || clause can go once we're no longer
856                    # concerned about producing exactly the same output as before
857                    || $TargetPlatform =~ /^(m68k|sparc|i386)-/
858                    ) {
859                     print OUTASM $T_HDR_fast;
860                 }
861                 &print_doctored($chk[$fastchk{$symb}], 0);
862                 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
863             }
864
865         } elsif ( $chkcat[$i] eq 'vector'
866                || $chkcat[$i] eq 'direct' ) { # do them in that order
867             $symb = $chksymb[$i];
868
869             # VECTOR TABLE
870             if ( defined($vectorchk{$symb}) ) {
871                 print OUTASM $T_HDR_vector;
872                 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
873                 # direct return code will be put here!
874                 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
875             }
876
877             # DIRECT RETURN
878             if ( defined($directchk{$symb}) ) {
879                 print OUTASM $T_HDR_direct;
880                 &print_doctored($chk[$directchk{$symb}], 0);
881                 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
882
883             } elsif ( $TargetPlatform =~ /^alpha-/ ) {
884                 # Alphas: the commented nop is for the splitter, to ensure
885                 # that no module ends with a label as the very last
886                 # thing.  (The linker will adjust the label to point
887                 # to the first code word of the next module linked in,
888                 # even if alignment constraints cause the label to move!)
889
890                 print OUTASM "\t# nop\n";
891             }
892             
893         } else {
894             &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
895         }
896     }
897     # finished
898     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
899     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
900 }
901 \end{code}
902
903 \begin{code}
904 sub mash_hppa_prologue { # OK, epilogue, too
905     local($_) = @_;
906
907     # toss all prologue stuff
908     s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;
909
910     # Lie about our .CALLINFO
911     s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;
912
913     # Get rid of P'
914
915     s/LP'/L'/g;
916     s/RP'/R'/g;
917
918     # toss all epilogue stuff
919     s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;
920
921     # Sorry; we moved the _info stuff to the code segment.
922     s/_info,DATA/_info,CODE/g;
923
924     return($_);
925 }
926 \end{code}
927
928 \begin{code}
929 sub print_doctored {
930     local($_, $need_fallthru_patch) = @_;
931
932     if ( $TargetPlatform !~ /^i386-/ 
933       || ! /^\t[a-z]/ ) { # no instructions in here, apparently
934         print OUTASM $_;
935         return;
936     }
937     # OK, must do some x86 **HACKING**
938
939     local($entry_patch) = '';
940     local($exit_patch)  = '';
941     local($call_entry_patch)= '';
942     local($call_exit_patch)     = '';
943
944 #OLD:   # first, convert calls to *very magic form*: (ToDo: document
945     # for real!)  from
946     #
947     #   pushl $768
948     #   call _?PerformGC_wrapper
949     #   addl $4,%esp
950     # to
951     #   movl $768, %eax
952     #   call _?PerformGC_wrapper
953     #
954     # The reason we do this now is to remove the apparent use of
955     # %esp, which would throw off the "what patch code do we need"
956     # decision.
957     #
958     # Special macros in ghc/includes/COptWraps.lh, used in
959     # ghc/runtime/CallWrap_C.lc, are required for this to work!
960     #
961
962     s/^\tpushl \$(\d+)\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \$$1,\%eax\n\tcall ${T_DO_GC}\n/go;
963     s/^\tpushl \%eax\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tcall ${T_DO_GC}\n/go;
964     s/^\tpushl \%edx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%edx,\%eax\n\tcall ${T_DO_GC}\n/go;
965
966 #=  if ( $StolenX86Regs <= 4 ) { # %ecx is ordinary reg
967 #=      s/^\tpushl \%ecx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%ecx,\%eax\n\tcall ${T_DO_GC}\n/go;
968 #=  }
969
970     # gotta watch out for weird instructions that
971     # invisibly smash various regs:
972     #   rep*    %ecx used for counting
973     #   scas*   %edi used for destination index
974     #   cmps*   %e[sd]i used for indices
975     #   loop*   %ecx used for counting
976     #
977     # SIGH.
978
979     # We cater for:
980     #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
981     #
982     #  * GCC used an "STG reg" for its own purposes
983     #
984     #  * some secret uses of machine reg, requiring STG reg
985     #    to be saved/restored
986
987     # The most dangerous "GCC uses" of an "STG reg" are when
988     # the reg holds the target of a jmp -- it's tricky to
989     # insert the patch-up code before we get to the target!
990     # So here we change the jmps:
991
992     # --------------------------------------------------------
993     # it can happen that we have jumps of the form...
994     #   jmp *<something involving %esp>
995     # or
996     #   jmp <something involving another naughty register...>
997     #
998     # a reasonably-common case is:
999     #
1000     #   movl $_blah,<bad-reg>
1001     #   jmp  *<bad-reg>
1002     #
1003     # which is easily fixed as:
1004     #
1005     # sigh! try to hack around it...
1006     #
1007
1008     if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
1009         s/^\tmovl (.*),\%esi\n\tjmp \*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1010         s/^\tjmp \*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1011         s/^\tjmp \*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
1012         die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
1013             if /(jmp|call) .*\%esi/;
1014     }
1015     if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
1016         s/^\tmovl (.*),\%edi\n\tjmp \*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1017         s/^\tjmp \*(-?\d*)\((.*\%edi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1018         s/^\tjmp \*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
1019         die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
1020             if /(jmp|call) .*\%edi/;
1021     }
1022 #=  if ($StolenX86Regs <= 4 ) { # spurious uses of ecx?
1023 #=      s/^\tmovl (.*),\%ecx\n\tjmp \*%ecx\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1024 #=      s/^\tjmp \*(-?\d*)\((.*\%ecx.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1025 #=      s/^\tjmp \*\%ecx\n/\tmovl \%ecx,\%eax\n\tjmp \*\%eax\n/g;
1026 #=      die "$Pgm: (mangler) still have jump involving \%ecx!\n$_"
1027 #=          if /(jmp|call) .*\%ecx/;
1028 #=  }
1029
1030     # OK, now we can decide what our patch-up code is going to
1031     # be:
1032     if ( $StolenX86Regs <= 2
1033          && ( /32\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
1034         $entry_patch .= "\tmovl \%esi,32(\%ebx)\n";
1035         $exit_patch  .= "\tmovl 32(\%ebx),\%esi\n";
1036         # nothing for call_{entry,exit} because %esi is callee-save
1037     }
1038     if ( $StolenX86Regs <= 3
1039          && ( /64\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # SpA (edi)
1040         $entry_patch .= "\tmovl \%edi,64(\%ebx)\n";
1041         $exit_patch  .= "\tmovl 64(\%ebx),\%edi\n";
1042         # nothing for call_{entry,exit} because %edi is callee-save
1043     }
1044 #=  if ( $StolenX86Regs <= 4
1045 #=       && ( /80\(\%ebx\)/ || /\%ecx/ || /^\t(rep|loop)/ ) ) { # Hp (ecx)
1046 #=      $entry_patch .= "\tmovl \%ecx,80(\%ebx)\n";
1047 #=      $exit_patch  .= "\tmovl 80(\%ebx),\%ecx\n";
1048 #=
1049 #=      $call_exit_patch  .= "\tmovl \%ecx,108(\%ebx)\n";
1050 #=      $call_entry_patch .= "\tmovl 108(\%ebx),\%ecx\n";
1051 #=      # I have a really bad feeling about this if we ever
1052 #=      # have a nested call...
1053 #=      # NB: should just hide it somewhere in the C stack.
1054 #=  }
1055     # --------------------------------------------------------
1056     # next, here we go with non-%esp patching!
1057     #
1058     s/^(\t[a-z])/$entry_patch$1/; # before first instruction
1059     s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
1060
1061     # fix _all_ non-local jumps:
1062
1063     s/^\tjmp \*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
1064     s/^\tjmp ${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
1065
1066     s/^(\tjmp .*\n)/$exit_patch$1/g; # here's the fix...
1067
1068     s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/go;
1069     s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/go;
1070
1071     # fix post-PerformGC wrapper (re-)entries ???
1072
1073     if ($StolenX86Regs == 2 ) {
1074         die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_" 
1075             if /^\t(jmp|call) .*\%e(si|di)/;
1076 #=      die "ARGH! Jump uses \%esi, \%edi, or \%ecx with -monly-2-regs:\n$_" 
1077 #=          if /^\t(jmp|call) .*\%e(si|di|cx)/;
1078     } elsif ($StolenX86Regs == 3 ) {
1079         die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_" 
1080             if /^\t(jmp|call) .*\%edi/;
1081 #=      die "ARGH! Jump uses \%edi or \%ecx with -monly-3-regs:\n$_" 
1082 #=          if /^\t(jmp|call) .*\%e(di|cx)/;
1083 #=  } elsif ($StolenX86Regs == 4 ) {
1084 #=      die "ARGH! Jump uses \%ecx with -monly-4-regs:\n$_" 
1085 #=          if /^\t(jmp|call) .*\%ecx/;
1086     }
1087
1088     # final peephole fixes
1089
1090     s/^\tmovl \%eax,36\(\%ebx\)\n\tjmp \*36\(\%ebx\)\n/\tmovl \%eax,36\(\%ebx\)\n\tjmp \*\%eax\n/;
1091     s/^\tmovl \$_(.*),(\%e[abcd]x)\n\tjmp \*$2/\tjmp _$1/g;
1092
1093     # Hacks to eliminate some reloads of Hp.  Worth about 5% code size.
1094     # We could do much better than this, but at least it catches about
1095     # half of the unnecessary reloads.
1096     # Note that these will stop working if either:
1097     #  (i) the offset of Hp from BaseReg changes from 80, or
1098     #  (ii) the register assignment of BaseReg changes from %ebx
1099
1100     s/^\tmovl 80\(\%ebx\),\%e.x\n\tmovl \$(.*),(-?[0-9]*)\(\%e.x\)\n\tmovl 80\(\%ebx\),\%e(.)x/\tmovl 80\(\%ebx\),\%e$3x\n\tmovl \$$1,$2\(\%e$3x\)/g;
1101
1102     s/^\tmovl 80\(\%ebx\),\%e(.)x\n\tmovl (.*),\%e(.)x\n\tmovl \%e$3x,(-?[0-9]*\(\%e$1x\))\n\tmovl 80\(\%ebx\),\%e$1x/\tmovl 80\(\%ebx\),\%e$1x\n\tmovl $2,\%e$3x\n\tmovl \%e$3x,$4/g;
1103
1104     s/^\tmovl 80\(\%ebx\),\%edx((\n\t(movl|addl) .*,((-?[0-9]*\(.*)|(\%e[abc]x)))+)\n\tmovl 80\(\%ebx\),\%edx/\tmovl 80\(\%ebx\),\%edx$1/g;
1105     s/^\tmovl 80\(\%ebx\),\%eax((\n\t(movl|addl) .*,((-?[0-9]*\(.*)|(\%e[bcd]x)))+)\n\tmovl 80\(\%ebx\),\%eax/\tmovl 80\(\%ebx\),\%eax$1/g;
1106
1107     # --------------------------------------------------------
1108     # that's it -- print it
1109     #
1110     #die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
1111
1112     print OUTASM $_;
1113
1114     if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
1115         print OUTASM $exit_patch;
1116         # ToDo: make it not print if there is a "jmp" at the end
1117     }
1118 }
1119 \end{code}
1120
1121 \begin{code}
1122 sub init_FUNNY_THINGS {
1123     %KNOWN_FUNNY_THING = (
1124         "${T_US}CheckHeapCode${T_POST_LBL}", 1,
1125         "${T_US}CommonUnderflow${T_POST_LBL}", 1,
1126         "${T_US}Continue${T_POST_LBL}", 1,
1127         "${T_US}EnterNodeCode${T_POST_LBL}", 1,
1128         "${T_US}ErrorIO_call_count${T_POST_LBL}", 1,
1129         "${T_US}ErrorIO_innards${T_POST_LBL}", 1,
1130         "${T_US}IndUpdRetDir${T_POST_LBL}", 1,
1131         "${T_US}IndUpdRetV0${T_POST_LBL}", 1,
1132         "${T_US}IndUpdRetV1${T_POST_LBL}", 1,
1133         "${T_US}IndUpdRetV2${T_POST_LBL}", 1,
1134         "${T_US}IndUpdRetV3${T_POST_LBL}", 1,
1135         "${T_US}IndUpdRetV4${T_POST_LBL}", 1,
1136         "${T_US}IndUpdRetV5${T_POST_LBL}", 1,
1137         "${T_US}IndUpdRetV6${T_POST_LBL}", 1,
1138         "${T_US}IndUpdRetV7${T_POST_LBL}", 1,
1139         "${T_US}PrimUnderflow${T_POST_LBL}", 1,
1140         "${T_US}StackUnderflowEnterNode${T_POST_LBL}", 1,
1141         "${T_US}StdErrorCode${T_POST_LBL}", 1,
1142         "${T_US}UnderflowVect0${T_POST_LBL}", 1,
1143         "${T_US}UnderflowVect1${T_POST_LBL}", 1,
1144         "${T_US}UnderflowVect2${T_POST_LBL}", 1,
1145         "${T_US}UnderflowVect3${T_POST_LBL}", 1,
1146         "${T_US}UnderflowVect4${T_POST_LBL}", 1,
1147         "${T_US}UnderflowVect5${T_POST_LBL}", 1,
1148         "${T_US}UnderflowVect6${T_POST_LBL}", 1,
1149         "${T_US}UnderflowVect7${T_POST_LBL}", 1,
1150         "${T_US}UpdErr${T_POST_LBL}", 1,
1151         "${T_US}UpdatePAP${T_POST_LBL}", 1,
1152         "${T_US}WorldStateToken${T_POST_LBL}", 1,
1153         "${T_US}_Enter_Internal${T_POST_LBL}", 1,
1154         "${T_US}_PRMarking_MarkNextAStack${T_POST_LBL}", 1,
1155         "${T_US}_PRMarking_MarkNextBStack${T_POST_LBL}", 1,
1156         "${T_US}_PRMarking_MarkNextCAF${T_POST_LBL}", 1,
1157         "${T_US}_PRMarking_MarkNextGA${T_POST_LBL}", 1,
1158         "${T_US}_PRMarking_MarkNextRoot${T_POST_LBL}", 1,
1159         "${T_US}_PRMarking_MarkNextSpark${T_POST_LBL}", 1,
1160         "${T_US}_Scavenge_Forward_Ref${T_POST_LBL}", 1,
1161         "${T_US}__std_entry_error__${T_POST_LBL}", 1,
1162         "${T_US}_startMarkWorld${T_POST_LBL}", 1,
1163         "${T_US}resumeThread${T_POST_LBL}", 1,
1164         "${T_US}startCcRegisteringWorld${T_POST_LBL}", 1,
1165         "${T_US}startEnterFloat${T_POST_LBL}", 1,
1166         "${T_US}startEnterInt${T_POST_LBL}", 1,
1167         "${T_US}startPerformIO${T_POST_LBL}", 1,
1168         "${T_US}startStgWorld${T_POST_LBL}", 1,
1169         "${T_US}stopPerformIO${T_POST_LBL}", 1
1170     );
1171 }
1172 \end{code}
1173
1174 The following table reversal is used for both info tables and return
1175 vectors.  In both cases, we remove the first entry from the table,
1176 reverse the table, put the label at the end, and paste some code
1177 (that which is normally referred to by the first entry in the table)
1178 right after the table itself.  (The code pasting is done elsewhere.)
1179
1180 \begin{code}
1181 sub rev_tbl {
1182     local($symb, $tbl, $discard1) = @_;
1183
1184     local($before) = '';
1185     local($label) = '';
1186     local(@imports) = (); # hppa only
1187     local(@words) = ();
1188     local($after) = '';
1189     local(@lines) = split(/\n/, $tbl);
1190     local($i, $extra, $words_to_pad, $j);
1191
1192     for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t${T_DOT_WORD}\s+/o; $i++) {
1193         $label .= $lines[$i] . "\n",
1194             next if $lines[$i] =~ /^[A-Za-z0-9_]+_info${T_POST_LBL}$/o
1195                  || $lines[$i] =~ /^${T_DOT_GLOBAL}/o
1196                  || $lines[$i] =~ /^${T_US}vtbl_\S+${T_POST_LBL}$/o;
1197
1198         $before .= $lines[$i] . "\n"; # otherwise...
1199     }
1200
1201     if ( $TargetPlatform !~ /^hppa/ ) {
1202         for ( ; $i <= $#lines && $lines[$i] =~ /^\t${T_DOT_WORD}\s+/o; $i++) {
1203             push(@words, $lines[$i]);
1204         }
1205     } else { # hppa weirdness
1206         for ( ; $i <= $#lines && $lines[$i] =~ /^\s+\.(word|IMPORT)/; $i++) {
1207             if ($lines[$i] =~ /^\s+\.IMPORT/) {
1208                 push(@imports, $lines[$i]);
1209             } else {
1210                 # We don't use HP's ``function pointers''
1211                 # We just use labels in code space, like normal people
1212                 $lines[$i] =~ s/P%//;
1213                 push(@words, $lines[$i]);
1214             }
1215         }
1216     }
1217
1218     # now throw away the first word (entry code):
1219     shift(@words) if $discard1;
1220
1221 # Padding removed to reduce code size and improve performance on Pentiums.
1222 # Simon M. 13/4/96
1223     # for 486-cache-friendliness, we want our tables aligned
1224     # on 16-byte boundaries (.align 4).  Let's pad:
1225 #    $extra = ($#words + 1) % 4;
1226 #    $words_to_pad = ($extra == 0) ? 0 : 4 - $extra;
1227 #    for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t${T_DOT_WORD} 0"); }
1228
1229     for (; $i <= $#lines; $i++) {
1230         $after .= $lines[$i] . "\n";
1231     }
1232
1233     # Alphas:If we have anonymous text (not part of a procedure), the
1234     # linker may complain about missing exception information.  Bleh.
1235     if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
1236         $before = "\t.ent $1\n" . $before;
1237         $after .= "\t.end $1\n";
1238     }
1239
1240     $tbl = $before
1241          . (($TargetPlatform !~ /^hppa/) ? '' : join("\n", @imports) . "\n")
1242          . join("\n", (reverse @words)) . "\n"
1243          . $label . $after;
1244
1245 #   print STDERR "before=$before\n";
1246 #   print STDERR "label=$label\n";
1247 #   print STDERR "words=",(reverse @words),"\n";
1248 #   print STDERR "after=$after\n";
1249
1250     $tbl;
1251 }
1252 \end{code}
1253
1254 \begin{code}
1255 sub mini_mangle_asm_i386 {
1256     local($in_asmf, $out_asmf) = @_;
1257
1258     &init_TARGET_STUFF();
1259
1260     open(INASM, "< $in_asmf")
1261         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1262     open(OUTASM,"> $out_asmf")
1263         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1264
1265     while (<INASM>) {
1266         print OUTASM;
1267
1268         next unless
1269             /^${T_US}(PerformGC|StackOverflow|Yield|PerformReschedule)_wrapper${T_POST_LBL}\n/o;
1270         print OUTASM "\tmovl \%esp, ${T_US}__temp_esp\n";
1271         print OUTASM "\tmovl \%eax, ${T_US}__temp_eax\n";
1272     }
1273
1274     # finished:
1275     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1276     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1277 }
1278 \end{code}
1279
1280 The HP is a major nuisance.  The threaded code mangler moved info
1281 tables from data space to code space, but unthreaded code in the RTS
1282 still has references to info tables in data space.  Since the HP
1283 linker is very precise about where symbols live, we need to patch the
1284 references in the unthreaded RTS as well.
1285
1286 \begin{code}
1287 sub mini_mangle_asm_hppa {
1288     local($in_asmf, $out_asmf) = @_;
1289
1290     open(INASM, "< $in_asmf")
1291         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1292     open(OUTASM,"> $out_asmf")
1293         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1294
1295     while (<INASM>) {
1296         s/_info,DATA/_info,CODE/;   # Move _info references to code space
1297         s/P%_PR/_PR/;
1298         print OUTASM;
1299     }
1300
1301     # finished:
1302     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1303     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1304 }
1305
1306 # make "require"r happy...
1307 1;
1308 \end{code}