summaryrefslogtreecommitdiff
path: root/ghc/driver/ghc-asm-alpha.lprl
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/driver/ghc-asm-alpha.lprl')
-rw-r--r--ghc/driver/ghc-asm-alpha.lprl521
1 files changed, 0 insertions, 521 deletions
diff --git a/ghc/driver/ghc-asm-alpha.lprl b/ghc/driver/ghc-asm-alpha.lprl
deleted file mode 100644
index 23ee45a16f..0000000000
--- a/ghc/driver/ghc-asm-alpha.lprl
+++ /dev/null
@@ -1,521 +0,0 @@
-%************************************************************************
-%* *
-\section[Driver-asm-fiddling]{Fiddling with assembler files (alpha)}
-%* *
-%************************************************************************
-
-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 /^\s*$/;
-
- if ( /^\s+/ ) { # most common case first -- a simple line!
- # duplicated from the bottom
- $chk[$i] .= $_;
-
- } elsif ( /\.\.ng:$/ ) { # Local labels not to be confused with new chunks
- $chk[$i] .= $_;
-
- } elsif ( /^\$C(\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;
-
-# 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
-
- # the first ".rdata" is quite magical; as of GCC 2.7.x, it
- # spits a ".quad 0" in after the v first ".rdata"; we
- # detect this special case (tossing the ".quad 0")!
- $magic_rdata_seen = 0;
-
- for ($i = 1; $i < $numchks; $i++) {
- $c = $chk[$i]; # convenience copy
-
-# print STDERR "\nCHK $i (BEFORE):\n", $c;
-
- # pin a funny end-thing on (for easier matching):
- $c .= 'FUNNY#END#THING';
-
- if ( ! $magic_rdata_seen && $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
- $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
- $magic_rdata_seen = 1;
- }
-
- # pick some end-things and move them to the next chunk
-
- while ( $c =~ /^(\s*\.align\s+\d+\n)FUNNY#END#THING/
- || $c =~ /^(\s*\.(globl|ent)\s+\S+\n)FUNNY#END#THING/
- || $c =~ /^(\s*\#.*\n)FUNNY#END#THING/
- || $c =~ /^(\s*\.(file|loc)\s+\S+\s+\S+\n)FUNNY#END#THING/
- || $c =~ /^(\s*\.text\n|\s*\.r?data\n)FUNNY#END#THING/ ) {
- $to_move = $1;
-
- if ( $to_move =~ /^\s*(\#|\.(file|globl|ent|loc))/ && $i < ($numchks - 1) ) {
- $chk[$i + 1] = $to_move . $chk[$i + 1];
- # otherwise they're tossed
- }
-
- $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
- }
-
- if ($c =~ /^\t\.ent\s+(\S+)/) {
- $ent = $1;
- # toss all prologue stuff, except for loading gp, and the ..ng address
- if (($p, $r) = split(/^\t\.prologue/, $c)) {
-# print STDERR "$ent: prologue:\n$p\nrest:\n$r\n";
- if (($keep, $junk) = split(/\.\.ng:/, $p)) {
- $c = $keep . "..ng:\n";
- } else {
- print STDERR "malformed code block ($ent)?\n"
- }
- }
- $c .= "\t.frame \$30,0,\$26,0\n\t.prologue" . $r;
- }
-
- $c =~ s/FUNNY#END#THING//;
- $chk[$i] = $c; # update w/ convenience copy
-
-# print STDERR "\nCHK $i (AFTER):\n", $c;
- }
-
- # print out the header stuff first
-
- $chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/\1"$ifile_root.hc"/;
- print OUTASM $chk[0];
-
- # print out all the literal strings second
- for ($i = 1; $i < $numchks; $i++) {
- if ( $chkcat[$i] eq 'string' ) {
- print OUTASM "\.rdata\n\t\.align 3\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 3\n";
- print OUTASM $chk[$i];
-
- } elsif ( $chkcat[$i] eq 'data' ) {
- print OUTASM "\.data\n\t\.align 3\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...
- # 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 "\.data\n\t\.align 3\n";
- print OUTASM $chk[$closurechk{$symb}];
- $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
- }
-
- # INFO TABLE
- if ( defined($infochk{$symb}) ) {
-
- print OUTASM "\.text\n\t\.align 3\n";
- print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
- # entry code will be put here!
-
- # paranoia
- if ( $chk[$infochk{$symb}] =~ /\.quad\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/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
- }
-
- # NB: no very good way to look for "dangling" references
- # to fast-entry pt
-
- print OUTASM "\.text\n\t\.align 3\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 "\.text\n\t\.align 3\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 "\.text\n\t\.align 3\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 3\n";
- print OUTASM $chk[$directchk{$symb}];
- $chkcat[$directchk{$symb}] = 'DONE ALREADY';
- } else {
- # The commented nop is for the splitter, to ensure
- # that no module ends with a label as the very last
- # thing. (The linker will adjust the label to point
- # to the first code word of the next module linked in,
- # even if alignment constraints cause the label to move!)
-
- print OUTASM "\t# nop\n";
- }
- } else {
- &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm alpha)\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\.quad\s+/; $i++) {
- $label .= $lines[$i] . "\n",
- next if $lines[$i] =~ /^[A-Za-z0-9_]+:$/
- || $lines[$i] =~ /^\t\.globl/;
-
- $before .= $lines[$i] . "\n"; # otherwise...
- }
-
- for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.quad\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";
- }
-
- # If we have anonymous text (not part of a procedure), the linker
- # may complain about missing exception information. Bleh.
- if ($label =~ /^([A-Za-z0-9_]+):$/) {
- $before = "\t.ent $1\n" . $before;
- $after .= "\t.end $1\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";
- }
-}
-
-sub dump_asm_globals_info {
-}
-
-# make "require"r happy...
-1;
-\end{code}
View Lorry Controller Status