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