ghc/driver/split/ghc-split.lprl

   1 %************************************************************************
   2 %*                                                                      *
   3 \section[Driver-obj-splitting]{Splitting into many \tr{.o} files (for libraries)}
   4 %*                                                                      *
   5 %************************************************************************
   6
   7 \begin{code}
   8 $TargetPlatform = $TARGETPLATFORM;
   9
  10 ($Pgm = $0) =~ s|.*/||;
  11 $ifile      = $ARGV[0];
  12 $Tmp_prefix = $ARGV[1];
  13 $Output     = $ARGV[2];
  14
  15 &split_asm_file($ifile);
  16
  17 open(OUTPUT, "> $Output") ||  &tidy_up_and_die(1,"$Pgm: failed to open `$Output' (to write)\n");
  18 print OUTPUT "$NoOfSplitFiles\n";
  19 close(OUTPUT);
  20
  21 exit(0);
  22 \end{code}
  23
  24
  25 \begin{code}
  26 sub split_asm_file {
  27     local($asm_file) = @_;
  28
  29     open(TMPI, "< $asm_file") || &tidy_up_and_die(1,"$Pgm: failed to open `$asm_file' (to read)\n");
  30
  31     &collectExports_hppa() if $TargetPlatform =~ /^hppa/;
  32     &collectExports_mips() if $TargetPlatform =~ /^mips/;
  33     &collectDyldStuff_powerpc() if $TargetPlatform =~ /^powerpc-apple/;
  34
  35     $octr = 0;  # output file counter
  36     $* = 1;     # multi-line matches are OK
  37
  38     %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants...
  39
  40     $s_stuff = &ReadTMPIUpToAMarker( '', $octr );
  41     # that first stuff is a prologue for all .s outputs
  42     $prologue_stuff = &process_asm_block ( $s_stuff );
  43     # $_ already has some of the next stuff in it...
  44
  45 #   &tidy_up_and_die(1,"$Pgm: no split markers in .s file!\n")
  46 #       if $prologue_stuff eq $s_stuff;
  47
  48     # about to use $Tmp_prefix in a regex - make sure backslashes don't get
  49     # interpreted in a strange way.  ToDo: what about other regex
  50     # characters, eg. '.'?
  51     $Tmp_prefix =~ s/\\/\\\\/g;
  52
  53     # lie about where this stuff came from
  54     $prologue_stuff =~ s|"${Tmp_prefix}\.c"|"$ifile_root\.hc"|g;
  55
  56     while ( $_ ne '' ) { # not EOF
  57         $octr++;
  58
  59         # grab and de-mangle a section of the .s file...
  60         $s_stuff = &ReadTMPIUpToAMarker ( $_, $octr );
  61         $this_piece = &process_asm_block ( $s_stuff );
  62
  63         # output to a file of its own
  64         # open a new output file...
  65         $ofname = "${Tmp_prefix}__${octr}.s";
  66         open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n";
  67
  68         print OUTF $prologue_stuff;
  69         print OUTF $this_piece;
  70
  71         close(OUTF)
  72           || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n");
  73     }
  74
  75     $NoOfSplitFiles = $octr;
  76
  77     close(TMPI) || &tidy_up_and_die(1,"Failed reading $asm_file\n");
  78 }
  79
  80 sub collectExports_hppa { # Note: HP-PA only
  81
  82     %LocalExport = (); # NB: global table
  83
  84     while(<TMPI>) {
  85         if (/^\s+\.EXPORT\s+([^,]+),.*\n/) {
  86             local($label) = $1;
  87             local($body)  = "\t.IMPORT $label";
  88             if (/,DATA/) {
  89                 $body .= ",DATA\n";
  90             } else {
  91                 $body .= ",CODE\n";
  92             }
  93             $label =~ s/\$/\\\$/g;
  94             $LocalExport{$label} = $body;
  95         }
  96     }
  97
  98     seek(TMPI, 0, 0);
  99 }
 100
 101 sub collectExports_mips { # Note: MIPS only
 102     # (not really sure this is necessary [WDP 95/05])
 103
 104     $UNDEFINED_FUNS = ''; # NB: global table
 105
 106     while(<TMPI>) {
 107         $UNDEFINED_FUNS .= $_ if /^\t\.globl\s+\S+ \.\S+\n/;
 108         # just save 'em all
 109     }
 110
 111     seek(TMPI, 0, 0);
 112 }
 113
 114 sub collectDyldStuff_powerpc { # Note: Darwin/PowerPC only
 115     local($chunk_label,$label,$cur_section,$section,$chunk,$alignment,$cur_alignment);
 116
 117     %DyldChunks = (); # NB: global table
 118     %DyldChunksDefined = (); # NB: global table
 119
 120     $cur_section = '';
 121     $section = '';
 122     $label = '';
 123     $chunk = '';
 124     $alignment = '';
 125     $cur_alignment = '';
 126
 127     while ( 1 ) {
 128         $_ = <TMPI>;
 129         if ( $_ eq '' || /^L(_.+)\$.+:/ ) {
 130             if ( $label ne '' ) {
 131                 $DyldChunksDefined{$label} .= $section . $chunk_label . $alignment . $ chunk;
 132                 if( $section =~ s/\.data/\.non_lazy_symbol_pointer/ ) {
 133                     $chunk = "\t.indirect_symbol $label\n\t.long 0\n";
 134                 }
 135                 $DyldChunks{$label} .= $section . $chunk_label . $chunk;
 136                 # don't use $alignment, it's only needed for .data, which we change into .non_lazy_symbol_pointer
 137                 print STDERR "### dyld chunk: $label\n$section$alignment$chunk\n###\n" if $Dump_asm_splitting_info;
 138             }
 139             last if ($_ eq '');
 140
 141             $chunk = '';
 142             $chunk_label = $_;
 143             $label = $1;
 144             $section = $cur_section;
 145             $alignment = $cur_alignment;
 146             print STDERR "label: $label\n" if $Dump_asm_splitting_info;
 147         } elsif ( /^\s*\.(symbol_stub|picsymbol_stub|lazy_symbol_pointer|non_lazy_symbol_pointer|data)/ ) {
 148             $cur_section = $_;
 149             printf STDERR "section: $cur_section\n" if $Dump_asm_splitting_info;
 150             $cur_alignment = ''
 151         } elsif ( /^\s*\.section\s+__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,\d+/ ) {
 152             $cur_section = $_;
 153             printf STDERR "section: $cur_section\n" if $Dump_asm_splitting_info;
 154             $cur_alignment = ''
 155         } elsif ( /^\s*\.align.*/ ) {
 156             $cur_alignment = $_;
 157             printf STDERR "alignment: $cur_alignment\n" if $Dump_asm_splitting_info;
 158         } else {
 159             $chunk .= $_;
 160         }
 161     }
 162
 163     seek(TMPI, 0, 0);
 164 }
 165
 166 sub ReadTMPIUpToAMarker {
 167     local($str, $count) = @_; # already read bits
 168
 169
 170     for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/; $_ = <TMPI> ) {
 171         $str .= $_;
 172     }
 173     # if not EOF, then creep forward until next "real" line
 174     # (throwing everything away).
 175     # that first "real" line will stay in $_.
 176
 177     # This loop is intended to pick up the body of the split_marker function
 178     # Note that the assembler mangler will already have eliminated this code
 179     # if it's been invoked (which it probably has).
 180
 181     while ($_ ne '' && (/_?__stg_split_marker/
 182                      || /^L[^C].*:$/
 183                      || /^\.stab/
 184                      || /\t\.proc/
 185                      || /\t\.stabd/
 186                      || /\t\.even/
 187                      || /\tunlk a6/
 188                      || /^\t!#PROLOGUE/
 189                      || /\t\.prologue/
 190                      || /\t\.frame/
 191                      # || /\t\.end/ NOT!  Let the split_marker regexp catch it
 192                      # || /\t\.ent/ NOT!  Let the split_marker regexp catch it
 193                      || /^\s+(save|retl?|restore|nop)/)) {
 194         $_ = <TMPI>;
 195     }
 196
 197     print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info;
 198
 199     # return str
 200     $str =~ tr/\r//d if $TargetPlatform =~ /-mingw32$/; # in case Perl doesn't convert line endings
 201     $str;
 202 }
 203 \end{code}
 204
 205 We must (a)~strip the marker off the block, (b)~record any literal C
 206 constants that are defined here, and (c)~inject copies of any C constants
 207 that are used-but-not-defined here.
 208
 209 \begin{code}
 210 sub process_asm_block {
 211     local($str) = @_;
 212
 213     return(&process_asm_block_m68k($str))  if $TargetPlatform =~ /^m68k-/;
 214     return(&process_asm_block_sparc($str)) if $TargetPlatform =~ /^sparc-/;
 215     return(&process_asm_block_iX86($str))  if $TargetPlatform =~ /^i[34]86-/;
 216     return(&process_asm_block_alpha($str)) if $TargetPlatform =~ /^alpha-/;
 217     return(&process_asm_block_hppa($str))  if $TargetPlatform =~ /^hppa/;
 218     return(&process_asm_block_mips($str))   if $TargetPlatform =~ /^mips-/;
 219     return(&process_asm_block_powerpc($str))   if $TargetPlatform =~ /^powerpc-apple-/;
 220
 221     # otherwise...
 222     &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n");
 223 }
 224
 225 sub process_asm_block_sparc {
 226     local($str) = @_;
 227
 228     # strip the marker
 229     if ( $OptimiseC ) {
 230         $str =~ s/_?__stg_split_marker.*:\n//;
 231     } else {
 232         $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
 233         $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
 234     }
 235
 236     # make sure the *.hc filename gets saved; not just ghc*.c (temp name)
 237     $str =~ s/^\.stabs "(ghc\d+\.c)"/.stabs "$ifile_root.hc"/g; # HACK HACK
 238
 239     # remove/record any literal constants defined here
 240     while ( $str =~ /(\t\.align .\n\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/ ) {
 241         local($label) = $2;
 242         local($body)  = $1;
 243
 244         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 245             if $LocalConstant{$label};
 246
 247         $LocalConstant{$label} = $body;
 248
 249         $str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//;
 250     }
 251
 252     # inject definitions for any local constants now used herein
 253     foreach $k (keys %LocalConstant) {
 254         if ( $str =~ /\b$k\b/ ) {
 255             $str = $LocalConstant{$k} . $str;
 256         }
 257     }
 258
 259    print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info;
 260
 261    $str;
 262 }
 263
 264 sub process_asm_block_m68k {
 265     local($str) = @_;
 266
 267     # strip the marker
 268
 269     $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 270     $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 271
 272     # it seems prudent to stick on one of these:
 273     $str = "\.text\n\t.even\n" . $str;
 274
 275     # remove/record any literal constants defined here
 276     while ( $str =~ /((LC\d+):\n\t\.ascii.*\n)/ ) {
 277         local($label) = $2;
 278         local($body)  = $1;
 279
 280         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 281             if $LocalConstant{$label};
 282
 283         $LocalConstant{$label} = $body;
 284
 285         $str =~ s/LC\d+:\n\t\.ascii.*\n//;
 286     }
 287
 288     # inject definitions for any local constants now used herein
 289     foreach $k (keys %LocalConstant) {
 290         if ( $str =~ /\b$k\b/ ) {
 291             $str = $LocalConstant{$k} . $str;
 292         }
 293     }
 294
 295    print STDERR "### STRIPPED BLOCK (m68k):\n$str" if $Dump_asm_splitting_info;
 296
 297    $str;
 298 }
 299
 300 sub process_asm_block_alpha {
 301     local($str) = @_;
 302
 303     # strip the marker
 304     if ( $OptimiseC ) {
 305         $str =~ s/_?__stg_split_marker.*:\n//;
 306     } else {
 307         $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
 308     }
 309
 310     # remove/record any literal constants defined here
 311     while ( $str =~ /(\.rdata\n\t\.align \d\n)?(\$(C\d+):\n\t\..*\n)/ ) {
 312         local($label) = $3;
 313         local($body)  = $2;
 314
 315         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 316             if $LocalConstant{$label};
 317
 318         $LocalConstant{$label} = ".rdata\n\t.align 3\n" . $body . "\t.text\n";
 319
 320         $str =~ s/(\.rdata\n\t\.align \d\n)?\$C\d+:\n\t\..*\n//;
 321     }
 322
 323     # inject definitions for any local constants now used herein
 324     foreach $k (keys %LocalConstant) {
 325         if ( $str =~ /\$\b$k\b/ ) {
 326             $str = $LocalConstant{$k} . $str;
 327         }
 328     }
 329
 330     # Slide the dummy direct return code into the vtbl .ent/.end block,
 331     # to keep the label fixed if it's the last thing in a module, and
 332     # to avoid having any anonymous text that the linker will complain about
 333     $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
 334
 335     print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info;
 336
 337     $str;
 338 }
 339
 340 sub process_asm_block_iX86 {
 341     local($str) = @_;
 342
 343     # strip the marker
 344
 345     $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 346     $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 347
 348     # it seems prudent to stick on one of these:
 349     $str = "\.text\n\t.align 4\n" . $str;
 350
 351     # remove/record any literal constants defined here
 352     # [perl made uglier to work around the perl 5.7/5.8 bug documented at
 353     # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated
 354     # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/'
 355     # -- ccshan 2002-09-05]
 356     while ( ($str =~ /(\.?(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ )) {
 357         local($label) = $2;
 358         local($body)  = $1;
 359         local($prefix, $suffix, $*) = ($`, $', 0);
 360
 361         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 362             if $LocalConstant{$label};
 363
 364         while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) {
 365             $body .= $1;
 366             $suffix = $';
 367         }
 368         $LocalConstant{$label} = $body;
 369         $str = $prefix . $suffix;
 370     }
 371
 372     # inject definitions for any local constants now used herein
 373     foreach $k (keys %LocalConstant) {
 374         if ( $str =~ /\b$k\b/ ) {
 375             $str = $LocalConstant{$k} . $str;
 376         }
 377     }
 378
 379    print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info;
 380
 381    $str;
 382 }
 383 \end{code}
 384
 385 \begin{code}
 386 sub process_asm_block_hppa {
 387     local($str) = @_;
 388
 389     # strip the marker
 390     $str =~ s/___stg_split_marker.*\n//;
 391
 392     # remove/record any imports defined here
 393     while ( $str =~ /^(\s+\.IMPORT\s.*\n)/ ) {
 394         $Imports .= $1;
 395
 396         $str =~ s/^\s+\.IMPORT.*\n//;
 397     }
 398
 399     # remove/record any literal constants defined here
 400     while ( $str =~ /^(\s+\.align.*\n(L\$C\d+)\n(\s.*\n)+); end literal\n/ ) {
 401         local($label) = $2;
 402         local($body)  = $1;
 403         local($prefix) = $`;
 404         local($suffix) = $';
 405         $label =~ s/\$/\\\$/g;
 406
 407         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 408             if $LocalConstant{$label};
 409
 410         $LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body;
 411
 412         $str = $prefix . $suffix;
 413     }
 414
 415     # inject definitions for any local constants now used herein
 416     foreach $k (keys %LocalConstant) {
 417         if ( $str =~ /\b$k\b/ ) {
 418             $str = $LocalConstant{$k} . $str;
 419         }
 420     }
 421
 422     # inject required imports for local exports in other chunks
 423     foreach $k (keys %LocalExport) {
 424         if ( $str =~ /\b$k\b/ && ! /EXPORT\s+$k\b/ ) {
 425             $str = $LocalExport{$k} . $str;
 426         }
 427     }
 428
 429     # inject collected imports
 430
 431     $str = $Imports . $str;
 432
 433     print STDERR "### STRIPPED BLOCK (hppa):\n$str" if $Dump_asm_splitting_info;
 434
 435     $str;
 436 }
 437 \end{code}
 438
 439 \begin{code}
 440 sub process_asm_block_mips {
 441     local($str) = @_;
 442
 443     # strip the marker
 444     if ( $OptimiseC ) {
 445         $str =~ s/_?__stg_split_marker.*:\n//;
 446     } else {
 447         $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
 448     }
 449
 450     # remove/record any literal constants defined here
 451     while ( $str =~ /(\t\.rdata\n\t\.align \d\n)?(\$(LC\d+):\n(\t\.byte\t.*\n)+)/ ) {
 452         local($label) = $3;
 453         local($body)  = $2;
 454
 455         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 456             if $LocalConstant{$label};
 457
 458         $LocalConstant{$label} = "\t.rdata\n\t.align 2\n" . $body . "\t.text\n";
 459
 460         $str =~ s/(\t\.rdata\n\t\.align \d\n)?\$LC\d+:\n(\t\.byte\t.*\n)+//;
 461     }
 462
 463     # inject definitions for any local constants now used herein
 464     foreach $k (keys %LocalConstant) {
 465         if ( $str =~ /\$\b$k\b/ ) {
 466             $str = $LocalConstant{$k} . $str;
 467         }
 468     }
 469
 470     # Slide the dummy direct return code into the vtbl .ent/.end block,
 471     # to keep the label fixed if it's the last thing in a module, and
 472     # to avoid having any anonymous text that the linker will complain about
 473     $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
 474
 475     $str .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info
 476
 477     print STDERR "### STRIPPED BLOCK (mips):\n$str" if $Dump_asm_splitting_info;
 478
 479     $str;
 480 }
 481 \end{code}
 482
 483 \begin{code}
 484 sub process_asm_block_powerpc {
 485     local($str) = @_;
 486     local($dyld_stuff) = '';
 487
 488     # strip the marker
 489     $str =~ s/___stg_split_marker.*\n//;
 490
 491     $str =~ s/L_.*\$.*:\n(.|\n)*//;
 492
 493     # remove/record any literal constants defined here
 494     while ( $str =~ s/^(\s+.const_data\n\s+\.align.*\n(LC\d+):\n(\s\.(byte|short|long|fill|space|ascii).*\n)+)// ) {
 495         local($label) = $2;
 496         local($body)  = $1;
 497
 498         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 499             if $LocalConstant{$label};
 500
 501         $LocalConstant{$label} = $body;
 502     }
 503
 504     # inject definitions for any local constants now used herein
 505     foreach $k (keys %LocalConstant) {
 506         if ( $str =~ /\b$k(\b|\[)/ ) {
 507             $str = $LocalConstant{$k} . $str;
 508         }
 509     }
 510
 511     foreach $k (keys %DyldChunks) {
 512         if ( $str =~ /\bL$k\$/ ) {
 513             if ( $str =~ /^$k:$/ ) {
 514                 $dyld_stuff .= $DyldChunksDefined{$k};
 515             } else {
 516                 $dyld_stuff .= $DyldChunks{$k};
 517             }
 518         }
 519     }
 520
 521     $str .= "\n" . $dyld_stuff;
 522
 523     print STDERR "### STRIPPED BLOCK (powerpc):\n$str" if $Dump_asm_splitting_info;
 524
 525     $str;
 526 }
 527 \end{code}
 528
 529 \begin{code}
 530 sub tidy_up_and_die {
 531     local($return_val, $msg) = @_;
 532     print STDERR $msg;
 533     exit (($return_val == 0) ? 0 : 1);
 534 }
 535 \end{code}