[asperl] add AS patch#17

p4raw-id: //depot/asperl@893

21 files changed, 1160 insertions, 51 deletions

diff --git a/MANIFEST b/MANIFEST
index ff13cb501b..88ee2e2c67 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -967,6 +967,7 @@ win32/config_h.PL	Perl code to convert Win32 config.sh to config.h
 win32/config_sh.PL	Perl code to update Win32 config.sh from Makefile 
 win32/dl_win32.xs	Win32 port
 win32/genxsdef.pl	Win32 port
+win32/GenCAPI.pl	Win32 port for C API with PERL_OBJECT
 win32/include/arpa/inet.h	Win32 port
 win32/include/dirent.h		Win32 port
 win32/include/netdb.h		Win32 port
@@ -980,6 +981,7 @@ win32/perllib.c		Win32 port
 win32/pod.mak		Win32 port
 win32/runperl.c		Win32 port
 win32/splittree.pl	Win32 port
+win32/TEST
 win32/win32.c		Win32 port
 win32/win32.h		Win32 port
 win32/win32iop.h	Win32 port
diff --git a/XSUB.h b/XSUB.h
index f9c0503a39..a1041ad3ca 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -2,7 +2,7 @@
 
 #ifdef CAN_PROTOTYPE
 #ifdef PERL_OBJECT
-#define XS(name) void name(CPerlObj* pPerl, CV* cv)
+#define XS(name) void name(CV* cv, CPerlObj* pPerl)
 #else
 #define XS(name) void name(CV* cv)
 #endif
@@ -75,4 +75,8 @@
 #include "XSLock.h"
 #endif  /* WIN32 */
 #endif  /* NO_XSLOCKS */
+#else
+#ifdef PERL_CAPI
+#include "PerlCAPI.h"
+#endif
 #endif	/* PERL_OBJECT */
diff --git a/cv.h b/cv.h
index f78b5a4199..c7c7a73cc5 100644
--- a/cv.h
+++ b/cv.h
@@ -21,7 +21,7 @@ struct xpvcv {
     HV *	xcv_stash;
     OP *	xcv_start;
     OP *	xcv_root;
-    void      (*xcv_xsub) _((CPERLproto_ CV*));
+    void      (*xcv_xsub) _((CV* _CPERLproto));
     ANY		xcv_xsubany;
     GV *	xcv_gv;
     GV *	xcv_filegv;
diff --git a/ipstdio.h b/ipstdio.h
index e49f1be293..1ed0e61086 100644
--- a/ipstdio.h
+++ b/ipstdio.h
@@ -52,6 +52,10 @@ public:
     virtual int Setpos(PerlIO*, const Fpos_t *, int &err) = 0;
     virtual void Init(int &err) = 0;
     virtual void InitOSExtras(void* p) = 0;
+#ifdef WIN32
+    virtual int OpenOSfhandle(long osfhandle, int flags) = 0;
+    virtual int GetOSfhandle(int filenum) = 0;
+#endif
 };
 
 #endif	/* __Inc__IPerlStdIO___ */
diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm
index 92a46426da..9ae5abe0bd 100644
--- a/lib/ExtUtils/MM_Unix.pm
+++ b/lib/ExtUtils/MM_Unix.pm
@@ -368,6 +368,12 @@ sub cflags {
 	$self->{uc $_} ||= $cflags{$_}
     }
 
+    if ($self->{CAPI}) {
+        $self->{CCFLAGS} =~ s/-DPERL_OBJECT(\s|$)//;
+        $self->{CCFLAGS} =~ s/-TP(\s|$)//;
+        $self->{OPTIMIZE} =~ s/-TP(\s|$)//;
+        $self->{CCFLAGS} .= '-DPERL_CAPI';
+    }
     return $self->{CFLAGS} = qq{
 CCFLAGS = $self->{CCFLAGS}
 OPTIMIZE = $self->{OPTIMIZE}
@@ -3240,9 +3246,11 @@ sub tool_xsubpp {
 	}
     }
 
+    $xsubpp = $self->{CAPI} ? "xsubpp -perlobject" : "xsubpp";
+
     return qq{
 XSUBPPDIR = $xsdir
-XSUBPP = \$(XSUBPPDIR)/xsubpp
+XSUBPP = \$(XSUBPPDIR)/$xsubpp
 XSPROTOARG = $self->{XSPROTOARG}
 XSUBPPDEPS = @tmdeps
 XSUBPPARGS = @tmargs
diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm
index d6dfe4a613..5b0184c39e 100644
--- a/lib/ExtUtils/MM_Win32.pm
+++ b/lib/ExtUtils/MM_Win32.pm
@@ -449,8 +449,14 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists
 
 sub perl_archive
 {
+    my ($self) = @_;
     if($OBJ) {
-	return '$(PERL_INC)\perlcore$(LIB_EXT)';
+        if ($self->{CAPI} eq 'TRUE') {
+            return '$(PERL_INC)\PerlCAPI$(LIB_EXT)';
+        }
+        else {
+            return '$(PERL_INC)\perlcore$(LIB_EXT)';
+        }
     }
     return '$(PERL_INC)\perl$(LIB_EXT)';
 }
diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm
index c86486ac1a..6735b034c0 100644
--- a/lib/ExtUtils/MakeMaker.pm
+++ b/lib/ExtUtils/MakeMaker.pm
@@ -235,7 +235,7 @@ sub full_setup {
 
     @Attrib_help = qw/
 
-    AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION LICENSE_HREF
+    AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION LICENSE_HREF CAPI
     C CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS
     EXE_FILES EXCLUDE_EXT INCLUDE_EXT NO_VC FIRST_MAKEFILE FULLPERL H
     INC INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR
diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm
index 4ac175af5e..2f2366a1c8 100644
--- a/lib/ExtUtils/Mksymlists.pm
+++ b/lib/ExtUtils/Mksymlists.pm
@@ -178,6 +178,13 @@ sub _write_vms {
     }
     close OPT;
 
+    # Options file specifying RTLs to which this extension must be linked.
+    # Eventually, the list of libraries will be supplied by a working
+    # extliblist routine.
+    open OPT,'>rtls.opt';
+    print OPT "PerlShr/Share\n";
+    foreach $rtl (split(/\s+/,$Config::Config{'libs'})) { print OPT "$rtl\n"; }
+    close OPT;
 }
 
 1;
diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 58b3a08705..fafa9cc2d5 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -6,7 +6,7 @@ xsubpp - compiler to convert Perl XS code into C code
 
 =head1 SYNOPSIS
 
-B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-typemap typemap>]... file.xs
+B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-typemap typemap>] [B<-perlobject>]... file.xs
 
 =head1 DESCRIPTION
 
