Commit | Line | Data |
5f05dabc |
1 | #!/usr/bin/perl -w |
e50aee73 |
2 | |
5f05dabc |
3 | require 5.003; |
4 | |
709f4e38 |
5 | # XXX others that may need adding |
6 | # warnhook |
7 | # hints |
8 | # copline |
84fee439 |
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 |
15 | defgv |
16 | errgv |
3070f6ec |
17 | rsfp_filters |
18 | perldb |
709f4e38 |
19 | diehook |
20 | dirty |
21 | perl_destruct_level |
84fee439 |
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 |
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 |
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 |
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 |
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 |
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 |
108 | sub embedvar ($) { |
109 | my ($sym) = @_; |
110 | # hide($sym, "Perl_$sym"); |
111 | return ''; |
112 | } |
113 | |
d4cce5f1 |
114 | sub multon ($$$) { |
115 | my ($sym,$pre,$ptr) = @_; |
3280af22 |
116 | hide("PL_$sym", "($ptr$pre$sym)"); |
5f05dabc |
117 | } |
d4cce5f1 |
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 |
126 | |
127 | print EM <<'END'; |
76b72cf1 |
128 | /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
d4cce5f1 |
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 |
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 |
147 | #ifdef EMBED |
148 | |
e50aee73 |
149 | END |
150 | |
5f05dabc |
151 | for $sym (sort keys %global) { |
dc86dda3 |
152 | print EM embed($sym); |
e50aee73 |
153 | } |
154 | |
e50aee73 |
155 | print EM <<'END'; |
156 | |
157 | #endif /* EMBED */ |
158 | |
d4cce5f1 |
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 |
184 | |
185 | #ifdef MULTIPLICITY |
186 | |
d4cce5f1 |
187 | #ifndef USE_THREADS |
188 | /* If we do not have threads then per-thread vars are per-interpreter */ |
189 | |
e50aee73 |
190 | END |
191 | |
d4cce5f1 |
192 | for $sym (sort keys %thread) { |
8f872242 |
193 | print EM multon($sym,'T','PL_curinterp->'); |
d4cce5f1 |
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 |
214 | for $sym (sort keys %intrp) { |
215 | print EM multoff($sym,'I'); |
e50aee73 |
216 | } |
e50aee73 |
217 | |
56d28764 |
218 | print EM <<'END'; |
219 | |
d4cce5f1 |
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 |
234 | #ifdef EMBED |
235 | |
236 | END |
e50aee73 |
237 | |
d4cce5f1 |
238 | for $sym (sort keys %intrp) { |
3280af22 |
239 | print EM embedvar($sym); |
d4cce5f1 |
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 |
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 |
266 | } |
267 | |
268 | print EM <<'END'; |
269 | |
270 | #endif /* USE_THREADS */ |
271 | |
22239a37 |
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 |
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 |
298 | } |
299 | |
300 | print EM <<'END'; |
301 | |
302 | #endif /* EMBED */ |
303 | #endif /* PERL_GLOBAL_STRUCT */ |
304 | |
e50aee73 |
305 | END |
306 | |
84fee439 |
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); |