Commit | Line | Data |
---|---|---|
5f05dabc | 1 | #!/usr/bin/perl -w |
e50aee73 | 2 | |
5f05dabc | 3 | require 5.003; |
4 | ||
84fee439 NIS |
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 GS |
11 | defgv |
12 | errgv | |
3070f6ec GS |
13 | rsfp_filters |
14 | perldb | |
84fee439 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
101 | sub embedvar ($) { |
102 | my ($sym) = @_; | |
103 | # hide($sym, "Perl_$sym"); | |
104 | return ''; | |
105 | } | |
106 | ||
d4cce5f1 NIS |
107 | sub multon ($$$) { |
108 | my ($sym,$pre,$ptr) = @_; | |
3280af22 | 109 | hide("PL_$sym", "($ptr$pre$sym)"); |
5f05dabc | 110 | } |
d4cce5f1 NIS |
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 AD |
119 | |
120 | print EM <<'END'; | |
76b72cf1 | 121 | /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
d4cce5f1 NIS |
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 AD |
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 AD |
140 | #ifdef EMBED |
141 | ||
e50aee73 AD |
142 | END |
143 | ||
5f05dabc | 144 | for $sym (sort keys %global) { |
dc86dda3 | 145 | print EM embed($sym); |
e50aee73 AD |
146 | } |
147 | ||
e50aee73 AD |
148 | print EM <<'END'; |
149 | ||
150 | #endif /* EMBED */ | |
151 | ||
d4cce5f1 NIS |
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 AD |
177 | |
178 | #ifdef MULTIPLICITY | |
179 | ||
d4cce5f1 NIS |
180 | #ifndef USE_THREADS |
181 | /* If we do not have threads then per-thread vars are per-interpreter */ | |
182 | ||
e50aee73 AD |
183 | END |
184 | ||
d4cce5f1 | 185 | for $sym (sort keys %thread) { |
8f872242 | 186 | print EM multon($sym,'T','PL_curinterp->'); |
d4cce5f1 NIS |
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 NIS |
207 | for $sym (sort keys %intrp) { |
208 | print EM multoff($sym,'I'); | |
e50aee73 | 209 | } |
e50aee73 | 210 | |
56d28764 CS |
211 | print EM <<'END'; |
212 | ||
d4cce5f1 NIS |
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 CS |
227 | #ifdef EMBED |
228 | ||
229 | END | |
e50aee73 | 230 | |
d4cce5f1 | 231 | for $sym (sort keys %intrp) { |
3280af22 | 232 | print EM embedvar($sym); |
d4cce5f1 NIS |
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 NIS |
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 NIS |
259 | } |
260 | ||
261 | print EM <<'END'; | |
262 | ||
263 | #endif /* USE_THREADS */ | |
264 | ||
22239a37 NIS |
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 NIS |
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 NIS |
291 | } |
292 | ||
293 | print EM <<'END'; | |
294 | ||
295 | #endif /* EMBED */ | |
296 | #endif /* PERL_GLOBAL_STRUCT */ | |
297 | ||
e50aee73 AD |
298 | END |
299 | ||
84fee439 NIS |
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); |