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'; |
5f05dabc |
40 | |
d4cce5f1 |
41 | sub readvars(\%$$) { |
42 | my ($syms, $file,$pre) = @_; |
43 | %$syms = (); |
44 | local (*FILE, $_); |
45 | open(FILE, "< $file") |
46 | or die "embed.pl: Can't open $file: $!\n"; |
47 | while (<FILE>) { |
48 | s/[ \t]*#.*//; # Delete comments. |
3fe35a81 |
49 | if (/PERLVARI?C?\($pre(\w+)/) { |
22239a37 |
50 | $$syms{$1} = 1; |
d4cce5f1 |
51 | } |
52 | } |
53 | close(FILE); |
54 | } |
55 | |
56 | my %intrp; |
57 | my %thread; |
58 | |
59 | readvars %intrp, 'intrpvar.h','I'; |
60 | readvars %thread, 'thrdvar.h','T'; |
22239a37 |
61 | readvars %globvar, 'perlvars.h','G'; |
d4cce5f1 |
62 | |
63 | foreach my $sym (sort keys %intrp) |
64 | { |
65 | warn "$sym not in interp.sym\n" unless exists $interp{$sym}; |
66 | if (exists $global{$sym}) |
67 | { |
68 | delete $global{$sym}; |
69 | warn "$sym in global.sym as well as interp\n"; |
70 | } |
71 | } |
72 | |
22239a37 |
73 | foreach my $sym (sort keys %globvar) |
74 | { |
75 | if (exists $global{$sym}) |
76 | { |
77 | delete $global{$sym}; |
78 | warn "$sym in global.sym as well as perlvars.h\n"; |
79 | } |
80 | } |
81 | |
d4cce5f1 |
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); |