X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdriver%2Fsplit%2Fghc-split.lprl;h=58c603ffa1f9c7238c43796bf60420a29e838d1e;hb=a248007e1e2f6b86bcbbca757a4c0e5bfa37690d;hp=8071aa5c60deafe34d649ff9410dd9aada5d3093;hpb=e07d34ab17df2b667cb2ce895be27f740f4f273e;p=ghc-hetmet.git diff --git a/ghc/driver/split/ghc-split.lprl b/ghc/driver/split/ghc-split.lprl index 8071aa5..58c603f 100644 --- a/ghc/driver/split/ghc-split.lprl +++ b/ghc/driver/split/ghc-split.lprl @@ -30,6 +30,7 @@ sub split_asm_file { &collectExports_hppa() if $TargetPlatform =~ /^hppa/; &collectExports_mips() if $TargetPlatform =~ /^mips/; + &collectDyldStuff_powerpc() if $TargetPlatform =~ /^powerpc-apple/; $octr = 0; # output file counter $* = 1; # multi-line matches are OK @@ -44,6 +45,11 @@ sub split_asm_file { # &tidy_up_and_die(1,"$Pgm: no split markers in .s file!\n") # if $prologue_stuff eq $s_stuff; + # about to use $Tmp_prefix in a regex - make sure backslashes don't get + # interpreted in a strange way. ToDo: what about other regex + # characters, eg. '.'? + $Tmp_prefix =~ s/\\/\\\\/g; + # lie about where this stuff came from $prologue_stuff =~ s|"${Tmp_prefix}\.c"|"$ifile_root\.hc"|g; @@ -105,6 +111,58 @@ sub collectExports_mips { # Note: MIPS only seek(TMPI, 0, 0); } +sub collectDyldStuff_powerpc { # Note: Darwin/PowerPC only + local($chunk_label,$label,$cur_section,$section,$chunk,$alignment,$cur_alignment); + + %DyldChunks = (); # NB: global table + %DyldChunksDefined = (); # NB: global table + + $cur_section = ''; + $section = ''; + $label = ''; + $chunk = ''; + $alignment = ''; + $cur_alignment = ''; + + while ( 1 ) { + $_ = ; + if ( $_ eq '' || /^L(_.+)\$.+:/ ) { + if ( $label ne '' ) { + $DyldChunksDefined{$label} .= $section . $chunk_label . $alignment . $ chunk; + if( $section =~ s/\.data/\.non_lazy_symbol_pointer/ ) { + $chunk = "\t.indirect_symbol $label\n\t.long 0\n"; + } + $DyldChunks{$label} .= $section . $chunk_label . $chunk; + # don't use $alignment, it's only needed for .data, which we change into .non_lazy_symbol_pointer + print STDERR "### dyld chunk: $label\n$section$alignment$chunk\n###\n" if $Dump_asm_splitting_info; + } + last if ($_ eq ''); + + $chunk = ''; + $chunk_label = $_; + $label = $1; + $section = $cur_section; + $alignment = $cur_alignment; + print STDERR "label: $label\n" if $Dump_asm_splitting_info; + } elsif ( /^\s*\.(symbol_stub|picsymbol_stub|lazy_symbol_pointer|non_lazy_symbol_pointer|data)/ ) { + $cur_section = $_; + printf STDERR "section: $cur_section\n" if $Dump_asm_splitting_info; + $cur_alignment = '' + } elsif ( /^\s*\.section\s+__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,\d+/ ) { + $cur_section = $_; + printf STDERR "section: $cur_section\n" if $Dump_asm_splitting_info; + $cur_alignment = '' + } elsif ( /^\s*\.align.*/ ) { + $cur_alignment = $_; + printf STDERR "alignment: $cur_alignment\n" if $Dump_asm_splitting_info; + } else { + $chunk .= $_; + } + } + + seek(TMPI, 0, 0); +} + sub ReadTMPIUpToAMarker { local($str, $count) = @_; # already read bits @@ -139,6 +197,7 @@ sub ReadTMPIUpToAMarker { print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info; # return str + $str =~ tr/\r//d if $TargetPlatform =~ /-mingw32$/; # in case Perl doesn't convert line endings $str; } \end{code} @@ -157,7 +216,7 @@ sub process_asm_block { return(&process_asm_block_alpha($str)) if $TargetPlatform =~ /^alpha-/; return(&process_asm_block_hppa($str)) if $TargetPlatform =~ /^hppa/; return(&process_asm_block_mips($str)) if $TargetPlatform =~ /^mips-/; - return(&process_asm_block_powerpc($str)) if $TargetPlatform =~ /^powerpc-|^rs6000-/; + return(&process_asm_block_powerpc($str)) if $TargetPlatform =~ /^powerpc-apple-/; # otherwise... &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n"); @@ -290,16 +349,24 @@ sub process_asm_block_iX86 { $str = "\.text\n\t.align 4\n" . $str; # remove/record any literal constants defined here - while ( ($str =~ /(\.?(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n)+)/ )) { + # [perl made uglier to work around the perl 5.7/5.8 bug documented at + # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated + # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/' + # -- ccshan 2002-09-05] + while ( ($str =~ /(\.?(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ )) { local($label) = $2; local($body) = $1; + local($prefix, $suffix, $*) = ($`, $', 0); &tidy_up_and_die(1,"Local constant label $label already defined!\n") if $LocalConstant{$label}; + while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) { + $body .= $1; + $suffix = $'; + } $LocalConstant{$label} = $body; - - $str =~ s/\.?LC\d+:\n(\t\.(ascii|string).*\n|\s*\.byte.*\n)+//; + $str = $prefix . $suffix; } # inject definitions for any local constants now used herein @@ -416,13 +483,15 @@ sub process_asm_block_mips { \begin{code} sub process_asm_block_powerpc { local($str) = @_; + local($dyld_stuff) = ''; # strip the marker $str =~ s/___stg_split_marker.*\n//; - $str =~ s/___stg_split_marker.*\n//; # yes, twice. + + $str =~ s/L_.*\$.*:\n(.|\n)*//; # remove/record any literal constants defined here - while ( $str =~ /^(.csect .data[RW]\n\s+\.align.*\n(LC\.\.\d+):\n(\s\.byte .*\n)+)/ ) { + while ( $str =~ s/^(\s+.const_data\n\s+\.align.*\n(LC\d+):\n(\s\.(byte|short|long|fill|space|ascii).*\n)+)// ) { local($label) = $2; local($body) = $1; @@ -430,8 +499,6 @@ sub process_asm_block_powerpc { if $LocalConstant{$label}; $LocalConstant{$label} = $body; - - $str =~ s/^.csect .data[RW]\n\s+\.align.*\nLC\.\.\d+:\n(\s\.byte .*\n)+//; } # inject definitions for any local constants now used herein @@ -440,10 +507,20 @@ sub process_asm_block_powerpc { $str = $LocalConstant{$k} . $str; } } + + foreach $k (keys %DyldChunks) { + if ( $str =~ /\bL$k\$/ ) { + if ( $str =~ /^$k:$/ ) { + $dyld_stuff .= $DyldChunksDefined{$k}; + } else { + $dyld_stuff .= $DyldChunks{$k}; + } + } + } - print STDERR "### STRIPPED BLOCK (powerpc/rs6000):\n$str" if $Dump_asm_splitting_info; + $str .= "\n" . $dyld_stuff; - $str = ".toc\n" . $str; + print STDERR "### STRIPPED BLOCK (powerpc):\n$str" if $Dump_asm_splitting_info; $str; }