These should've been already in #2803.
[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
228 sv_mortalgrow
229 sv_unglob
230 sv_check_thinkfirst
231 avhv_index_sv
232 do_report_used
233 do_clean_objs
234 do_clean_named_objs
235 do_clean_all
236 not_a_number
237 my_safemalloc
238 visit
239 qsortsv
240 sortcv
241 save_magic
242 magic_methpack
243 magic_methcall
244 magic_methcall
245 doform
246 doencodes
247 refto
248 seed
249 docatch
250 dofindlabel
251 doparseform
252 dopoptoeval
253 dopoptolabel
254 dopoptoloop
255 dopoptosub
256 dopoptosub_at
257 save_lines
258 doeval
bda4119b 259 sv_ncmp
260 sv_i_ncmp
261 amagic_ncmp
262 amagic_i_ncmp
22c35a8c 263 amagic_cmp
264 amagic_cmp_locale
265 mul128
266 is_an_int
267 div128
268 runops_standard
269 runops_debug
270 check_uni
271 force_next
272 force_version
273 force_word
274 tokeq
275 scan_const
276 scan_formline
277 scan_heredoc
278 scan_ident
279 scan_inputsymbol
280 scan_pat
281 scan_str
282 scan_subst
283 scan_trans
284 scan_word
285 skipspace
286 checkcomma
287 force_ident
288 incline
289 intuit_method
290 intuit_more
291 lop
292 missingterm
293 no_op
294 set_csh
295 sublex_done
296 sublex_push
297 sublex_start
298 uni
299 filter_gets
300 new_constant
301 ao
302 depcom
303 win32_textfilter
304 incl_perldb
305 isa_lookup
306 get_db_sub
307 list_assignment
308 bad_type
309 modkids
310 no_fh_allowed
311 scalarboolean
312 too_few_arguments
313 too_many_arguments
314 null
315 pad_findlex
316 newDEFSVOP
317 gv_ename
318 cv_clone2
319 find_beginning
320 forbid_setid
321 incpush
322 init_interp
323 init_ids
324 init_debugger
325 init_lexer
326 init_main_stash
327 init_perllib
328 init_postdump_symbols
329 init_predump_symbols
330 my_exit_jump
331 nuke_stacks
332 open_script
333 usage
334 validate_suid
335 emulate_eaccess
336 reg
337 reganode
338 regatom
339 regbranch
340 regc
341 reguni
342 regclass
343 regclassutf8
344 regcurly
345 reg_node
346 regpiece
347 reginsert
348 regoptail
349 regset
350 regtail
351 regwhite
352 nextchar
353 dumpuntil
354 scan_commit
355 study_chunk
356 add_data
357 re_croak2
eb1ab10a 358 regpposixcc
22c35a8c 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 370 reghop
371 reghopmaybe
372 dump
373 do_aspawn
374 debprof
375 bset_obj_store
376 new_logop
bda4119b 377 simplify_sort
22c35a8c 378 do_trans_CC_simple
379 do_trans_CC_count
380 do_trans_CC_complex
381 do_trans_UU_simple
382 do_trans_UU_count
383 do_trans_UU_complex
384 do_trans_UC_simple
385 do_trans_CU_simple
386 do_trans_UC_trivial
387 do_trans_CU_trivial
388 unwind_handler_stack
389 restore_magic
390 restore_rsfp
391 restore_expect
392 restore_lex_expect
393 yydestruct
394 del_sv
395 fprintf
396);
397
c6af7a1a 398for $sym (sort(keys(%global),@staticfuncs)) {
22c35a8c 399 print EM embedobj($sym);
400}
401
402print EM <<'END';
403
404#endif /* PERL_OBJECT */
e50aee73 405
d4cce5f1 406END
407
408close(EM);
409
410unlink 'embedvar.h';
411open(EM, '> embedvar.h')
412 or die "Can't create embedvar.h: $!\n";
413
414print EM <<'END';
415/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
22c35a8c 416 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
c6af7a1a 417 perlvars.h and thrdvar.h. Any changes made here will be lost!
d4cce5f1 418*/
419
420/* (Doing namespace management portably in C is really gross.) */
421
5f05dabc 422/* Put interpreter-specific symbols into a struct? */
e50aee73 423
424#ifdef MULTIPLICITY
425
d4cce5f1 426#ifndef USE_THREADS
427/* If we do not have threads then per-thread vars are per-interpreter */
428
e50aee73 429END
430
d4cce5f1 431for $sym (sort keys %thread) {
8f872242 432 print EM multon($sym,'T','PL_curinterp->');
d4cce5f1 433}
434
435print EM <<'END';
436
437#endif /* !USE_THREADS */
438
439/* These are always per-interpreter if there is more than one */
440
441END
442
443for $sym (sort keys %intrp) {
8f872242 444 print EM multon($sym,'I','PL_curinterp->');
760ac839 445}
760ac839 446
55497cff 447print EM <<'END';
448
5f05dabc 449#else /* !MULTIPLICITY */
55497cff 450
451END
760ac839 452
d4cce5f1 453for $sym (sort keys %intrp) {
454 print EM multoff($sym,'I');
e50aee73 455}
e50aee73 456
56d28764 457print EM <<'END';
458
d4cce5f1 459#ifndef USE_THREADS
460
461END
462
463for $sym (sort keys %thread) {
464 print EM multoff($sym,'T');
465}
466
467print EM <<'END';
468
469#endif /* USE_THREADS */
470
471/* Hide what would have been interpreter-specific symbols? */
5f05dabc 472
56d28764 473END
e50aee73 474
d4cce5f1 475for $sym (sort keys %intrp) {
3280af22 476 print EM embedvar($sym);
d4cce5f1 477}
478
479print EM <<'END';
480
481#ifndef USE_THREADS
482
483END
484
485for $sym (sort keys %thread) {
3280af22 486 print EM embedvar($sym);
5f05dabc 487}
488
489print EM <<'END';
490
d4cce5f1 491#endif /* USE_THREADS */
e50aee73 492#endif /* MULTIPLICITY */
d4cce5f1 493
494/* Now same trickey for per-thread variables */
495
496#ifdef USE_THREADS
497
498END
499
500for $sym (sort keys %thread) {
22239a37 501 print EM multon($sym,'T','thr->');
d4cce5f1 502}
503
504print EM <<'END';
505
506#endif /* USE_THREADS */
507
22239a37 508#ifdef PERL_GLOBAL_STRUCT
509
510END
511
512for $sym (sort keys %globvar) {
533c011a 513 print EM multon($sym,'G','PL_Vars.');
22239a37 514}
515
516print EM <<'END';
517
518#else /* !PERL_GLOBAL_STRUCT */
519
520END
521
522for $sym (sort keys %globvar) {
523 print EM multoff($sym,'G');
524}
525
526print EM <<'END';
527
22239a37 528END
529
530for $sym (sort keys %globvar) {
3280af22 531 print EM embedvar($sym);
22239a37 532}
533
534print EM <<'END';
535
22239a37 536#endif /* PERL_GLOBAL_STRUCT */
537
e50aee73 538END
539
84fee439 540print EM <<'END';
541
1ba53475 542#ifdef PERL_POLLUTE /* unsupported in 5.006 */
84fee439 543
544END
545
546for $sym (sort @extvars) {
547 print EM hide($sym,"PL_$sym");
548}
549
550print EM <<'END';
551
552#endif /* MIN_PERL_DEFINE */
553END
554
555
3fe35a81 556close(EM);
c6af7a1a 557
558unlink 'objXSUB.h';
559open(OBX, '> objXSUB.h')
560 or die "Can't create objXSUB.h: $!\n";
561
562print OBX <<'EOT';
563/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
564 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
565 perlvars.h and thrdvar.h. Any changes made here will be lost!
566*/
567
568#ifndef __objXSUB_h__
569#define __objXSUB_h__
570
571/* Variables */
572
573EOT
574
575foreach my $sym (sort(keys(%intrp),
576 keys(%thread),
577 keys(%globvar),
578 keys(%objvar)))
579{
580 print OBX objxsub_var($sym);
581}
582
583print OBX <<'EOT';
584
585/* Functions */
586
587EOT
588
589
590for $sym (sort(keys(%global),@staticfuncs)) {
591 print OBX objxsub_func($sym);
592}
593
594
595print OBX <<'EOT';
596
597#endif /* __objXSUB_h__ */
598EOT
599
600close(OBX);