$ofile = $ARGV[1];
if ( $TargetPlatform =~ /^i386-/ ) {
- $StolenX86Regs = $ARGV[2];
+ if ($ARGV[2] eq '') {
+ $StolenX86Regs = 4;
+ } else {
+ $StolenX86Regs = $ARGV[2];
+ }
}
&mangle_asm($ifile,$ofile);
$T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
$T_US = ''; # _ if symbols have an underscore on the front
$T_PRE_APP = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
- $T_CONST_LBL = '^\$C(\d+):$'; # regexp for what such a lbl looks like
+ $T_CONST_LBL = '^\$L?C(\d+):$'; # regexp for what such a lbl looks like
$T_POST_LBL = ':';
$T_MOVE_DIRVS = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)';
$T_COPY_DIRVS = '^\s*(\#|\.(file|globl|ent|loc))';
$T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
- $T_DOT_WORD = '\.quad';
+ $T_DOT_WORD = '\.(long|quad|byte|word)';
$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_direct = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
#--------------------------------------------------------#
- } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd2|netbsd|openbsd|nextstep3|cygwin32|mingw32)$/ ) {
+ } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd2|openbsd|nextstep3|cygwin32|mingw32)$/ ) {
# NeXT added but not tested. CaS
$T_STABBY = 1; # 1 iff .stab things (usually if a.out format)
$T_HDR_direct = "\.text\n\t\.align 2,0x90\n";
#--------------------------------------------------------#
- } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux|freebsd|netbsd_elf)$/ ) {
+ } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux|freebsd|netbsd)$/ ) {
$T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
$T_US = ''; # _ if symbols have an underscore on the front
$T_PRE_APP = # regexp that says what comes before APP/NO_APP
- ($TargetPlatform =~ /-(linux|freebsd|netbsd_elf)$/) ? '#' : '/' ;
+ ($TargetPlatform =~ /-(linux|freebsd|netbsd)$/) ? '#' : '/' ;
$T_CONST_LBL = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
$T_POST_LBL = ':';
$T_X86_PRE_LLBL_PAT = '\.L';
$T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.Lfe.*\n\s*\.size\s+.*|\.size\s+.*|\.ident.*)\n)';
$T_COPY_DIRVS = '\.(globl)';
- if ( $TargetPlatform =~ /freebsd|netbsd_elf/ ) {
+ if ( $TargetPlatform =~ /freebsd|netbsd/ ) {
$T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
} else {
$T_hsc_cc_PAT = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
$i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
while (<INASM>) {
+ tr/\r//d if $TargetPlatform =~ /-mingw32$/;
next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
next if /^\t\.def.*endef$/;
last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-|^rs6000-/;
if ( $TargetPlatform =~ /^mips-/
- && /^\t\.(globl \S+ \.text|comm\t)/ ) {
+ && /^\t\.(globl\S+\.text|comm\t)/ ) {
$EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
# As a temporary solution for compiling "foreign export" declarations,
$chksymb[$i] = '';
} elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
- && /^(_uname|uname|stat|fstat):/ ) {
- # for some utterly bizarre reason, this platform
- # likes to drop little local C routines with these names
- # into each and every .o file that #includes the
- # relevant system .h file. Yuck. We just don't
- # tolerate them in .hc files (which we are processing
- # here). If you need to call one of these things from
- # Haskell, make a call to your own C wrapper, then
- # put that C wrapper (which calls one of these) in a
- # plain .c file. WDP 95/12
+ && /^[A-Za-z0-9][A-Za-z0-9_]*:/ ) {
+ # Some Solaris system headers contain function definitions (as
+ # opposed to mere prototypes), which end up in the .hc file when
+ # a Haskell module foreign imports the corresponding system
+ # functions (most notably stat()). We put them into the text
+ # segment. Note that this currently does not extend to function
+ # names starting with an underscore.
+ # - chak 7/2001
$chk[++$i] = $_;
- $chkcat[$i] = 'toss';
+ $chkcat[$i] = 'misc';
$chksymb[$i] = $1;
} elsif ( /^${T_US}[A-Za-z0-9_]/o
|| ! /^(L\.\.\d+|LT\.\..*):$/ ) ) {
local($thing);
chop($thing = $_);
- print "Funny global thing?: $_"
+ print STDERR "Funny global thing?: $_"
unless $KNOWN_FUNNY_THING{$thing}
|| /^${T_US}stg_.*${T_POST_LBL}$/o # RTS internals
|| /^${T_US}__fexp_.*${T_POST_LBL}$/o # foreign export
- || /^${T_US}__init.*${T_POST_LBL}$/o # __init<module>
+ || /^${T_US}__stginit.*${T_POST_LBL}$/o # __stginit<module>
|| /^${T_US}.*_btm${T_POST_LBL}$/o # large bitmaps
- || /^${T_US}.*_closure_tbl${T_POST_LBL}$/o; # closure tables
+ || /^${T_US}.*_closure_tbl${T_POST_LBL}$/o # closure tables
+ || /^_uname:/o; # x86/Solaris2
$chk[++$i] = $_;
$chkcat[$i] = 'misc';
if ($TargetPlatform =~ /^powerpc-|^rs6000-/)
}
$numchks = $#chk + 1;
+ # open CHUNKS, ">/tmp/chunks1" or die "Cannot open /tmp/chunks1: $!\n";
+ # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] }
+ # close CHUNKS;
+
# the division into chunks is imperfect;
# we throw some things over the fence into the next
# chunk.
# output.
local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
+ local($FIRST_TOSSABLE ) = ($TargetPlatform =~ /^(hppa|mips-)/) ? 1 : 0;
# print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n";
# Alphas: 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
+ # spits a ".quad 0" in after the very first ".rdata"; we
# detect this special case (tossing the ".quad 0")!
local($magic_rdata_seen) = 0;
}
};
- for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
+ for ($i = $FIRST_TOSSABLE; $i < $numchks; $i++) {
$c = $chk[$i]; # convenience copy
# print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
}
- print "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/
+ print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/
&& $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
# glue together what's left
$chk[$i] = $c; # update w/ convenience copy
}
+ # open CHUNKS, ">/tmp/chunks2" or die "Cannot open /tmp/chunks2: $!\n";
+ # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] }
+ # close CHUNKS;
+
if ( $TargetPlatform =~ /^alpha-/ ) {
# print out the header stuff first
$chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
};
&print_doctored($chk[$i], 0);
if ($TargetPlatform =~ /^powerpc-|^rs6000-/ && $printDS) {
-#ok if ($chksymb[$i] !~ /\__init_Main/) {
+#ok if ($chksymb[$i] !~ /\__stginit_Main/) {
print OUTASM "\.csect ${chksymb[$i]}[DS]\n";
print OUTASM "${p}TOC[tc0], 0\n";
#ok }
# references to fast-entry point.
# (questionable re hppa and mips...)
print STDERR "still has jump to fast entry point:\n$c"
- if $c =~ /${T_US}${symb}_fast/;
+ if $c =~ /\b${T_US}${symb}_fast/;
}
print OUTASM $T_HDR_entry;
if ( $TargetPlatform !~ /^i386-/
|| ! /^\t[a-z]/ # no instructions in here, apparently
- || /^${T_US}__init_[A-Za-z0-9_]+${T_POST_LBL}/) {
+ || /^${T_US}__stginit_[A-Za-z0-9_]+${T_POST_LBL}/) {
print OUTASM $_;
return;
}
# Alphas:If we have anonymous text (not part of a procedure), the
# linker may complain about missing exception information. Bleh.
+ # To suppress this, we place a .ent/.end pair around the code.
+ # At the same time, we have to be careful and not enclose any leading
+ # .file/.loc directives.
if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
- $before = "\t.ent $1\n" . $before;
- $after .= "\t.end $1\n";
+ local ($ident) = $1;
+ $before =~ s/^((\s*\.(file|loc)\s+[^\n]*\n)*)/$1\t.ent $ident\n/;
+ $after .= "\t.end $ident\n";
}
$tbl = $before
projects / ghc-hetmet.git / blobdiff