1 %************************************************************************
3 \section[Driver-asm-fiddling]{Fiddling with assembler files}
5 %************************************************************************
10 Utterly stomp out C functions' prologues and epilogues; i.e., the
11 stuff to do with the C stack.
13 Any other required tidying up.
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.
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.
43 %************************************************************************
45 \subsection{Constants for various architectures}
47 %************************************************************************
50 sub init_TARGET_STUFF {
52 #--------------------------------------------------------#
53 if ( $TargetPlatform =~ /^alpha-.*-.*/ ) {
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
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))';
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";
79 #--------------------------------------------------------#
80 } elsif ( $TargetPlatform =~ /^hppa/ ) {
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
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)';
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";
106 #--------------------------------------------------------#
107 } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd|nextstep3|cygwin32)/ ) {
108 # NeXT added but not tested. CaS
110 $T_STABBY = 1; # 1 iff .stab things (usually if a.out format)
111 $T_US = '_'; # _ if symbols have an underscore on the front
112 $T_DO_GC = '_PerformGC_wrapper';
113 $T_PRE_APP = '^#'; # regexp that says what comes before APP/NO_APP
114 $T_CONST_LBL = '^LC(\d+):$';
116 $T_X86_PRE_LLBL_PAT = 'L';
117 $T_X86_PRE_LLBL = 'L';
118 $T_X86_BADJMP = '^\tjmp [^L\*]';
120 $T_MOVE_DIRVS = '^(\s*(\.align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*)\n)';
121 $T_COPY_DIRVS = '\.(globl|stab)';
122 $T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
123 $T_DOT_WORD = '\.long';
124 $T_DOT_GLOBAL = '\.globl';
125 $T_HDR_literal = "\.text\n\t\.align 2\n";
126 $T_HDR_misc = "\.text\n\t\.align 2,0x90\n";
127 $T_HDR_data = "\.data\n\t\.align 2\n";
128 $T_HDR_consist = "\.text\n";
129 $T_HDR_closure = "\.data\n\t\.align 2\n";
130 $T_HDR_info = "\.text\n\t\.align 2\n"; # NB: requires padding
131 $T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
132 $T_HDR_fast = "\.text\n\t\.align 2,0x90\n";
133 $T_HDR_vector = "\.text\n\t\.align 2\n"; # NB: requires padding
134 $T_HDR_direct = "\.text\n\t\.align 2,0x90\n";
136 #--------------------------------------------------------#
137 } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux)$/ ) {
139 $T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
140 $T_US = ''; # _ if symbols have an underscore on the front
141 $T_DO_GC = 'PerformGC_wrapper';
142 $T_PRE_APP = # regexp that says what comes before APP/NO_APP
143 ($TargetPlatform =~ /-linux$/) ? '#' : '/' ;
144 $T_CONST_LBL = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
146 $T_X86_PRE_LLBL_PAT = '\.L';
147 $T_X86_PRE_LLBL = '.L';
148 $T_X86_BADJMP = '^\tjmp [^\.\*]';
150 $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)';
151 $T_COPY_DIRVS = '\.(globl)';
153 $T_hsc_cc_PAT = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
154 $T_DOT_WORD = '\.long';
155 $T_DOT_GLOBAL = '\.globl';
156 $T_HDR_literal = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
157 $T_HDR_misc = "\.text\n\t\.align 16\n";
158 $T_HDR_data = "\.data\n\t\.align 4\n"; # ToDo: change align??
159 $T_HDR_consist = "\.text\n";
160 $T_HDR_closure = "\.data\n\t\.align 4\n"; # ToDo: change align?
161 $T_HDR_info = "\.text\n\t\.align 16\n"; # NB: requires padding
162 $T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
163 $T_HDR_fast = "\.text\n\t\.align 16\n";
164 $T_HDR_vector = "\.text\n\t\.align 16\n"; # NB: requires padding
165 $T_HDR_direct = "\.text\n\t\.align 16\n";
167 #--------------------------------------------------------#
168 } elsif ( $TargetPlatform =~ /^m68k-.*-sunos4/ ) {
170 $T_STABBY = 1; # 1 iff .stab things (usually if a.out format)
171 $T_US = '_'; # _ if symbols have an underscore on the front
172 $T_DO_GC = '_PerformGC_wrapper';
173 $T_PRE_APP = '^# MAY NOT APPLY'; # regexp that says what comes before APP/NO_APP
174 $T_CONST_LBL = '^LC(\d+):$';
177 $T_MOVE_DIRVS = '^(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
178 $T_COPY_DIRVS = '\.(globl|proc|stab)';
179 $T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
181 $T_DOT_WORD = '\.long';
182 $T_DOT_GLOBAL = '\.globl';
183 $T_HDR_literal = "\.text\n\t\.even\n";
184 $T_HDR_misc = "\.text\n\t\.even\n";
185 $T_HDR_data = "\.data\n\t\.even\n";
186 $T_HDR_consist = "\.text\n";
187 $T_HDR_closure = "\.data\n\t\.even\n";
188 $T_HDR_info = "\.text\n\t\.even\n";
189 $T_HDR_entry = "\.text\n\t\.even\n";
190 $T_HDR_fast = "\.text\n\t\.even\n";
191 $T_HDR_vector = "\.text\n\t\.even\n";
192 $T_HDR_direct = "\.text\n\t\.even\n";
194 #--------------------------------------------------------#
195 } elsif ( $TargetPlatform =~ /^mips-.*/ ) {
197 $T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
198 $T_US = ''; # _ if symbols have an underscore on the front
199 $T_DO_GC = 'PerformGC_wrapper';
200 $T_PRE_APP = '^\s*#'; # regexp that says what comes before APP/NO_APP
201 $T_CONST_LBL = '^\$LC(\d+):$'; # regexp for what such a lbl looks like
204 $T_MOVE_DIRVS = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
205 $T_COPY_DIRVS = '\.(globl|ent)';
207 $T_hsc_cc_PAT = 'I WAS TOO LAZY TO DO THIS BIT (WDP 95/05)';
208 $T_DOT_WORD = '\.word';
209 $T_DOT_GLOBAL = '^\t\.globl';
210 $T_HDR_literal = "\t\.rdata\n\t\.align 2\n";
211 $T_HDR_misc = "\t\.text\n\t\.align 2\n";
212 $T_HDR_data = "\t\.data\n\t\.align 2\n";
213 $T_HDR_consist = 'TOO LAZY TO DO THIS TOO';
214 $T_HDR_closure = "\t\.data\n\t\.align 2\n";
215 $T_HDR_info = "\t\.text\n\t\.align 2\n";
216 $T_HDR_entry = "\t\.text\n\t\.align 2\n";
217 $T_HDR_fast = "\t\.text\n\t\.align 2\n";
218 $T_HDR_vector = "\t\.text\n\t\.align 2\n";
219 $T_HDR_direct = "\t\.text\n\t\.align 2\n";
221 #--------------------------------------------------------#
222 } elsif ( $TargetPlatform =~ /^powerpc-.*|^rs6000-.*/ ) {
224 $T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
225 $T_US = ''; # _ if symbols have an underscore on the front
226 $T_DO_GC = '\.PerformGC_wrapper';
227 $T_PRE_APP = 'NOT APPLICABLE'; # regexp that says what comes before APP/NO_APP
228 $T_CONST_LBL = 'NOT APPLICABLE'; # regexp for what such a lbl looks like
231 $T_MOVE_DIRVS = '^(\s*(\.toc|\.align \d+|\.csect \S+|\t\.?l?globl \S+)\n)';
232 $T_COPY_DIRVS = '\.(l?globl)';
234 $T_hsc_cc_PAT = '\.byte.*\)(hsc|cc) (.*)"\n\t\.byte \d+\n\t\.byte "(.*)"\n\t\.byte \d+';
235 $T_DOT_WORD = '\.long';
236 $T_DOT_GLOBAL = '\.globl';
237 $T_HDR_toc = "\.toc\n";
238 $T_HDR_literal = "\.csect .data[RW]\n\t\.align 2\n"; #not RO!?
239 $T_HDR_misc = "# misc\n\.csect \.text[PR]\n\t\.align 2\n";
240 $T_HDR_data = "# data\n\.csect \.data[RW]\n\t\.align 2\n";
241 $T_HDR_consist = "# consist\n\.csect \.data[RW]\n\t\.align 2\n";
242 $T_HDR_closure = "# closure\n\.csect \.data[RW]\n\t\.align 2\n";
243 $T_HDR_info = "# info\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!?
244 $T_HDR_entry = "# entry\n\.csect \.text[PR]\n\t\.align 2\n";
245 $T_HDR_fast = "# fast\n\.csect \.text[PR]\n\t\.align 2\n";
246 $T_HDR_vector = "# vector\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!?
247 $T_HDR_direct = "# direct\n";
249 #--------------------------------------------------------#
250 } elsif ( $TargetPlatform =~ /^sparc-.*-solaris2/ ) {
252 $T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
253 $T_US = ''; # _ if symbols have an underscore on the front
254 $T_DO_GC = 'PerformGC_wrapper';
255 $T_PRE_APP = 'DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
256 $T_CONST_LBL = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
259 $T_MOVE_DIRVS = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*|\.section.*|\s+\.type.*|\s+\.size.*)\n)';
260 $T_COPY_DIRVS = '\.(global|proc|stab)';
262 $T_hsc_cc_PAT = '\.asciz.*\)(hsc|cc) (.*)\\\\t(.*)"';
263 $T_DOT_WORD = '\.word';
264 $T_DOT_GLOBAL = '^\t\.global';
265 $T_HDR_literal = "\.text\n\t\.align 8\n";
266 $T_HDR_misc = "\.text\n\t\.align 4\n";
267 $T_HDR_data = "\.data\n\t\.align 8\n";
268 $T_HDR_consist = "\.text\n";
269 $T_HDR_closure = "\.data\n\t\.align 4\n";
270 $T_HDR_info = "\.text\n\t\.align 4\n";
271 $T_HDR_entry = "\.text\n\t\.align 4\n";
272 $T_HDR_fast = "\.text\n\t\.align 4\n";
273 $T_HDR_vector = "\.text\n\t\.align 4\n";
274 $T_HDR_direct = "\.text\n\t\.align 4\n";
276 #--------------------------------------------------------#
277 } elsif ( $TargetPlatform =~ /^sparc-.*-sunos4/ ) {
279 $T_STABBY = 1; # 1 iff .stab things (usually if a.out format)
280 $T_US = '_'; # _ if symbols have an underscore on the front
281 $T_DO_GC = '_PerformGC_wrapper';
282 $T_PRE_APP = '^# DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
283 $T_CONST_LBL = '^LC(\d+):$';
286 $T_MOVE_DIRVS = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*)\n)';
287 $T_COPY_DIRVS = '\.(global|proc|stab)';
288 $T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
290 $T_DOT_WORD = '\.word';
291 $T_DOT_GLOBAL = '^\t\.global';
292 $T_HDR_literal = "\.text\n\t\.align 8\n";
293 $T_HDR_misc = "\.text\n\t\.align 4\n";
294 $T_HDR_data = "\.data\n\t\.align 8\n";
295 $T_HDR_consist = "\.text\n";
296 $T_HDR_closure = "\.data\n\t\.align 4\n";
297 $T_HDR_info = "\.text\n\t\.align 4\n";
298 $T_HDR_entry = "\.text\n\t\.align 4\n";
299 $T_HDR_fast = "\.text\n\t\.align 4\n";
300 $T_HDR_vector = "\.text\n\t\.align 4\n";
301 $T_HDR_direct = "\.text\n\t\.align 4\n";
303 #--------------------------------------------------------#
305 print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n";
310 print STDERR "T_STABBY: $T_STABBY\n";
311 print STDERR "T_US: $T_US\n";
312 print STDERR "T_DO_GC: $T_DO_GC\n";
313 print STDERR "T_PRE_APP: $T_PRE_APP\n";
314 print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
315 print STDERR "T_POST_LBL: $T_POST_LBL\n";
316 if ( $TargetPlatform =~ /^i386-/ ) {
317 print STDERR "T_X86_PRE_LLBL_PAT: $T_X86_PRE_LLBL_PAT\n";
318 print STDERR "T_X86_PRE_LLBL: $T_X86_PRE_LLBL\n";
319 print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
321 print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
322 print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
323 print STDERR "T_hsc_cc_PAT: $T_hsc_cc_PAT\n";
324 print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
325 print STDERR "T_HDR_literal: $T_HDR_literal\n";
326 print STDERR "T_HDR_misc: $T_HDR_misc\n";
327 print STDERR "T_HDR_data: $T_HDR_data\n";
328 print STDERR "T_HDR_consist: $T_HDR_consist\n";
329 print STDERR "T_HDR_closure: $T_HDR_closure\n";
330 print STDERR "T_HDR_info: $T_HDR_info\n";
331 print STDERR "T_HDR_entry: $T_HDR_entry\n";
332 print STDERR "T_HDR_fast: $T_HDR_fast\n";
333 print STDERR "T_HDR_vector: $T_HDR_vector\n";
334 print STDERR "T_HDR_direct: $T_HDR_direct\n";
340 %************************************************************************
342 \subsection{Mangle away}
344 %************************************************************************
348 local($in_asmf, $out_asmf) = @_;
350 # multi-line regexp matching:
355 &init_TARGET_STUFF();
356 &init_FUNNY_THINGS();
358 # perl4 on alphas SEGVs when give ${foo} substitutions in patterns.
359 # To avoid them we declare some locals that allows to avoid using curlies.
360 local($TUS) = ${T_US};
361 local($TPOSTLBL) = ${T_POST_LBL};
362 local($TMOVEDIRVS) = ${T_MOVE_DIRVS};
363 local($TPREAPP) = ${T_PRE_APP};
364 local($TCOPYDIRVS) = ${T_COPY_DIRVS};
365 local($TDOTWORD) = ${T_DOT_WORD};
367 open(INASM, "< $in_asmf")
368 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
369 open(OUTASM,"> $out_asmf")
370 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
372 # read whole file, divide into "chunks":
373 # record some info about what we've found...
375 @chk = (); # contents of the chunk
376 $numchks = 0; # number of them
377 @chkcat = (); # what category of thing in each chunk
378 @chksymb = (); # what symbol(base) is defined in this chunk
379 %slowchk = (); # ditto, its regular "slow" entry code
380 %fastchk = (); # ditto, fast entry code
381 %closurechk = (); # ditto, the (static) closure
382 %infochk = (); # given a symbol base, say what chunk its info tbl is in
383 %vectorchk = (); # ditto, return vector table
384 %directchk = (); # ditto, direct return code
385 $EXTERN_DECLS = ''; # .globl <foo> .text (MIPS only)
387 $i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
390 next if $T_STABBY && /^\.stab.*$TUS[@]?__stg_split_marker/o;
391 next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
392 next if /$TPREAPP(NO_)?APP/o;
393 next if /^;/ && $TargetPlatform =~ /^hppa/;
395 next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc|rs6000)-/;
397 last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-|^rs6000-/;
399 if ( $TargetPlatform =~ /^mips-/
400 && /^\t\.(globl \S+ \.text|comm\t)/ ) {
401 $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
403 } elsif ( /^\s+/ ) { # most common case first -- a simple line!
404 # duplicated from the bottom
408 } elsif ( /\.\.ng:$/ && $TargetPlatform =~ /^alpha-/ ) {
409 # Alphas: Local labels not to be confused with new chunks
412 # NB: all the rest start with a non-space
414 } elsif ( $TargetPlatform =~ /^mips-/
415 && /^\d+:/ ) { # a funny-looking very-local label
418 } elsif ( /$T_CONST_LBL/o ) {
420 $chkcat[$i] = 'literal';
423 } elsif ( /^$TUS[@]?__stg_split_marker(\d+)$TPOSTLBL[@]?$/o ) {
425 $chkcat[$i] = 'splitmarker';
428 } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_info$TPOSTLBL[@]?$/o ) {
431 $chkcat[$i] = 'infotbl';
432 $chksymb[$i] = $symb;
434 die "Info table already? $symb; $i\n" if defined($infochk{$symb});
436 $infochk{$symb} = $i;
438 } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_entry$TPOSTLBL[@]?$/o ) {
440 $chkcat[$i] = 'slow';
445 } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_fast\d+$TPOSTLBL[@]?$/o ) {
447 $chkcat[$i] = 'fast';
452 } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_closure$TPOSTLBL[@]?$/o ) {
454 $chkcat[$i] = 'closure';
457 $closurechk{$1} = $i;
459 } elsif ( /^$TUS[@]?ghc.*c_ID$TPOSTLBL/o ) {
461 $chkcat[$i] = 'consist';
463 } elsif ( /^($TUS[@]?__gnu_compiled_c|gcc2_compiled\.)$TPOSTLBL/o ) {
466 } elsif ( /^$TUS[@]?ErrorIO_call_count$TPOSTLBL[@]?$/o # HACK!!!!
467 || /^$TUS[A-Za-z0-9_]+\.\d+$TPOSTLBL[@]?$/o
468 || /^$TUS[@]?.*_CAT$TPOSTLBL[@]?$/o # PROF: _entryname_CAT
469 || /^$TUS[@]?CC_.*_struct$TPOSTLBL[@]?$/o # PROF: _CC_ccident_struct
470 || /^$TUS[@]?.*_done$TPOSTLBL[@]?$/o # PROF: _module_done
471 || /^$TUS[@]?_module_registered$TPOSTLBL[@]?$/o # PROF: _module_registered
474 $chkcat[$i] = 'data';
477 } elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) {
482 } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ && /^LC\.\.([0-9]+)/ ) {
487 } elsif ( /^($TUS[@]?(ret_|djn_)[A-Za-z0-9_]+)/o ) {
489 $chkcat[$i] = 'misc';
492 $chksymb[$i] = $symbtmp if ($TargetPlatform =~ /^powerpc-|^rs6000-/) ; #rm andre
494 } elsif ( /^$TUS[@]?vtbl_([A-Za-z0-9_]+)$TPOSTLBL[@]?$/o ) {
496 $chkcat[$i] = 'vector';
501 } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)DirectReturn$TPOSTLBL[@]?$/o ) {
503 $chkcat[$i] = 'direct';
508 } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_upd$TPOSTLBL[@]?$/o ) {
510 $chkcat[$i] = 'misc';
511 print STDERR "_upd!!!!! I guess this code is dead!!!!\n";
512 # I guess this is never entered, since all _upds are
513 # either vtbl_'s or ret_'s, caught above. - andre
515 # if ($TargetPlatform =~ /^powerpc-/)
516 # { $chksymb[$i] = $symbtmp;}
517 # else { $chksymb[$i] = ''; };
520 } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
521 && /^(_uname|uname|stat|fstat):/ ) {
522 # for some utterly bizarre reason, this platform
523 # likes to drop little local C routines with these names
524 # into each and every .o file that #includes the
525 # relevant system .h file. Yuck. We just don't
526 # tolerate them in .hc files (which we are processing
527 # here). If you need to call one of these things from
528 # Haskell, make a call to your own C wrapper, then
529 # put that C wrapper (which calls one of these) in a
530 # plain .c file. WDP 95/12
532 $chkcat[$i] = 'toss';
535 } elsif ( /^$TUS[@]?[A-Za-z0-9_]/o
536 && ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
538 && ( $TargetPlatform !~ /^powerpc|^rs6000/ # ditto
539 || ! /^(L\.\.\d+|LT\.\..*):$/ ) ) {
542 print STDERR "Funny global thing?: $_"
543 unless $KNOWN_FUNNY_THING{$thing}
544 || /^$TUS[@]?_(PRIn|PRStart).*$TPOSTLBL[@]?$/o # pointer reversal GC routines
545 || /^$TUS[@]?CC_.*$TPOSTLBL$/o # PROF: _CC_ccident ([@]? is a silly hack (see above))
546 || /^$TUS[@]?_reg.*$TPOSTLBL$/o; # PROF: __reg<module>
548 $chkcat[$i] = 'misc';
549 if ($TargetPlatform =~ /^powerpc-|^rs6000-/)
550 { $chksymb[$i] = $thing; }
551 else { $chksymb[$i] = ''; };
553 } else { # simple line (duplicated at the top)
558 $numchks = $#chk + 1;
560 # the division into chunks is imperfect;
561 # we throw some things over the fence into the next
564 # also, there are things we would like to know
565 # about the whole module before we start spitting
568 local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
570 # print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n";
572 # Alphas: NB: we start meddling at chunk 1, not chunk 0
573 # The first ".rdata" is quite magical; as of GCC 2.7.x, it
574 # spits a ".quad 0" in after the v first ".rdata"; we
575 # detect this special case (tossing the ".quad 0")!
576 local($magic_rdata_seen) = 0;
578 # HPPAs, MIPSen: also start medding at chunk 1
580 # AIX hack for the moment, to join up multiple identical tocs
581 if ($TargetPlatform =~ /^powerpc|^rs6000/) {
582 print OUTASM $T_HDR_toc; # yes, we have to put a .toc
583 # in the beginning of every file!
584 %tocequiv = (); # maps toc symbol number to toc symbol
585 %revtocequiv = (); # maps toc symbol to toc symbol number
586 for ($i = 1; $i < $numchks; $i++) {
587 $chk[$i] =~ s/\[RW\]//g;
588 $chk[$i] =~ s/\[DS\]//g;
589 $chk[$i] =~ s/^\.csect .*\[DS\]$//g;
590 if ( $chkcat[$i] eq 'toc' && $chk[$i] !~ /\.byte/ )
591 { $chk[$i] =~ s/$T_MOVE_DIRVS//g;
592 $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(\S+_fast\d+)/\t\.tc \1\[TC\],\.\2/;
593 $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(\S+_entry)\n/\t\.tc \1\[TC\],\.\2\n/;
594 $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(ret_\S+)/\t\.tc \1\[TC\],\.\2/;
595 $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(djn_\S+)/\t\.tc \1\[TC\],\.\2/;
596 $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(vtbl_\S+)/\t\.tc \1\[TC\],\.\2/;
597 $chk[$i] =~ s/\t\.tc (\S+)\[TC\],ErrorIO_innards/\t\.tc \1\[TC\],\.ErrorIO_innards/;
598 $chk[$i] =~ s/\t\.tc (\S+)\[TC\],startStgWorld/\t\.tc \1\[TC\],\.startStgWorld/;
599 $chk[$i] =~ s/\.tc UpdatePAP\[TC\],UpdatePAP/\.tc UpdatePAP\[TC\],\.UpdatePAP/;
600 $chk[$i] =~ s/\.tc IndUpdRetDir\[TC\],IndUpdRetDir/\.tc IndUpdRetDir\[TC\],\.IndUpdRetDir/;
601 $chk[$i] =~ s/\t\.tc (_PRStart_\S+)\[TC\],_PRStart_\S+/\t\.tc \1\[TC\],\.\1/;
603 $tocnumber = $chksymb[$i];
605 $tocsymb =~ s/^LC\.\.\d+:\n//;
606 $tocsymb =~ s/^\t\.tc \S+,(\S+)\n/\1/;
607 $tocequiv{$tocnumber} = $tocsymb;
609 } elsif ( $chkcat[$i] eq 'toc' && $chk[$i] =~ /\.byte/ ) {
610 $chkcat[$i] = 'literal';
615 for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
616 $c = $chk[$i]; # convenience copy
618 # print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
620 # toss all prologue stuff; HPPA is pretty weird
622 $c = &mash_hppa_prologue($c) if $TargetPlatform =~ /^hppa/;
624 # be slightly paranoid to make sure there's
625 # nothing surprising in there
626 if ( $c =~ /--- BEGIN ---/ ) {
627 if (($p, $r) = split(/--- BEGIN ---/, $c)) {
629 if ($TargetPlatform =~ /^i386-/) {
630 $p =~ s/^\tpushl \%edi\n//;
631 $p =~ s/^\tpushl \%esi\n//;
632 $p =~ s/^\tsubl \$\d+,\%esp\n//;
633 $p =~ s/^\tmovl \$\d+,\%eax\n\tcall __alloca\n// if ($TargetPlatform =~ /^.*-cygwin32/);
634 } elsif ($TargetPlatform =~ /^m68k-/) {
635 $p =~ s/^\tlink a6,#-?\d.*\n//;
636 $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;
637 # The above showed up in the asm code,
638 # so I added it here.
639 # I hope it's correct.
641 $p =~ s/^\tmovel d2,sp\@-\n//;
642 $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
643 $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
644 } elsif ($TargetPlatform =~ /^mips-/) {
645 # the .frame/.mask/.fmask that we use is the same
646 # as that produced by GCC for miniInterpret; this
647 # gives GDB some chance of figuring out what happened
648 $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
649 $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
650 $p =~ s/^\t\.(mask|fmask).*\n//g;
651 $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
652 $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
653 $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
654 $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
655 $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
656 $p =~ s/__FRAME__/$FRAME/;
657 } elsif ($TargetPlatform =~ /^powerpc-|^rs6000/) {
658 $p =~ s/^\tmflr 0\n//;
659 $p =~ s/^\tstm \d+,-\d+\(1\)\n//;
660 $p =~ s/^\tstw? 0,\d+\(1\)\n//;
661 $p =~ s/^\tstw?u 1,-\d+\(1\)\n//;
662 $p =~ s/^\tstw? \d+,-\d+\(1\)\n//g;
663 $p =~ s/^\tstfd \d+,-\d+\(1\)\n//g;
665 print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
668 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/
669 && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
671 # glue together what's left
673 $c =~ s/\n\t\n/\n/; # junk blank line
677 if ( $TargetPlatform =~ /^mips-/ ) {
678 # MIPS: first, this basic sequence may occur "--- END ---" or not
679 $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
682 # toss all epilogue stuff; again, paranoidly
683 if ( $c =~ /--- END ---/ ) {
684 if (($r, $e) = split(/--- END ---/, $c)) {
685 if ($TargetPlatform =~ /^i386-/) {
687 $e =~ s/^\tpopl \%edi\n//;
688 $e =~ s/^\tpopl \%esi\n//;
689 $e =~ s/^\taddl \$\d+,\%esp\n//;
690 } elsif ($TargetPlatform =~ /^m68k-/) {
691 $e =~ s/^\tunlk a6\n//;
693 } elsif ($TargetPlatform =~ /^mips-/) {
694 $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
695 $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
696 $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
697 $e =~ s/^\tj\t\$31\n//;
698 } elsif ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
699 $e =~ s/^\taddi 1,1,\d+\n//;
700 $e =~ s/^\tcal 1,\d+\(1\)\n//;
701 $e =~ s/^\tlw?z? \d+,\d+\(1\)\n//;
702 $e =~ s/^\tmtlr 0\n//;
705 print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
707 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
708 && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
710 # glue together what's left
712 $c =~ s/\n\t\n/\n/; # junk blank line
716 # On SPARCs, we don't do --- BEGIN/END ---, we just
717 # toss the register-windowing save/restore/ret* instructions
719 if ( $TargetPlatform =~ /^sparc-/ ) {
720 $c =~ s/^\t(save .*|restore|ret|retl)\n//g;
721 # throw away PROLOGUE comments
722 $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
725 # On Alphas, the prologue mangling is done a little later (below)
727 # toss all calls to __DISCARD__
728 $c =~ s/^\t(call|jbsr|jal)\s+$TUS[@]?__DISCARD__\n//go;
730 # MIPS: that may leave some gratuitous asm macros around
731 # (no harm done; but we get rid of them to be tidier)
732 $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/
733 if $TargetPlatform =~ /^mips-/;
735 # toss stack adjustment after DoSparks
736 $c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g
737 if $TargetPlatform =~ /^m68k-/; # this looks old...
739 if ( $TargetPlatform =~ /^alpha-/ &&
740 ! $magic_rdata_seen &&
741 $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
742 $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
743 $magic_rdata_seen = 1;
746 # pick some end-things and move them to the next chunk
748 # pin a funny end-thing on (for easier matching):
749 $c .= 'FUNNY#END#THING';
751 while ( $c =~ /$TMOVEDIRVS[@]?FUNNY#END#THING/o ) { # [@]? is a silly hack to avoid having to use curlies for T_PRE_APP
752 # (this SEGVs perl4 on alphas, you see)
755 if ( $i < ($numchks - 1)
756 && ( $to_move =~ /$TCOPYDIRVS/
757 || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
758 $chk[$i + 1] = $to_move . $chk[$i + 1];
759 # otherwise they're tossed
762 $c =~ s/$TMOVEDIRVS[@]?FUNNY#END#THING/FUNNY#END#THING/o; # [@]? is a hack (see above)
765 if ( $TargetPlatform =~ /^alpha-/ && $c =~ /^\t\.ent\s+(\S+)/ ) {
767 # toss all prologue stuff, except for loading gp, and the ..ng address
768 if (($p, $r) = split(/^\t\.prologue/, $c)) {
769 if (($keep, $junk) = split(/\.\.ng:/, $p)) {
770 $c = $keep . "..ng:\n";
772 print STDERR "malformed code block ($ent)?\n"
775 $c .= "\t.frame \$30,0,\$26,0\n\t.prologue" . $r;
778 $c =~ s/FUNNY#END#THING//;
780 # print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;
782 $chk[$i] = $c; # update w/ convenience copy
785 if ( $TargetPlatform =~ /^alpha-/ ) {
786 # print out the header stuff first
787 $chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
788 print OUTASM $chk[0];
790 } elsif ( $TargetPlatform =~ /^hppa/ ) {
791 print OUTASM $chk[0];
793 } elsif ( $TargetPlatform =~ /^mips-/ ) {
794 $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
796 # get rid of horrible "<dollar>Revision: .*$" strings
797 local(@lines0) = split(/\n/, $chk[0]);
799 while ( $z <= $#lines0 ) {
800 if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
803 while ( $z <= $#lines0 ) {
805 last if $lines0[$z] =~ /[,\t]0x0$/;
811 $chk[0] = join("\n", @lines0);
812 $chk[0] =~ s/\n\n+/\n/;
813 print OUTASM $chk[0];
816 # print out all the literal strings next
817 for ($i = 0; $i < $numchks; $i++) {
818 if ( $chkcat[$i] eq 'literal' ) {
819 print OUTASM $T_HDR_literal, $chk[$i];
820 print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter
822 $chkcat[$i] = 'DONE ALREADY';
826 # on the HPPA, print out all the bss next
827 if ( $TargetPlatform =~ /^hppa/ ) {
828 for ($i = 1; $i < $numchks; $i++) {
829 if ( $chkcat[$i] eq 'bss' ) {
830 print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
831 print OUTASM $chk[$i];
833 $chkcat[$i] = 'DONE ALREADY';
838 for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
839 # print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
841 next if $chkcat[$i] eq 'DONE ALREADY';
843 if ( $chkcat[$i] eq 'misc' ) {
844 if ($chk[$i] ne '') {
845 print OUTASM $T_HDR_misc;
846 if ($TargetPlatform =~ /^powerpc-|^rs6000/) {
847 $chksymb[$i] =~ s/://;
848 #new if ($chksymb[$i] =~ /ret.*upd/ || $KNOWN_FUNNY_THING{$chksymb[$i]}
849 #new || $chksymb[$i] =~ /^$.{T_US}_(PRIn|PRStart).*${T_POST_LBL}$/o )
850 #new { print OUTASM "\t\.globl $chksymb[$i]\n"; }
851 if ($chksymb[$i] ne '')
852 { print OUTASM "\t\.globl \.$chksymb[$i]\n"; };
853 if ($chk[$i] =~ /TOC\[tc0\], 0\n/)
854 { ($p, $r) = split(/TOC\[tc0\], 0\n/, $chk[$i]); $printDS = 1;}
855 else { $r = $chk[$i]; $printDS = 0; };
856 $chk[$i] = &mangle_powerpc_tailjump($r);
858 &print_doctored($chk[$i], 0);
859 if ($TargetPlatform =~ /^powerpc-|^rs6000-/ && $printDS) {
860 print OUTASM "\.csect ${chksymb[$i]}[DS]\n";
861 print OUTASM "${p}TOC[tc0], 0\n";
865 } elsif ( $chkcat[$i] eq 'toss' ) {
866 print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";
868 } elsif ( $chkcat[$i] eq 'data' ) {
869 if ($chk[$i] ne '') {
870 print OUTASM $T_HDR_data;
871 print OUTASM $chk[$i];
874 } elsif ( $chkcat[$i] eq 'consist' ) {
875 if ( $chk[$i] =~ /$T_hsc_cc_PAT/o ) {
876 local($consist) = "$1.$2.$3";
878 $consist =~ s/\//./g;
880 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
881 print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
883 } elsif ( $TargetPlatform !~ /^(mips)-/ ) { # we just don't try in those case (ToDo)
884 # on mips: consistency string is just a v
885 # horrible bunch of .bytes,
886 # which I am too lazy to sort out (WDP 95/05)
888 print STDERR "Couldn't grok consistency: ", $chk[$i];
891 } elsif ( $chkcat[$i] eq 'splitmarker' ) {
892 # we can just re-constitute this one...
893 # NB: we emit _three_ underscores no matter what,
894 # so ghc-split doesn't have to care.
895 print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
897 } elsif ( $chkcat[$i] eq 'closure'
898 || $chkcat[$i] eq 'infotbl'
899 || $chkcat[$i] eq 'slow'
900 || $chkcat[$i] eq 'fast' ) { # do them in that order
901 $symb = $chksymb[$i];
904 if ( defined($closurechk{$symb}) ) {
905 print OUTASM $T_HDR_closure;
906 print OUTASM $chk[$closurechk{$symb}];
907 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
911 if ( defined($infochk{$symb}) ) {
913 print OUTASM $T_HDR_info;
914 if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
915 $chk[$infochk{$symb}] =~ s/\.long ([_A-Za-z]\S+_entry)/\.long \.\1/;
916 $chk[$infochk{$symb}] =~ s/\.long ([A-Za-z]\S+_upd)/\.long \.\1/;
917 $chk[$infochk{$symb}] =~ s/\.long (IndUpdRet\S+)/\.long \.\1/;
918 $chk[$infochk{$symb}] =~ s/\.long StdErrorCode/\.long \.StdErrorCode/;
919 $chk[$infochk{$symb}] =~ s/\.long UpdErr/\.long \.UpdErr/;
920 print OUTASM $chk[$infochk{$symb}];
922 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
924 # entry code will be put here!
927 if ( $chk[$infochk{$symb}] =~ /$TDOTWORD[@]?\s+([A-Za-z0-9_]+_entry)$/o
928 && $1 ne "${T_US}${symb}_entry" ) {
929 print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
932 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
936 if ( defined($slowchk{$symb}) ) {
938 # teach it to drop through to the fast entry point:
939 $c = $chk[$slowchk{$symb}];
941 if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
942 ($p, $r) = split(/TOC\[tc0\], 0\n/, $c);
943 if ($symb =~ /^[_A-Z]/)
945 print OUTASM "\t\.globl \.${chksymb[$i]}_entry\n";
946 print OUTASM "\.csect ${symb}_entry[DS]\n";
947 print OUTASM "${p}TOC[tc0], 0\n";
949 $r =~ s/\.csect \.text\[PR\]\n//; # todo: properly - andre
950 $c = &mangle_powerpc_tailjump($r);
953 if ( defined($fastchk{$symb}) ) {
954 if ( $TargetPlatform =~ /^alpha-/ ) {
955 $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
956 } elsif ( $TargetPlatform =~ /^hppa/ ) {
957 $c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
958 } elsif ( $TargetPlatform =~ /^i386-/ ) {
959 $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%edx\n\tjmp \*\%edx\n//;
960 $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%eax\n\tjmp \*\%eax\n//;
961 } elsif ( $TargetPlatform =~ /^mips-/ ) {
962 $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
963 } elsif ( $TargetPlatform =~ /^m68k-/ ) {
964 $c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n\tnop\n//;
965 $c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n//;
966 } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ ) {
967 $c =~ s/^\tb \.${T_US}${symb}_fast\d+\n//;
968 } elsif ( $TargetPlatform =~ /^sparc-/ ) {
969 $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n\tnop\n//;
970 $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n(\t[a-z].*\n)/$1/;
972 print STDERR "$Pgm: mystery slow-fast dropthrough: $TargetPlatform\n";
976 if ( $TargetPlatform !~ /^(alpha-|hppa|mips-)/ ) {
977 # On alphas, hppa: no very good way to look for "dangling"
978 # references to fast-entry point.
979 # (questionable re hppa and mips...)
980 print STDERR "still has jump to fast entry point:\n$c"
981 if $c =~ /$TUS[@]?$symb[@]?_fast/; # NB: paranoia
984 print OUTASM $T_HDR_entry;
986 &print_doctored($c, 1); # NB: the 1!!!
988 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
992 if ( defined($fastchk{$symb}) ) {
993 $c = $chk[$fastchk{$symb}];
994 if ( ! defined($slowchk{$symb})
995 # ToDo: the || clause can go once we're no longer
996 # concerned about producing exactly the same output as before
997 #OLD: || $TargetPlatform =~ /^(m68k|sparc|i386)-/
999 print OUTASM $T_HDR_fast;
1001 if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
1002 local(@lbls) = split(/:/, $c);
1003 $fullname = $lbls[0];
1004 $fullname =~ s/$T_MOVE_DIRVS//g;
1005 if ( $fullname =~ /^[A-Z]/)
1006 { print OUTASM "\t\.globl \.${fullname}\n";
1008 print OUTASM "\t\.lglobl \.${fullname}\n"; #todo: rm - andre
1010 $c =~ s/((.*\n)*)\t.long \S+, TOC\[tc0\], 0\n\.csect \.text\[PR\]\n((.*\n)*)/\1\3/;
1011 $c = &mangle_powerpc_tailjump($c);
1013 &print_doctored($c, 0);
1014 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
1017 } elsif ( $chkcat[$i] eq 'vector'
1018 || $chkcat[$i] eq 'direct' ) { # do them in that order
1019 $symb = $chksymb[$i];
1022 if ( defined($vectorchk{$symb}) ) {
1023 print OUTASM $T_HDR_vector;
1024 if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
1025 if ( $symb =~ /^[A-Z]/) {
1026 print OUTASM "\t\.globl \.vtbl_${symb}\n";
1027 print OUTASM "\t\.globl vtbl_${symb}\n";
1029 $chk[$vectorchk{$symb}] =~ s/\.long (\S+)/\.long \.\1/g;
1030 print OUTASM ".vtbl_${symb}:\n";
1031 print OUTASM $chk[$vectorchk{$symb}];
1033 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
1035 # direct return code will be put here!
1036 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
1040 if ( defined($directchk{$symb}) ) {
1041 print OUTASM $T_HDR_direct;
1042 if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
1043 ($p, $r) = split(/TOC\[tc0\], 0\n/, $chk[$directchk{$symb}]);
1044 &print_doctored($r, 0);
1045 print OUTASM "\.csect ${symb}DirectReturn[DS]\n";
1046 print OUTASM "${p}TOC[tc0], 0\n";
1048 &print_doctored($chk[$directchk{$symb}], 0);
1050 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
1052 } elsif ( $TargetPlatform =~ /^alpha-/ ) {
1053 # Alphas: the commented nop is for the splitter, to ensure
1054 # that no module ends with a label as the very last
1055 # thing. (The linker will adjust the label to point
1056 # to the first code word of the next module linked in,
1057 # even if alignment constraints cause the label to move!)
1059 print OUTASM "\t# nop\n";
1062 } elsif ( $chkcat[$i] eq 'toc' ) {
1063 # silly optimisation to print tocs, since they come in groups...
1064 print OUTASM $T_HDR_toc;
1066 while ($chkcat[$j] eq 'toc')
1067 { print OUTASM $chk[$j];
1068 $chkcat[$j] = 'DONE ALREADY';
1073 &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
1077 print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/;
1079 if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
1080 print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n"
1084 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1085 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1090 sub mash_hppa_prologue { # OK, epilogue, too
1093 # toss all prologue stuff
1094 s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;
1096 # Lie about our .CALLINFO
1097 s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;
1104 # toss all epilogue stuff
1105 s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;
1107 # Sorry; we moved the _info stuff to the code segment.
1108 s/_info,DATA/_info,CODE/g;
1115 sub print_doctored {
1116 local($_, $need_fallthru_patch) = @_;
1118 if ( $TargetPlatform !~ /^i386-/
1119 || ! /^\t[a-z]/ ) { # no instructions in here, apparently
1123 # OK, must do some x86 **HACKING**
1125 local($entry_patch) = '';
1126 local($exit_patch) = '';
1127 local($call_entry_patch)= '';
1128 local($call_exit_patch) = '';
1130 #OLD: # first, convert calls to *very magic form*: (ToDo: document
1134 # call _?PerformGC_wrapper
1138 # call _?PerformGC_wrapper
1140 # The reason we do this now is to remove the apparent use of
1141 # %esp, which would throw off the "what patch code do we need"
1144 # Special macros in ghc/includes/COptWraps.lh, used in
1145 # ghc/runtime/CallWrap_C.lc, are required for this to work!
1148 s/^\tpushl \$(\d+)\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \$$1,\%eax\n\tcall ${T_DO_GC}\n/go;
1149 s/^\tpushl \%eax\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tcall ${T_DO_GC}\n/go;
1150 s/^\tpushl \%edx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%edx,\%eax\n\tcall ${T_DO_GC}\n/go;
1152 #= if ( $StolenX86Regs <= 4 ) { # %ecx is ordinary reg
1153 #= s/^\tpushl \%ecx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%ecx,\%eax\n\tcall ${T_DO_GC}\n/go;
1156 # gotta watch out for weird instructions that
1157 # invisibly smash various regs:
1158 # rep* %ecx used for counting
1159 # scas* %edi used for destination index
1160 # cmps* %e[sd]i used for indices
1161 # loop* %ecx used for counting
1166 # * use of STG reg [ nn(%ebx) ] where no machine reg avail
1168 # * GCC used an "STG reg" for its own purposes
1170 # * some secret uses of machine reg, requiring STG reg
1171 # to be saved/restored
1173 # The most dangerous "GCC uses" of an "STG reg" are when
1174 # the reg holds the target of a jmp -- it's tricky to
1175 # insert the patch-up code before we get to the target!
1176 # So here we change the jmps:
1178 # --------------------------------------------------------
1179 # it can happen that we have jumps of the form...
1180 # jmp *<something involving %esp>
1182 # jmp <something involving another naughty register...>
1184 # a reasonably-common case is:
1186 # movl $_blah,<bad-reg>
1189 # which is easily fixed as:
1191 # sigh! try to hack around it...
1194 if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
1195 s/^\tmovl (.*),\%esi\n\tjmp \*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1196 s/^\tjmp \*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1197 s/^\tjmp \*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
1198 die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
1199 if /(jmp|call) .*\%esi/;
1201 if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
1202 s/^\tmovl (.*),\%edi\n\tjmp \*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1203 s/^\tjmp \*(-?\d*)\((.*\%edi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1204 s/^\tjmp \*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
1205 die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
1206 if /(jmp|call) .*\%edi/;
1208 #= if ($StolenX86Regs <= 4 ) { # spurious uses of ecx?
1209 #= s/^\tmovl (.*),\%ecx\n\tjmp \*%ecx\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1210 #= s/^\tjmp \*(-?\d*)\((.*\%ecx.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1211 #= s/^\tjmp \*\%ecx\n/\tmovl \%ecx,\%eax\n\tjmp \*\%eax\n/g;
1212 #= die "$Pgm: (mangler) still have jump involving \%ecx!\n$_"
1213 #= if /(jmp|call) .*\%ecx/;
1216 # OK, now we can decide what our patch-up code is going to
1218 if ( $StolenX86Regs <= 2
1219 && ( /32\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
1220 $entry_patch .= "\tmovl \%esi,32(\%ebx)\n";
1221 $exit_patch .= "\tmovl 32(\%ebx),\%esi\n";
1222 # nothing for call_{entry,exit} because %esi is callee-save
1224 if ( $StolenX86Regs <= 3
1225 && ( /64\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # SpA (edi)
1226 $entry_patch .= "\tmovl \%edi,64(\%ebx)\n";
1227 $exit_patch .= "\tmovl 64(\%ebx),\%edi\n";
1228 # nothing for call_{entry,exit} because %edi is callee-save
1230 #= if ( $StolenX86Regs <= 4
1231 #= && ( /80\(\%ebx\)/ || /\%ecx/ || /^\t(rep|loop)/ ) ) { # Hp (ecx)
1232 #= $entry_patch .= "\tmovl \%ecx,80(\%ebx)\n";
1233 #= $exit_patch .= "\tmovl 80(\%ebx),\%ecx\n";
1235 #= $call_exit_patch .= "\tmovl \%ecx,108(\%ebx)\n";
1236 #= $call_entry_patch .= "\tmovl 108(\%ebx),\%ecx\n";
1237 #= # I have a really bad feeling about this if we ever
1238 #= # have a nested call...
1239 #= # NB: should just hide it somewhere in the C stack.
1241 # --------------------------------------------------------
1242 # next, here we go with non-%esp patching!
1244 s/^(\t[a-z])/$entry_patch$1/; # before first instruction
1245 s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
1247 # fix _all_ non-local jumps:
1249 s/^\tjmp \*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
1250 s/^\tjmp ${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
1252 s/^(\tjmp .*\n)/$exit_patch$1/g; # here's the fix...
1254 s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/go;
1255 s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/go;
1257 # fix post-PerformGC wrapper (re-)entries ???
1259 if ($StolenX86Regs == 2 ) {
1260 die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_"
1261 if /^\t(jmp|call) .*\%e(si|di)/;
1262 #= die "ARGH! Jump uses \%esi, \%edi, or \%ecx with -monly-2-regs:\n$_"
1263 #= if /^\t(jmp|call) .*\%e(si|di|cx)/;
1264 } elsif ($StolenX86Regs == 3 ) {
1265 die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_"
1266 if /^\t(jmp|call) .*\%edi/;
1267 #= die "ARGH! Jump uses \%edi or \%ecx with -monly-3-regs:\n$_"
1268 #= if /^\t(jmp|call) .*\%e(di|cx)/;
1269 #= } elsif ($StolenX86Regs == 4 ) {
1270 #= die "ARGH! Jump uses \%ecx with -monly-4-regs:\n$_"
1271 #= if /^\t(jmp|call) .*\%ecx/;
1274 # final peephole fixes
1276 s/^\tmovl \%eax,36\(\%ebx\)\n\tjmp \*36\(\%ebx\)\n/\tmovl \%eax,36\(\%ebx\)\n\tjmp \*\%eax\n/;
1277 # the short form may tickle perl bug:
1278 # s/^\tmovl \$${T_US}(.*),(\%e[abcd]x)\n\tjmp \*$2/\tjmp $T_US$1/g;
1279 s/^\tmovl \$${T_US}(.*),\%eax\n\tjmp \*\%eax/\tjmp $T_US$1/g;
1280 s/^\tmovl \$${T_US}(.*),\%ebx\n\tjmp \*\%ebx/\tjmp $T_US$1/g;
1281 s/^\tmovl \$${T_US}(.*),\%ecx\n\tjmp \*\%ecx/\tjmp $T_US$1/g;
1282 s/^\tmovl \$${T_US}(.*),\%edx\n\tjmp \*\%edx/\tjmp $T_US$1/g;
1284 # Hacks to eliminate some reloads of Hp. Worth about 5% code size.
1285 # We could do much better than this, but at least it catches about
1286 # half of the unnecessary reloads.
1287 # Note that these will stop working if either:
1288 # (i) the offset of Hp from BaseReg changes from 80, or
1289 # (ii) the register assignment of BaseReg changes from %ebx
1291 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;
1293 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;
1295 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;
1296 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;
1298 # --------------------------------------------------------
1299 # that's it -- print it
1301 #die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
1305 if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
1306 print OUTASM $exit_patch;
1307 # ToDo: make it not print if there is a "jmp" at the end
1313 sub init_FUNNY_THINGS {
1314 %KNOWN_FUNNY_THING = (
1315 "${T_US}CheckHeapCode${T_POST_LBL}", 1,
1316 "${T_US}CommonUnderflow${T_POST_LBL}", 1,
1317 "${T_US}Continue${T_POST_LBL}", 1,
1318 "${T_US}EnterNodeCode${T_POST_LBL}", 1,
1319 "${T_US}ErrorIO_call_count${T_POST_LBL}", 1,
1320 "${T_US}ErrorIO_innards${T_POST_LBL}", 1,
1321 "${T_US}IndUpdRetDir${T_POST_LBL}", 1,
1322 "${T_US}IndUpdRetV0${T_POST_LBL}", 1,
1323 "${T_US}IndUpdRetV1${T_POST_LBL}", 1,
1324 "${T_US}IndUpdRetV2${T_POST_LBL}", 1,
1325 "${T_US}IndUpdRetV3${T_POST_LBL}", 1,
1326 "${T_US}IndUpdRetV4${T_POST_LBL}", 1,
1327 "${T_US}IndUpdRetV5${T_POST_LBL}", 1,
1328 "${T_US}IndUpdRetV6${T_POST_LBL}", 1,
1329 "${T_US}IndUpdRetV7${T_POST_LBL}", 1,
1330 "${T_US}PrimUnderflow${T_POST_LBL}", 1,
1331 "${T_US}StackUnderflowEnterNode${T_POST_LBL}", 1,
1332 "${T_US}StdErrorCode${T_POST_LBL}", 1,
1333 "${T_US}UnderflowVect0${T_POST_LBL}", 1,
1334 "${T_US}UnderflowVect1${T_POST_LBL}", 1,
1335 "${T_US}UnderflowVect2${T_POST_LBL}", 1,
1336 "${T_US}UnderflowVect3${T_POST_LBL}", 1,
1337 "${T_US}UnderflowVect4${T_POST_LBL}", 1,
1338 "${T_US}UnderflowVect5${T_POST_LBL}", 1,
1339 "${T_US}UnderflowVect6${T_POST_LBL}", 1,
1340 "${T_US}UnderflowVect7${T_POST_LBL}", 1,
1341 "${T_US}UpdErr${T_POST_LBL}", 1,
1342 "${T_US}UpdatePAP${T_POST_LBL}", 1,
1343 "${T_US}WorldStateToken${T_POST_LBL}", 1,
1344 "${T_US}_Enter_Internal${T_POST_LBL}", 1,
1345 "${T_US}_PRMarking_MarkNextAStack${T_POST_LBL}", 1,
1346 "${T_US}_PRMarking_MarkNextBStack${T_POST_LBL}", 1,
1347 "${T_US}_PRMarking_MarkNextCAF${T_POST_LBL}", 1,
1348 "${T_US}_PRMarking_MarkNextGA${T_POST_LBL}", 1,
1349 "${T_US}_PRMarking_MarkNextRoot${T_POST_LBL}", 1,
1350 "${T_US}_PRMarking_MarkNextSpark${T_POST_LBL}", 1,
1351 "${T_US}_PRMarking_MarkNextEvent${T_POST_LBL}", 1,
1352 "${T_US}_PRMarking_MarkNextClosureInFetchBuffer${T_POST_LBL}", 1,
1353 "${T_US}_Scavenge_Forward_Ref${T_POST_LBL}", 1,
1354 "${T_US}__std_entry_error__${T_POST_LBL}", 1,
1355 "${T_US}_startMarkWorld${T_POST_LBL}", 1,
1356 "${T_US}resumeThread${T_POST_LBL}", 1,
1357 "${T_US}startCcRegisteringWorld${T_POST_LBL}", 1,
1358 "${T_US}startEnterFloat${T_POST_LBL}", 1,
1359 "${T_US}startEnterInt${T_POST_LBL}", 1,
1360 "${T_US}startPerformIO${T_POST_LBL}", 1,
1361 "${T_US}startStgWorld${T_POST_LBL}", 1,
1362 "${T_US}stopPerformIO${T_POST_LBL}", 1
1367 The following table reversal is used for both info tables and return
1368 vectors. In both cases, we remove the first entry from the table,
1369 reverse the table, put the label at the end, and paste some code
1370 (that which is normally referred to by the first entry in the table)
1371 right after the table itself. (The code pasting is done elsewhere.)
1375 local($symb, $tbl, $discard1) = @_;
1377 local($before) = '';
1379 local(@imports) = (); # hppa only
1382 local(@lines) = split(/\n/, $tbl);
1383 local($i, $j); #local ($i, $extra, $words_to_pad, $j);
1385 # see comment in mangleAsm as to why this silliness is needed.
1386 local($TDOTWORD) = ${T_DOT_WORD};
1387 local($TDOTGLOBAL) = ${T_DOT_GLOBAL};
1388 local($TUS) = ${T_US};
1389 local($TPOSTLBL) = ${T_POST_LBL};
1391 for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t$TDOTWORD\s+/o; $i++) {
1392 $label .= $lines[$i] . "\n",
1393 next if $lines[$i] =~ /^[A-Za-z0-9_]+_info$TPOSTLBL[@]?$/o
1394 || $lines[$i] =~ /$TDOTGLOBAL/o
1395 || $lines[$i] =~ /^$TUS[@]?vtbl_\S+$TPOSTLBL[@]?$/o;
1397 $before .= $lines[$i] . "\n"; # otherwise...
1400 if ( $TargetPlatform !~ /^hppa/ ) {
1401 for ( ; $i <= $#lines && $lines[$i] =~ /^\t$TDOTWORD\s+/o; $i++) {
1402 push(@words, $lines[$i]);
1404 } else { # hppa weirdness
1405 for ( ; $i <= $#lines && $lines[$i] =~ /^\s+\.(word|IMPORT)/; $i++) {
1406 if ($lines[$i] =~ /^\s+\.IMPORT/) {
1407 push(@imports, $lines[$i]);
1409 # We don't use HP's ``function pointers''
1410 # We just use labels in code space, like normal people
1411 $lines[$i] =~ s/P%//;
1412 push(@words, $lines[$i]);
1417 # now throw away the first word (entry code):
1418 shift(@words) if $discard1;
1420 # Padding removed to reduce code size and improve performance on Pentiums.
1422 # for 486-cache-friendliness, we want our tables aligned
1423 # on 16-byte boundaries (.align 4). Let's pad:
1424 # $extra = ($#words + 1) % 4;
1425 # $words_to_pad = ($extra == 0) ? 0 : 4 - $extra;
1426 # for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t${T_DOT_WORD} 0"); }
1428 for (; $i <= $#lines; $i++) {
1429 $after .= $lines[$i] . "\n";
1432 # Alphas:If we have anonymous text (not part of a procedure), the
1433 # linker may complain about missing exception information. Bleh.
1434 if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
1435 $before = "\t.ent $1\n" . $before;
1436 $after .= "\t.end $1\n";
1440 . (($TargetPlatform !~ /^hppa/) ? '' : join("\n", @imports) . "\n")
1441 . join("\n", (reverse @words)) . "\n"
1444 # print STDERR "before=$before\n";
1445 # print STDERR "label=$label\n";
1446 # print STDERR "words=",(reverse @words),"\n";
1447 # print STDERR "after=$after\n";
1454 sub mini_mangle_asm_i386 {
1455 local($in_asmf, $out_asmf) = @_;
1457 &init_TARGET_STUFF();
1459 # see mangleAsm comment
1460 local($TUS) = ${T_US};
1461 local($TPOSTLBL)=${T_POST_LBL};
1463 open(INASM, "< $in_asmf")
1464 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1465 open(OUTASM,"> $out_asmf")
1466 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1472 /^$TUS[@]?(PerformGC|StackOverflow|Yield|PerformReschedule)_wrapper$TPOSTLBL\n/o;
1473 print OUTASM "\tmovl \%esp, ${T_US}__temp_esp\n";
1474 print OUTASM "\tmovl \%eax, ${T_US}__temp_eax\n";
1478 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1479 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1483 The HP is a major nuisance. The threaded code mangler moved info
1484 tables from data space to code space, but unthreaded code in the RTS
1485 still has references to info tables in data space. Since the HP
1486 linker is very precise about where symbols live, we need to patch the
1487 references in the unthreaded RTS as well.
1490 sub mini_mangle_asm_hppa {
1491 local($in_asmf, $out_asmf) = @_;
1493 open(INASM, "< $in_asmf")
1494 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1495 open(OUTASM,"> $out_asmf")
1496 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1499 s/_info,DATA/_info,CODE/; # Move _info references to code space
1505 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1506 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1512 sub mini_mangle_asm_powerpc {
1513 local($in_asmf, $out_asmf) = @_;
1515 open(INASM, "< $in_asmf")
1516 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1517 open(OUTASM,"> $out_asmf")
1518 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1521 s/long _PRStart/long ._PRStart/;
1522 s/long _PRIn_/long ._PRIn_/;
1523 s/long _Dummy_(\S+)_entry/long ._Dummy_\1_entry/;
1524 s/long _PRMarking_MarkNextRoot\[DS\]/long ._PRMarking_MarkNextRoot/;
1525 s/long _PRMarking_MarkNextCAF\[DS\]/long ._PRMarking_MarkNextCAF/;
1526 s/long _PRMarking_MarkNextAStack\[DS\]/long ._PRMarking_MarkNextAStack/;
1527 s/long _PRMarking_MarkNextBStack\[DS\]/long ._PRMarking_MarkNextBStack/;
1532 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1533 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1536 sub mangle_powerpc_tailjump {
1538 local($maybe_more) = 1;
1539 while (($c =~ /\tlw?z? \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n/) && $maybe_more)
1542 $lcsymb =~ s/(.*\n)*\tlw?z? \d+,LC\.\.(\d+)\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/;
1543 # the checks for r1 and r2 are mostly paranoia...
1545 $r1 =~ s/(.*\n)*\tlw?z? (\d+),LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/;
1547 $r2 =~ s/(.*\n)*\tlw?z? \d+,LC\.\.(\d+)\(2\)\n\tmtctr (\d+)\n\tbctr\n(.*\n)*/\3/;
1550 $c =~ s/((.*\n)*)\tlw?z? \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n((.*\n)*)/\1\tb $tocequiv{$lcsymb}\n\3/;
1556 # make "require"r happy...