diff options
Diffstat (limited to 'driver/split/ghc-split.pl')
| -rw-r--r-- | driver/split/ghc-split.pl | 432 |
1 files changed, 432 insertions, 0 deletions
diff --git a/driver/split/ghc-split.pl b/driver/split/ghc-split.pl new file mode 100644 index 0000000000..1ddc0798ab --- /dev/null +++ b/driver/split/ghc-split.pl @@ -0,0 +1,432 @@ +#************************************************************************ +#* * +#* \section[Driver-obj-splitting]{Splitting into many \tr{.o} files (for libraries)} +#* * +#************************************************************************ + +$TargetPlatform = $TARGETPLATFORM; + +($Pgm = $0) =~ s|.*/||; +$ifile = $ARGV[0]; +$Tmp_prefix = $ARGV[1]; +$Output = $ARGV[2]; + +&split_asm_file($ifile); + +open(OUTPUT, "> $Output") || &tidy_up_and_die(1,"$Pgm: failed to open `$Output' (to write)\n"); +print OUTPUT "$NoOfSplitFiles\n"; +close(OUTPUT); + +exit(0); + + +sub split_asm_file { + local($asm_file) = @_; + my @pieces = (); + + open(TMPI, "< $asm_file") || &tidy_up_and_die(1,"$Pgm: failed to open `$asm_file' (to read)\n"); + + &collectExports_hppa() if $TargetPlatform =~ /^hppa/; + &collectExports_mips() if $TargetPlatform =~ /^mips/; + &collectDyldStuff_darwin() if $TargetPlatform =~ /-apple-darwin/; + + $octr = 0; # output file counter + + %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants... + + $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... + +# &tidy_up_and_die(1,"$Pgm: no split markers in .s file!\n") +# if $prologue_stuff eq $s_stuff; + + # lie about where this stuff came from + # Note the \Q: this ignores regex meta-chars in $Tmp_prefix. + $prologue_stuff =~ s/\Q"$Tmp_prefix.c"/"$ifile_root.hc"/gm; + + while ( $_ ne '' ) { # not EOF + $octr++; + + # grab and de-mangle a section of the .s file... + $s_stuff = &ReadTMPIUpToAMarker ( $_, $octr ); + $pieces[$octr] = &process_asm_block ( $s_stuff ); + } + + # Make sure that we still have some output when the input file is empty + if ($octr == 0) { + $octr = 1; + $pieces[$octr] = ''; + } + + $NoOfSplitFiles = $octr; + + if ($pieces[$NoOfSplitFiles] =~ /(\n[ \t]*\.section[ \t]+\.note\.GNU-stack,[^\n]*\n)/m) { + $note_gnu_stack = $1; + for $octr (1..($NoOfSplitFiles - 1)) { + $pieces[$octr] .= $note_gnu_stack; + } + } + + for $octr (1..$NoOfSplitFiles) { + # output to a file of its own + # open a new output file... + $ofname = "${Tmp_prefix}__${octr}.s"; + open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n"; + + print OUTF $prologue_stuff; + print OUTF $pieces[$octr]; + + close(OUTF) + || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n"); + } + + close(TMPI) || &tidy_up_and_die(1,"Failed reading $asm_file\n"); +} + +sub collectExports_hppa { # Note: HP-PA only + + %LocalExport = (); # NB: global table + + while(<TMPI>) { + if (/^\s+\.EXPORT\s+([^,]+),.*\n/m) { + local($label) = $1; + local($body) = "\t.IMPORT $label"; + if (/,DATA/m) { + $body .= ",DATA\n"; + } else { + $body .= ",CODE\n"; + } + $label =~ s/\$/\\\$/gm; + $LocalExport{$label} = $body; + } + } + + seek(TMPI, 0, 0); +} + +sub collectExports_mips { # Note: MIPS only + # (not really sure this is necessary [WDP 95/05]) + + $UNDEFINED_FUNS = ''; # NB: global table + + while(<TMPI>) { + $UNDEFINED_FUNS .= $_ if /^\t\.globl\s+\S+ \.\S+\n/m; + # just save 'em all + } + + seek(TMPI, 0, 0); +} + +sub collectDyldStuff_darwin { + 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 ) { + $_ = <TMPI>; + if ( $_ eq '' || (/^L(_.+)\$.+:/m && !(/^L(.*)\$stub_binder:/m))) { + if ( $label ne '' ) { + $DyldChunksDefined{$label} .= $section . $alignment . $chunk_label . $ chunk; + if( $section =~ s/\.data/\.non_lazy_symbol_pointer/m ) { + $chunk = "\t.indirect_symbol $label\n\t.long 0\n"; + } + $DyldChunks{$label} .= $section . $alignment . $chunk_label . $chunk; + 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|section __IMPORT,.*|section __DATA, __la_sym_ptr(2|3),lazy_symbol_pointers)/m ) { + $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+/m ) { + $cur_section = $_; + printf STDERR "section: $cur_section\n" if $Dump_asm_splitting_info; + # always make sure we align things + $cur_alignment = '\t.align 2' + } elsif ( /^\s*\.align.*/m ) { + $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 + + + for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/m; $_ = <TMPI> ) { + $str .= $_; + } + # if not EOF, then creep forward until next "real" line + # (throwing everything away). + # that first "real" line will stay in $_. + + # This loop is intended to pick up the body of the split_marker function + # Note that the assembler mangler will already have eliminated this code + # if it's been invoked (which it probably has). + + while ($_ ne '' && (/_?__stg_split_marker/m + || /^L[^C].*:$/m + || /^\.stab/m + || /\t\.proc/m + || /\t\.stabd/m + || /\t\.even/m + || /\tunlk a6/m + || /^\t!#PROLOGUE/m + || /\t\.prologue/m + || /\t\.frame/m + # || /\t\.end/ NOT! Let the split_marker regexp catch it + # || /\t\.ent/ NOT! Let the split_marker regexp catch it + || /^\s+(save|retl?|restore|nop)/m)) { + $_ = <TMPI>; + } + + print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info; + + # return str + $str =~ tr/\r//d if $TargetPlatform =~ /-mingw32$/m; # in case Perl doesn't convert line endings + $str; +} +=pod + +We must (a)~strip the marker off the block, (b)~record any literal C +constants that are defined here, and (c)~inject copies of any C constants +that are used-but-not-defined here. + +=cut + +sub process_asm_block { + local($str) = @_; + + return(&process_asm_block_darwin($str)) + if $TargetPlatform =~ /-apple-darwin/m; + return(&process_asm_block_sparc($str)) if $TargetPlatform =~ /^sparc-/m; + return(&process_asm_block_iX86($str)) if $TargetPlatform =~ /^i[34]86-/m; + return(&process_asm_block_x86_64($str)) if $TargetPlatform =~ /^x86_64-/m; + return(&process_asm_block_powerpc_linux($str)) + if $TargetPlatform =~ /^powerpc-[^-]+-linux/m; + + # otherwise... + &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n"); +} + +sub process_asm_block_sparc { + local($str) = @_; + + # strip the marker + if ( $OptimiseC ) { + $str =~ s/_?__stg_split_marker.*:\n//m; + } else { + $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/m; + $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/m; + } + + # make sure the *.hc filename gets saved; not just ghc*.c (temp name) + $str =~ s/^\.stabs "(ghc\d+\.c)"/.stabs "$ifile_root.hc"/gm; # HACK HACK + + # remove/record any literal constants defined here + while ( $str =~ /(\t\.align .\n\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/m ) { + local($label) = $2; + local($body) = $1; + + &tidy_up_and_die(1,"Local constant label $label already defined!\n") + if $LocalConstant{$label}; + + $LocalConstant{$label} = $body; + + $str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//m; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /\b$k\b/m ) { + $str = $LocalConstant{$k} . $str; + } + } + + print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info; + + $str; +} + +sub process_asm_block_iX86 { + local($str) = @_; + + # strip the marker + + $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/m; + $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/m; + + # it seems prudent to stick on one of these: + $str = "\.text\n\t.align 4\n" . $str; + + # remove/record any literal constants defined here + # [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})/m )) { + local($label) = $2; + local($body) = $1; + local($prefix, $suffix) = ($`, $'); + + &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 = $prefix . $suffix; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /\b$k\b/m ) { + $str = $LocalConstant{$k} . $str; + } + } + + print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info; + + $str; +} + +sub process_asm_block_x86_64 { + local($str) = @_; + + # remove/record any literal constants defined here + # [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})/m )) { + local($label) = $2; + local($body) = $1; + local($prefix, $suffix) = ($`, $'); + + &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 = $prefix . $suffix; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /\b$k\b/m ) { + $str = $LocalConstant{$k} . $str; + } + } + + print STDERR "### STRIPPED BLOCK (x86_64):\n$str" if $Dump_asm_splitting_info; + + $str; +} + +# The logic for both Darwin/PowerPC and Darwin/x86 ends up being the same. + +sub process_asm_block_darwin { + local($str) = @_; + local($dyld_stuff) = ''; + + # strip the marker + $str =~ s/___stg_split_marker.*\n//m; + + $str =~ s/L_.*\$.*:\n(.|\n)*//m; + + # remove/record any literal constants defined here + while ( $str =~ s/^(\s+.const.*\n\s+\.align.*\n(LC\d+):\n(\s\.(byte|short|long|fill|space|ascii).*\n)+)//m ) { + local($label) = $2; + local($body) = $1; + + &tidy_up_and_die(1,"Local constant label $label already defined!\n") + if $LocalConstant{$label}; + + $LocalConstant{$label} = $body; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /\b$k(\b|\[)/m ) { + $str = $LocalConstant{$k} . $str; + } + } + + foreach $k (keys %DyldChunks) { + if ( $str =~ /\bL$k\$/m ) { + if ( $str =~ /^$k:$/m ) { + $dyld_stuff .= $DyldChunksDefined{$k}; + } else { + $dyld_stuff .= $DyldChunks{$k}; + } + } + } + + $str .= "\n" . $dyld_stuff; + + print STDERR "### STRIPPED BLOCK (darwin):\n$str" if $Dump_asm_splitting_info; + + $str; +} + +sub process_asm_block_powerpc_linux { + local($str) = @_; + + # strip the marker + $str =~ s/__stg_split_marker.*\n//m; + + # remove/record any literal constants defined here + while ( $str =~ s/^(\s+.section\s+\.rodata\n\s+\.align.*\n(\.LC\d+):\n(\s\.(byte|short|long|quad|2byte|4byte|8byte|fill|space|ascii|string).*\n)+)//m ) { + local($label) = $2; + local($body) = $1; + + &tidy_up_and_die(1,"Local constant label $label already defined!\n") + if $LocalConstant{$label}; + + $LocalConstant{$label} = $body; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /[\s,]$k\b/m ) { + $str = $LocalConstant{$k} . $str; + } + } + + print STDERR "### STRIPPED BLOCK (powerpc linux):\n$str" if $Dump_asm_splitting_info; + + $str; +} + +sub tidy_up_and_die { + local($return_val, $msg) = @_; + print STDERR $msg; + exit (($return_val == 0) ? 0 : 1); +} |