1 %************************************************************************
3 \section[Driver-obj-splitting]{Splitting into many \tr{.o} files (for libraries)}
5 %************************************************************************
8 sub inject_split_markers {
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');
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");
18 local($marker_no) = 1;
20 # make sure there is a split marker before any "real" code
22 while ( $_ ne '' && ( /^$/ || /^#/ ) ) {
26 print TMPO "__STG_SPLIT_MARKER(1)\n";
27 print TMPO $_ if ! /^\s*\/\* SPLIT \*\/\s*$/;
29 # Have to be a bit careful detecting /* SPLIT */ comments
30 # since a progam may use a string containing "/* SPLIT */"
31 # We check that there is nothing else on the line
34 if (/^\s*\/\* SPLIT \*\/\s*$/) {
36 print TMPO "__STG_SPLIT_MARKER($marker_no)\n";
42 close(TMPI) || &tidy_up_and_die(1,"Failed reading $Tmp_prefix.unmkd\n");
43 close(TMPO) || &tidy_up_and_die(1,"Failed writing $hc_file\n");
49 local($asm_file) = @_;
51 open(TMPI, "< $asm_file") || &tidy_up_and_die(1,"$Pgm: failed to open `$asm_file' (to read)\n");
53 &collectExports_hppa() if $TargetPlatform =~ /^hppa/;
54 &collectExports_mips() if $TargetPlatform =~ /^mips/;
56 $octr = 0; # output file counter
57 $* = 1; # multi-line matches are OK
59 %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants...
61 $s_stuff = &ReadTMPIUpToAMarker( '', $octr );
62 # that first stuff is a prologue for all .s outputs
63 $prologue_stuff = &process_asm_block ( $s_stuff );
64 # $_ already has some of the next stuff in it...
66 # &tidy_up_and_die(1,"$Pgm: no split markers in .s file!\n")
67 # if $prologue_stuff eq $s_stuff;
69 # lie about where this stuff came from
70 $prologue_stuff =~ s|"/tmp/ghc\d+\.c"|"$ifile_root\.hc"|g;
72 while ( $_ ne '' ) { # not EOF
75 # grab and de-mangle a section of the .s file...
76 $s_stuff = &ReadTMPIUpToAMarker ( $_, $octr );
77 $this_piece = &process_asm_block ( $s_stuff );
79 # output to a file of its own
80 # open a new output file...
81 $ofname = "${Tmp_prefix}__${octr}.s";
82 open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n";
84 print OUTF $prologue_stuff;
85 print OUTF $this_piece;
88 || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n");
91 $NoOfSplitFiles = $octr;
93 close(TMPI) || &tidy_up_and_die(1,"Failed reading $asm_file\n");
96 sub collectExports_hppa { # Note: HP-PA only
98 %LocalExport = (); # NB: global table
101 if (/^\s+\.EXPORT\s+([^,]+),.*\n/) {
103 local($body) = "\t.IMPORT $label";
109 $label =~ s/\$/\\\$/g;
110 $LocalExport{$label} = $body;
117 sub collectExports_mips { # Note: MIPS only
118 # (not really sure this is necessary [WDP 95/05])
120 $UNDEFINED_FUNS = ''; # NB: global table
123 $UNDEFINED_FUNS .= $_ if /^\t\.globl\s+\S+ \.\S+\n/;
130 sub ReadTMPIUpToAMarker {
131 local($str, $count) = @_; # already read bits
134 for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/; $_ = <TMPI> ) {
137 # if not EOF, then creep forward until next "real" line
138 # (throwing everything away).
139 # that first "real" line will stay in $_.
141 # This loop is intended to pick up the body of the split_marker function
142 # Note that the assembler mangler will already have eliminated this code
143 # if it's been invoked (which it probably has).
145 while ($_ ne '' && (/_?__stg_split_marker/
155 # || /\t\.end/ NOT! Let the split_marker regexp catch it
156 # || /\t\.ent/ NOT! Let the split_marker regexp catch it
157 || /^\s+(save|retl?|restore|nop)/)) {
161 print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info;
168 We must (a)~strip the marker off the block, (b)~record any literal C
169 constants that are defined here, and (c)~inject copies of any C constants
170 that are used-but-not-defined here.
173 sub process_asm_block {
176 return(&process_asm_block_m68k($str)) if $TargetPlatform =~ /^m68k-/;
177 return(&process_asm_block_sparc($str)) if $TargetPlatform =~ /^sparc-/;
178 return(&process_asm_block_iX86($str)) if $TargetPlatform =~ /^i[34]86-/;
179 return(&process_asm_block_alpha($str)) if $TargetPlatform =~ /^alpha-/;
180 return(&process_asm_block_hppa($str)) if $TargetPlatform =~ /^hppa/;
181 return(&process_asm_block_mips($str)) if $TargetPlatform =~ /^mips-/;
182 return(&process_asm_block_powerpc($str)) if $TargetPlatform =~ /^powerpc-|^rs6000-/;
185 &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n");
188 sub process_asm_block_sparc {
193 $str =~ s/_?__stg_split_marker.*:\n//;
195 $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
196 $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
199 # make sure the *.hc filename gets saved; not just ghc*.c (temp name)
200 $str =~ s/^\.stabs "(ghc\d+\.c)"/.stabs "$ifile_root.hc"/g; # HACK HACK
202 # remove/record any literal constants defined here
203 while ( $str =~ /(\t\.align .\n\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/ ) {
207 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
208 if $LocalConstant{$label};
210 $LocalConstant{$label} = $body;
212 $str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//;
215 # inject definitions for any local constants now used herein
216 foreach $k (keys %LocalConstant) {
217 if ( $str =~ /\b$k\b/ ) {
218 $str = $LocalConstant{$k} . $str;
222 print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info;
227 sub process_asm_block_m68k {
232 $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
233 $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
235 # it seems prudent to stick on one of these:
236 $str = "\.text\n\t.even\n" . $str;
238 # remove/record any literal constants defined here
239 while ( $str =~ /((LC\d+):\n\t\.ascii.*\n)/ ) {
243 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
244 if $LocalConstant{$label};
246 $LocalConstant{$label} = $body;
248 $str =~ s/LC\d+:\n\t\.ascii.*\n//;
251 # inject definitions for any local constants now used herein
252 foreach $k (keys %LocalConstant) {
253 if ( $str =~ /\b$k\b/ ) {
254 $str = $LocalConstant{$k} . $str;
258 print STDERR "### STRIPPED BLOCK (m68k):\n$str" if $Dump_asm_splitting_info;
263 sub process_asm_block_alpha {
268 $str =~ s/_?__stg_split_marker.*:\n//;
270 $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
273 # remove/record any literal constants defined here
274 while ( $str =~ /(\.rdata\n\t\.align \d\n)?(\$(C\d+):\n\t\..*\n)/ ) {
278 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
279 if $LocalConstant{$label};
281 $LocalConstant{$label} = ".rdata\n\t.align 3\n" . $body . "\t.text\n";
283 $str =~ s/(\.rdata\n\t\.align \d\n)?\$C\d+:\n\t\..*\n//;
286 # inject definitions for any local constants now used herein
287 foreach $k (keys %LocalConstant) {
288 if ( $str =~ /\$\b$k\b/ ) {
289 $str = $LocalConstant{$k} . $str;
293 # Slide the dummy direct return code into the vtbl .ent/.end block,
294 # to keep the label fixed if it's the last thing in a module, and
295 # to avoid having any anonymous text that the linker will complain about
296 $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
298 print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info;
303 sub process_asm_block_iX86 {
308 $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
309 $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
311 # it seems prudent to stick on one of these:
312 $str = "\.text\n\t.align 4\n" . $str;
314 # remove/record any literal constants defined here
315 while ( ($str =~ /(\.?(LC\d+):\n\t\.(ascii|string).*\n)/ )) {
319 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
320 if $LocalConstant{$label};
322 $LocalConstant{$label} = $body;
324 $str =~ s/\.?LC\d+:\n\t\.(ascii|string).*\n//;
327 # inject definitions for any local constants now used herein
328 foreach $k (keys %LocalConstant) {
329 if ( $str =~ /\b$k\b/ ) {
330 $str = $LocalConstant{$k} . $str;
334 print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info;
341 sub process_asm_block_hppa {
345 $str =~ s/___stg_split_marker.*\n//;
347 # remove/record any imports defined here
348 while ( $str =~ /^(\s+\.IMPORT\s.*\n)/ ) {
351 $str =~ s/^\s+\.IMPORT.*\n//;
354 # remove/record any literal constants defined here
355 while ( $str =~ /^(\s+\.align.*\n(L\$C\d+)\n(\s.*\n)+); end literal\n/ ) {
358 $label =~ s/\$/\\\$/g;
360 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
361 if $LocalConstant{$label};
363 $LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body;
365 $str =~ s/^\s+\.SPACE \$TEXT\$\n\s+\.SUBSPA \$LIT\$\s+\.align.*\nL\$C\d+\n(\s.*\n)+; end literal\n//;
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;
375 # inject required imports for local exports in other chunks
376 foreach $k (keys %LocalExport) {
377 if ( $str =~ /\b$k\b/ && ! /EXPORT\s+$k\b/ ) {
378 $str = $LocalExport{$k} . $str;
382 # inject collected imports
384 $str = $Imports . $str;
386 print STDERR "### STRIPPED BLOCK (hppa):\n$str" if $Dump_asm_splitting_info;
393 sub process_asm_block_mips {
398 $str =~ s/_?__stg_split_marker.*:\n//;
400 $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
403 # remove/record any literal constants defined here
404 while ( $str =~ /(\t\.rdata\n\t\.align \d\n)?(\$(LC\d+):\n(\t\.byte\t.*\n)+)/ ) {
408 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
409 if $LocalConstant{$label};
411 $LocalConstant{$label} = "\t.rdata\n\t.align 2\n" . $body . "\t.text\n";
413 $str =~ s/(\t\.rdata\n\t\.align \d\n)?\$LC\d+:\n(\t\.byte\t.*\n)+//;
416 # inject definitions for any local constants now used herein
417 foreach $k (keys %LocalConstant) {
418 if ( $str =~ /\$\b$k\b/ ) {
419 $str = $LocalConstant{$k} . $str;
423 # Slide the dummy direct return code into the vtbl .ent/.end block,
424 # to keep the label fixed if it's the last thing in a module, and
425 # to avoid having any anonymous text that the linker will complain about
426 $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
428 $str .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info
430 print STDERR "### STRIPPED BLOCK (mips):\n$str" if $Dump_asm_splitting_info;
437 sub process_asm_block_powerpc {
441 $str =~ s/___stg_split_marker.*\n//;
442 $str =~ s/___stg_split_marker.*\n//; # yes, twice.
444 # remove/record any literal constants defined here
445 while ( $str =~ /^(.csect .data[RW]\n\s+\.align.*\n(LC\.\.\d+):\n(\s\.byte .*\n)+)/ ) {
449 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
450 if $LocalConstant{$label};
452 $LocalConstant{$label} = $body;
454 $str =~ s/^.csect .data[RW]\n\s+\.align.*\nLC\.\.\d+:\n(\s\.byte .*\n)+//;
457 # inject definitions for any local constants now used herein
458 foreach $k (keys %LocalConstant) {
459 if ( $str =~ /\b$k(\b|\[)/ ) {
460 $str = $LocalConstant{$k} . $str;
464 print STDERR "### STRIPPED BLOCK (powerpc/rs6000):\n$str" if $Dump_asm_splitting_info;
466 $str = ".toc\n" . $str;
473 # make "require"r happy...