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

Comparing App-Staticperl/mkbundle (file contents):
Revision 1.34 by root, Mon Mar 12 21:45:10 2012 UTC vs.
Revision 1.45 by root, Mon Aug 7 05:00:03 2023 UTC

… …
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 $COMPRESS = "lzf";
9our $KEEPNL = 0;
8our $UNISTRIP = 1; # always on, try to strip unicore swash data 10our $UNISTRIP = 1; # always on, try to strip unicore swash data
9our $PERL = 0; 11our $PERL = 0;
10our $APP; 12our $APP;
11our $VERIFY = 0; 13our $VERIFY = 0;
12our $STATIC = 0; 14our $STATIC = 0;
13our $PACKLIST = 0; 15our $PACKLIST = 0;
14our $IGNORE_ENV = 0; 16our $IGNORE_ENV = 0;
15our $ALLOW_DYNAMIC = 0; 17our $ALLOW_DYNAMIC = 0;
16our $HAVE_DYNAMIC; # maybe useful? 18our $HAVE_DYNAMIC; # maybe useful?
19our $EXTRA_CFLAGS = "";
20our $EXTRA_LDFLAGS = "";
21our $EXTRA_LIBS = "";
17 22
23# TODO: at least with lzf, OPTIMIZE_SIZE sesm to be a win? (also, does not respect KEEPNL)
18our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression? 24our $OPTIMISE_SIZE = 0; # optimise for raw file size instead of for compression?
19 25
20our $CACHE; 26our $CACHE;
21our $CACHEVER = 1; # do not change unless you know what you are doing 27our $CACHEVER = 2; # do not change unless you know what you are doing
22 28
23my $PREFIX = "bundle"; 29my $PREFIX = "bundle";
24my $PACKAGE = "static"; 30my $PACKAGE = "static";
25 31
26my %pm; 32my %pm;
… …
353 359
354use Getopt::Long; 360use Getopt::Long;
355 361
356sub parse_argv { 362sub parse_argv {
357 GetOptions 363 GetOptions
358 "perl" => \$PERL, 364 "perl" => \$PERL,
359 "app=s" => \$APP, 365 "app=s" => \$APP,
360 366
361 "verbose|v" => sub { ++$VERBOSE }, 367 "verbose|v" => sub { ++$VERBOSE },
362 "quiet|q" => sub { --$VERBOSE }, 368 "quiet|q" => sub { --$VERBOSE },
363 369
364 "strip=s" => \$STRIP, 370 "strip=s" => \$STRIP,
371 "keepnl" => \$KEEPNL,
372 "compress=s" => \$COMPRESS,
365 "cache=s" => \$CACHE, # internal option 373 "cache=s" => \$CACHE, # internal option
366 "eval|e=s" => sub { trace_eval $_[1] }, 374 "eval|e=s" => sub { trace_eval $_[1] },
367 "use|M=s" => sub { trace_module $_[1] }, 375 "use|M=s" => sub { trace_module $_[1] },
368 "boot=s" => sub { cmd_boot $_[1] }, 376 "boot=s" => sub { cmd_boot $_[1] },
369 "add=s" => sub { cmd_add $_[1], 0 }, 377 "add=s" => sub { cmd_add $_[1], 0 },
370 "addbin=s" => sub { cmd_add $_[1], 1 }, 378 "addbin=s" => sub { cmd_add $_[1], 1 },
371 "incglob=s" => sub { cmd_incglob $_[1] }, 379 "incglob=s" => sub { cmd_incglob $_[1] },
372 "include|i=s" => sub { cmd_include $_[1], 1 }, 380 "include|i=s" => sub { cmd_include $_[1], 1 },
373 "exclude|x=s" => sub { cmd_include $_[1], 0 }, 381 "exclude|x=s" => sub { cmd_include $_[1], 0 },
374 "usepacklists!" => \$PACKLIST, 382 "usepacklists!" => \$PACKLIST,
375 383
376 "static!" => \$STATIC, 384 "static!" => \$STATIC,
377 "staticlib=s" => sub { cmd_staticlib $_[1] }, 385 "staticlib=s" => sub { cmd_staticlib $_[1] },
378 "allow-dynamic!"=> \$ALLOW_DYNAMIC, 386 "allow-dynamic!" => \$ALLOW_DYNAMIC,
379 "ignore-env" => \$IGNORE_ENV, 387 "ignore-env" => \$IGNORE_ENV,
380 388
389 "extra-cflags=s" => \$EXTRA_CFLAGS,
390 "extra-ldflags=s" => \$EXTRA_LDFLAGS,
391 "extra-libs=s" => \$EXTRA_LIBS,
392
381 "<>" => sub { cmd_file $_[0] }, 393 "<>" => sub { cmd_file $_[0] },
382 or exit 1; 394 or exit 1;
383} 395}
384 396
385Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); 397Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case");
386 398
387parse_argv; 399parse_argv;
388 400
389die "cannot specify both --app and --perl\n" 401die "cannot specify both --app and --perl\n"
390 if $PERL and defined $APP; 402 if $PERL and defined $APP;
403
404die "--compress must be either none or lzf\n"
405 unless $COMPRESS =~ /^(?:none|lzf)\z/;
391 406
392# required for @INC loading, unfortunately 407# required for @INC loading, unfortunately
393trace_module "PerlIO::scalar"; 408trace_module "PerlIO::scalar";
394 409
395############################################################################# 410#############################################################################
… …
543############################################################################# 558#############################################################################
544 559
545print "processing bundle files (try more -v power if you get bored waiting here)...\n" 560print "processing bundle files (try more -v power if you get bored waiting here)...\n"
546 if $VERBOSE >= 1; 561 if $VERBOSE >= 1;
547 562
563my $compress = sub { shift };
564
565if ($COMPRESS eq "lzf") {
566 require Compress::LZF;
567 $compress = sub { Compress::LZF::compress_best (shift) };
568}
569
548my $data; 570my $data;
549my @index; 571my @index;
550my @order = sort { 572my @order = sort {
551 length $a <=> length $b 573 length $a <=> length $b
552 or $a cmp $b 574 or $a cmp $b
… …
582 if $VERBOSE >= 3; 604 if $VERBOSE >= 3;
583 next; 605 next;
584 } 606 }
585 } 607 }
586 608
587 $src = cache +($STRIP eq "ppi" ? "$UNISTRIP,$OPTIMISE_SIZE" : undef), $src, sub { 609 $src = cache "$STRIP,$UNISTRIP,$KEEPNL,$OPTIMISE_SIZE,$COMPRESS", $src, sub {
588 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) { 610 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) {
589 print "applying unicore stripping $pm\n" 611 print "applying unicore stripping $pm\n"
590 if $VERBOSE >= 6; 612 if $VERBOSE >= 6;
591 613
592 # special stripping for unicore swashes and properties 614 # special stripping for unicore swashes and properties
… …
618 } 640 }
619 641
620 if ($STRIP =~ /ppi/i) { 642 if ($STRIP =~ /ppi/i) {
621 require PPI; 643 require PPI;
622 644
645 # PPI (quite correctly) treats pod in __DATA__ as data, not pod, so
646 # we don't have to work around Opcode.pm, as with Pod::Strip
647
623 if (my $ppi = PPI::Document->new (\$src)) { 648 if (my $ppi = PPI::Document->new (\$src)) {
649 for my $node (
624 $ppi->prune ("PPI::Token::Comment"); 650 @{ $ppi->find (PPI::Token::Comment::) },
625 $ppi->prune ("PPI::Token::Pod"); 651 @{ $ppi->find (PPI::Token::Pod::) }
652 ) {
653 if ($KEEPNL) {
654 $node->{content} =~ s/[^\n]//g;
655 $node->insert_after (PPI::Token::Whitespace->new ("\n")) if length $node->{content};
656 }
657
658 $node->delete;
659 }
626 660
627 # prune END stuff 661 # prune END stuff
628 for (my $last = $ppi->last_element; $last; ) { 662 for (my $last = $ppi->last_element; $last; ) {
629 my $prev = $last->previous_token; 663 my $prev = $last->previous_token;
630 664
… …
633 } elsif ($last->isa (PPI::Statement::End::)) { 667 } elsif ($last->isa (PPI::Statement::End::)) {
634 $last->delete; 668 $last->delete;
635 last; 669 last;
636 } elsif ($last->isa (PPI::Token::Pod::)) { 670 } elsif ($last->isa (PPI::Token::Pod::)) {
637 $last->delete; 671 $last->delete;
672 } elsif ($last->isa (PPI::Token::Comment::)) {
673 $last->delete;
638 } else { 674 } else {
639 last; 675 last;
640 } 676 }
641 677
642 $last = $prev; 678 $last = $prev;
… …
648 my $next = $ws->next_token; 684 my $next = $ws->next_token;
649 685
650 if (!$prev || !$next) { 686 if (!$prev || !$next) {
651 $ws->delete; 687 $ws->delete;
652 } else { 688 } else {
689 if ($next->isa (PPI::Token::Whitespace::)) {
690 # push this whitespace data into the next node
691 $next->{content} = "$ws->{content}$next->{content}";
692 $ws->{content} = "";
693 } elsif (
653 if ( 694 (
654 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float 695 $next->isa (PPI::Token::Operator::) && $next->{content} =~ /^(?:,|=|!|!=|==|=>)$/ # no ., because of digits. == float
655 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/ 696 or $prev->isa (PPI::Token::Operator::) && $prev->{content} =~ /^(?:,|=|\.|!|!=|==|=>)$/
656 or $prev->isa (PPI::Token::Structure::) 697 or $prev->isa (PPI::Token::Structure::)
657 or ($OPTIMISE_SIZE && 698 or ($OPTIMISE_SIZE &&
658 ($prev->isa (PPI::Token::Word::) 699 ($prev->isa (PPI::Token::Word::)
659 && (PPI::Token::Symbol:: eq ref $next 700 && (PPI::Token::Symbol:: eq ref $next
660 || $next->isa (PPI::Structure::Block::) 701 || $next->isa (PPI::Structure::Block::)
661 || $next->isa (PPI::Structure::List::) 702 || $next->isa (PPI::Structure::List::)
662 || $next->isa (PPI::Structure::Condition::))) 703 || $next->isa (PPI::Structure::Condition::)))
704 )
663 ) 705 )
706 # perl has some idiotic warning about nonexisting operators (Reverse %s operator)
707 # also catch "= ~"
708 && !(
709 $prev->isa (PPI::Token::Operator::) && $prev->{content} eq "="
710 && $next->isa (PPI::Token::Operator::) && $next->{content} =~ /[+\-\~]/
711 )
664 ) { 712 ) {
713 if ($KEEPNL) {
714 $ws->{content} =~ s/[^\n]//g;
665 $ws->delete; 715 } else {
666 } elsif ($prev->isa (PPI::Token::Whitespace::)) {
667 $ws->{content} = ' '; 716 $ws->{content} = '';
668 $prev->delete; 717 }
669 } else { 718 } else {
719 if ($KEEPNL) {
720 $ws->{content} =~ s/[^\n]//g;
721 $ws->{content} ||= ' '; # keep at least one space
722 } else {
670 $ws->{content} = ' '; 723 $ws->{content} = ' ';
724 }
671 } 725 }
672 } 726 }
673 } 727 }
674 728
675 # prune whitespace around blocks 729 # prune whitespace around blocks
… …
730 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n"; 784 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n";
731 exit 0; 785 exit 0;
732 } 786 }
733 } 787 }
734 788
789 $src = $compress->($src);
790
735 $src 791 $src
736 }; 792 };
737 793
738# if ($pm eq "Opcode.pm") { 794# if ($pm eq "Opcode.pm") {
739# open my $fh, ">x" or die; print $fh $src;#d# 795# open my $fh, ">x" or die; print $fh $src;#d#
… …
798 854
799/* public API */ 855/* public API */
800PerlInterpreter *staticperl; 856PerlInterpreter *staticperl;
801 857
802EOF 858EOF
859
860#############################################################################
861# lzf decompressor
862
863if ($COMPRESS eq "lzf") {
864 print $fh <<'EOF';
865/* stripped down/perlified version of lzf_d.c from liblzf-3.7 */
866
867#if (__i386 || __amd64) && __GNUC__ >= 3
868# define lzf_movsb(dst, src, len) \
869 asm ("rep movsb" \
870 : "=D" (dst), "=S" (src), "=c" (len) \
871 : "0" (dst), "1" (src), "2" (len));
872#endif
873
874static unsigned int
875lzf_decompress (const void *const in_data, unsigned int in_len,
876 void *out_data, unsigned int out_len)
877{
878 U8 const *ip = (const U8 *)in_data;
879 U8 *op = (U8 *)out_data;
880 U8 const *const in_end = ip + in_len;
881 U8 *const out_end = op + out_len;
882
883 do
884 {
885 unsigned int ctrl = *ip++;
886
887 if (ctrl < (1 << 5)) /* literal run */
888 {
889 ctrl++;
890
891 if (op + ctrl > out_end)
892 return 0;
893
894#ifdef lzf_movsb
895 lzf_movsb (op, ip, ctrl);
896#else
897 while (ctrl--)
898 *op++ = *ip++;
899#endif
900 }
901 else /* back reference */
902 {
903 unsigned int len = ctrl >> 5;
904
905 U8 *ref = op - ((ctrl & 0x1f) << 8) - 1;
906
907 if (len == 7)
908 len += *ip++;
909
910 ref -= *ip++;
911
912 if (op + len + 2 > out_end)
913 return 0;
914
915 if (ref < (U8 *)out_data)
916 return 0;
917
918 len += 2;
919#ifdef lzf_movsb
920 lzf_movsb (op, ref, len);
921#else
922 do
923 *op++ = *ref++;
924 while (--len);
925#endif
926 }
927 }
928 while (ip < in_end);
929
930 return op - (U8 *)out_data;
931}
932
933static SV *
934static_to_sv (const char *ptr, STRLEN len)
935{
936 SV *res;
937 const U8 *p = (const U8 *)ptr;
938
939 if (len == 0) /* empty */
940 res = newSVpvn ("", 0);
941 else if (*p == 0) /* not compressed */
942 res = newSVpvn (p + 1, len - 1);
943 else /* lzf compressed, with UTF-8-encoded original size in front */
944 {
945 STRLEN ulenlen;
946 UV ulen = utf8n_to_uvchr (p, len, &ulenlen, 0);
947
948 p += ulenlen;
949 len -= ulenlen;
950
951 res = NEWSV (0, ulen);
952 sv_upgrade (res, SVt_PV);
953 SvPOK_only (res);
954 lzf_decompress (p, len, SvPVX (res), ulen);
955 SvCUR_set (res, ulen);
956 }
957
958 return res;
959}
960
961EOF
962} else {
963 print $fh <<EOF;
964
965#define static_to_sv(ptr,len) newSVpvn (ptr, len)
966
967EOF
968}
803 969
804############################################################################# 970#############################################################################
805# bundle data 971# bundle data
806 972
807my $count = @index; 973my $count = @index;
… …
933 { 1099 {
934 /* found */ 1100 /* found */
935 int ofs2 = $varpfx\_index [m + 1] & 0x1FFFFFFU; 1101 int ofs2 = $varpfx\_index [m + 1] & 0x1FFFFFFU;
936 1102
937 ofs += namelen; 1103 ofs += namelen;
938 res = newSVpvn ($varpfx\_data + ofs, ofs2 - ofs); 1104 res = static_to_sv ($varpfx\_data + ofs, ofs2 - ofs);
939 goto found; 1105 goto found;
940 } 1106 }
941 } 1107 }
942 1108
943 if (comp < 0) 1109 if (comp < 0)
… …
977 } 1143 }
978 1144
979 XSRETURN ($varpfx\_count); 1145 XSRETURN ($varpfx\_count);
980} 1146}
981 1147
1148#ifdef STATICPERL_BUNDLE_INCLUDE
1149#include STATICPERL_BUNDLE_INCLUDE
1150#endif
1151
982EOF 1152EOF
983 1153
984############################################################################# 1154#############################################################################
985# xs_init 1155# xs_init
986 1156
… …
1003 char *file = __FILE__; 1173 char *file = __FILE__;
1004 dXSUB_SYS; 1174 dXSUB_SYS;
1005 1175
1006 newXSproto ("$PACKAGE\::find", find, file, "\$"); 1176 newXSproto ("$PACKAGE\::find", find, file, "\$");
1007 newXSproto ("$PACKAGE\::list", list, file, ""); 1177 newXSproto ("$PACKAGE\::list", list, file, "");
1178
1179 #ifdef STATICPERL_BUNDLE_XS_INIT
1180 STATICPERL_BUNDLE_XS_INIT;
1181 #endif
1008EOF 1182EOF
1009 1183
1010# calls 1184# calls
1011for (@static_ext) { 1185for (@static_ext) {
1012 s/\.pm$//; 1186 s/\.pm$//;
… …
1018 1192
1019 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n"; 1193 print $fh " newXS (\"$pname\::$bootstrap\", boot_$cname, file);\n";
1020} 1194}
1021 1195
1022print $fh <<EOF; 1196print $fh <<EOF;
1197 Safefree (PL_origfilename);
1198 PL_origfilename = savepv (PL_origargv [0]);
1199 sv_setpv (GvSV (gv_fetchpvs ("0", GV_ADD|GV_NOTQUAL, SVt_PV)), PL_origfilename);
1200
1023 #ifdef _WIN32 1201 #ifdef _WIN32
1024 /* windows perls usually trail behind unix perls 8-10 years in exporting symbols */ 1202 /* windows perls usually trail behind unix perls 8-10 years in exporting symbols */
1025 1203
1026 if (!PL_preambleav) 1204 if (!PL_preambleav)
1027 PL_preambleav = newAV (); 1205 PL_preambleav = newAV ();
… …
1080 perl_construct (staticperl); 1258 perl_construct (staticperl);
1081 1259
1082 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 1260 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1083 1261
1084 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ); 1262 exitstatus = perl_parse (staticperl, staticperl_xs_init, argc + 3, args, environ);
1085 free (args);
1086 if (!exitstatus) 1263 if (!exitstatus)
1087 perl_run (staticperl); 1264 perl_run (staticperl);
1088 1265
1089 exitstatus = perl_destruct (staticperl); 1266 exitstatus = perl_destruct (staticperl);
1090 perl_free (staticperl); 1267 perl_free (staticperl);
1091 PERL_SYS_TERM (); 1268 PERL_SYS_TERM ();
1269 /*free (args); no point doing it this late */
1092 1270
1093 return exitstatus; 1271 return exitstatus;
1094} 1272}
1095EOF 1273EOF
1096} elsif ($PERL) { 1274} elsif ($PERL) {
… …
1171 1349
1172{ 1350{
1173 print "generating $PREFIX.ccopts... " 1351 print "generating $PREFIX.ccopts... "
1174 if $VERBOSE >= 1; 1352 if $VERBOSE >= 1;
1175 1353
1176 $ccopts = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE"; 1354 $ccopts = "$Config{ccflags} $Config{optimize} $Config{cppflags} -I$Config{archlibexp}/CORE $EXTRA_CFLAGS";
1177 $ccopts =~ s/([\(\)])/\\$1/g; 1355 $ccopts =~ s/([\(\)])/\\$1/g;
1178 1356
1179 open my $fh, ">$PREFIX.ccopts" 1357 open my $fh, ">$PREFIX.ccopts"
1180 or die "$PREFIX.ccopts: $!"; 1358 or die "$PREFIX.ccopts: $!";
1181 print $fh $ccopts; 1359 print $fh $ccopts;
… …
1189{ 1367{
1190 print "generating $PREFIX.ldopts... "; 1368 print "generating $PREFIX.ldopts... ";
1191 1369
1192 $ldopts = $STATIC ? "-static " : ""; 1370 $ldopts = $STATIC ? "-static " : "";
1193 1371
1194 $ldopts .= "$Config{ccdlflags} $Config{ldflags} @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs}"; 1372 $ldopts .= "$Config{ccdlflags} $Config{ldflags} $EXTRA_LDFLAGS @libs $Config{archlibexp}/CORE/$Config{libperl} $Config{perllibs} $EXTRA_LIBS";
1195 1373
1196 my %seen; 1374 my %seen;
1197 $ldopts .= " $_" for reverse grep !$seen{$_}++, reverse +($extralibs =~ /(\S+)/g); 1375 $ldopts .= " $_" for reverse grep !$seen{$_}++, reverse +($extralibs =~ /(\S+)/g);
1198 1376
1199 for (@staticlibs) { 1377 for (@staticlibs) {

Diff Legend

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