This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
-x should be C<-x>, reported by Gerben Wierda.
[perl5.git] / embed.pl
CommitLineData
5f05dabc 1#!/usr/bin/perl -w
e50aee73 2
5f05dabc 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 24sub 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
GS
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
41readsyms %global, 'global.sym';
22c35a8c 42readsyms %global, 'pp.sym';
5f05dabc 43
d4cce5f1
NIS
44sub readvars(\%$$) {
45 my ($syms, $file,$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
GS
52 my $sym = $1;
53 warn "duplicate symbol $sym while processing $file\n"
54 if exists $$syms{$sym};
55 $$syms{$sym} = 1;
d4cce5f1
NIS
56 }
57 }
58 close(FILE);
59}
60
61my %intrp;
62my %thread;
63
64readvars %intrp, 'intrpvar.h','I';
65readvars %thread, 'thrdvar.h','T';
22239a37 66readvars %globvar, 'perlvars.h','G';
d4cce5f1
NIS
67
68foreach my $sym (sort keys %intrp)
69 {
d4cce5f1
NIS
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
NIS
74 }
75 }
76
22239a37
NIS
77foreach 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
NIS
83 }
84 }
85
d4cce5f1
NIS
86foreach my $sym (sort keys %thread)
87 {
34b58025 88 warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
d4cce5f1
NIS
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
NIS
93 }
94 }
95
5f05dabc 96sub 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}
101sub embed ($) {
102 my ($sym) = @_;
103 hide($sym, "Perl_$sym");
104}
22c35a8c
GS
105sub embedobj ($) {
106 my ($sym) = @_;
107 hide($sym, $sym =~ /^perl_/i ? "CPerlObj::$sym" : "CPerlObj::Perl_$sym");
108}
3280af22
NIS
109sub embedvar ($) {
110 my ($sym) = @_;
111# hide($sym, "Perl_$sym");
112 return '';
113}
114
d4cce5f1
NIS
115sub multon ($$$) {
116 my ($sym,$pre,$ptr) = @_;
3280af22 117 hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc 118}
d4cce5f1
NIS
119sub multoff ($$) {
120 my ($sym,$pre) = @_;
533c011a 121 return hide("PL_$pre$sym", "PL_$sym");
5f05dabc 122}
123
124unlink 'embed.h';
125open(EM, '> embed.h')
126 or die "Can't create embed.h: $!\n";
e50aee73
AD
127
128print 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
AD
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
AD
142END
143
5f05dabc 144for $sym (sort keys %global) {
dc86dda3 145 print EM embed($sym);
e50aee73
AD
146}
147
e50aee73
AD
148print EM <<'END';
149
22c35a8c
GS
150#else /* PERL_OBJECT */
151
152END
153
154# XXX these should be in a *.sym file
155my @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
22c35a8c 368for $sym (sort(keys(%global),@extras)) {
22c35a8c
GS
369 print EM embedobj($sym);
370}
371
372print EM <<'END';
373
374#endif /* PERL_OBJECT */
e50aee73 375
d4cce5f1
NIS
376END
377
378close(EM);
379
380unlink 'embedvar.h';
381open(EM, '> embedvar.h')
382 or die "Can't create embedvar.h: $!\n";
383
384print EM <<'END';
385/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
22c35a8c 386 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
d4cce5f1
NIS
387 and thrdvar.h. Any changes made here will be lost!
388*/
389
390/* (Doing namespace management portably in C is really gross.) */
391
5f05dabc 392/* Put interpreter-specific symbols into a struct? */
e50aee73
AD
393
394#ifdef MULTIPLICITY
395
d4cce5f1
NIS
396#ifndef USE_THREADS
397/* If we do not have threads then per-thread vars are per-interpreter */
398
e50aee73
AD
399END
400
d4cce5f1 401for $sym (sort keys %thread) {
8f872242 402 print EM multon($sym,'T','PL_curinterp->');
d4cce5f1
NIS
403}
404
405print EM <<'END';
406
407#endif /* !USE_THREADS */
408
409/* These are always per-interpreter if there is more than one */
410
411END
412
413for $sym (sort keys %intrp) {
8f872242 414 print EM multon($sym,'I','PL_curinterp->');
760ac839 415}
760ac839 416
55497cff 417print EM <<'END';
418
5f05dabc 419#else /* !MULTIPLICITY */
55497cff 420
421END
760ac839 422
d4cce5f1
NIS
423for $sym (sort keys %intrp) {
424 print EM multoff($sym,'I');
e50aee73 425}
e50aee73 426
56d28764
CS
427print EM <<'END';
428
d4cce5f1
NIS
429#ifndef USE_THREADS
430
431END
432
433for $sym (sort keys %thread) {
434 print EM multoff($sym,'T');
435}
436
437print EM <<'END';
438
439#endif /* USE_THREADS */
440
441/* Hide what would have been interpreter-specific symbols? */
5f05dabc 442
56d28764 443END
e50aee73 444
d4cce5f1 445for $sym (sort keys %intrp) {
3280af22 446 print EM embedvar($sym);
d4cce5f1
NIS
447}
448
449print EM <<'END';
450
451#ifndef USE_THREADS
452
453END
454
455for $sym (sort keys %thread) {
3280af22 456 print EM embedvar($sym);
5f05dabc 457}
458
459print EM <<'END';
460
d4cce5f1 461#endif /* USE_THREADS */
e50aee73 462#endif /* MULTIPLICITY */
d4cce5f1
NIS
463
464/* Now same trickey for per-thread variables */
465
466#ifdef USE_THREADS
467
468END
469
470for $sym (sort keys %thread) {
22239a37 471 print EM multon($sym,'T','thr->');
d4cce5f1
NIS
472}
473
474print EM <<'END';
475
476#endif /* USE_THREADS */
477
22239a37
NIS
478#ifdef PERL_GLOBAL_STRUCT
479
480END
481
482for $sym (sort keys %globvar) {
533c011a 483 print EM multon($sym,'G','PL_Vars.');
22239a37
NIS
484}
485
486print EM <<'END';
487
488#else /* !PERL_GLOBAL_STRUCT */
489
490END
491
492for $sym (sort keys %globvar) {
493 print EM multoff($sym,'G');
494}
495
496print EM <<'END';
497
22239a37
NIS
498END
499
500for $sym (sort keys %globvar) {
3280af22 501 print EM embedvar($sym);
22239a37
NIS
502}
503
504print EM <<'END';
505
22239a37
NIS
506#endif /* PERL_GLOBAL_STRUCT */
507
e50aee73
AD
508END
509
84fee439
NIS
510print EM <<'END';
511
1ba53475 512#ifdef PERL_POLLUTE /* unsupported in 5.006 */
84fee439
NIS
513
514END
515
516for $sym (sort @extvars) {
517 print EM hide($sym,"PL_$sym");
518}
519
520print EM <<'END';
521
522#endif /* MIN_PERL_DEFINE */
523END
524
525
3fe35a81 526close(EM);