TODO
[perl.git] / embed.pl
1 #!/usr/bin/perl -w
2
3 require 5.003;
4
5 # XXX others that may need adding
6 #       warnhook
7 #       hints
8 #       copline
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
15                  defgv
16                  errgv
17                  rsfp_filters
18                  perldb
19                  diehook
20                  dirty
21                  perl_destruct_level
22                 );
23
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';
40
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.
49         if (/PERLVARI?C?\($pre(\w+)/) {
50             $$syms{$1} = 1;
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';
61 readvars %globvar, 'perlvars.h','G';
62
63 foreach my $sym (sort keys %intrp)
64  {
65   if (exists $global{$sym})
66    {
67     delete $global{$sym};
68     warn "$sym in global.sym as well as intrpvar.h\n";
69    }
70  }
71
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
81 foreach my $sym (sort keys %thread)
82  {
83   warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
84   if (exists $global{$sym})
85    {
86     delete $global{$sym};
87     warn "$sym in global.sym as well as thrdvar.h\n";
88    }
89  }
90
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 }
100 sub embedvar ($) {
101     my ($sym) = @_;
102 #   hide($sym, "Perl_$sym");
103     return '';
104 }
105
106 sub multon ($$$) {
107     my ($sym,$pre,$ptr) = @_;
108     hide("PL_$sym", "($ptr$pre$sym)");
109 }
110 sub multoff ($$) {
111     my ($sym,$pre) = @_;
112     return hide("PL_$pre$sym", "PL_$sym");
113 }
114
115 unlink 'embed.h';
116 open(EM, '> embed.h')
117     or die "Can't create embed.h: $!\n";
118
119 print EM <<'END';
120 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
121    This file is built by embed.pl from global.sym, intrpvar.h,
122    and thrdvar.h.  Any changes made here will be lost!
123 */
124
125 /* (Doing namespace management portably in C is really gross.) */
126
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
137 /* Hide global symbols? */
138
139 #ifdef EMBED
140
141 END
142
143 for $sym (sort keys %global) {
144     print EM embed($sym);
145 }
146
147 print EM <<'END';
148
149 #endif /* EMBED */
150
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
175 /* Put interpreter-specific symbols into a struct? */
176
177 #ifdef MULTIPLICITY
178
179 #ifndef USE_THREADS
180 /* If we do not have threads then per-thread vars are per-interpreter */
181
182 END
183
184 for $sym (sort keys %thread) {
185     print EM multon($sym,'T','PL_curinterp->');
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) {
197     print EM multon($sym,'I','PL_curinterp->');
198 }
199
200 print EM <<'END';
201
202 #else   /* !MULTIPLICITY */
203
204 END
205
206 for $sym (sort keys %intrp) {
207     print EM multoff($sym,'I');
208 }
209
210 print EM <<'END';
211
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? */
225
226 #ifdef EMBED
227
228 END
229
230 for $sym (sort keys %intrp) {
231     print EM embedvar($sym);
232 }
233
234 print EM <<'END';
235
236 #ifndef USE_THREADS
237
238 END
239
240 for $sym (sort keys %thread) {
241     print EM embedvar($sym);
242 }
243
244 print EM <<'END';
245
246 #endif /* USE_THREADS */
247 #endif /* EMBED */
248 #endif /* MULTIPLICITY */
249
250 /* Now same trickey for per-thread variables */
251
252 #ifdef USE_THREADS
253
254 END
255
256 for $sym (sort keys %thread) {
257     print EM multon($sym,'T','thr->');
258 }
259
260 print EM <<'END';
261
262 #endif /* USE_THREADS */
263
264 #ifdef PERL_GLOBAL_STRUCT
265
266 END
267
268 for $sym (sort keys %globvar) {
269     print EM multon($sym,'G','PL_Vars.');
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) {
289     print EM embedvar($sym);
290 }
291
292 print EM <<'END';
293
294 #endif /* EMBED */
295 #endif /* PERL_GLOBAL_STRUCT */
296
297 END
298
299 print EM <<'END';
300
301 #ifndef MIN_PERL_DEFINE  
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
315 close(EM);