X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdriver%2Fsplit%2Fghc-split.lprl;h=58c603ffa1f9c7238c43796bf60420a29e838d1e;hb=a248007e1e2f6b86bcbbca757a4c0e5bfa37690d;hp=962f67d857951dd71d07f3b192bd0c79bfb55b1d;hpb=a7b34ca31fef53031a12c40e4550bdd76ef51d56;p=ghc-hetmet.git diff --git a/ghc/driver/split/ghc-split.lprl b/ghc/driver/split/ghc-split.lprl index 962f67d..58c603f 100644 --- a/ghc/driver/split/ghc-split.lprl +++ b/ghc/driver/split/ghc-split.lprl @@ -5,45 +5,23 @@ %************************************************************************ \begin{code} -sub inject_split_markers { - local($hc_file) = @_; +$TargetPlatform = $TARGETPLATFORM; - unlink("$Tmp_prefix.unmkd"); - local($to_do) = "$Cp $hc_file $Tmp_prefix.unmkd"; - &run_something($to_do, 'Prepare to number split markers'); +($Pgm = $0) =~ s|.*/||; +$ifile = $ARGV[0]; +$Tmp_prefix = $ARGV[1]; +$Output = $ARGV[2]; - open(TMPI, "< $Tmp_prefix.unmkd") || &tidy_up_and_die(1,"$Pgm: failed to open `$Tmp_prefix.unmkd' (to read)\n"); - open(TMPO, "> $hc_file") || &tidy_up_and_die(1,"$Pgm: failed to open `$hc_file' (to write)\n"); +&split_asm_file($ifile); - local($marker_no) = 1; +open(OUTPUT, "> $Output") || &tidy_up_and_die(1,"$Pgm: failed to open `$Output' (to write)\n"); +print OUTPUT "$NoOfSplitFiles\n"; +close(OUTPUT); - # make sure there is a split marker before any "real" code - $_ = ; - while ( $_ ne '' && ( /^$/ || /^#/ ) ) { - print TMPO $_; - $_ = ; - } - print TMPO "__STG_SPLIT_MARKER(1)\n"; - 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 () { - if (/^\s*\/\* SPLIT \*\/\s*$/) { - $marker_no++; - print TMPO "__STG_SPLIT_MARKER($marker_no)\n"; - next; - } - print TMPO $_; - } - - close(TMPI) || &tidy_up_and_die(1,"Failed reading $Tmp_prefix.unmkd\n"); - close(TMPO) || &tidy_up_and_die(1,"Failed writing $hc_file\n"); -} +exit(0); \end{code} + \begin{code} sub split_asm_file { local($asm_file) = @_; @@ -52,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 @@ -66,8 +45,13 @@ 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/ghc\d+\.c"|"$ifile_root\.hc"|g; + $prologue_stuff =~ s|"${Tmp_prefix}\.c"|"$ifile_root\.hc"|g; while ( $_ ne '' ) { # not EOF $octr++; @@ -127,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 @@ -161,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} @@ -179,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"); @@ -200,7 +237,7 @@ sub process_asm_block_sparc { $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\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/ ) { local($label) = $2; local($body) = $1; @@ -209,7 +246,7 @@ sub process_asm_block_sparc { $LocalConstant{$label} = $body; - $str =~ s/\t\.align .\nLC\d+:\n(\t\.ascii.*\n)+//; + $str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//; } # inject definitions for any local constants now used herein @@ -312,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.*\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.*\n//; + $str = $prefix . $suffix; } # inject definitions for any local constants now used herein @@ -355,6 +400,8 @@ sub process_asm_block_hppa { while ( $str =~ /^(\s+\.align.*\n(L\$C\d+)\n(\s.*\n)+); end literal\n/ ) { local($label) = $2; local($body) = $1; + local($prefix) = $`; + local($suffix) = $'; $label =~ s/\$/\\\$/g; &tidy_up_and_die(1,"Local constant label $label already defined!\n") @@ -362,7 +409,7 @@ sub process_asm_block_hppa { $LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body; - $str =~ s/^\s+\.SPACE \$TEXT\$\n\s+\.SUBSPA \$LIT\$\s+\.align.*\nL\$C\d+\n(\s.*\n)+; end literal\n//; + $str = $prefix . $suffix; } # inject definitions for any local constants now used herein @@ -436,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; @@ -450,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 @@ -460,17 +507,29 @@ 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; } \end{code} \begin{code} -# make "require"r happy... -1; +sub tidy_up_and_die { + local($return_val, $msg) = @_; + print STDERR $msg; + exit (($return_val == 0) ? 0 : 1); +} \end{code} -