This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove duplicate code and an extra branch in sv_setsv() and
[perl5.git] / embed.pl
CommitLineData
5f05dabc 1#!/usr/bin/perl -w
e50aee73 2
5f05dabc
PP
3require 5.003;
4
709f4e38
GS
5# XXX others that may need adding
6# warnhook
7# hints
8# copline
84fee439
NIS
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
NIS
13 curstash DBsub DBsingle debstash
14 rsfp
15 stdingv
6b88bc9c
GS
16 defgv
17 errgv
3070f6ec
GS
18 rsfp_filters
19 perldb
709f4e38
GS
20 diehook
21 dirty
22 perl_destruct_level
84fee439
NIS
23 );
24
5f05dabc
PP
25sub readsyms (\%$) {
26 my ($syms, $file) = @_;
5f05dabc
PP
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
GS
33 my $sym = $1;
34 warn "duplicate symbol $sym while processing $file\n"
35 if exists $$syms{$sym};
36 $$syms{$sym} = 1;
5f05dabc
PP
37 }
38 }
39 close(FILE);
40}
41
42readsyms %global, 'global.sym';
22c35a8c 43readsyms %global, 'pp.sym';
5f05dabc 44
c6af7a1a
GS
45sub readvars(\%$$@) {
46 my ($syms, $file,$pre,$keep_pre) = @_;
d4cce5f1
NIS
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
GS
55 warn "duplicate symbol $sym while processing $file\n"
56 if exists $$syms{$sym};
57 $$syms{$sym} = 1;
d4cce5f1
NIS
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
NIS
70
71foreach my $sym (sort keys %intrp)
72 {
d4cce5f1
NIS
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
NIS
77 }
78 }
79
22239a37
NIS
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
NIS
86 }
87 }
88
d4cce5f1
NIS
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
NIS
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
NIS
96 }
97 }
98
c6af7a1a
GS
99sub undefine ($) {
100 my ($sym) = @_;
101 "#undef $sym\n";
102}
103
5f05dabc
PP
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
PP
110sub embed ($) {
111 my ($sym) = @_;
112 hide($sym, "Perl_$sym");
113}
c6af7a1a 114
22c35a8c
GS
115sub embedobj ($) {
116 my ($sym) = @_;
117 hide($sym, $sym =~ /^perl_/i ? "CPerlObj::$sym" : "CPerlObj::Perl_$sym");
118}
c6af7a1a
GS
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
NIS
132sub embedvar ($) {
133 my ($sym) = @_;
134# hide($sym, "Perl_$sym");
135 return '';
136}
137
d4cce5f1
NIS
138sub multon ($$$) {
139 my ($sym,$pre,$ptr) = @_;
3280af22 140 hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc 141}
d4cce5f1
NIS
142sub multoff ($$) {
143 my ($sym,$pre) = @_;
533c011a 144 return hide("PL_$pre$sym", "PL_$sym");
5f05dabc
PP
145}
146
147unlink 'embed.h';
148open(EM, '> embed.h')
149 or die "Can't create embed.h: $!\n";
e50aee73
AD
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
AD
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
AD
165END
166
5f05dabc 167for $sym (sort keys %global) {
dc86dda3 168 print EM embed($sym);
e50aee73
AD
169}
170
e50aee73
AD
171print EM <<'END';
172
22c35a8c
GS
173#else /* PERL_OBJECT */
174
175END
176
177# XXX these should be in a *.sym file
c6af7a1a 178my @staticfuncs = qw(
22c35a8c
GS
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
228 sv_mortalgrow
229 sv_unglob
22c35a8c
GS
230 avhv_index_sv
231 do_report_used
232 do_clean_objs
233 do_clean_named_objs
234 do_clean_all
235 not_a_number
236 my_safemalloc
237 visit
238 qsortsv
239 sortcv
240 save_magic
241 magic_methpack
242 magic_methcall
243 magic_methcall
244 doform
245 doencodes
246 refto
247 seed
248 docatch
249 dofindlabel
250 doparseform
251 dopoptoeval
252 dopoptolabel
253 dopoptoloop
254 dopoptosub
255 dopoptosub_at
256 save_lines
257 doeval
bda4119b
GS
258 sv_ncmp
259 sv_i_ncmp
260 amagic_ncmp
261 amagic_i_ncmp
22c35a8c
GS
262 amagic_cmp
263 amagic_cmp_locale
264 mul128
265 is_an_int
266 div128
267 runops_standard
268 runops_debug
269 check_uni
270 force_next
271 force_version
272 force_word
273 tokeq
274 scan_const
275 scan_formline
276 scan_heredoc
277 scan_ident
278 scan_inputsymbol
279 scan_pat
280 scan_str
281 scan_subst
282 scan_trans
283 scan_word
284 skipspace
285 checkcomma
286 force_ident
287 incline
288 intuit_method
289 intuit_more
290 lop
291 missingterm
292 no_op
293 set_csh
294 sublex_done
295 sublex_push
296 sublex_start
297 uni
298 filter_gets
299 new_constant
300 ao
301 depcom
302 win32_textfilter
303 incl_perldb
304 isa_lookup
305 get_db_sub
306 list_assignment
307 bad_type
308 modkids
309 no_fh_allowed
310 scalarboolean
311 too_few_arguments
312 too_many_arguments
313 null
314 pad_findlex
315 newDEFSVOP
316 gv_ename
317 cv_clone2
318 find_beginning
319 forbid_setid
320 incpush
321 init_interp
322 init_ids
323 init_debugger
324 init_lexer
325 init_main_stash
326 init_perllib
327 init_postdump_symbols
328 init_predump_symbols
329 my_exit_jump
330 nuke_stacks
331 open_script
332 usage
333 validate_suid
334 emulate_eaccess
335 reg
336 reganode
337 regatom
338 regbranch
339 regc
340 reguni
341 regclass
342 regclassutf8
343 regcurly
344 reg_node
345 regpiece
346 reginsert
347 regoptail
348 regset
349 regtail
350 regwhite
351 nextchar
352 dumpuntil
353 scan_commit
354 study_chunk
355 add_data
356 re_croak2
eb1ab10a 357 regpposixcc
4327152a 358 clear_re
22c35a8c
GS
359 regmatch
360 regrepeat
361 regrepeat_hard
362 regtry
363 reginclass
364 reginclassutf8
365 regcppush
366 regcppop
367 regcp_set_to
368 cache_re
9661b544 369 restore_pos
22c35a8c
GS
370 reghop
371 reghopmaybe
372 dump
373 do_aspawn
374 debprof
375 bset_obj_store
376 new_logop
bda4119b 377 simplify_sort
35cd451c 378 is_handle_constructor
22c35a8c
GS
379 do_trans_CC_simple
380 do_trans_CC_count
381 do_trans_CC_complex
382 do_trans_UU_simple
383 do_trans_UU_count
384 do_trans_UU_complex
385 do_trans_UC_simple
386 do_trans_CU_simple
387 do_trans_UC_trivial
388 do_trans_CU_trivial
389 unwind_handler_stack
390 restore_magic
391 restore_rsfp
392 restore_expect
393 restore_lex_expect
394 yydestruct
395 del_sv
396 fprintf
397);
398
c6af7a1a 399for $sym (sort(keys(%global),@staticfuncs)) {
22c35a8c
GS
400 print EM embedobj($sym);
401}
402
403print EM <<'END';
404
405#endif /* PERL_OBJECT */
e50aee73 406
db5cf5a9
GS
407/* compatibility stubs */
408
409#define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,(IV)ptr)
410#define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
411
d4cce5f1
NIS
412END
413
414close(EM);
415
416unlink 'embedvar.h';
417open(EM, '> embedvar.h')
418 or die "Can't create embedvar.h: $!\n";
419
420print EM <<'END';
421/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
22c35a8c 422 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
c6af7a1a 423 perlvars.h and thrdvar.h. Any changes made here will be lost!
d4cce5f1
NIS
424*/
425
426/* (Doing namespace management portably in C is really gross.) */
427
5f05dabc 428/* Put interpreter-specific symbols into a struct? */
e50aee73
AD
429
430#ifdef MULTIPLICITY
431
d4cce5f1
NIS
432#ifndef USE_THREADS
433/* If we do not have threads then per-thread vars are per-interpreter */
434
e50aee73
AD
435END
436
d4cce5f1 437for $sym (sort keys %thread) {
8f872242 438 print EM multon($sym,'T','PL_curinterp->');
d4cce5f1
NIS
439}
440
441print EM <<'END';
442
443#endif /* !USE_THREADS */
444
445/* These are always per-interpreter if there is more than one */
446
447END
448
449for $sym (sort keys %intrp) {
8f872242 450 print EM multon($sym,'I','PL_curinterp->');
760ac839 451}
760ac839 452
55497cff
PP
453print EM <<'END';
454
5f05dabc 455#else /* !MULTIPLICITY */
55497cff
PP
456
457END
760ac839 458
d4cce5f1
NIS
459for $sym (sort keys %intrp) {
460 print EM multoff($sym,'I');
e50aee73 461}
e50aee73 462
56d28764
CS
463print EM <<'END';
464
d4cce5f1
NIS
465#ifndef USE_THREADS
466
467END
468
469for $sym (sort keys %thread) {
470 print EM multoff($sym,'T');
471}
472
473print EM <<'END';
474
475#endif /* USE_THREADS */
476
477/* Hide what would have been interpreter-specific symbols? */
5f05dabc 478
56d28764 479END
e50aee73 480
d4cce5f1 481for $sym (sort keys %intrp) {
3280af22 482 print EM embedvar($sym);
d4cce5f1
NIS
483}
484
485print EM <<'END';
486
487#ifndef USE_THREADS
488
489END
490
491for $sym (sort keys %thread) {
3280af22 492 print EM embedvar($sym);
5f05dabc
PP
493}
494
495print EM <<'END';
496
d4cce5f1 497#endif /* USE_THREADS */
e50aee73 498#endif /* MULTIPLICITY */
d4cce5f1
NIS
499
500/* Now same trickey for per-thread variables */
501
502#ifdef USE_THREADS
503
504END
505
506for $sym (sort keys %thread) {
22239a37 507 print EM multon($sym,'T','thr->');
d4cce5f1
NIS
508}
509
510print EM <<'END';
511
512#endif /* USE_THREADS */
513
22239a37
NIS
514#ifdef PERL_GLOBAL_STRUCT
515
516END
517
518for $sym (sort keys %globvar) {
533c011a 519 print EM multon($sym,'G','PL_Vars.');
22239a37
NIS
520}
521
522print EM <<'END';
523
524#else /* !PERL_GLOBAL_STRUCT */
525
526END
527
528for $sym (sort keys %globvar) {
529 print EM multoff($sym,'G');
530}
531
532print EM <<'END';
533
22239a37
NIS
534END
535
536for $sym (sort keys %globvar) {
3280af22 537 print EM embedvar($sym);
22239a37
NIS
538}
539
540print EM <<'END';
541
22239a37
NIS
542#endif /* PERL_GLOBAL_STRUCT */
543
e50aee73
AD
544END
545
84fee439
NIS
546print EM <<'END';
547
db5cf5a9 548#ifdef PERL_POLLUTE /* disabled by default in 5.006 */
84fee439
NIS
549
550END
551
552for $sym (sort @extvars) {
553 print EM hide($sym,"PL_$sym");
554}
555
556print EM <<'END';
557
db5cf5a9 558#endif /* PERL_POLLUTE */
84fee439
NIS
559END
560
561
3fe35a81 562close(EM);
c6af7a1a
GS
563
564unlink 'objXSUB.h';
565open(OBX, '> objXSUB.h')
566 or die "Can't create objXSUB.h: $!\n";
567
568print OBX <<'EOT';
569/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
570 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
571 perlvars.h and thrdvar.h. Any changes made here will be lost!
572*/
573
574#ifndef __objXSUB_h__
575#define __objXSUB_h__
576
577/* Variables */
578
579EOT
580
581foreach my $sym (sort(keys(%intrp),
582 keys(%thread),
583 keys(%globvar),
584 keys(%objvar)))
585{
586 print OBX objxsub_var($sym);
587}
588
589print OBX <<'EOT';
590
591/* Functions */
592
593EOT
594
595
596for $sym (sort(keys(%global),@staticfuncs)) {
597 print OBX objxsub_func($sym);
598}
599
600
601print OBX <<'EOT';
602
603#endif /* __objXSUB_h__ */
604EOT
605
606close(OBX);