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 ! /\/\* SPLIT \*\//;
30 if (/\/\* SPLIT \*\//) {
32 print TMPO "__STG_SPLIT_MARKER($marker_no)\n";
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");
45 local($asm_file) = @_;
47 open(TMPI, "< $asm_file") || &tidy_up_and_die(1,"$Pgm: failed to open `$asm_file' (to read)\n");
49 &collectExports_hppa() if $TargetPlatform =~ /^hppa/;
50 &collectExports_mips() if $TargetPlatform =~ /^mips/;
52 $octr = 0; # output file counter
53 $* = 1; # multi-line matches are OK
55 %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants...
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...
62 # &tidy_up_and_die(1,"$Pgm: no split markers in .s file!\n")
63 # if $prologue_stuff eq $s_stuff;
65 # lie about where this stuff came from
66 $prologue_stuff =~ s|"/tmp/ghc\d+\.c"|"$ifile_root\.hc"|g;
68 while ( $_ ne '' ) { # not EOF
70 # grab and de-mangle a section of the .s file...
71 $s_stuff = &ReadTMPIUpToAMarker ( $_ );
72 $this_piece = &process_asm_block ( $s_stuff );
74 # output to a file of its own
75 # open a new output file...
77 $ofname = "${Tmp_prefix}__${octr}.s";
78 open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n";
80 print OUTF $prologue_stuff;
81 print OUTF $this_piece;
84 || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n");
87 $NoOfSplitFiles = $octr;
89 close(TMPI) || &tidy_up_and_die(1,"Failed reading $asm_file\n");
92 sub collectExports_hppa { # Note: HP-PA only
94 %LocalExport = (); # NB: global table
97 if (/^\s+\.EXPORT\s+([^,]+),.*\n/) {
99 local($body) = "\t.IMPORT $label";
105 $label =~ s/\$/\\\$/g;
106 $LocalExport{$label} = $body;
113 sub collectExports_mips { # Note: MIPS only
114 # (not really sure this is necessary [WDP 95/05])
116 $UNDEFINED_FUNS = ''; # NB: global table
119 $UNDEFINED_FUNS .= $_ if /^\t\.globl\s+\S+ \.\S+\n/;
126 sub ReadTMPIUpToAMarker {
127 local($str) = @_; # already read bits
130 for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/; $_ = <TMPI> ) {
133 # if not EOF, then creep forward until next "real" line
134 # (throwing everything away).
135 # that first "real" line will stay in $_.
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).
141 while ($_ ne '' && (/_?__stg_split_marker/
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)/)) {
157 print STDERR "### BLOCK:\n$str" if $Dump_asm_splitting_info;
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.
169 sub process_asm_block {
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-/;
180 &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n");
183 sub process_asm_block_sparc {
188 $str =~ s/_?__stg_split_marker.*:\n//;
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/;
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
197 # remove/record any literal constants defined here
198 while ( $str =~ /(\t\.align .\n(LC\d+):\n\t\.ascii.*\n)/ ) {
202 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
203 if $LocalConstant{$label};
205 $LocalConstant{$label} = $body;
207 $str =~ s/\t\.align .\nLC\d+:\n\t\.ascii.*\n//;
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;
217 print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info;
222 sub process_asm_block_m68k {
225 # strip the marker (ToDo: something special for unregisterized???)
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/;
230 # it seems prudent to stick on one of these:
231 $str = "\.text\n\t.even\n" . $str;
233 # remove/record any literal constants defined here
234 while ( $str =~ /((LC\d+):\n\t\.ascii.*\n)/ ) {
238 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
239 if $LocalConstant{$label};
241 $LocalConstant{$label} = $body;
243 $str =~ s/LC\d+:\n\t\.ascii.*\n//;
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;
253 print STDERR "### STRIPPED BLOCK (m68k):\n$str" if $Dump_asm_splitting_info;
258 sub process_asm_block_alpha {
263 $str =~ s/_?__stg_split_marker.*:\n//;
265 $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/\1/;
268 # remove/record any literal constants defined here
269 while ( $str =~ /(\.rdata\n\t\.align \d\n)?(\$(C\d+):\n\t\..*\n)/ ) {
273 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
274 if $LocalConstant{$label};
276 $LocalConstant{$label} = ".rdata\n\t.align 3\n" . $body . "\t.text\n";
278 $str =~ s/(\.rdata\n\t\.align \d\n)?\$C\d+:\n\t\..*\n//;
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;
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;
293 print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info;
298 sub process_asm_block_iX86 {
301 # strip the marker (ToDo: something special for unregisterized???)
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/;
306 # it seems prudent to stick on one of these:
307 $str = "\.text\n\t.align 4\n" . $str;
309 # remove/record any literal constants defined here
310 while ( ($str =~ /((LC\d+):\n\t\.ascii.*\n)/ )) {
314 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
315 if $LocalConstant{$label};
317 $LocalConstant{$label} = $body;
319 $str =~ s/LC\d+:\n\t\.ascii.*\n//;
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;
329 print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info;
336 sub process_asm_block_hppa {
340 $str =~ s/___stg_split_marker.*\n//;
342 # remove/record any imports defined here
343 while ( $str =~ /^(\s+\.IMPORT\s.*\n)/ ) {
346 $str =~ s/^\s+\.IMPORT.*\n//;
349 # remove/record any literal constants defined here
350 while ( $str =~ /^(\s+\.align.*\n(L\$C\d+)\n(\s.*\n)+); end literal\n/ ) {
353 $label =~ s/\$/\\\$/g;
355 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
356 if $LocalConstant{$label};
358 $LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body;
360 $str =~ s/^\s+\.SPACE \$TEXT\$\n\s+\.SUBSPA \$LIT\$\s+\.align.*\nL\$C\d+\n(\s.*\n)+; end literal\n//;
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;
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;
377 # inject collected imports
379 $str = $Imports . $str;
381 print STDERR "### STRIPPED BLOCK (hppa):\n$str" if $Dump_asm_splitting_info;
388 sub process_asm_block_mips {
393 $str =~ s/_?__stg_split_marker.*:\n//;
395 $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/\1/;
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)+)/ ) {
403 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
404 if $LocalConstant{$label};
406 $LocalConstant{$label} = "\t.rdata\n\t.align 2\n" . $body . "\t.text\n";
408 $str =~ s/(\t\.rdata\n\t\.align \d\n)?\$LC\d+:\n(\t\.byte\t.*\n)+//;
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;
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;
423 $str .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info
425 print STDERR "### STRIPPED BLOCK (mips):\n$str" if $Dump_asm_splitting_info;
432 # make "require"r happy...