Commit | Line | Data |
---|---|---|
5f05dabc | 1 | #!/usr/bin/perl -w |
e50aee73 | 2 | |
5f05dabc | 3 | require 5.003; |
4 | ||
709f4e38 GS |
5 | # XXX others that may need adding |
6 | # warnhook | |
7 | # hints | |
8 | # copline | |
84fee439 NIS |
9 | my @extvars = qw(sv_undef sv_yes sv_no na dowarn |
10 | curcop compiling | |
11 | tainting tainted stack_base stack_sp sv_arenaroot | |
12 | curstash DBsub DBsingle debstash | |
13 | rsfp | |
14 | stdingv | |
6b88bc9c GS |
15 | defgv |
16 | errgv | |
3070f6ec GS |
17 | rsfp_filters |
18 | perldb | |
709f4e38 GS |
19 | diehook |
20 | dirty | |
21 | perl_destruct_level | |
84fee439 NIS |
22 | ); |
23 | ||
5f05dabc | 24 | sub readsyms (\%$) { |
25 | my ($syms, $file) = @_; | |
26 | %$syms = (); | |
27 | local (*FILE, $_); | |
28 | open(FILE, "< $file") | |
29 | or die "embed.pl: Can't open $file: $!\n"; | |
30 | while (<FILE>) { | |
31 | s/[ \t]*#.*//; # Delete comments. | |
32 | if (/^\s*(\S+)\s*$/) { | |
33 | $$syms{$1} = 1; | |
34 | } | |
35 | } | |
36 | close(FILE); | |
37 | } | |
38 | ||
39 | readsyms %global, 'global.sym'; | |
40 | readsyms %interp, 'interp.sym'; | |
5f05dabc | 41 | |
d4cce5f1 NIS |
42 | sub readvars(\%$$) { |
43 | my ($syms, $file,$pre) = @_; | |
44 | %$syms = (); | |
45 | local (*FILE, $_); | |
46 | open(FILE, "< $file") | |
47 | or die "embed.pl: Can't open $file: $!\n"; | |
48 | while (<FILE>) { | |
49 | s/[ \t]*#.*//; # Delete comments. | |
3fe35a81 | 50 | if (/PERLVARI?C?\($pre(\w+)/) { |
22239a37 | 51 | $$syms{$1} = 1; |
d4cce5f1 NIS |
52 | } |
53 | } | |
54 | close(FILE); | |
55 | } | |
56 | ||
57 | my %intrp; | |
58 | my %thread; | |
59 | ||
60 | readvars %intrp, 'intrpvar.h','I'; | |
61 | readvars %thread, 'thrdvar.h','T'; | |
22239a37 | 62 | readvars %globvar, 'perlvars.h','G'; |
d4cce5f1 NIS |
63 | |
64 | foreach my $sym (sort keys %intrp) | |
65 | { | |
66 | warn "$sym not in interp.sym\n" unless exists $interp{$sym}; | |
67 | if (exists $global{$sym}) | |
68 | { | |
69 | delete $global{$sym}; | |
70 | warn "$sym in global.sym as well as interp\n"; | |
71 | } | |
72 | } | |
73 | ||
22239a37 NIS |
74 | foreach my $sym (sort keys %globvar) |
75 | { | |
76 | if (exists $global{$sym}) | |
77 | { | |
78 | delete $global{$sym}; | |
79 | warn "$sym in global.sym as well as perlvars.h\n"; | |
80 | } | |
81 | } | |
82 | ||
d4cce5f1 NIS |
83 | foreach my $sym (keys %interp) |
84 | { | |
85 | warn "extra $sym in interp.sym\n" | |
86 | unless exists $intrp{$sym} || exists $thread{$sym}; | |
87 | } | |
88 | ||
89 | foreach my $sym (sort keys %thread) | |
90 | { | |
91 | warn "$sym in intrpvar.h\n" if exists $intrp{$sym}; | |
92 | if (exists $global{$sym}) | |
93 | { | |
94 | delete $global{$sym}; | |
95 | warn "$sym in global.sym as well as thread\n"; | |
96 | } | |
97 | } | |
98 | ||
5f05dabc | 99 | sub hide ($$) { |
100 | my ($from, $to) = @_; | |
101 | my $t = int(length($from) / 8); | |
102 | "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n"; | |
103 | } | |
104 | sub embed ($) { | |
105 | my ($sym) = @_; | |
106 | hide($sym, "Perl_$sym"); | |
107 | } | |
3280af22 NIS |
108 | sub embedvar ($) { |
109 | my ($sym) = @_; | |
110 | # hide($sym, "Perl_$sym"); | |
111 | return ''; | |
112 | } | |
113 | ||
d4cce5f1 NIS |
114 | sub multon ($$$) { |
115 | my ($sym,$pre,$ptr) = @_; | |
3280af22 | 116 | hide("PL_$sym", "($ptr$pre$sym)"); |
5f05dabc | 117 | } |
d4cce5f1 NIS |
118 | sub multoff ($$) { |
119 | my ($sym,$pre) = @_; | |
533c011a | 120 | return hide("PL_$pre$sym", "PL_$sym"); |
5f05dabc | 121 | } |
122 | ||
123 | unlink 'embed.h'; | |
124 | open(EM, '> embed.h') | |
125 | or die "Can't create embed.h: $!\n"; | |
e50aee73 AD |
126 | |
127 | print EM <<'END'; | |
76b72cf1 | 128 | /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
d4cce5f1 NIS |
129 | This file is built by embed.pl from global.sym, intrpvar.h, |
130 | and thrdvar.h. Any changes made here will be lost! | |
76b72cf1 | 131 | */ |
e50aee73 AD |
132 | |
133 | /* (Doing namespace management portably in C is really gross.) */ | |
134 | ||
820c3be9 | 135 | /* EMBED has no run-time penalty, but helps keep the Perl namespace |
136 | from colliding with that used by other libraries pulled in | |
137 | by extensions or by embedding perl. Allow a cc -DNO_EMBED | |
138 | override, however, to keep binary compatability with previous | |
139 | versions of perl. | |
140 | */ | |
141 | #ifndef NO_EMBED | |
142 | # define EMBED 1 | |
143 | #endif | |
144 | ||
5f05dabc | 145 | /* Hide global symbols? */ |
146 | ||
e50aee73 AD |
147 | #ifdef EMBED |
148 | ||
e50aee73 AD |
149 | END |
150 | ||
5f05dabc | 151 | for $sym (sort keys %global) { |
dc86dda3 | 152 | print EM embed($sym); |
e50aee73 AD |
153 | } |
154 | ||
e50aee73 AD |
155 | print EM <<'END'; |
156 | ||
157 | #endif /* EMBED */ | |
158 | ||
d4cce5f1 NIS |
159 | END |
160 | ||
161 | close(EM); | |
162 | ||
163 | unlink 'embedvar.h'; | |
164 | open(EM, '> embedvar.h') | |
165 | or die "Can't create embedvar.h: $!\n"; | |
166 | ||
167 | print EM <<'END'; | |
168 | /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! | |
169 | This file is built by embed.pl from global.sym, intrpvar.h, | |
170 | and thrdvar.h. Any changes made here will be lost! | |
171 | */ | |
172 | ||
173 | /* (Doing namespace management portably in C is really gross.) */ | |
174 | ||
175 | /* EMBED has no run-time penalty, but helps keep the Perl namespace | |
176 | from colliding with that used by other libraries pulled in | |
177 | by extensions or by embedding perl. Allow a cc -DNO_EMBED | |
178 | override, however, to keep binary compatability with previous | |
179 | versions of perl. | |
180 | */ | |
181 | ||
182 | ||
5f05dabc | 183 | /* Put interpreter-specific symbols into a struct? */ |
e50aee73 AD |
184 | |
185 | #ifdef MULTIPLICITY | |
186 | ||
d4cce5f1 NIS |
187 | #ifndef USE_THREADS |
188 | /* If we do not have threads then per-thread vars are per-interpreter */ | |
189 | ||
e50aee73 AD |
190 | END |
191 | ||
d4cce5f1 | 192 | for $sym (sort keys %thread) { |
8f872242 | 193 | print EM multon($sym,'T','PL_curinterp->'); |
d4cce5f1 NIS |
194 | } |
195 | ||
196 | print EM <<'END'; | |
197 | ||
198 | #endif /* !USE_THREADS */ | |
199 | ||
200 | /* These are always per-interpreter if there is more than one */ | |
201 | ||
202 | END | |
203 | ||
204 | for $sym (sort keys %intrp) { | |
8f872242 | 205 | print EM multon($sym,'I','PL_curinterp->'); |
760ac839 | 206 | } |
760ac839 | 207 | |
55497cff | 208 | print EM <<'END'; |
209 | ||
5f05dabc | 210 | #else /* !MULTIPLICITY */ |
55497cff | 211 | |
212 | END | |
760ac839 | 213 | |
d4cce5f1 NIS |
214 | for $sym (sort keys %intrp) { |
215 | print EM multoff($sym,'I'); | |
e50aee73 | 216 | } |
e50aee73 | 217 | |
56d28764 CS |
218 | print EM <<'END'; |
219 | ||
d4cce5f1 NIS |
220 | #ifndef USE_THREADS |
221 | ||
222 | END | |
223 | ||
224 | for $sym (sort keys %thread) { | |
225 | print EM multoff($sym,'T'); | |
226 | } | |
227 | ||
228 | print EM <<'END'; | |
229 | ||
230 | #endif /* USE_THREADS */ | |
231 | ||
232 | /* Hide what would have been interpreter-specific symbols? */ | |
5f05dabc | 233 | |
56d28764 CS |
234 | #ifdef EMBED |
235 | ||
236 | END | |
e50aee73 | 237 | |
d4cce5f1 | 238 | for $sym (sort keys %intrp) { |
3280af22 | 239 | print EM embedvar($sym); |
d4cce5f1 NIS |
240 | } |
241 | ||
242 | print EM <<'END'; | |
243 | ||
244 | #ifndef USE_THREADS | |
245 | ||
246 | END | |
247 | ||
248 | for $sym (sort keys %thread) { | |
3280af22 | 249 | print EM embedvar($sym); |
5f05dabc | 250 | } |
251 | ||
252 | print EM <<'END'; | |
253 | ||
d4cce5f1 | 254 | #endif /* USE_THREADS */ |
56d28764 | 255 | #endif /* EMBED */ |
e50aee73 | 256 | #endif /* MULTIPLICITY */ |
d4cce5f1 NIS |
257 | |
258 | /* Now same trickey for per-thread variables */ | |
259 | ||
260 | #ifdef USE_THREADS | |
261 | ||
262 | END | |
263 | ||
264 | for $sym (sort keys %thread) { | |
22239a37 | 265 | print EM multon($sym,'T','thr->'); |
d4cce5f1 NIS |
266 | } |
267 | ||
268 | print EM <<'END'; | |
269 | ||
270 | #endif /* USE_THREADS */ | |
271 | ||
22239a37 NIS |
272 | #ifdef PERL_GLOBAL_STRUCT |
273 | ||
274 | END | |
275 | ||
276 | for $sym (sort keys %globvar) { | |
533c011a | 277 | print EM multon($sym,'G','PL_Vars.'); |
22239a37 NIS |
278 | } |
279 | ||
280 | print EM <<'END'; | |
281 | ||
282 | #else /* !PERL_GLOBAL_STRUCT */ | |
283 | ||
284 | END | |
285 | ||
286 | for $sym (sort keys %globvar) { | |
287 | print EM multoff($sym,'G'); | |
288 | } | |
289 | ||
290 | print EM <<'END'; | |
291 | ||
292 | #ifdef EMBED | |
293 | ||
294 | END | |
295 | ||
296 | for $sym (sort keys %globvar) { | |
3280af22 | 297 | print EM embedvar($sym); |
22239a37 NIS |
298 | } |
299 | ||
300 | print EM <<'END'; | |
301 | ||
302 | #endif /* EMBED */ | |
303 | #endif /* PERL_GLOBAL_STRUCT */ | |
304 | ||
e50aee73 AD |
305 | END |
306 | ||
84fee439 NIS |
307 | print EM <<'END'; |
308 | ||
309 | #ifndef MIN_PERL_DEFINE | |
310 | ||
311 | END | |
312 | ||
313 | for $sym (sort @extvars) { | |
314 | print EM hide($sym,"PL_$sym"); | |
315 | } | |
316 | ||
317 | print EM <<'END'; | |
318 | ||
319 | #endif /* MIN_PERL_DEFINE */ | |
320 | END | |
321 | ||
322 | ||
3fe35a81 | 323 | close(EM); |