$T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
$T_DOT_WORD = '\.quad';
- $T_DOT_GLOBAL = '^\t\.globl';
+ $T_DOT_GLOBAL = "\t\.globl";
$T_HDR_literal = "\.rdata\n\t\.align 3\n";
$T_HDR_misc = "\.text\n\t\.align 3\n";
$T_HDR_data = "\.data\n\t\.align 3\n";
$T_hsc_cc_PAT = '\.STRING.*\)(hsc|cc) (.*)\\\\x09(.*)\\\\x00';
$T_DOT_WORD = '\.word';
- $T_DOT_GLOBAL = '^\s+\.EXPORT';
+ $T_DOT_GLOBAL = '\s+\.EXPORT';
$T_HDR_literal = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
$T_HDR_misc = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
$T_HDR_data = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
$T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
$T_DOT_WORD = '\.long';
$T_DOT_GLOBAL = '\.globl';
- $T_HDR_literal = "\.text\n\t\.align 2\n";
+ $T_HDR_literal = "\.text\n\t\.align 2\n"; # .align 4 is 486-cache friendly
$T_HDR_misc = "\.text\n\t\.align 2,0x90\n";
- $T_HDR_data = "\.data\n\t\.align 2\n";
+ $T_HDR_data = "\.data\n\t\.align 2\n"; # ToDo: change align??
$T_HDR_consist = "\.text\n";
- $T_HDR_closure = "\.data\n\t\.align 2\n";
+ $T_HDR_closure = "\.data\n\t\.align 2\n"; # ToDo: change align?
$T_HDR_info = "\.text\n\t\.align 2\n"; # NB: requires padding
$T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
$T_HDR_fast = "\.text\n\t\.align 2,0x90\n";
$T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
$T_US = ''; # _ if symbols have an underscore on the front
$T_DO_GC = 'PerformGC_wrapper';
- $T_PRE_APP = # regexp that says what comes before APP/NO_APP
- ($TargetPlatform =~ /-linux$/) ? '#' : '/' ;
+ $T_PRE_APP = '/'; # regexp that says what comes before APP/NO_APP
$T_CONST_LBL = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
$T_POST_LBL = ':';
$T_X86_PRE_LLBL_PAT = '\.L';
$T_CONST_LBL = '^LC(\d+):$';
$T_POST_LBL = ':';
- $T_MOVE_DIRVS = '^(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
+ $T_MOVE_DIRVS = '(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
$T_COPY_DIRVS = '\.(globl|proc|stab)';
$T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
$T_CONST_LBL = '^\$LC(\d+):$'; # regexp for what such a lbl looks like
$T_POST_LBL = ':';
- $T_MOVE_DIRVS = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
+ $T_MOVE_DIRVS = '(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
$T_COPY_DIRVS = '\.(globl|ent)';
$T_hsc_cc_PAT = 'I WAS TOO LAZY TO DO THIS BIT (WDP 95/05)';
$T_DOT_WORD = '\.word';
- $T_DOT_GLOBAL = '^\t\.globl';
+ $T_DOT_GLOBAL = '\t\.globl';
$T_HDR_literal = "\t\.rdata\n\t\.align 2\n";
$T_HDR_misc = "\t\.text\n\t\.align 2\n";
$T_HDR_data = "\t\.data\n\t\.align 2\n";
} elsif ( $TargetPlatform =~ /^powerpc-.*/ ) {
$T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
- $T_US = ''; # _ if symbols have an underscore on the front
+ $T_US = '\.'; # _ if symbols have an underscore on the front
$T_DO_GC = 'PerformGC_wrapper';
$T_PRE_APP = 'NOT APPLICABLE'; # regexp that says what comes before APP/NO_APP
$T_CONST_LBL = '^LC\.\.(\d+):$'; # regexp for what such a lbl looks like
$T_POST_LBL = ':';
- $T_MOVE_DIRVS = '^(\s*(\.toc|.csect \S+|\.l?globl \S+|\.align \d+)\n)';
- $T_COPY_DIRVS = '\.(l?globl)';
+ $T_MOVE_DIRVS = '^(\s*(\.align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.Lfe.*\n\t\.size\s+.*|\.size\s+.*|\.ident.*)\n)';
+ $T_COPY_DIRVS = '\.(globl)';
$T_hsc_cc_PAT = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
$T_DOT_WORD = '\.long';
$T_DOT_GLOBAL = '\.globl';
- $T_HDR_literal = "\.section\t\.rodata\n";
- $T_HDR_misc = "\.text\n\t\.align 2\n";
- $T_HDR_data = "\.data\n\t\.align 2\n";
+ $T_HDR_literal = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
+ $T_HDR_misc = "\.text\n\t\.align 16\n";
+ $T_HDR_data = "\.data\n\t\.align 4\n"; # ToDo: change align??
$T_HDR_consist = "\.text\n";
- $T_HDR_closure = "\.data\n\t\.align 2\n";
- $T_HDR_info = "\.text\n\t\.align 2\n";
- $T_HDR_entry = "\.text\n";
- $T_HDR_fast = "\.text\n\t\.align 2\n";
- $T_HDR_vector = "\.text\n\t\.align 2\n";
- $T_HDR_direct = "\.text\n\t\.align 2\n";
+ $T_HDR_closure = "\.data\n\t\.align 4\n"; # ToDo: change align?
+ $T_HDR_info = "\.text\n\t\.align 16\n"; # NB: requires padding
+ $T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
+ $T_HDR_fast = "\.text\n\t\.align 16\n";
+ $T_HDR_vector = "\.text\n\t\.align 16\n"; # NB: requires padding
+ $T_HDR_direct = "\.text\n\t\.align 16\n";
#--------------------------------------------------------#
} elsif ( $TargetPlatform =~ /^sparc-.*-solaris2/ ) {
$T_hsc_cc_PAT = '\.asciz.*\)(hsc|cc) (.*)\\\\t(.*)"';
$T_DOT_WORD = '\.word';
- $T_DOT_GLOBAL = '^\t\.global';
+ $T_DOT_GLOBAL = '\.global';
$T_HDR_literal = "\.text\n\t\.align 8\n";
$T_HDR_misc = "\.text\n\t\.align 4\n";
$T_HDR_data = "\.data\n\t\.align 8\n";
next if /^;/ && $TargetPlatform =~ /^hppa/;
- next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc)-/;
-
- last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-/;
+ next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^mips-/;
if ( $TargetPlatform =~ /^mips-/
&& /^\t\.(globl \S+ \.text|comm\t)/ ) {
} elsif ( /^${T_US}[A-Za-z0-9_]/o
&& ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
- || ! /^L\$\d+$/ )
- && ( $TargetPlatform !~ /^powerpc/ # ditto
- || ! /^(L\.\.\d+|LT\.\..*):$/ ) ) {
+ || /^L\$\d+$/ ) ) {
local($thing);
chop($thing = $_);
print STDERR "Funny global thing?: $_"
print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
}
- die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/
- && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
+ die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
# glue together what's left
$c = $p . $r;
- $c =~ s/\n\t\n/\n/; # junk blank line
}
}
- if ( $TargetPlatform =~ /^mips-/ ) {
- # MIPS: first, this basic sequence may occur "--- END ---" or not
- $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
- }
-
# toss all epilogue stuff; again, paranoidly
if ( $c =~ /--- END ---/ ) {
if (($r, $e) = split(/--- END ---/, $c)) {
} else {
print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
}
- die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
- && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
+ die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/;
# glue together what's left
$c = $r . $e;
# On Alphas, the prologue mangling is done a little later (below)
# toss all calls to __DISCARD__
- $c =~ s/^\t(call|jbsr|jal)\s+${T_US}__DISCARD__\n//go;
+ $c =~ s/^\t(call|jbsr|jal) ${T_US}__DISCARD__\n//go;
# MIPS: that may leave some gratuitous asm macros around
# (no harm done; but we get rid of them to be tidier)
while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/o ) {
$to_move = $1;
+
if ( $i < ($numchks - 1)
&& ( $to_move =~ /${T_COPY_DIRVS}/
|| ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
$consist =~ s/\//./g;
$consist =~ s/-/_/g;
$consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
- print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
-
- } elsif ( $TargetPlatform !~ /^(mips|powerpc)-/ ) { # we just don't try in those case (ToDo)
- # on mips: consistency string is just a v
- # horrible bunch of .bytes,
- # which I am too lazy to sort out (WDP 95/05)
-
+ print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n"
+ if $TargetPlatform !~ /^mips-/; # we just don't try in that case
+ } else {
print STDERR "Couldn't grok consistency: ", $chk[$i];
}
if ( ! defined($slowchk{$symb})
# ToDo: the || clause can go once we're no longer
# concerned about producing exactly the same output as before
-#OLD: || $TargetPlatform =~ /^(m68k|sparc|i386)-/
+ || $TargetPlatform =~ /^(m68k|sparc|i386)-/
) {
print OUTASM $T_HDR_fast;
}
&tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
}
}
-
- print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/;
-
- print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n"
- if $TargetPlatform =~ /^powerpc-/;
-
# 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");
# final peephole fixes
s/^\tmovl \%eax,36\(\%ebx\)\n\tjmp \*36\(\%ebx\)\n/\tmovl \%eax,36\(\%ebx\)\n\tjmp \*\%eax\n/;
-# the short form may tickle perl bug:
-# s/^\tmovl \$${T_US}(.*),(\%e[abcd]x)\n\tjmp \*$2/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%eax\n\tjmp \*\%eax/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%ebx\n\tjmp \*\%ebx/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%ecx\n\tjmp \*\%ecx/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%edx\n\tjmp \*\%edx/\tjmp $T_US$1/g;
+ s/^\tmovl \$_(.*),(\%e[abcd]x)\n\tjmp \*$2/\tjmp _$1/g;
# Hacks to eliminate some reloads of Hp. Worth about 5% code size.
# We could do much better than this, but at least it catches about
"${T_US}_PRMarking_MarkNextGA${T_POST_LBL}", 1,
"${T_US}_PRMarking_MarkNextRoot${T_POST_LBL}", 1,
"${T_US}_PRMarking_MarkNextSpark${T_POST_LBL}", 1,
- "${T_US}_PRMarking_MarkNextEvent${T_POST_LBL}", 1,
- "${T_US}_PRMarking_MarkNextClosureInFetchBuffer${T_POST_LBL}", 1,
"${T_US}_Scavenge_Forward_Ref${T_POST_LBL}", 1,
"${T_US}__std_entry_error__${T_POST_LBL}", 1,
"${T_US}_startMarkWorld${T_POST_LBL}", 1,
for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t${T_DOT_WORD}\s+/o; $i++) {
$label .= $lines[$i] . "\n",
next if $lines[$i] =~ /^[A-Za-z0-9_]+_info${T_POST_LBL}$/o
- || $lines[$i] =~ /${T_DOT_GLOBAL}/o
+ || $lines[$i] =~ /^${T_DOT_GLOBAL}/o
|| $lines[$i] =~ /^${T_US}vtbl_\S+${T_POST_LBL}$/o;
$before .= $lines[$i] . "\n"; # otherwise...
local($hc_file) = @_;
unlink("$Tmp_prefix.unmkd");
- local($to_do) = "cp $hc_file $Tmp_prefix.unmkd";
+ local($to_do) = "$Cp $hc_file $Tmp_prefix.unmkd";
&run_something($to_do, 'Prepare to number split markers');
open(TMPI, "< $Tmp_prefix.unmkd") || &tidy_up_and_die(1,"$Pgm: failed to open `$Tmp_prefix.unmkd' (to read)\n");
$_ = <TMPI>;
}
print TMPO "__STG_SPLIT_MARKER(1)\n";
- print TMPO $_ if ! /\/\* SPLIT \*\//;
+ print TMPO $_ if ! /^\s*\/\* SPLIT \*\/\s*$/;
+
+ # Have to be a bit careful detecting /* SPLIT */ comments
+ # since a progam may use a string containing "/* SPLIT */"
+ # We check that there is nothing else on the line
while (<TMPI>) {
- if (/\/\* SPLIT \*\//) {
+ if (/^\s*\/\* SPLIT \*\/\s*$/) {
$marker_no++;
print TMPO "__STG_SPLIT_MARKER($marker_no)\n";
next;
%LocalConstant = (); # we have to subvert C compiler's commoning-up of constants...
- $s_stuff = &ReadTMPIUpToAMarker( '' );
+ $s_stuff = &ReadTMPIUpToAMarker( '', $octr );
# that first stuff is a prologue for all .s outputs
$prologue_stuff = &process_asm_block ( $s_stuff );
# $_ already has some of the next stuff in it...
$prologue_stuff =~ s|"/tmp/ghc\d+\.c"|"$ifile_root\.hc"|g;
while ( $_ ne '' ) { # not EOF
+ $octr++;
# grab and de-mangle a section of the .s file...
- $s_stuff = &ReadTMPIUpToAMarker ( $_ );
+ $s_stuff = &ReadTMPIUpToAMarker ( $_, $octr );
$this_piece = &process_asm_block ( $s_stuff );
# output to a file of its own
# open a new output file...
- $octr++;
$ofname = "${Tmp_prefix}__${octr}.s";
open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n";
}
sub ReadTMPIUpToAMarker {
- local($str) = @_; # already read bits
+ local($str, $count) = @_; # already read bits
for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/; $_ = <TMPI> ) {
$_ = <TMPI>;
}
- print STDERR "### BLOCK:\n$str" if $Dump_asm_splitting_info;
+ print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info;
# return str
$str;
if ( $OptimiseC ) {
$str =~ s/_?__stg_split_marker.*:\n//;
} else {
- $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/\1/;
- $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/\1/;
+ $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
+ $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
}
# make sure the *.hc filename gets saved; not just ghc*.c (temp name)
$str =~ s/^\.stabs "(ghc\d+\.c)"/.stabs "$ifile_root.hc"/g; # HACK HACK
# remove/record any literal constants defined here
- while ( $str =~ /(\t\.align .\n(LC\d+):\n\t\.ascii.*\n)/ ) {
+ while ( $str =~ /(\t\.align .\n(LC\d+):\n(\t\.ascii.*\n)+)/ ) {
local($label) = $2;
local($body) = $1;
$LocalConstant{$label} = $body;
- $str =~ s/\t\.align .\nLC\d+:\n\t\.ascii.*\n//;
+ $str =~ s/\t\.align .\nLC\d+:\n(\t\.ascii.*\n)+//;
}
# inject definitions for any local constants now used herein
sub process_asm_block_m68k {
local($str) = @_;
- # strip the marker (ToDo: something special for unregisterized???)
+ # strip the marker
- $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/\1/;
- $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/\1/;
+ $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
+ $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
# it seems prudent to stick on one of these:
$str = "\.text\n\t.even\n" . $str;
if ( $OptimiseC ) {
$str =~ s/_?__stg_split_marker.*:\n//;
} else {
- $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/\1/;
+ $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
}
# remove/record any literal constants defined here
# Slide the dummy direct return code into the vtbl .ent/.end block,
# to keep the label fixed if it's the last thing in a module, and
# to avoid having any anonymous text that the linker will complain about
- $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n\1/g;
+ $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info;
sub process_asm_block_iX86 {
local($str) = @_;
- # strip the marker (ToDo: something special for unregisterized???)
+ # strip the marker
- $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/\1/;
- $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/\1/;
+ $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
+ $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
# it seems prudent to stick on one of these:
$str = "\.text\n\t.align 4\n" . $str;
if ( $OptimiseC ) {
$str =~ s/_?__stg_split_marker.*:\n//;
} else {
- $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/\1/;
+ $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
}
# remove/record any literal constants defined here
# Slide the dummy direct return code into the vtbl .ent/.end block,
# to keep the label fixed if it's the last thing in a module, and
# to avoid having any anonymous text that the linker will complain about
- $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n\1/g;
+ $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
$str .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info
projects / ghc-hetmet.git / commitdiff