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.
16 %************************************************************************
18 \subsection{Constants for various architectures}
20 %************************************************************************
23 sub init_TARGET_STUFF {
25 if ( $TargetPlatform =~ /^i386-.*-linuxaout/ ) {
27 $T_STABBY = 1; # 1 iff .stab things (usually if a.out format)
28 $T_US = '_'; # _ if symbols have an underscore on the front
29 $T_DO_GC = '_PerformGC_wrapper';
30 $T_PRE_APP = '^#'; # regexp that says what comes before APP/NO_APP
31 $T_CONST_LBL = '^LC(\d+):$';
33 $T_PRE_LLBL_PAT = 'L';
35 $T_X86_BADJMP = '^\tjmp [^L\*]';
37 $T_MOVE_DIRVS = '^\s*(\.align\s+\d+(,0x90)?\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.stab[^n].*\n)';
38 $T_COPY_DIRVS = '\.(globl|stab)';
39 $T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
40 $T_DOT_WORD = '\.long';
41 $T_HDR_string = "\.text\n\t\.align 4\n"; # .align 4 is 486-cache friendly
42 $T_HDR_misc = "\.text\n\t\.align 4\n";
43 $T_HDR_data = "\.data\n\t\.align 2\n"; # ToDo: change align??
44 $T_HDR_consist = "\.text\n";
45 $T_HDR_closure = "\.data\n\t\.align 2\n"; # ToDo: change align?
46 $T_HDR_info = "\.text\n\t\.align 4\n"; # NB: requires padding
47 $T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
48 $T_HDR_fast = "\.text\n\t\.align 4\n";
49 $T_HDR_vector = "\.text\n\t\.align 4\n"; # NB: requires padding
50 $T_HDR_direct = "\.text\n\t\.align 4\n";
52 } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/ ) {
54 $T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
55 $T_US = ''; # _ if symbols have an underscore on the front
56 $T_DO_GC = 'PerformGC_wrapper';
57 $T_PRE_APP = '/'; # regexp that says what comes before APP/NO_APP
58 $T_CONST_LBL = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
60 $T_PRE_LLBL_PAT = '\.L';
62 $T_X86_BADJMP = '^\tjmp [^\.\*]';
64 $T_MOVE_DIRVS = '^\s*(\.align\s+\d+(,0x90)?\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.section\s+.*\n|\.type\s+.*\n|\.Lfe.*\n\t\.size\s+.*\n|\.size\s+.*\n|\.ident.*\n)';
65 $T_COPY_DIRVS = '\.(globl)';
67 $T_hsc_cc_PAT = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
68 $T_DOT_WORD = '\.long';
69 $T_HDR_string = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
70 $T_HDR_misc = "\.text\n\t\.align 16\n";
71 $T_HDR_data = "\.data\n\t\.align 4\n"; # ToDo: change align??
72 $T_HDR_consist = "\.text\n";
73 $T_HDR_closure = "\.data\n\t\.align 4\n"; # ToDo: change align?
74 $T_HDR_info = "\.text\n\t\.align 16\n"; # NB: requires padding
75 $T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
76 $T_HDR_fast = "\.text\n\t\.align 16\n";
77 $T_HDR_vector = "\.text\n\t\.align 16\n"; # NB: requires padding
78 $T_HDR_direct = "\.text\n\t\.align 16\n";
80 } elsif ( $TargetPlatform =~ /^powerpc-.*/ ) {
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 = 'NOT APPLICABLE'; # regexp that says what comes before APP/NO_APP
86 $T_CONST_LBL = '^LC\.\.(\d+):$'; # regexp for what such a lbl looks like
88 $T_PRE_LLBL_PAT = '\.L';
90 $T_X86_BADJMP = 'NOT APPLICABLE';
92 $T_MOVE_DIRVS = '^\s*(\.align\s+\d+(,0x90)?\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.section\s+.*\n|\.type\s+.*\n|\.Lfe.*\n\t\.size\s+.*\n|\.size\s+.*\n|\.ident.*\n)';
93 $T_COPY_DIRVS = '\.(globl)';
95 $T_hsc_cc_PAT = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
96 $T_DOT_WORD = '\.long';
97 $T_HDR_string = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
98 $T_HDR_misc = "\.text\n\t\.align 16\n";
99 $T_HDR_data = "\.data\n\t\.align 4\n"; # ToDo: change align??
100 $T_HDR_consist = "\.text\n";
101 $T_HDR_closure = "\.data\n\t\.align 4\n"; # ToDo: change align?
102 $T_HDR_info = "\.text\n\t\.align 16\n"; # NB: requires padding
103 $T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
104 $T_HDR_fast = "\.text\n\t\.align 16\n";
105 $T_HDR_vector = "\.text\n\t\.align 16\n"; # NB: requires padding
106 $T_HDR_direct = "\.text\n\t\.align 16\n";
110 print STDERR "T_STABBY: $T_STABBY\n";
111 print STDERR "T_US: $T_US\n";
112 print STDERR "T_DO_GC: $T_DO_GC\n";
113 print STDERR "T_PRE_APP: $T_PRE_APP\n";
114 print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
115 print STDERR "T_POST_LBL: $T_POST_LBL\n";
116 print STDERR "T_PRE_LLBL_PAT: $T_PRE_LLBL_PAT\n";
117 print STDERR "T_PRE_LLBL: $T_PRE_LLBL\n";
118 print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
120 print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
121 print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
122 print STDERR "T_hsc_cc_PAT: $T_hsc_cc_PAT\n";
123 print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
124 print STDERR "T_HDR_string: $T_HDR_string\n";
125 print STDERR "T_HDR_misc: $T_HDR_misc\n";
126 print STDERR "T_HDR_data: $T_HDR_data\n";
127 print STDERR "T_HDR_consist: $T_HDR_consist\n";
128 print STDERR "T_HDR_closure: $T_HDR_closure\n";
129 print STDERR "T_HDR_info: $T_HDR_info\n";
130 print STDERR "T_HDR_entry: $T_HDR_entry\n";
131 print STDERR "T_HDR_fast: $T_HDR_fast\n";
132 print STDERR "T_HDR_vector: $T_HDR_vector\n";
133 print STDERR "T_HDR_direct: $T_HDR_direct\n";
139 %************************************************************************
141 \subsection{Mangle away}
143 %************************************************************************
147 local($in_asmf, $out_asmf) = @_;
149 # multi-line regexp matching:
152 &init_TARGET_STUFF();
153 &init_FUNNY_THINGS();
155 open(INASM, "< $in_asmf")
156 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
157 open(OUTASM,"> $out_asmf")
158 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
160 # read whole file, divide into "chunks":
161 # record some info about what we've found...
163 @chk = (); # contents of the chunk
164 $numchks = 0; # number of them
165 @chkcat = (); # what category of thing in each chunk
166 @chksymb = (); # what symbol(base) is defined in this chunk
167 %slowchk = (); # ditto, its regular "slow" entry code
168 %fastchk = (); # ditto, fast entry code
169 %closurechk = (); # ditto, the (static) closure
170 %infochk = (); # given a symbol base, say what chunk its info tbl is in
171 %vectorchk = (); # ditto, return vector table
172 %directchk = (); # ditto, direct return code
178 next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
179 next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
180 next if /${T_PRE_APP}(NO_)?APP/o;
182 if ( /^\s+/ ) { # most common case first -- a simple line!
183 # duplicated from the bottom
187 } elsif ( /$T_CONST_LBL/o ) {
189 $chkcat[$i] = 'string';
192 } elsif ( /^${T_US}__stg_split_marker(\d+)${T_POST_LBL}$/o ) {
194 $chkcat[$i] = 'splitmarker';
197 } elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/o ) {
200 $chkcat[$i] = 'infotbl';
201 $chksymb[$i] = $symb;
203 die "Info table already? $symb; $i\n" if defined($infochk{$symb});
205 $infochk{$symb} = $i;
207 } elsif ( /^${T_US}([A-Za-z0-9_]+)_entry${T_POST_LBL}$/o ) {
209 $chkcat[$i] = 'slow';
214 } elsif ( /^${T_US}([A-Za-z0-9_]+)_fast\d+${T_POST_LBL}$/o ) {
216 $chkcat[$i] = 'fast';
221 } elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/o ) {
223 $chkcat[$i] = 'closure';
226 $closurechk{$1} = $i;
228 } elsif ( /^${T_US}ghc.*c_ID${T_POST_LBL}/o ) {
230 $chkcat[$i] = 'consist';
232 } elsif ( /^(___gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/o ) {
235 } elsif ( /^${T_US}ErrorIO_call_count${T_POST_LBL}$/o # HACK!!!!
236 || /^${T_US}[A-Za-z0-9_]+\.\d+${T_POST_LBL}$/o
237 || /^${T_US}.*_CAT${T_POST_LBL}$/o # PROF: _entryname_CAT
238 || /^${T_US}CC_.*_struct${T_POST_LBL}$/o # PROF: _CC_ccident_struct
239 || /^${T_US}.*_done${T_POST_LBL}$/o # PROF: _module_done
240 || /^${T_US}_module_registered${T_POST_LBL}$/o # PROF: _module_registered
243 $chkcat[$i] = 'data';
246 } elsif ( /^${T_US}(ret_|djn_)/o ) {
248 $chkcat[$i] = 'misc';
251 } elsif ( /^${T_US}vtbl_([A-Za-z0-9_]+)${T_POST_LBL}$/o ) {
253 $chkcat[$i] = 'vector';
258 } elsif ( /^${T_US}([A-Za-z0-9_]+)DirectReturn${T_POST_LBL}$/o ) {
260 $chkcat[$i] = 'direct';
265 } elsif ( /^${T_US}[A-Za-z0-9_]+_upd${T_POST_LBL}$/o ) {
267 $chkcat[$i] = 'misc';
270 } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
271 && /^(_uname|uname|stat|fstat):/ ) {
272 # for some utterly bizarre reason, this platform
273 # likes to drop little local C routines with these names
274 # into each and every .o file that #includes the
275 # relevant system .h file. Yuck. We just don't
276 # tolerate them in .hc files (which we are processing
277 # here). If you need to call one of these things from
278 # Haskell, make a call to your own C wrapper, then
279 # put that C wrapper (which calls one of these) in a
280 # plain .c file. WDP 95/12
282 $chkcat[$i] = 'toss';
285 } elsif ( /^${T_US}[A-Za-z0-9_]/o ) {
288 print STDERR "Funny global thing?: $_"
289 unless $KNOWN_FUNNY_THING{$thing}
290 || /^${T_US}_(PRIn|PRStart).*${T_POST_LBL}$/o # pointer reversal GC routines
291 || /^${T_US}CC_.*${T_POST_LBL}$/ # PROF: _CC_ccident
292 || /^${T_US}_reg.*${T_POST_LBL}$/; # PROF: __reg<module>
294 $chkcat[$i] = 'misc';
297 } else { # simple line (duplicated at the top)
302 $numchks = $#chk + 1;
304 # the division into chunks is imperfect;
305 # we throw some things over the fence into the next
308 # also, there are things we would like to know
309 # about the whole module before we start spitting
312 for ($i = 0; $i < $numchks; $i++) {
313 $c = $chk[$i]; # convenience copy
315 # print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
317 # toss all prologue stuff;
318 # be slightly paranoid to make sure there's
319 # nothing surprising in there
320 if ( $c =~ /--- BEGIN ---/ ) {
321 if (($p, $r) = split(/--- BEGIN ---/, $c)) {
322 $p =~ s/^\tpushl \%edi\n//;
323 $p =~ s/^\tpushl \%esi\n//;
324 $p =~ s/^\tsubl \$\d+,\%esp\n//;
325 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
327 # glue together what's left
332 # toss all epilogue stuff; again, paranoidly
333 if ( $c =~ /--- END ---/ ) {
334 if (($r, $e) = split(/--- END ---/, $c)) {
336 $e =~ s/^\tpopl \%edi\n//;
337 $e =~ s/^\tpopl \%esi\n//;
338 $e =~ s/^\taddl \$\d+,\%esp\n//;
339 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/;
341 # glue together what's left
346 # toss all calls to __DISCARD__
347 $c =~ s/^\tcall ${T_US}__DISCARD__\n//go;
349 # pin a funny end-thing on (for easier matching):
350 $c .= 'FUNNY#END#THING';
352 # pick some end-things and move them to the next chunk
354 while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/o ) {
357 if ( $to_move =~ /${T_COPY_DIRVS}/ && $i < ($numchks - 1) ) {
358 $chk[$i + 1] = $to_move . $chk[$i + 1];
359 # otherwise they're tossed
362 $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o;
365 $c =~ s/FUNNY#END#THING//;
367 # print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;
369 $chk[$i] = $c; # update w/ convenience copy
372 # print out all the literal strings first
373 for ($i = 0; $i < $numchks; $i++) {
374 if ( $chkcat[$i] eq 'string' ) {
375 print OUTASM $T_HDR_string, $chk[$i];
377 $chkcat[$i] = 'DONE ALREADY';
381 for ($i = 0; $i < $numchks; $i++) {
382 # print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
384 next if $chkcat[$i] eq 'DONE ALREADY';
386 if ( $chkcat[$i] eq 'misc' ) {
387 print OUTASM $T_HDR_misc;
388 &print_doctored($chk[$i], 0);
390 } elsif ( $chkcat[$i] eq 'toss' ) {
391 print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";
393 } elsif ( $chkcat[$i] eq 'data' ) {
394 print OUTASM $T_HDR_data;
395 print OUTASM $chk[$i];
397 } elsif ( $chkcat[$i] eq 'consist' ) {
398 if ( $chk[$i] =~ /$T_hsc_cc_PAT/o ) {
399 local($consist) = "$1.$2.$3";
401 $consist =~ s/\//./g;
403 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
404 print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
406 print STDERR "Couldn't grok consistency: ", $chk[$i];
409 } elsif ( $chkcat[$i] eq 'splitmarker' ) {
410 # we can just re-constitute this one...
411 print OUTASM "${T_US}__stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
413 } elsif ( $chkcat[$i] eq 'closure'
414 || $chkcat[$i] eq 'infotbl'
415 || $chkcat[$i] eq 'slow'
416 || $chkcat[$i] eq 'fast' ) { # do them in that order
417 $symb = $chksymb[$i];
420 if ( defined($closurechk{$symb}) ) {
421 print OUTASM $T_HDR_closure;
422 print OUTASM $chk[$closurechk{$symb}];
423 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
427 if ( defined($infochk{$symb}) ) {
429 print OUTASM $T_HDR_info;
430 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
431 # entry code will be put here!
434 if ( $chk[$infochk{$symb}] =~ /${T_DOT_WORD}\s+([A-Za-z0-9_]+_entry)$/o
435 && $1 ne "${T_US}${symb}_entry" ) {
436 print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
439 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
443 if ( defined($slowchk{$symb}) ) {
445 # teach it to drop through to the fast entry point:
446 $c = $chk[$slowchk{$symb}];
448 if ( defined($fastchk{$symb}) ) {
449 $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%edx\n\tjmp \*\%edx\n//;
450 $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%eax\n\tjmp \*\%eax\n//;
453 print STDERR "still has jump to fast entry point:\n$c"
454 if $c =~ /${T_US}${symb}_fast/; # NB: paranoia
456 print OUTASM $T_HDR_entry;
458 &print_doctored($c, 1); # NB: the 1!!!
460 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
464 if ( defined($fastchk{$symb}) ) {
465 print OUTASM $T_HDR_fast;
466 &print_doctored($chk[$fastchk{$symb}], 0);
467 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
470 } elsif ( $chkcat[$i] eq 'vector'
471 || $chkcat[$i] eq 'direct' ) { # do them in that order
472 $symb = $chksymb[$i];
475 if ( defined($vectorchk{$symb}) ) {
476 print OUTASM $T_HDR_vector;
477 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
478 # direct return code will be put here!
479 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
483 if ( defined($directchk{$symb}) ) {
484 print OUTASM $T_HDR_direct;
485 &print_doctored($chk[$directchk{$symb}], 0);
486 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
490 &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
494 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
495 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
501 local($_, $need_fallthru_patch) = @_;
503 if ( $TargetPlatform !~ /^i386-/
504 || ! /^\t[a-z]/ ) { # no instructions in here, apparently
508 # OK, must do some x86 **HACKING**
510 local($entry_patch) = '';
511 local($exit_patch) = '';
512 local($call_entry_patch)= '';
513 local($call_exit_patch) = '';
515 #OLD: # first, convert calls to *very magic form*: (ToDo: document
519 # call _?PerformGC_wrapper
523 # call _?PerformGC_wrapper
525 # The reason we do this now is to remove the apparent use of
526 # %esp, which would throw off the "what patch code do we need"
529 # Special macros in ghc/includes/COptWraps.lh, used in
530 # ghc/runtime/CallWrap_C.lc, are required for this to work!
533 s/^\tpushl \$(\d+)\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \$$1,\%eax\n\tcall ${T_DO_GC}\n/go;
534 s/^\tpushl \%eax\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tcall ${T_DO_GC}\n/go;
535 s/^\tpushl \%edx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%edx,\%eax\n\tcall ${T_DO_GC}\n/go;
537 #= if ( $StolenX86Regs <= 4 ) { # %ecx is ordinary reg
538 #= s/^\tpushl \%ecx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%ecx,\%eax\n\tcall ${T_DO_GC}\n/go;
541 # gotta watch out for weird instructions that
542 # invisibly smash various regs:
543 # rep* %ecx used for counting
544 # scas* %edi used for destination index
545 # cmps* %e[sd]i used for indices
546 # loop* %ecx used for counting
551 # * use of STG reg [ nn(%ebx) ] where no machine reg avail
553 # * GCC used an "STG reg" for its own purposes
555 # * some secret uses of machine reg, requiring STG reg
556 # to be saved/restored
558 # The most dangerous "GCC uses" of an "STG reg" are when
559 # the reg holds the target of a jmp -- it's tricky to
560 # insert the patch-up code before we get to the target!
561 # So here we change the jmps:
563 # --------------------------------------------------------
564 # it can happen that we have jumps of the form...
565 # jmp *<something involving %esp>
567 # jmp <something involving another naughty register...>
569 # a reasonably-common case is:
571 # movl $_blah,<bad-reg>
574 # which is easily fixed as:
576 # sigh! try to hack around it...
579 if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
580 s/^\tmovl (.*),\%esi\n\tjmp \*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
581 s/^\tjmp \*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
582 s/^\tjmp \*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
583 die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
584 if /(jmp|call) .*\%esi/;
586 if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
587 s/^\tmovl (.*),\%edi\n\tjmp \*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
588 s/^\tjmp \*(-?\d*)\((.*\%edi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
589 s/^\tjmp \*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
590 die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
591 if /(jmp|call) .*\%edi/;
593 #= if ($StolenX86Regs <= 4 ) { # spurious uses of ecx?
594 #= s/^\tmovl (.*),\%ecx\n\tjmp \*%ecx\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
595 #= s/^\tjmp \*(-?\d*)\((.*\%ecx.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
596 #= s/^\tjmp \*\%ecx\n/\tmovl \%ecx,\%eax\n\tjmp \*\%eax\n/g;
597 #= die "$Pgm: (mangler) still have jump involving \%ecx!\n$_"
598 #= if /(jmp|call) .*\%ecx/;
601 # OK, now we can decide what our patch-up code is going to
603 if ( $StolenX86Regs <= 2
604 && ( /32\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
605 $entry_patch .= "\tmovl \%esi,32(\%ebx)\n";
606 $exit_patch .= "\tmovl 32(\%ebx),\%esi\n";
607 # nothing for call_{entry,exit} because %esi is callee-save
609 if ( $StolenX86Regs <= 3
610 && ( /64\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # SpA (edi)
611 $entry_patch .= "\tmovl \%edi,64(\%ebx)\n";
612 $exit_patch .= "\tmovl 64(\%ebx),\%edi\n";
613 # nothing for call_{entry,exit} because %edi is callee-save
615 #= if ( $StolenX86Regs <= 4
616 #= && ( /80\(\%ebx\)/ || /\%ecx/ || /^\t(rep|loop)/ ) ) { # Hp (ecx)
617 #= $entry_patch .= "\tmovl \%ecx,80(\%ebx)\n";
618 #= $exit_patch .= "\tmovl 80(\%ebx),\%ecx\n";
620 #= $call_exit_patch .= "\tmovl \%ecx,108(\%ebx)\n";
621 #= $call_entry_patch .= "\tmovl 108(\%ebx),\%ecx\n";
622 #= # I have a really bad feeling about this if we ever
623 #= # have a nested call...
624 #= # NB: should just hide it somewhere in the C stack.
626 # --------------------------------------------------------
627 # next, here we go with non-%esp patching!
629 s/^(\t[a-z])/$entry_patch$1/; # before first instruction
630 s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
632 # fix _all_ non-local jumps:
634 s/^\tjmp \*${T_PRE_LLBL_PAT}/\tJMP___SL/go;
635 s/^\tjmp ${T_PRE_LLBL_PAT}/\tJMP___L/go;
637 s/^(\tjmp .*\n)/$exit_patch$1/g; # here's the fix...
639 s/^\tJMP___SL/\tjmp \*${T_PRE_LLBL}/go;
640 s/^\tJMP___L/\tjmp ${T_PRE_LLBL}/go;
642 # fix post-PerformGC wrapper (re-)entries ???
644 if ($StolenX86Regs == 2 ) {
645 die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_"
646 if /^\t(jmp|call) .*\%e(si|di)/;
647 #= die "ARGH! Jump uses \%esi, \%edi, or \%ecx with -monly-2-regs:\n$_"
648 #= if /^\t(jmp|call) .*\%e(si|di|cx)/;
649 } elsif ($StolenX86Regs == 3 ) {
650 die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_"
651 if /^\t(jmp|call) .*\%edi/;
652 #= die "ARGH! Jump uses \%edi or \%ecx with -monly-3-regs:\n$_"
653 #= if /^\t(jmp|call) .*\%e(di|cx)/;
654 #= } elsif ($StolenX86Regs == 4 ) {
655 #= die "ARGH! Jump uses \%ecx with -monly-4-regs:\n$_"
656 #= if /^\t(jmp|call) .*\%ecx/;
661 s/^\tmovl \%eax,36\(\%ebx\)\n\tjmp \*36\(\%ebx\)\n/\tmovl \%eax,36\(\%ebx\)\n\tjmp \*\%eax\n/;
663 # --------------------------------------------------------
664 # that's it -- print it
666 die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
670 if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
671 print OUTASM $exit_patch;
672 # ToDo: make it not print if there is a "jmp" at the end
678 sub init_FUNNY_THINGS {
679 %KNOWN_FUNNY_THING = (
680 "${T_US}CheckHeapCode${T_POST_LBL}", 1,
681 "${T_US}CommonUnderflow${T_POST_LBL}", 1,
682 "${T_US}Continue${T_POST_LBL}", 1,
683 "${T_US}EnterNodeCode${T_POST_LBL}", 1,
684 "${T_US}ErrorIO_call_count${T_POST_LBL}", 1,
685 "${T_US}ErrorIO_innards${T_POST_LBL}", 1,
686 "${T_US}IndUpdRetDir${T_POST_LBL}", 1,
687 "${T_US}IndUpdRetV0${T_POST_LBL}", 1,
688 "${T_US}IndUpdRetV1${T_POST_LBL}", 1,
689 "${T_US}IndUpdRetV2${T_POST_LBL}", 1,
690 "${T_US}IndUpdRetV3${T_POST_LBL}", 1,
691 "${T_US}IndUpdRetV4${T_POST_LBL}", 1,
692 "${T_US}IndUpdRetV5${T_POST_LBL}", 1,
693 "${T_US}IndUpdRetV6${T_POST_LBL}", 1,
694 "${T_US}IndUpdRetV7${T_POST_LBL}", 1,
695 "${T_US}PrimUnderflow${T_POST_LBL}", 1,
696 "${T_US}StackUnderflowEnterNode${T_POST_LBL}", 1,
697 "${T_US}StdErrorCode${T_POST_LBL}", 1,
698 "${T_US}UnderflowVect0${T_POST_LBL}", 1,
699 "${T_US}UnderflowVect1${T_POST_LBL}", 1,
700 "${T_US}UnderflowVect2${T_POST_LBL}", 1,
701 "${T_US}UnderflowVect3${T_POST_LBL}", 1,
702 "${T_US}UnderflowVect4${T_POST_LBL}", 1,
703 "${T_US}UnderflowVect5${T_POST_LBL}", 1,
704 "${T_US}UnderflowVect6${T_POST_LBL}", 1,
705 "${T_US}UnderflowVect7${T_POST_LBL}", 1,
706 "${T_US}UpdErr${T_POST_LBL}", 1,
707 "${T_US}UpdatePAP${T_POST_LBL}", 1,
708 "${T_US}WorldStateToken${T_POST_LBL}", 1,
709 "${T_US}_Enter_Internal${T_POST_LBL}", 1,
710 "${T_US}_PRMarking_MarkNextAStack${T_POST_LBL}", 1,
711 "${T_US}_PRMarking_MarkNextBStack${T_POST_LBL}", 1,
712 "${T_US}_PRMarking_MarkNextCAF${T_POST_LBL}", 1,
713 "${T_US}_PRMarking_MarkNextGA${T_POST_LBL}", 1,
714 "${T_US}_PRMarking_MarkNextRoot${T_POST_LBL}", 1,
715 "${T_US}_PRMarking_MarkNextSpark${T_POST_LBL}", 1,
716 "${T_US}_Scavenge_Forward_Ref${T_POST_LBL}", 1,
717 "${T_US}__std_entry_error__${T_POST_LBL}", 1,
718 "${T_US}_startMarkWorld${T_POST_LBL}", 1,
719 "${T_US}resumeThread${T_POST_LBL}", 1,
720 "${T_US}startCcRegisteringWorld${T_POST_LBL}", 1,
721 "${T_US}startEnterFloat${T_POST_LBL}", 1,
722 "${T_US}startEnterInt${T_POST_LBL}", 1,
723 "${T_US}startPerformIO${T_POST_LBL}", 1,
724 "${T_US}startStgWorld${T_POST_LBL}", 1,
725 "${T_US}stopPerformIO${T_POST_LBL}", 1
730 The following table reversal is used for both info tables and return
731 vectors. In both cases, we remove the first entry from the table,
732 reverse the table, put the label at the end, and paste some code
733 (that which is normally referred to by the first entry in the table)
734 right after the table itself. (The code pasting is done elsewhere.)
738 local($symb, $tbl, $discard1) = @_;
744 local(@lines) = split(/\n/, $tbl);
745 local($i, $extra, $words_to_pad, $j);
747 for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.long\s+/; $i++) {
748 $label .= $lines[$i] . "\n",
749 next if $lines[$i] =~ /^[A-Za-z0-9_]+_info:$/
750 || $lines[$i] =~ /^\.globl/
751 || $lines[$i] =~ /^${T_US}vtbl_\S+:$/;
753 $before .= $lines[$i] . "\n"; # otherwise...
756 for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.long\s+/; $i++) {
757 push(@words, $lines[$i]);
759 # now throw away the first word (entry code):
760 shift(@words) if $discard1;
762 # for 486-cache-friendliness, we want our tables aligned
763 # on 16-byte boundaries (.align 4). Let's pad:
764 $extra = ($#words + 1) % 4;
765 $words_to_pad = ($extra == 0) ? 0 : 4 - $extra;
766 for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t\.long 0"); }
768 for (; $i <= $#lines; $i++) {
769 $after .= $lines[$i] . "\n";
772 $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
774 # print STDERR "before=$before\n";
775 # print STDERR "label=$label\n";
776 # print STDERR "words=",(reverse @words),"\n";
777 # print STDERR "after=$after\n";
784 sub mini_mangle_asm {
785 local($in_asmf, $out_asmf) = @_;
787 &init_TARGET_STUFF();
789 open(INASM, "< $in_asmf")
790 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
791 open(OUTASM,"> $out_asmf")
792 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
798 /^${T_US}(PerformGC|StackOverflow|Yield|PerformReschedule)_wrapper${T_POST_LBL}\n/o;
799 print OUTASM "\tmovl \%esp, ${T_US}__temp_esp\n";
800 print OUTASM "\tmovl \%eax, ${T_US}__temp_eax\n";
804 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
805 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
808 # make "require"r happy...