ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/App-Staticperl/mkbundle
(Generate patch)

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.17 by root, Wed Feb 9 09:52:27 2011 UTC vs.
Revision 1.40 by root, Thu Aug 3 03:06:47 2023 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2 2
3############################################################################# 3#############################################################################
4# cannot load modules till after the tracer BEGIN block 4# cannot load modules till after the tracer BEGIN block
5 5
6our $VERBOSE = 1; 6our $VERBOSE = 1;
7our $STRIP = "pod"; # none, pod or ppi 7our $STRIP = "pod"; # none, pod or ppi
8our $UNISTRIP = 1; # always on, try to strip unicore swash data 8our $UNISTRIP = 1; # always on, try to strip unicore swash data
9our $PERL = 0; 9our $PERL = 0;
10our $APP; 10our $APP;
11our $VERIFY = 0; 11our $VERIFY = 0;
12our $STATIC = 0; 12our $STATIC = 0;
13our $PACKLIST = 0; 13our $PACKLIST = 0;
14our $IGNORE_ENV = 0;
15our $ALLOW_DYNAMIC = 0;
16our $HAVE_DYNAMIC; # maybe useful?
17our $EXTRA_CFLAGS = "";
18our $EXTRA_LDFLAGS = "";
19our $EXTRA_LIBS = "";
14 20
15our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression? 21our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression?
16 22
17our $CACHE; 23our $CACHE;
18our $CACHEVER = 1; # do not change unless you know what you are doing 24our $CACHEVER = 2; # do not change unless you know what you are doing
19 25
20my $PREFIX = "bundle"; 26my $PREFIX = "bundle";
21my $PACKAGE = "static"; 27my $PACKAGE = "static";
22 28
23my %pm; 29my %pm;
… …
73 my $dir = find_incdir $_[1] 79 my $dir = find_incdir $_[1]
74 or return; 80 or return;
75 81
76 syswrite $W_TRACER, "-\n$dir\n$_[1]\n"; 82 syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
77 83
78 open my $fh, "<:perlio", "$dir/$_[1]" 84 open my $fh, "<:raw:perlio", "$dir/$_[1]"
79 or warn "ERROR: $dir/$_[1]: $!\n"; 85 or warn "ERROR: $dir/$_[1]: $!\n";
80 86
81 $fh 87 $fh
82 }; 88 };
83 89
84 while (<$R_TRACER>) { 90 while (<$R_TRACER>) {
85 if (/use (.*)$/) { 91 if (/use (.*)$/) {
86 my $mod = $1; 92 my $mod = $1;
93 my $eval;
94
95 if ($mod =~ /^'.*'$/ or $mod =~ /^".*"$/) {
96 $eval = "require $mod";
97 } elsif ($mod =~ y%/.%%) {
98 $eval = "require q\x00$mod\x00";
99 } else {
87 my $pkg = ++$pkg; 100 my $pkg = ++$pkg;
88 my $eval = $mod = $mod =~ /[^A-Za-z0-9_:]/
89 ? "require $mod"
90 : "{ package $pkg; use $mod; }"; 101 $eval = "{ package $pkg; use $mod; }";
102 }
103
91 eval $eval; 104 eval $eval;
92 warn "ERROR: $@ (while loading '$mod')\n" 105 warn "ERROR: $@ (while loading '$mod')\n"
93 if $@; 106 if $@;
94 } elsif (/eval (.*)$/) { 107 } elsif (/eval (.*)$/) {
95 my $eval = $1; 108 my $eval = $1;
… …
152 my ($variant, $src, $filter) = @_; 165 my ($variant, $src, $filter) = @_;
153 166
154 if (length $CACHE and 2048 <= length $src and defined $variant) { 167 if (length $CACHE and 2048 <= length $src and defined $variant) {
155 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src"; 168 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src";
156 169
157 if (open my $fh, "<:perlio", $file) { 170 if (open my $fh, "<:raw:perlio", $file) {
158 print "using cache for $file\n" 171 print "using cache for $file\n"
159 if $VERBOSE >= 7; 172 if $VERBOSE >= 7;
160 173
161 local $/; 174 local $/;
162 return <$fh>; 175 return <$fh>;
… …
165 $src = $filter->($src); 178 $src = $filter->($src);
166 179
167 print "creating cache entry $file\n" 180 print "creating cache entry $file\n"
168 if $VERBOSE >= 8; 181 if $VERBOSE >= 8;
169 182
170 if (open my $fh, ">:perlio", "$file~") { 183 if (open my $fh, ">:raw:perlio", "$file~") {
171 if ((syswrite $fh, $src) == length $src) { 184 if ((syswrite $fh, $src) == length $src) {
172 close $fh; 185 close $fh;
173 rename "$file~", $file; 186 rename "$file~", $file;
174 } 187 }
175 } 188 }
… …
182 195
183sub dump_string { 196sub dump_string {
184 my ($fh, $data) = @_; 197 my ($fh, $data) = @_;
185 198
186 if (length $data) { 199 if (length $data) {
200 if ($^O eq "MSWin32") {
201 # 16 bit system, strings can't be longer than 64k. seriously.
202 print $fh "{\n";
187 for ( 203 for (
188 my $ofs = 0; 204 my $ofs = 0;
205 length (my $substr = substr $data, $ofs, 20);
206 $ofs += 20
207 ) {
208 $substr = join ",", map ord, split //, $substr;
209 print $fh " $substr,\n";
210 }
211 print $fh " 0 }\n";
212 } else {
213 for (
214 my $ofs = 0;
189 length (my $substr = substr $data, $ofs, 80); 215 length (my $substr = substr $data, $ofs, 80);
190 $ofs += 80 216 $ofs += 80
191 ) { 217 ) {
192 $substr =~ s/([^\x20-\x21\x23-\x5b\x5d-\x7e])/sprintf "\\%03o", ord $1/ge; 218 $substr =~ s/([^\x20-\x21\x23-\x5b\x5d-\x7e])/sprintf "\\%03o", ord $1/ge;
193 $substr =~ s/\?/\\?/g; # trigraphs... 219 $substr =~ s/\?/\\?/g; # trigraphs...
194 print $fh " \"$substr\"\n"; 220 print $fh " \"$substr\"\n";
221 }
195 } 222 }
196 } else { 223 } else {
197 print $fh " \"\"\n"; 224 print $fh " \"\"\n";
198 } 225 }
199} 226}
… …
266} 293}
267 294
268############################################################################# 295#############################################################################
269 296
270sub cmd_boot { 297sub cmd_boot {
271 $pm{"//boot"} = $_[0]; 298 $pm{"!boot"} = $_[0];
272} 299}
273 300
274sub cmd_add { 301sub cmd_add {
275 $_[0] =~ /^(.*)(?:\s+(\S+))$/ 302 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
276 or die "$_[0]: cannot parse"; 303 or die "$_[0]: cannot parse";
277 304
278 my $file = $1; 305 my $file = $1;
279 my $as = defined $2 ? $2 : "/$1"; 306 my $as = defined $2 ? $2 : $1;
280 307
281 $pm{$as} = $file; 308 $pm{$as} = $file;
282 $pmbin{$as} = 1 if $_[1]; 309 $pmbin{$as} = 1 if $_[1];
283} 310}
284 311
… …
329 356
330use Getopt::Long; 357use Getopt::Long;
331 358
332sub parse_argv { 359sub parse_argv {
333 GetOptions 360 GetOptions
361 "perl" => \$PERL,
362 "app=s" => \$APP,
363
364 "verbose|v" => sub { ++$VERBOSE },
365 "quiet|q" => sub { --$VERBOSE },
366
334 "strip=s" => \$STRIP, 367 "strip=s" => \$STRIP,
335 "cache=s" => \$CACHE, # internal option 368 "cache=s" => \$CACHE, # internal option
336 "verbose|v" => sub { ++$VERBOSE },
337 "quiet|q" => sub { --$VERBOSE },
338 "perl" => \$PERL,
339 "app=s" => \$APP,
340 "eval|e=s" => sub { trace_eval $_[1] }, 369 "eval|e=s" => sub { trace_eval $_[1] },
341 "use|M=s" => sub { trace_module $_[1] }, 370 "use|M=s" => sub { trace_module $_[1] },
342 "boot=s" => sub { cmd_boot $_[1] }, 371 "boot=s" => sub { cmd_boot $_[1] },
343 "add=s" => sub { cmd_add $_[1], 0 }, 372 "add=s" => sub { cmd_add $_[1], 0 },
344 "addbin=s" => sub { cmd_add $_[1], 1 }, 373 "addbin=s" => sub { cmd_add $_[1], 1 },
345 "incglob=s" => sub { cmd_incglob $_[1] }, 374 "incglob=s" => sub { cmd_incglob $_[1] },
346 "include|i=s" => sub { cmd_include $_[1], 1 }, 375 "include|i=s" => sub { cmd_include $_[1], 1 },
347 "exclude|x=s" => sub { cmd_include $_[1], 0 }, 376 "exclude|x=s" => sub { cmd_include $_[1], 0 },
348 "static!" => \$STATIC,
349 "usepacklists!" => \$PACKLIST, 377 "usepacklists!" => \$PACKLIST,
378
379 "static!" => \$STATIC,
350 "staticlib=s" => sub { cmd_staticlib $_[1] }, 380 "staticlib=s" => sub { cmd_staticlib $_[1] },
381 "allow-dynamic!" => \$ALLOW_DYNAMIC,
382 "ignore-env" => \$IGNORE_ENV,
383
384 "extra-cflags=s" => \$EXTRA_CFLAGS,
385 "extra-ldflags=s" => \$EXTRA_LDFLAGS,
386 "extra-libs=s" => \$EXTRA_LIBS,
387
351 "<>" => sub { cmd_file $_[0] }, 388 "<>" => sub { cmd_file $_[0] },
352 or exit 1; 389 or exit 1;
353} 390}
354 391
355Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 392Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
356 393
… …
462 push @libs, "$autodir/$base$Config{_a}"; 499 push @libs, "$autodir/$base$Config{_a}";
463 push @static_ext, $pm; 500 push @static_ext, $pm;
464 } 501 }
465 502
466 # dynamic object 503 # dynamic object
467 die "ERROR: found shared object - can't link statically ($_)\n"
468 if -f "$autodir/$base.$Config{dlext}"; 504 if (-f "$autodir/$base.$Config{dlext}") {
505 if ($ALLOW_DYNAMIC) {
506 my $as = "!$auto/$base.$Config{dlext}";
507 $pm{$as} = "$autodir/$base.$Config{dlext}";
508 $pmbin{$as} = 1;
509
510 $HAVE_DYNAMIC = 1;
511
512 print "+ added dynamic object $as\n"
513 if $VERBOSE >= 3;
514 } else {
515 die "ERROR: found shared object '$autodir/$base.$Config{dlext}' but --allow-dynamic not given, aborting.\n"
516 }
517 }
469 518
470 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") { 519 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") {
471 print "found .packlist for $pm\n" 520 print "found .packlist for $pm\n"
472 if $VERBOSE >= 3; 521 if $VERBOSE >= 3;
473 522
… …
521 or die "ERROR: $pm: path too long (only 128 octets supported)\n"; 570 or die "ERROR: $pm: path too long (only 128 octets supported)\n";
522 571
523 my $src = ref $path 572 my $src = ref $path
524 ? $$path 573 ? $$path
525 : do { 574 : do {
526 open my $pm, "<", $path 575 open my $pm, "<:raw:perlio", $path
527 or die "$path: $!"; 576 or die "$path: $!";
528 577
529 local $/; 578 local $/;
530 579
531 <$pm> 580 <$pm>
… …
606 my $next = $ws->next_token; 655 my $next = $ws->next_token;
607 656
608 if (!$prev || !$next) { 657 if (!$prev || !$next) {
609 $ws->delete; 658 $ws->delete;
610 } else { 659 } else {
660 if ($next->isa (PPI::Token::Whitespace::)) {
661 $ws->delete;
611 if ( 662 } elsif (
612 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float 663 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float
613 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/ 664 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/
614 or $prev->isa (PPI::Token::Structure::) 665 or $prev->isa (PPI::Token::Structure::)
615 or ($OPTIMISE_SIZE && 666 or ($OPTIMISE_SIZE &&
616 ($prev->isa (PPI::Token::Word::) 667 ($prev->isa (PPI::Token::Word::)
… …
618 || $next->isa (PPI::Structure::Block::) 669 || $next->isa (PPI::Structure::Block::)
619 || $next->isa (PPI::Structure::List::) 670 || $next->isa (PPI::Structure::List::)
620 || $next->isa (PPI::Structure::Condition::))) 671 || $next->isa (PPI::Structure::Condition::)))
621 ) 672 )
622 ) { 673 ) {
674 # perl has some idiotic warnigns about nonexisting operators
675 if ($prev->isa (PPI::Token::Operator::) && $prev->{content} eq "="
676 && $next->isa (PPI::Token::Operator::) && $next->{content} =~ /[+\-]/
677 ) {
678 # avoid "Reverse %s operator" diagnostic
679 } else {
623 $ws->delete; 680 $ws->delete;
624 } elsif ($prev->isa (PPI::Token::Whitespace::)) {
625 $ws->{content} = ' ';
626 $prev->delete; 681 }
627 } else { 682 } else {
628 $ws->{content} = ' '; 683 $ws->{content} = ' ';
629 } 684 }
630 } 685 }
631 } 686 }
… …
707} 762}
708 763
709length $data < 2**25 764length $data < 2**25
710 or die "ERROR: bundle too large (only 32MB supported)\n"; 765 or die "ERROR: bundle too large (only 32MB supported)\n";
711 766
712my $varpfx = "bundle_" . substr +(Digest::MD5::md5_hex $data), 0, 16; 767my $varpfx = "bundle";
713 768
714############################################################################# 769#############################################################################
715# output 770# output
716 771
717print "generating $PREFIX.h... " 772print "generating $PREFIX.h... "
… …
720{ 775{
721 open my $fh, ">", "$PREFIX.h" 776 open my $fh, ">", "$PREFIX.h"
722 or die "$PREFIX.h: $!\n"; 777 or die "$PREFIX.h: $!\n";
723 778
724 print $fh <<EOF; 779 print $fh <<EOF;
725/* do not edit, automatically created by mkstaticbundle */ 780/* do not edit, automatically created by staticperl */
726 781
727#include <EXTERN.h> 782#include <EXTERN.h>
728#include <perl.h> 783#include <perl.h>
729#include <XSUB.h> 784#include <XSUB.h>
730 785
731/* public API */ 786/* public API */
732EXTERN_C PerlInterpreter *staticperl; 787EXTERN_C PerlInterpreter *staticperl;
733EXTERN_C void staticperl_xs_init (pTHX); 788EXTERN_C void staticperl_xs_init (pTHX);
734EXTERN_C void staticperl_init (void); 789EXTERN_C void staticperl_init (XSINIT_t xs_init); /* argument can be 0 */
735EXTERN_C void staticperl_cleanup (void); 790EXTERN_C void staticperl_cleanup (void);
736 791
737EOF 792EOF
738} 793}
739 794
… …
748 803
749open my $fh, ">", "$PREFIX.c" 804open my $fh, ">", "$PREFIX.c"
750 or die "$PREFIX.c: $!\n"; 805 or die "$PREFIX.c: $!\n";
751 806
752print $fh <<EOF; 807print $fh <<EOF;
753/* do not edit, automatically created by mkstaticbundle */ 808/* do not edit, automatically created by staticperl */
754 809
755#include "bundle.h" 810#include "bundle.h"
756 811
757/* public API */ 812/* public API */
758PerlInterpreter *staticperl; 813PerlInterpreter *staticperl;
… …
790# bootstrap 845# bootstrap
791 846
792# boot file for staticperl 847# boot file for staticperl
793# this file will be eval'ed at initialisation time 848# this file will be eval'ed at initialisation time
794 849
850# lines marked with "^D" are only used when $HAVE_DYNAMIC
795my $bootstrap = ' 851my $bootstrap = '
796BEGIN { 852BEGIN {
797 package ' . $PACKAGE . '; 853 package ' . $PACKAGE . ';
798 854
799 PerlIO::scalar->bootstrap; 855 # the path prefix to use when putting files into %INC
856 our $inc_prefix;
800 857
801 @INC = sub { 858 # the @INC hook to use when we have PerlIO::scalar available
859 my $perlio_inc = sub {
802 my $data = find "$_[1]" 860 my $data = find "$_[1]"
803 or return; 861 or return;
804 862
805 $INC{$_[1]} = $_[1]; 863 $INC{$_[1]} = "$inc_prefix$_[1]";
806 864
807 open my $fh, "<", \$data; 865 open my $fh, "<", \$data;
808 $fh 866 $fh
809 }; 867 };
868
869D if (defined &PerlIO::scalar::bootstrap) {
870 # PerlIO::scalar statically compiled in
871 PerlIO::scalar->bootstrap;
872 @INC = $perlio_inc;
873D } else {
874D # PerlIO::scalar not available, use slower method
875D @INC = sub {
876D # always check if PerlIO::scalar might now be available
877D if (defined &PerlIO::scalar::bootstrap) {
878D # switch to the faster perlio_inc hook
879D @INC = map { $_ == $_[0] ? $perlio_inc : $_ } @INC;
880D goto &$perlio_inc;
881D }
882D
883D my $data = find "$_[1]"
884D or return;
885D
886D $INC{$_[1]} = "$inc_prefix$_[1]";
887D
888D sub {
889D $data =~ /\G([^\n]*\n?)/g
890D or return;
891D
892D $_ = $1;
893D 1
894D }
895D };
896D }
810} 897}
811'; 898';
812 899
813$bootstrap .= "require '//boot';" 900$bootstrap .= "require '!boot';"
814 if exists $pm{"//boot"}; 901 if exists $pm{"!boot"};
815 902
903if ($HAVE_DYNAMIC) {
904 $bootstrap =~ s/^D/ /mg;
905} else {
906 $bootstrap =~ s/^D.*$//mg;
907}
908
909$bootstrap =~ s/#.*$//mg;
816$bootstrap =~ s/\s+/ /g; 910$bootstrap =~ s/\s+/ /g;
817$bootstrap =~ s/(\W) /$1/g; 911$bootstrap =~ s/(\W) /$1/g;
818$bootstrap =~ s/ (\W)/$1/g; 912$bootstrap =~ s/ (\W)/$1/g;
819 913
820print $fh "const char bootstrap [] = "; 914print $fh "const char bootstrap [] = ";
… …
866 } 960 }
867 961
868 XSRETURN (0); 962 XSRETURN (0);
869 963
870 found: 964 found:
871 ST (0) = res; 965 ST (0) = sv_2mortal (res);
872 sv_2mortal (ST (0));
873 } 966 }
874 967
875 XSRETURN (1); 968 XSRETURN (1);
876} 969}
877 970
… …
890 983
891 for (i = 0; i < $varpfx\_count; ++i) 984 for (i = 0; i < $varpfx\_count; ++i)
892 { 985 {
893 U32 idx = $varpfx\_index [i]; 986 U32 idx = $varpfx\_index [i];
894 987
895 PUSHs (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)); 988 PUSHs (sv_2mortal (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)));
896 } 989 }
897 } 990 }
898 991
899 XSRETURN ($varpfx\_count); 992 XSRETURN ($varpfx\_count);
900} 993}
994
995#ifdef STATICPERL_BUNDLE_INCLUDE
996#include STATICPERL_BUNDLE_INCLUDE
997#endif
901 998
902EOF 999EOF
903 1000
904############################################################################# 1001#############################################################################
905# xs_init 1002# xs_init
… …
908void 1005void
909staticperl_xs_init (pTHX) 1006staticperl_xs_init (pTHX)
910{ 1007{
911EOF 1008EOF
912 1009
913@static_ext = ("DynaLoader", sort @static_ext); 1010@static_ext = sort @static_ext;
914 1011
915# prototypes 1012# prototypes
916for (@static_ext) { 1013for (@static_ext) {
917 s/\.pm$//; 1014 s/\.pm$//;
918 (my $cname = $_) =~ s/\//__/g; 1015 (my $cname = $_) =~ s/\//__/g;
… …
923 char *file = __FILE__; 1020 char *file = __FILE__;
924 dXSUB_SYS; 1021 dXSUB_SYS;
925 1022
926 newXSproto ("$PACKAGE\::find", find, file, "\$"); 1023 newXSproto ("$PACKAGE\::find", find, file, "\$");
927 newXSproto ("$PACKAGE\::list", list, file, ""); 1024 newXSproto ("$PACKAGE\::list", list, file, "");
1025
1026 #ifdef STATICPERL_BUNDLE_XS_INIT
1027 STATICPERL_BUNDLE_XS_INIT;
1028 #endif
928EOF 1029EOF
929 1030
930# calls 1031# calls
931for (@static_ext) { 1032for (@static_ext) {
932 s/\.pm$//; 1033 s/\.pm$//;
933 1034
934 (my $cname = $_) =~ s/\//__/g; 1035 (my $cname = $_) =~ s/\//__/g;
935 (my $pname = $_) =~ s/\//::/g; 1036 (my $pname = $_) =~ s/\//::/g;
936 1037
937 my $bootstrap = $pname eq "DynaLoader" ? "boot" : "bootstrap"; 1038 my $bootstrap = $pname eq "DynaLoader" ? "boot_DynaLoader" : "bootstrap";
938 1039
939 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 1040 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
940} 1041}
941 1042
942print $fh <<EOF; 1043print $fh <<EOF;
1044 Safefree (PL_origfilename);
1045 PL_origfilename = savepv (PL_origargv [0]);
1046 sv_setpv (GvSV (gv_fetchpvs ("0", GV_ADD|GV_NOTQUAL, SVt_PV)), PL_origfilename);
1047
1048 #ifdef _WIN32
1049 /* windows perls usually trail behind unix perls 8-10 years in exporting symbols */
1050
1051 if (!PL_preambleav)
1052 PL_preambleav = newAV ();
1053
1054 av_unshift (PL_preambleav, 1);
1055 av_store (PL_preambleav, 0, newSVpv (bootstrap, sizeof (bootstrap) - 1));
1056 #else
943 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1)); 1057 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1));
1058 #endif
1059
1060 if (PL_oldname)
1061 ((XSINIT_t)PL_oldname)(aTHX);
944} 1062}
945EOF 1063EOF
946 1064
947############################################################################# 1065#############################################################################
948# optional perl_init/perl_destroy 1066# optional perl_init/perl_destroy
1067
1068if ($IGNORE_ENV) {
1069 $IGNORE_ENV = <<EOF;
1070 unsetenv ("PERL_UNICODE");
1071 unsetenv ("PERL_HASH_SEED_DEBUG");
1072 unsetenv ("PERL_DESTRUCT_LEVEL");
1073 unsetenv ("PERL_SIGNALS");
1074 unsetenv ("PERL_DEBUG_MSTATS");
1075 unsetenv ("PERL5OPT");
1076 unsetenv ("PERLIO_DEBUG");
1077 unsetenv ("PERLIO");
1078 unsetenv ("PERL_HASH_SEED");
1079EOF
1080} else {
1081 $IGNORE_ENV = "";
1082}
949 1083
950if ($APP) { 1084if ($APP) {
951 print $fh <<EOF; 1085 print $fh <<EOF;
952 1086
953int 1087int
… …
963 args [3] = "--"; 1097 args [3] = "--";
964 1098
965 for (i = 1; i < argc; ++i) 1099 for (i = 1; i < argc; ++i)
966 args [i + 3] = argv [i]; 1100 args [i + 3] = argv [i];
967 1101
1102$IGNORE_ENV
968 PERL_SYS_INIT3 (&argc, &argv, &environ); 1103 PERL_SYS_INIT3 (&argc, &argv, &environ);
969 staticperl = perl_alloc (); 1104 staticperl = perl_alloc ();
970 perl_construct (staticperl); 1105 perl_construct (staticperl);
971 1106
972 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1107 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
973 1108
974 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ); 1109 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ);
975 free (args);
976 if (!exitstatus) 1110 if (!exitstatus)
977 perl_run (staticperl); 1111 perl_run (staticperl);
978 1112
979 exitstatus = perl_destruct (staticperl); 1113 exitstatus = perl_destruct (staticperl);
980 perl_free (staticperl); 1114 perl_free (staticperl);
981 PERL_SYS_TERM (); 1115 PERL_SYS_TERM ();
1116 /*free (args); no point doing it this late */
982 1117
983 return exitstatus; 1118 return exitstatus;
984} 1119}
985EOF 1120EOF
986} elsif ($PERL) { 1121} elsif ($PERL) {
… …
990main (int argc, char *argv []) 1125main (int argc, char *argv [])
991{ 1126{
992 extern char **environ; 1127 extern char **environ;
993 int exitstatus; 1128 int exitstatus;
994 1129
1130$IGNORE_ENV
995 PERL_SYS_INIT3 (&argc, &argv, &environ); 1131 PERL_SYS_INIT3 (&argc, &argv, &environ);
996 staticperl = perl_alloc (); 1132 staticperl = perl_alloc ();
997 perl_construct (staticperl); 1133 perl_construct (staticperl);
998 1134
999 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1135 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
… …
1011EOF 1147EOF
1012} else { 1148} else {
1013 print $fh <<EOF; 1149 print $fh <<EOF;
1014 1150
1015EXTERN_C void 1151EXTERN_C void
1016staticperl_init (void) 1152staticperl_init (XSINIT_t xs_init)
1017{ 1153{
1018 static char *args[] = { 1154 static char *args[] = {
1019 "staticperl", 1155 "staticperl",
1020 "-e", 1156 "-e",
1021 "0" 1157 "0"
… …
1023 1159
1024 extern char **environ; 1160 extern char **environ;
1025 int argc = sizeof (args) / sizeof (args [0]); 1161 int argc = sizeof (args) / sizeof (args [0]);
1026 char **argv = args; 1162 char **argv = args;
1027 1163
1164$IGNORE_ENV
1028 PERL_SYS_INIT3 (&argc, &argv, &environ); 1165 PERL_SYS_INIT3 (&argc, &argv, &environ);
1029 staticperl = perl_alloc (); 1166 staticperl = perl_alloc ();
1030 perl_construct (staticperl); 1167 perl_construct (staticperl);
1031 PL_origalen = 1; 1168 PL_origalen = 1;
1032 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1169 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1170 PL_oldname = (char *)xs_init;
1033 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ); 1171 perl_parse (staticperl, staticperl_xs_init, argc, argv, environ);
1034 1172
1035 perl_run (staticperl); 1173 perl_run (staticperl);
1036} 1174}
1037 1175
… …
1044 PERL_SYS_TERM (); 1182 PERL_SYS_TERM ();
1045} 1183}
1046EOF 1184EOF
1047} 1185}
1048 1186
1187close $fh;
1188
1049print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n" 1189print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"
1050 if $VERBOSE >= 1; 1190 if $VERBOSE >= 1;
1051 1191
1052############################################################################# 1192#############################################################################
1053# libs, cflags 1193# libs, cflags
1194
1195my $ccopts;
1054 1196
1055{ 1197{
1056 print "generating $PREFIX.ccopts... " 1198 print "generating $PREFIX.ccopts... "
1057 if $VERBOSE >= 1; 1199 if $VERBOSE >= 1;
1058 1200
1059 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE"; 1201 $ccopts = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE $EXTRA_CFLAGS";
1060 $str =~ s/([\(\)])/\\$1/g; 1202 $ccopts =~ s/([\(\)])/\\$1/g;
1061 1203
1062 open my $fh, ">$PREFIX.ccopts" 1204 open my $fh, ">$PREFIX.ccopts"
1063 or die "$PREFIX.ccopts: $!"; 1205 or die "$PREFIX.ccopts: $!";
1064 print $fh $str; 1206 print $fh $ccopts;
1065 1207
1066 print "$str\n\n" 1208 print "$ccopts\n\n"
1067 if $VERBOSE >= 1; 1209 if $VERBOSE >= 1;
1068} 1210}
1211
1212my $ldopts;
1069 1213
1070{ 1214{
1071 print "generating $PREFIX.ldopts... "; 1215 print "generating $PREFIX.ldopts... ";
1072 1216
1073 my $str = $STATIC ? "-static " : ""; 1217 $ldopts = $STATIC ? "-static " : "";
1074 1218
1075 $str .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}"; 1219 $ldopts .= "$Config{ccdlflags} $Config{ldflags} $EXTRA_LDFLAGS @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs} $EXTRA_LIBS";
1076 1220
1077 my %seen; 1221 my %seen;
1078 $str .= " $_" for grep !$seen{$_}++, ($extralibs =~ /(\S+)/g); 1222 $ldopts .= " $_" for reverse grep !$seen{$_}++, reverse +($extralibs =~ /(\S+)/g);
1079 1223
1080 for (@staticlibs) { 1224 for (@staticlibs) {
1081 $str =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx; 1225 $ldopts =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx;
1082 } 1226 }
1083 1227
1084 $str =~ s/([\(\)])/\\$1/g; 1228 $ldopts =~ s/([\(\)])/\\$1/g;
1085 1229
1086 open my $fh, ">$PREFIX.ldopts" 1230 open my $fh, ">$PREFIX.ldopts"
1087 or die "$PREFIX.ldopts: $!"; 1231 or die "$PREFIX.ldopts: $!";
1088 print $fh $str; 1232 print $fh $ldopts;
1089 1233
1090 print "$str\n\n" 1234 print "$ldopts\n\n"
1091 if $VERBOSE >= 1; 1235 if $VERBOSE >= 1;
1092} 1236}
1093 1237
1094if ($PERL or defined $APP) { 1238if ($PERL or defined $APP) {
1095 $APP = "perl" unless defined $APP; 1239 $APP = "perl" unless defined $APP;
1096 1240
1241 my $build = "$Config{cc} $ccopts -o \Q$APP\E$Config{_exe} bundle.c $ldopts";
1242
1097 print "building $APP...\n" 1243 print "build $APP...\n"
1098 if $VERBOSE >= 1; 1244 if $VERBOSE >= 1;
1099 1245
1100 system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)"; 1246 print "$build\n"
1247 if $VERBOSE >= 2;
1248
1249 system $build;
1101 1250
1102 unlink "$PREFIX.$_" 1251 unlink "$PREFIX.$_"
1103 for qw(ccopts ldopts c h); 1252 for qw(ccopts ldopts c h);
1104 1253
1105 print "\n" 1254 print "\n"

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines