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 | { |
d4cce5f1 |
65 | if (exists $global{$sym}) |
66 | { |
67 | delete $global{$sym}; |
34b58025 |
68 | warn "$sym in global.sym as well as intrpvar.h\n"; |
d4cce5f1 |
69 | } |
70 | } |
71 | |
22239a37 |
72 | foreach my $sym (sort keys %globvar) |
73 | { |
74 | if (exists $global{$sym}) |
75 | { |
76 | delete $global{$sym}; |
77 | warn "$sym in global.sym as well as perlvars.h\n"; |
78 | } |
79 | } |
80 | |
d4cce5f1 |
81 | foreach my $sym (sort keys %thread) |
82 | { |
34b58025 |
83 | warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym}; |
d4cce5f1 |
84 | if (exists $global{$sym}) |
85 | { |
86 | delete $global{$sym}; |
34b58025 |
87 | warn "$sym in global.sym as well as thrdvar.h\n"; |
d4cce5f1 |
88 | } |
89 | } |
90 | |
5f05dabc |
91 | sub hide ($$) { |
92 | my ($from, $to) = @_; |
93 | my $t = int(length($from) / 8); |
94 | "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n"; |
95 | } |
96 | sub embed ($) { |
97 | my ($sym) = @_; |
98 | hide($sym, "Perl_$sym"); |
99 | } |
3280af22 |
100 | sub embedvar ($) { |
101 | my ($sym) = @_; |
102 | # hide($sym, "Perl_$sym"); |
103 | return ''; |
104 | } |
105 | |
d4cce5f1 |
106 | sub multon ($$$) { |
107 | my ($sym,$pre,$ptr) = @_; |
3280af22 |
108 | hide("PL_$sym", "($ptr$pre$sym)"); |
5f05dabc |
109 | } |
d4cce5f1 |
110 | sub multoff ($$) { |
111 | my ($sym,$pre) = @_; |
533c011a |
112 | return hide("PL_$pre$sym", "PL_$sym"); |
5f05dabc |
113 | } |
114 | |
115 | unlink 'embed.h'; |
116 | open(EM, '> embed.h') |
117 | or die "Can't create embed.h: $!\n"; |
e50aee73 |
118 | |
119 | print EM <<'END'; |
76b72cf1 |
120 | /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
d4cce5f1 |
121 | This file is built by embed.pl from global.sym, intrpvar.h, |
122 | and thrdvar.h. Any changes made here will be lost! |
76b72cf1 |
123 | */ |
e50aee73 |
124 | |
125 | /* (Doing namespace management portably in C is really gross.) */ |
126 | |
820c3be9 |
127 | /* EMBED has no run-time penalty, but helps keep the Perl namespace |
128 | from colliding with that used by other libraries pulled in |
129 | by extensions or by embedding perl. Allow a cc -DNO_EMBED |
130 | override, however, to keep binary compatability with previous |
131 | versions of perl. |
132 | */ |
133 | #ifndef NO_EMBED |
134 | # define EMBED 1 |
135 | #endif |
136 | |
5f05dabc |
137 | /* Hide global symbols? */ |
138 | |
e50aee73 |
139 | #ifdef EMBED |
140 | |
e50aee73 |
141 | END |
142 | |
5f05dabc |
143 | for $sym (sort keys %global) { |
dc86dda3 |
144 | print EM embed($sym); |
e50aee73 |
145 | } |
146 | |
e50aee73 |
147 | print EM <<'END'; |
148 | |
149 | #endif /* EMBED */ |
150 | |
d4cce5f1 |
151 | END |
152 | |
153 | close(EM); |
154 | |
155 | unlink 'embedvar.h'; |
156 | open(EM, '> embedvar.h') |
157 | or die "Can't create embedvar.h: $!\n"; |
158 | |
159 | print EM <<'END'; |
160 | /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
161 | This file is built by embed.pl from global.sym, intrpvar.h, |
162 | and thrdvar.h. Any changes made here will be lost! |
163 | */ |
164 | |
165 | /* (Doing namespace management portably in C is really gross.) */ |
166 | |
167 | /* EMBED has no run-time penalty, but helps keep the Perl namespace |
168 | from colliding with that used by other libraries pulled in |
169 | by extensions or by embedding perl. Allow a cc -DNO_EMBED |
170 | override, however, to keep binary compatability with previous |
171 | versions of perl. |
172 | */ |
173 | |
174 | |
5f05dabc |
175 | /* Put interpreter-specific symbols into a struct? */ |
e50aee73 |
176 | |
177 | #ifdef MULTIPLICITY |
178 | |
d4cce5f1 |
179 | #ifndef USE_THREADS |
180 | /* If we do not have threads then per-thread vars are per-interpreter */ |
181 | |
e50aee73 |
182 | END |
183 | |
d4cce5f1 |
184 | for $sym (sort keys %thread) { |
8f872242 |
185 | print EM multon($sym,'T','PL_curinterp->'); |
d4cce5f1 |
186 | } |
187 | |
188 | print EM <<'END'; |
189 | |
190 | #endif /* !USE_THREADS */ |
191 | |
192 | /* These are always per-interpreter if there is more than one */ |
193 | |
194 | END |
195 | |
196 | for $sym (sort keys %intrp) { |
8f872242 |
197 | print EM multon($sym,'I','PL_curinterp->'); |
760ac839 |
198 | } |
760ac839 |
199 | |
55497cff |
200 | print EM <<'END'; |
201 | |
5f05dabc |
202 | #else /* !MULTIPLICITY */ |
55497cff |
203 | |
204 | END |
760ac839 |
205 | |
d4cce5f1 |
206 | for $sym (sort keys %intrp) { |
207 | print EM multoff($sym,'I'); |
e50aee73 |
208 | } |
e50aee73 |
209 | |
56d28764 |
210 | print EM <<'END'; |
211 | |
d4cce5f1 |
212 | #ifndef USE_THREADS |
213 | |
214 | END |
215 | |
216 | for $sym (sort keys %thread) { |
217 | print EM multoff($sym,'T'); |
218 | } |
219 | |
220 | print EM <<'END'; |
221 | |
222 | #endif /* USE_THREADS */ |
223 | |
224 | /* Hide what would have been interpreter-specific symbols? */ |
5f05dabc |
225 | |
56d28764 |
226 | #ifdef EMBED |
227 | |
228 | END |
e50aee73 |
229 | |
d4cce5f1 |
230 | for $sym (sort keys %intrp) { |
3280af22 |
231 | print EM embedvar($sym); |
d4cce5f1 |
232 | } |
233 | |
234 | print EM <<'END'; |
235 | |
236 | #ifndef USE_THREADS |
237 | |
238 | END |
239 | |
240 | for $sym (sort keys %thread) { |
3280af22 |
241 | print EM embedvar($sym); |
5f05dabc |
242 | } |
243 | |
244 | print EM <<'END'; |
245 | |
d4cce5f1 |
246 | #endif /* USE_THREADS */ |
56d28764 |
247 | #endif /* EMBED */ |
e50aee73 |
248 | #endif /* MULTIPLICITY */ |
d4cce5f1 |
249 | |
250 | /* Now same trickey for per-thread variables */ |
251 | |
252 | #ifdef USE_THREADS |
253 | |
254 | END |
255 | |
256 | for $sym (sort keys %thread) { |
22239a37 |
257 | print EM multon($sym,'T','thr->'); |
d4cce5f1 |
258 | } |
259 | |
260 | print EM <<'END'; |
261 | |
262 | #endif /* USE_THREADS */ |
263 | |
22239a37 |
264 | #ifdef PERL_GLOBAL_STRUCT |
265 | |
266 | END |
267 | |
268 | for $sym (sort keys %globvar) { |
533c011a |
269 | print EM multon($sym,'G','PL_Vars.'); |
22239a37 |
270 | } |
271 | |
272 | print EM <<'END'; |
273 | |
274 | #else /* !PERL_GLOBAL_STRUCT */ |
275 | |
276 | END |
277 | |
278 | for $sym (sort keys %globvar) { |
279 | print EM multoff($sym,'G'); |
280 | } |
281 | |
282 | print EM <<'END'; |
283 | |
284 | #ifdef EMBED |
285 | |
286 | END |
287 | |
288 | for $sym (sort keys %globvar) { |
3280af22 |
289 | print EM embedvar($sym); |
22239a37 |
290 | } |
291 | |
292 | print EM <<'END'; |
293 | |
294 | #endif /* EMBED */ |
295 | #endif /* PERL_GLOBAL_STRUCT */ |
296 | |
e50aee73 |
297 | END |
298 | |
84fee439 |
299 | print EM <<'END'; |
300 | |
eb07465e |
301 | #if 0 /* ndef MIN_PERL_DEFINE */ /* unsupported in 5.006 */ |
84fee439 |
302 | |
303 | END |
304 | |
305 | for $sym (sort @extvars) { |
306 | print EM hide($sym,"PL_$sym"); |
307 | } |
308 | |
309 | print EM <<'END'; |
310 | |
311 | #endif /* MIN_PERL_DEFINE */ |
312 | END |
313 | |
314 | |
3fe35a81 |
315 | close(EM); |