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