my @extvars = qw(sv_undef sv_yes sv_no na dowarn
curcop compiling
tainting tainted stack_base stack_sp sv_arenaroot
+ no_modify
curstash DBsub DBsingle debstash
rsfp
stdingv
readsyms %global, 'global.sym';
readsyms %global, 'pp.sym';
-sub readvars(\%$$) {
- my ($syms, $file,$pre) = @_;
+sub readvars(\%$$@) {
+ my ($syms, $file,$pre,$keep_pre) = @_;
local (*FILE, $_);
open(FILE, "< $file")
or die "embed.pl: Can't open $file: $!\n";
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;
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)
{
}
}
+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");
print EM <<'END';
/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
- and thrdvar.h. Any changes made here will be lost!
+ perlvars.h and thrdvar.h. Any changes made here will be lost!
*/
/* (Doing namespace management portably in C is really gross.) */
END
# XXX these should be in a *.sym file
-my @extras = qw(
+my @staticfuncs = qw(
perl_init_i18nl10n
perl_init_i18nl14n
perl_new_collate
del_xnv
del_xpv
del_xrv
- sv_mortalgrow
sv_unglob
- sv_check_thinkfirst
avhv_index_sv
do_report_used
do_clean_objs
refto
seed
docatch
+ docatch_body
+ perl_parse_body
+ perl_run_body
+ perl_call_body
+ perl_call_xbody
+ call_list_body
dofindlabel
doparseform
dopoptoeval
dopoptosub_at
save_lines
doeval
+ doopen_pmc
+ sv_ncmp
+ sv_i_ncmp
+ amagic_ncmp
+ amagic_i_ncmp
amagic_cmp
amagic_cmp_locale
mul128
study_chunk
add_data
re_croak2
+ regpposixcc
+ clear_re
regmatch
regrepeat
regrepeat_hard
regcppop
regcp_set_to
cache_re
+ restore_pos
reghop
reghopmaybe
dump
do_aspawn
debprof
- bset_obj_store
new_logop
+ simplify_sort
+ is_handle_constructor
+ sv_add_backref
+ sv_del_backref
do_trans_CC_simple
do_trans_CC_count
do_trans_CC_complex
fprintf
);
-my %skip;
-
-for $sym (qw[
- utf8skip
- ])
-{
- $skip{$sym}++;
-}
-
-for $sym (sort(keys(%global),@extras)) {
- next if exists $skip{$sym};
+for $sym (sort(keys(%global),@staticfuncs)) {
print EM embedobj($sym);
}
#endif /* PERL_OBJECT */
+/* compatibility stubs */
+
+#define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,(IV)ptr)
+#define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
+
END
close(EM);
print EM <<'END';
/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by embed.pl from global.sym, pp.sym, intrpvar.h,
- and thrdvar.h. Any changes made here will be lost!
+ perlvars.h and thrdvar.h. Any changes made here will be lost!
*/
/* (Doing namespace management portably in C is really gross.) */
print EM <<'END';
-#if 0 /* ndef MIN_PERL_DEFINE */ /* unsupported in 5.006 */
+#ifdef PERL_POLLUTE /* disabled by default in 5.006 */
END
print EM <<'END';
-#endif /* MIN_PERL_DEFINE */
+#endif /* PERL_POLLUTE */
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);