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