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/ghc\d+\.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;
 143 }
 144 \end{code}
 145
 146 We must (a)~strip the marker off the block, (b)~record any literal C
 147 constants that are defined here, and (c)~inject copies of any C constants
 148 that are used-but-not-defined here.
 149
 150 \begin{code}
 151 sub process_asm_block {
 152     local($str) = @_;
 153
 154     return(&process_asm_block_m68k($str))  if $TargetPlatform =~ /^m68k-/;
 155     return(&process_asm_block_sparc($str)) if $TargetPlatform =~ /^sparc-/;
 156     return(&process_asm_block_iX86($str))  if $TargetPlatform =~ /^i[34]86-/;
 157     return(&process_asm_block_alpha($str)) if $TargetPlatform =~ /^alpha-/;
 158     return(&process_asm_block_hppa($str))  if $TargetPlatform =~ /^hppa/;
 159     return(&process_asm_block_mips($str))   if $TargetPlatform =~ /^mips-/;
 160     return(&process_asm_block_powerpc($str))   if $TargetPlatform =~ /^powerpc-|^rs6000-/;
 161
 162     # otherwise...
 163     &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n");
 164 }
 165
 166 sub process_asm_block_sparc {
 167     local($str) = @_;
 168
 169     # strip the marker
 170     if ( $OptimiseC ) {
 171         $str =~ s/_?__stg_split_marker.*:\n//;
 172     } else {
 173         $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
 174         $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
 175     }
 176
 177     # make sure the *.hc filename gets saved; not just ghc*.c (temp name)
 178     $str =~ s/^\.stabs "(ghc\d+\.c)"/.stabs "$ifile_root.hc"/g; # HACK HACK
 179
 180     # remove/record any literal constants defined here
 181     while ( $str =~ /(\t\.align .\n\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/ ) {
 182         local($label) = $2;
 183         local($body)  = $1;
 184
 185         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 186             if $LocalConstant{$label};
 187
 188         $LocalConstant{$label} = $body;
 189
 190         $str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//;
 191     }
 192
 193     # inject definitions for any local constants now used herein
 194     foreach $k (keys %LocalConstant) {
 195         if ( $str =~ /\b$k\b/ ) {
 196             $str = $LocalConstant{$k} . $str;
 197         }
 198     }
 199
 200    print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info;
 201
 202    $str;
 203 }
 204
 205 sub process_asm_block_m68k {
 206     local($str) = @_;
 207
 208     # strip the marker
 209
 210     $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 211     $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 212
 213     # it seems prudent to stick on one of these:
 214     $str = "\.text\n\t.even\n" . $str;
 215
 216     # remove/record any literal constants defined here
 217     while ( $str =~ /((LC\d+):\n\t\.ascii.*\n)/ ) {
 218         local($label) = $2;
 219         local($body)  = $1;
 220
 221         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 222             if $LocalConstant{$label};
 223
 224         $LocalConstant{$label} = $body;
 225
 226         $str =~ s/LC\d+:\n\t\.ascii.*\n//;
 227     }
 228
 229     # inject definitions for any local constants now used herein
 230     foreach $k (keys %LocalConstant) {
 231         if ( $str =~ /\b$k\b/ ) {
 232             $str = $LocalConstant{$k} . $str;
 233         }
 234     }
 235
 236    print STDERR "### STRIPPED BLOCK (m68k):\n$str" if $Dump_asm_splitting_info;
 237
 238    $str;
 239 }
 240
 241 sub process_asm_block_alpha {
 242     local($str) = @_;
 243
 244     # strip the marker
 245     if ( $OptimiseC ) {
 246         $str =~ s/_?__stg_split_marker.*:\n//;
 247     } else {
 248         $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
 249     }
 250
 251     # remove/record any literal constants defined here
 252     while ( $str =~ /(\.rdata\n\t\.align \d\n)?(\$(C\d+):\n\t\..*\n)/ ) {
 253         local($label) = $3;
 254         local($body)  = $2;
 255
 256         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 257             if $LocalConstant{$label};
 258
 259         $LocalConstant{$label} = ".rdata\n\t.align 3\n" . $body . "\t.text\n";
 260
 261         $str =~ s/(\.rdata\n\t\.align \d\n)?\$C\d+:\n\t\..*\n//;
 262     }
 263
 264     # inject definitions for any local constants now used herein
 265     foreach $k (keys %LocalConstant) {
 266         if ( $str =~ /\$\b$k\b/ ) {
 267             $str = $LocalConstant{$k} . $str;
 268         }
 269     }
 270
 271     # Slide the dummy direct return code into the vtbl .ent/.end block,
 272     # to keep the label fixed if it's the last thing in a module, and
 273     # to avoid having any anonymous text that the linker will complain about
 274     $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
 275
 276     print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info;
 277
 278     $str;
 279 }
 280
 281 sub process_asm_block_iX86 {
 282     local($str) = @_;
 283
 284     # strip the marker
 285
 286     $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 287     $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
 288
 289     # it seems prudent to stick on one of these:
 290     $str = "\.text\n\t.align 4\n" . $str;
 291
 292     # remove/record any literal constants defined here
 293     while ( ($str =~ /(\.?(LC\d+):\n\t\.(ascii|string).*\n)/ )) {
 294         local($label) = $2;
 295         local($body)  = $1;
 296
 297         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 298             if $LocalConstant{$label};
 299
 300         $LocalConstant{$label} = $body;
 301
 302         $str =~ s/\.?LC\d+:\n\t\.(ascii|string).*\n//;
 303     }
 304
 305     # inject definitions for any local constants now used herein
 306     foreach $k (keys %LocalConstant) {
 307         if ( $str =~ /\b$k\b/ ) {
 308             $str = $LocalConstant{$k} . $str;
 309         }
 310     }
 311
 312    print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info;
 313
 314    $str;
 315 }
 316 \end{code}
 317
 318 \begin{code}
 319 sub process_asm_block_hppa {
 320     local($str) = @_;
 321
 322     # strip the marker
 323     $str =~ s/___stg_split_marker.*\n//;
 324
 325     # remove/record any imports defined here
 326     while ( $str =~ /^(\s+\.IMPORT\s.*\n)/ ) {
 327         $Imports .= $1;
 328
 329         $str =~ s/^\s+\.IMPORT.*\n//;
 330     }
 331
 332     # remove/record any literal constants defined here
 333     while ( $str =~ /^(\s+\.align.*\n(L\$C\d+)\n(\s.*\n)+); end literal\n/ ) {
 334         local($label) = $2;
 335         local($body)  = $1;
 336         $label =~ s/\$/\\\$/g;
 337
 338         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 339             if $LocalConstant{$label};
 340
 341         $LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body;
 342
 343         $str =~ s/^\s+\.SPACE \$TEXT\$\n\s+\.SUBSPA \$LIT\$\s+\.align.*\nL\$C\d+\n(\s.*\n)+; end literal\n//;
 344     }
 345
 346     # inject definitions for any local constants now used herein
 347     foreach $k (keys %LocalConstant) {
 348         if ( $str =~ /\b$k\b/ ) {
 349             $str = $LocalConstant{$k} . $str;
 350         }
 351     }
 352
 353     # inject required imports for local exports in other chunks
 354     foreach $k (keys %LocalExport) {
 355         if ( $str =~ /\b$k\b/ && ! /EXPORT\s+$k\b/ ) {
 356             $str = $LocalExport{$k} . $str;
 357         }
 358     }
 359
 360     # inject collected imports
 361
 362     $str = $Imports . $str;
 363
 364     print STDERR "### STRIPPED BLOCK (hppa):\n$str" if $Dump_asm_splitting_info;
 365
 366     $str;
 367 }
 368 \end{code}
 369
 370 \begin{code}
 371 sub process_asm_block_mips {
 372     local($str) = @_;
 373
 374     # strip the marker
 375     if ( $OptimiseC ) {
 376         $str =~ s/_?__stg_split_marker.*:\n//;
 377     } else {
 378         $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
 379     }
 380
 381     # remove/record any literal constants defined here
 382     while ( $str =~ /(\t\.rdata\n\t\.align \d\n)?(\$(LC\d+):\n(\t\.byte\t.*\n)+)/ ) {
 383         local($label) = $3;
 384         local($body)  = $2;
 385
 386         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 387             if $LocalConstant{$label};
 388
 389         $LocalConstant{$label} = "\t.rdata\n\t.align 2\n" . $body . "\t.text\n";
 390
 391         $str =~ s/(\t\.rdata\n\t\.align \d\n)?\$LC\d+:\n(\t\.byte\t.*\n)+//;
 392     }
 393
 394     # inject definitions for any local constants now used herein
 395     foreach $k (keys %LocalConstant) {
 396         if ( $str =~ /\$\b$k\b/ ) {
 397             $str = $LocalConstant{$k} . $str;
 398         }
 399     }
 400
 401     # Slide the dummy direct return code into the vtbl .ent/.end block,
 402     # to keep the label fixed if it's the last thing in a module, and
 403     # to avoid having any anonymous text that the linker will complain about
 404     $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
 405
 406     $str .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info
 407
 408     print STDERR "### STRIPPED BLOCK (mips):\n$str" if $Dump_asm_splitting_info;
 409
 410     $str;
 411 }
 412 \end{code}
 413
 414 \begin{code}
 415 sub process_asm_block_powerpc {
 416     local($str) = @_;
 417
 418     # strip the marker
 419     $str =~ s/___stg_split_marker.*\n//;
 420     $str =~ s/___stg_split_marker.*\n//; # yes, twice.
 421
 422     # remove/record any literal constants defined here
 423     while ( $str =~ /^(.csect .data[RW]\n\s+\.align.*\n(LC\.\.\d+):\n(\s\.byte .*\n)+)/ ) {
 424         local($label) = $2;
 425         local($body)  = $1;
 426
 427         &tidy_up_and_die(1,"Local constant label $label already defined!\n")
 428             if $LocalConstant{$label};
 429
 430         $LocalConstant{$label} = $body;
 431
 432         $str =~ s/^.csect .data[RW]\n\s+\.align.*\nLC\.\.\d+:\n(\s\.byte .*\n)+//;
 433     }
 434
 435     # inject definitions for any local constants now used herein
 436     foreach $k (keys %LocalConstant) {
 437         if ( $str =~ /\b$k(\b|\[)/ ) {
 438             $str = $LocalConstant{$k} . $str;
 439         }
 440     }
 441
 442     print STDERR "### STRIPPED BLOCK (powerpc/rs6000):\n$str" if $Dump_asm_splitting_info;
 443
 444     $str = ".toc\n" . $str;
 445
 446     $str;
 447 }
 448 \end{code}
 449
 450 \begin{code}
 451 sub tidy_up_and_die {
 452     local($return_val, $msg) = @_;
 453     print STDERR $msg;
 454     exit (($return_val == 0) ? 0 : 1);
 455 }
 456 \end{code}