Make it possible to disable and control hash key traversal randomization
[perl.git] / minimod.pl
1 #./miniperl -w
2 # minimod.pl writes the contents of miniperlmain.c into the module
3 # ExtUtils::Miniperl for later perusal (when the perl source is
4 # deleted)
5 #
6 # It also writes the subroutine writemain(), which takes as its
7 # arguments module names that shall be statically linked into perl.
8 #
9 # Authors: Andreas Koenig <k@franz.ww.TU-Berlin.DE>, Tim Bunce
10 #          <Tim.Bunce@ig.co.uk>
11 #
12 # Version 1.0, Feb 2nd 1995 by Andreas Koenig
13
14 BEGIN { unshift @INC, "lib" }
15
16 use strict;
17
18 print <<'END';
19 # This File keeps the contents of miniperlmain.c.
20 #
21 # It was generated automatically by minimod.PL from the contents
22 # of miniperlmain.c. Don't edit this file!
23 #
24 #       ANY CHANGES MADE HERE WILL BE LOST! 
25 #
26
27
28 package ExtUtils::Miniperl;
29 require Exporter;
30 @ISA = qw(Exporter);
31 @EXPORT = qw(&writemain);
32
33 $head= <<'EOF!HEAD';
34 END
35
36 open MINI, "miniperlmain.c";
37 while (<MINI>) {
38     last if /Do not delete this line--writemain depends on it/;
39     print;
40     /#include "perl.h"/ and print qq/#include "XSUB.h"\n/;
41 }
42
43 print <<'END';
44 EOF!HEAD
45 $tail=<<'EOF!TAIL';
46 END
47
48 while (<MINI>) {
49     print unless /dXSUB_SYS/;
50 }
51 close MINI;
52
53 print <<'END';
54 EOF!TAIL
55
56 sub writemain{
57     my(@exts) = @_;
58
59     my($pname);
60     my($dl) = canon('/','DynaLoader');
61     print $head;
62
63     foreach $_ (@exts){
64         my($pname) = canon('/', $_);
65         my($mname, $cname);
66         ($mname = $pname) =~ s!/!::!g;
67         ($cname = $pname) =~ s!/!__!g;
68         print "EXTERN_C void boot_${cname} (pTHX_ CV* cv);\n";
69     }
70
71     my ($tail1,$tail2,$tail3) = ( $tail =~ /\A(.*{\s*\n)(.*\n)(\s*\}.*)\Z/s );
72
73     print $tail1;
74     print "\tstatic const char file[] = __FILE__;\n";
75     print "\tdXSUB_SYS;\n" if $] > 5.002;
76     print $tail2;
77
78     foreach $_ (@exts){
79         my($pname) = canon('/', $_);
80         my($mname, $cname, $ccode);
81         ($mname = $pname) =~ s!/!::!g;
82         ($cname = $pname) =~ s!/!__!g;
83         print "\t{\n";
84         if ($pname eq $dl){
85             # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
86             # boot_DynaLoader is called directly in DynaLoader.pm
87             $ccode = "\t/* DynaLoader is a special case */\n
88 \tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
89             print $ccode unless $SEEN{$ccode}++;
90         } else {
91             $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
92             print $ccode unless $SEEN{$ccode}++;
93         }
94         print "\t}\n";
95     }
96     print $tail3;
97 }
98
99 sub canon{
100     my($as, @ext) = @_;
101         foreach(@ext){
102             # might be X::Y or lib/auto/X/Y/Y.a
103                 next if s!::!/!g;
104             s:^(lib|ext)/(auto/)?::;
105             s:/\w+\.\w+$::;
106         }
107         grep(s:/:$as:, @ext) if ($as ne '/');
108         @ext;
109 }
110
111 1;
112 __END__
113
114 =head1 NAME
115
116 ExtUtils::Miniperl, writemain - write the C code for perlmain.c
117
118 =head1 SYNOPSIS
119
120 C<use ExtUtils::Miniperl;>
121
122 C<writemain(@directories);>
123
124 =head1 DESCRIPTION
125
126 This whole module is written when perl itself is built from a script
127 called minimod.PL. In case you want to patch it, please patch
128 minimod.PL in the perl distribution instead.
129
130 writemain() takes an argument list of directories containing archive
131 libraries that relate to perl modules and should be linked into a new
132 perl binary. It writes to STDOUT a corresponding perlmain.c file that
133 is a plain C file containing all the bootstrap code to make the
134 modules associated with the libraries available from within perl.
135
136 The typical usage is from within a Makefile generated by
137 ExtUtils::MakeMaker. So under normal circumstances you won't have to
138 deal with this module directly.
139
140 =head1 SEE ALSO
141
142 L<ExtUtils::MakeMaker>
143
144 =cut
145
146 END