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     # 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 { # Note: Darwin/PowerPC only
 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($str))   if $TargetPlatform =~ /^powerpc-apple-/;
 216
 217     # otherwise...
 218     &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n");
 219 }
 220
 221 sub process_asm_block_sparc {
 222     local($str) = @_;
 223
 224     # strip the marker
 225     if ( $OptimiseC ) {
 226         $str =~ s/_?__stg_split_marker.*:\n//;
 227     } else {
 228         $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
 229         $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
 230     }
 231
 232     # make sure the *.hc filename gets saved; not just ghc*.c (temp name)
 233     $str =~ s/^\.stabs "(ghc\d+\.c)"/.stabs "$ifile_root.hc"/g; # HACK HACK
 234
 235     # remove/record any literal constants defined here
 236     while ( $str =~ /(\t\.align .\n\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/ ) {
 237         local($label) = $2;
 238         local($body)  = $1;
 239
 240         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 241             if $LocalConstant{$label};
 242
 243         $LocalConstant{$label} = $body;
 244
 245         $str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//;
 246     }
 247
 248     # inject definitions for any local constants now used herein
 249     foreach $k (keys %LocalConstant) {
 250         if ( $str =~ /\b$k\b/ ) {
 251             $str = $LocalConstant{$k} . $str;
 252         }
 253     }
 254
 255    print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info;
 256
 257    $str;
 258 }
 259
 260 sub process_asm_block_m68k {
 261     local($str) = @_;
 262
 263     # strip the marker
 264
 265     $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 266     $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 267
 268     # it seems prudent to stick on one of these:
 269     $str = "\.text\n\t.even\n" . $str;
 270
 271     # remove/record any literal constants defined here
 272     while ( $str =~ /((LC\d+):\n\t\.ascii.*\n)/ ) {
 273         local($label) = $2;
 274         local($body)  = $1;
 275
 276         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 277             if $LocalConstant{$label};
 278
 279         $LocalConstant{$label} = $body;
 280
 281         $str =~ s/LC\d+:\n\t\.ascii.*\n//;
 282     }
 283
 284     # inject definitions for any local constants now used herein
 285     foreach $k (keys %LocalConstant) {
 286         if ( $str =~ /\b$k\b/ ) {
 287             $str = $LocalConstant{$k} . $str;
 288         }
 289     }
 290
 291    print STDERR "### STRIPPED BLOCK (m68k):\n$str" if $Dump_asm_splitting_info;
 292
 293    $str;
 294 }
 295
 296 sub process_asm_block_alpha {
 297     local($str) = @_;
 298
 299     # strip the marker
 300     if ( $OptimiseC ) {
 301         $str =~ s/_?__stg_split_marker.*:\n//;
 302     } else {
 303         $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
 304     }
 305
 306     # remove/record any literal constants defined here
 307     while ( $str =~ /(\.rdata\n\t\.align \d\n)?(\$(C\d+):\n\t\..*\n)/ ) {
 308         local($label) = $3;
 309         local($body)  = $2;
 310
 311         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 312             if $LocalConstant{$label};
 313
 314         $LocalConstant{$label} = ".rdata\n\t.align 3\n" . $body . "\t.text\n";
 315
 316         $str =~ s/(\.rdata\n\t\.align \d\n)?\$C\d+:\n\t\..*\n//;
 317     }
 318
 319     # inject definitions for any local constants now used herein
 320     foreach $k (keys %LocalConstant) {
 321         if ( $str =~ /\$\b$k\b/ ) {
 322             $str = $LocalConstant{$k} . $str;
 323         }
 324     }
 325
 326     # Slide the dummy direct return code into the vtbl .ent/.end block,
 327     # to keep the label fixed if it's the last thing in a module, and
 328     # to avoid having any anonymous text that the linker will complain about
 329     $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
 330
 331     print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info;
 332
 333     $str;
 334 }
 335
 336 sub process_asm_block_iX86 {
 337     local($str) = @_;
 338
 339     # strip the marker
 340
 341     $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 342     $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 343
 344     # it seems prudent to stick on one of these:
 345     $str = "\.text\n\t.align 4\n" . $str;
 346
 347     # remove/record any literal constants defined here
 348     # [perl made uglier to work around the perl 5.7/5.8 bug documented at
 349     # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated
 350     # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/'
 351     # -- ccshan 2002-09-05]
 352     while ( ($str =~ /(\.?(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ )) {
 353         local($label) = $2;
 354         local($body)  = $1;
 355         local($prefix, $suffix, $*) = ($`, $', 0);
 356
 357         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 358             if $LocalConstant{$label};
 359
 360         while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) {
 361             $body .= $1;
 362             $suffix = $';
 363         }
 364         $LocalConstant{$label} = $body;
 365         $str = $prefix . $suffix;
 366     }
 367
 368     # inject definitions for any local constants now used herein
 369     foreach $k (keys %LocalConstant) {
 370         if ( $str =~ /\b$k\b/ ) {
 371             $str = $LocalConstant{$k} . $str;
 372         }
 373     }
 374
 375    print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info;
 376
 377    $str;
 378 }
 379 \end{code}
 380
 381 \begin{code}
 382 sub process_asm_block_hppa {
 383     local($str) = @_;
 384
 385     # strip the marker
 386     $str =~ s/___stg_split_marker.*\n//;
 387
 388     # remove/record any imports defined here
 389     while ( $str =~ /^(\s+\.IMPORT\s.*\n)/ ) {
 390         $Imports .= $1;
 391
 392         $str =~ s/^\s+\.IMPORT.*\n//;
 393     }
 394
 395     # remove/record any literal constants defined here
 396     while ( $str =~ /^(\s+\.align.*\n(L\$C\d+)\n(\s.*\n)+); end literal\n/ ) {
 397         local($label) = $2;
 398         local($body)  = $1;
 399         local($prefix) = $`;
 400         local($suffix) = $';
 401         $label =~ s/\$/\\\$/g;
 402
 403         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 404             if $LocalConstant{$label};
 405
 406         $LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body;
 407
 408         $str = $prefix . $suffix;
 409     }
 410
 411     # inject definitions for any local constants now used herein
 412     foreach $k (keys %LocalConstant) {
 413         if ( $str =~ /\b$k\b/ ) {
 414             $str = $LocalConstant{$k} . $str;
 415         }
 416     }
 417
 418     # inject required imports for local exports in other chunks
 419     foreach $k (keys %LocalExport) {
 420         if ( $str =~ /\b$k\b/ && ! /EXPORT\s+$k\b/ ) {
 421             $str = $LocalExport{$k} . $str;
 422         }
 423     }
 424
 425     # inject collected imports
 426
 427     $str = $Imports . $str;
 428
 429     print STDERR "### STRIPPED BLOCK (hppa):\n$str" if $Dump_asm_splitting_info;
 430
 431     $str;
 432 }
 433 \end{code}
 434
 435 \begin{code}
 436 sub process_asm_block_mips {
 437     local($str) = @_;
 438
 439     # strip the marker
 440     if ( $OptimiseC ) {
 441         $str =~ s/_?__stg_split_marker.*:\n//;
 442     } else {
 443         $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
 444     }
 445
 446     # remove/record any literal constants defined here
 447     while ( $str =~ /(\t\.rdata\n\t\.align \d\n)?(\$(LC\d+):\n(\t\.byte\t.*\n)+)/ ) {
 448         local($label) = $3;
 449         local($body)  = $2;
 450
 451         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 452             if $LocalConstant{$label};
 453
 454         $LocalConstant{$label} = "\t.rdata\n\t.align 2\n" . $body . "\t.text\n";
 455
 456         $str =~ s/(\t\.rdata\n\t\.align \d\n)?\$LC\d+:\n(\t\.byte\t.*\n)+//;
 457     }
 458
 459     # inject definitions for any local constants now used herein
 460     foreach $k (keys %LocalConstant) {
 461         if ( $str =~ /\$\b$k\b/ ) {
 462             $str = $LocalConstant{$k} . $str;
 463         }
 464     }
 465
 466     # Slide the dummy direct return code into the vtbl .ent/.end block,
 467     # to keep the label fixed if it's the last thing in a module, and
 468     # to avoid having any anonymous text that the linker will complain about
 469     $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
 470
 471     $str .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info
 472
 473     print STDERR "### STRIPPED BLOCK (mips):\n$str" if $Dump_asm_splitting_info;
 474
 475     $str;
 476 }
 477 \end{code}
 478
 479 \begin{code}
 480 sub process_asm_block_powerpc {
 481     local($str) = @_;
 482     local($dyld_stuff) = '';
 483
 484     # strip the marker
 485     $str =~ s/___stg_split_marker.*\n//;
 486
 487     $str =~ s/L_.*\$.*:\n(.|\n)*//;
 488
 489     # remove/record any literal constants defined here
 490     while ( $str =~ s/^(\s+.const_data\n\s+\.align.*\n(LC\d+):\n(\s\.(byte|short|long|fill|space|ascii).*\n)+)// ) {
 491         local($label) = $2;
 492         local($body)  = $1;
 493
 494         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 495             if $LocalConstant{$label};
 496
 497         $LocalConstant{$label} = $body;
 498     }
 499
 500     # inject definitions for any local constants now used herein
 501     foreach $k (keys %LocalConstant) {
 502         if ( $str =~ /\b$k(\b|\[)/ ) {
 503             $str = $LocalConstant{$k} . $str;
 504         }
 505     }
 506
 507     foreach $k (keys %DyldChunks) {
 508         if ( $str =~ /\bL$k\$/ ) {
 509             if ( $str =~ /^$k:$/ ) {
 510                 $dyld_stuff .= $DyldChunksDefined{$k};
 511             } else {
 512                 $dyld_stuff .= $DyldChunks{$k};
 513             }
 514         }
 515     }
 516
 517     $str .= "\n" . $dyld_stuff;
 518
 519     print STDERR "### STRIPPED BLOCK (powerpc):\n$str" if $Dump_asm_splitting_info;
 520
 521     $str;
 522 }
 523 \end{code}
 524
 525 \begin{code}
 526 sub tidy_up_and_die {
 527     local($return_val, $msg) = @_;
 528     print STDERR $msg;
 529     exit (($return_val == 0) ? 0 : 1);
 530 }
 531 \end{code}