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

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.27 by root, Thu Feb 24 14:35:38 2011 UTC vs.
Revision 1.34 by root, Mon Mar 12 21:45:10 2012 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; 14our $IGNORE_ENV = 0;
15our $ALLOW_DYNAMIC = 0;
16our $HAVE_DYNAMIC; # maybe useful?
15 17
16our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression? 18our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression?
17 19
18our $CACHE; 20our $CACHE;
19our $CACHEVER = 1; # do not change unless you know what you are doing 21our $CACHEVER = 1; # do not change unless you know what you are doing
… …
74 my $dir = find_incdir $_[1] 76 my $dir = find_incdir $_[1]
75 or return; 77 or return;
76 78
77 syswrite $W_TRACER, "-\n$dir\n$_[1]\n"; 79 syswrite $W_TRACER, "-\n$dir\n$_[1]\n";
78 80
79 open my $fh, "<:perlio", "$dir/$_[1]" 81 open my $fh, "<:raw:perlio", "$dir/$_[1]"
80 or warn "ERROR: $dir/$_[1]: $!\n"; 82 or warn "ERROR: $dir/$_[1]: $!\n";
81 83
82 $fh 84 $fh
83 }; 85 };
84 86
… …
160 my ($variant, $src, $filter) = @_; 162 my ($variant, $src, $filter) = @_;
161 163
162 if (length $CACHE and 2048 <= length $src and defined $variant) { 164 if (length $CACHE and 2048 <= length $src and defined $variant) {
163 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src"; 165 my $file = "$CACHE/" . Digest::MD5::md5_hex "$CACHEVER\x00$variant\x00$src";
164 166
165 if (open my $fh, "<:perlio", $file) { 167 if (open my $fh, "<:raw:perlio", $file) {
166 print "using cache for $file\n" 168 print "using cache for $file\n"
167 if $VERBOSE >= 7; 169 if $VERBOSE >= 7;
168 170
169 local $/; 171 local $/;
170 return <$fh>; 172 return <$fh>;
… …
173 $src = $filter->($src); 175 $src = $filter->($src);
174 176
175 print "creating cache entry $file\n" 177 print "creating cache entry $file\n"
176 if $VERBOSE >= 8; 178 if $VERBOSE >= 8;
177 179
178 if (open my $fh, ">:perlio", "$file~") { 180 if (open my $fh, ">:raw:perlio", "$file~") {
179 if ((syswrite $fh, $src) == length $src) { 181 if ((syswrite $fh, $src) == length $src) {
180 close $fh; 182 close $fh;
181 rename "$file~", $file; 183 rename "$file~", $file;
182 } 184 }
183 } 185 }
… …
190 192
191sub dump_string { 193sub dump_string {
192 my ($fh, $data) = @_; 194 my ($fh, $data) = @_;
193 195
194 if (length $data) { 196 if (length $data) {
197 if ($^O eq "MSWin32") {
198 # 16 bit system, strings can't be longer than 64k. seriously.
199 print $fh "{\n";
195 for ( 200 for (
196 my $ofs = 0; 201 my $ofs = 0;
202 length (my $substr = substr $data, $ofs, 20);
203 $ofs += 20
204 ) {
205 $substr = join ",", map ord, split //, $substr;
206 print $fh " $substr,\n";
207 }
208 print $fh " 0 }\n";
209 } else {
210 for (
211 my $ofs = 0;
197 length (my $substr = substr $data, $ofs, 80); 212 length (my $substr = substr $data, $ofs, 80);
198 $ofs += 80 213 $ofs += 80
199 ) { 214 ) {
200 $substr =~ s/([^\x20-\x21\x23-\x5b\x5d-\x7e])/sprintf "\\%03o", ord $1/ge; 215 $substr =~ s/([^\x20-\x21\x23-\x5b\x5d-\x7e])/sprintf "\\%03o", ord $1/ge;
201 $substr =~ s/\?/\\?/g; # trigraphs... 216 $substr =~ s/\?/\\?/g; # trigraphs...
202 print $fh " \"$substr\"\n"; 217 print $fh " \"$substr\"\n";
218 }
203 } 219 }
204 } else { 220 } else {
205 print $fh " \"\"\n"; 221 print $fh " \"\"\n";
206 } 222 }
207} 223}
… …
274} 290}
275 291
276############################################################################# 292#############################################################################
277 293
278sub cmd_boot { 294sub cmd_boot {
279 $pm{"&&boot"} = $_[0]; 295 $pm{"!boot"} = $_[0];
280} 296}
281 297
282sub cmd_add { 298sub cmd_add {
283 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/ 299 $_[0] =~ /^(.*?)(?:\s+(\S+))?$/
284 or die "$_[0]: cannot parse"; 300 or die "$_[0]: cannot parse";
… …
357 "exclude|x=s" => sub { cmd_include $_[1], 0 }, 373 "exclude|x=s" => sub { cmd_include $_[1], 0 },
358 "usepacklists!" => \$PACKLIST, 374 "usepacklists!" => \$PACKLIST,
359 375
360 "static!" => \$STATIC, 376 "static!" => \$STATIC,
361 "staticlib=s" => sub { cmd_staticlib $_[1] }, 377 "staticlib=s" => sub { cmd_staticlib $_[1] },
378 "allow-dynamic!"=> \$ALLOW_DYNAMIC,
362 "ignore-env" => \$IGNORE_ENV, 379 "ignore-env" => \$IGNORE_ENV,
363 380
364 "<>" => sub { cmd_file $_[0] }, 381 "<>" => sub { cmd_file $_[0] },
365 or exit 1; 382 or exit 1;
366} 383}
… …
475 push @libs, "$autodir/$base$Config{_a}"; 492 push @libs, "$autodir/$base$Config{_a}";
476 push @static_ext, $pm; 493 push @static_ext, $pm;
477 } 494 }
478 495
479 # dynamic object 496 # dynamic object
480 die "ERROR: found shared object - can't link statically ($_)\n"
481 if -f "$autodir/$base.$Config{dlext}"; 497 if (-f "$autodir/$base.$Config{dlext}") {
498 if ($ALLOW_DYNAMIC) {
499 my $as = "!$auto/$base.$Config{dlext}";
500 $pm{$as} = "$autodir/$base.$Config{dlext}";
501 $pmbin{$as} = 1;
502
503 $HAVE_DYNAMIC = 1;
504
505 print "+ added dynamic object $as\n"
506 if $VERBOSE >= 3;
507 } else {
508 die "ERROR: found shared object '$autodir/$base.$Config{dlext}' but --allow-dynamic not given, aborting.\n"
509 }
510 }
482 511
483 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") { 512 if ($PACKLIST && open my $fh, "<:perlio", "$autodir/.packlist") {
484 print "found .packlist for $pm\n" 513 print "found .packlist for $pm\n"
485 if $VERBOSE >= 3; 514 if $VERBOSE >= 3;
486 515
… …
534 or die "ERROR: $pm: path too long (only 128 octets supported)\n"; 563 or die "ERROR: $pm: path too long (only 128 octets supported)\n";
535 564
536 my $src = ref $path 565 my $src = ref $path
537 ? $$path 566 ? $$path
538 : do { 567 : do {
539 open my $pm, "<", $path 568 open my $pm, "<:raw:perlio", $path
540 or die "$path: $!"; 569 or die "$path: $!";
541 570
542 local $/; 571 local $/;
543 572
544 <$pm> 573 <$pm>
… …
803# bootstrap 832# bootstrap
804 833
805# boot file for staticperl 834# boot file for staticperl
806# this file will be eval'ed at initialisation time 835# this file will be eval'ed at initialisation time
807 836
837# lines marked with "^D" are only used when $HAVE_DYNAMIC
808my $bootstrap = ' 838my $bootstrap = '
809BEGIN { 839BEGIN {
810 package ' . $PACKAGE . '; 840 package ' . $PACKAGE . ';
811 841
812 PerlIO::scalar->bootstrap; 842 # the path prefix to use when putting files into %INC
843 our $inc_prefix;
813 844
814 @INC = sub { 845 # the @INC hook to use when we have PerlIO::scalar available
846 my $perlio_inc = sub {
815 my $data = find "$_[1]" 847 my $data = find "$_[1]"
816 or return; 848 or return;
817 849
818 $INC{$_[1]} = $_[1]; 850 $INC{$_[1]} = "$inc_prefix$_[1]";
819 851
820 open my $fh, "<", \$data; 852 open my $fh, "<", \$data;
821 $fh 853 $fh
822 }; 854 };
855
856D if (defined &PerlIO::scalar::bootstrap) {
857 # PerlIO::scalar statically compiled in
858 PerlIO::scalar->bootstrap;
859 @INC = $perlio_inc;
860D } else {
861D # PerlIO::scalar not available, use slower method
862D @INC = sub {
863D # always check if PerlIO::scalar might now be available
864D if (defined &PerlIO::scalar::bootstrap) {
865D # switch to the faster perlio_inc hook
866D @INC = map { $_ == $_[0] ? $perlio_inc : $_ } @INC;
867D goto &$perlio_inc;
868D }
869D
870D my $data = find "$_[1]"
871D or return;
872D
873D $INC{$_[1]} = "$inc_prefix$_[1]";
874D
875D sub {
876D $data =~ /\G([^\n]*\n?)/g
877D or return;
878D
879D $_ = $1;
880D 1
881D }
882D };
883D }
823} 884}
824'; 885';
825 886
826$bootstrap .= "require '&&boot';" 887$bootstrap .= "require '!boot';"
827 if exists $pm{"&&boot"}; 888 if exists $pm{"!boot"};
828 889
890if ($HAVE_DYNAMIC) {
891 $bootstrap =~ s/^D/ /mg;
892} else {
893 $bootstrap =~ s/^D.*$//mg;
894}
895
896$bootstrap =~ s/#.*$//mg;
829$bootstrap =~ s/\s+/ /g; 897$bootstrap =~ s/\s+/ /g;
830$bootstrap =~ s/(\W) /$1/g; 898$bootstrap =~ s/(\W) /$1/g;
831$bootstrap =~ s/ (\W)/$1/g; 899$bootstrap =~ s/ (\W)/$1/g;
832 900
833print $fh "const char bootstrap [] = "; 901print $fh "const char bootstrap [] = ";
… …
879 } 947 }
880 948
881 XSRETURN (0); 949 XSRETURN (0);
882 950
883 found: 951 found:
884 ST (0) = res; 952 ST (0) = sv_2mortal (res);
885 sv_2mortal (ST (0));
886 } 953 }
887 954
888 XSRETURN (1); 955 XSRETURN (1);
889} 956}
890 957
… …
903 970
904 for (i = 0; i < $varpfx\_count; ++i) 971 for (i = 0; i < $varpfx\_count; ++i)
905 { 972 {
906 U32 idx = $varpfx\_index [i]; 973 U32 idx = $varpfx\_index [i];
907 974
908 PUSHs (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)); 975 PUSHs (sv_2mortal (newSVpvn ($varpfx\_data + (idx & 0x1FFFFFFU), idx >> 25)));
909 } 976 }
910 } 977 }
911 978
912 XSRETURN ($varpfx\_count); 979 XSRETURN ($varpfx\_count);
913} 980}
… …
921void 988void
922staticperl_xs_init (pTHX) 989staticperl_xs_init (pTHX)
923{ 990{
924EOF 991EOF
925 992
926@static_ext = ("DynaLoader", sort @static_ext); 993@static_ext = sort @static_ext;
927 994
928# prototypes 995# prototypes
929for (@static_ext) { 996for (@static_ext) {
930 s/\.pm$//; 997 s/\.pm$//;
931 (my $cname = $_) =~ s/\//__/g; 998 (my $cname = $_) =~ s/\//__/g;
… …
945 s/\.pm$//; 1012 s/\.pm$//;
946 1013
947 (my $cname = $_) =~ s/\//__/g; 1014 (my $cname = $_) =~ s/\//__/g;
948 (my $pname = $_) =~ s/\//::/g; 1015 (my $pname = $_) =~ s/\//::/g;
949 1016
950 my $bootstrap = $pname eq "DynaLoader" ? "boot" : "bootstrap"; 1017 my $bootstrap = $pname eq "DynaLoader" ? "boot_DynaLoader" : "bootstrap";
951 1018
952 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 1019 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
953} 1020}
954 1021
955print $fh <<EOF; 1022print $fh <<EOF;
1023 #ifdef _WIN32
1024 /* windows perls usually trail behind unix perls 8-10 years in exporting symbols */
1025
1026 if (!PL_preambleav)
1027 PL_preambleav = newAV ();
1028
1029 av_unshift (PL_preambleav, 1);
1030 av_store (PL_preambleav, 0, newSVpv (bootstrap, sizeof (bootstrap) - 1));
1031 #else
956 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1)); 1032 Perl_av_create_and_unshift_one (&PL_preambleav, newSVpv (bootstrap, sizeof (bootstrap) - 1));
1033 #endif
957 1034
958 if (PL_oldname) 1035 if (PL_oldname)
959 ((XSINIT_t)PL_oldname)(aTHX); 1036 ((XSINIT_t)PL_oldname)(aTHX);
960} 1037}
961EOF 1038EOF
… …
1080 PERL_SYS_TERM (); 1157 PERL_SYS_TERM ();
1081} 1158}
1082EOF 1159EOF
1083} 1160}
1084 1161
1162close $fh;
1163
1085print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n" 1164print -s "$PREFIX.c", " octets (", (length $data) , " data octets).\n\n"
1086 if $VERBOSE >= 1; 1165 if $VERBOSE >= 1;
1087 1166
1088############################################################################# 1167#############################################################################
1089# libs, cflags 1168# libs, cflags
1169
1170my $ccopts;
1090 1171
1091{ 1172{
1092 print "generating $PREFIX.ccopts... " 1173 print "generating $PREFIX.ccopts... "
1093 if $VERBOSE >= 1; 1174 if $VERBOSE >= 1;
1094 1175
1095 my $str = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE"; 1176 $ccopts = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE";
1096 $str =~ s/([\(\)])/\\$1/g; 1177 $ccopts =~ s/([\(\)])/\\$1/g;
1097 1178
1098 open my $fh, ">$PREFIX.ccopts" 1179 open my $fh, ">$PREFIX.ccopts"
1099 or die "$PREFIX.ccopts: $!"; 1180 or die "$PREFIX.ccopts: $!";
1100 print $fh $str; 1181 print $fh $ccopts;
1101 1182
1102 print "$str\n\n" 1183 print "$ccopts\n\n"
1103 if $VERBOSE >= 1; 1184 if $VERBOSE >= 1;
1104} 1185}
1186
1187my $ldopts;
1105 1188
1106{ 1189{
1107 print "generating $PREFIX.ldopts... "; 1190 print "generating $PREFIX.ldopts... ";
1108 1191
1109 my $str = $STATIC ? "-static " : ""; 1192 $ldopts = $STATIC ? "-static " : "";
1110 1193
1111 $str .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}"; 1194 $ldopts .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}";
1112 1195
1113 my %seen; 1196 my %seen;
1114 $str .= " $_" for grep !$seen{$_}++, ($extralibs =~ /(\S+)/g); 1197 $ldopts .= " $_" for reverse grep !$seen{$_}++, reverse +($extralibs =~ /(\S+)/g);
1115 1198
1116 for (@staticlibs) { 1199 for (@staticlibs) {
1117 $str =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx; 1200 $ldopts =~ s/(^|\s) (-l\Q$_\E) ($|\s)/$1-Wl,-Bstatic $2 -Wl,-Bdynamic$3/gx;
1118 } 1201 }
1119 1202
1120 $str =~ s/([\(\)])/\\$1/g; 1203 $ldopts =~ s/([\(\)])/\\$1/g;
1121 1204
1122 open my $fh, ">$PREFIX.ldopts" 1205 open my $fh, ">$PREFIX.ldopts"
1123 or die "$PREFIX.ldopts: $!"; 1206 or die "$PREFIX.ldopts: $!";
1124 print $fh $str; 1207 print $fh $ldopts;
1125 1208
1126 print "$str\n\n" 1209 print "$ldopts\n\n"
1127 if $VERBOSE >= 1; 1210 if $VERBOSE >= 1;
1128} 1211}
1129 1212
1130if ($PERL or defined $APP) { 1213if ($PERL or defined $APP) {
1131 $APP = "perl" unless defined $APP; 1214 $APP = "perl" unless defined $APP;
1132 1215
1216 my $build = "$Config{cc} $ccopts -o \Q$APP\E$Config{_exe} bundle.c $ldopts";
1217
1133 print "building $APP...\n" 1218 print "build $APP...\n"
1134 if $VERBOSE >= 1; 1219 if $VERBOSE >= 1;
1135 1220
1136 system "$Config{cc} \$(cat bundle.ccopts\) -o \Q$APP\E bundle.c \$(cat bundle.ldopts\)"; 1221 print "$build\n"
1222 if $VERBOSE >= 2;
1223
1224 system $build;
1137 1225
1138 unlink "$PREFIX.$_" 1226 unlink "$PREFIX.$_"
1139 for qw(ccopts ldopts c h); 1227 for qw(ccopts ldopts c h);
1140 1228
1141 print "\n" 1229 print "\n"

Diff Legend

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