summaryrefslogtreecommitdiff
path: root/ghc/driver/ghc-asm-sparc.lprl
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/driver/ghc-asm-sparc.lprl')
-rw-r--r--ghc/driver/ghc-asm-sparc.lprl487
1 files changed, 0 insertions, 487 deletions
diff --git a/ghc/driver/ghc-asm-sparc.lprl b/ghc/driver/ghc-asm-sparc.lprl
deleted file mode 100644
index ffe91ae3c6..0000000000
--- a/ghc/driver/ghc-asm-sparc.lprl
+++ /dev/null
@@ -1,487 +0,0 @@
-%************************************************************************
-%* *
-\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>) {
- 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 ( /^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;
-
- 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 ( /^_(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_]/ ) {
- 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!
-
- # 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/^\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/; # NB: paranoia
-
- 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