clean up some stray "global" symbols
[p5sagit/p5-mst-13.2.git] / embed.pl
CommitLineData
5f05dabc 1#!/usr/bin/perl -w
e50aee73 2
5f05dabc 3require 5.003;
4
709f4e38 5# XXX others that may need adding
6# warnhook
7# hints
8# copline
84fee439 9my @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 25sub 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
42readsyms %global, 'global.sym';
22c35a8c 43readsyms %global, 'pp.sym';
5f05dabc 44
c6af7a1a 45sub 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
63my %intrp;
64my %thread;
65
66readvars %intrp, 'intrpvar.h','I';
67readvars %thread, 'thrdvar.h','T';
22239a37 68readvars %globvar, 'perlvars.h','G';
c6af7a1a 69readvars %objvar, 'intrpvar.h','pi', 1;
d4cce5f1 70
71foreach 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 80foreach 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 89foreach 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 99sub undefine ($) {
100 my ($sym) = @_;
101 "#undef $sym\n";
102}
103
5f05dabc 104sub 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 110sub embed ($) {
111 my ($sym) = @_;
112 hide($sym, "Perl_$sym");
113}
c6af7a1a 114
22c35a8c 115sub embedobj ($) {
116 my ($sym) = @_;
117 hide($sym, $sym =~ /^perl_/i ? "CPerlObj::$sym" : "CPerlObj::Perl_$sym");
118}
c6af7a1a 119
120sub objxsub_func ($) {
121 my ($sym) = @_;
122 undefine($sym) . hide($sym, $sym =~ /^perl_/i
123 ? "pPerl->$sym"
124 : "pPerl->Perl_$sym");
125}
126
127sub objxsub_var ($) {
128 my ($sym) = @_;
129 undefine("PL_$sym") . hide("PL_$sym", "pPerl->PL_$sym");
130}
131
3280af22 132sub embedvar ($) {
133 my ($sym) = @_;
134# hide($sym, "Perl_$sym");
135 return '';
136}
137
d4cce5f1 138sub multon ($$$) {
139 my ($sym,$pre,$ptr) = @_;
3280af22 140 hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc 141}
d4cce5f1 142sub multoff ($$) {
143 my ($sym,$pre) = @_;
533c011a 144 return hide("PL_$pre$sym", "PL_$sym");
5f05dabc 145}
146
147unlink 'embed.h';
148open(EM, '> embed.h')
149 or die "Can't create embed.h: $!\n";
e50aee73 150
151print 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 165END
166
5f05dabc 167for $sym (sort keys %global) {
dc86dda3 168 print EM embed($sym);
e50aee73 169}
170
e50aee73 171print EM <<'END';
172
22c35a8c 173#else /* PERL_OBJECT */
174
175END
176
177# XXX these should be in a *.sym file
c6af7a1a 178my @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
067f92a0 261 free_closures
22c35a8c 262 save_lines
263 doeval
a6c40364 264 doopen_pmc
bda4119b 265 sv_ncmp
266 sv_i_ncmp
267 amagic_ncmp
268 amagic_i_ncmp
22c35a8c 269 amagic_cmp
270 amagic_cmp_locale
271 mul128
272 is_an_int
273 div128
22c35a8c 274 check_uni
275 force_next
276 force_version
277 force_word
278 tokeq
279 scan_const
280 scan_formline
281 scan_heredoc
282 scan_ident
283 scan_inputsymbol
284 scan_pat
285 scan_str
286 scan_subst
287 scan_trans
288 scan_word
289 skipspace
290 checkcomma
291 force_ident
292 incline
293 intuit_method
294 intuit_more
295 lop
296 missingterm
297 no_op
298 set_csh
299 sublex_done
300 sublex_push
301 sublex_start
302 uni
303 filter_gets
304 new_constant
305 ao
306 depcom
307 win32_textfilter
308 incl_perldb
309 isa_lookup
310 get_db_sub
311 list_assignment
312 bad_type
313 modkids
314 no_fh_allowed
7a52d87a 315 no_bareword_allowed
22c35a8c 316 scalarboolean
317 too_few_arguments
318 too_many_arguments
319 null
320 pad_findlex
321 newDEFSVOP
322 gv_ename
323 cv_clone2
324 find_beginning
325 forbid_setid
326 incpush
327 init_interp
328 init_ids
329 init_debugger
330 init_lexer
331 init_main_stash
332 init_perllib
333 init_postdump_symbols
334 init_predump_symbols
335 my_exit_jump
336 nuke_stacks
337 open_script
338 usage
339 validate_suid
340 emulate_eaccess
341 reg
342 reganode
343 regatom
344 regbranch
345 regc
346 reguni
347 regclass
348 regclassutf8
349 regcurly
350 reg_node
351 regpiece
352 reginsert
353 regoptail
354 regset
355 regtail
356 regwhite
357 nextchar
358 dumpuntil
359 scan_commit
360 study_chunk
361 add_data
362 re_croak2
eb1ab10a 363 regpposixcc
4327152a 364 clear_re
22c35a8c 365 regmatch
366 regrepeat
367 regrepeat_hard
368 regtry
369 reginclass
370 reginclassutf8
371 regcppush
372 regcppop
373 regcp_set_to
374 cache_re
9661b544 375 restore_pos
22c35a8c 376 reghop
377 reghopmaybe
378 dump
379 do_aspawn
380 debprof
22c35a8c 381 new_logop
bda4119b 382 simplify_sort
35cd451c 383 is_handle_constructor
810b8aa5 384 sv_add_backref
385 sv_del_backref
22c35a8c 386 do_trans_CC_simple
387 do_trans_CC_count
388 do_trans_CC_complex
389 do_trans_UU_simple
390 do_trans_UU_count
391 do_trans_UU_complex
392 do_trans_UC_simple
393 do_trans_CU_simple
394 do_trans_UC_trivial
395 do_trans_CU_trivial
396 unwind_handler_stack
397 restore_magic
398 restore_rsfp
399 restore_expect
400 restore_lex_expect
22c35a8c 401 del_sv
22c35a8c 402);
403
c6af7a1a 404for $sym (sort(keys(%global),@staticfuncs)) {
22c35a8c 405 print EM embedobj($sym);
406}
407
408print EM <<'END';
409
410#endif /* PERL_OBJECT */
e50aee73 411
db5cf5a9 412/* compatibility stubs */
413
414#define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,(IV)ptr)
415#define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
416
d4cce5f1 417END
418
419close(EM);
420
421unlink 'embedvar.h';
422open(EM, '> embedvar.h')
423 or die "Can't create embedvar.h: $!\n";
424
425print EM <<'END';
426/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
22c35a8c 427 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
c6af7a1a 428 perlvars.h and thrdvar.h. Any changes made here will be lost!
d4cce5f1 429*/
430
431/* (Doing namespace management portably in C is really gross.) */
432
5f05dabc 433/* Put interpreter-specific symbols into a struct? */
e50aee73 434
435#ifdef MULTIPLICITY
436
d4cce5f1 437#ifndef USE_THREADS
438/* If we do not have threads then per-thread vars are per-interpreter */
439
e50aee73 440END
441
d4cce5f1 442for $sym (sort keys %thread) {
8f872242 443 print EM multon($sym,'T','PL_curinterp->');
d4cce5f1 444}
445
446print EM <<'END';
447
448#endif /* !USE_THREADS */
449
450/* These are always per-interpreter if there is more than one */
451
452END
453
454for $sym (sort keys %intrp) {
8f872242 455 print EM multon($sym,'I','PL_curinterp->');
760ac839 456}
760ac839 457
55497cff 458print EM <<'END';
459
5f05dabc 460#else /* !MULTIPLICITY */
55497cff 461
462END
760ac839 463
d4cce5f1 464for $sym (sort keys %intrp) {
465 print EM multoff($sym,'I');
e50aee73 466}
e50aee73 467
56d28764 468print EM <<'END';
469
d4cce5f1 470#ifndef USE_THREADS
471
472END
473
474for $sym (sort keys %thread) {
475 print EM multoff($sym,'T');
476}
477
478print EM <<'END';
479
480#endif /* USE_THREADS */
481
482/* Hide what would have been interpreter-specific symbols? */
5f05dabc 483
56d28764 484END
e50aee73 485
d4cce5f1 486for $sym (sort keys %intrp) {
3280af22 487 print EM embedvar($sym);
d4cce5f1 488}
489
490print EM <<'END';
491
492#ifndef USE_THREADS
493
494END
495
496for $sym (sort keys %thread) {
3280af22 497 print EM embedvar($sym);
5f05dabc 498}
499
500print EM <<'END';
501
d4cce5f1 502#endif /* USE_THREADS */
e50aee73 503#endif /* MULTIPLICITY */
d4cce5f1 504
505/* Now same trickey for per-thread variables */
506
507#ifdef USE_THREADS
508
509END
510
511for $sym (sort keys %thread) {
22239a37 512 print EM multon($sym,'T','thr->');
d4cce5f1 513}
514
515print EM <<'END';
516
517#endif /* USE_THREADS */
518
22239a37 519#ifdef PERL_GLOBAL_STRUCT
520
521END
522
523for $sym (sort keys %globvar) {
533c011a 524 print EM multon($sym,'G','PL_Vars.');
22239a37 525}
526
527print EM <<'END';
528
529#else /* !PERL_GLOBAL_STRUCT */
530
531END
532
533for $sym (sort keys %globvar) {
534 print EM multoff($sym,'G');
535}
536
537print EM <<'END';
538
22239a37 539END
540
541for $sym (sort keys %globvar) {
3280af22 542 print EM embedvar($sym);
22239a37 543}
544
545print EM <<'END';
546
22239a37 547#endif /* PERL_GLOBAL_STRUCT */
548
e50aee73 549END
550
84fee439 551print EM <<'END';
552
db5cf5a9 553#ifdef PERL_POLLUTE /* disabled by default in 5.006 */
84fee439 554
555END
556
557for $sym (sort @extvars) {
558 print EM hide($sym,"PL_$sym");
559}
560
561print EM <<'END';
562
db5cf5a9 563#endif /* PERL_POLLUTE */
84fee439 564END
565
566
3fe35a81 567close(EM);
c6af7a1a 568
569unlink 'objXSUB.h';
570open(OBX, '> objXSUB.h')
571 or die "Can't create objXSUB.h: $!\n";
572
573print OBX <<'EOT';
574/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
575 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
576 perlvars.h and thrdvar.h. Any changes made here will be lost!
577*/
578
579#ifndef __objXSUB_h__
580#define __objXSUB_h__
581
582/* Variables */
583
584EOT
585
586foreach my $sym (sort(keys(%intrp),
587 keys(%thread),
588 keys(%globvar),
589 keys(%objvar)))
590{
591 print OBX objxsub_var($sym);
592}
593
594print OBX <<'EOT';
595
596/* Functions */
597
598EOT
599
600
601for $sym (sort(keys(%global),@staticfuncs)) {
602 print OBX objxsub_func($sym);
603}
604
605
606print OBX <<'EOT';
607
608#endif /* __objXSUB_h__ */
609EOT
610
611close(OBX);