This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Create a struct for all perls globals (as an option)
[perl5.git] / embed.pl
1 #!/usr/bin/perl -w
2
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';
22
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.
31         if (/PERLVARI?\($pre(\w+)/) {
32             $$syms{$1} = 1;
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';
43 readvars %globvar, 'perlvars.h','G';
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
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
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
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 }
89 sub multon ($$$) {
90     my ($sym,$pre,$ptr) = @_;
91     hide($sym, "($ptr$pre$sym)");
92 }
93 sub multoff ($$) {
94     my ($sym,$pre) = @_;
95     hide("$pre$sym", $sym);
96 }
97
98 unlink 'embed.h';
99 open(EM, '> embed.h')
100     or die "Can't create embed.h: $!\n";
101
102 print EM <<'END';
103 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
104    This file is built by embed.pl from global.sym, intrpvar.h,
105    and thrdvar.h.  Any changes made here will be lost!
106 */
107
108 /* (Doing namespace management portably in C is really gross.) */
109
110 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
111     from colliding with that used by other libraries pulled in
112     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
113     override, however, to keep binary compatability with previous
114     versions of perl.
115 */
116 #ifndef NO_EMBED
117 #  define EMBED 1 
118 #endif
119
120 /* Hide global symbols? */
121
122 #ifdef EMBED
123
124 END
125
126 for $sym (sort keys %global) {
127     print EM embed($sym);
128 }
129
130 print EM <<'END';
131
132 #endif /* EMBED */
133
134 END
135
136 close(EM);
137
138 unlink 'embedvar.h';
139 open(EM, '> embedvar.h')
140     or die "Can't create embedvar.h: $!\n";
141
142 print EM <<'END';
143 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
144    This file is built by embed.pl from global.sym, intrpvar.h,
145    and thrdvar.h.  Any changes made here will be lost!
146 */
147
148 /* (Doing namespace management portably in C is really gross.) */
149
150 /*  EMBED has no run-time penalty, but helps keep the Perl namespace
151     from colliding with that used by other libraries pulled in
152     by extensions or by embedding perl.  Allow a cc -DNO_EMBED
153     override, however, to keep binary compatability with previous
154     versions of perl.
155 */
156
157
158 /* Put interpreter-specific symbols into a struct? */
159
160 #ifdef MULTIPLICITY
161
162 #ifndef USE_THREADS
163 /* If we do not have threads then per-thread vars are per-interpreter */
164
165 END
166
167 for $sym (sort keys %thread) {
168     print EM multon($sym,'T','curinterp->');
169 }
170
171 print EM <<'END';
172
173 #endif /* !USE_THREADS */
174
175 /* These are always per-interpreter if there is more than one */
176
177 END
178
179 for $sym (sort keys %intrp) {
180     print EM multon($sym,'I','curinterp->');
181 }
182
183 print EM <<'END';
184
185 #else   /* !MULTIPLICITY */
186
187 END
188
189 for $sym (sort keys %intrp) {
190     print EM multoff($sym,'I');
191 }
192
193 print EM <<'END';
194
195 #ifndef USE_THREADS
196
197 END
198
199 for $sym (sort keys %thread) {
200     print EM multoff($sym,'T');
201 }
202
203 print EM <<'END';
204
205 #endif /* USE_THREADS */
206
207 /* Hide what would have been interpreter-specific symbols? */
208
209 #ifdef EMBED
210
211 END
212
213 for $sym (sort keys %intrp) {
214     print EM embed($sym);
215 }
216
217 print EM <<'END';
218
219 #ifndef USE_THREADS
220
221 END
222
223 for $sym (sort keys %thread) {
224     print EM embed($sym);
225 }
226
227 print EM <<'END';
228
229 #endif /* USE_THREADS */
230 #endif /* EMBED */
231 #endif /* MULTIPLICITY */
232
233 /* Now same trickey for per-thread variables */
234
235 #ifdef USE_THREADS
236
237 END
238
239 for $sym (sort keys %thread) {
240     print EM multon($sym,'T','thr->');
241 }
242
243 print EM <<'END';
244
245 #endif /* USE_THREADS */
246
247 #ifdef PERL_GLOBAL_STRUCT
248
249 END
250
251 for $sym (sort keys %globvar) {
252     print EM multon($sym,'G','Perl_Vars.');
253 }
254
255 print EM <<'END';
256
257 #else /* !PERL_GLOBAL_STRUCT */
258
259 END
260
261 for $sym (sort keys %globvar) {
262     print EM multoff($sym,'G');
263 }
264
265 print EM <<'END';
266
267 #ifdef EMBED
268
269 END
270
271 for $sym (sort keys %globvar) {
272     print EM embed($sym);
273 }
274
275 print EM <<'END';
276
277 #endif /* EMBED */
278 #endif /* PERL_GLOBAL_STRUCT */
279
280 END
281
282 close(EM);