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-/;
184 &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n");
187 sub process_asm_block_sparc {
192 $str =~ s/_?__stg_split_marker.*:\n//;
194 $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
195 $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
198 # make sure the *.hc filename gets saved; not just ghc*.c (temp name)
199 $str =~ s/^\.stabs "(ghc\d+\.c)"/.stabs "$ifile_root.hc"/g; # HACK HACK
201 # remove/record any literal constants defined here
202 while ( $str =~ /(\t\.align .\n(LC\d+):\n(\t\.ascii.*\n)+)/ ) {
206 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
207 if $LocalConstant{$label};
209 $LocalConstant{$label} = $body;
211 $str =~ s/\t\.align .\nLC\d+:\n(\t\.ascii.*\n)+//;
214 # inject definitions for any local constants now used herein
215 foreach $k (keys %LocalConstant) {
216 if ( $str =~ /\b$k\b/ ) {
217 $str = $LocalConstant{$k} . $str;
221 print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info;
226 sub process_asm_block_m68k {
231 $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
232 $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
234 # it seems prudent to stick on one of these:
235 $str = "\.text\n\t.even\n" . $str;
237 # remove/record any literal constants defined here
238 while ( $str =~ /((LC\d+):\n\t\.ascii.*\n)/ ) {
242 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
243 if $LocalConstant{$label};
245 $LocalConstant{$label} = $body;
247 $str =~ s/LC\d+:\n\t\.ascii.*\n//;
250 # inject definitions for any local constants now used herein
251 foreach $k (keys %LocalConstant) {
252 if ( $str =~ /\b$k\b/ ) {
253 $str = $LocalConstant{$k} . $str;
257 print STDERR "### STRIPPED BLOCK (m68k):\n$str" if $Dump_asm_splitting_info;
262 sub process_asm_block_alpha {
267 $str =~ s/_?__stg_split_marker.*:\n//;
269 $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
272 # remove/record any literal constants defined here
273 while ( $str =~ /(\.rdata\n\t\.align \d\n)?(\$(C\d+):\n\t\..*\n)/ ) {
277 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
278 if $LocalConstant{$label};
280 $LocalConstant{$label} = ".rdata\n\t.align 3\n" . $body . "\t.text\n";
282 $str =~ s/(\.rdata\n\t\.align \d\n)?\$C\d+:\n\t\..*\n//;
285 # inject definitions for any local constants now used herein
286 foreach $k (keys %LocalConstant) {
287 if ( $str =~ /\$\b$k\b/ ) {
288 $str = $LocalConstant{$k} . $str;
292 # Slide the dummy direct return code into the vtbl .ent/.end block,
293 # to keep the label fixed if it's the last thing in a module, and
294 # to avoid having any anonymous text that the linker will complain about
295 $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
297 print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info;
302 sub process_asm_block_iX86 {
307 $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
308 $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
310 # it seems prudent to stick on one of these:
311 $str = "\.text\n\t.align 4\n" . $str;
313 # remove/record any literal constants defined here
314 while ( ($str =~ /((LC\d+):\n\t\.ascii.*\n)/ )) {
318 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
319 if $LocalConstant{$label};
321 $LocalConstant{$label} = $body;
323 $str =~ s/LC\d+:\n\t\.ascii.*\n//;
326 # inject definitions for any local constants now used herein
327 foreach $k (keys %LocalConstant) {
328 if ( $str =~ /\b$k\b/ ) {
329 $str = $LocalConstant{$k} . $str;
333 print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info;
340 sub process_asm_block_hppa {
344 $str =~ s/___stg_split_marker.*\n//;
346 # remove/record any imports defined here
347 while ( $str =~ /^(\s+\.IMPORT\s.*\n)/ ) {
350 $str =~ s/^\s+\.IMPORT.*\n//;
353 # remove/record any literal constants defined here
354 while ( $str =~ /^(\s+\.align.*\n(L\$C\d+)\n(\s.*\n)+); end literal\n/ ) {
357 $label =~ s/\$/\\\$/g;
359 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
360 if $LocalConstant{$label};
362 $LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body;
364 $str =~ s/^\s+\.SPACE \$TEXT\$\n\s+\.SUBSPA \$LIT\$\s+\.align.*\nL\$C\d+\n(\s.*\n)+; end literal\n//;
367 # inject definitions for any local constants now used herein
368 foreach $k (keys %LocalConstant) {
369 if ( $str =~ /\b$k\b/ ) {
370 $str = $LocalConstant{$k} . $str;
374 # inject required imports for local exports in other chunks
375 foreach $k (keys %LocalExport) {
376 if ( $str =~ /\b$k\b/ && ! /EXPORT\s+$k\b/ ) {
377 $str = $LocalExport{$k} . $str;
381 # inject collected imports
383 $str = $Imports . $str;
385 print STDERR "### STRIPPED BLOCK (hppa):\n$str" if $Dump_asm_splitting_info;
392 sub process_asm_block_mips {
397 $str =~ s/_?__stg_split_marker.*:\n//;
399 $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
402 # remove/record any literal constants defined here
403 while ( $str =~ /(\t\.rdata\n\t\.align \d\n)?(\$(LC\d+):\n(\t\.byte\t.*\n)+)/ ) {
407 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
408 if $LocalConstant{$label};
410 $LocalConstant{$label} = "\t.rdata\n\t.align 2\n" . $body . "\t.text\n";
412 $str =~ s/(\t\.rdata\n\t\.align \d\n)?\$LC\d+:\n(\t\.byte\t.*\n)+//;
415 # inject definitions for any local constants now used herein
416 foreach $k (keys %LocalConstant) {
417 if ( $str =~ /\$\b$k\b/ ) {
418 $str = $LocalConstant{$k} . $str;
422 # Slide the dummy direct return code into the vtbl .ent/.end block,
423 # to keep the label fixed if it's the last thing in a module, and
424 # to avoid having any anonymous text that the linker will complain about
425 $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
427 $str .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info
429 print STDERR "### STRIPPED BLOCK (mips):\n$str" if $Dump_asm_splitting_info;
436 # make "require"r happy...