+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!
+*/
+
+/* declare accessor functions for Perl variables */
+
+#if defined(PERL_OBJECT) || defined (PERL_CAPI)
+
+#if defined(PERL_OBJECT)
+# undef aTHXo
+# define aTHXo pPerl
+# undef aTHXo_
+# define aTHXo_ aTHXo,
+# undef _aTHXo
+# define _aTHXo ,aTHXo
+#endif /* PERL_OBJECT */
+
+START_EXTERN_C
+
+#undef PERLVAR
+#undef PERLVARA
+#undef PERLVARI
+#undef PERLVARIC
+#define PERLVAR(v,t) EXTERN_C t* Perl_##v##_ptr(pTHXo);
+#define PERLVARA(v,n,t) typedef t PL_##v##_t[n]; \
+ EXTERN_C PL_##v##_t* Perl_##v##_ptr(pTHXo);
+#define PERLVARI(v,t,i) PERLVAR(v,t)
+#define PERLVARIC(v,t,i) PERLVAR(v, const t)
+
+#include "thrdvar.h"
+#include "intrpvar.h"
+#include "perlvars.h"
+
+#undef PERLVAR
+#undef PERLVARA
+#undef PERLVARI
+#undef PERLVARIC
+
+END_EXTERN_C
+
+#endif /* PERL_OBJECT || PERL_CAPI */
+
+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(pTHXo) \
+ { return &(aTHXo->PL_##v); }
+#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \
+ { return &(aTHXo->PL_##v); }
+#define PERLVARI(v,t,i) PERLVAR(v,t)
+#define PERLVARIC(v,t,i) PERLVAR(v, const t)
+
+#include "thrdvar.h"
+#include "intrpvar.h"
+
+#undef PERLVAR
+#undef PERLVARA
+#define PERLVAR(v,t) t* Perl_##v##_ptr(pTHXo) \
+ { return &(PL_##v); }
+#define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \
+ { return &(PL_##v); }
+#include "perlvars.h"
+
+#undef PERLVAR
+#undef PERLVARA
+#undef PERLVARI
+#undef PERLVARIC
+
+EOT
+
+# functions that take va_list* for implementing vararg functions
+my %vfuncs = qw(
+ Perl_croak Perl_vcroak
+ Perl_warn Perl_vwarn
+ Perl_warner Perl_vwarner
+ Perl_die Perl_vdie
+ Perl_form Perl_vform
+ Perl_deb Perl_vdeb
+ Perl_newSVpvf Perl_vnewSVpvf
+ Perl_sv_setpvf Perl_sv_vsetpvf
+ Perl_sv_setpvf_mg Perl_sv_vsetpvf_mg
+ Perl_sv_catpvf Perl_sv_vcatpvf
+ Perl_sv_catpvf_mg Perl_sv_vcatpvf_mg
+ Perl_dump_indent Perl_dump_vindent
+ Perl_default_protect Perl_vdefault_protect
+);
+
+sub emit_func {
+ my ($addcontext, $rettype,$func,@args) = @_;
+ my @aargs = @args;
+ for my $a (@aargs) { $a =~ s/^.*\b(\w+)$/$1/ }
+ my $ctxarg = '';
+ if (not $addcontext) {
+ $ctxarg = 'pTHXo';
+ $ctxarg .= '_ ' if @args;
+ }
+ my $decl = '';
+ if ($addcontext) {
+ $decl .= " dTHXo;\n";
+ }
+ local $" = ', ';
+ my $return = ($rettype =~ /^\s*(void|Free_t|Signal_t)\s*$/
+ ? '' : 'return ');
+ my $emitval = '';
+ if (@args and $args[$#args] =~ /\.\.\./) {
+ pop @args;
+ pop @aargs;
+ my $retarg = '';
+ my $ctxfunc = $func;
+ $ctxfunc =~ s/_nocontext$//;
+ return $emitval unless exists $vfuncs{$ctxfunc};
+ if (length $return) {
+ $decl .= " $rettype retval;\n";
+ $retarg .= "retval = ";
+ $return = "\n ${return}retval;\n";
+ }
+ $emitval .= <<EOT
+$rettype
+$func($ctxarg@args)
+{
+$decl va_list args;
+ va_start(args, $aargs[$#aargs]);
+ $retarg((CPerlObj*)pPerl)->$vfuncs{$ctxfunc}(@aargs, &args);
+ va_end(args);$return
+}
+EOT
+ }
+ else {
+ $emitval .= <<EOT
+$rettype
+$func($ctxarg@args)
+{
+$decl $return((CPerlObj*)pPerl)->$func(@aargs);
+}
+EOT
+ }
+ $emitval;
+}
+
+# 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 ($flags =~ /s/) {
+ $ret .= "\n";
+ my $addctx = 1 if $flags =~ /n/;
+ if ($flags =~ /p/) {
+ $ret .= undefine("Perl_$func");
+ $ret .= emit_func($addctx,$retval,"Perl_$func",@args);
+ }
+ else {
+ $ret .= undefine($func);
+ $ret .= emit_func($addctx,$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(0, 'OP *',"Perl_$sym",'OP *o');
+ }
+ else { # pp_foo
+ print CAPI emit_func(0, 'OP *',"Perl_$sym");
+ }
+}
+
+print CAPI <<'EOT';
+
+#undef Perl_fprintf_nocontext
+int
+Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
+{
+ dTHXo;
+ va_list(arglist);
+ va_start(arglist, format);
+ return (*pPerl->PL_StdIO->pVprintf)(pPerl->PL_StdIO, stream, format, arglist);
+}
+
+END_EXTERN_C
+
+#endif /* PERL_OBJECT */
+EOT
+