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

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

Tasks:
\begin{itemize}
\item
Utterly stomp out C functions' prologues and epilogues; i.e., the
stuff to do with the C stack.
\item
(SPARC) [Related] Utterly stomp out the changing of register windows.
\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
    %num_infos = ();	# this symbol base has this many info tables (1-3)
    %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/;

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

	# toss all reg-window stuff (save/restore/ret[l] s):
	$c =~ s/^\t(save .*|restore|ret|retl)\n//g;
	# throw away PROLOGUE comments
	$c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;

	# 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+\n|\s+\.proc\s+\d+\n|\s+\.global\s+\S+\n|\.text\n|\.data\n|\.stab.*\n)FUNNY#END#THING/ ) {
	    $to_move = $1;

	    if ( $to_move =~ /\.(global|proc|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 STDERR "\nCHK $i (AFTER):\n", $c;
    }

    # print out all the literal strings first
    for ($i = 0; $i < $numchks; $i++) {
	if ( $chkcat[$i] eq 'string' ) {
	    print OUTASM "\.text\n\t\.align 8\n";
	    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 OUTASM $chk[$i];

	} elsif ( $chkcat[$i] eq 'data' ) {
	    print OUTASM "\.data\n\t\.align 8\n";
	    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];

#	print STDERR "$i: cat $chkcat[$i], symb $symb ",defined($closurechk{$symb}),":",defined($infochk{$symb}),":",defined($slowchk{$symb}),":",defined($fastchk{$symb}),"\n";

	    # CLOSURE
	    if ( defined($closurechk{$symb}) ) {
		print OUTASM "\.data\n\t\.align 4\n";
		print OUTASM $chk[$closurechk{$symb}];
		$chkcat[$closurechk{$symb}] = 'DONE ALREADY';
	    }

	    # INFO TABLE
	    if ( defined($infochk{$symb}) ) {

		print OUTASM "\.text\n\t\.align 4\n";
		print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
		# entry code will follow, 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/^\tcall _${symb}_fast\d+,.*\n\tnop\n//;
		$c =~ s/^\tcall _${symb}_fast\d+,.*\n(\t[a-z].*\n)/\1/;

		print STDERR "still has jump to fast entry point:\n$c"
		    if $c =~ /_${symb}_fast/;

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

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

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

    for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.word\s+/; $i++) {
	push(@words, $lines[$i]);
    }
    # now throw away the first word (entry code):
    shift(@words) if $discard1;

    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;
}
\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";
    }
}
\end{code}

How many times is each ``global variable'' used in a \tr{sethi}
instruction (SPARC)?  This can give some guidance about what should be
put in machine registers...

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

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

    local($globl);

    open(INASM, "< $asmf")  || &tidy_up_and_die(1,"$Pgm: failed to open `$asmf' (to read)\n");
    while (<INASM>) {
	if ( /^\tsethi \%hi\(_([_A-Za-z0-9]+)/ ) {
	    $globl = $1;
	    next if $globl =~ /(ds|fail|stg|tpl|vtbl)_[0-9]+/;

	    $SethiGlobal{$globl} ++;
	}
    }
    close(INASM) || &tidy_up_and_die(1,"Failed reading from $asmf\n");

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

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