Don't use the splitter on Darwin
[ghc.git] / driver / split / ghc-split.pl
1 #************************************************************************
2 #* *
3 #* \section[Driver-obj-splitting]{Splitting into many \tr{.o} files (for libraries)}
4 #* *
5 #************************************************************************
6
7 $TargetPlatform = $TARGETPLATFORM;
8
9 ($Pgm = $0) =~ s|.*/||;
10 $ifile = $ARGV[0];
11 $Tmp_prefix = $ARGV[1];
12 $Output = $ARGV[2];
13
14 &split_asm_file($ifile);
15
16 open(OUTPUT, '>', $Output) || &tidy_up_and_die(1,"$Pgm: failed to open `$Output' (to write)\n");
17 print OUTPUT "$NoOfSplitFiles\n";
18 close(OUTPUT);
19
20 exit(0);
21
22
23 sub split_asm_file {
24 (my $asm_file,) = @_;
25 my @pieces = ();
26
27 open(TMPI, '<', $asm_file) || &tidy_up_and_die(1,"$Pgm: failed to open `$asm_file' (to read)\n");
28
29
30 $octr = 0; # output file counter
31
32 %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants...
33
34 $s_stuff = &ReadTMPIUpToAMarker( '', $octr );
35 # that first stuff is a prologue for all .s outputs
36 $prologue_stuff = &process_asm_block ( $s_stuff );
37 # $_ already has some of the next stuff in it...
38
39 # &tidy_up_and_die(1,"$Pgm: no split markers in .s file!\n")
40 # if $prologue_stuff eq $s_stuff;
41
42 while ( $_ ne '' ) { # not EOF
43 $octr++;
44
45 # grab and de-mangle a section of the .s file...
46 $s_stuff = &ReadTMPIUpToAMarker ( $_, $octr );
47 $pieces[$octr] = &process_asm_block ( $s_stuff );
48 }
49
50 # Make sure that we still have some output when the input file is empty
51 if ($octr == 0) {
52 $octr = 1;
53 $pieces[$octr] = '';
54 }
55
56 $NoOfSplitFiles = $octr;
57
58 if ($pieces[$NoOfSplitFiles] =~ /(\n[ \t]*\.section[ \t]+\.note\.GNU-stack,[^\n]*\n)/m) {
59 $note_gnu_stack = $1;
60 for $octr (1..($NoOfSplitFiles - 1)) {
61 $pieces[$octr] .= $note_gnu_stack;
62 }
63 }
64
65 for $octr (1..$NoOfSplitFiles) {
66 # output to a file of its own
67 # open a new output file...
68 $ofname = "${Tmp_prefix}__${octr}.s";
69 open(OUTF, '>', $ofname) || die "$Pgm: can't open output file: $ofname\n";
70
71 print OUTF $prologue_stuff;
72 print OUTF $pieces[$octr];
73
74 close(OUTF)
75 || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n");
76 }
77
78 close(TMPI) || &tidy_up_and_die(1,"Failed reading $asm_file\n");
79 }
80
81 sub ReadTMPIUpToAMarker {
82 (my $str, my $count) = @_; # already read bits
83
84
85 for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/m; $_ = <TMPI> ) {
86 $str .= $_;
87 }
88 # if not EOF, then creep forward until next "real" line
89 # (throwing everything away).
90 # that first "real" line will stay in $_.
91
92 # This loop is intended to pick up the body of the split_marker function
93
94 while ($_ ne '' && (/_?__stg_split_marker/m
95 || /^L[^C].*:$/m
96 || /\t\.frame/m
97 # || /\t\.end/ NOT! Let the split_marker regexp catch it
98 # || /\t\.ent/ NOT! Let the split_marker regexp catch it
99 || /^\s+(save|retl?|restore|nop)/m)) {
100 $_ = <TMPI>;
101 }
102
103 print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info;
104
105 # return str
106 $str =~ tr/\r//d if $TargetPlatform =~ /-mingw32$/m; # in case Perl doesn't convert line endings
107 $str;
108 }
109 =pod
110
111 We must (a)~strip the marker off the block, (b)~record any literal C
112 constants that are defined here, and (c)~inject copies of any C constants
113 that are used-but-not-defined here.
114
115 =cut
116
117 sub process_asm_block {
118 local($str) = @_;
119
120 return(&process_asm_block_sparc($str)) if $TargetPlatform =~ /^sparc-/m;
121 return(&process_asm_block_iX86($str)) if $TargetPlatform =~ /^i[34]86-/m;
122 return(&process_asm_block_x86_64($str)) if $TargetPlatform =~ /^x86_64-/m;
123 return(&process_asm_block_powerpc_linux($str))
124 if $TargetPlatform =~ /^powerpc-[^-]+-linux/m;
125
126 # otherwise...
127 &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n");
128 }
129
130 sub process_asm_block_sparc {
131 local($str) = @_;
132
133 # strip the marker
134 $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/m;
135 $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/m;
136
137 # remove/record any literal constants defined here
138 while ( $str =~ /(\t\.align .\n\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/m ) {
139 local($label) = $2;
140 local($body) = $1;
141
142 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
143 if $LocalConstant{$label};
144
145 $LocalConstant{$label} = $body;
146
147 $str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//m;
148 }
149
150 # inject definitions for any local constants now used herein
151 foreach $k (keys %LocalConstant) {
152 if ( $str =~ /\b$k\b/m ) {
153 $str = $LocalConstant{$k} . $str;
154 }
155 }
156
157 print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info;
158
159 $str;
160 }
161
162 sub process_asm_block_iX86 {
163 (my $str,) = @_;
164
165 # strip the marker
166
167 $str =~ s/(\.text\n\t\.align .(?:,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/m;
168 $str =~ s/(\t\.align .(?:,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/m;
169
170 # it seems prudent to stick on one of these:
171 $str = "\.text\n\t.align 4\n" . $str;
172
173 # remove/record any literal constants defined here
174 # [perl made uglier to work around the perl 5.7/5.8 bug documented at
175 # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated
176 # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/'
177 # -- ccshan 2002-09-05]
178 while ( ($str =~ /((?:^|\.)(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/m )) {
179 local($label) = $2;
180 local($body) = $1;
181 local($prefix, $suffix) = ($`, $');
182
183 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
184 if $LocalConstant{$label};
185
186 while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) {
187 $body .= $1;
188 $suffix = $';
189 }
190 $LocalConstant{$label} = $body;
191 $str = $prefix . $suffix;
192 }
193
194 # inject definitions for any local constants now used herein
195 foreach $k (keys %LocalConstant) {
196 if ( $str =~ /\b$k\b/m ) {
197 $str = $LocalConstant{$k} . $str;
198 }
199 }
200
201 print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info;
202
203 $str;
204 }
205
206 sub process_asm_block_x86_64 {
207 local($str) = @_;
208
209 # remove/record any literal constants defined here
210 # [perl made uglier to work around the perl 5.7/5.8 bug documented at
211 # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated
212 # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/'
213 # -- ccshan 2002-09-05]
214 while ( ($str =~ /((?:^|\.)(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/m )) {
215 local($label) = $2;
216 local($body) = $1;
217 local($prefix, $suffix) = ($`, $');
218
219 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
220 if $LocalConstant{$label};
221
222 while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) {
223 $body .= $1;
224 $suffix = $';
225 }
226 $LocalConstant{$label} = $body;
227 $str = $prefix . $suffix;
228 }
229
230 # inject definitions for any local constants now used herein
231 foreach $k (keys %LocalConstant) {
232 if ( $str =~ /\b$k\b/m ) {
233 $str = $LocalConstant{$k} . $str;
234 }
235 }
236
237 print STDERR "### STRIPPED BLOCK (x86_64):\n$str" if $Dump_asm_splitting_info;
238
239 $str;
240 }
241
242 sub process_asm_block_powerpc_linux {
243 local($str) = @_;
244
245 # strip the marker
246 $str =~ s/__stg_split_marker.*\n//m;
247
248 # remove/record any literal constants defined here
249 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)+)//m ) {
250 local($label) = $2;
251 local($body) = $1;
252
253 &tidy_up_and_die(1,"Local constant label $label already defined!\n")
254 if $LocalConstant{$label};
255
256 $LocalConstant{$label} = $body;
257 }
258
259 # inject definitions for any local constants now used herein
260 foreach $k (keys %LocalConstant) {
261 if ( $str =~ /[\s,]$k\b/m ) {
262 $str = $LocalConstant{$k} . $str;
263 }
264 }
265
266 print STDERR "### STRIPPED BLOCK (powerpc linux):\n$str" if $Dump_asm_splitting_info;
267
268 $str;
269 }
270
271 sub tidy_up_and_die {
272 local($return_val, $msg) = @_;
273 print STDERR $msg;
274 exit (($return_val == 0) ? 0 : 1);
275 }