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