[perl5.git] / embed.pl

#!/usr/bin/perl -w

require 5.003;

# XXX others that may need adding
#       warnhook
#       hints
#       copline
my @extvars = qw(sv_undef sv_yes sv_no na dowarn
                 curcop compiling 
                 tainting tainted stack_base stack_sp sv_arenaroot
                 curstash DBsub DBsingle debstash
                 rsfp 
                 stdingv
		 defgv
		 errgv
		 rsfp_filters
		 perldb
		 diehook
		 dirty
		 perl_destruct_level
                );

sub readsyms (\%$) {
    my ($syms, $file) = @_;
    local (*FILE, $_);
    open(FILE, "< $file")
	or die "embed.pl: Can't open $file: $!\n";
    while (<FILE>) {
	s/[ \t]*#.*//;		# Delete comments.
	if (/^\s*(\S+)\s*$/) {
	    my $sym = $1;
	    warn "duplicate symbol $sym while processing $file\n"
		if exists $$syms{$sym};
	    $$syms{$sym} = 1;
	}
    }
    close(FILE);
}

readsyms %global, 'global.sym';
readsyms %global, 'pp.sym';

sub readvars(\%$$@) {
    my ($syms, $file,$pre,$keep_pre) = @_;
    local (*FILE, $_);
    open(FILE, "< $file")
	or die "embed.pl: Can't open $file: $!\n";
    while (<FILE>) {
	s/[ \t]*#.*//;		# Delete comments.
	if (/PERLVARI?C?\($pre(\w+)/) {
	    my $sym = $1;
	    $sym = $pre . $sym if $keep_pre;
	    warn "duplicate symbol $sym while processing $file\n"
		if exists $$syms{$sym};
	    $$syms{$sym} = 1;
	}
    }
    close(FILE);
}

my %intrp;
my %thread;

readvars %intrp,  'intrpvar.h','I';
readvars %thread, 'thrdvar.h','T';
readvars %globvar, 'perlvars.h','G';
readvars %objvar, 'intrpvar.h','pi', 1;

foreach my $sym (sort keys %intrp)
 {
  if (exists $global{$sym})
   {
    delete $global{$sym};
    warn "$sym in {global,pp}.sym as well as intrpvar.h\n";
   }
 }

foreach my $sym (sort keys %globvar)
 {
  if (exists $global{$sym})
   {
    delete $global{$sym};
    warn "$sym in {global,pp}.sym as well as perlvars.h\n";
   }
 }

foreach my $sym (sort keys %thread)
 {
  warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
  if (exists $global{$sym})
   {
    delete $global{$sym};
    warn "$sym in {global,pp}.sym as well as thrdvar.h\n";
   }
 }

sub undefine ($) {
    my ($sym) = @_;
    "#undef  $sym\n";
}

sub hide ($$) {
    my ($from, $to) = @_;
    my $t = int(length($from) / 8);
    "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
}

sub embed ($) {
    my ($sym) = @_;
    hide($sym, "Perl_$sym");
}

sub embedobj ($) {
    my ($sym) = @_;
    hide($sym, $sym =~ /^perl_/i ? "CPerlObj::$sym" : "CPerlObj::Perl_$sym");
}

sub objxsub_func ($) {
    my ($sym) = @_;
    undefine($sym) . hide($sym, $sym =~ /^perl_/i
			  	? "pPerl->$sym"
				: "pPerl->Perl_$sym");
}

sub objxsub_var ($) {
    my ($sym) = @_;
    undefine("PL_$sym") . hide("PL_$sym", "pPerl->PL_$sym");
}

sub embedvar ($) {
    my ($sym) = @_;
#   hide($sym, "Perl_$sym");
    return '';
}

sub multon ($$$) {
    my ($sym,$pre,$ptr) = @_;
    hide("PL_$sym", "($ptr$pre$sym)");
}
sub multoff ($$) {
    my ($sym,$pre) = @_;
    return hide("PL_$pre$sym", "PL_$sym");
}

unlink 'embed.h';
open(EM, '> embed.h')
    or die "Can't create embed.h: $!\n";

print EM <<'END';
/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
   This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
   perlvars.h and thrdvar.h.  Any changes made here will be lost!
*/

/* (Doing namespace management portably in C is really gross.) */

/* NO_EMBED is no longer supported. i.e. EMBED is always active. */

/* Hide global symbols */

#if !defined(PERL_OBJECT)

END

for $sym (sort keys %global) {
    print EM embed($sym);
}

print EM <<'END';

#else	/* PERL_OBJECT */

END

# XXX these should be in a *.sym file
my @staticfuncs = qw(
    perl_init_i18nl10n
    perl_init_i18nl14n
    perl_new_collate
    perl_new_ctype
    perl_new_numeric
    perl_set_numeric_local
    perl_set_numeric_standard
    perl_construct
    perl_destruct
    perl_atexit
    perl_free
    perl_parse
    perl_run
    perl_get_sv
    perl_get_av
    perl_get_hv
    perl_get_cv
    perl_call_argv
    perl_call_pv
    perl_call_method
    perl_call_sv
    perl_eval_pv
    perl_eval_sv
    perl_require_pv

    hsplit
    hfreeentries
    more_he
    new_he
    del_he
    save_hek
    mess_alloc
    gv_init_sv
    save_scalar_at
    asIV
    asUV
    more_sv
    more_xiv
    more_xnv
    more_xpv
    more_xrv
    new_xiv
    new_xnv
    new_xpv
    new_xrv
    del_xiv
    del_xnv
    del_xpv
    del_xrv
    sv_mortalgrow
    sv_unglob
    sv_check_thinkfirst
    avhv_index_sv
    do_report_used
    do_clean_objs
    do_clean_named_objs
    do_clean_all
    not_a_number
    my_safemalloc
    visit
    qsortsv
    sortcv
    save_magic
    magic_methpack
    magic_methcall
    magic_methcall
    doform
    doencodes
    refto
    seed
    docatch
    dofindlabel
    doparseform
    dopoptoeval
    dopoptolabel
    dopoptoloop
    dopoptosub
    dopoptosub_at
    save_lines
    doeval
    amagic_cmp
    amagic_cmp_locale
    mul128
    is_an_int
    div128
    runops_standard
    runops_debug
    check_uni
    force_next
    force_version
    force_word
    tokeq
    scan_const
    scan_formline
    scan_heredoc
    scan_ident
    scan_inputsymbol
    scan_pat
    scan_str
    scan_subst
    scan_trans
    scan_word
    skipspace
    checkcomma
    force_ident
    incline
    intuit_method
    intuit_more
    lop
    missingterm
    no_op
    set_csh
    sublex_done
    sublex_push
    sublex_start
    uni
    filter_gets
    new_constant
    ao
    depcom
    win32_textfilter
    incl_perldb
    isa_lookup
    get_db_sub
    list_assignment
    bad_type
    modkids
    no_fh_allowed
    scalarboolean
    too_few_arguments
    too_many_arguments
    null
    pad_findlex
    newDEFSVOP
    gv_ename
    cv_clone2
    find_beginning
    forbid_setid
    incpush
    init_interp
    init_ids
    init_debugger
    init_lexer
    init_main_stash
    init_perllib
    init_postdump_symbols
    init_predump_symbols
    my_exit_jump
    nuke_stacks
    open_script
    usage
    validate_suid
    emulate_eaccess
    reg
    reganode
    regatom
    regbranch
    regc
    reguni
    regclass
    regclassutf8
    regcurly
    reg_node
    regpiece
    reginsert
    regoptail
    regset
    regtail
    regwhite
    nextchar
    dumpuntil
    scan_commit
    study_chunk
    add_data
    re_croak2
    regmatch
    regrepeat
    regrepeat_hard
    regtry
    reginclass
    reginclassutf8
    regcppush
    regcppop
    regcp_set_to
    cache_re
    reghop
    reghopmaybe
    dump
    do_aspawn
    debprof
    bset_obj_store
    new_logop
    do_trans_CC_simple
    do_trans_CC_count
    do_trans_CC_complex
    do_trans_UU_simple
    do_trans_UU_count
    do_trans_UU_complex
    do_trans_UC_simple
    do_trans_CU_simple
    do_trans_UC_trivial
    do_trans_CU_trivial
    unwind_handler_stack
    restore_magic
    restore_rsfp
    restore_expect
    restore_lex_expect
    yydestruct
    del_sv
    fprintf
);

for $sym (sort(keys(%global),@staticfuncs)) {
    print EM embedobj($sym);
}

print EM <<'END';

#endif	/* PERL_OBJECT */

END

close(EM);

unlink 'embedvar.h';
open(EM, '> embedvar.h')
    or die "Can't create embedvar.h: $!\n";

print EM <<'END';
/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
   This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
   perlvars.h and thrdvar.h.  Any changes made here will be lost!
*/

/* (Doing namespace management portably in C is really gross.) */

/* Put interpreter-specific symbols into a struct? */

#ifdef MULTIPLICITY

#ifndef USE_THREADS
/* If we do not have threads then per-thread vars are per-interpreter */

END

for $sym (sort keys %thread) {
    print EM multon($sym,'T','PL_curinterp->');
}

print EM <<'END';

#endif /* !USE_THREADS */

/* These are always per-interpreter if there is more than one */

END

for $sym (sort keys %intrp) {
    print EM multon($sym,'I','PL_curinterp->');
}

print EM <<'END';

#else	/* !MULTIPLICITY */

END

for $sym (sort keys %intrp) {
    print EM multoff($sym,'I');
}

print EM <<'END';

#ifndef USE_THREADS

END

for $sym (sort keys %thread) {
    print EM multoff($sym,'T');
}

print EM <<'END';

#endif /* USE_THREADS */

/* Hide what would have been interpreter-specific symbols? */

END

for $sym (sort keys %intrp) {
    print EM embedvar($sym);
}

print EM <<'END';

#ifndef USE_THREADS

END

for $sym (sort keys %thread) {
    print EM embedvar($sym);
}

print EM <<'END';

#endif /* USE_THREADS */
#endif /* MULTIPLICITY */

/* Now same trickey for per-thread variables */

#ifdef USE_THREADS

END

for $sym (sort keys %thread) {
    print EM multon($sym,'T','thr->');
}

print EM <<'END';

#endif /* USE_THREADS */

#ifdef PERL_GLOBAL_STRUCT

END

for $sym (sort keys %globvar) {
    print EM multon($sym,'G','PL_Vars.');
}

print EM <<'END';

#else /* !PERL_GLOBAL_STRUCT */

END

for $sym (sort keys %globvar) {
    print EM multoff($sym,'G');
}

print EM <<'END';

END

for $sym (sort keys %globvar) {
    print EM embedvar($sym);
}

print EM <<'END';

#endif /* PERL_GLOBAL_STRUCT */

END

print EM <<'END';

#ifdef PERL_POLLUTE		/* unsupported in 5.006 */

END

for $sym (sort @extvars) {
    print EM hide($sym,"PL_$sym");
}

print EM <<'END';

#endif /* MIN_PERL_DEFINE */
END


close(EM);

unlink 'objXSUB.h';
open(OBX, '> objXSUB.h')
    or die "Can't create objXSUB.h: $!\n";

print OBX <<'EOT';
/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
   This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
   perlvars.h and thrdvar.h.  Any changes made here will be lost!
*/

#ifndef __objXSUB_h__
#define __objXSUB_h__

/* Variables */

EOT

foreach my $sym (sort(keys(%intrp),
		      keys(%thread),
		      keys(%globvar),
		      keys(%objvar)))
{
    print OBX objxsub_var($sym);
}

print OBX <<'EOT';

/* Functions */

EOT


for $sym (sort(keys(%global),@staticfuncs)) {
    print OBX objxsub_func($sym);
}


print OBX <<'EOT';

#endif	/* __objXSUB_h__ */
EOT

close(OBX);
Commit	Line	Data
5f05dabc	1	#!/usr/bin/perl -w
e50aee73	2
5f05dabc	3	require 5.003;
5f05dabc	4
709f4e38 GS	5	# XXX others that may need adding
	6	# warnhook
	7	# hints
	8	# copline
84fee439 NIS	9	my @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
6b88bc9c GS	16	errgv
3070f6ec GS	17	rsfp_filters
3070f6ec GS	18	perldb
709f4e38 GS	19	diehook
	20	dirty
	21	perl_destruct_level
84fee439 NIS	22	);
84fee439 NIS	23
5f05dabc	24	sub readsyms (\%$) {
5f05dabc	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
	41	readsyms %global, 'global.sym';
22c35a8c	42	readsyms %global, 'pp.sym';
5f05dabc	43
c6af7a1a GS	44	sub readvars(\%$$@) {
c6af7a1a GS	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
	62	my %intrp;
	63	my %thread;
	64
	65	readvars %intrp, 'intrpvar.h','I';
	66	readvars %thread, 'thrdvar.h','T';
22239a37	67	readvars %globvar, 'perlvars.h','G';
c6af7a1a	68	readvars %objvar, 'intrpvar.h','pi', 1;
d4cce5f1 NIS	69
	70	foreach 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	79	foreach 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	88	foreach my $sym (sort keys %thread)
d4cce5f1 NIS	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	98	sub undefine ($) {
	99	my ($sym) = @_;
	100	"#undef $sym\n";
	101	}
	102
5f05dabc	103	sub 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	109	sub embed ($) {
	110	my ($sym) = @_;
	111	hide($sym, "Perl_$sym");
	112	}
c6af7a1a	113
22c35a8c GS	114	sub embedobj ($) {
	115	my ($sym) = @_;
	116	hide($sym, $sym =~ /^perl_/i ? "CPerlObj::$sym" : "CPerlObj::Perl_$sym");
	117	}
c6af7a1a GS	118
	119	sub objxsub_func ($) {
	120	my ($sym) = @_;
	121	undefine($sym) . hide($sym, $sym =~ /^perl_/i
	122	? "pPerl->$sym"
	123	: "pPerl->Perl_$sym");
	124	}
	125
	126	sub objxsub_var ($) {
	127	my ($sym) = @_;
	128	undefine("PL_$sym") . hide("PL_$sym", "pPerl->PL_$sym");
	129	}
	130
3280af22 NIS	131	sub embedvar ($) {
	132	my ($sym) = @_;
	133	# hide($sym, "Perl_$sym");
	134	return '';
	135	}
	136
d4cce5f1 NIS	137	sub multon ($$$) {
d4cce5f1 NIS	138	my ($sym,$pre,$ptr) = @_;
3280af22	139	hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc	140	}
d4cce5f1 NIS	141	sub multoff ($$) {
d4cce5f1 NIS	142	my ($sym,$pre) = @_;
533c011a	143	return hide("PL_$pre$sym", "PL_$sym");
5f05dabc	144	}
	145
	146	unlink 'embed.h';
	147	open(EM, '> embed.h')
	148	or die "Can't create embed.h: $!\n";
e50aee73 AD	149
e50aee73 AD	150	print 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	164	END
e50aee73 AD	165
5f05dabc	166	for $sym (sort keys %global) {
dc86dda3	167	print EM embed($sym);
e50aee73 AD	168	}
e50aee73 AD	169
e50aee73 AD	170	print EM <<'END';
e50aee73 AD	171
22c35a8c GS	172	#else /* PERL_OBJECT */
	173
	174	END
	175
	176	# XXX these should be in a *.sym file
c6af7a1a	177	my @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	390	for $sym (sort(keys(%global),@staticfuncs)) {
22c35a8c GS	391	print EM embedobj($sym);
	392	}
	393
	394	print EM <<'END';
	395
	396	#endif /* PERL_OBJECT */
e50aee73	397
d4cce5f1 NIS	398	END
	399
	400	close(EM);
	401
	402	unlink 'embedvar.h';
	403	open(EM, '> embedvar.h')
	404	or die "Can't create embedvar.h: $!\n";
	405
	406	print 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	421	END
e50aee73 AD	422
d4cce5f1	423	for $sym (sort keys %thread) {
8f872242	424	print EM multon($sym,'T','PL_curinterp->');
d4cce5f1 NIS	425	}
	426
	427	print EM <<'END';
	428
	429	#endif /* !USE_THREADS */
	430
	431	/* These are always per-interpreter if there is more than one */
	432
	433	END
	434
	435	for $sym (sort keys %intrp) {
8f872242	436	print EM multon($sym,'I','PL_curinterp->');
760ac839	437	}
760ac839	438
55497cff	439	print EM <<'END';
55497cff	440
5f05dabc	441	#else /* !MULTIPLICITY */
55497cff	442
55497cff	443	END
760ac839	444
d4cce5f1 NIS	445	for $sym (sort keys %intrp) {
d4cce5f1 NIS	446	print EM multoff($sym,'I');
e50aee73	447	}
e50aee73	448
56d28764 CS	449	print EM <<'END';
56d28764 CS	450
d4cce5f1 NIS	451	#ifndef USE_THREADS
	452
	453	END
	454
	455	for $sym (sort keys %thread) {
	456	print EM multoff($sym,'T');
	457	}
	458
	459	print EM <<'END';
	460
	461	#endif /* USE_THREADS */
	462
	463	/* Hide what would have been interpreter-specific symbols? */
5f05dabc	464
56d28764	465	END
e50aee73	466
d4cce5f1	467	for $sym (sort keys %intrp) {
3280af22	468	print EM embedvar($sym);
d4cce5f1 NIS	469	}
	470
	471	print EM <<'END';
	472
	473	#ifndef USE_THREADS
	474
	475	END
	476
	477	for $sym (sort keys %thread) {
3280af22	478	print EM embedvar($sym);
5f05dabc	479	}
	480
	481	print 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
	490	END
	491
	492	for $sym (sort keys %thread) {
22239a37	493	print EM multon($sym,'T','thr->');
d4cce5f1 NIS	494	}
	495
	496	print EM <<'END';
	497
	498	#endif /* USE_THREADS */
	499
22239a37 NIS	500	#ifdef PERL_GLOBAL_STRUCT
	501
	502	END
	503
	504	for $sym (sort keys %globvar) {
533c011a	505	print EM multon($sym,'G','PL_Vars.');
22239a37 NIS	506	}
	507
	508	print EM <<'END';
	509
	510	#else /* !PERL_GLOBAL_STRUCT */
	511
	512	END
	513
	514	for $sym (sort keys %globvar) {
	515	print EM multoff($sym,'G');
	516	}
	517
	518	print EM <<'END';
	519
22239a37 NIS	520	END
	521
	522	for $sym (sort keys %globvar) {
3280af22	523	print EM embedvar($sym);
22239a37 NIS	524	}
	525
	526	print EM <<'END';
	527
22239a37 NIS	528	#endif /* PERL_GLOBAL_STRUCT */
22239a37 NIS	529
e50aee73 AD	530	END
e50aee73 AD	531
84fee439 NIS	532	print EM <<'END';
84fee439 NIS	533
1ba53475	534	#ifdef PERL_POLLUTE /* unsupported in 5.006 */
84fee439 NIS	535
	536	END
	537
	538	for $sym (sort @extvars) {
	539	print EM hide($sym,"PL_$sym");
	540	}
	541
	542	print EM <<'END';
	543
	544	#endif /* MIN_PERL_DEFINE */
	545	END
	546
	547
3fe35a81	548	close(EM);
c6af7a1a GS	549
	550	unlink 'objXSUB.h';
	551	open(OBX, '> objXSUB.h')
	552	or die "Can't create objXSUB.h: $!\n";
	553
	554	print 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
	565	EOT
	566
	567	foreach my $sym (sort(keys(%intrp),
	568	keys(%thread),
	569	keys(%globvar),
	570	keys(%objvar)))
	571	{
	572	print OBX objxsub_var($sym);
	573	}
	574
	575	print OBX <<'EOT';
	576
	577	/* Functions */
	578
	579	EOT
	580
	581
	582	for $sym (sort(keys(%global),@staticfuncs)) {
	583	print OBX objxsub_func($sym);
	584	}
	585
	586
	587	print OBX <<'EOT';
	588
	589	#endif /* __objXSUB_h__ */
	590	EOT
	591
	592	close(OBX);