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