or die "embed.pl: Can't open $file: $!\n";
while (<FILE>) {
s/[ \t]*#.*//; # Delete comments.
- if (/PERLVARI?C?\($pre(\w+)/) {
+ if (/PERLVARA?I?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;
+ $$syms{$sym} = $pre || 1;
}
}
close(FILE);
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 %thread)
- {
+foreach my $sym (sort keys %thread) {
warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
- }
+}
sub undefine ($) {
my ($sym) = @_;
"#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
}
-sub objxsub_var ($) {
- my ($sym) = @_;
- undefine("PL_$sym") . hide("PL_$sym", "pPerl->PL_$sym");
+sub objxsub_var ($$) {
+ my ($pfx, $sym) = @_;
+ undefine("PL_$sym") . hide("PL_$sym", "(*Perl_${pfx}${sym}_ptr(pPerl))");
}
sub embedvar ($) {
EOT
-foreach my $sym (sort(keys(%intrp),
- keys(%thread),
- keys(%globvar),
- keys(%objvar)))
-{
- print OBX objxsub_var($sym);
+foreach my $sym (sort keys %intrp) {
+ print OBX objxsub_var('I',$sym);
+}
+
+foreach my $sym (sort keys %thread) {
+ print OBX objxsub_var('T',$sym);
+}
+
+foreach my $sym (sort keys %globvar) {
+ print OBX objxsub_var('G',$sym);
}
print OBX <<'EOT';
close(OBX);
+unlink 'perlapi.h';
+unlink 'perlapi.c';
+open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
+open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
+
+print CAPIH <<'EOT';
+/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+ This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
+ perlvars.h and thrdvar.h. Any changes made here will be lost!
+*/
+
+#if defined(PERL_OBJECT)
+
+/* declare accessor functions for Perl variables */
+
+START_EXTERN_C
+
+#undef PERLVAR
+#undef PERLVARA
+#undef PERLVARI
+#undef PERLVARIC
+#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(void *p);
+#define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
+ EXTERN_C PL_##v##_t* Perl_##v##_ptr(void *p);
+#define PERLVARI(v,t,i) PERLVAR(v,t)
+#define PERLVARIC(v,t,i) PERLVAR(v,t)
+
+#include "thrdvar.h"
+#include "intrpvar.h"
+#include "perlvars.h"
+
+#undef PERLVAR
+#undef PERLVARA
+#undef PERLVARI
+#undef PERLVARIC
+
+END_EXTERN_C
+
+#endif /* PERL_OBJECT */
+
+EOT
+
+
+print CAPI <<'EOT';
+/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+ This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
+ perlvars.h and thrdvar.h. Any changes made here will be lost!
+*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perlapi.h"
+
+#if defined(PERL_OBJECT)
+
+/* accessor functions for Perl variables (provides binary compatibility) */
+START_EXTERN_C
+
+#undef PERLVAR
+#undef PERLVARA
+#undef PERLVARI
+#undef PERLVARIC
+#define PERLVAR(v,t) t* Perl_##v##_ptr(void *p) \
+ { return &(((CPerlObj*)p)->PL_##v); }
+#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(void *p) \
+ { return &(((CPerlObj*)p)->PL_##v); }
+#define PERLVARI(v,t,i) PERLVAR(v,t)
+#define PERLVARIC(v,t,i) PERLVAR(v,t)
+
+#include "thrdvar.h"
+#include "intrpvar.h"
+#include "perlvars.h"
+
+#undef PERLVAR
+#undef PERLVARA
+#undef PERLVARI
+#undef PERLVARIC
+
+EOT
+
+sub emit_func {
+ my ($retval,$func,@args) = @_;
+ my @aargs = @args;
+ for my $a (@aargs) { $a =~ s/^.*\b(\w+)$/$1/ }
+ unshift @args, 'void *pPerl';
+ local $" = ', ';
+ my $return = ($retval =~ /^\s*(void|Free_t|Signal_t)\s*$/ ? '' : 'return ');
+ return <<EOT
+$retval
+$func(@args)
+{
+ $return((CPerlObj*)pPerl)->$func(@aargs);
+}
+EOT
+
+}
+
+# XXXX temporary hack
+for my $sym (qw(
+ perl_construct
+ perl_destruct
+ perl_free
+ perl_run
+ perl_parse
+ ))
+{
+ $skipapi_funcs{$sym}++;
+}
+
+walk_table {
+ my $ret = "";
+ if (@_ == 1) {
+ my $arg = shift;
+ $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/;
+ }
+ else {
+ my ($flags,$retval,$func,@args) = @_;
+ return $ret if exists $skipapi_funcs{$func};
+ unless (@args and $args[$#args] =~ /\.\.\./) {
+ unless ($flags =~ /s/) {
+ $ret .= "\n";
+ if ($flags =~ /p/) {
+ $ret .= undefine("Perl_$func");
+ $ret .= emit_func($retval,"Perl_$func",@args);
+ }
+ else {
+ $ret .= undefine($func);
+ $ret .= emit_func($retval,$func,@args);
+ }
+ }
+ }
+ }
+ $ret;
+} \*CAPI;
+
+for $sym (sort keys %ppsym) {
+ $sym =~ s/^Perl_//;
+ print CAPI "\n";
+ print CAPI undefine("Perl_$sym");
+ if ($sym =~ /^ck_/) {
+ print CAPI emit_func('OP *',"Perl_$sym",'OP *o');
+ }
+ else { # pp_foo
+ print CAPI emit_func('OP *',"Perl_$sym");
+ }
+}
+
+print CAPI <<'EOT';
+
+END_EXTERN_C
+
+#endif /* PERL_OBJECT */
+EOT
+
__END__
# Lines are of the form:
p |void |boot_core_UNIVERSAL
p |void |call_list |I32 oldscope|AV* av_list
p |I32 |cando |I32 bit|I32 effective|Stat_t* statbufp
-p |U32 |cast_ulong |double f
-p |I32 |cast_i32 |double f
-p |IV |cast_iv |double f
-p |UV |cast_uv |double f
+p |U32 |cast_ulong |NV f
+p |I32 |cast_i32 |NV f
+p |IV |cast_iv |NV f
+p |UV |cast_uv |NV f
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
p |I32 |my_chsize |int fd|Off_t length
#endif
p |bool |io_close |IO* io
p |OP* |invert |OP* cmd
p |bool |is_uni_alnum |U32 c
+p |bool |is_uni_alnumc |U32 c
p |bool |is_uni_idfirst |U32 c
p |bool |is_uni_alpha |U32 c
+p |bool |is_uni_ascii |U32 c
p |bool |is_uni_space |U32 c
+p |bool |is_uni_cntrl |U32 c
+p |bool |is_uni_graph |U32 c
p |bool |is_uni_digit |U32 c
p |bool |is_uni_upper |U32 c
p |bool |is_uni_lower |U32 c
p |bool |is_uni_print |U32 c
+p |bool |is_uni_punct |U32 c
+p |bool |is_uni_xdigit |U32 c
p |U32 |to_uni_upper |U32 c
p |U32 |to_uni_title |U32 c
p |U32 |to_uni_lower |U32 c
p |bool |is_uni_alnum_lc|U32 c
+p |bool |is_uni_alnumc_lc|U32 c
p |bool |is_uni_idfirst_lc|U32 c
p |bool |is_uni_alpha_lc|U32 c
+p |bool |is_uni_ascii_lc|U32 c
p |bool |is_uni_space_lc|U32 c
+p |bool |is_uni_cntrl_lc|U32 c
+p |bool |is_uni_graph_lc|U32 c
p |bool |is_uni_digit_lc|U32 c
p |bool |is_uni_upper_lc|U32 c
p |bool |is_uni_lower_lc|U32 c
p |bool |is_uni_print_lc|U32 c
+p |bool |is_uni_punct_lc|U32 c
+p |bool |is_uni_xdigit_lc|U32 c
p |U32 |to_uni_upper_lc|U32 c
p |U32 |to_uni_title_lc|U32 c
p |U32 |to_uni_lower_lc|U32 c
p |bool |is_utf8_alnum |U8 *p
+p |bool |is_utf8_alnumc |U8 *p
p |bool |is_utf8_idfirst|U8 *p
p |bool |is_utf8_alpha |U8 *p
+p |bool |is_utf8_ascii |U8 *p
p |bool |is_utf8_space |U8 *p
+p |bool |is_utf8_cntrl |U8 *p
p |bool |is_utf8_digit |U8 *p
+p |bool |is_utf8_graph |U8 *p
p |bool |is_utf8_upper |U8 *p
p |bool |is_utf8_lower |U8 *p
p |bool |is_utf8_print |U8 *p
+p |bool |is_utf8_punct |U8 *p
+p |bool |is_utf8_xdigit |U8 *p
p |bool |is_utf8_mark |U8 *p
p |OP* |jmaybe |OP* arg
p |I32 |keyword |char* d|I32 len
p |OP* |mod |OP* o|I32 type
p |char* |moreswitches |char* s
p |OP* |my |OP* o
-#ifdef USE_LOCALE_NUMERIC
-p |double |my_atof |const char *s
-#endif
+p |NV |my_atof |const char *s
#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
p |char* |my_bcopy |const char* from|char* to|I32 len
#endif
p |OP* |newSVREF |OP* o
p |OP* |newSVOP |I32 type|I32 flags|SV* sv
p |SV* |newSViv |IV i
-p |SV* |newSVnv |double n
+p |SV* |newSVnv |NV n
p |SV* |newSVpv |const char* s|STRLEN len
p |SV* |newSVpvn |const char* s|STRLEN len
p |SV* |newSVpvf |const char* pat|...
|SV* screamer|U32 nosave
p |void |pregfree |struct regexp* r
p |regexp*|pregcomp |char* exp|char* xend|PMOP* pm
+p |char* |re_intuit_start|regexp* prog|SV* sv|char* strpos \
+ |char* strend|U32 flags \
+ |struct re_scream_pos_data_s *data
+p |SV* |re_intuit_string|regexp* prog
p |I32 |regexec_flags |regexp* prog|char* stringarg \
|char* strend|char* strbeg|I32 minend \
|SV* screamer|void* data|U32 flags
p |IO* |sv_2io |SV* sv
p |IV |sv_2iv |SV* sv
p |SV* |sv_2mortal |SV* sv
-p |double |sv_2nv |SV* sv
+p |NV |sv_2nv |SV* sv
p |char* |sv_2pv |SV* sv|STRLEN* lp
p |UV |sv_2uv |SV* sv
p |IV |sv_iv |SV* sv
p |UV |sv_uv |SV* sv
-p |double |sv_nv |SV* sv
+p |NV |sv_nv |SV* sv
p |char* |sv_pvn |SV *sv|STRLEN *len
p |I32 |sv_true |SV *sv
p |void |sv_add_arena |char* ptr|U32 size|U32 flags
p |void |sv_setiv |SV* sv|IV num
p |void |sv_setpviv |SV* sv|IV num
p |void |sv_setuv |SV* sv|UV num
-p |void |sv_setnv |SV* sv|double num
+p |void |sv_setnv |SV* sv|NV num
p |SV* |sv_setref_iv |SV* rv|const char* classname|IV iv
-p |SV* |sv_setref_nv |SV* rv|const char* classname|double nv
+p |SV* |sv_setref_nv |SV* rv|const char* classname|NV nv
p |SV* |sv_setref_pv |SV* rv|const char* classname|void* pv
p |SV* |sv_setref_pvn |SV* rv|const char* classname|char* pv \
|STRLEN n
#if defined(PERL_GLOBAL_STRUCT)
p |struct perl_vars *|GetVars
#endif
-p |void |yydestruct |void *ptr
p |int |runops_standard
p |int |runops_debug
-
-#if defined(WIN32)
-#if defined(PERL_OBJECT)
-p |int& |ErrorNo
-#else
-p |int* |ErrorNo
-#endif
-#endif
p |void |sv_catpvf_mg |SV *sv|const char* pat|...
p |void |sv_catpv_mg |SV *sv|const char *ptr
p |void |sv_catpvn_mg |SV *sv|const char *ptr|STRLEN len
p |void |sv_setiv_mg |SV *sv|IV i
p |void |sv_setpviv_mg |SV *sv|IV iv
p |void |sv_setuv_mg |SV *sv|UV u
-p |void |sv_setnv_mg |SV *sv|double num
+p |void |sv_setnv_mg |SV *sv|NV num
p |void |sv_setpv_mg |SV *sv|const char *ptr
p |void |sv_setpvn_mg |SV *sv|const char *ptr|STRLEN len
p |void |sv_setsv_mg |SV *dstr|SV *sstr
s |int |magic_methpack |SV *sv|MAGIC *mg|char *meth
s |int |magic_methcall |SV *sv|MAGIC *mg|char *meth|I32 f \
|int n|SV *val
-s |void |unwind_handler_stack |void *p
-s |void |restore_magic |void *p
#endif
#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT)
s |I32 |list_assignment|OP *o
s |void |bad_type |I32 n|char *t|char *name|OP *kid
+s |void |cop_free |COP *cop
s |OP* |modkids |OP *o|I32 type
s |void |no_bareword_allowed|OP *o
s |OP* |no_fh_allowed |OP *o
s |OP* |doeval |int gimme|OP** startop
s |PerlIO *|doopen_pmc |const char *name|const char *mode
s |void |qsortsv |SV ** array|size_t num_elts|SVCOMPARE_t f
-s |I32 |sortcv |SV *a|SV *b
-s |I32 |sv_ncmp |SV *a|SV *b
-s |I32 |sv_i_ncmp |SV *a|SV *b
-s |I32 |amagic_ncmp |SV *a|SV *b
-s |I32 |amagic_i_ncmp |SV *a|SV *b
-s |I32 |amagic_cmp |SV *str1|SV *str2
-s |I32 |amagic_cmp_locale|SV *str1|SV *str2
#endif
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
s |CV* |get_db_sub |SV **svp|CV *cv
-# if defined(USE_THREADS)
-s |void |unset_cvowner |void *cvarg
-# endif
#endif
#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT)
|regnode *last|scan_data_t *data|U32 flags
s |I32 |add_data |I32 n|char *s
rs |void|re_croak2 |const char* pat1|const char* pat2|...
-s |char*|regpposixcc |I32 value
-s |void |clear_re |void *r
+s |I32 |regpposixcc |I32 value
+s |void |checkposixcc
#endif
#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
s |char*|regcppop
s |char*|regcp_set_to |I32 ss
s |void |cache_re |regexp *prog
-s |void |restore_pos |void *arg
s |U8* |reghop |U8 *pos|I32 off
s |U8* |reghopmaybe |U8 *pos|I32 off
#endif
s |void |del_xpv |XPV* p
s |void |del_xrv |XRV* p
s |void |sv_unglob |SV* sv
-s |void |do_report_used |SV *sv
-s |void |do_clean_objs |SV *sv
-s |void |do_clean_named_objs|SV *sv
-s |void |do_clean_all |SV *sv
s |void |not_a_number |SV *sv
s |void |visit |SVFUNC_t f
# if defined(PURIFY)
s |char* |incl_perldb
s |I32 |utf16_textfilter|int idx|SV *sv|int maxlen
s |I32 |utf16rev_textfilter|int idx|SV *sv|int maxlen
-s |void |restore_rsfp |void *f
-s |void |restore_expect |void *e
-s |void |restore_lex_expect |void *e
# if defined(CRIPPLED_CC)
s |int |uni |I32 f|char *s
# endif