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