diff options
Diffstat (limited to 'ghc/driver/ghc-asm-iX86.lprl')
| -rw-r--r-- | ghc/driver/ghc-asm-iX86.lprl | 640 |
1 files changed, 640 insertions, 0 deletions
diff --git a/ghc/driver/ghc-asm-iX86.lprl b/ghc/driver/ghc-asm-iX86.lprl new file mode 100644 index 0000000000..941ff68af9 --- /dev/null +++ b/ghc/driver/ghc-asm-iX86.lprl @@ -0,0 +1,640 @@ +%************************************************************************ +%* * +\section[Driver-asm-fiddling]{Fiddling with assembler files (iX86)} +%* * +%************************************************************************ + +Tasks: +\begin{itemize} +\item +Utterly stomp out C functions' prologues and epilogues; i.e., the +stuff to do with the C stack. +\item +Any other required tidying up. +\end{itemize} + +\begin{code} +sub mangle_asm { + local($in_asmf, $out_asmf) = @_; + + # multi-line regexp matching: + local($*) = 1; + local($i, $c); + &init_FUNNY_THINGS(); + + open(INASM, "< $in_asmf") + || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n"); + open(OUTASM,"> $out_asmf") + || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n"); + + # read whole file, divide into "chunks": + # record some info about what we've found... + + @chk = (); # contents of the chunk + $numchks = 0; # number of them + @chkcat = (); # what category of thing in each chunk + @chksymb = (); # what symbol(base) is defined in this chunk + %slowchk = (); # ditto, its regular "slow" entry code + %fastchk = (); # ditto, fast entry code + %closurechk = (); # ditto, the (static) closure + %infochk = (); # given a symbol base, say what chunk its info tbl is in + %vectorchk = (); # ditto, return vector table + %directchk = (); # ditto, direct return code + + $i = 0; + $chkcat[0] = 'misc'; + + while (<INASM>) { +#??? next if /^\.stab.*___stg_split_marker/; +#??? next if /^\.stab.*ghc.*c_ID/; + next if /^#(NO_)?APP/; + + if ( /^\s+/ ) { # most common case first -- a simple line! + # duplicated from the bottom + + $chk[$i] .= $_; + + } elsif ( /^_(ret_|djn_)/ ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'misc'; + $chksymb[$i] = ''; + + } elsif ( /^_vtbl_([A-Za-z0-9_]+):$/ ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'vector'; + $chksymb[$i] = $1; + + $vectorchk{$1} = $i; + + } elsif ( /^_([A-Za-z0-9_]+)DirectReturn:$/ ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'direct'; + $chksymb[$i] = $1; + + $directchk{$1} = $i; + + } elsif ( /^_[A-Za-z0-9_]+_upd:$/ ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'misc'; + $chksymb[$i] = ''; + + } elsif ( /^LC(\d+):$/ ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'string'; + $chksymb[$i] = $1; + + } elsif ( /^___stg_split_marker(\d+):$/ ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'splitmarker'; + $chksymb[$i] = $1; + + } elsif ( /^_([A-Za-z0-9_]+)_info:$/ ) { + $symb = $1; + $chk[++$i] .= $_; + $chkcat[$i] = 'infotbl'; + $chksymb[$i] = $symb; + + $infochk{$symb} = $i; + + } elsif ( /^_([A-Za-z0-9_]+)_entry:$/ ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'slow'; + $chksymb[$i] = $1; + + $slowchk{$1} = $i; + + } elsif ( /^_([A-Za-z0-9_]+)_fast\d+:$/ ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'fast'; + $chksymb[$i] = $1; + + $fastchk{$1} = $i; + + } elsif ( /^_([A-Za-z0-9_]+)_closure:$/ ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'closure'; + $chksymb[$i] = $1; + + $closurechk{$1} = $i; + + } elsif ( /^_ghc.*c_ID:/ ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'consist'; + + } elsif ( /^(___gnu_compiled_c|gcc2_compiled\.):/ ) { + ; # toss it + + } elsif ( /^_ErrorIO_call_count:/ # HACK!!!! + || /^_[A-Za-z0-9_]+\.\d+:$/ + || /^_.*_CAT:/ # PROF: _entryname_CAT + || /^_CC_.*_struct:/ # PROF: _CC_ccident_struct + || /^_.*_done:/ # PROF: _module_done + || /^__module_registered:/ # PROF: _module_registered + ) { + $chk[++$i] .= $_; + $chkcat[$i] = 'data'; + $chksymb[$i] = ''; + + } elsif ( /^_[A-Za-z0-9_]/ ) { + local($thing); + chop($thing = $_); + print STDERR "Funny global thing?: $_" + unless $KNOWN_FUNNY_THING{$thing} + || /^__(PRIn|PRStart).*:/ # pointer reversal GC routines + || /^_CC_.*:/ # PROF: _CC_ccident + || /^__reg.*:/; # PROF: __reg<module> + $chk[++$i] .= $_; + $chkcat[$i] = 'misc'; + $chksymb[$i] = ''; + + } else { # simple line (duplicated at the top) + + $chk[$i] .= $_; + } + } + $numchks = $#chk + 1; + + # the division into chunks is imperfect; + # we throw some things over the fence into the next + # chunk. + # + # also, there are things we would like to know + # about the whole module before we start spitting + # output. + + # NB: we start meddling at chunk 1, not chunk 0 + + for ($i = 1; $i < $numchks; $i++) { + $c = $chk[$i]; # convenience copy + +# print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c; + + # toss all prologue stuff; + # be slightly paranoid to make sure there's + # nothing surprising in there + if ( $c =~ /--- BEGIN ---/ ) { + if (($p, $r) = split(/--- BEGIN ---/, $c)) { + $p =~ s/^\tpushl \%edi\n//; + $p =~ s/^\tpushl \%esi\n//; + $p =~ s/^\tsubl \$\d+,\%esp\n//; + die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/; + + # glue together what's left + $c = $p . $r; + } + } + + # toss all epilogue stuff; again, paranoidly + if ( $c =~ /--- END ---/ ) { + if (($r, $e) = split(/--- END ---/, $c)) { + $e =~ s/^\tret\n//; + $e =~ s/^\tpopl \%edi\n//; + $e =~ s/^\tpopl \%esi\n//; + $e =~ s/^\taddl \$\d+,\%esp\n//; + die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/; + + # glue together what's left + $c = $r . $e; + } + } + + # toss all calls to __DISCARD__ + $c =~ s/^\tcall ___DISCARD__\n//g; + + # pin a funny end-thing on (for easier matching): + $c .= 'FUNNY#END#THING'; + + # pick some end-things and move them to the next chunk + + while ( $c =~ /^\s*(\.align\s+\d+(,0x90)?\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.stab[^n].*\n)FUNNY#END#THING/ ) { + $to_move = $1; + + if ( $to_move =~ /\.(globl|stab)/ && $i < ($numchks - 1) ) { + $chk[$i + 1] = $to_move . $chk[$i + 1]; + # otherwise they're tossed + } + + $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/; + } + + $c =~ s/FUNNY#END#THING//; + $chk[$i] = $c; # update w/ convenience copy + } + + # print out all the literal strings first + for ($i = 0; $i < $numchks; $i++) { + if ( $chkcat[$i] eq 'string' ) { + print OUTASM "\.text\n\t\.align 4\n"; + # not sure what alignment is required (WDP 95/02) + # .align 4 (on 16-byte boundaries) is 486-cache friendly + print OUTASM $chk[$i]; + + $chkcat[$i] = 'DONE ALREADY'; + } + } + + for ($i = 0; $i < $numchks; $i++) { +# print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n"; + + next if $chkcat[$i] eq 'DONE ALREADY'; + + if ( $chkcat[$i] eq 'misc' ) { + print OUTASM "\.text\n\t\.align 4\n"; + &print_doctored($chk[$i], 0); + + } elsif ( $chkcat[$i] eq 'data' ) { + print OUTASM "\.data\n\t\.align 2\n"; # ToDo: change align?? + print OUTASM $chk[$i]; + + } elsif ( $chkcat[$i] eq 'consist' ) { + if ( $chk[$i] =~ /\.ascii.*\)(hsc|cc) (.*)\\11"\n\t\.ascii\s+"(.*)\\0"/ ) { + local($consist) = "$1.$2.$3"; + $consist =~ s/,/./g; + $consist =~ s/\//./g; + $consist =~ s/-/_/g; + $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly? + print OUTASM "\.text\n$consist:\n"; + } else { + print STDERR "Couldn't grok consistency: ", $chk[$i]; + } + + } elsif ( $chkcat[$i] eq 'splitmarker' ) { + # we can just re-constitute this one... + print OUTASM "___stg_split_marker",$chksymb[$i],":\n"; + + } elsif ( $chkcat[$i] eq 'closure' + || $chkcat[$i] eq 'infotbl' + || $chkcat[$i] eq 'slow' + || $chkcat[$i] eq 'fast' ) { # do them in that order + $symb = $chksymb[$i]; + + # CLOSURE + if ( defined($closurechk{$symb}) ) { + print OUTASM "\.data\n\t\.align 2\n"; # ToDo: change align? + print OUTASM $chk[$closurechk{$symb}]; + $chkcat[$closurechk{$symb}] = 'DONE ALREADY'; + } + + # INFO TABLE + if ( defined($infochk{$symb}) ) { + + print OUTASM "\.text\n\t\.align 4\n"; # NB: requires padding + print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1); + # entry code will be put here! + + $chkcat[$infochk{$symb}] = 'DONE ALREADY'; + } + + # STD ENTRY POINT + if ( defined($slowchk{$symb}) ) { + + # teach it to drop through to the fast entry point: + $c = $chk[$slowchk{$symb}]; + $c =~ s/^\tmovl \$_${symb}_fast\d+,\%edx\n\tjmp \*\%edx\n//; + $c =~ s/^\tmovl \$_${symb}_fast\d+,\%eax\n\tjmp \*\%eax\n//; + + print STDERR "still has jump to fast entry point:\n$c" + if $c =~ /_${symb}_fast/; + + print OUTASM "\.text\n\t\.align 4\n"; + &print_doctored($c, 1); # NB: the 1!!! + $chkcat[$slowchk{$symb}] = 'DONE ALREADY'; + } + + # FAST ENTRY POINT + if ( defined($fastchk{$symb}) ) { + print OUTASM "\.text\n\t\.align 4\n"; # Fills w/ no-ops! + &print_doctored($chk[$fastchk{$symb}], 0); + $chkcat[$fastchk{$symb}] = 'DONE ALREADY'; + } + + } elsif ( $chkcat[$i] eq 'vector' + || $chkcat[$i] eq 'direct' ) { # do them in that order + $symb = $chksymb[$i]; + + # VECTOR TABLE + if ( defined($vectorchk{$symb}) ) { + print OUTASM "\.text\n\t\.align 4\n"; # NB: requires padding + print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0); + # direct return code will be put here! + $chkcat[$vectorchk{$symb}] = 'DONE ALREADY'; + } + + # DIRECT RETURN + if ( defined($directchk{$symb}) ) { + print OUTASM "\.text\n\t\.align 4\n"; + &print_doctored($chk[$directchk{$symb}], 0); + $chkcat[$directchk{$symb}] = 'DONE ALREADY'; + } + + } else { + &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm iX86)\n$chkcat[$i]\n$chk[$i]\n"); + } + } + # finished + close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n"); + close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n"); +} +\end{code} + +\begin{code} +sub print_doctored { + local($_, $need_fallthru_patch) = @_; + + if ( ! /^\t[a-z]/ ) { # no instructions in here, apparently + print OUTASM $_; + + } else { # must do some **HACKING** + local($entry_patch) = ''; + local($exit_patch) = ''; + local($call_entry_patch)= ''; + local($call_exit_patch) = ''; + local($sp_entry_patch) = ''; + local($sp_exit_patch) = ''; + + # gotta watch out for weird instructions that + # invisibly smash various regs: + # rep* %ecx used for counting + # scas* %edi used for destination index + # cmps* %e[sd]i used for indices + # loop* %ecx used for counting + # + # SIGH. + print STDERR "WEIRD INSN!\n$_" if /^\t(rep|scas|loop|cmps)/; + + # WDP: this still looks highly dubious to me. 95/07 + # We cater for: + # * use of STG reg [ nn(%ebx) ] where no machine reg avail + # * some secret uses of machine reg, requiring STG reg + # to be saved/restored + # * but what about totally-unexpected uses of machine reg? + # (maybe I've forgotten how this works...) + + if ( $StolenX86Regs < 3 + && ( /32\(\%ebx\)/ || /^\tcmps/ ) ) { # R1 (esi) + $entry_patch .= "\tmovl \%esi,32(\%ebx)\n"; + $exit_patch .= "\tmovl 32(\%ebx),\%esi\n"; + # nothing for call_{entry,exit} because %esi is callee-save + } + if ( $StolenX86Regs < 4 + && ( /64\(\%ebx\)/ || /^\t(scas|cmps)/ ) ) { # SpA (edi) + $entry_patch .= "\tmovl \%edi,64(\%ebx)\n"; + $exit_patch .= "\tmovl 64(\%ebx),\%edi\n"; + # nothing for call_{entry,exit} because %edi is callee-save + } + if ( $StolenX86Regs < 5 + && ( /36\(\%ebx\)/ || /^\t(rep|loop)/ ) ) { # R2 (ecx) + $entry_patch .= "\tmovl \%ecx,36(\%ebx)\n"; + $exit_patch .= "\tmovl 36(\%ebx),\%ecx\n"; + + $call_exit_patch .= "\tmovl \%ecx,108(\%ebx)\n"; + $call_entry_patch .= "\tmovl 108(\%ebx),\%ecx\n"; + } + # first, convert calls to *very magic form*: (ToDo: document for real!) + # from + # pushl $768 + # call _PerformGC_wrapper + # addl $4,%esp + # to + # movl $768, %eax + # call _PerformGC_wrapper + # + # Special macros in ghc/includes/COptWraps.lh, used in + # ghc/runtime/CallWrap_C.lc, are required for this to work! + # + s/^\tpushl \$(\d+)\n\tcall _PerformGC_wrapper\n\taddl \$4,\%esp\nL(\d+):\n/\tmovl \$$1,\%eax\n\tmovl \$L$2a,104\(\%ebx\)\n\tmovl \$_PerformGC_wrapper,\%edx\n\tjmp \*\%edx\nL$2a:\n__SP_ENTRY_PATCH__L$2:\n/g; + s/^\tpushl \%eax\n\tcall _PerformGC_wrapper\n\taddl \$4,\%esp\nL(\d+):\n/\tmovl \$L$1a,104\(\%ebx\)\n\tmovl \$_PerformGC_wrapper,\%edx\n\tjmp \*\%edx\nL$1a:\n__SP_ENTRY_PATCH__L$1:\n/g; + + s/^\tpushl \%edx\n\tcall _PerformGC_wrapper\n\taddl \$4,\%esp\nL(\d+):\n/\tmovl \%edx,\%eax\n\tmovl \$L$1a,104\(\%ebx\)\n\tmovl \$_PerformGC_wrapper,\%edx\n\tjmp \*\%edx\nL$1a:\n__SP_ENTRY_PATCH__L$1:\n/g; + + if ( $StolenX86Regs < 5 ) { # %ecx is ordinary reg + s/^\tpushl \%ecx\n\tcall _PerformGC_wrapper\n\taddl \$4,\%esp\nL(\d+):\n/\tmovl \%ecx,\%eax\n\tmovl \$L$1a,104\(\%ebx\)\n\tmovl \$_PerformGC_wrapper,\%edx\n\tjmp \*\%edx\nL$1a:\n__SP_ENTRY_PATCH__L$1:\n/g; + } + + die "PerformGC_wrapper still alive!\n$_" if / _PerformGC_wrapper/; + + # -------------------------------------------------------- + # OK, now acct for the fact that %esp holds Hp on entry; + # + # * must hold C-stack ptr if we go to C + # * must get Hp ( 80(%ebx) ) back in it if we come back from C + # * must hold Hp when we go on to the next guy + # * don't worry about PerformGC_wrapper -- it is magic + # * we have a "save location" for %esp ( 100(%ebx) ) + # * because C-stack ptr doesn't change in Haskell-land, + # we don't have to save it -- just restore it when + # necessary. + # + if ( $SpX86Mangling ) { # NB: not used in RTS + if ( /(\tcall |\tpushl |\%esp)/ ) { # *anything* C-stack-ish... + # then we patch up... + $sp_entry_patch = "\tmovl \%esp,80(\%ebx)\n\tmovl 100(\%ebx),%esp\n"; + $sp_exit_patch = "\tmovl 80(\%ebx),\%esp\n"; + + } elsif ( /80\(\%ebx\)/ ) { # no C-stack stuff: try to squash Hp refs! + $sp_entry_patch = ''; + $sp_exit_patch = ''; + + # mangle heap-check code + + s/\tmovl 80\(\%ebx\),%eax\n\taddl \$(\d+),\%eax\n\tmovl \%eax,80\(\%ebx\)\n\tcmpl \%eax,84\(\%ebx\)\n/\taddl \$$1,\%esp\n\tcmpl \%esp,84\(\%ebx\)\n/g; + + # mangle other Hp refs + s/80\(\%ebx\)/\%esp/g; + + # squash some repeated reloadings of Hp + while ( /\tmovl \%esp,\%eax\n\t([a-z].*)\n\tmovl \%esp,\%eax\n/ ) { + local($x) = $1; + $x =~ s/\%eax/\%esp/g; + s/\tmovl \%esp,\%eax\n\t([a-z].*)\n\tmovl \%esp,\%eax\n/\t$x\n\tmovl \%esp,\%eax\n/; + } + + while ( /\tmovl \%esp,\%edx\n\t([a-z].*)\n\tmovl \%esp,\%edx\n/ ) { + local($x) = $1; + $x =~ s/\%edx/\%esp/g; + s/\tmovl \%esp,\%edx\n\t([a-z].*)\n\tmovl \%esp,\%edx\n/\t$x\n\tmovl \%esp,\%edx\n/; + } + + if ( $StolenX86Regs < 5 ) { # %ecx is ordinary reg + while ( /\tmovl \%esp,\%ecx\n\t([a-z].*)\n\tmovl \%esp,\%ecx\n/ ) { + local($x) = $1; + $x =~ s/\%ecx/\%esp/g; + s/\tmovl \%esp,\%ecx\n\t([a-z].*)\n\tmovl \%esp,\%ecx\n/\t$x\n\tmovl \%esp,\%ecx\n/; + } + } + + s/\tmovl \%esp,\%eax\n\tmovl \%eax,\%edx\n\taddl \$-(\d+),\%edx\n\tmovl \%edx,(-\d+)?\(\%eax\)\n/\tmovl \%esp,\%edx\n\taddl \$-$1,\%edx\n\tmovl \%edx,$2\(\%esp\)\n/g; + + } + } + + # -------------------------------------------------------- + # next, here we go with non-%esp patching! + # + s/^(\t[a-z])/$sp_entry_patch$entry_patch$1/; # before first instruction + s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls + + if ($StolenX86Regs == 2 ) { # YURGH! spurious uses of esi,edi,ecx? + s/^(\tjmp .*)(\%esi|\%edi|\%ecx)(.*\n)/\tmovl $2,\%eax\n$1\%eax$3/g; + } elsif ($StolenX86Regs == 3 ) { # spurious uses of edi,ecx? + s/^(\tjmp .*)(\%edi|\%ecx)(.*\n)/\tmovl $2,\%eax\n$1\%eax$3/g; + } elsif ($StolenX86Regs == 4 ) { # spurious uses of ecx? + s/^(\tjmp .*)(\%ecx)(.*\n)/\tmovl $2,\%eax\n$1\%eax$3/g; + } + + s/^\tjmp \*L/\tJMP___L/g; + +#testing: +# while ( /^(\tjmp (\*)?[^L].*\n)/ && $sp_exit_patch ) { +# print STDERR "Converting\n$1to\n$sp_exit_patch$exit_patch$1"; +# s/^(\tjmp)( (\*)?[^L].*\n)/$sp_exit_patch$exit_patch\tJMPME$2/; +# } + + # fix _all_ non-local jumps + s/^(\tjmp (\*)?[^L].*\n)/$sp_exit_patch$exit_patch$1/g; + +#test: s/JMPME/jmp /g; + + s/^\tJMP___L/\tjmp \*L/g; + + # fix post-PerformGC wrapper (re-)entries + s/__SP_ENTRY_PATCH__/$sp_entry_patch/g; + + if ($StolenX86Regs == 2 ) { + die "ARGH! Jump uses \%esi, \%edi, or \%ecx with -monly-2-regs:\n$_" + if /^\t(jmp|call) .*\%e(si|di|cx)/; + } elsif ($StolenX86Regs == 3 ) { + die "ARGH! Jump uses \%edi or \%ecx with -monly-3-regs:\n$_" + if /^\t(jmp|call) .*\%e(di|cx)/; + } elsif ($StolenX86Regs == 4 ) { + die "ARGH! Jump uses \%ecx with -monly-4-regs:\n$_" + if /^\t(jmp|call) .*\%ecx/; + } + + # final peephole fix + s/^\tmovl 36\(\%ebx\),\%ecx\n\tjmp \*36\(\%ebx\)\n/\tmovl 36\(\%ebx\),\%ecx\n\tjmp \*\%ecx\n/; + + # -------------------------------------------------------- + # that's it -- print it + # + die "Funny jumps?\n$_" if /^\tjmp [^L\*]/; # paranoia + + print OUTASM $_; + + if ( $need_fallthru_patch ) { # exit patch for end of slow entry code + print OUTASM $sp_exit_patch, $exit_patch; + # ToDo: make it not print if there is a "jmp" at the end + } + } +} +\end{code} + +\begin{code} +sub init_FUNNY_THINGS { + %KNOWN_FUNNY_THING = ( + '_CheckHeapCode:', 1, + '_CommonUnderflow:', 1, + '_Continue:', 1, + '_EnterNodeCode:', 1, + '_ErrorIO_call_count:', 1, + '_ErrorIO_innards:', 1, + '_IndUpdRetDir:', 1, + '_IndUpdRetV0:', 1, + '_IndUpdRetV1:', 1, + '_IndUpdRetV2:', 1, + '_IndUpdRetV3:', 1, + '_IndUpdRetV4:', 1, + '_IndUpdRetV5:', 1, + '_IndUpdRetV6:', 1, + '_IndUpdRetV7:', 1, + '_PrimUnderflow:', 1, + '_StackUnderflowEnterNode:', 1, + '_StdErrorCode:', 1, + '_UnderflowVect0:', 1, + '_UnderflowVect1:', 1, + '_UnderflowVect2:', 1, + '_UnderflowVect3:', 1, + '_UnderflowVect4:', 1, + '_UnderflowVect5:', 1, + '_UnderflowVect6:', 1, + '_UnderflowVect7:', 1, + '_UpdErr:', 1, + '_UpdatePAP:', 1, + '_WorldStateToken:', 1, + '__Enter_Internal:', 1, + '__PRMarking_MarkNextAStack:', 1, + '__PRMarking_MarkNextBStack:', 1, + '__PRMarking_MarkNextCAF:', 1, + '__PRMarking_MarkNextGA:', 1, + '__PRMarking_MarkNextRoot:', 1, + '__PRMarking_MarkNextSpark:', 1, + '__Scavenge_Forward_Ref:', 1, + '___std_entry_error__:', 1, + '__startMarkWorld:', 1, + '_resumeThread:', 1, + '_startCcRegisteringWorld:', 1, + '_startEnterFloat:', 1, + '_startEnterInt:', 1, + '_startPerformIO:', 1, + '_startStgWorld:', 1, + '_stopPerformIO:', 1 + ); +} +\end{code} + +The following table reversal is used for both info tables and return +vectors. In both cases, we remove the first entry from the table, +reverse the table, put the label at the end, and paste some code +(that which is normally referred to by the first entry in the table) +right after the table itself. (The code pasting is done elsewhere.) + +\begin{code} +sub rev_tbl { + local($symb, $tbl, $discard1) = @_; + + local($before) = ''; + local($label) = ''; + local(@words) = (); + local($after) = ''; + local(@lines) = split(/\n/, $tbl); + local($i, $extra, $words_to_pad, $j); + + for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.long\s+/; $i++) { + $label .= $lines[$i] . "\n", + next if $lines[$i] =~ /^[A-Za-z0-9_]+_info:$/ + || $lines[$i] =~ /^\.globl/ + || $lines[$i] =~ /^_vtbl_\S+:$/; + + $before .= $lines[$i] . "\n"; # otherwise... + } + + for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.long\s+/; $i++) { + push(@words, $lines[$i]); + } + # now throw away the first word (entry code): + shift(@words) if $discard1; + + # for 486-cache-friendliness, we want our tables aligned + # on 16-byte boundaries (.align 4). Let's pad: + $extra = ($#words + 1) % 4; + $words_to_pad = ($extra == 0) ? 0 : 4 - $extra; + for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t\.long 0"); } + + for (; $i <= $#lines; $i++) { + $after .= $lines[$i] . "\n"; + } + + $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after; + +# print STDERR "before=$before\n"; +# print STDERR "label=$label\n"; +# print STDERR "words=",(reverse @words),"\n"; +# print STDERR "after=$after\n"; + + $tbl; +} + +# make "require"r happy... +1; + +\end{code} |