summaryrefslogtreecommitdiff
path: root/ghc/driver/ghc-asm-solaris.lprl
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/driver/ghc-asm-solaris.lprl')
-rw-r--r--ghc/driver/ghc-asm-solaris.lprl487
1 files changed, 487 insertions, 0 deletions
diff --git a/ghc/driver/ghc-asm-solaris.lprl b/ghc/driver/ghc-asm-solaris.lprl
new file mode 100644
index 0000000000..e4a313919a
--- /dev/null
+++ b/ghc/driver/ghc-asm-solaris.lprl
@@ -0,0 +1,487 @@
+%************************************************************************
+%* *
+\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
+ %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>) {
+
+ 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 ( /^\.LLC(\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;
+
+# print STDERR "\nCLOSURES:\n";
+# foreach $s (sort (keys %closurechk)) {
+# print STDERR "$s:\t\t",$closurechk{$s},"\n";
+# }
+# print STDERR "\nINFOS:\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 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|\.section.*\n|\s+\.type.*\n|\s+\.size.*\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 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 = 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 "\.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] =~ /\.asciz.*\)(hsc|cc) (.*)\\t(.*)"/ ) {
+ 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 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 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/^\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}
View Lorry Controller Status