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