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