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

Comparing cvsroot/App-Staticperl/mkbundle (file contents):
Revision 1.40 by root, Thu Aug 3 03:06:47 2023 UTC vs.
Revision 1.41 by root, Fri Aug 4 03:14:33 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";
8our $UNISTRIP = 1; # always on, try to strip unicore swash data 9our $UNISTRIP = 1; # always on, try to strip unicore swash data
9our $PERL = 0; 10our $PERL = 0;
10our $APP; 11our $APP;
11our $VERIFY = 0; 12our $VERIFY = 0;
12our $STATIC = 0; 13our $STATIC = 0;
… …
363 364
364 "verbose|v" => sub { ++$VERBOSE }, 365 "verbose|v" => sub { ++$VERBOSE },
365 "quiet|q" => sub { --$VERBOSE }, 366 "quiet|q" => sub { --$VERBOSE },
366 367
367 "strip=s" => \$STRIP, 368 "strip=s" => \$STRIP,
369 "compress=s" => \$COMPRESS,
368 "cache=s" => \$CACHE, # internal option 370 "cache=s" => \$CACHE, # internal option
369 "eval|e=s" => sub { trace_eval $_[1] }, 371 "eval|e=s" => sub { trace_eval $_[1] },
370 "use|M=s" => sub { trace_module $_[1] }, 372 "use|M=s" => sub { trace_module $_[1] },
371 "boot=s" => sub { cmd_boot $_[1] }, 373 "boot=s" => sub { cmd_boot $_[1] },
372 "add=s" => sub { cmd_add $_[1], 0 }, 374 "add=s" => sub { cmd_add $_[1], 0 },
… …
394parse_argv; 396parse_argv;
395 397
396die "cannot specify both --app and --perl\n" 398die "cannot specify both --app and --perl\n"
397 if $PERL and defined $APP; 399 if $PERL and defined $APP;
398 400
401die "--compress must be either none or lzf\n"
402 unless $COMPRESS =~ /^(?:none|lzf)\z/;
403
399# required for @INC loading, unfortunately 404# required for @INC loading, unfortunately
400trace_module "PerlIO::scalar"; 405trace_module "PerlIO::scalar";
401 406
402############################################################################# 407#############################################################################
403# apply include/exclude 408# apply include/exclude
… …
550############################################################################# 555#############################################################################
551 556
552print "processing bundle files (try more -v power if you get bored waiting here)...\n" 557print "processing bundle files (try more -v power if you get bored waiting here)...\n"
553 if $VERBOSE >= 1; 558 if $VERBOSE >= 1;
554 559
560my $compress = sub { shift };
561
562if ($COMPRESS eq "lzf") {
563 require Compress::LZF;
564 $compress = sub { Compress::LZF::compress_best (shift) };
565}
566
555my $data; 567my $data;
556my @index; 568my @index;
557my @order = sort { 569my @order = sort {
558 length $a <=> length $b 570 length $a <=> length $b
559 or $a cmp $b 571 or $a cmp $b
… …
589 if $VERBOSE >= 3; 601 if $VERBOSE >= 3;
590 next; 602 next;
591 } 603 }
592 } 604 }
593 605
594 $src = cache +($STRIP eq "ppi" ? "$UNISTRIP,$OPTIMISE_SIZE" : undef), $src, sub { 606 $src = cache "$STRIP,$UNISTRIP,$OPTIMISE_SIZE,$COMPRESS", $src, sub {
595 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) { 607 if ($UNISTRIP && $pm =~ /^unicore\/.*\.pl$/) {
596 print "applying unicore stripping $pm\n" 608 print "applying unicore stripping $pm\n"
597 if $VERBOSE >= 6; 609 if $VERBOSE >= 6;
598 610
599 # special stripping for unicore swashes and properties 611 # special stripping for unicore swashes and properties
… …
743 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n"; 755 eval "#line 1 \"$pm\"\n$src" or warn "\n\n\n$pm\n\n$src\n$@\n\n\n";
744 exit 0; 756 exit 0;
745 } 757 }
746 } 758 }
747 759
760 $src = $compress->($src);
761
748 $src 762 $src
749 }; 763 };
750 764
751# if ($pm eq "Opcode.pm") { 765# if ($pm eq "Opcode.pm") {
752# open my $fh, ">x" or die; print $fh $src;#d# 766# open my $fh, ">x" or die; print $fh $src;#d#
… …
811 825
812/* public API */ 826/* public API */
813PerlInterpreter *staticperl; 827PerlInterpreter *staticperl;
814 828
815EOF 829EOF
830
831#############################################################################
832# lzf decompressor
833
834if ($COMPRESS eq "lzf") {
835 print $fh <<'EOF';
836/* stripped down/perlified version of lzf_d.c from liblzf-3.7 */
837
838#if (__i386 || __amd64) && __GNUC__ >= 3
839# define lzf_movsb(dst, src, len) \
840 asm ("rep movsb" \
841 : "=D" (dst), "=S" (src), "=c" (len) \
842 : "0" (dst), "1" (src), "2" (len));
843#endif
844
845static unsigned int
846lzf_decompress (const void *const in_data, unsigned int in_len,
847 void *out_data, unsigned int out_len)
848{
849 U8 const *ip = (const U8 *)in_data;
850 U8 *op = (U8 *)out_data;
851 U8 const *const in_end = ip + in_len;
852 U8 *const out_end = op + out_len;
853
854 do
855 {
856 unsigned int ctrl = *ip++;
857
858 if (ctrl < (1 << 5)) /* literal run */
859 {
860 ctrl++;
861
862 if (op + ctrl > out_end)
863 return 0;
864
865#ifdef lzf_movsb
866 lzf_movsb (op, ip, ctrl);
867#else
868 while (ctrl--)
869 *op++ = *ip++;
870#endif
871 }
872 else /* back reference */
873 {
874 unsigned int len = ctrl >> 5;
875
876 U8 *ref = op - ((ctrl & 0x1f) << 8) - 1;
877
878 if (len == 7)
879 len += *ip++;
880
881 ref -= *ip++;
882
883 if (op + len + 2 > out_end)
884 return 0;
885
886 if (ref < (U8 *)out_data)
887 return 0;
888
889 len += 2;
890#ifdef lzf_movsb
891 lzf_movsb (op, ref, len);
892#else
893 do
894 *op++ = *ref++;
895 while (--len);
896#endif
897 }
898 }
899 while (ip < in_end);
900
901 return op - (U8 *)out_data;
902}
903
904static SV *
905static_to_sv (const char *ptr, STRLEN len)
906{
907 SV *res;
908 const U8 *p = (const U8 *)ptr;
909
910 if (len == 0) /* empty */
911 res = newSVpvn ("", 0);
912 else if (*p == 0) /* not compressed */
913 res = newSVpvn (p + 1, len - 1);
914 else /* lzf compressed, with UTF-8-encoded original size in front */
915 {
916 STRLEN ulenlen;
917 UV ulen = utf8n_to_uvchr (p, len, &ulenlen, 0);
918
919 p += ulenlen;
920 len -= ulenlen;
921
922 res = NEWSV (0, ulen);
923 sv_upgrade (res, SVt_PV);
924 SvPOK_only (res);
925 lzf_decompress (p, len, SvPVX (res), ulen);
926 SvCUR_set (res, ulen);
927 }
928
929 return res;
930}
931
932EOF
933} else {
934 print $fh <<EOF;
935
936#define static_to_sv(ptr,len) newSVpvn (ptr, len)
937
938EOF
939}
816 940
817############################################################################# 941#############################################################################
818# bundle data 942# bundle data
819 943
820my $count = @index; 944my $count = @index;
… …
946 { 1070 {
947 /* found */ 1071 /* found */
948 int ofs2 = $varpfx\_index [m + 1] & 0x1FFFFFFU; 1072 int ofs2 = $varpfx\_index [m + 1] & 0x1FFFFFFU;
949 1073
950 ofs += namelen; 1074 ofs += namelen;
951 res = newSVpvn ($varpfx\_data + ofs, ofs2 - ofs); 1075 res = static_to_sv ($varpfx\_data + ofs, ofs2 - ofs);
952 goto found; 1076 goto found;
953 } 1077 }
954 } 1078 }
955 1079
956 if (comp < 0) 1080 if (comp < 0)

Diff Legend

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