path: root/ghc/driver/ghc-asm-iX86.lprl

%************************************************************************
%*									*
\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}