applied suggested patch with PERL_OBJECT tweaks
[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
12 curstash DBsub DBsingle debstash
13 rsfp
14 stdingv
6b88bc9c 15 defgv
16 errgv
3070f6ec 17 rsfp_filters
18 perldb
709f4e38 19 diehook
20 dirty
21 perl_destruct_level
84fee439 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 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
c6af7a1a 44sub readvars(\%$$@) {
45 my ($syms, $file,$pre,$keep_pre) = @_;
d4cce5f1 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 54 warn "duplicate symbol $sym while processing $file\n"
55 if exists $$syms{$sym};
56 $$syms{$sym} = 1;
d4cce5f1 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 69
70foreach my $sym (sort keys %intrp)
71 {
d4cce5f1 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 76 }
77 }
78
22239a37 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 85 }
86 }
87
d4cce5f1 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 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 95 }
96 }
97
c6af7a1a 98sub undefine ($) {
99 my ($sym) = @_;
100 "#undef $sym\n";
101}
102
5f05dabc 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 109sub embed ($) {
110 my ($sym) = @_;
111 hide($sym, "Perl_$sym");
112}
c6af7a1a 113
22c35a8c 114sub embedobj ($) {
115 my ($sym) = @_;
116 hide($sym, $sym =~ /^perl_/i ? "CPerlObj::$sym" : "CPerlObj::Perl_$sym");
117}
c6af7a1a 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 131sub embedvar ($) {
132 my ($sym) = @_;
133# hide($sym, "Perl_$sym");
134 return '';
135}
136
d4cce5f1 137sub multon ($$$) {
138 my ($sym,$pre,$ptr) = @_;
3280af22 139 hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc 140}
d4cce5f1 141sub multoff ($$) {
142 my ($sym,$pre) = @_;
533c011a 143 return hide("PL_$pre$sym", "PL_$sym");
5f05dabc 144}
145
146unlink 'embed.h';
147open(EM, '> embed.h')
148 or die "Can't create embed.h: $!\n";
e50aee73 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 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 164END
165
5f05dabc 166for $sym (sort keys %global) {
dc86dda3 167 print EM embed($sym);
e50aee73 168}
169
e50aee73 170print EM <<'END';
171
22c35a8c 172#else /* PERL_OBJECT */
173
174END
175
176# XXX these should be in a *.sym file
c6af7a1a 177my @staticfuncs = qw(
22c35a8c 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
9661b544 363 restore_pos
22c35a8c 364 reghop
365 reghopmaybe
366 dump
367 do_aspawn
368 debprof
369 bset_obj_store
370 new_logop
371 do_trans_CC_simple
372 do_trans_CC_count
373 do_trans_CC_complex
374 do_trans_UU_simple
375 do_trans_UU_count
376 do_trans_UU_complex
377 do_trans_UC_simple
378 do_trans_CU_simple
379 do_trans_UC_trivial
380 do_trans_CU_trivial
381 unwind_handler_stack
382 restore_magic
383 restore_rsfp
384 restore_expect
385 restore_lex_expect
386 yydestruct
387 del_sv
388 fprintf
389);
390
c6af7a1a 391for $sym (sort(keys(%global),@staticfuncs)) {
22c35a8c 392 print EM embedobj($sym);
393}
394
395print EM <<'END';
396
397#endif /* PERL_OBJECT */
e50aee73 398
d4cce5f1 399END
400
401close(EM);
402
403unlink 'embedvar.h';
404open(EM, '> embedvar.h')
405 or die "Can't create embedvar.h: $!\n";
406
407print EM <<'END';
408/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
22c35a8c 409 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
c6af7a1a 410 perlvars.h and thrdvar.h. Any changes made here will be lost!
d4cce5f1 411*/
412
413/* (Doing namespace management portably in C is really gross.) */
414
5f05dabc 415/* Put interpreter-specific symbols into a struct? */
e50aee73 416
417#ifdef MULTIPLICITY
418
d4cce5f1 419#ifndef USE_THREADS
420/* If we do not have threads then per-thread vars are per-interpreter */
421
e50aee73 422END
423
d4cce5f1 424for $sym (sort keys %thread) {
8f872242 425 print EM multon($sym,'T','PL_curinterp->');
d4cce5f1 426}
427
428print EM <<'END';
429
430#endif /* !USE_THREADS */
431
432/* These are always per-interpreter if there is more than one */
433
434END
435
436for $sym (sort keys %intrp) {
8f872242 437 print EM multon($sym,'I','PL_curinterp->');
760ac839 438}
760ac839 439
55497cff 440print EM <<'END';
441
5f05dabc 442#else /* !MULTIPLICITY */
55497cff 443
444END
760ac839 445
d4cce5f1 446for $sym (sort keys %intrp) {
447 print EM multoff($sym,'I');
e50aee73 448}
e50aee73 449
56d28764 450print EM <<'END';
451
d4cce5f1 452#ifndef USE_THREADS
453
454END
455
456for $sym (sort keys %thread) {
457 print EM multoff($sym,'T');
458}
459
460print EM <<'END';
461
462#endif /* USE_THREADS */
463
464/* Hide what would have been interpreter-specific symbols? */
5f05dabc 465
56d28764 466END
e50aee73 467
d4cce5f1 468for $sym (sort keys %intrp) {
3280af22 469 print EM embedvar($sym);
d4cce5f1 470}
471
472print EM <<'END';
473
474#ifndef USE_THREADS
475
476END
477
478for $sym (sort keys %thread) {
3280af22 479 print EM embedvar($sym);
5f05dabc 480}
481
482print EM <<'END';
483
d4cce5f1 484#endif /* USE_THREADS */
e50aee73 485#endif /* MULTIPLICITY */
d4cce5f1 486
487/* Now same trickey for per-thread variables */
488
489#ifdef USE_THREADS
490
491END
492
493for $sym (sort keys %thread) {
22239a37 494 print EM multon($sym,'T','thr->');
d4cce5f1 495}
496
497print EM <<'END';
498
499#endif /* USE_THREADS */
500
22239a37 501#ifdef PERL_GLOBAL_STRUCT
502
503END
504
505for $sym (sort keys %globvar) {
533c011a 506 print EM multon($sym,'G','PL_Vars.');
22239a37 507}
508
509print EM <<'END';
510
511#else /* !PERL_GLOBAL_STRUCT */
512
513END
514
515for $sym (sort keys %globvar) {
516 print EM multoff($sym,'G');
517}
518
519print EM <<'END';
520
22239a37 521END
522
523for $sym (sort keys %globvar) {
3280af22 524 print EM embedvar($sym);
22239a37 525}
526
527print EM <<'END';
528
22239a37 529#endif /* PERL_GLOBAL_STRUCT */
530
e50aee73 531END
532
84fee439 533print EM <<'END';
534
1ba53475 535#ifdef PERL_POLLUTE /* unsupported in 5.006 */
84fee439 536
537END
538
539for $sym (sort @extvars) {
540 print EM hide($sym,"PL_$sym");
541}
542
543print EM <<'END';
544
545#endif /* MIN_PERL_DEFINE */
546END
547
548
3fe35a81 549close(EM);
c6af7a1a 550
551unlink 'objXSUB.h';
552open(OBX, '> objXSUB.h')
553 or die "Can't create objXSUB.h: $!\n";
554
555print OBX <<'EOT';
556/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
557 This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
558 perlvars.h and thrdvar.h. Any changes made here will be lost!
559*/
560
561#ifndef __objXSUB_h__
562#define __objXSUB_h__
563
564/* Variables */
565
566EOT
567
568foreach my $sym (sort(keys(%intrp),
569 keys(%thread),
570 keys(%globvar),
571 keys(%objvar)))
572{
573 print OBX objxsub_var($sym);
574}
575
576print OBX <<'EOT';
577
578/* Functions */
579
580EOT
581
582
583for $sym (sort(keys(%global),@staticfuncs)) {
584 print OBX objxsub_func($sym);
585}
586
587
588print OBX <<'EOT';
589
590#endif /* __objXSUB_h__ */
591EOT
592
593close(OBX);