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