%************************************************************************
%*									*
\section[Driver-asm-fiddling]{Fiddling with assembler files (HP-PA)}
%*									*
%************************************************************************

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}

HP specific notes:
\begin{itemize}
\item
The HP linker is very picky about symbols being in the appropriate
space (code vs. data).  When we mangle the threaded code to put the
info tables just prior to the code, they wind up in code space
rather than data space.  This means that references to *_info from
un-mangled parts of the RTS (e.g. unthreaded GC code) get
unresolved symbols.  Solution:  mini-mangler for .c files on HP.  I
think this should really be triggered in the driver by a new -rts
option, so that user code doesn't get mangled inappropriately.
\item
With reversed tables, jumps are to the _info label rather than to
the _entry label.  The _info label is just an address in code
space, rather than an entry point with the descriptive blob we
talked about yesterday.  As a result, you can't use the call-style
JMP_ macro.  However, some JMP_ macros take _info labels as targets
and some take code entry points within the RTS.  The latter won't
work with the goto-style JMP_ macro.  Sigh.  Solution: Use the goto
style JMP_ macro, and mangle some more assembly, changing all
"RP'literal" and "LP'literal" references to "R'literal" and
"L'literal," so that you get the real address of the code, rather
than the descriptive blob.  Also change all ".word P%literal"
entries in info tables and vector tables to just ".word literal,"
for the same reason.  Advantage: No more ridiculous call sequences.
\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 = ();	# ditto, normal info tbl
    %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 /^;/;

	if ( /^\s+/ ) { # most common case first -- a simple line!
	    # duplicated from the bottom
	    $chk[$i] .= $_;

	} elsif ( /^L\$C(\d+)$/ ) {
	    $chk[++$i] .= $_;
	    $chkcat[$i] = 'literal';
	    $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;

	    die "Info table already? $symb; $i\n" if defined($infochk{$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_]+)\s+\.comm/ ) {
	    $chk[++$i] .= $_;
	    $chkcat[$i] = 'bss';
  	    $chksymb[$i] = $1;

	} 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 ( /^[A-Za-z0-9_]/ && ! /^L\$\d+$/) {
	    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;

#    print STDERR "\nCLOSURES:\n";
#    foreach $s (sort (keys %closurechk)) {
#	print STDERR "$s:\t\t",$closurechk{$s},"\n";
#    }
#    print STDERR "\nNORMAL INFOS:\n";
#    foreach $s (sort (keys %infochk)) {
#	print STDERR "$s:\t\t",$infochk{$s},"\n";
#    }
#    print STDERR "SLOWS:\n";
#    foreach $s (sort (keys %slowchk)) {
#	print STDERR "$s:\t\t",$slowchk{$s},"\n";
#    }
#    print STDERR "\nFASTS:\n";
#    foreach $s (sort (keys %fastchk)) {
#	print STDERR "$s:\t\t",$fastchk{$s},"\n";
#    }

    # 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):\n", $c;

	# toss all prologue stuff
	$c =~ s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;

        # Lie about our .CALLINFO
        $c =~ s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;

	# Get rid of P'

	$c =~ s/LP'/L'/g;
	$c =~ s/RP'/R'/g;

#	print STDERR "\nCHK $i (STEP 1):\n", $c;

	# toss all epilogue stuff
	$c =~ s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;

#	print STDERR "\nCHK $i (STEP 2):\n", $c;

	# Sorry; we moved the _info stuff to the code segment.
	$c =~ s/_info,DATA/_info,CODE/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

#	print STDERR "\nCHK $i (STEP 3):\n", $c;
	while ($c =~ /^(\s+\.(IMPORT|EXPORT|PARAM).*\n)FUNNY#END#THING/
             || $c =~ /^(\s+\.align\s+\d+\n)FUNNY#END#THING/
	     || $c =~ /^(\s+\.(SPACE|SUBSPA)\s+\S+\n)FUNNY#END#THING/
             ||  $c =~ /^(\s*\n)FUNNY#END#THING/ ) {
	    $to_move = $1;

	    if ( $i < ($numchks - 1) && ($to_move =~ /^\s+\.(IMPORT|EXPORT)/ 
                || ($to_move =~ /align/ && $chkcat[$i+1] eq 'literal')) ) {
		$chk[$i + 1] = $to_move . $chk[$i + 1];
		# otherwise they're tossed
	    }
	    $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
	}
#	print STDERR "\nCHK $i (STEP 4):\n", $c;

	$c =~ s/FUNNY#END#THING//;
	$chk[$i] = $c; # update w/ convenience copy
    }

    # print out the header stuff first

    print OUTASM $chk[0];

    # print out all the literals second
    
    for ($i = 1; $i < $numchks; $i++) {
	if ( $chkcat[$i] eq 'literal' ) {
	    print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
	    print OUTASM $chk[$i];
	    print OUTASM "; end literal\n"; # for the splitter

	    $chkcat[$i] = 'DONE ALREADY';
	}
    }

    # print out all the bss third
    
    for ($i = 1; $i < $numchks; $i++) {
	if ( $chkcat[$i] eq 'bss' ) {
	    print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
	    print OUTASM $chk[$i];
	    
	    $chkcat[$i] = 'DONE ALREADY';
	}
    }

    for ($i = 1; $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 "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
	    print OUTASM $chk[$i];

	} elsif ( $chkcat[$i] eq 'data' ) {
	    print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
	    print OUTASM $chk[$i];

	} elsif ( $chkcat[$i] eq 'consist' ) {
	    if ( $chk[$i] =~ /\.STRING.*\)(hsc|cc) (.*)\\x09(.*)\\x00/ ) {
		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 "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n$consist\n";
	    } else {
		print STDERR "Couldn't grok consistency: ", $chk[$i];
	    }

	} elsif ( $chkcat[$i] eq 'splitmarker' ) {
	    # we can just re-constitute this one...
    	    # ignore the final split marker, to save an empty object module
    	    # Use _three_ underscores so that ghc-split doesn't get overly complicated
	    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 "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
		print OUTASM $chk[$closurechk{$symb}];
		$chkcat[$closurechk{$symb}] = 'DONE ALREADY';
	    }

	    # INFO TABLE
	    if ( defined($infochk{$symb}) ) {
		print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
		print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
		# entry code will be put here!

		# paranoia
		if ( $chk[$infochk{$symb}] =~ /\.word\s+([A-Za-z0-9_]+_entry)$/
		  && $1 ne "${symb}_entry" ) {
		    print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
		}

		$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}];
    	    	if ( defined($fastchk{$symb}) ) {
    		    $c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
    	    	}

		# ToDo: ???? any good way to look for "dangling" references
		# to fast-entry pt ???

		print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
		print OUTASM $c;
		$chkcat[$slowchk{$symb}] = 'DONE ALREADY';
	    }
	    
	    # FAST ENTRY POINT
	    if ( defined($fastchk{$symb}) ) {
    	    	$c = $chk[$fastchk{$symb}];
    	    	if ( ! defined($slowchk{$symb}) ) {
		    print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
    	    	}
		print OUTASM $c;
		$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 "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
		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 "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
		print OUTASM $chk[$directchk{$symb}];
		$chkcat[$directchk{$symb}] = 'DONE ALREADY';
	    }
	} else {
	    &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm hppa)\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}

