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
  34     $octr = 0;  # output file counter
  35     $* = 1;     # multi-line matches are OK
  36
  37     %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants...
  38
  39     $s_stuff = &ReadTMPIUpToAMarker( '', $octr );
  40     # that first stuff is a prologue for all .s outputs
  41     $prologue_stuff = &process_asm_block ( $s_stuff );
  42     # $_ already has some of the next stuff in it...
  43
  44 #   &tidy_up_and_die(1,"$Pgm: no split markers in .s file!\n")
  45 #       if $prologue_stuff eq $s_stuff;
  46
  47     # lie about where this stuff came from
  48     $prologue_stuff =~ s|"${Tmp_prefix}\.c"|"$ifile_root\.hc"|g;
  49
  50     while ( $_ ne '' ) { # not EOF
  51         $octr++;
  52
  53         # grab and de-mangle a section of the .s file...
  54         $s_stuff = &ReadTMPIUpToAMarker ( $_, $octr );
  55         $this_piece = &process_asm_block ( $s_stuff );
  56
  57         # output to a file of its own
  58         # open a new output file...
  59         $ofname = "${Tmp_prefix}__${octr}.s";
  60         open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n";
  61
  62         print OUTF $prologue_stuff;
  63         print OUTF $this_piece;
  64
  65         close(OUTF)
  66           || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n");
  67     }
  68
  69     $NoOfSplitFiles = $octr;
  70
  71     close(TMPI) || &tidy_up_and_die(1,"Failed reading $asm_file\n");
  72 }
  73
  74 sub collectExports_hppa { # Note: HP-PA only
  75
  76     %LocalExport = (); # NB: global table
  77
  78     while(<TMPI>) {
  79         if (/^\s+\.EXPORT\s+([^,]+),.*\n/) {
  80             local($label) = $1;
  81             local($body)  = "\t.IMPORT $label";
  82             if (/,DATA/) {
  83                 $body .= ",DATA\n";
  84             } else {
  85                 $body .= ",CODE\n";
  86             }
  87             $label =~ s/\$/\\\$/g;
  88             $LocalExport{$label} = $body;
  89         }
  90     }
  91
  92     seek(TMPI, 0, 0);
  93 }
  94
  95 sub collectExports_mips { # Note: MIPS only
  96     # (not really sure this is necessary [WDP 95/05])
  97
  98     $UNDEFINED_FUNS = ''; # NB: global table
  99
 100     while(<TMPI>) {
 101         $UNDEFINED_FUNS .= $_ if /^\t\.globl\s+\S+ \.\S+\n/;
 102         # just save 'em all
 103     }
 104
 105     seek(TMPI, 0, 0);
 106 }
 107
 108 sub ReadTMPIUpToAMarker {
 109     local($str, $count) = @_; # already read bits
 110
 111
 112     for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/; $_ = <TMPI> ) {
 113         $str .= $_;
 114     }
 115     # if not EOF, then creep forward until next "real" line
 116     # (throwing everything away).
 117     # that first "real" line will stay in $_.
 118
 119     # This loop is intended to pick up the body of the split_marker function
 120     # Note that the assembler mangler will already have eliminated this code
 121     # if it's been invoked (which it probably has).
 122
 123     while ($_ ne '' && (/_?__stg_split_marker/
 124                      || /^L[^C].*:$/
 125                      || /^\.stab/
 126                      || /\t\.proc/
 127                      || /\t\.stabd/
 128                      || /\t\.even/
 129                      || /\tunlk a6/
 130                      || /^\t!#PROLOGUE/
 131                      || /\t\.prologue/
 132                      || /\t\.frame/
 133                      # || /\t\.end/ NOT!  Let the split_marker regexp catch it
 134                      # || /\t\.ent/ NOT!  Let the split_marker regexp catch it
 135                      || /^\s+(save|retl?|restore|nop)/)) {
 136         $_ = <TMPI>;
 137     }
 138
 139     print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info;
 140
 141     # return str
 142     $str =~ tr/\r//d if $TargetPlatform =~ /-mingw32$/;
 143     $str;
 144 }
 145 \end{code}
 146
 147 We must (a)~strip the marker off the block, (b)~record any literal C
 148 constants that are defined here, and (c)~inject copies of any C constants
 149 that are used-but-not-defined here.
 150
 151 \begin{code}
 152 sub process_asm_block {
 153     local($str) = @_;
 154
 155     return(&process_asm_block_m68k($str))  if $TargetPlatform =~ /^m68k-/;
 156     return(&process_asm_block_sparc($str)) if $TargetPlatform =~ /^sparc-/;
 157     return(&process_asm_block_iX86($str))  if $TargetPlatform =~ /^i[34]86-/;
 158     return(&process_asm_block_alpha($str)) if $TargetPlatform =~ /^alpha-/;
 159     return(&process_asm_block_hppa($str))  if $TargetPlatform =~ /^hppa/;
 160     return(&process_asm_block_mips($str))   if $TargetPlatform =~ /^mips-/;
 161     return(&process_asm_block_powerpc($str))   if $TargetPlatform =~ /^powerpc-|^rs6000-/;
 162
 163     # otherwise...
 164     &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n");
 165 }
 166
 167 sub process_asm_block_sparc {
 168     local($str) = @_;
 169
 170     # strip the marker
 171     if ( $OptimiseC ) {
 172         $str =~ s/_?__stg_split_marker.*:\n//;
 173     } else {
 174         $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
 175         $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
 176     }
 177
 178     # make sure the *.hc filename gets saved; not just ghc*.c (temp name)
 179     $str =~ s/^\.stabs "(ghc\d+\.c)"/.stabs "$ifile_root.hc"/g; # HACK HACK
 180
 181     # remove/record any literal constants defined here
 182     while ( $str =~ /(\t\.align .\n\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/ ) {
 183         local($label) = $2;
 184         local($body)  = $1;
 185
 186         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 187             if $LocalConstant{$label};
 188
 189         $LocalConstant{$label} = $body;
 190
 191         $str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//;
 192     }
 193
 194     # inject definitions for any local constants now used herein
 195     foreach $k (keys %LocalConstant) {
 196         if ( $str =~ /\b$k\b/ ) {
 197             $str = $LocalConstant{$k} . $str;
 198         }
 199     }
 200
 201    print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info;
 202
 203    $str;
 204 }
 205
 206 sub process_asm_block_m68k {
 207     local($str) = @_;
 208
 209     # strip the marker
 210
 211     $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 212     $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 213
 214     # it seems prudent to stick on one of these:
 215     $str = "\.text\n\t.even\n" . $str;
 216
 217     # remove/record any literal constants defined here
 218     while ( $str =~ /((LC\d+):\n\t\.ascii.*\n)/ ) {
 219         local($label) = $2;
 220         local($body)  = $1;
 221
 222         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 223             if $LocalConstant{$label};
 224
 225         $LocalConstant{$label} = $body;
 226
 227         $str =~ s/LC\d+:\n\t\.ascii.*\n//;
 228     }
 229
 230     # inject definitions for any local constants now used herein
 231     foreach $k (keys %LocalConstant) {
 232         if ( $str =~ /\b$k\b/ ) {
 233             $str = $LocalConstant{$k} . $str;
 234         }
 235     }
 236
 237    print STDERR "### STRIPPED BLOCK (m68k):\n$str" if $Dump_asm_splitting_info;
 238
 239    $str;
 240 }
 241
 242 sub process_asm_block_alpha {
 243     local($str) = @_;
 244
 245     # strip the marker
 246     if ( $OptimiseC ) {
 247         $str =~ s/_?__stg_split_marker.*:\n//;
 248     } else {
 249         $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
 250     }
 251
 252     # remove/record any literal constants defined here
 253     while ( $str =~ /(\.rdata\n\t\.align \d\n)?(\$(C\d+):\n\t\..*\n)/ ) {
 254         local($label) = $3;
 255         local($body)  = $2;
 256
 257         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 258             if $LocalConstant{$label};
 259
 260         $LocalConstant{$label} = ".rdata\n\t.align 3\n" . $body . "\t.text\n";
 261
 262         $str =~ s/(\.rdata\n\t\.align \d\n)?\$C\d+:\n\t\..*\n//;
 263     }
 264
 265     # inject definitions for any local constants now used herein
 266     foreach $k (keys %LocalConstant) {
 267         if ( $str =~ /\$\b$k\b/ ) {
 268             $str = $LocalConstant{$k} . $str;
 269         }
 270     }
 271
 272     # Slide the dummy direct return code into the vtbl .ent/.end block,
 273     # to keep the label fixed if it's the last thing in a module, and
 274     # to avoid having any anonymous text that the linker will complain about
 275     $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
 276
 277     print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info;
 278
 279     $str;
 280 }
 281
 282 sub process_asm_block_iX86 {
 283     local($str) = @_;
 284
 285     # strip the marker
 286
 287     $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 288     $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 289
 290     # it seems prudent to stick on one of these:
 291     $str = "\.text\n\t.align 4\n" . $str;
 292
 293     # remove/record any literal constants defined here
 294     while ( ($str =~ /(\.?(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n)+)/ )) {
 295         local($label) = $2;
 296         local($body)  = $1;
 297
 298         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 299             if $LocalConstant{$label};
 300
 301         $LocalConstant{$label} = $body;
 302
 303         $str =~ s/\.?LC\d+:\n(\t\.(ascii|string).*\n|\s*\.byte.*\n)+//;
 304     }
 305
 306     # inject definitions for any local constants now used herein
 307     foreach $k (keys %LocalConstant) {
 308         if ( $str =~ /\b$k\b/ ) {
 309             $str = $LocalConstant{$k} . $str;
 310         }
 311     }
 312
 313    print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info;
 314
 315    $str;
 316 }
 317 \end{code}
 318
 319 \begin{code}
 320 sub process_asm_block_hppa {
 321     local($str) = @_;
 322
 323     # strip the marker
 324     $str =~ s/___stg_split_marker.*\n//;
 325
 326     # remove/record any imports defined here
 327     while ( $str =~ /^(\s+\.IMPORT\s.*\n)/ ) {
 328         $Imports .= $1;
 329
 330         $str =~ s/^\s+\.IMPORT.*\n//;
 331     }
 332
 333     # remove/record any literal constants defined here
 334     while ( $str =~ /^(\s+\.align.*\n(L\$C\d+)\n(\s.*\n)+); end literal\n/ ) {
 335         local($label) = $2;
 336         local($body)  = $1;
 337         local($prefix) = $`;
 338         local($suffix) = $';
 339         $label =~ s/\$/\\\$/g;
 340
 341         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 342             if $LocalConstant{$label};
 343
 344         $LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body;
 345
 346         $str = $prefix . $suffix;
 347     }
 348
 349     # inject definitions for any local constants now used herein
 350     foreach $k (keys %LocalConstant) {
 351         if ( $str =~ /\b$k\b/ ) {
 352             $str = $LocalConstant{$k} . $str;
 353         }
 354     }
 355
 356     # inject required imports for local exports in other chunks
 357     foreach $k (keys %LocalExport) {
 358         if ( $str =~ /\b$k\b/ && ! /EXPORT\s+$k\b/ ) {
 359             $str = $LocalExport{$k} . $str;
 360         }
 361     }
 362
 363     # inject collected imports
 364
 365     $str = $Imports . $str;
 366
 367     print STDERR "### STRIPPED BLOCK (hppa):\n$str" if $Dump_asm_splitting_info;
 368
 369     $str;
 370 }
 371 \end{code}
 372
 373 \begin{code}
 374 sub process_asm_block_mips {
 375     local($str) = @_;
 376
 377     # strip the marker
 378     if ( $OptimiseC ) {
 379         $str =~ s/_?__stg_split_marker.*:\n//;
 380     } else {
 381         $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
 382     }
 383
 384     # remove/record any literal constants defined here
 385     while ( $str =~ /(\t\.rdata\n\t\.align \d\n)?(\$(LC\d+):\n(\t\.byte\t.*\n)+)/ ) {
 386         local($label) = $3;
 387         local($body)  = $2;
 388
 389         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 390             if $LocalConstant{$label};
 391
 392         $LocalConstant{$label} = "\t.rdata\n\t.align 2\n" . $body . "\t.text\n";
 393
 394         $str =~ s/(\t\.rdata\n\t\.align \d\n)?\$LC\d+:\n(\t\.byte\t.*\n)+//;
 395     }
 396
 397     # inject definitions for any local constants now used herein
 398     foreach $k (keys %LocalConstant) {
 399         if ( $str =~ /\$\b$k\b/ ) {
 400             $str = $LocalConstant{$k} . $str;
 401         }
 402     }
 403
 404     # Slide the dummy direct return code into the vtbl .ent/.end block,
 405     # to keep the label fixed if it's the last thing in a module, and
 406     # to avoid having any anonymous text that the linker will complain about
 407     $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
 408
 409     $str .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info
 410
 411     print STDERR "### STRIPPED BLOCK (mips):\n$str" if $Dump_asm_splitting_info;
 412
 413     $str;
 414 }
 415 \end{code}
 416
 417 \begin{code}
 418 sub process_asm_block_powerpc {
 419     local($str) = @_;
 420
 421     # strip the marker
 422     $str =~ s/___stg_split_marker.*\n//;
 423     $str =~ s/___stg_split_marker.*\n//; # yes, twice.
 424
 425     # remove/record any literal constants defined here
 426     while ( $str =~ /^(.csect .data[RW]\n\s+\.align.*\n(LC\.\.\d+):\n(\s\.byte .*\n)+)/ ) {
 427         local($label) = $2;
 428         local($body)  = $1;
 429
 430         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 431             if $LocalConstant{$label};
 432
 433         $LocalConstant{$label} = $body;
 434
 435         $str =~ s/^.csect .data[RW]\n\s+\.align.*\nLC\.\.\d+:\n(\s\.byte .*\n)+//;
 436     }
 437
 438     # inject definitions for any local constants now used herein
 439     foreach $k (keys %LocalConstant) {
 440         if ( $str =~ /\b$k(\b|\[)/ ) {
 441             $str = $LocalConstant{$k} . $str;
 442         }
 443     }
 444
 445     print STDERR "### STRIPPED BLOCK (powerpc/rs6000):\n$str" if $Dump_asm_splitting_info;
 446
 447     $str = ".toc\n" . $str;
 448
 449     $str;
 450 }
 451 \end{code}
 452
 453 \begin{code}
 454 sub tidy_up_and_die {
 455     local($return_val, $msg) = @_;
 456     print STDERR $msg;
 457     exit (($return_val == 0) ? 0 : 1);
 458 }
 459 \end{code}