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