The HP is a major nuisance.  The threaded code mangler moved info tables
from data space to code space, but unthreaded code in the RTS still has
references to info tables in data space.  Since the HP linker is very precise
about where symbols live, we need to patch the references in the unthreaded
RTS as well.

\begin{code}

sub mini_mangle_asm {
    local($in_asmf, $out_asmf) = @_;

    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");

    while (<INASM>) {
	s/_info,DATA/_info,CODE/;   # Move _info references to code space
	s/P%_PR/_PR/;
	print OUTASM;
    }

    # 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 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(@imports) = ();
    local(@words) = ();
    local($after) = '';
    local(@lines) = split(/\n/, $tbl);
    local($i);

    for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\s+\.word\s+/; $i++) {
	$label .= $lines[$i] . "\n",
	    next if $lines[$i] =~ /^[A-Za-z0-9_]+$/
		 || $lines[$i] =~ /^\s+\.EXPORT/;

	$before .= $lines[$i] . "\n"; # otherwise...
    }

    for ( ; $i <= $#lines && $lines[$i] =~ /^\s+\.(word|IMPORT)/; $i++) {
	if ($lines[$i] =~ /^\s+\.IMPORT/) {
	    push(@imports, $lines[$i]);
	} else {
	    # We don't use HP's ``function pointers''
            # We just use labels in code space, like normal people
	    $lines[$i] =~ s/P%//;
	    push(@words, $lines[$i]);
	}
    }
    # now throw away the first word (entry code):
    if ($discard1) {
	shift(@words);
    }

    for (; $i <= $#lines; $i++) {
	$after .= $lines[$i] . "\n";
    }

    $tbl = $before . join("\n", @imports) . "\n" .
           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;
}
\end{code}

%************************************************************************
%*									*
\subsection[Driver-asm-info]{Collect interesting (static) info from an assembler file}
%*									*
%************************************************************************

How many times is each asm instruction used?

\begin{code}
%AsmInsn = (); # init

sub dump_asm_insn_counts {
    local($asmf) = @_;

    open(INASM, "< $asmf")  || &tidy_up_and_die(1,"$Pgm: failed to open `$asmf' (to read)\n");
    while (<INASM>) {
	if ( /^\t([a-z][a-z0-9]+)\b/ ) {
	    $AsmInsn{$1} ++;
	}
    }
    close(INASM) || &tidy_up_and_die(1,"Failed reading from $asmf\n");

    # OK, now print what we collected (to stderr)
    foreach $i (sort (keys %AsmInsn)) {
	print STDERR "INSN:: $i\t",$AsmInsn{$i},"\n";
    }
}

sub dump_asm_globals_info {
}

# make "require"r happy...
1;
\end{code}