Commit | Line | Data |
5f05dabc |
1 | #!/usr/bin/perl -w |
e50aee73 |
2 | |
5f05dabc |
3 | require 5.003; |
4 | |
709f4e38 |
5 | # XXX others that may need adding |
6 | # warnhook |
7 | # hints |
8 | # copline |
84fee439 |
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 |
6b88bc9c |
15 | defgv |
16 | errgv |
3070f6ec |
17 | rsfp_filters |
18 | perldb |
709f4e38 |
19 | diehook |
20 | dirty |
21 | perl_destruct_level |
84fee439 |
22 | ); |
23 | |
5f05dabc |
24 | sub readsyms (\%$) { |
25 | my ($syms, $file) = @_; |
5f05dabc |
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 (/^\s*(\S+)\s*$/) { |
22c35a8c |
32 | my $sym = $1; |
33 | warn "duplicate symbol $sym while processing $file\n" |
34 | if exists $$syms{$sym}; |
35 | $$syms{$sym} = 1; |
5f05dabc |
36 | } |
37 | } |
38 | close(FILE); |
39 | } |
40 | |
41 | readsyms %global, 'global.sym'; |
22c35a8c |
42 | readsyms %global, 'pp.sym'; |
5f05dabc |
43 | |
d4cce5f1 |
44 | sub readvars(\%$$) { |
45 | my ($syms, $file,$pre) = @_; |
d4cce5f1 |
46 | local (*FILE, $_); |
47 | open(FILE, "< $file") |
48 | or die "embed.pl: Can't open $file: $!\n"; |
49 | while (<FILE>) { |
50 | s/[ \t]*#.*//; # Delete comments. |
3fe35a81 |
51 | if (/PERLVARI?C?\($pre(\w+)/) { |
22c35a8c |
52 | my $sym = $1; |
53 | warn "duplicate symbol $sym while processing $file\n" |
54 | if exists $$syms{$sym}; |
55 | $$syms{$sym} = 1; |
d4cce5f1 |
56 | } |
57 | } |
58 | close(FILE); |
59 | } |
60 | |
61 | my %intrp; |
62 | my %thread; |
63 | |
64 | readvars %intrp, 'intrpvar.h','I'; |
65 | readvars %thread, 'thrdvar.h','T'; |
22239a37 |
66 | readvars %globvar, 'perlvars.h','G'; |
d4cce5f1 |
67 | |
68 | foreach my $sym (sort keys %intrp) |
69 | { |
d4cce5f1 |
70 | if (exists $global{$sym}) |
71 | { |
72 | delete $global{$sym}; |
22c35a8c |
73 | warn "$sym in {global,pp}.sym as well as intrpvar.h\n"; |
d4cce5f1 |
74 | } |
75 | } |
76 | |
22239a37 |
77 | foreach my $sym (sort keys %globvar) |
78 | { |
79 | if (exists $global{$sym}) |
80 | { |
81 | delete $global{$sym}; |
22c35a8c |
82 | warn "$sym in {global,pp}.sym as well as perlvars.h\n"; |
22239a37 |
83 | } |
84 | } |
85 | |
d4cce5f1 |
86 | foreach my $sym (sort keys %thread) |
87 | { |
34b58025 |
88 | warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym}; |
d4cce5f1 |
89 | if (exists $global{$sym}) |
90 | { |
91 | delete $global{$sym}; |
22c35a8c |
92 | warn "$sym in {global,pp}.sym as well as thrdvar.h\n"; |
d4cce5f1 |
93 | } |
94 | } |
95 | |
5f05dabc |
96 | sub hide ($$) { |
97 | my ($from, $to) = @_; |
98 | my $t = int(length($from) / 8); |
99 | "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n"; |
100 | } |
101 | sub embed ($) { |
102 | my ($sym) = @_; |
103 | hide($sym, "Perl_$sym"); |
104 | } |
22c35a8c |
105 | sub embedobj ($) { |
106 | my ($sym) = @_; |
107 | hide($sym, $sym =~ /^perl_/i ? "CPerlObj::$sym" : "CPerlObj::Perl_$sym"); |
108 | } |
3280af22 |
109 | sub embedvar ($) { |
110 | my ($sym) = @_; |
111 | # hide($sym, "Perl_$sym"); |
112 | return ''; |
113 | } |
114 | |
d4cce5f1 |
115 | sub multon ($$$) { |
116 | my ($sym,$pre,$ptr) = @_; |
3280af22 |
117 | hide("PL_$sym", "($ptr$pre$sym)"); |
5f05dabc |
118 | } |
d4cce5f1 |
119 | sub multoff ($$) { |
120 | my ($sym,$pre) = @_; |
533c011a |
121 | return hide("PL_$pre$sym", "PL_$sym"); |
5f05dabc |
122 | } |
123 | |
124 | unlink 'embed.h'; |
125 | open(EM, '> embed.h') |
126 | or die "Can't create embed.h: $!\n"; |
e50aee73 |
127 | |
128 | print EM <<'END'; |
76b72cf1 |
129 | /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
22c35a8c |
130 | This file is built by embed.pl from global.sym, pp.sym, intrpvar.h, |
d4cce5f1 |
131 | and thrdvar.h. Any changes made here will be lost! |
76b72cf1 |
132 | */ |
e50aee73 |
133 | |
134 | /* (Doing namespace management portably in C is really gross.) */ |
135 | |
22c35a8c |
136 | /* NO_EMBED is no longer supported. i.e. EMBED is always active. */ |
820c3be9 |
137 | |
22c35a8c |
138 | /* Hide global symbols */ |
5f05dabc |
139 | |
22c35a8c |
140 | #if !defined(PERL_OBJECT) |
e50aee73 |
141 | |
e50aee73 |
142 | END |
143 | |
5f05dabc |
144 | for $sym (sort keys %global) { |
dc86dda3 |
145 | print EM embed($sym); |
e50aee73 |
146 | } |
147 | |
e50aee73 |
148 | print EM <<'END'; |
149 | |
22c35a8c |
150 | #else /* PERL_OBJECT */ |
151 | |
152 | END |
153 | |
154 | # XXX these should be in a *.sym file |
155 | my @extras = qw( |
156 | perl_init_i18nl10n |
157 | perl_init_i18nl14n |
158 | perl_new_collate |
159 | perl_new_ctype |
160 | perl_new_numeric |
161 | perl_set_numeric_local |
162 | perl_set_numeric_standard |
163 | perl_construct |
164 | perl_destruct |
165 | perl_atexit |
166 | perl_free |
167 | perl_parse |
168 | perl_run |
169 | perl_get_sv |
170 | perl_get_av |
171 | perl_get_hv |
172 | perl_get_cv |
173 | perl_call_argv |
174 | perl_call_pv |
175 | perl_call_method |
176 | perl_call_sv |
177 | perl_eval_pv |
178 | perl_eval_sv |
179 | perl_require_pv |
180 | |
181 | hsplit |
182 | hfreeentries |
183 | more_he |
184 | new_he |
185 | del_he |
186 | save_hek |
187 | mess_alloc |
188 | gv_init_sv |
189 | save_scalar_at |
190 | asIV |
191 | asUV |
192 | more_sv |
193 | more_xiv |
194 | more_xnv |
195 | more_xpv |
196 | more_xrv |
197 | new_xiv |
198 | new_xnv |
199 | new_xpv |
200 | new_xrv |
201 | del_xiv |
202 | del_xnv |
203 | del_xpv |
204 | del_xrv |
205 | sv_mortalgrow |
206 | sv_unglob |
207 | sv_check_thinkfirst |
208 | avhv_index_sv |
209 | do_report_used |
210 | do_clean_objs |
211 | do_clean_named_objs |
212 | do_clean_all |
213 | not_a_number |
214 | my_safemalloc |
215 | visit |
216 | qsortsv |
217 | sortcv |
218 | save_magic |
219 | magic_methpack |
220 | magic_methcall |
221 | magic_methcall |
222 | doform |
223 | doencodes |
224 | refto |
225 | seed |
226 | docatch |
227 | dofindlabel |
228 | doparseform |
229 | dopoptoeval |
230 | dopoptolabel |
231 | dopoptoloop |
232 | dopoptosub |
233 | dopoptosub_at |
234 | save_lines |
235 | doeval |
236 | amagic_cmp |
237 | amagic_cmp_locale |
238 | mul128 |
239 | is_an_int |
240 | div128 |
241 | runops_standard |
242 | runops_debug |
243 | check_uni |
244 | force_next |
245 | force_version |
246 | force_word |
247 | tokeq |
248 | scan_const |
249 | scan_formline |
250 | scan_heredoc |
251 | scan_ident |
252 | scan_inputsymbol |
253 | scan_pat |
254 | scan_str |
255 | scan_subst |
256 | scan_trans |
257 | scan_word |
258 | skipspace |
259 | checkcomma |
260 | force_ident |
261 | incline |
262 | intuit_method |
263 | intuit_more |
264 | lop |
265 | missingterm |
266 | no_op |
267 | set_csh |
268 | sublex_done |
269 | sublex_push |
270 | sublex_start |
271 | uni |
272 | filter_gets |
273 | new_constant |
274 | ao |
275 | depcom |
276 | win32_textfilter |
277 | incl_perldb |
278 | isa_lookup |
279 | get_db_sub |
280 | list_assignment |
281 | bad_type |
282 | modkids |
283 | no_fh_allowed |
284 | scalarboolean |
285 | too_few_arguments |
286 | too_many_arguments |
287 | null |
288 | pad_findlex |
289 | newDEFSVOP |
290 | gv_ename |
291 | cv_clone2 |
292 | find_beginning |
293 | forbid_setid |
294 | incpush |
295 | init_interp |
296 | init_ids |
297 | init_debugger |
298 | init_lexer |
299 | init_main_stash |
300 | init_perllib |
301 | init_postdump_symbols |
302 | init_predump_symbols |
303 | my_exit_jump |
304 | nuke_stacks |
305 | open_script |
306 | usage |
307 | validate_suid |
308 | emulate_eaccess |
309 | reg |
310 | reganode |
311 | regatom |
312 | regbranch |
313 | regc |
314 | reguni |
315 | regclass |
316 | regclassutf8 |
317 | regcurly |
318 | reg_node |
319 | regpiece |
320 | reginsert |
321 | regoptail |
322 | regset |
323 | regtail |
324 | regwhite |
325 | nextchar |
326 | dumpuntil |
327 | scan_commit |
328 | study_chunk |
329 | add_data |
330 | re_croak2 |
331 | regmatch |
332 | regrepeat |
333 | regrepeat_hard |
334 | regtry |
335 | reginclass |
336 | reginclassutf8 |
337 | regcppush |
338 | regcppop |
339 | regcp_set_to |
340 | cache_re |
341 | reghop |
342 | reghopmaybe |
343 | dump |
344 | do_aspawn |
345 | debprof |
346 | bset_obj_store |
347 | new_logop |
348 | do_trans_CC_simple |
349 | do_trans_CC_count |
350 | do_trans_CC_complex |
351 | do_trans_UU_simple |
352 | do_trans_UU_count |
353 | do_trans_UU_complex |
354 | do_trans_UC_simple |
355 | do_trans_CU_simple |
356 | do_trans_UC_trivial |
357 | do_trans_CU_trivial |
358 | unwind_handler_stack |
359 | restore_magic |
360 | restore_rsfp |
361 | restore_expect |
362 | restore_lex_expect |
363 | yydestruct |
364 | del_sv |
365 | fprintf |
366 | ); |
367 | |
368 | my %skip; |
369 | |
370 | for $sym (qw[ |
371 | utf8skip |
372 | ]) |
373 | { |
374 | $skip{$sym}++; |
375 | } |
376 | |
377 | for $sym (sort(keys(%global),@extras)) { |
378 | next if exists $skip{$sym}; |
379 | print EM embedobj($sym); |
380 | } |
381 | |
382 | print EM <<'END'; |
383 | |
384 | #endif /* PERL_OBJECT */ |
e50aee73 |
385 | |
d4cce5f1 |
386 | END |
387 | |
388 | close(EM); |
389 | |
390 | unlink 'embedvar.h'; |
391 | open(EM, '> embedvar.h') |
392 | or die "Can't create embedvar.h: $!\n"; |
393 | |
394 | print EM <<'END'; |
395 | /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
22c35a8c |
396 | This file is built by embed.pl from global.sym, pp.sym, intrpvar.h, |
d4cce5f1 |
397 | and thrdvar.h. Any changes made here will be lost! |
398 | */ |
399 | |
400 | /* (Doing namespace management portably in C is really gross.) */ |
401 | |
5f05dabc |
402 | /* Put interpreter-specific symbols into a struct? */ |
e50aee73 |
403 | |
404 | #ifdef MULTIPLICITY |
405 | |
d4cce5f1 |
406 | #ifndef USE_THREADS |
407 | /* If we do not have threads then per-thread vars are per-interpreter */ |
408 | |
e50aee73 |
409 | END |
410 | |
d4cce5f1 |
411 | for $sym (sort keys %thread) { |
8f872242 |
412 | print EM multon($sym,'T','PL_curinterp->'); |
d4cce5f1 |
413 | } |
414 | |
415 | print EM <<'END'; |
416 | |
417 | #endif /* !USE_THREADS */ |
418 | |
419 | /* These are always per-interpreter if there is more than one */ |
420 | |
421 | END |
422 | |
423 | for $sym (sort keys %intrp) { |
8f872242 |
424 | print EM multon($sym,'I','PL_curinterp->'); |
760ac839 |
425 | } |
760ac839 |
426 | |
55497cff |
427 | print EM <<'END'; |
428 | |
5f05dabc |
429 | #else /* !MULTIPLICITY */ |
55497cff |
430 | |
431 | END |
760ac839 |
432 | |
d4cce5f1 |
433 | for $sym (sort keys %intrp) { |
434 | print EM multoff($sym,'I'); |
e50aee73 |
435 | } |
e50aee73 |
436 | |
56d28764 |
437 | print EM <<'END'; |
438 | |
d4cce5f1 |
439 | #ifndef USE_THREADS |
440 | |
441 | END |
442 | |
443 | for $sym (sort keys %thread) { |
444 | print EM multoff($sym,'T'); |
445 | } |
446 | |
447 | print EM <<'END'; |
448 | |
449 | #endif /* USE_THREADS */ |
450 | |
451 | /* Hide what would have been interpreter-specific symbols? */ |
5f05dabc |
452 | |
56d28764 |
453 | END |
e50aee73 |
454 | |
d4cce5f1 |
455 | for $sym (sort keys %intrp) { |
3280af22 |
456 | print EM embedvar($sym); |
d4cce5f1 |
457 | } |
458 | |
459 | print EM <<'END'; |
460 | |
461 | #ifndef USE_THREADS |
462 | |
463 | END |
464 | |
465 | for $sym (sort keys %thread) { |
3280af22 |
466 | print EM embedvar($sym); |
5f05dabc |
467 | } |
468 | |
469 | print EM <<'END'; |
470 | |
d4cce5f1 |
471 | #endif /* USE_THREADS */ |
e50aee73 |
472 | #endif /* MULTIPLICITY */ |
d4cce5f1 |
473 | |
474 | /* Now same trickey for per-thread variables */ |
475 | |
476 | #ifdef USE_THREADS |
477 | |
478 | END |
479 | |
480 | for $sym (sort keys %thread) { |
22239a37 |
481 | print EM multon($sym,'T','thr->'); |
d4cce5f1 |
482 | } |
483 | |
484 | print EM <<'END'; |
485 | |
486 | #endif /* USE_THREADS */ |
487 | |
22239a37 |
488 | #ifdef PERL_GLOBAL_STRUCT |
489 | |
490 | END |
491 | |
492 | for $sym (sort keys %globvar) { |
533c011a |
493 | print EM multon($sym,'G','PL_Vars.'); |
22239a37 |
494 | } |
495 | |
496 | print EM <<'END'; |
497 | |
498 | #else /* !PERL_GLOBAL_STRUCT */ |
499 | |
500 | END |
501 | |
502 | for $sym (sort keys %globvar) { |
503 | print EM multoff($sym,'G'); |
504 | } |
505 | |
506 | print EM <<'END'; |
507 | |
22239a37 |
508 | END |
509 | |
510 | for $sym (sort keys %globvar) { |
3280af22 |
511 | print EM embedvar($sym); |
22239a37 |
512 | } |
513 | |
514 | print EM <<'END'; |
515 | |
22239a37 |
516 | #endif /* PERL_GLOBAL_STRUCT */ |
517 | |
e50aee73 |
518 | END |
519 | |
84fee439 |
520 | print EM <<'END'; |
521 | |
eb07465e |
522 | #if 0 /* ndef MIN_PERL_DEFINE */ /* unsupported in 5.006 */ |
84fee439 |
523 | |
524 | END |
525 | |
526 | for $sym (sort @extvars) { |
527 | print EM hide($sym,"PL_$sym"); |
528 | } |
529 | |
530 | print EM <<'END'; |
531 | |
532 | #endif /* MIN_PERL_DEFINE */ |
533 | END |
534 | |
535 | |
3fe35a81 |
536 | close(EM); |