@@ -59,7 +59,11 @@ number.
 
 Prevents the inclusion of `#line' directives in the output.
 
-=back
+=item B<-perlobject>
+
+Compile code as C in a PERL_OBJECT environment.
+
+back
 
 =head1 ENVIRONMENT
 
@@ -122,6 +126,7 @@ SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
     $WantPrototypes = 1, next SWITCH	if $flag eq 'prototypes';
     $WantVersionChk = 0, next SWITCH	if $flag eq 'noversioncheck';
     $WantVersionChk = 1, next SWITCH	if $flag eq 'versioncheck';
+    $WantCAPI = 1, next SWITCH    if $flag eq 'perlobject';
     $except = " TRY",	next SWITCH	if $flag eq 'except';
     push(@tm,shift),	next SWITCH	if $flag eq 'typemap';
     $WantLineNumbers = 0, next SWITCH	if $flag eq 'nolinenumbers';
@@ -1175,6 +1180,19 @@ EOF
 }
 
 # print initialization routine
+if ($WantCAPI) {
+print Q<<"EOF";
+#
+##ifdef __cplusplus
+#extern "C"
+##endif
+#XS(boot__CAPI_entry)
+#[[
+#    dXSARGS;
+#    char* file = __FILE__;
+#
+EOF
+} else {
 print Q<<"EOF";
 ##ifdef __cplusplus
 #extern "C"
@@ -1185,6 +1203,7 @@ print Q<<"EOF";
 #    char* file = __FILE__;
 #
 EOF
+}
 
 print Q<<"EOF" if $WantVersionChk ;
 #    XS_VERSION_BOOTCHECK ;
@@ -1215,7 +1234,24 @@ print Q<<"EOF";;
 #    ST(0) = &sv_yes;
 #    XSRETURN(1);
 #]]
+#
+EOF
+
+if ($WantCAPI) { 
+print Q<<"EOF";
+#
+##define XSCAPI(name) void name(void* pPerl, CV* cv)
+##ifdef __cplusplus
+#extern "C"
+##endif
+#XSCAPI(boot_$Module_cname)
+#[[
+#    SetCPerlObj(pPerl);
+#    boot__CAPI_entry(cv);
+#]]
+#
 EOF
+}
 
 warn("Please specify prototyping behavior for $filename (see perlxs manual)\n") 
     unless $ProtoUsed ;
diff --git a/op.c b/op.c
index 616b792e7f..25469329d3 100644
--- a/op.c
+++ b/op.c
@@ -3550,7 +3550,7 @@ newCONSTSUB(HV *stash, char *name, SV *sv)
 }
 
 CV *
-newXS(char *name, void (*subaddr) (CPERLproto_ CV *), char *filename)
+newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
 {
     dTHR;
     GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
diff --git a/perl.h b/perl.h
index 376a99fa9d..9b139ecfb0 100644
--- a/perl.h
+++ b/perl.h
@@ -104,11 +104,12 @@ class CPerlObj;
 #define STATIC
 #define CPERLscope(x) CPerlObj::x
 #define CPERLproto CPerlObj *
-#define CPERLproto_ CPERLproto,
+#define _CPERLproto ,CPERLproto
 #define CPERLarg CPerlObj *pPerl
 #define CPERLarg_ CPERLarg,
+#define _CPERLarg ,CPERLarg
 #define THIS this
-#define THIS_ this,
+#define _THIS ,this
 #define CALLRUNOPS (this->*runops)
 
 #else /* !PERL_OBJECT */
@@ -116,10 +117,12 @@ class CPerlObj;
 #define STATIC static
 #define CPERLscope(x) x
 #define CPERLproto
-#define CPERLproto_ 
+#define _CPERLproto
 #define CPERLarg void
 #define CPERLarg_
+#define _CPERLarg
 #define THIS
+#define _THIS
 #define THIS_
 #define CALLRUNOPS runops
 
@@ -1195,6 +1198,10 @@ union any {
     IV		any_iv;
     long	any_long;
     void	(CPERLscope(*any_dptr)) _((void*));
+#if defined(WIN32) && !defined(PERL_OBJECT)
+	/* Visual C thinks that a pointer to a member variable is 16 bytes in size. */
+	char	handle_VC_problem[16];
+#endif
 };
 
 #ifdef USE_THREADS
diff --git a/pp_ctl.c b/pp_ctl.c
index 7dfe540721..86668c9368 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1762,7 +1762,7 @@ PP(pp_goto)
 		}
 		else {
 		    stack_sp--;		/* There is no cv arg. */
-		    (void)(*CvXSUB(cv))(THIS_ cv);
+		    (void)(*CvXSUB(cv))(cv _THIS);
 		}
 		LEAVE;
 		return pop_return();
diff --git a/pp_hot.c b/pp_hot.c
index 9549737dac..630f3cb79e 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2093,7 +2093,7 @@ PP(pp_entersub)
 		curcopdb = NULL;
 	    }
 	    /* Do we need to open block here? XXXX */
-	    (void)(*CvXSUB(cv))(THIS_ cv);
+	    (void)(*CvXSUB(cv))(cv _THIS);
 
 	    /* Enforce some sanity in scalar context. */
 	    if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
diff --git a/proto.h b/proto.h
index dcb26cb23f..159eeeedae 100644
--- a/proto.h
+++ b/proto.h
@@ -60,7 +60,7 @@ VIRTUAL OP*	block_end _((I32 floor, OP* seq));
 VIRTUAL I32	block_gimme _((void));
 VIRTUAL int	block_start _((int full));
 VIRTUAL void	boot_core_UNIVERSAL _((void));
-VIRTUAL void	call_list _((I32 oldscope, AV* list));
+VIRTUAL void	call_list _((I32 oldscope, AV* av_list));
 VIRTUAL I32	cando _((I32 bit, I32 effective, Stat_t* statbufp));
 #ifndef CASTNEGFLOAT
 VIRTUAL U32	cast_ulong _((double f));
@@ -276,7 +276,7 @@ VIRTUAL char*	mem_collxfrm _((const char* s, STRLEN len, STRLEN* xlen));
 #endif
 VIRTUAL char*	mess _((const char* pat, va_list* args));
 VIRTUAL int	mg_clear _((SV* sv));
-VIRTUAL int	mg_copy _((SV* , SV* , char* , I32));
+VIRTUAL int	mg_copy _((SV* sv, SV* nsv, char* key, I32 klen));
 VIRTUAL MAGIC*	mg_find _((SV* sv, int type));
 VIRTUAL int	mg_free _((SV* sv));
 VIRTUAL int	mg_get _((SV* sv));
@@ -321,7 +321,7 @@ VIRTUAL OP*	newASSIGNOP _((I32 flags, OP* left, I32 optype, OP* right));
 VIRTUAL OP*	newCONDOP _((I32 flags, OP* expr, OP* trueop, OP* falseop));
 VIRTUAL void	newCONSTSUB _((HV* stash, char* name, SV* sv));
 VIRTUAL void	newFORM _((I32 floor, OP* o, OP* block));
-VIRTUAL OP*	newFOROP _((I32 flags, char* label, line_t forline, OP* scalar, OP* expr, OP*block, OP*cont));
+VIRTUAL OP*	newFOROP _((I32 flags, char* label, line_t forline, OP* sclr, OP* expr, OP*block, OP*cont));
 VIRTUAL OP*	newLOGOP _((I32 optype, I32 flags, OP* left, OP* right));
 VIRTUAL OP*	newLOOPEX _((I32 type, OP* label));
 VIRTUAL OP*	newLOOPOP _((I32 flags, I32 debuggable, OP* expr, OP* block));
@@ -332,7 +332,7 @@ VIRTUAL OP*	newRANGE _((I32 flags, OP* left, OP* right));
 VIRTUAL OP*	newSLICEOP _((I32 flags, OP* subscript, OP* list));
 VIRTUAL OP*	newSTATEOP _((I32 flags, char* label, OP* o));
 VIRTUAL CV*	newSUB _((I32 floor, OP* o, OP* proto, OP* block));
-VIRTUAL CV*	newXS _((char* name, void (*subaddr)(CPERLproto_ CV* cv), char* filename));
+VIRTUAL CV*	newXS _((char* name, void (*subaddr)(CV* cv _CPERLproto), char* filename));
 VIRTUAL AV*	newAV _((void));
 VIRTUAL OP*	newAVREF _((OP* o));
 VIRTUAL OP*	newBINOP _((I32 type, I32 flags, OP* first, OP* last));
@@ -346,9 +346,9 @@ VIRTUAL IO*	newIO _((void));
 VIRTUAL OP*	newLISTOP _((I32 type, I32 flags, OP* first, OP* last));
 VIRTUAL OP*	newPMOP _((I32 type, I32 flags));
 VIRTUAL OP*	newPVOP _((I32 type, I32 flags, char* pv));
-VIRTUAL SV*	newRV _((SV* ref));
+VIRTUAL SV*	newRV _((SV* pref));
 #if !defined(__GNUC__) && (defined(CRIPPLED_CC) || defined(USE_THREADS) || defined(PERL_OBJECT))
-VIRTUAL SV*	newRV_noinc _((SV *));
+VIRTUAL SV*	newRV_noinc _((SV *sv));
 #endif
 #ifdef LEAKTEST
 VIRTUAL SV*	newSV _((I32 x, STRLEN len));
@@ -389,9 +389,9 @@ VIRTUAL void	peep _((OP* o));
 #ifndef PERL_OBJECT
 PerlInterpreter*	perl_alloc _((void));
 #endif
-VIRTUAL I32	perl_call_argv _((char* subname, I32 flags, char** argv));
+VIRTUAL I32	perl_call_argv _((char* sub_name, I32 flags, char** argv));
 VIRTUAL I32	perl_call_method _((char* methname, I32 flags));
-VIRTUAL I32	perl_call_pv _((char* subname, I32 flags));
+VIRTUAL I32	perl_call_pv _((char* sub_name, I32 flags));
 VIRTUAL I32	perl_call_sv _((SV* sv, I32 flags));
 #ifdef PERL_OBJECT
 VIRTUAL void	perl_construct _((void));
@@ -448,19 +448,19 @@ void	regdump _((regexp* r));
 VIRTUAL I32	pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave));
 VIRTUAL I32	regexec_flags _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags));
 VIRTUAL void	pregfree _((struct regexp* r));
-VIRTUAL regnode*regnext _((regnode* p));
+VIRTUAL regnode* regnext _((regnode* p));
 #ifdef DEBUGGING
 void	regprop _((SV* sv, regnode* o));
 #endif
 VIRTUAL void	repeatcpy _((char* to, char* from, I32 len, I32 count));
 VIRTUAL char*	rninstr _((char* big, char* bigend, char* little, char* lend));
-VIRTUAL Sighandler_t rsignal _((int, Sighandler_t));
-VIRTUAL int	rsignal_restore _((int, Sigsave_t*));
-VIRTUAL int	rsignal_save _((int, Sighandler_t, Sigsave_t*));
-VIRTUAL Sighandler_t rsignal_state _((int));
+VIRTUAL Sighandler_t rsignal _((int i, Sighandler_t t));
+VIRTUAL int	rsignal_restore _((int i, Sigsave_t* t));
+VIRTUAL int	rsignal_save _((int i, Sighandler_t t1, Sigsave_t* t2));
+VIRTUAL Sighandler_t rsignal_state _((int i));
 VIRTUAL void	rxres_free _((void** rsp));
-VIRTUAL void	rxres_restore _((void** rsp, REGEXP* rx));
-VIRTUAL void	rxres_save _((void** rsp, REGEXP* rx));
+VIRTUAL void	rxres_restore _((void** rsp, REGEXP* prx));
+VIRTUAL void	rxres_save _((void** rsp, REGEXP* prx));
 #ifndef HAS_RENAME
 VIRTUAL I32	same_dirent _((char* a, char* b));
 #endif
@@ -532,8 +532,8 @@ VIRTUAL UV	sv_2uv _((SV* sv));
 VIRTUAL IV	sv_iv _((SV* sv));
 VIRTUAL UV	sv_uv _((SV* sv));
 VIRTUAL double	sv_nv _((SV* sv));
-VIRTUAL char *	sv_pvn _((SV *, STRLEN *));
-VIRTUAL I32	sv_true _((SV *));
+VIRTUAL char *	sv_pvn _((SV *sv, STRLEN *len));
+VIRTUAL I32	sv_true _((SV *sv));
 VIRTUAL void	sv_add_arena _((char* ptr, U32 size, U32 flags));
 VIRTUAL int	sv_backoff _((SV* sv));
 VIRTUAL SV*	sv_bless _((SV* sv, HV* stash));
@@ -1233,10 +1233,10 @@ void restore_rsfp _((void *f));
 void restore_expect _((void *e));
 void restore_lex_expect _((void *e));
 void yydestruct _((void *ptr));
-VIRTUAL int fprintf _((PerlIO *, const char *, ...));
+VIRTUAL int fprintf _((PerlIO *pf, const char *pat, ...));
 
 #ifdef WIN32
-VIRTUAL int&	ErrorNo();
+VIRTUAL int&	ErrorNo _((void));
 #endif	/* WIN32 */
 #else	/* !PERL_OBJECT */
 END_EXTERN_C
diff --git a/sv.h b/sv.h
index 2799cd530d..693cc3268a 100644
--- a/sv.h
+++ b/sv.h
@@ -270,7 +270,7 @@ struct xpvfm {
     HV *	xcv_stash;
     OP *	xcv_start;
     OP *	xcv_root;
-    void      (*xcv_xsub)_((CV*));
+    void      (*xcv_xsub)_((CV* _CPERLproto));
     ANY		xcv_xsubany;
     GV *	xcv_gv;
     GV *	xcv_filegv;
diff --git a/thread.h b/thread.h
index 2c6e192a7f..f1f4d8eeef 100644
--- a/thread.h
+++ b/thread.h
@@ -225,7 +225,7 @@ typedef struct condpair {
 #define THR
 /* Rats: if dTHR is just blank then the subsequent ";" throws an error */
 #ifdef WIN32
-#define dTHR
+#define dTHR extern int Perl___notused
 #else
 #define dTHR extern int errno
 #endif
diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl
new file mode 100644
index 0000000000..d096da302e
--- /dev/null
+++ b/win32/GenCAPI.pl
@@ -0,0 +1,1015 @@
+
+# creates a C API file from proto.h
+# takes one argument, the path to lib/CORE directory.
+# creates 2 files: "PerlCAPI.cpp" and "PerlCAPI.h".
+
+my $hdrfile = "$ARGV[0]\\PerlCAPI.h";
+my $infile = '..\\proto.h';
+my $embedfile = '..\\embed.h';
+my $separateObj = 0;
+
+my %skip_list;
+my %embed;
+
+sub readembed(\%$) {
+    my ($syms, $file) = @_;
+    my ($line, @words);
+    %$syms = ();
+    local (*FILE, $_);
+    open(FILE, "< $file")
+	or die "$0: Can't open $file: $!\n";
+    while ($line = <FILE>) {
+	chop($line);
+	if ($line =~ /^#define\s+\w+/) {
+	    $line =~ s/^#define\s+//;
+	    @words = split ' ', $line;
+#	    print "$words[0]\t$words[1]\n";
+	    $$syms{$words[0]} = $words[1];
+	}
+    }
+    close(FILE);
+}
+
+readembed %embed, $embedfile;
+
+sub skip_these {
+    my $list = shift;
+    foreach my $symbol (@$list) {
+	$skip_list{$symbol} = 1;
+    }
+}
+
+skip_these [qw(
+cando
+cast_ulong
+my_chsize
+condpair_magic
+deb
+deb_growlevel
+debprofdump
+debop
+debstack
+debstackptrs
+fprintf
+find_threadsv
+magic_mutexfree
+my_pclose
+my_popen
+my_swap
+my_htonl
+my_ntohl
+new_struct_thread
+same_dirent
+unlnk
+unlock_condpair
+safexmalloc
+safexcalloc
+safexrealloc
+safexfree
+Perl_GetVars
+)];
+
+
+
+if (!open(INFILE, "<$infile")) {
+    print "open of $infile failed: $!\n";
+    return 1;
+}
+
+if (!open(OUTFILE, ">PerlCAPI.cpp")) {
+    print "open of PerlCAPI.cpp failed: $!\n";
+    return 1;
+}
+
+print OUTFILE "#include \"EXTERN.h\"\n#include \"perl.h\"\n#include \"XSUB.h\"\n\n";
+print OUTFILE "#define DESTRUCTORFUNC (void (*)(void*))\n\n";
+print OUTFILE "#ifdef SetCPerlObj_defined\n" unless ($separateObj == 0); 
+print OUTFILE "extern \"C\" void SetCPerlObj(CPerlObj* pP)\n{\n\tpPerl = pP;\n}\n";
+print OUTFILE "#endif\n" unless ($separateObj == 0); 
+
+while () {
+    last unless defined ($_ = <INFILE>);
+    if (/^VIRTUAL\s/) {
+        while (!/;$/) {
+            chomp;
+            $_ .= <INFILE>;
+        }
+        $_ =~ s/^VIRTUAL\s*//;
+        $_ =~ s/\s*__attribute__.*$/;/;
+        if ( /(.*)\s([A-z_]*[0-9A-z_]+\s)_\(\((.*)\)\);/ ||
+             /(.*)\*([A-z_]*[0-9A-z_]+\s)_\(\((.*)\)\);/ ) {
+            $type = $1;
+            $name = $2;
+            $args = $3;
+ 
+            $name =~ s/\s*$//;
+            $type =~ s/\s*$//;
+	    next if (defined $skip_list{$name});
+
+	    if($args eq "ARGSproto") {
+		$args = "void";
+	    }
+
+            $return = ($type eq "void" or $type eq "Free_t") ? "\t" : "\treturn";
+
+	    if(defined $embed{$name}) {
+		$funcName = $embed{$name};
+	    } else {
+		$funcName = $name;
+	    }
+
+            @args = split(',', $args);
+            if ($args[$#args] =~ /\s*\.\.\.\s*/) {
+                if(($name eq "croak") or ($name eq "deb") or ($name eq "die")
+		        or ($name eq "form") or ($name eq "warn")) {
+                    print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+                    print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ($args)\n{\n";
+                    $args[0] =~ /(\w+)\W*$/; 
+                    $arg = $1;
+                    print OUTFILE "\tva_list args;\n\tva_start(args, $arg);\n";
+                    print OUTFILE "$return pPerl->Perl_$name(pPerl->Perl_mess($arg, &args));\n";
+                    print OUTFILE "\tva_end(args);\n}\n";
+                    print OUTFILE "#endif\n" unless ($separateObj == 0);
+                }
+                elsif($name eq "newSVpvf") {
+                    print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+                    print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ($args)\n{\n";
+                    $args[0] =~ /(\w+)\W*$/; 
+                    $arg = $1;
+                    print OUTFILE "\tSV *sv;\n\tva_list args;\n\tva_start(args, $arg);\n";
+                    print OUTFILE "\tsv = pPerl->Perl_newSV(0);\n";
+                    print OUTFILE "\tpPerl->Perl_sv_vcatpvfn(sv, $arg, strlen($arg), &args, NULL, 0, NULL);\n";
+                    print OUTFILE "\tva_end(args);\n\treturn sv;\n}\n";
+                    print OUTFILE "#endif\n" unless ($separateObj == 0);
+                }
+                elsif($name eq "sv_catpvf") {
+                    print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+                    print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ($args)\n{\n";
+                    $args[0] =~ /(\w+)\W*$/; 
+                    $arg0 = $1;
+                    $args[1] =~ /(\w+)\W*$/; 
+                    $arg1 = $1;
+                    print OUTFILE "\tva_list args;\n\tva_start(args, $arg1);\n";
+                    print OUTFILE "\tpPerl->Perl_sv_vcatpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);\n";
+                    print OUTFILE "\tva_end(args);\n}\n";
+                    print OUTFILE "#endif\n" unless ($separateObj == 0);
+                }
+                elsif($name eq "sv_setpvf") {
+                    print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+                    print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ($args)\n{\n";
+                    $args[0] =~ /(\w+)\W*$/; 
+                    $arg0 = $1;
+                    $args[1] =~ /(\w+)\W*$/; 
+                    $arg1 = $1;
+                    print OUTFILE "\tva_list args;\n\tva_start(args, $arg1);\n";
+                    print OUTFILE "\tpPerl->Perl_sv_vsetpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);\n";
+                    print OUTFILE "\tva_end(args);\n}\n";
+                    print OUTFILE "#endif\n" unless ($separateObj == 0);
+                }
+                elsif($name eq "fprintf") {
+                    print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+                    print OUTFILE "\n#undef $name\nextern \"C\" $type $name ($args)\n{\n";
+                    $args[0] =~ /(\w+)\W*$/; 
+                    $arg0 = $1;
+                    $args[1] =~ /(\w+)\W*$/; 
+                    $arg1 = $1;
+                    print OUTFILE "\tint nRet;\n\tva_list args;\n\tva_start(args, $arg1);\n";
+                    print OUTFILE "\tnRet = PerlIO_vprintf($arg0, $arg1, args);\n";
+                    print OUTFILE "\tva_end(args);\n\treturn nRet;\n}\n";
+                    print OUTFILE "#endif\n" unless ($separateObj == 0);
+                } else {
+                    print "Warning: can't handle varargs function '$name'\n";
+                }
+                next;
+            }
+
+	    # newXS special case
+	    if ($name eq "newXS") {
+		next;
+	    }
+            
+            print OUTFILE "\n#ifdef $name" . "defined" unless ($separateObj == 0);
+
+	    # handle specical case for save_destructor
+	    if ($name eq "save_destructor") {
+		next;
+	    }
+	    # handle specical case for sighandler
+	    if ($name eq "sighandler") {
+		next;
+	    }
+	    # handle special case for sv_grow
+	    if ($name eq "sv_grow" and $args eq "SV* sv, unsigned long newlen") {
+		next;
+	    }
+	    # handle special case for newSV
+	    if ($name eq "newSV" and $args eq "I32 x, STRLEN len") {
+		next;
+	    }
+	    # handle special case for perl_parse
+	    if ($name eq "perl_parse") {
+		print OUTFILE "\n#undef $name\nextern \"C\" $type $name ($args)\n{\n";
+		print OUTFILE "\treturn pPerl->perl_parse(xsinit, argc, argv, env);\n}\n";
+                print OUTFILE "#endif\n" unless ($separateObj == 0);
+		next;
+	    }
+
+            # foo(void);
+            if ($args eq "void") {
+                print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ()\n{\n$return pPerl->$funcName();\n}\n";
+                print OUTFILE "#endif\n" unless ($separateObj == 0);
+                next;
+            }
+
+            # foo(char *s, const int bar);
+            print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ($args)\n{\n$return pPerl->$funcName";
+            $doneone = 0;
+            foreach $arg (@args) {
+                if ($arg =~ /(\w+)\W*$/) {
+                    if ($doneone) {
+                        print OUTFILE ", $1";
+                    }
+                    else {
+                        print OUTFILE "($1";
+                        $doneone++;
+                    }
+                }
+            }
+            print OUTFILE ");\n}\n";
+            print OUTFILE "#endif\n" unless ($separateObj == 0);
+        }
+        else {
+            print "failed to match $_";
+        }
+    }
+}
+
+close INFILE;
+
+%skip_list = ();
+
+skip_these [qw(
+strchop
+filemode
+lastfd
+oldname
+curinterp
+Argv
+Cmd
+sortcop
+sortstash
+firstgv
+secondgv
+sortstack
+signalstack
+mystrk
+dumplvl
+oldlastpm
+gensym
+preambled
+preambleav
+Ilaststatval
+Ilaststype
+mess_sv
+ors
+opsave
+eval_mutex
+orslen
+ofmt
+mh
+modcount
+generation
+DBcv
+archpat_auto
+sortcxix
+lastgotoprobe
+regdummy
+regparse
+regxend
+regcode
+regnaughty
+regsawback
+regprecomp
+regnpar
+regsize
+regflags
+regseen
+seen_zerolen
+rx
+extralen
+colorset
+colors
+reginput
+regbol
+regeol
+regstartp
+regendp
+reglastparen
+regtill
+regprev
+reg_start_tmp
+reg_start_tmpl
+regdata
+bostr
+reg_flags
+reg_eval_set
+regnarrate
+regprogram
+regindent
+regcc
+in_clean_objs
+in_clean_all
+linestart
+pending_ident
+statusvalue_vms
+sublex_info
+thrsv
+threadnum
+piMem
+piENV
+piStdIO
+piLIO
+piDir
+piSock
+piProc
+cshname
+threadsv_names
+thread
+nthreads
+thr_key
+threads_mutex
+malloc_mutex
+svref_mutex
+sv_mutex
+nthreads_cond
+eval_cond
+cryptseen
+cshlen
+)];
+
+sub readvars(\%$$) {
+    my ($syms, $file, $pre) = @_;
+    %$syms = ();
+    local (*FILE, $_);
+    open(FILE, "< $file")
+	or die "$0: Can't open $file: $!\n";
+    while (<FILE>) {
+	s/[ \t]*#.*//;		# Delete comments.
+	if (/PERLVARI?C?\($pre(\w+),\s*([^,)]+)/) {
+	    $$syms{$1} = $2;
+	}
+    }
+    close(FILE);
+}
+
+my %intrp;
+my %thread;
+my %globvar;
+
+readvars %intrp,  '..\intrpvar.h','I';
+readvars %thread, '..\thrdvar.h','T';
+readvars %globvar, '..\perlvars.h','G';
+
+open(HDRFILE, ">$hdrfile") or die "$0: Can't open $hdrfile: $!\n";
+print HDRFILE "\nvoid SetCPerlObj(void* pP);";
+print HDRFILE "\nCV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename);\n";
+
+sub DoVariable($$) {
+    my $name = shift;
+    my $type = shift;
+
+    return if (defined $skip_list{$name});
+    return if ($type eq 'struct perl_thread *');
+
+    print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+    print OUTFILE "\nextern \"C\" $type * _Perl_$name ()\n{\n";
+    print OUTFILE "\treturn (($type *)&pPerl->Perl_$name);\n}\n";
+    print OUTFILE "#endif\n" unless ($separateObj == 0);
+
+    print HDRFILE "\n#undef Perl_$name\n$type * _Perl_$name ();";
+    print HDRFILE "\n#define Perl_$name (*_Perl_$name())\n\n";
+}
+
+foreach $key (keys %intrp) {
+    DoVariable ($key, $intrp{$key});
+}
+
+foreach $key (keys %thread) {
+    DoVariable ($key, $thread{$key});
+}
+
+foreach $key (keys %globvar) {
+    DoVariable ($key, $globvar{$key});
+}
+
+print OUTFILE <<EOCODE;
+
+
+extern "C" {
+void xs_handler(CV* cv, CPerlObj* pPerl)
+{
+    void(*func)(CV*);
+    SV* sv;
+    MAGIC* m = pPerl->Perl_mg_find((SV*)cv, '~');
+    if(m != NULL)
+    {
+	sv = m->mg_obj;
+	if(SvIOK(sv))
+	{
+	    func = (void(*)(CV*))SvIVX(sv);
+	}
+	else
+	{
+	    func = (void(*)(CV*))pPerl->Perl_sv_2iv(sv);
+	}
+	SetCPerlObj(pPerl);
+	func(cv);
+    }
+}
+
+CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename)
+{
+    CV* cv = pPerl->Perl_newXS(name, xs_handler, filename);
+    pPerl->Perl_sv_magic((SV*)cv, pPerl->Perl_sv_2mortal(pPerl->Perl_newSViv((IV)subaddr)), '~', "CAPI", 4);
+    return cv;
+}
+
+#undef piMem
+#undef piENV
+#undef piStdIO
+#undef piLIO
+#undef piDir
+#undef piSock
+#undef piProc
+
+int *        _win32_errno(void)
+{
+    return &pPerl->ErrorNo();
+}
+
+FILE*        _win32_stdin(void)
+{
+    return (FILE*)pPerl->piStdIO->Stdin();
+}
+
+FILE*        _win32_stdout(void)
+{
+    return (FILE*)pPerl->piStdIO->Stdout();
+}
+
+FILE*        _win32_stderr(void)
+{
+    return (FILE*)pPerl->piStdIO->Stderr();
+}
+
+int          _win32_ferror(FILE *fp)
+{
+    return pPerl->piStdIO->Error((PerlIO*)fp, ErrorNo());
+}
+
+int          _win32_feof(FILE *fp)
+{
+    return pPerl->piStdIO->Eof((PerlIO*)fp, ErrorNo());
+}
+
+char*	     _win32_strerror(int e)
+{
+    return strerror(e);
+}
+
+void	     _win32_perror(const char *str)
+{
+    perror(str);
+}
+
+int          _win32_vfprintf(FILE *pf, const char *format, va_list arg)
+{
+    return pPerl->piStdIO->Vprintf((PerlIO*)pf, ErrorNo(), format, arg);
+}
+
+int          _win32_vprintf(const char *format, va_list arg)
+{
+    return pPerl->piStdIO->Vprintf(pPerl->piStdIO->Stdout(), ErrorNo(), format, arg);
+}
+
+int          _win32_fprintf(FILE *pf, const char *format, ...)
+{
+    int ret;
+    va_list args;
+    va_start(args, format);
+    ret = _win32_vfprintf(pf, format, args);
+    va_end(args);
+    return ret;
+}
+
+int          _win32_printf(const char *format, ...)
+{
+    int ret;
+    va_list args;
+    va_start(args, format);
+    ret = _win32_vprintf(format, args);
+    va_end(args);
+    return ret;
+}
+
+size_t       _win32_fread(void *buf, size_t size, size_t count, FILE *pf)
+{
+    return pPerl->piStdIO->Read((PerlIO*)pf, buf, (size*count), ErrorNo());
+}
+
+size_t       _win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf)
+{
+    return pPerl->piStdIO->Write((PerlIO*)pf, buf, (size*count), ErrorNo());
+}
+
+FILE*        _win32_fopen(const char *path, const char *mode)
+{
+    return (FILE*)pPerl->piStdIO->Open(path, mode, ErrorNo());
+}
+
+FILE*        _win32_fdopen(int fh, const char *mode)
+{
+    return (FILE*)pPerl->piStdIO->Fdopen(fh, mode, ErrorNo());
+}
+
+FILE*        _win32_freopen(const char *path, const char *mode, FILE *pf)
+{
+    return (FILE*)pPerl->piStdIO->Reopen(path, mode, (PerlIO*)pf, ErrorNo());
+}
+
+int          _win32_fclose(FILE *pf)
+{
+    return pPerl->piStdIO->Close((PerlIO*)pf, ErrorNo());
+}
+
+int          _win32_fputs(const char *s,FILE *pf)
+{
+    return pPerl->piStdIO->Puts((PerlIO*)pf, s, ErrorNo());
+}
+
+int          _win32_fputc(int c,FILE *pf)
+{
+    return pPerl->piStdIO->Putc((PerlIO*)pf, c, ErrorNo());
+}
+
+int          _win32_ungetc(int c,FILE *pf)
+{
+    return pPerl->piStdIO->Ungetc((PerlIO*)pf, c, ErrorNo());
+}
+
+int          _win32_getc(FILE *pf)
+{
+    return pPerl->piStdIO->Getc((PerlIO*)pf, ErrorNo());
+}
+
+int          _win32_fileno(FILE *pf)
+{
+    return pPerl->piStdIO->Fileno((PerlIO*)pf, ErrorNo());
+}
+
+void         _win32_clearerr(FILE *pf)
+{
+    pPerl->piStdIO->Clearerr((PerlIO*)pf, ErrorNo());
+}
+
+int          _win32_fflush(FILE *pf)
+{
+    return pPerl->piStdIO->Flush((PerlIO*)pf, ErrorNo());
+}
+
+long         _win32_ftell(FILE *pf)
+{
+    return pPerl->piStdIO->Tell((PerlIO*)pf, ErrorNo());
+}
+
+int          _win32_fseek(FILE *pf,long offset,int origin)
+{
+    return pPerl->piStdIO->Seek((PerlIO*)pf, offset, origin, ErrorNo());
+}
+
+int          _win32_fgetpos(FILE *pf,fpos_t *p)
+{
+    return pPerl->piStdIO->Getpos((PerlIO*)pf, p, ErrorNo());
+}
+
+int          _win32_fsetpos(FILE *pf,const fpos_t *p)
+{
+    return pPerl->piStdIO->Setpos((PerlIO*)pf, p, ErrorNo());
+}
+
+void         _win32_rewind(FILE *pf)
+{
+    pPerl->piStdIO->Rewind((PerlIO*)pf, ErrorNo());
+}
+
+FILE*        _win32_tmpfile(void)
+{
+    return (FILE*)pPerl->piStdIO->Tmpfile(ErrorNo());
+}
+
+void         _win32_setbuf(FILE *pf, char *buf)
+{
+    pPerl->piStdIO->SetBuf((PerlIO*)pf, buf, ErrorNo());
+}
+
+int          _win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
+{
+    return pPerl->piStdIO->SetVBuf((PerlIO*)pf, buf, type, size, ErrorNo());
+}
+
+int          _win32_fgetc(FILE *pf)
+{
+    return pPerl->piStdIO->Getc((PerlIO*)pf, ErrorNo());
+}
+
+int          _win32_putc(int c, FILE *pf)
+{
+    return pPerl->piStdIO->Putc((PerlIO*)pf, c, ErrorNo());
+}
+
+int          _win32_puts(const char *s)
+{
+    return pPerl->piStdIO->Puts(pPerl->piStdIO->Stdout(), s, ErrorNo());
+}
+
+int          _win32_getchar(void)
+{
+    return pPerl->piStdIO->Getc(pPerl->piStdIO->Stdin(), ErrorNo());
+}
+
+int          _win32_putchar(int c)
+{
+    return pPerl->piStdIO->Putc(pPerl->piStdIO->Stdout(), c, ErrorNo());
+}
+
+void*        _win32_malloc(size_t size)
+{
+    return pPerl->piMem->Malloc(size);
+}
+
+void*        _win32_calloc(size_t numitems, size_t size)
+{
+    return pPerl->piMem->Malloc(numitems*size);
+}
+
+void*        _win32_realloc(void *block, size_t size)
+{
+    return pPerl->piMem->Realloc(block, size);
+}
+
+void         _win32_free(void *block)
+{
+    pPerl->piMem->Free(block);
+}
+
+void         _win32_abort(void)
+{
+    pPerl->piProc->Abort();
+}
+
+int          _win32_pipe(int *phandles, unsigned int psize, int textmode)
+{
+    return pPerl->piProc->Pipe(phandles);
+}
+
+FILE*        _win32_popen(const char *command, const char *mode)
+{
+    return (FILE*)pPerl->piProc->Popen(command, mode);
+}
+
+int          _win32_pclose(FILE *pf)
+{
+    return pPerl->piProc->Pclose((PerlIO*)pf);
+}
+
+unsigned     _win32_sleep(unsigned int t)
+{
+    return pPerl->piProc->Sleep(t);
+}
+
+int	_win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
+{
+    return pPerl->piProc->Spawnvp(mode, cmdname, argv);
+}
+
+int          _win32_mkdir(const char *dir, int mode)
+{
+    return pPerl->piDir->Makedir(dir, mode, ErrorNo());
+}
+
+int          _win32_rmdir(const char *dir)
+{
+    return pPerl->piDir->Rmdir(dir, ErrorNo());
+}
+
+int          _win32_chdir(const char *dir)
+{
+    return pPerl->piDir->Chdir(dir, ErrorNo());
+}
+
+#undef stat
+int          _win32_fstat(int fd,struct stat *sbufptr)
+{
+    return pPerl->piLIO->FileStat(fd, sbufptr, ErrorNo());
+}
+
+int          _win32_stat(const char *name,struct stat *sbufptr)
+{
+    return pPerl->piLIO->NameStat(name, sbufptr, ErrorNo());
+}
+
+int          _win32_setmode(int fd, int mode)
+{
+    return pPerl->piLIO->Setmode(fd, mode, ErrorNo());
+}
+
+long         _win32_lseek(int fd, long offset, int origin)
+{
+    return pPerl->piLIO->Lseek(fd, offset, origin, ErrorNo());
+}
+
+long         _win32_tell(int fd)
+{
+    return pPerl->piStdIO->Tell((PerlIO*)fd, ErrorNo());
+}
+
+int          _win32_dup(int fd)
+{
+    return pPerl->piLIO->Dup(fd, ErrorNo());
+}
+
+int          _win32_dup2(int h1, int h2)
+{
+    return pPerl->piLIO->Dup2(h1, h2, ErrorNo());
+}
+
+int          _win32_open(const char *path, int oflag,...)
+{
+    return pPerl->piLIO->Open(path, oflag, ErrorNo());
+}
+
+int          _win32_close(int fd)
+{
+    return pPerl->piLIO->Close(fd, ErrorNo());
+}
+
+int          _win32_read(int fd, void *buf, unsigned int cnt)
+{
+    return pPerl->piLIO->Read(fd, buf, cnt, ErrorNo());
+}
+
+int          _win32_write(int fd, const void *buf, unsigned int cnt)
+{
+    return pPerl->piLIO->Write(fd, buf, cnt, ErrorNo());
+}
+
+int          _win32_times(struct tms *timebuf)
+{
+    return pPerl->piProc->Times(timebuf);
+}
+
+int          _win32_ioctl(int i, unsigned int u, char *data)
+{
+    return pPerl->piLIO->IOCtl(i, u, data, ErrorNo());
+}
+
+int          _win32_utime(const char *f, struct utimbuf *t)
+{
+    return pPerl->piLIO->Utime((char*)f, t, ErrorNo());
+}
+
+char*   _win32_getenv(const char *name)
+{
+    return pPerl->piENV->Getenv(name, ErrorNo());
+}
+
+int          _win32_open_osfhandle(long handle, int flags)
+{
+    return pPerl->piStdIO->OpenOSfhandle(handle, flags);
+}
+
+long         _win32_get_osfhandle(int fd)
+{
+    return pPerl->piStdIO->GetOSfhandle(fd);
+}
+} /* extern "C" */
+EOCODE
+
+
+print HDRFILE <<EOCODE;
+#undef win32_errno
+#undef win32_stdin
+#undef win32_stdout
+#undef win32_stderr
+#undef win32_ferror
+#undef win32_feof
+#undef win32_fprintf
+#undef win32_printf
+#undef win32_vfprintf
+#undef win32_vprintf
+#undef win32_fread
+#undef win32_fwrite
+#undef win32_fopen
+#undef win32_fdopen
+#undef win32_freopen
+#undef win32_fclose
+#undef win32_fputs
+#undef win32_fputc
+#undef win32_ungetc
+#undef win32_getc
+#undef win32_fileno
+#undef win32_clearerr
+#undef win32_fflush
+#undef win32_ftell
+#undef win32_fseek
+#undef win32_fgetpos
+#undef win32_fsetpos
+#undef win32_rewind
+#undef win32_tmpfile
+#undef win32_abort
+#undef win32_fstat
+#undef win32_stat
+#undef win32_pipe
+#undef win32_popen
+#undef win32_pclose
+#undef win32_setmode
+#undef win32_lseek
+#undef win32_tell
+#undef win32_dup
+#undef win32_dup2
+#undef win32_open
+#undef win32_close
+#undef win32_eof
+#undef win32_read
+#undef win32_write
+#undef win32_mkdir
+#undef win32_rmdir
+#undef win32_chdir
+#undef win32_setbuf
+#undef win32_setvbuf
+#undef win32_fgetc
+#undef win32_putc
+#undef win32_puts
+#undef win32_getchar
+#undef win32_putchar
+#undef win32_malloc
+#undef win32_calloc
+#undef win32_realloc
+#undef win32_free
+#undef win32_sleep
+#undef win32_times
+#undef win32_stat
+#undef win32_ioctl
+#undef win32_utime
+#undef win32_getenv
+
+#define win32_errno    _win32_errno
+#define win32_stdin    _win32_stdin
+#define win32_stdout   _win32_stdout
+#define win32_stderr   _win32_stderr
+#define win32_ferror   _win32_ferror
+#define win32_feof     _win32_feof
+#define win32_strerror _win32_strerror
+#define win32_perror   _win32_perror
+#define win32_fprintf  _win32_fprintf
+#define win32_printf   _win32_printf
+#define win32_vfprintf _win32_vfprintf
+#define win32_vprintf  _win32_vprintf
+#define win32_fread    _win32_fread
+#define win32_fwrite   _win32_fwrite
+#define win32_fopen    _win32_fopen
+#define win32_fdopen   _win32_fdopen
+#define win32_freopen  _win32_freopen
+#define win32_fclose   _win32_fclose
+#define win32_fputs    _win32_fputs
+#define win32_fputc    _win32_fputc
+#define win32_ungetc   _win32_ungetc
+#define win32_getc     _win32_getc
+#define win32_fileno   _win32_fileno
+#define win32_clearerr _win32_clearerr
+#define win32_fflush   _win32_fflush
+#define win32_ftell    _win32_ftell
+#define win32_fseek    _win32_fseek
+#define win32_fgetpos  _win32_fgetpos
+#define win32_fsetpos  _win32_fsetpos
+#define win32_rewind   _win32_rewind
+#define win32_tmpfile  _win32_tmpfile
+#define win32_abort    _win32_abort
+#define win32_fstat    _win32_fstat
+#define win32_stat     _win32_stat
+#define win32_pipe     _win32_pipe
+#define win32_popen    _win32_popen
+#define win32_pclose   _win32_pclose
+#define win32_setmode  _win32_setmode
+#define win32_lseek    _win32_lseek
+#define win32_tell     _win32_tell
+#define win32_dup      _win32_dup
+#define win32_dup2     _win32_dup2
+#define win32_open     _win32_open
+#define win32_close    _win32_close
+#define win32_eof      _win32_eof
+#define win32_read     _win32_read
+#define win32_write    _win32_write
+#define win32_mkdir    _win32_mkdir
+#define win32_rmdir    _win32_rmdir
+#define win32_chdir    _win32_chdir
+#define win32_setbuf   _win32_setbuf
+#define win32_setvbuf  _win32_setvbuf
+#define win32_fgetc    _win32_fgetc
+#define win32_putc     _win32_putc
+#define win32_puts     _win32_puts
+#define win32_getchar  _win32_getchar
+#define win32_putchar  _win32_putchar
+#define win32_malloc   _win32_malloc
+#define win32_calloc   _win32_calloc
+#define win32_realloc  _win32_realloc
+#define win32_free     _win32_free
+#define win32_sleep    _win32_sleep
+#define win32_spawnvp  _win32_spawnvp
+#define win32_times    _win32_times
+#define win32_stat     _win32_stat
+#define win32_ioctl    _win32_ioctl
+#define win32_utime    _win32_utime
+#define win32_getenv   _win32_getenv
+#define win32_open_osfhandle _win32_open_osfhandle
+#define win32_get_osfhandle  _win32_get_osfhandle
+
+int * 	_win32_errno(void);
+FILE*	_win32_stdin(void);
+FILE*	_win32_stdout(void);
+FILE*	_win32_stderr(void);
+int	_win32_ferror(FILE *fp);
+int	_win32_feof(FILE *fp);
+char*	_win32_strerror(int e);
+void    _win32_perror(const char *str);
+int	_win32_fprintf(FILE *pf, const char *format, ...);
+int	_win32_printf(const char *format, ...);
+int	_win32_vfprintf(FILE *pf, const char *format, va_list arg);
+int	_win32_vprintf(const char *format, va_list arg);
+size_t	_win32_fread(void *buf, size_t size, size_t count, FILE *pf);
+size_t	_win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf);
+FILE*	_win32_fopen(const char *path, const char *mode);
+FILE*	_win32_fdopen(int fh, const char *mode);
+FILE*	_win32_freopen(const char *path, const char *mode, FILE *pf);
+int	_win32_fclose(FILE *pf);
+int	_win32_fputs(const char *s,FILE *pf);
+int	_win32_fputc(int c,FILE *pf);
+int	_win32_ungetc(int c,FILE *pf);
+int	_win32_getc(FILE *pf);
+int	_win32_fileno(FILE *pf);
+void	_win32_clearerr(FILE *pf);
+int	_win32_fflush(FILE *pf);
+long	_win32_ftell(FILE *pf);
+int	_win32_fseek(FILE *pf,long offset,int origin);
+int	_win32_fgetpos(FILE *pf,fpos_t *p);
+int	_win32_fsetpos(FILE *pf,const fpos_t *p);
+void	_win32_rewind(FILE *pf);
+FILE*	_win32_tmpfile(void);
+void	_win32_abort(void);
+int  	_win32_fstat(int fd,struct stat *sbufptr);
+int  	_win32_stat(const char *name,struct stat *sbufptr);
+int	_win32_pipe( int *phandles, unsigned int psize, int textmode );
+FILE*	_win32_popen( const char *command, const char *mode );
+int	_win32_pclose( FILE *pf);
+int	_win32_setmode( int fd, int mode);
+long	_win32_lseek( int fd, long offset, int origin);
+long	_win32_tell( int fd);
+int	_win32_dup( int fd);
+int	_win32_dup2(int h1, int h2);
+int	_win32_open(const char *path, int oflag,...);
+int	_win32_close(int fd);
+int	_win32_eof(int fd);
+int	_win32_read(int fd, void *buf, unsigned int cnt);
+int	_win32_write(int fd, const void *buf, unsigned int cnt);
+int	_win32_mkdir(const char *dir, int mode);
+int	_win32_rmdir(const char *dir);
+int	_win32_chdir(const char *dir);
+void	_win32_setbuf(FILE *pf, char *buf);
+int	_win32_setvbuf(FILE *pf, char *buf, int type, size_t size);
+char*	_win32_fgets(char *s, int n, FILE *pf);
+char*	_win32_gets(char *s);
+int	_win32_fgetc(FILE *pf);
+int	_win32_putc(int c, FILE *pf);
+int	_win32_puts(const char *s);
+int	_win32_getchar(void);
+int	_win32_putchar(int c);
+void*	_win32_malloc(size_t size);
+void*	_win32_calloc(size_t numitems, size_t size);
+void*	_win32_realloc(void *block, size_t size);
+void	_win32_free(void *block);
+unsigned _win32_sleep(unsigned int);
+int	_win32_spawnvp(int mode, const char *cmdname, const char *const *argv);
+int	_win32_times(struct tms *timebuf);
+int	_win32_stat(const char *path, struct stat *buf);
+int	_win32_ioctl(int i, unsigned int u, char *data);
+int	_win32_utime(const char *f, struct utimbuf *t);
+char*   _win32_getenv(const char *name);
+int     _win32_open_osfhandle(long handle, int flags);
+long    _win32_get_osfhandle(int fd);
+
+#pragma warning(once : 4113)
+EOCODE
+
+
+close HDRFILE;
+close OUTFILE;
diff --git a/win32/Makefile b/win32/Makefile
index f8095d8f76..29e92d15ec 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -141,7 +141,7 @@ LINK_DBG	= -debug -pdb:none
 !  IF "$(CCTYPE)" == "MSVC20"
 OPTIMIZE	= -Od $(RUNTIME) -DNDEBUG
 !  ELSE
-OPTIMIZE	= -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE	= -O2 $(RUNTIME) -DNDEBUG
 !  ENDIF
 LINK_DBG	= -release
 !ENDIF
@@ -200,9 +200,11 @@ EXTUTILSDIR	= $(LIBDIR)\extutils
 !IF "$(OBJECT)" == "-DPERL_OBJECT"
 PERLIMPLIB	= ..\perlcore.lib
 PERLDLL		= ..\perlcore.dll
+CAPILIB		= $(COREDIR)\PerlCAPI.lib
 !ELSE
 PERLIMPLIB	= ..\perl.lib
 PERLDLL		= ..\perl.dll
+CAPILIB		=
 !ENDIF
 
 MINIPERL	= ..\miniperl.exe
@@ -430,7 +432,7 @@ CFG_VARS	=					\
 # Top targets
 #
 
-all : $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) $(X2P) \
+all : $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) $(CAPILIB) $(X2P) \
 	$(EXTENSION_DLL)
 
 $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
@@ -575,6 +577,18 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
 	$(XSUBPP) dl_win32.xs > $(*B).c
 	cd ..\..\win32
 
+!IF "$(OBJECT)" == "-DPERL_OBJECT"
+PerlCAPI.cpp : $(MINIPERL)
+	$(MINIPERL) GenCAPI.pl $(COREDIR)
+
+PerlCAPI$(o) : PerlCAPI.cpp
+	$(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+	    $(OBJOUT_FLAG)PerlCAPI$(o) PerlCAPI.cpp
+
+$(CAPILIB) : PerlCAPI.cpp PerlCAPI$(o)
+	lib /OUT:$(CAPILIB) PerlCAPI$(o)
+!ENDIF
+
 $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
 	copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
 
@@ -647,7 +661,7 @@ utils: $(PERLEXE)
 	$(PERLEXE) -I..\lib $(PL2BAT) bin\network.pl bin\www.pl bin\runperl.pl \
 			bin\pl2bat.pl bin\perlglob.pl
 
-distclean: clean
+realclean: clean
 	-del /f $(MINIPERL) $(PERLEXE) $(PERL95EXE) $(PERLDLL) $(GLOBEXE) \
 		$(PERLIMPLIB) ..\miniperl.lib $(MINIMOD)
 	-del /f *.def *.map
@@ -655,13 +669,22 @@ distclean: clean
 	-del /f $(EXTENSION_C)
 	-del /f $(PODDIR)\*.html
 	-del /f $(PODDIR)\*.bat
+	-del /f ..\utils\h2ph ..\utils\splain ..\utils\perlbug ..\utils\pl2pm ..\utils\c2ph
+	-del /f ..\utils\h2xs ..\utils\perldoc ..\utils\pstruct ..\utils\*.bat
 	-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
-	-del /f ..\lib\Config.pm
+	-del /f $(CONFIGPM)
 	-del /f perl95.c
 	-del /f bin\*.bat
 	cd $(EXTDIR)
 	-del /s *.lib *.def *.map *.bs Makefile *$(o) pm_to_blib
 	cd ..\win32
+	-del /f $(EXTDIR)\DynaLoader\dl_win32.xs
+	-del /f $(EXTDIR)\DynaLoader\DynaLoader.c
+	-del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\Dynaloader.pm $(LIBDIR)\FCntl.pm
+	-del /f $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm
+	-del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm
+	-del /f ..\x2p\find2perl ..\x2p\s2p
+	-rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO
 	-rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR)
 	-rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR)
 	-rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR)
@@ -711,10 +734,12 @@ clean :
 	-@erase perlmain$(o)
 	-@erase config.w32
 	-@erase /f config.h
+	-@erase PerlCAPI.cpp
 	-@erase $(GLOBEXE)
 	-@erase $(PERLEXE)
 	-@erase $(PERLDLL)
 	-@erase $(CORE_OBJ)
+	-@erase $(CAPILIB)
 	-rmdir /s /q "$(MINIDIR)"
 	-@erase $(WIN32_OBJ)
 	-@erase $(DLL_OBJ)
diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs
index 2f330b4e1e..b9d4c14bd3 100644
--- a/win32/dl_win32.xs
+++ b/win32/dl_win32.xs
@@ -133,7 +133,7 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     CODE:
     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
 		      perl_name, symref));
-    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CPERLarg_ CV*))symref, filename)));
+    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV* _CPERLarg))symref, filename)));
 
 
 char *
diff --git a/win32/runperl.c b/win32/runperl.c
index 755b386358..cfa195d044 100644
--- a/win32/runperl.c
+++ b/win32/runperl.c
@@ -23,13 +23,6 @@ CPerlObj *pPerl;
 #include <ipproc.h>
 #include <ipstdio.h>
 
-class IPerlStdIOWin : public IPerlStdIO
-{
-public:
-    virtual int OpenOSfhandle(long osfhandle, int flags) = 0;
-    virtual int GetOSfhandle(int filenum) = 0;
-};
-
 extern int g_closedir(DIR *dirp);
 extern DIR *g_opendir(char *filename);
 extern struct direct *g_readdir(DIR *dirp);
@@ -668,7 +661,7 @@ public:
 };
 
 
-class CPerlStdIO : public IPerlStdIOWin
+class CPerlStdIO : public IPerlStdIO
 {
 public:
     CPerlStdIO() {};
@@ -1001,7 +994,7 @@ char *staticlinkmodules[] = {
     NULL,
 };
 
-EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv));
+EXTERN_C void boot_DynaLoader _((CV* cv _CPERLarg));
 
 static void
 xs_init(CPERLarg)
diff --git a/win32/win32.c b/win32/win32.c
index 7208e6bd08..674b047446 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -349,6 +349,7 @@ win32_get_sitelib(char *pl)
     char szPathStr[MAX_PATH];
     char *lpPath1;
     char *lpPath2;
+	int len, newSize;
 
     /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */
     sprintf(szRegStr, "%s-%s", szSiteLib, pl);
@@ -363,8 +364,8 @@ win32_get_sitelib(char *pl)
     if (lpPath2 == NULL)
 	return lpPath1;
 
-    int len = strlen(lpPath1);
-    int newSize = len + strlen(lpPath2) + 2; /* plus one for ';' */
+    len = strlen(lpPath1);
+    newSize = len + strlen(lpPath2) + 2; /* plus one for ';' */
 
     lpPath1 = Renew(lpPath1, newSize, char);
     if (lpPath1 != NULL)
@@ -2908,13 +2909,14 @@ XS(w32_RegSetValue)
 
     unsigned int size;
     char *buffer;
+	DWORD type;
 
     if (items != 4) 
     {
 	croak("usage: Win32::RegSetValue($hkey, $subKey, $type, $data);\n");
     }
 
-    DWORD type = SvIV(ST(2));
+    type = SvIV(ST(2));
     if (type != REG_SZ && type != REG_EXPAND_SZ)
     {
 	croak("Win32::RegSetValue: Type was not REG_SZ or REG_EXPAND_SZ, cannot set %s\n", (char *)SvPV(ST(1), na));