… | |
… | |
11 | |
11 | |
12 | my $PREFIX = "bundle"; |
12 | my $PREFIX = "bundle"; |
13 | my $PACKAGE = "static"; |
13 | my $PACKAGE = "static"; |
14 | |
14 | |
15 | my %pm; |
15 | my %pm; |
|
|
16 | my %pmbin; |
16 | my @libs; |
17 | my @libs; |
17 | my @static_ext; |
18 | my @static_ext; |
18 | my $extralibs; |
19 | my $extralibs; |
19 | |
20 | |
20 | @ARGV |
21 | @ARGV |
… | |
… | |
76 | } |
77 | } |
77 | |
78 | |
78 | # module loading is now safe |
79 | # module loading is now safe |
79 | use Config; |
80 | use Config; |
80 | |
81 | |
|
|
82 | sub scan_al { |
|
|
83 | my ($auto, $autodir, $ix) = @_; |
|
|
84 | |
|
|
85 | $pm{"$auto/$ix"} = "$autodir/$ix"; |
|
|
86 | |
|
|
87 | open my $fh, "<:perlio", "$autodir/$ix" |
|
|
88 | or die "$autodir/$ix: $!"; |
|
|
89 | |
|
|
90 | my $package; |
|
|
91 | |
|
|
92 | while (<$fh>) { |
|
|
93 | if (/^\s*sub\s+([^[:space:];]+)\s*;?\s*$/) { |
|
|
94 | my $al = "auto/$package/$1.al"; |
|
|
95 | my $inc = find_inc $al; |
|
|
96 | |
|
|
97 | defined $inc or die "$al: autoload file not found, but should be there.\n"; |
|
|
98 | |
|
|
99 | $pm{$al} = "$inc/$al"; |
|
|
100 | |
|
|
101 | } elsif (/^\s*package\s+([^[:space:];]+)\s*;?\s*$/) { |
|
|
102 | ($package = $1) =~ s/::/\//g; |
|
|
103 | } elsif (/^\s*(?:#|1?\s*;?\s*$)/) { |
|
|
104 | # nop |
|
|
105 | } else { |
|
|
106 | warn "$autodir/$ix: unparsable line, please report: $_"; |
|
|
107 | } |
|
|
108 | } |
|
|
109 | } |
|
|
110 | |
81 | sub trace_module { |
111 | sub trace_module { |
82 | syswrite $TRACER_W, "use $_[0]\n"; |
112 | syswrite $TRACER_W, "use $_[0]\n"; |
83 | |
113 | |
84 | for (;;) { |
114 | for (;;) { |
85 | <$TRACER_R> =~ /^-$/ or last; |
115 | <$TRACER_R> =~ /^-$/ or last; |
… | |
… | |
96 | opendir my $dir, $autodir |
126 | opendir my $dir, $autodir |
97 | or die "$autodir: $!\n"; |
127 | or die "$autodir: $!\n"; |
98 | |
128 | |
99 | for (readdir $dir) { |
129 | for (readdir $dir) { |
100 | # AutoLoader |
130 | # AutoLoader |
101 | $pm{"$auto/$_"} = "$autodir/$_" |
131 | scan_al $auto, $autodir, $_ |
102 | if /\.(?:al|ix)$/; |
132 | if /\.ix$/; |
103 | |
133 | |
104 | # static ext |
134 | # static ext |
105 | if (/\Q$Config{_a}\E$/o) { |
135 | if (/\Q$Config{_a}\E$/o) { |
106 | push @libs, "$autodir/$_"; |
136 | push @libs, "$autodir/$_"; |
107 | push @static_ext, $name; |
137 | push @static_ext, $name; |
… | |
… | |
117 | } |
147 | } |
118 | |
148 | |
119 | # dynamic object |
149 | # dynamic object |
120 | warn "WARNING: found shared object - can't link statically ($_)\n" |
150 | warn "WARNING: found shared object - can't link statically ($_)\n" |
121 | if /\.\Q$Config{dlext}\E$/o; |
151 | if /\.\Q$Config{dlext}\E$/o; |
122 | |
|
|
123 | #TODO: extralibs? |
|
|
124 | } |
152 | } |
125 | } |
153 | } |
126 | } |
154 | } |
127 | } |
155 | } |
128 | } |
156 | } |
… | |
… | |
171 | sub cmd_boot { |
199 | sub cmd_boot { |
172 | $pm{"//boot"} = $_[0]; |
200 | $pm{"//boot"} = $_[0]; |
173 | } |
201 | } |
174 | |
202 | |
175 | sub cmd_add { |
203 | sub cmd_add { |
176 | $_[0] =~ /^(.*)(?:\s*(\S+))$/ |
204 | $_[0] =~ /^(.*)(?:\s+(\S+))$/ |
177 | or die "$_[0]: cannot parse"; |
205 | or die "$_[0]: cannot parse"; |
178 | |
206 | |
179 | my $file = $1; |
207 | my $file = $1; |
180 | my $as = defined $2 ? $2 : "/$1"; |
208 | my $as = defined $2 ? $2 : "/$1"; |
181 | |
209 | |
182 | $pm{$as} = $file; |
210 | $pm{$as} = $file; |
|
|
211 | $pmbin{$as} = 1 if $_[1]; |
183 | } |
212 | } |
184 | |
213 | |
185 | sub cmd_file { |
214 | sub cmd_file { |
186 | open my $fh, "<", $_[0] |
215 | open my $fh, "<", $_[0] |
187 | or die "$_[0]: $!\n"; |
216 | or die "$_[0]: $!\n"; |
188 | |
217 | |
189 | while (<$fh>) { |
218 | while (<$fh>) { |
190 | chomp; |
219 | chomp; |
191 | my ($cmd, $args) = split / /, $_, 2; |
220 | my ($cmd, $args) = split / /, $_, 2; |
|
|
221 | $cmd =~ s/^-+//; |
192 | |
222 | |
193 | if ($cmd eq "strip") { |
223 | if ($cmd eq "strip") { |
194 | $STRIP = $args; |
224 | $STRIP = $args; |
195 | } elsif ($cmd eq "eval") { |
225 | } elsif ($cmd eq "eval") { |
196 | trace_eval $_; |
226 | trace_eval $_; |
… | |
… | |
200 | } elsif ($cmd eq "boot") { |
230 | } elsif ($cmd eq "boot") { |
201 | cmd_boot $args; |
231 | cmd_boot $args; |
202 | } elsif ($cmd eq "static") { |
232 | } elsif ($cmd eq "static") { |
203 | $STATIC = 1; |
233 | $STATIC = 1; |
204 | } elsif ($cmd eq "add") { |
234 | } elsif ($cmd eq "add") { |
205 | cmd_add $args; |
235 | cmd_add $args, 0; |
|
|
236 | } elsif ($cmd eq "addbin") { |
|
|
237 | cmd_add $args, 1; |
206 | } elsif (/^\s*#/) { |
238 | } elsif (/^\s*#/) { |
207 | # comment |
239 | # comment |
208 | } elsif (/\S/) { |
240 | } elsif (/\S/) { |
209 | die "$_: unsupported directive\n"; |
241 | die "$_: unsupported directive\n"; |
210 | } |
242 | } |
… | |
… | |
218 | GetOptions |
250 | GetOptions |
219 | "strip=s" => \$STRIP, |
251 | "strip=s" => \$STRIP, |
220 | "verbose|v" => sub { ++$VERBOSE }, |
252 | "verbose|v" => sub { ++$VERBOSE }, |
221 | "quiet|q" => sub { --$VERBOSE }, |
253 | "quiet|q" => sub { --$VERBOSE }, |
222 | "perl" => \$PERL, |
254 | "perl" => \$PERL, |
223 | "eval=s" => sub { trace_eval $_[1] }, |
255 | "eval|e=s" => sub { trace_eval $_[1] }, |
224 | "use|M=s" => sub { trace_module $_[1] }, |
256 | "use|M=s" => sub { trace_module $_[1] }, |
225 | "boot=s" => sub { cmd_boot $_[1] }, |
257 | "boot=s" => sub { cmd_boot $_[1] }, |
226 | "add=s" => sub { cmd_add $_[1] }, |
258 | "add=s" => sub { cmd_add $_[1], 0 }, |
|
|
259 | "addbin=s" => sub { cmd_add $_[1], 1 }, |
227 | "static" => sub { $STATIC = 1 }, |
260 | "static" => sub { $STATIC = 1 }, |
228 | "<>" => sub { cmd_file $_[1] }, |
261 | "<>" => sub { cmd_file $_[0] }, |
229 | or exit 1; |
262 | or exit 1; |
230 | |
263 | |
231 | my $data; |
264 | my $data; |
232 | my @index; |
265 | my @index; |
233 | my @order = sort { |
266 | my @order = sort { |
… | |
… | |
246 | or die "$pm: path too long (only 128 octets supported)\n"; |
279 | or die "$pm: path too long (only 128 octets supported)\n"; |
247 | |
280 | |
248 | my $src = ref $path |
281 | my $src = ref $path |
249 | ? $$path |
282 | ? $$path |
250 | : do { |
283 | : do { |
251 | open my $pm, "<:perlio", $path |
284 | open my $pm, "<", $path |
252 | or die "$path: $!"; |
285 | or die "$path: $!"; |
253 | |
286 | |
254 | local $/; |
287 | local $/; |
255 | |
288 | |
256 | <$pm> |
289 | <$pm> |
257 | }; |
290 | }; |
258 | |
291 | |
|
|
292 | unless ($pmbin{$pm}) { # only do this unless the file is binary |
|
|
293 | |
259 | if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { |
294 | if ($pm =~ /^auto\/POSIX\/[^\/]+\.al$/) { |
260 | if ($src =~ /^ unimpl \"/m) { |
295 | if ($src =~ /^ unimpl \"/m) { |
261 | warn "$pm: skipping (not implemented anyways).\n" |
296 | warn "$pm: skipping (not implemented anyways).\n" |
262 | if $VERBOSE >= 2; |
297 | if $VERBOSE >= 2; |
263 | next; |
298 | next; |
264 | } |
|
|
265 | } |
|
|
266 | |
|
|
267 | if ($STRIP =~ /ppi/i) { |
|
|
268 | require PPI; |
|
|
269 | |
|
|
270 | my $ppi = PPI::Document->new (\$src); |
|
|
271 | $ppi->prune ("PPI::Token::Comment"); |
|
|
272 | $ppi->prune ("PPI::Token::Pod"); |
|
|
273 | |
|
|
274 | # prune END stuff |
|
|
275 | for (my $last = $ppi->last_element; $last; ) { |
|
|
276 | my $prev = $last->previous_token; |
|
|
277 | |
|
|
278 | if ($last->isa (PPI::Token::Whitespace::)) { |
|
|
279 | $last->delete; |
|
|
280 | } elsif ($last->isa (PPI::Statement::End::)) { |
|
|
281 | $last->delete; |
|
|
282 | last; |
|
|
283 | } elsif ($last->isa (PPI::Token::Pod::)) { |
|
|
284 | $last->delete; |
|
|
285 | } else { |
|
|
286 | last; |
|
|
287 | } |
299 | } |
|
|
300 | } |
288 | |
301 | |
|
|
302 | if ($STRIP =~ /ppi/i) { |
|
|
303 | require PPI; |
|
|
304 | |
|
|
305 | my $ppi = PPI::Document->new (\$src); |
|
|
306 | $ppi->prune ("PPI::Token::Comment"); |
|
|
307 | $ppi->prune ("PPI::Token::Pod"); |
|
|
308 | |
|
|
309 | # prune END stuff |
|
|
310 | for (my $last = $ppi->last_element; $last; ) { |
|
|
311 | my $prev = $last->previous_token; |
|
|
312 | |
|
|
313 | if ($last->isa (PPI::Token::Whitespace::)) { |
|
|
314 | $last->delete; |
|
|
315 | } elsif ($last->isa (PPI::Statement::End::)) { |
|
|
316 | $last->delete; |
|
|
317 | last; |
|
|
318 | } elsif ($last->isa (PPI::Token::Pod::)) { |
|
|
319 | $last->delete; |
|
|
320 | } else { |
|
|
321 | last; |
|
|
322 | } |
|
|
323 | |
289 | $last = $prev; |
324 | $last = $prev; |
290 | } |
325 | } |
291 | |
326 | |
292 | # prune some but not all insignificant whitespace |
327 | # prune some but not all insignificant whitespace |
293 | for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) { |
328 | for my $ws (@{ $ppi->find (PPI::Token::Whitespace::) }) { |
294 | my $prev = $ws->previous_token; |
329 | my $prev = $ws->previous_token; |
295 | my $next = $ws->next_token; |
330 | my $next = $ws->next_token; |
296 | |
331 | |
297 | if (!$prev || !$next) { |
332 | if (!$prev || !$next) { |
298 | $ws->delete; |
|
|
299 | } else { |
|
|
300 | if ( |
|
|
301 | $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float |
|
|
302 | or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/ |
|
|
303 | or $prev->isa (PPI::Token::Structure::) |
|
|
304 | # decrease size, decrease compressability |
|
|
305 | #or ($prev->isa (PPI::Token::Word::) |
|
|
306 | # && (PPI::Token::Symbol:: eq ref $next |
|
|
307 | # || $next->isa (PPI::Structure::Block::) |
|
|
308 | # || $next->isa (PPI::Structure::List::) |
|
|
309 | # || $next->isa (PPI::Structure::Condition::))) |
|
|
310 | ) { |
|
|
311 | $ws->delete; |
333 | $ws->delete; |
312 | } elsif ($prev->isa (PPI::Token::Whitespace::)) { |
|
|
313 | $ws->{content} = ' '; |
|
|
314 | $prev->delete; |
|
|
315 | } else { |
334 | } else { |
|
|
335 | if ( |
|
|
336 | $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float |
|
|
337 | or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/ |
|
|
338 | or $prev->isa (PPI::Token::Structure::) |
|
|
339 | # decrease size, decrease compressability |
|
|
340 | #or ($prev->isa (PPI::Token::Word::) |
|
|
341 | # && (PPI::Token::Symbol:: eq ref $next |
|
|
342 | # || $next->isa (PPI::Structure::Block::) |
|
|
343 | # || $next->isa (PPI::Structure::List::) |
|
|
344 | # || $next->isa (PPI::Structure::Condition::))) |
|
|
345 | ) { |
|
|
346 | $ws->delete; |
|
|
347 | } elsif ($prev->isa (PPI::Token::Whitespace::)) { |
316 | $ws->{content} = ' '; |
348 | $ws->{content} = ' '; |
|
|
349 | $prev->delete; |
|
|
350 | } else { |
|
|
351 | $ws->{content} = ' '; |
|
|
352 | } |
317 | } |
353 | } |
318 | } |
354 | } |
319 | } |
|
|
320 | |
355 | |
321 | # prune whitespace around blocks |
356 | # prune whitespace around blocks |
322 | if (0) { |
357 | if (0) { |
323 | # these usually decrease size, but decrease compressability more |
358 | # these usually decrease size, but decrease compressability more |
324 | for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) { |
359 | for my $struct (PPI::Structure::Block::, PPI::Structure::Condition::) { |
325 | for my $node (@{ $ppi->find ($struct) }) { |
360 | for my $node (@{ $ppi->find ($struct) }) { |
|
|
361 | my $n1 = $node->first_token; |
|
|
362 | my $n2 = $n1->previous_token; |
|
|
363 | $n1->delete if $n1->isa (PPI::Token::Whitespace::); |
|
|
364 | $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::); |
|
|
365 | my $n1 = $node->last_token; |
|
|
366 | my $n2 = $n1->next_token; |
|
|
367 | $n1->delete if $n1->isa (PPI::Token::Whitespace::); |
|
|
368 | $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::); |
|
|
369 | } |
|
|
370 | } |
|
|
371 | |
|
|
372 | for my $node (@{ $ppi->find (PPI::Structure::List::) }) { |
326 | my $n1 = $node->first_token; |
373 | my $n1 = $node->first_token; |
327 | my $n2 = $n1->previous_token; |
|
|
328 | $n1->delete if $n1->isa (PPI::Token::Whitespace::); |
374 | $n1->delete if $n1->isa (PPI::Token::Whitespace::); |
329 | $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::); |
|
|
330 | my $n1 = $node->last_token; |
375 | my $n1 = $node->last_token; |
331 | my $n2 = $n1->next_token; |
|
|
332 | $n1->delete if $n1->isa (PPI::Token::Whitespace::); |
376 | $n1->delete if $n1->isa (PPI::Token::Whitespace::); |
333 | $n2->delete if $n2 && $n2->isa (PPI::Token::Whitespace::); |
|
|
334 | } |
377 | } |
335 | } |
378 | } |
336 | |
379 | |
|
|
380 | # reformat qw() lists which often have lots of whitespace |
337 | for my $node (@{ $ppi->find (PPI::Structure::List::) }) { |
381 | for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) { |
338 | my $n1 = $node->first_token; |
382 | if ($node->{content} =~ /^qw(.)(.*)(.)$/s) { |
339 | $n1->delete if $n1->isa (PPI::Token::Whitespace::); |
383 | my ($a, $qw, $b) = ($1, $2, $3); |
340 | my $n1 = $node->last_token; |
384 | $qw =~ s/^\s+//; |
341 | $n1->delete if $n1->isa (PPI::Token::Whitespace::); |
385 | $qw =~ s/\s+$//; |
|
|
386 | $qw =~ s/\s+/ /g; |
|
|
387 | $node->{content} = "qw$a$qw$b"; |
|
|
388 | } |
342 | } |
389 | } |
343 | } |
|
|
344 | |
390 | |
345 | # reformat qw() lists which often have lots of whitespace |
391 | $src = $ppi->serialize; |
346 | for my $node (@{ $ppi->find (PPI::Token::QuoteLike::Words::) }) { |
392 | } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod |
347 | if ($node->{content} =~ /^qw(.)(.*)(.)$/s) { |
393 | require Pod::Strip; |
348 | my ($a, $qw, $b) = ($1, $2, $3); |
394 | |
349 | $qw =~ s/^\s+//; |
395 | my $stripper = Pod::Strip->new; |
350 | $qw =~ s/\s+$//; |
396 | |
351 | $qw =~ s/\s+/ /g; |
397 | my $out; |
352 | $node->{content} = "qw$a$qw$b"; |
398 | $stripper->output_string (\$out); |
|
|
399 | $stripper->parse_string_document ($src) |
|
|
400 | or die; |
|
|
401 | $src = $out; |
|
|
402 | } |
|
|
403 | |
|
|
404 | if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") { |
|
|
405 | if (open my $fh, "-|") { |
|
|
406 | <$fh>; |
|
|
407 | } else { |
|
|
408 | eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n"; |
|
|
409 | exit 0; |
353 | } |
410 | } |
354 | } |
411 | } |
355 | |
412 | |
356 | $src = $ppi->serialize; |
413 | # if ($pm eq "Opcode.pm") { |
357 | } elsif ($STRIP =~ /pod/i && $pm ne "Opcode.pm") { # opcode parses it's own pod |
414 | # open my $fh, ">x" or die; print $fh $src;#d# |
358 | require Pod::Strip; |
415 | # exit 1; |
359 | |
416 | # } |
360 | my $stripper = Pod::Strip->new; |
|
|
361 | |
|
|
362 | my $out; |
|
|
363 | $stripper->output_string (\$out); |
|
|
364 | $stripper->parse_string_document ($src); |
|
|
365 | $src = $out; |
|
|
366 | } |
417 | } |
367 | |
|
|
368 | if ($VERIFY && $pm =~ /\.pm$/ && $pm ne "Opcode.pm") { |
|
|
369 | if (open my $fh, "-|") { |
|
|
370 | <$fh>; |
|
|
371 | } else { |
|
|
372 | eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n"; |
|
|
373 | exit 0; |
|
|
374 | } |
|
|
375 | } |
|
|
376 | |
|
|
377 | # if ($pm eq "Opcode.pm") { |
|
|
378 | # open my $fh, ">x" or die; print $fh $src;#d# |
|
|
379 | # exit 1; |
|
|
380 | # } |
|
|
381 | |
418 | |
382 | warn "adding $pm\n" |
419 | warn "adding $pm\n" |
383 | if $VERBOSE >= 2; |
420 | if $VERBOSE >= 2; |
384 | |
421 | |
385 | push @index, ((length $pm) << 25) | length $data; |
422 | push @index, ((length $pm) << 25) | length $data; |
… | |
… | |
400 | open my $fh, ">", "$PREFIX.h" |
437 | open my $fh, ">", "$PREFIX.h" |
401 | or die "$PREFIX.h: $!\n"; |
438 | or die "$PREFIX.h: $!\n"; |
402 | |
439 | |
403 | print $fh <<EOF; |
440 | print $fh <<EOF; |
404 | /* do not edit, automatically created by mkstaticbundle */ |
441 | /* do not edit, automatically created by mkstaticbundle */ |
|
|
442 | |
405 | #include <EXTERN.h> |
443 | #include <EXTERN.h> |
406 | #include <perl.h> |
444 | #include <perl.h> |
407 | #include <XSUB.h> |
445 | #include <XSUB.h> |
408 | |
446 | |
409 | /* public API */ |
447 | /* public API */ |
410 | EXTERN_C PerlInterpreter *staticperl; |
448 | EXTERN_C PerlInterpreter *staticperl; |
|
|
449 | EXTERN_C void staticperl_xs_init (pTHX); |
411 | EXTERN_C void staticperl_init (void); |
450 | EXTERN_C void staticperl_init (void); |
412 | EXTERN_C void staticperl_cleanup (void); |
451 | EXTERN_C void staticperl_cleanup (void); |
|
|
452 | |
413 | EOF |
453 | EOF |
414 | } |
454 | } |
415 | |
455 | |
416 | print "\n"; |
456 | print "\n"; |
417 | |
457 | |
… | |
… | |
423 | open my $fh, ">", "$PREFIX.c" |
463 | open my $fh, ">", "$PREFIX.c" |
424 | or die "$PREFIX.c: $!\n"; |
464 | or die "$PREFIX.c: $!\n"; |
425 | |
465 | |
426 | print $fh <<EOF; |
466 | print $fh <<EOF; |
427 | /* do not edit, automatically created by mkstaticbundle */ |
467 | /* do not edit, automatically created by mkstaticbundle */ |
428 | |
|
|
429 | #include <EXTERN.h> |
|
|
430 | #include <perl.h> |
|
|
431 | #include <XSUB.h> |
|
|
432 | |
468 | |
433 | #include "bundle.h" |
469 | #include "bundle.h" |
434 | |
470 | |
435 | /* public API */ |
471 | /* public API */ |
436 | PerlInterpreter *staticperl; |
472 | PerlInterpreter *staticperl; |
… | |
… | |
587 | |
623 | |
588 | ############################################################################# |
624 | ############################################################################# |
589 | # xs_init |
625 | # xs_init |
590 | |
626 | |
591 | print $fh <<EOF; |
627 | print $fh <<EOF; |
592 | static void |
628 | void |
593 | xs_init (pTHX) |
629 | staticperl_xs_init (pTHX) |
594 | { |
630 | { |
595 | EOF |
631 | EOF |
596 | |
632 | |
597 | @static_ext = ("DynaLoader", sort @static_ext); |
633 | @static_ext = ("DynaLoader", sort @static_ext); |
598 | |
634 | |
… | |
… | |
644 | staticperl = perl_alloc (); |
680 | staticperl = perl_alloc (); |
645 | perl_construct (staticperl); |
681 | perl_construct (staticperl); |
646 | |
682 | |
647 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
683 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
648 | |
684 | |
649 | exitstatus = perl_parse (staticperl, xs_init, argc, argv, environ); |
685 | exitstatus = perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); |
650 | if (!exitstatus) |
686 | if (!exitstatus) |
651 | perl_run (staticperl); |
687 | perl_run (staticperl); |
652 | |
688 | |
653 | exitstatus = perl_destruct (staticperl); |
689 | exitstatus = perl_destruct (staticperl); |
654 | perl_free (staticperl); |
690 | perl_free (staticperl); |
… | |
… | |
670 | PERL_SYS_INIT3 (&argc, &argv, &environ); |
706 | PERL_SYS_INIT3 (&argc, &argv, &environ); |
671 | staticperl = perl_alloc (); |
707 | staticperl = perl_alloc (); |
672 | perl_construct (staticperl); |
708 | perl_construct (staticperl); |
673 | PL_origalen = 1; |
709 | PL_origalen = 1; |
674 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
710 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
675 | perl_parse (staticperl, xs_init, argc, argv, environ); |
711 | perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); |
676 | |
712 | |
677 | perl_run (staticperl); |
713 | perl_run (staticperl); |
678 | } |
714 | } |
679 | |
715 | |
680 | EXTERN_C void |
716 | EXTERN_C void |