summaryrefslogtreecommitdiff
path: root/win32
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1998-05-29 11:05:50 +0000
committerGurusamy Sarathy <gsar@cpan.org>1998-05-29 11:05:50 +0000
commit26ca90b622247714396690e385249f8ca1417aa0 (patch)
tree520b78b2e1d8b3429b4833f9ee8a1465d8e6abc2 /win32
parent8a29a26d101c2a07bdfaee1b99a0c73504c5cbe4 (diff)
parent30ac6d9be367ff08cc605906fbe575fb1ca35fdf (diff)
downloadperl-26ca90b622247714396690e385249f8ca1417aa0.tar.gz
[win32] reverse integrate asperl branch contents (phew!)
- various fixups to ensure AS stuff does no harm - adjust win32/makefiles for the new directory layout (new layout looks rather a muddle--needs rework) - verified build & test on NT and Solaris/gcc p4raw-id: //depot/win32/perl@1060
Diffstat (limited to 'win32')
-rw-r--r--win32/GenCAPI.pl1546
-rw-r--r--win32/Makefile81
-rw-r--r--win32/config.bc24
-rw-r--r--win32/config.gc24
-rw-r--r--win32/config.vc24
-rw-r--r--win32/config_H.bc22
-rw-r--r--win32/config_H.gc22
-rw-r--r--win32/config_H.vc22
-rw-r--r--win32/config_h.PL28
-rw-r--r--win32/config_sh.PL1
-rw-r--r--win32/dl_win32.xs55
-rw-r--r--win32/include/sys/socket.h2
-rw-r--r--win32/makedef.pl97
-rw-r--r--win32/makefile.mk80
-rw-r--r--win32/runperl.c1026
-rw-r--r--win32/win32.c1057
-rw-r--r--win32/win32.h32
-rw-r--r--win32/win32iop.h5
-rw-r--r--win32/win32sck.c16
-rw-r--r--win32/win32thread.c6
20 files changed, 3989 insertions, 181 deletions
diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl
new file mode 100644
index 0000000000..67b3de4fa9
--- /dev/null
+++ b/win32/GenCAPI.pl
@@ -0,0 +1,1546 @@
+
+# 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
+dump_fds
+dump_mstats
+fprintf
+find_threadsv
+magic_mutexfree
+my_memcmp
+my_memset
+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 <<ENDCODE;
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define DESTRUCTORFUNC (void (*)(void*))
+
+ENDCODE
+
+print OUTFILE "#ifdef SetCPerlObj_defined\n" unless ($separateObj == 0);
+
+print OUTFILE <<ENDCODE;
+extern "C" void SetCPerlObj(CPerlObj* pP)
+{
+ pPerl = pP;
+}
+
+ENDCODE
+
+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);
+ $args[0] =~ /(\w+)\W*$/;
+ $arg = $1;
+ print OUTFILE <<ENDCODE;
+
+#undef $name
+extern "C" $type $funcName ($args)
+{
+ char *pstr;
+ char *pmsg;
+ va_list args;
+ va_start(args, $arg);
+ pmsg = pPerl->Perl_mess($arg, &args);
+ New(0, pstr, strlen(pmsg)+1, char);
+ strcpy(pstr, pmsg);
+$return pPerl->Perl_$name(pstr);
+ va_end(args);
+}
+ENDCODE
+ print OUTFILE "#endif\n" unless ($separateObj == 0);
+ }
+ elsif($name eq "newSVpvf") {
+ print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+ $args[0] =~ /(\w+)\W*$/;
+ $arg = $1;
+ print OUTFILE <<ENDCODE;
+
+#undef $name
+extern "C" $type $funcName ($args)
+{
+ SV *sv;
+ va_list args;
+ va_start(args, $arg);
+ sv = pPerl->Perl_newSV(0);
+ pPerl->Perl_sv_vcatpvfn(sv, $arg, strlen($arg), &args, NULL, 0, NULL);
+ va_end(args);
+ return sv;
+}
+ENDCODE
+ print OUTFILE "#endif\n" unless ($separateObj == 0);
+ }
+ elsif($name eq "sv_catpvf") {
+ print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+ $args[0] =~ /(\w+)\W*$/;
+ $arg0 = $1;
+ $args[1] =~ /(\w+)\W*$/;
+ $arg1 = $1;
+ print OUTFILE <<ENDCODE;
+
+#undef $name
+extern "C" $type $funcName ($args)
+{
+ va_list args;
+ va_start(args, $arg1);
+ pPerl->Perl_sv_vcatpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);
+ va_end(args);
+}
+ENDCODE
+ print OUTFILE "#endif\n" unless ($separateObj == 0);
+ }
+ elsif($name eq "sv_setpvf") {
+ print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+ $args[0] =~ /(\w+)\W*$/;
+ $arg0 = $1;
+ $args[1] =~ /(\w+)\W*$/;
+ $arg1 = $1;
+ print OUTFILE <<ENDCODE;
+
+#undef $name
+extern "C" $type $funcName ($args)
+{
+ va_list args;
+ va_start(args, $arg1);
+ pPerl->Perl_sv_vsetpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);
+ va_end(args);
+}
+ENDCODE
+ print OUTFILE "#endif\n" unless ($separateObj == 0);
+ }
+ elsif($name eq "fprintf") {
+ print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+ $args[0] =~ /(\w+)\W*$/;
+ $arg0 = $1;
+ $args[1] =~ /(\w+)\W*$/;
+ $arg1 = $1;
+ print OUTFILE <<ENDCODE;
+
+#undef $name
+extern "C" $type $name ($args)
+{
+ int nRet;
+ va_list args;
+ va_start(args, $arg1);
+ nRet = PerlIO_vprintf($arg0, $arg1, args);
+ va_end(args);
+ return nRet;
+}
+ENDCODE
+ 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 <<ENDCODE;
+
+#undef $name
+extern "C" $type $name ($args)
+{
+ return pPerl->perl_parse(xsinit, argc, argv, env);
+}
+ENDCODE
+ print OUTFILE "#endif\n" unless ($separateObj == 0);
+ next;
+ }
+ # handle special case for perl_atexit
+ if ($name eq "perl_atexit") {
+ print OUTFILE <<ENDCODE;
+
+#undef $name
+extern "C" $type $name ($args)
+{
+ pPerl->perl_atexit(fn, ptr);
+}
+ENDCODE
+ print OUTFILE "#endif\n" unless ($separateObj == 0);
+ next;
+ }
+
+
+ if($name eq "byterun" and $args eq "struct bytestream bs") {
+ next;
+ }
+
+ # foo(void);
+ if ($args eq "void") {
+ print OUTFILE <<ENDCODE;
+
+#undef $name
+extern "C" $type $funcName ()
+{
+$return pPerl->$funcName();
+}
+
+ENDCODE
+ print OUTFILE "#endif\n" unless ($separateObj == 0);
+ next;
+ }
+
+ # foo(char *s, const int bar);
+ print OUTFILE <<ENDCODE;
+
+#undef $name
+extern "C" $type $funcName ($args)
+{
+ENDCODE
+ print OUTFILE "$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 <<ENDCODE;
+void SetCPerlObj(void* pP);
+CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename);
+
+ENDCODE
+
+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 <<ENDCODE;
+extern "C" $type * _Perl_$name ()
+{
+ return (($type *)&pPerl->Perl_$name);
+}
+
+ENDCODE
+
+ print OUTFILE "#endif\n" unless ($separateObj == 0);
+
+ print HDRFILE <<ENDCODE;
+
+#undef Perl_$name
+$type * _Perl_$name ();
+#define Perl_$name (*_Perl_$name())
+
+ENDCODE
+
+}
+
+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" {
+
+
+char ** _Perl_op_desc(void)
+{
+ return pPerl->Perl_get_op_descs();
+}
+
+char ** _Perl_op_name(void)
+{
+ return pPerl->Perl_get_op_names();
+}
+
+char * _Perl_no_modify(void)
+{
+ return pPerl->Perl_get_no_modify();
+}
+
+U32 * _Perl_opargs(void)
+{
+ return pPerl->Perl_get_opargs();
+}
+
+void xs_handler(CV* cv, CPerlObj* p)
+{
+ 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);
+ }
+ 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;
+}
+
+
+void Perl_deb(const char pat, ...)
+{
+}
+
+#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());
+}
+
+char* _win32_fgets(char *s, int n, FILE *pf)
+{
+ return pPerl->piStdIO->Gets((PerlIO*)pf, s, n, ErrorNo());
+}
+
+char* _win32_gets(char *s)
+{
+ return _win32_fgets(s, 80, (FILE*)pPerl->piStdIO->Stdin());
+}
+
+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);
+}
+
+u_long _win32_htonl (u_long hostlong)
+{
+ return pPerl->piSock->Htonl(hostlong);
+}
+
+u_short _win32_htons (u_short hostshort)
+{
+ return pPerl->piSock->Htons(hostshort);
+}
+
+u_long _win32_ntohl (u_long netlong)
+{
+ return pPerl->piSock->Ntohl(netlong);
+}
+
+u_short _win32_ntohs (u_short netshort)
+{
+ return pPerl->piSock->Ntohs(netshort);
+}
+
+unsigned long _win32_inet_addr (const char * cp)
+{
+ return pPerl->piSock->InetAddr(cp, ErrorNo());
+}
+
+char * _win32_inet_ntoa (struct in_addr in)
+{
+ return pPerl->piSock->InetNtoa(in, ErrorNo());
+}
+
+SOCKET _win32_socket (int af, int type, int protocol)
+{
+ return pPerl->piSock->Socket(af, type, protocol, ErrorNo());
+}
+
+int _win32_bind (SOCKET s, const struct sockaddr *addr, int namelen)
+{
+ return pPerl->piSock->Bind(s, addr, namelen, ErrorNo());
+}
+
+int _win32_listen (SOCKET s, int backlog)
+{
+ return pPerl->piSock->Listen(s, backlog, ErrorNo());
+}
+
+SOCKET _win32_accept (SOCKET s, struct sockaddr *addr, int *addrlen)
+{
+ return pPerl->piSock->Accept(s, addr, addrlen, ErrorNo());
+}
+
+int _win32_connect (SOCKET s, const struct sockaddr *name, int namelen)
+{
+ return pPerl->piSock->Connect(s, name, namelen, ErrorNo());
+}
+
+int _win32_send (SOCKET s, const char * buf, int len, int flags)
+{
+ return pPerl->piSock->Send(s, buf, len, flags, ErrorNo());
+}
+
+int _win32_sendto (SOCKET s, const char * buf, int len, int flags,
+ const struct sockaddr *to, int tolen)
+{
+ return pPerl->piSock->Sendto(s, buf, len, flags, to, tolen, ErrorNo());
+}
+
+int _win32_recv (SOCKET s, char * buf, int len, int flags)
+{
+ return pPerl->piSock->Recv(s, buf, len, flags, ErrorNo());
+}
+
+int _win32_recvfrom (SOCKET s, char * buf, int len, int flags,
+ struct sockaddr *from, int * fromlen)
+{
+ return pPerl->piSock->Recvfrom(s, buf, len, flags, from, fromlen, ErrorNo());
+}
+
+int _win32_shutdown (SOCKET s, int how)
+{
+ return pPerl->piSock->Shutdown(s, how, ErrorNo());
+}
+
+int _win32_closesocket (SOCKET s)
+{
+ return pPerl->piSock->Closesocket(s, ErrorNo());
+}
+
+int _win32_ioctlsocket (SOCKET s, long cmd, u_long *argp)
+{
+ return pPerl->piSock->Ioctlsocket(s, cmd, argp, ErrorNo());
+}
+
+int _win32_setsockopt (SOCKET s, int level, int optname,
+ const char * optval, int optlen)
+{
+ return pPerl->piSock->Setsockopt(s, level, optname, optval, optlen, ErrorNo());
+}
+
+int _win32_getsockopt (SOCKET s, int level, int optname, char * optval, int *optlen)
+{
+ return pPerl->piSock->Getsockopt(s, level, optname, optval, optlen, ErrorNo());
+}
+
+int _win32_getpeername (SOCKET s, struct sockaddr *name, int * namelen)
+{
+ return pPerl->piSock->Getpeername(s, name, namelen, ErrorNo());
+}
+
+int _win32_getsockname (SOCKET s, struct sockaddr *name, int * namelen)
+{
+ return pPerl->piSock->Getsockname(s, name, namelen, ErrorNo());
+}
+
+int _win32_gethostname (char * name, int namelen)
+{
+ return pPerl->piSock->Gethostname(name, namelen, ErrorNo());
+}
+
+struct hostent * _win32_gethostbyname(const char * name)
+{
+ return pPerl->piSock->Gethostbyname(name, ErrorNo());
+}
+
+struct hostent * _win32_gethostbyaddr(const char * addr, int len, int type)
+{
+ return pPerl->piSock->Gethostbyaddr(addr, len, type, ErrorNo());
+}
+
+struct protoent * _win32_getprotobyname(const char * name)
+{
+ return pPerl->piSock->Getprotobyname(name, ErrorNo());
+}
+
+struct protoent * _win32_getprotobynumber(int proto)
+{
+ return pPerl->piSock->Getprotobynumber(proto, ErrorNo());
+}
+
+struct servent * _win32_getservbyname(const char * name, const char * proto)
+{
+ return pPerl->piSock->Getservbyname(name, proto, ErrorNo());
+}
+
+struct servent * _win32_getservbyport(int port, const char * proto)
+{
+ return pPerl->piSock->Getservbyport(port, proto, ErrorNo());
+}
+
+int _win32_select (int nfds, Perl_fd_set *rfds, Perl_fd_set *wfds, Perl_fd_set *xfds,
+ const struct timeval *timeout)
+{
+ return pPerl->piSock->Select(nfds, (char*)rfds, (char*)wfds, (char*)xfds, timeout, ErrorNo());
+}
+
+void _win32_endnetent(void)
+{
+ pPerl->piSock->Endnetent(ErrorNo());
+}
+
+void _win32_endhostent(void)
+{
+ pPerl->piSock->Endhostent(ErrorNo());
+}
+
+void _win32_endprotoent(void)
+{
+ pPerl->piSock->Endprotoent(ErrorNo());
+}
+
+void _win32_endservent(void)
+{
+ pPerl->piSock->Endservent(ErrorNo());
+}
+
+struct netent * _win32_getnetent(void)
+{
+ return pPerl->piSock->Getnetent(ErrorNo());
+}
+
+struct netent * _win32_getnetbyname(char *name)
+{
+ return pPerl->piSock->Getnetbyname(name, ErrorNo());
+}
+
+struct netent * _win32_getnetbyaddr(long net, int type)
+{
+ return pPerl->piSock->Getnetbyaddr(net, type, ErrorNo());
+}
+
+struct protoent *_win32_getprotoent(void)
+{
+ return pPerl->piSock->Getprotoent(ErrorNo());
+}
+
+struct servent *_win32_getservent(void)
+{
+ return pPerl->piSock->Getservent(ErrorNo());
+}
+
+void _win32_sethostent(int stayopen)
+{
+ pPerl->piSock->Sethostent(stayopen, ErrorNo());
+}
+
+void _win32_setnetent(int stayopen)
+{
+ pPerl->piSock->Setnetent(stayopen, ErrorNo());
+}
+
+void _win32_setprotoent(int stayopen)
+{
+ pPerl->piSock->Setprotoent(stayopen, ErrorNo());
+}
+
+void _win32_setservent(int stayopen)
+{
+ pPerl->piSock->Setservent(stayopen, ErrorNo());
+}
+} /* extern "C" */
+EOCODE
+
+
+print HDRFILE <<EOCODE;
+#undef Perl_op_desc
+char ** _Perl_op_desc ();
+#define Perl_op_desc (_Perl_op_desc())
+
+#undef Perl_op_name
+char ** _Perl_op_name ();
+#define Perl_op_name (_Perl_op_name())
+
+#undef Perl_no_modify
+char * _Perl_no_modify ();
+#define Perl_no_modify (_Perl_no_modify())
+
+#undef Perl_opargs
+U32 * _Perl_opargs ();
+#define Perl_opargs (_Perl_opargs())
+
+
+#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_fgets
+#undef win32_gets
+#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
+
+#undef win32_htonl
+#undef win32_htons
+#undef win32_ntohl
+#undef win32_ntohs
+#undef win32_inet_addr
+#undef win32_inet_ntoa
+
+#undef win32_socket
+#undef win32_bind
+#undef win32_listen
+#undef win32_accept
+#undef win32_connect
+#undef win32_send
+#undef win32_sendto
+#undef win32_recv
+#undef win32_recvfrom
+#undef win32_shutdown
+#undef win32_closesocket
+#undef win32_ioctlsocket
+#undef win32_setsockopt
+#undef win32_getsockopt
+#undef win32_getpeername
+#undef win32_getsockname
+#undef win32_gethostname
+#undef win32_gethostbyname
+#undef win32_gethostbyaddr
+#undef win32_getprotobyname
+#undef win32_getprotobynumber
+#undef win32_getservbyname
+#undef win32_getservbyport
+#undef win32_select
+#undef win32_endhostent
+#undef win32_endnetent
+#undef win32_endprotoent
+#undef win32_endservent
+#undef win32_getnetent
+#undef win32_getnetbyname
+#undef win32_getnetbyaddr
+#undef win32_getprotoent
+#undef win32_getservent
+#undef win32_sethostent
+#undef win32_setnetent
+#undef win32_setprotoent
+#undef win32_setservent
+
+#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_fgets _win32_fgets
+#define win32_gets _win32_gets
+#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
+
+#define win32_htonl _win32_htonl
+#define win32_htons _win32_htons
+#define win32_ntohl _win32_ntohl
+#define win32_ntohs _win32_ntohs
+#define win32_inet_addr _win32_inet_addr
+#define win32_inet_ntoa _win32_inet_ntoa
+
+#define win32_socket _win32_socket
+#define win32_bind _win32_bind
+#define win32_listen _win32_listen
+#define win32_accept _win32_accept
+#define win32_connect _win32_connect
+#define win32_send _win32_send
+#define win32_sendto _win32_sendto
+#define win32_recv _win32_recv
+#define win32_recvfrom _win32_recvfrom
+#define win32_shutdown _win32_shutdown
+#define win32_closesocket _win32_closesocket
+#define win32_ioctlsocket _win32_ioctlsocket
+#define win32_setsockopt _win32_setsockopt
+#define win32_getsockopt _win32_getsockopt
+#define win32_getpeername _win32_getpeername
+#define win32_getsockname _win32_getsockname
+#define win32_gethostname _win32_gethostname
+#define win32_gethostbyname _win32_gethostbyname
+#define win32_gethostbyaddr _win32_gethostbyaddr
+#define win32_getprotobyname _win32_getprotobyname
+#define win32_getprotobynumber _win32_getprotobynumber
+#define win32_getservbyname _win32_getservbyname
+#define win32_getservbyport _win32_getservbyport
+#define win32_select _win32_select
+#define win32_endhostent _win32_endhostent
+#define win32_endnetent _win32_endnetent
+#define win32_endprotoent _win32_endprotoent
+#define win32_endservent _win32_endservent
+#define win32_getnetent _win32_getnetent
+#define win32_getnetbyname _win32_getnetbyname
+#define win32_getnetbyaddr _win32_getnetbyaddr
+#define win32_getprotoent _win32_getprotoent
+#define win32_getservent _win32_getservent
+#define win32_sethostent _win32_sethostent
+#define win32_setnetent _win32_setnetent
+#define win32_setprotoent _win32_setprotoent
+#define win32_setservent _win32_setservent
+
+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);
+
+u_long _win32_htonl (u_long hostlong);
+u_short _win32_htons (u_short hostshort);
+u_long _win32_ntohl (u_long netlong);
+u_short _win32_ntohs (u_short netshort);
+unsigned long _win32_inet_addr (const char * cp);
+char * _win32_inet_ntoa (struct in_addr in);
+
+SOCKET _win32_socket (int af, int type, int protocol);
+int _win32_bind (SOCKET s, const struct sockaddr *addr, int namelen);
+int _win32_listen (SOCKET s, int backlog);
+SOCKET _win32_accept (SOCKET s, struct sockaddr *addr, int *addrlen);
+int _win32_connect (SOCKET s, const struct sockaddr *name, int namelen);
+int _win32_send (SOCKET s, const char * buf, int len, int flags);
+int _win32_sendto (SOCKET s, const char * buf, int len, int flags,
+ const struct sockaddr *to, int tolen);
+int _win32_recv (SOCKET s, char * buf, int len, int flags);
+int _win32_recvfrom (SOCKET s, char * buf, int len, int flags,
+ struct sockaddr *from, int * fromlen);
+int _win32_shutdown (SOCKET s, int how);
+int _win32_closesocket (SOCKET s);
+int _win32_ioctlsocket (SOCKET s, long cmd, u_long *argp);
+int _win32_setsockopt (SOCKET s, int level, int optname,
+ const char * optval, int optlen);
+int _win32_getsockopt (SOCKET s, int level, int optname, char * optval, int *optlen);
+int _win32_getpeername (SOCKET s, struct sockaddr *name, int * namelen);
+int _win32_getsockname (SOCKET s, struct sockaddr *name, int * namelen);
+int _win32_gethostname (char * name, int namelen);
+struct hostent * _win32_gethostbyname(const char * name);
+struct hostent * _win32_gethostbyaddr(const char * addr, int len, int type);
+struct protoent * _win32_getprotobyname(const char * name);
+struct protoent * _win32_getprotobynumber(int proto);
+struct servent * _win32_getservbyname(const char * name, const char * proto);
+struct servent * _win32_getservbyport(int port, const char * proto);
+int _win32_select (int nfds, Perl_fd_set *rfds, Perl_fd_set *wfds, Perl_fd_set *xfds,
+ const struct timeval *timeout);
+void _win32_endnetent(void);
+void _win32_endhostent(void);
+void _win32_endprotoent(void);
+void _win32_endservent(void);
+struct netent * _win32_getnetent(void);
+struct netent * _win32_getnetbyname(char *name);
+struct netent * _win32_getnetbyaddr(long net, int type);
+struct protoent *_win32_getprotoent(void);
+struct servent *_win32_getservent(void);
+void _win32_sethostent(int stayopen);
+void _win32_setnetent(int stayopen);
+void _win32_setprotoent(int stayopen);
+void _win32_setservent(int stayopen);
+
+#pragma warning(once : 4113)
+EOCODE
+
+
+close HDRFILE;
+close OUTFILE;
diff --git a/win32/Makefile b/win32/Makefile
index a1b037f791..16ea34d283 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -3,13 +3,14 @@
#
# This is set up to build a perl.exe that runs off a shared library
# (perl.dll). Also makes individual DLLs for the XS extensions.
-#
-
+# NB: Miniperl has a different set of objects it depends on than
+# perl.exe
+# Also, Miniperl will not build with -DPERL_OBJECT defined
#
# Set these to wherever you want "nmake install" to put your
# newly built perl.
INST_DRV = c:
-INST_TOP = $(INST_DRV)\perl5004.5x
+INST_TOP = $(INST_DRV)\perl\5004.5x
#
# uncomment to enable threads-capabilities
@@ -20,6 +21,11 @@ INST_TOP = $(INST_DRV)\perl5004.5x
#CCTYPE = MSVC20
#
+# uncomment next line if you want to use the perl object
+# Currently, this cannot be enabled if you ask for threads above
+#OBJECT = -DPERL_OBJECT
+
+#
# uncomment next line if you want debug version of perl (big,slow)
#CFG = Debug
@@ -39,8 +45,9 @@ INST_TOP = $(INST_DRV)\perl5004.5x
# set this if you wish to use perl's malloc
# WARNING: Turning this on/off WILL break binary compatibility with extensions
# you may have compiled with/without it. Be prepared to recompile all extensions
-# if you change the default.
-PERL_MALLOC = define
+# if you change the default. Currently, this cannot be enabled if you ask for
+# PERL_OBJECT above.
+#PERL_MALLOC = define
#
# set the install locations of the compiler include/libraries
@@ -107,8 +114,12 @@ LIB32 = $(LINK32) -lib
#
# Options
#
-
-!IF "$(RUNTIME)" == ""
+!IF "$(OBJECT)" == "-DPERL_OBJECT"
+RUNTIME = -MT
+# XXX building with -MD fails many tests, but cannot investigate
+# because building with debug crashes compiler :-( GSAR )-:
+#RUNTIME = -MD
+!ELSE
RUNTIME = -MD
!ENDIF
@@ -129,14 +140,14 @@ LIBC = libcmt.lib
! IF "$(CCTYPE)" == "MSVC20"
OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING
! ELSE
-OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING
+OPTIMIZE = -Od $(RUNTIME)d -Zi -D_DEBUG -DDEBUGGING
! ENDIF
LINK_DBG = -debug -pdb:none
!ELSE
! IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG
! ELSE
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG
! ENDIF
LINK_DBG = -release
!ENDIF
@@ -145,7 +156,7 @@ LINK_DBG = -release
OPTIMIZE = $(OPTIMIZE) $(CXX_FLAG)
!ENDIF
-# we don't add LIBC here, the compiler do it based on -MD/-MT
+# we don't add LIBC here, the compiler does it based on -MD/-MT
LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \
winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \
oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
@@ -195,9 +206,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
@@ -344,7 +357,7 @@ WIN32_OBJ = $(WIN32_SRC:.c=.obj)
MINICORE_OBJ = $(CORE_OBJ:..\=.\mini\) $(MINIDIR)\miniperlmain$(o)
MINIWIN32_OBJ = $(WIN32_OBJ:.\=.\mini\)
MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ)
-PERL95_OBJ = $(PERL95_SRC:.c=.obj)
+PERL95_OBJ = $(PERL95_SRC:.c=.obj) DynaLoadmt$(o)
DLL_OBJ = $(DLL_SRC:.c=.obj)
X2P_OBJ = $(X2P_SRC:.c=.obj)
@@ -403,9 +416,14 @@ EXTENSION_DLL = \
$(SDBM_FILE_DLL)\
$(IO_DLL) \
$(POSIX_DLL) \
- $(ATTRS_DLL) \
+ $(ATTRS_DLL)
+
+!IF "$(OBJECT)" == ""
+EXTENSION_DLL = \
+ $(EXTENSION_DLL)\
$(THREAD_DLL) \
$(B_DLL)
+!ENDIF
POD2HTML = $(PODDIR)\pod2html
POD2MAN = $(PODDIR)\pod2man
@@ -417,12 +435,13 @@ CFG_VARS = \
"INST_TOP=$(INST_TOP)" \
"archname=$(ARCHNAME)" \
"cc=$(CC)" \
- "ccflags=$(OPTIMIZE) $(DEFINES)" \
+ "ccflags=$(OPTIMIZE) $(DEFINES) $(OBJECT)" \
"cf_email=$(EMAIL)" \
"d_crypt=$(D_CRYPT)" \
"d_mymalloc=$(PERL_MALLOC)" \
"libs=$(LIBFILES)" \
"incpath=$(CCINCDIR)" \
+ "libperl=$(PERLIMPLIB)" \
"libpth=$(CCLIBDIR)" \
"libc=$(LIBC)" \
"make=nmake" \
@@ -436,7 +455,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
@@ -459,6 +478,20 @@ config.w32 : $(CFGSH_TMPL)
..\config.sh : config.w32 $(MINIPERL) config_sh.PL
$(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) config.w32 > ..\config.sh
+# this target is for when changes to the main config.sh happen
+# edit config.{b,v,g}c and make this target once for each supported
+# compiler (e.g. `dmake CCTYPE=BORLAND regen_config_h`)
+regen_config_h:
+ perl config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh
+ cd ..
+ -del /f perl.exe
+ perl configpm
+ cd win32
+ -del /f $(CFGH_TMPL)
+ -mkdir ..\lib\CORE
+ -perl -I..\lib config_h.PL
+ rename config.h $(CFGH_TMPL)
+
$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl
cd .. && miniperl configpm
if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL)
@@ -552,6 +585,10 @@ win32mt$(o) : win32.c
$(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
$(OBJOUT_FLAG)win32mt$(o) win32.c
+DynaLoadmt$(o) : $(DYNALOADER).c
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+ $(OBJOUT_FLAG)DynaLoadmt$(o) $(DYNALOADER).c
+
$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ)
$(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \
$(LIBFILES) $(PERL95_OBJ) $(PERLIMPLIB) libcmt.lib
@@ -566,6 +603,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
@@ -730,10 +779,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) || rmdir /s $(MINIDIR)
-@erase $(WIN32_OBJ)
-@erase $(DLL_OBJ)
diff --git a/win32/config.bc b/win32/config.bc
index 94d4297450..f0a095290d 100644
--- a/win32/config.bc
+++ b/win32/config.bc
@@ -21,8 +21,8 @@ afs='false'
alignbytes='8'
aphostname=''
ar='tlib /P128'
-archlib='~INST_TOP~\lib\~archname~'
-archlibexp='~INST_TOP~\lib\~archname~'
+archlib=''
+archlibexp=''
archname='MSWin32'
archobjs=''
awk='awk'
@@ -64,7 +64,7 @@ csh='undef'
d_Gconvert='gcvt((x),(n),(b))'
d_access='define'
d_alarm='undef'
-d_archlib='define'
+d_archlib='undef'
d_attribut='undef'
d_bcmp='undef'
d_bcopy='undef'
@@ -164,7 +164,7 @@ d_msgctl='undef'
d_msgget='undef'
d_msgrcv='undef'
d_msgsnd='undef'
-d_mymalloc='define'
+d_mymalloc='undef'
d_nice='undef'
d_oldpthreads='undef'
d_oldsock='undef'
@@ -368,13 +368,13 @@ i_vfork='undef'
incpath=''
inews=''
installarchlib='~INST_TOP~\lib\~archname~'
-installbin='~INST_TOP~\bin'
+installbin='~INST_TOP~\bin\~archname~'
installman1dir='~INST_TOP~\man\man1'
installman3dir='~INST_TOP~\man\man3'
installprivlib='~INST_TOP~\lib'
installscript='~INST_TOP~\bin'
-installsitearch='~INST_TOP~\lib\site\~archname~'
-installsitelib='~INST_TOP~\lib\site'
+installsitearch='~INST_TOP~\..\site\~VERSION~\lib\~archname~'
+installsitelib='~INST_TOP~\..\site\~VERSION~\lib'
intsize='4'
known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
ksh=''
@@ -450,7 +450,7 @@ patchlevel='2'
path_sep=';'
perl='perl'
perladmin=''
-perlpath='~INST_TOP~\bin\perl.exe'
+perlpath='~INST_TOP~\bin\~archname~\perl.exe'
pg=''
phostname='hostname'
pidtype='int'
@@ -485,10 +485,10 @@ sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM USR1 USR2 CHLD USR3 BRE
sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "USR3", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0'
sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 16, 17, 18, 20, 21, 22, 23, 25, 18, 0'
signal_t='void'
-sitearch='~INST_TOP~\lib\site\~archname~'
-sitearchexp='~INST_TOP~\lib\site\~archname~'
-sitelib='~INST_TOP~\lib\site'
-sitelibexp='~INST_TOP~\lib\site'
+sitearch=''
+sitearchexp=''
+sitelib='~INST_TOP~\..\site\~VERSION~\lib'
+sitelibexp='~INST_TOP~\..\site\~VERSION~\lib'
sizetype='size_t'
sleep=''
smail=''
diff --git a/win32/config.gc b/win32/config.gc
index 46dc9ac681..48876989c7 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -21,8 +21,8 @@ afs='false'
alignbytes='8'
aphostname=''
ar='ar'
-archlib='~INST_TOP~\lib\~archname~'
-archlibexp='~INST_TOP~\lib\~archname~'
+archlib=''
+archlibexp=''
archname='MSWin32'
archobjs=''
awk='awk'
@@ -64,7 +64,7 @@ csh='undef'
d_Gconvert='sprintf((b),"%.*g",(n),(x))'
d_access='define'
d_alarm='undef'
-d_archlib='define'
+d_archlib='undef'
d_attribut='define'
d_bcmp='undef'
d_bcopy='undef'
@@ -164,7 +164,7 @@ d_msgctl='undef'
d_msgget='undef'
d_msgrcv='undef'
d_msgsnd='undef'
-d_mymalloc='define'
+d_mymalloc='undef'
d_nice='undef'
d_oldpthreads='undef'
d_oldsock='undef'
@@ -368,13 +368,13 @@ i_vfork='undef'
incpath=''
inews=''
installarchlib='~INST_TOP~\lib\~archname~'
-installbin='~INST_TOP~\bin'
+installbin='~INST_TOP~\bin\~archname~'
installman1dir='~INST_TOP~\man\man1'
installman3dir='~INST_TOP~\man\man3'
installprivlib='~INST_TOP~\lib'
installscript='~INST_TOP~\bin'
-installsitearch='~INST_TOP~\lib\site\~archname~'
-installsitelib='~INST_TOP~\lib\site'
+installsitearch='~INST_TOP~\..\site\~VERSION~\lib\~archname~'
+installsitelib='~INST_TOP~\..\site\~VERSION~\lib'
intsize='4'
known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
ksh=''
@@ -450,7 +450,7 @@ patchlevel='2'
path_sep=';'
perl='perl'
perladmin=''
-perlpath='~INST_TOP~\bin\perl.exe'
+perlpath='~INST_TOP~\bin\~archname~\perl.exe'
pg=''
phostname='hostname'
pidtype='int'
@@ -485,10 +485,10 @@ sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM CHLD BREAK ABRT STOP CO
sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0'
sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0'
signal_t='void'
-sitearch='~INST_TOP~\lib\site\~archname~'
-sitearchexp='~INST_TOP~\lib\site\~archname~'
-sitelib='~INST_TOP~\lib\site'
-sitelibexp='~INST_TOP~\lib\site'
+sitearch=''
+sitearchexp=''
+sitelib='~INST_TOP~\..\site\~VERSION~\lib'
+sitelibexp='~INST_TOP~\..\site\~VERSION~\lib'
sizetype='size_t'
sleep=''
smail=''
diff --git a/win32/config.vc b/win32/config.vc
index 0f8152d772..a870cef0b0 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -21,8 +21,8 @@ afs='false'
alignbytes='8'
aphostname=''
ar='lib'
-archlib='~INST_TOP~\lib\~archname~'
-archlibexp='~INST_TOP~\lib\~archname~'
+archlib=''
+archlibexp=''
archname='MSWin32'
archobjs=''
awk='awk'
@@ -64,7 +64,7 @@ csh='undef'
d_Gconvert='sprintf((b),"%.*g",(n),(x))'
d_access='define'
d_alarm='undef'
-d_archlib='define'
+d_archlib='undef'
d_attribut='undef'
d_bcmp='undef'
d_bcopy='undef'
@@ -164,7 +164,7 @@ d_msgctl='undef'
d_msgget='undef'
d_msgrcv='undef'
d_msgsnd='undef'
-d_mymalloc='define'
+d_mymalloc='undef'
d_nice='undef'
d_oldpthreads='undef'
d_oldsock='undef'
@@ -368,13 +368,13 @@ i_vfork='undef'
incpath=''
inews=''
installarchlib='~INST_TOP~\lib\~archname~'
-installbin='~INST_TOP~\bin'
+installbin='~INST_TOP~\bin\~archname~'
installman1dir='~INST_TOP~\man\man1'
installman3dir='~INST_TOP~\man\man3'
installprivlib='~INST_TOP~\lib'
installscript='~INST_TOP~\bin'
-installsitearch='~INST_TOP~\lib\site\~archname~'
-installsitelib='~INST_TOP~\lib\site'
+installsitearch='~INST_TOP~\..\site\~VERSION~\lib\~archname~'
+installsitelib='~INST_TOP~\..\site\~VERSION~\lib'
intsize='4'
known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
ksh=''
@@ -450,7 +450,7 @@ patchlevel='2'
path_sep=';'
perl='perl'
perladmin=''
-perlpath='~INST_TOP~\bin\perl.exe'
+perlpath='~INST_TOP~\bin\~archname~\perl.exe'
pg=''
phostname='hostname'
pidtype='int'
@@ -485,10 +485,10 @@ sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM CHLD BREAK ABRT STOP CO
sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0'
sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0'
signal_t='void'
-sitearch='~INST_TOP~\lib\site\~archname~'
-sitearchexp='~INST_TOP~\lib\site\~archname~'
-sitelib='~INST_TOP~\lib\site'
-sitelibexp='~INST_TOP~\lib\site'
+sitearch=''
+sitearchexp=''
+sitelib='~INST_TOP~\..\site\~VERSION~\lib'
+sitelibexp='~INST_TOP~\..\site\~VERSION~\lib'
sizetype='size_t'
sleep=''
smail=''
diff --git a/win32/config_H.bc b/win32/config_H.bc
index 540ba95bfa..0a0e861c6e 100644
--- a/win32/config_H.bc
+++ b/win32/config_H.bc
@@ -34,8 +34,8 @@
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
-#define BIN "c:\\perl5004.5x\\bin" /**/
-#define BIN_EXP "c:\\perl5004.5x\\bin" /**/
+#define BIN "c:\\perl\\5004.5x\\bin" /**/
+#define BIN_EXP "c:\\perl\\5004.5x\\bin" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
@@ -1066,7 +1066,7 @@
/* MYMALLOC:
* This symbol, if defined, indicates that we're using our own malloc.
*/
-#define MYMALLOC /**/
+/*#define MYMALLOC /**/
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
@@ -1463,8 +1463,8 @@
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/
-#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/
+/*#define ARCHLIB "" /**/
+/*#define ARCHLIB_EXP "" /**/
/* CAT2:
* This macro catenates 2 tokens together.
@@ -1771,8 +1771,8 @@
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "c:\\perl5004.5x\\lib" /**/
-#define PRIVLIB_EXP (win32_perllib_path(NULL)) /**/
+#define PRIVLIB "c:\\perl\\5004.5x\\lib" /**/
+#define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/
/* SIG_NAME:
* This symbol contains a list of signal names in order of
@@ -1818,8 +1818,8 @@
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/
-#define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/
+#define SITEARCH "" /**/
+#define SITEARCH_EXP "" /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
@@ -1834,8 +1834,8 @@
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITELIB "c:\\perl5004.5x\\lib\\site" /**/
-#define SITELIB_EXP (win32_perllib_path("site",NULL)) /**/
+#define SITELIB "c:\\perl\\5004.5x\\..\\site\\5.00466\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib(patchlevel)) /**/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
diff --git a/win32/config_H.gc b/win32/config_H.gc
index 3266ca9ae3..8ff345a5e5 100644
--- a/win32/config_H.gc
+++ b/win32/config_H.gc
@@ -34,8 +34,8 @@
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
-#define BIN "c:\\perl5004.5x\\bin" /**/
-#define BIN_EXP "c:\\perl5004.5x\\bin" /**/
+#define BIN "c:\\perl\\5004.5x\\bin" /**/
+#define BIN_EXP "c:\\perl\\5004.5x\\bin" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
@@ -1066,7 +1066,7 @@
/* MYMALLOC:
* This symbol, if defined, indicates that we're using our own malloc.
*/
-#define MYMALLOC /**/
+/*#define MYMALLOC /**/
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
@@ -1463,8 +1463,8 @@
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/
-#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/
+/*#define ARCHLIB "" /**/
+/*#define ARCHLIB_EXP "" /**/
/* CAT2:
* This macro catenates 2 tokens together.
@@ -1771,8 +1771,8 @@
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "c:\\perl5004.5x\\lib" /**/
-#define PRIVLIB_EXP (win32_perllib_path(NULL)) /**/
+#define PRIVLIB "c:\\perl\\5004.5x\\lib" /**/
+#define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/
/* SIG_NAME:
* This symbol contains a list of signal names in order of
@@ -1818,8 +1818,8 @@
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/
-#define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/
+#define SITEARCH "" /**/
+#define SITEARCH_EXP "" /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
@@ -1834,8 +1834,8 @@
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITELIB "c:\\perl5004.5x\\lib\\site" /**/
-#define SITELIB_EXP (win32_perllib_path("site",NULL)) /**/
+#define SITELIB "c:\\perl\\5004.5x\\..\\site\\5.00466\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib(patchlevel)) /**/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
diff --git a/win32/config_H.vc b/win32/config_H.vc
index 9e383f93d0..bd5ffb66b5 100644
--- a/win32/config_H.vc
+++ b/win32/config_H.vc
@@ -34,8 +34,8 @@
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
-#define BIN "c:\\perl5004.5x\\bin" /**/
-#define BIN_EXP "c:\\perl5004.5x\\bin" /**/
+#define BIN "c:\\perl\\5004.5x\\bin" /**/
+#define BIN_EXP "c:\\perl\\5004.5x\\bin" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
@@ -1066,7 +1066,7 @@
/* MYMALLOC:
* This symbol, if defined, indicates that we're using our own malloc.
*/
-#define MYMALLOC /**/
+/*#define MYMALLOC /**/
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
@@ -1463,8 +1463,8 @@
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/
-#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/
+/*#define ARCHLIB "" /**/
+/*#define ARCHLIB_EXP "" /**/
/* CAT2:
* This macro catenates 2 tokens together.
@@ -1771,8 +1771,8 @@
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "c:\\perl5004.5x\\lib" /**/
-#define PRIVLIB_EXP (win32_perllib_path(NULL)) /**/
+#define PRIVLIB "c:\\perl\\5004.5x\\lib" /**/
+#define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/
/* SIG_NAME:
* This symbol contains a list of signal names in order of
@@ -1818,8 +1818,8 @@
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/
-#define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/
+#define SITEARCH "" /**/
+#define SITEARCH_EXP "" /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
@@ -1834,8 +1834,8 @@
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITELIB "c:\\perl5004.5x\\lib\\site" /**/
-#define SITELIB_EXP (win32_perllib_path("site",NULL)) /**/
+#define SITELIB "c:\\perl\\5004.5x\\..\\site\\5.00466\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib(patchlevel)) /**/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
diff --git a/win32/config_h.PL b/win32/config_h.PL
index f317e5a407..0a4e6cee51 100644
--- a/win32/config_h.PL
+++ b/win32/config_h.PL
@@ -2,6 +2,7 @@
use Config;
use File::Compare qw(compare);
use File::Copy qw(copy);
+my $OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
my $name = $0;
$name =~ s#^(.*)\.PL$#../$1.SH#;
open(SH,"<$name") || die "Cannot open $name:$!";
@@ -36,21 +37,21 @@ while (<SH>)
munge();
s/\\\$/\$/g;
s#/[ *\*]*\*/#/**/#;
- if (/^\s*#define\s+ARCHLIB_EXP/)
- {
- $_ = "#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL))\t/**/\n";
- }
+ # if (/^\s*#define\s+ARCHLIB_EXP/)
+ # {
+ # $_ = "#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL))\t/**/\n";
+ # }
if (/^\s*#define\s+PRIVLIB_EXP/)
{
- $_ = "#define PRIVLIB_EXP (win32_perllib_path(NULL))\t/**/\n"
- }
- if (/^\s*#define\s+SITEARCH_EXP/)
- {
- $_ = "#define SITEARCH_EXP (win32_perllib_path(\"site\",ARCHNAME,NULL))\t/**/\n";
+ $_ = "#define PRIVLIB_EXP (win32_get_stdlib(patchlevel))\t/**/\n"
}
+ # if (/^\s*#define\s+SITEARCH_EXP/)
+ # {
+ # $_ = "#define SITEARCH_EXP (win32_perllib_path(\"site\",ARCHNAME,NULL))\t/**/\n";
+ # }
if (/^\s*#define\s+SITELIB_EXP/)
{
- $_ = "#define SITELIB_EXP (win32_perllib_path(\"site\",NULL))\t/**/\n";
+ $_ = "#define SITELIB_EXP (win32_get_sitelib(patchlevel))\t/**/\n";
}
print H;
}
@@ -64,7 +65,7 @@ chmod(0666,"../lib/CORE/config.h");
copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!";
chmod(0444,"../lib/CORE/config.h");
-if (compare("$file.new",$file))
+if (!$OBJ && compare("$file.new",$file))
{
warn "$file has changed\n";
chmod(0666,$file);
@@ -73,6 +74,11 @@ if (compare("$file.new",$file))
#chmod(0444,$file);
exit(1);
}
+else
+ {
+ unlink ("$file.new");
+ exit(0);
+ }
sub Config
{
diff --git a/win32/config_sh.PL b/win32/config_sh.PL
index 0c3713cb2e..8194988f28 100644
--- a/win32/config_sh.PL
+++ b/win32/config_sh.PL
@@ -10,6 +10,7 @@ if ($] =~ /\.(\d\d\d)?(\d\d)?$/) { # should always be true
$opt{SUBVERSION} = $2 || '00';
}
+$opt{VERSION} = $];
$opt{'cf_by'} = $ENV{USERNAME} unless $opt{'cf_by'};
$opt{'cf_email'} = $opt{'cf_by'} . '@' . (gethostbyname('localhost'))[0]
unless $opt{'cf_email'};
diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs
index 0f869e1f85..b9d4c14bd3 100644
--- a/win32/dl_win32.xs
+++ b/win32/dl_win32.xs
@@ -26,22 +26,53 @@ calls.
#include "EXTERN.h"
#include "perl.h"
+
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#endif /* PERL_OBJECT */
+
#include "XSUB.h"
#include "dlutils.c" /* SaveError() etc */
static void
-dl_private_init(void)
+dl_private_init(CPERLarg)
{
- (void)dl_generic_private_init();
+ (void)dl_generic_private_init(THIS);
}
+/*
+ This function assumes the list staticlinkmodules
+ will be formed from package names with '::' replaced
+ with '/'. Thus Win32::OLE is in the list as Win32/OLE
+*/
static int
dl_static_linked(char *filename)
{
char **p;
+ char* ptr;
+ static char subStr[] = "/auto/";
+ char szBuffer[MAX_PATH];
+
+ /* change all the '\\' to '/' */
+ strcpy(szBuffer, filename);
+ for(ptr = szBuffer; ptr = strchr(ptr, '\\'); ++ptr)
+ *ptr = '/';
+
+ /* delete the file name */
+ ptr = strrchr(szBuffer, '/');
+ if(ptr != NULL)
+ *ptr = '\0';
+
+ /* remove leading lib path */
+ ptr = strstr(szBuffer, subStr);
+ if(ptr != NULL)
+ ptr += sizeof(subStr)-1;
+ else
+ ptr = szBuffer;
+
for (p = staticlinkmodules; *p;p++) {
- if (strstr(filename, *p)) return 1;
+ if (strstr(ptr, *p)) return 1;
};
return 0;
}
@@ -49,7 +80,7 @@ dl_static_linked(char *filename)
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (void)dl_private_init(THIS);
void *
dl_load_file(filename,flags=0)
@@ -57,15 +88,15 @@ dl_load_file(filename,flags=0)
int flags
PREINIT:
CODE:
- DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
+ DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename));
if (dl_static_linked(filename) == 0)
RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
else
RETVAL = (void*) GetModuleHandle(NULL);
- DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("%d",GetLastError()) ;
+ SaveError(THIS_ "%d",GetLastError()) ;
else
sv_setiv( ST(0), (IV)RETVAL);
@@ -75,13 +106,13 @@ dl_find_symbol(libhandle, symbolname)
void * libhandle
char * symbolname
CODE:
- DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
libhandle, symbolname));
RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
- DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL));
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("%d",GetLastError()) ;
+ SaveError(THIS_ "%d",GetLastError()) ;
else
sv_setiv( ST(0), (IV)RETVAL);
@@ -100,9 +131,9 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
+ 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(*)(CV*))symref, filename)));
+ ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV* _CPERLarg))symref, filename)));
char *
diff --git a/win32/include/sys/socket.h b/win32/include/sys/socket.h
index 40a5485343..6ffb0ac269 100644
--- a/win32/include/sys/socket.h
+++ b/win32/include/sys/socket.h
@@ -142,6 +142,7 @@ void win32_endprotoent(void);
void win32_endservent(void);
#ifndef WIN32SCK_IS_STDSCK
+#ifndef PERL_OBJECT
//
// direct to our version
//
@@ -203,6 +204,7 @@ void win32_endservent(void);
#define FD_ZERO(p) PERL_FD_ZERO(p)
#endif /* USE_SOCKETS_AS_HANDLES */
+#endif /* PERL_OBJECT */
#endif /* WIN32SCK_IS_STDSCK */
#ifdef __cplusplus
diff --git a/win32/makedef.pl b/win32/makedef.pl
index c366be4cdd..acaa64b232 100644
--- a/win32/makedef.pl
+++ b/win32/makedef.pl
@@ -33,6 +33,14 @@ close(CFG);
warn join(' ',keys %define)."\n";
+if ($define{PERL_OBJECT}) {
+ print "LIBRARY PerlCore\n";
+ print "DESCRIPTION 'Perl interpreter'\n";
+ print "EXPORTS\n";
+ output_symbol("perl_alloc");
+ exit(0);
+}
+
if ($CCTYPE ne 'GCC')
{
print "LIBRARY Perl\n";
@@ -71,15 +79,20 @@ sub emit_symbols
skip_symbols [qw(
Perl_statusvalue_vms
+Perl_archpat_auto
Perl_block_type
+Perl_bostr
Perl_additem
Perl_cast_ulong
Perl_check_uni
Perl_checkcomma
Perl_chsize
Perl_ck_aelem
+Perl_colors
+Perl_colorset
Perl_cryptseen
Perl_cx_dump
+Perl_DBcv
Perl_do_ipcctl
Perl_do_ipcget
Perl_do_msgrcv
@@ -99,15 +112,23 @@ Perl_dump_packsubs
Perl_dump_pm
Perl_dump_sub
Perl_expectterm
+Perl_error_no
+Perl_extralen
Perl_fetch_gv
Perl_fetch_io
Perl_force_ident
Perl_force_next
Perl_force_word
+Perl_generation
Perl_hv_stashpv
+Perl_in_clean_all
+Perl_in_clean_objs
Perl_intuit_more
Perl_init_thread_intern
Perl_know_next
+Perl_lastgotoprobe
+Perl_linestart
+Perl_modcount
Perl_modkids
Perl_mstats
Perl_my_bzero
@@ -120,6 +141,7 @@ Perl_no_fh_allowed
Perl_no_op
Perl_nointrp
Perl_nomem
+Perl_pending_ident
Perl_pp_cswitch
Perl_pp_entersubr
Perl_pp_evalonce
@@ -129,13 +151,41 @@ Perl_pp_nswitch
Perl_q
Perl_rcsid
Perl_reall_srchlen
+Perl_reg_eval_set
+Perl_reg_flags
+Perl_reg_start_tmp
+Perl_reg_start_tmpl
+Perl_regbol
+Perl_regcc
+Perl_regcode
+Perl_regdata
+Perl_regdummy
Perl_regdump
Perl_regfold
+Perl_regendp
+Perl_regeol
+Perl_regflags
+Perl_regindent
+Perl_reginput
+Perl_reglastparen
Perl_regmyendp
Perl_regmyp_size
Perl_regmystartp
Perl_regnarrate
+Perl_regnaughty
+Perl_regnpar
+Perl_regparse
+Perl_regprecomp
+Perl_regprev
+Perl_regprogram
Perl_regprop
+Perl_regsawback
+Perl_regseen
+Perl_regsize
+Perl_regstartp
+Perl_regtill
+Perl_regxend
+Perl_rx
Perl_same_dirent
Perl_saw_return
Perl_scan_const
@@ -149,9 +199,13 @@ Perl_scan_str
Perl_scan_subst
Perl_scan_trans
Perl_scan_word
+Perl_seen_zerolen
Perl_setenv_getix
Perl_skipspace
+Perl_sort_mutex
+Perl_sortcxix
Perl_sublex_done
+Perl_sublex_info
Perl_sublex_start
Perl_sv_ref
Perl_sv_setptrobj
@@ -342,25 +396,7 @@ while (<DATA>) {
foreach my $symbol (sort keys %export)
{
- if ($CCTYPE eq "BORLAND") {
- # workaround Borland quirk by exporting both the straight
- # name and a name with leading underscore. Note the
- # alias *must* come after the symbol itself, if both
- # are to be exported. (Linker bug?)
- print "\t_$symbol\n";
- print "\t$symbol = _$symbol\n";
- }
- elsif ($CCTYPE eq 'GCC') {
- # Symbols have leading _ whole process is $%£"% slow
- # so skip aliases for now
- print "\t$symbol\n";
- }
- else {
- # for binary coexistence, export both the symbol and
- # alias with leading underscore
- print "\t$symbol\n";
- print "\t_$symbol = $symbol\n";
- }
+ output_symbol($symbol);
}
sub emit_symbol {
@@ -369,6 +405,29 @@ sub emit_symbol {
$export{$symbol} = 1;
}
+sub output_symbol {
+ my $symbol = shift;
+ if ($CCTYPE eq "BORLAND") {
+ # workaround Borland quirk by exporting both the straight
+ # name and a name with leading underscore. Note the
+ # alias *must* come after the symbol itself, if both
+ # are to be exported. (Linker bug?)
+ print "\t_$symbol\n";
+ print "\t$symbol = _$symbol\n";
+ }
+ elsif ($CCTYPE eq 'GCC') {
+ # Symbols have leading _ whole process is $%£"% slow
+ # so skip aliases for now
+ print "\t$symbol\n";
+ }
+ else {
+ # for binary coexistence, export both the symbol and
+ # alias with leading underscore
+ print "\t$symbol\n";
+ print "\t_$symbol = $symbol\n";
+ }
+}
+
1;
__DATA__
# extra globals not included above.
diff --git a/win32/makefile.mk b/win32/makefile.mk
index c04fe692ad..ab67c7365d 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -13,7 +13,7 @@
# Set these to wherever you want "nmake install" to put your
# newly built perl.
INST_DRV *= c:
-INST_TOP *= $(INST_DRV)\perl5004.5x
+INST_TOP *= $(INST_DRV)\perl\5004.5x
#
# uncomment to enable threads-capabilities
@@ -27,6 +27,11 @@ CCTYPE *= BORLAND
#CCTYPE *= GCC
#
+# uncomment next line if you want to use the perl object
+# Currently, this cannot be enabled if you ask for threads above
+#OBJECT *= -DPERL_OBJECT
+
+#
# uncomment next line if you want debug version of perl (big,slow)
#CFG *= Debug
@@ -46,8 +51,9 @@ CCTYPE *= BORLAND
# set this if you wish to use perl's malloc
# WARNING: Turning this on/off WILL break binary compatibility with extensions
# you may have compiled with/without it. Be prepared to recompile all extensions
-# if you change the default.
-PERL_MALLOC *= define
+# if you change the default. Currently, this cannot be enabled if you ask for
+# PERL_OBJECT above.
+#PERL_MALLOC *= define
#
# set the install locations of the compiler include/libraries
@@ -115,7 +121,7 @@ AUTODIR = ..\lib\auto
CC = bcc32
LINK32 = tlink32
-LIB32 = tlib
+LIB32 = tlib /P128
IMPLIB = implib -c
#
@@ -145,12 +151,13 @@ CFLAGS = -w -d -tWM -tWD $(INCLUDES) $(DEFINES) $(LOCDEFS) \
LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR)
OBJOUT_FLAG = -o
EXEOUT_FLAG = -e
+LIBOUT_FLAG =
.ELIF "$(CCTYPE)" == "GCC"
CC = gcc -pipe
LINK32 = gcc -pipe
-LIB32 = ar
+LIB32 = ar rc
IMPLIB = dlltool
o = .o
@@ -181,6 +188,7 @@ CFLAGS = $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE)
LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR)
OBJOUT_FLAG = -o
EXEOUT_FLAG = -o
+LIBOUT_FLAG =
.ELSE
@@ -191,8 +199,12 @@ LIB32 = $(LINK32) -lib
#
# Options
#
-
-.IF "$(RUNTIME)" == ""
+.IF "$(OBJECT)" == "-DPERL_OBJECT"
+RUNTIME = -MT
+# XXX building with -MD fails many tests, but cannot investigate
+# because building with debug crashes compiler :-( GSAR )-:
+#RUNTIME = -MD
+.ELSE
RUNTIME = -MD
.ENDIF
@@ -213,14 +225,14 @@ LIBC = libcmt.lib
.IF "$(CCTYPE)" == "MSVC20"
OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG -DDEBUGGING
.ELSE
-OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING
+OPTIMIZE = -Od $(RUNTIME)d -Zi -D_DEBUG -DDEBUGGING
.ENDIF
LINK_DBG = -debug -pdb:none
.ELSE
.IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG
.ELSE
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG
.ENDIF
LINK_DBG = -release
.ENDIF
@@ -236,6 +248,7 @@ CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \
LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE)
OBJOUT_FLAG = -Fo
EXEOUT_FLAG = -Fe
+LIBOUT_FLAG = /out:
.ENDIF
@@ -292,9 +305,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
@@ -452,7 +467,7 @@ WIN32_OBJ = $(WIN32_SRC:db:+$(o))
MINICORE_OBJ = $(MINIDIR)\{$(CORE_OBJ:f) miniperlmain$(o)}
MINIWIN32_OBJ = $(MINIDIR)\{$(WIN32_OBJ:f)}
MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ)
-PERL95_OBJ = $(PERL95_SRC:db:+$(o))
+PERL95_OBJ = $(PERL95_SRC:db:+$(o)) DynaLoadmt$(o)
DLL_OBJ = $(DLL_SRC:db:+$(o))
X2P_OBJ = $(X2P_SRC:db:+$(o))
@@ -493,7 +508,7 @@ ATTRS_DLL = $(AUTODIR)\attrs\attrs.dll
THREAD_DLL = $(AUTODIR)\Thread\Thread.dll
B_DLL = $(AUTODIR)\B\B.dll
-EXTENSION_C = \
+EXTENSION_C = \
$(SOCKET).c \
$(FCNTL).c \
$(OPCODE).c \
@@ -504,16 +519,20 @@ EXTENSION_C = \
$(THREAD).c \
$(B).c
-EXTENSION_DLL = \
+EXTENSION_DLL = \
$(SOCKET_DLL) \
$(FCNTL_DLL) \
$(OPCODE_DLL) \
$(SDBM_FILE_DLL)\
$(IO_DLL) \
$(POSIX_DLL) \
- $(ATTRS_DLL) \
+ $(ATTRS_DLL)
+
+.IF "$(OBJECT)" == ""
+EXTENSION_DLL += \
$(THREAD_DLL) \
$(B_DLL)
+.ENDIF
POD2HTML = $(PODDIR)\pod2html
POD2MAN = $(PODDIR)\pod2man
@@ -525,12 +544,13 @@ CFG_VARS = \
"INST_TOP=$(INST_TOP)" \
"archname=$(ARCHNAME)" \
"cc=$(CC)" \
- "ccflags=$(OPTIMIZE) $(DEFINES)" \
+ "ccflags=$(OPTIMIZE) $(DEFINES) $(OBJECT)" \
"cf_email=$(EMAIL)" \
"d_crypt=$(D_CRYPT)" \
"d_mymalloc=$(PERL_MALLOC)" \
"libs=$(LIBFILES:f)" \
"incpath=$(CCINCDIR)" \
+ "libperl=$(PERLIMPLIB)" \
"libpth=$(strip $(CCLIBDIR) $(LIBFILES:d))" \
"libc=$(LIBC)" \
"make=dmake" \
@@ -544,7 +564,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
@@ -726,6 +746,10 @@ win32mt$(o) : win32.c
$(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
$(OBJOUT_FLAG)win32mt$(o) win32.c
+DynaLoadmt$(o) : $(DYNALOADER).c
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+ $(OBJOUT_FLAG)DynaLoadmt$(o) $(DYNALOADER).c
+
$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ)
$(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \
$(LIBFILES) $(PERL95_OBJ) $(PERLIMPLIB) libcmt.lib
@@ -740,6 +764,30 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
cd $(EXTDIR)\$(*B) && $(XSUBPP) dl_win32.xs > $(*B).c
$(XCOPY) $(EXTDIR)\$(*B)\dlutils.c .
+.IF "$(OBJECT)" == "-DPERL_OBJECT"
+
+PerlCAPI.cpp : $(MINIPERL)
+ $(MINIPERL) GenCAPI.pl $(COREDIR)
+
+PerlCAPI$(o) : PerlCAPI.cpp
+.IF "$(CCTYPE)" == "BORLAND"
+ $(CC) $(CFLAGS_O) -c $(OBJOUT_FLAG)PerlCAPI$(o) PerlCAPI.cpp
+.ELIF "$(CCTYPE)" == "GCC"
+ $(CC) $(CFLAGS_O) -c $(OBJOUT_FLAG)PerlCAPI$(o) PerlCAPI.cpp
+.ELSE
+ $(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+ $(OBJOUT_FLAG)PerlCAPI$(o) PerlCAPI.cpp
+.ENDIF
+
+$(CAPILIB) : PerlCAPI.cpp PerlCAPI$(o)
+.IF "$(CCTYPE)" == "BORLAND"
+ $(LIB32) $(LIBOUT_FLAG)$(CAPILIB) +PerlCAPI$(o)
+.ELSE
+ $(LIB32) $(LIBOUT_FLAG)$(CAPILIB) PerlCAPI$(o)
+.ENDIF
+
+.ENDIF
+
$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
diff --git a/win32/runperl.c b/win32/runperl.c
index 954460739f..9f2e5c170d 100644
--- a/win32/runperl.c
+++ b/win32/runperl.c
@@ -1,4 +1,1026 @@
-/* Say NO to CPP! Hallelujah! */
+
+#ifdef PERL_OBJECT
+#define USE_SOCKETS_AS_HANDLES
+#include "EXTERN.h"
+#include "perl.h"
+
+#define NO_XSLOCKS
+#include "XSUB.H"
+#include "Win32iop.h"
+
+#define errno (*win32_errno())
+#define stdout (win32_stdout())
+#define stderr (win32_stderr())
+
+CPerlObj *pPerl;
+
+#include <fcntl.h>
+#include <ipdir.h>
+#include <ipenv.h>
+#include <ipsock.h>
+#include <iplio.h>
+#include <ipmem.h>
+#include <ipproc.h>
+#include <ipstdio.h>
+
+extern int g_closedir(DIR *dirp);
+extern DIR *g_opendir(char *filename);
+extern struct direct *g_readdir(DIR *dirp);
+extern void g_rewinddir(DIR *dirp);
+extern void g_seekdir(DIR *dirp, long loc);
+extern long g_telldir(DIR *dirp);
+class CPerlDir : public IPerlDir
+{
+public:
+ CPerlDir() {};
+ virtual int Makedir(const char *dirname, int mode, int &err)
+ {
+ return win32_mkdir(dirname, mode);
+ };
+ virtual int Chdir(const char *dirname, int &err)
+ {
+ return win32_chdir(dirname);
+ };
+ virtual int Rmdir(const char *dirname, int &err)
+ {
+ return win32_rmdir(dirname);
+ };
+ virtual int Close(DIR *dirp, int &err)
+ {
+ return g_closedir(dirp);
+ };
+ virtual DIR *Open(char *filename, int &err)
+ {
+ return g_opendir(filename);
+ };
+ virtual struct direct *Read(DIR *dirp, int &err)
+ {
+ return g_readdir(dirp);
+ };
+ virtual void Rewind(DIR *dirp, int &err)
+ {
+ g_rewinddir(dirp);
+ };
+ virtual void Seek(DIR *dirp, long loc, int &err)
+ {
+ g_seekdir(dirp, loc);
+ };
+ virtual long Tell(DIR *dirp, int &err)
+ {
+ return g_telldir(dirp);
+ };
+};
+
+
+extern char * g_win32_get_stdlib(char *pl);
+extern char * g_win32_get_sitelib(char *pl);
+class CPerlEnv : public IPerlEnv
+{
+public:
+ CPerlEnv() {};
+ virtual char *Getenv(const char *varname, int &err)
+ {
+ return win32_getenv(varname);
+ };
+ virtual int Putenv(const char *envstring, int &err)
+ {
+ return putenv(envstring);
+ };
+ virtual char* LibPath(char *pl)
+ {
+ return g_win32_get_stdlib(pl);
+ };
+ virtual char* SiteLibPath(char *pl)
+ {
+ return g_win32_get_sitelib(pl);
+ };
+};
+
+#define PROCESS_AND_RETURN \
+ if(errno) \
+ err = errno; \
+ return r
+
+class CPerlSock : public IPerlSock
+{
+public:
+ CPerlSock() {};
+ virtual u_long Htonl(u_long hostlong)
+ {
+ return win32_htonl(hostlong);
+ };
+ virtual u_short Htons(u_short hostshort)
+ {
+ return win32_htons(hostshort);
+ };
+ virtual u_long Ntohl(u_long netlong)
+ {
+ return win32_ntohl(netlong);
+ };
+ virtual u_short Ntohs(u_short netshort)
+ {
+ return win32_ntohs(netshort);
+ }
+
+ virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err)
+ {
+ SOCKET r = win32_accept(s, addr, addrlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err)
+ {
+ int r = win32_bind(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err)
+ {
+ int r = win32_connect(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual void Endhostent(int &err)
+ {
+ win32_endhostent();
+ };
+ virtual void Endnetent(int &err)
+ {
+ win32_endnetent();
+ };
+ virtual void Endprotoent(int &err)
+ {
+ win32_endprotoent();
+ };
+ virtual void Endservent(int &err)
+ {
+ win32_endservent();
+ };
+ virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err)
+ {
+ struct hostent *r = win32_gethostbyaddr(addr, len, type);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct hostent* Gethostbyname(const char* name, int &err)
+ {
+ struct hostent *r = win32_gethostbyname(name);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct hostent* Gethostent(int &err)
+ {
+ croak("gethostent not implemented!\n");
+ return NULL;
+ };
+ virtual int Gethostname(char* name, int namelen, int &err)
+ {
+ int r = win32_gethostname(name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct netent *Getnetbyaddr(long net, int type, int &err)
+ {
+ struct netent *r = win32_getnetbyaddr(net, type);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct netent *Getnetbyname(const char *name, int &err)
+ {
+ struct netent *r = win32_getnetbyname((char*)name);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct netent *Getnetent(int &err)
+ {
+ struct netent *r = win32_getnetent();
+ PROCESS_AND_RETURN;
+ };
+ virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err)
+ {
+ int r = win32_getpeername(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct protoent* Getprotobyname(const char* name, int &err)
+ {
+ struct protoent *r = win32_getprotobyname(name);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct protoent* Getprotobynumber(int number, int &err)
+ {
+ struct protoent *r = win32_getprotobynumber(number);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct protoent* Getprotoent(int &err)
+ {
+ struct protoent *r = win32_getprotoent();
+ PROCESS_AND_RETURN;
+ };
+ virtual struct servent* Getservbyname(const char* name, const char* proto, int &err)
+ {
+ struct servent *r = win32_getservbyname(name, proto);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct servent* Getservbyport(int port, const char* proto, int &err)
+ {
+ struct servent *r = win32_getservbyport(port, proto);
+ PROCESS_AND_RETURN;
+ };
+ virtual struct servent* Getservent(int &err)
+ {
+ struct servent *r = win32_getservent();
+ PROCESS_AND_RETURN;
+ };
+ virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err)
+ {
+ int r = win32_getsockname(s, name, namelen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err)
+ {
+ int r = win32_getsockopt(s, level, optname, optval, optlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual unsigned long InetAddr(const char* cp, int &err)
+ {
+ unsigned long r = win32_inet_addr(cp);
+ PROCESS_AND_RETURN;
+ };
+ virtual char* InetNtoa(struct in_addr in, int &err)
+ {
+ char *r = win32_inet_ntoa(in);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Listen(SOCKET s, int backlog, int &err)
+ {
+ int r = win32_listen(s, backlog);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Recv(SOCKET s, char* buffer, int len, int flags, int &err)
+ {
+ int r = win32_recv(s, buffer, len, flags);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err)
+ {
+ int r = win32_recvfrom(s, buffer, len, flags, from, fromlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err)
+ {
+ int r = win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err)
+ {
+ int r = win32_send(s, buffer, len, flags);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err)
+ {
+ int r = win32_sendto(s, buffer, len, flags, to, tolen);
+ PROCESS_AND_RETURN;
+ };
+ virtual void Sethostent(int stayopen, int &err)
+ {
+ win32_sethostent(stayopen);
+ };
+ virtual void Setnetent(int stayopen, int &err)
+ {
+ win32_setnetent(stayopen);
+ };
+ virtual void Setprotoent(int stayopen, int &err)
+ {
+ win32_setprotoent(stayopen);
+ };
+ virtual void Setservent(int stayopen, int &err)
+ {
+ win32_setservent(stayopen);
+ };
+ virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err)
+ {
+ int r = win32_setsockopt(s, level, optname, optval, optlen);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Shutdown(SOCKET s, int how, int &err)
+ {
+ int r = win32_shutdown(s, how);
+ PROCESS_AND_RETURN;
+ };
+ virtual SOCKET Socket(int af, int type, int protocol, int &err)
+ {
+ SOCKET r = win32_socket(af, type, protocol);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err)
+ {
+ croak("socketpair not implemented!\n");
+ return 0;
+ };
+ virtual int Closesocket(SOCKET s, int& err)
+ {
+ int r = win32_closesocket(s);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err)
+ {
+ int r = win32_ioctlsocket(s, cmd, argp);
+ PROCESS_AND_RETURN;
+ };
+};
+
+
+#define CALLFUNCRET(x)\
+ int ret = x;\
+ if(ret)\
+ err = errno;\
+ return ret;
+
+#define CALLFUNCERR(x)\
+ int ret = x;\
+ if(errno)\
+ err = errno;\
+ return ret;
+
+#define LCALLFUNCERR(x)\
+ long ret = x;\
+ if(errno)\
+ err = errno;\
+ return ret;
+
+class CPerlLIO : public IPerlLIO
+{
+public:
+ CPerlLIO() {};
+ virtual int Access(const char *path, int mode, int &err)
+ {
+ CALLFUNCRET(access(path, mode))
+ };
+ virtual int Chmod(const char *filename, int pmode, int &err)
+ {
+ CALLFUNCRET(chmod(filename, pmode))
+ };
+ virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err)
+ {
+ CALLFUNCERR(chown(filename, owner, group))
+ };
+ virtual int Chsize(int handle, long size, int &err)
+ {
+ CALLFUNCRET(chsize(handle, size))
+ };
+ virtual int Close(int handle, int &err)
+ {
+ CALLFUNCRET(win32_close(handle))
+ };
+ virtual int Dup(int handle, int &err)
+ {
+ CALLFUNCERR(win32_dup(handle))
+ };
+ virtual int Dup2(int handle1, int handle2, int &err)
+ {
+ CALLFUNCERR(win32_dup2(handle1, handle2))
+ };
+ virtual int Flock(int fd, int oper, int &err)
+ {
+ CALLFUNCERR(win32_flock(fd, oper))
+ };
+ virtual int FileStat(int handle, struct stat *buffer, int &err)
+ {
+ CALLFUNCERR(fstat(handle, buffer))
+ };
+ virtual int IOCtl(int i, unsigned int u, char *data, int &err)
+ {
+ CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data))
+ };
+ virtual int Isatty(int fd, int &err)
+ {
+ return isatty(fd);
+ };
+ virtual long Lseek(int handle, long offset, int origin, int &err)
+ {
+ LCALLFUNCERR(win32_lseek(handle, offset, origin))
+ };
+ virtual int Lstat(const char *path, struct stat *buffer, int &err)
+ {
+ return NameStat(path, buffer, err);
+ };
+ virtual char *Mktemp(char *Template, int &err)
+ {
+ return mktemp(Template);
+ };
+ virtual int Open(const char *filename, int oflag, int &err)
+ {
+ CALLFUNCERR(win32_open(filename, oflag))
+ };
+ virtual int Open(const char *filename, int oflag, int pmode, int &err)
+ {
+ int ret;
+ if(stricmp(filename, "/dev/null") == 0)
+ ret = open("NUL", oflag, pmode);
+ else
+ ret = open(filename, oflag, pmode);
+
+ if(errno)
+ err = errno;
+ return ret;
+ };
+ virtual int Read(int handle, void *buffer, unsigned int count, int &err)
+ {
+ CALLFUNCERR(win32_read(handle, buffer, count))
+ };
+ virtual int Rename(const char *OldFileName, const char *newname, int &err)
+ {
+ char szNewWorkName[MAX_PATH+1];
+ WIN32_FIND_DATA fdOldFile, fdNewFile;
+ HANDLE handle;
+ char *ptr;
+
+ if((strchr(OldFileName, '\\') || strchr(OldFileName, '/'))
+ && strchr(newname, '\\') == NULL
+ && strchr(newname, '/') == NULL)
+ {
+ strcpy(szNewWorkName, OldFileName);
+ if((ptr = strrchr(szNewWorkName, '\\')) == NULL)
+ ptr = strrchr(szNewWorkName, '/');
+ strcpy(++ptr, newname);
+ }
+ else
+ strcpy(szNewWorkName, newname);
+
+ if(stricmp(OldFileName, szNewWorkName) != 0)
+ { // check that we're not being fooled by relative paths
+ // and only delete the new file
+ // 1) if it exists
+ // 2) it is not the same file as the old file
+ // 3) old file exist
+ // GetFullPathName does not return the long file name on some systems
+ handle = FindFirstFile(OldFileName, &fdOldFile);
+ if(handle != INVALID_HANDLE_VALUE)
+ {
+ FindClose(handle);
+
+ handle = FindFirstFile(szNewWorkName, &fdNewFile);
+
+ if(handle != INVALID_HANDLE_VALUE)
+ FindClose(handle);
+ else
+ fdNewFile.cFileName[0] = '\0';
+
+ if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0
+ && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
+ { // file exists and not same file
+ DeleteFile(szNewWorkName);
+ }
+ }
+ }
+ int ret = rename(OldFileName, szNewWorkName);
+ if(ret)
+ err = errno;
+
+ return ret;
+ };
+ virtual int Setmode(int handle, int mode, int &err)
+ {
+ CALLFUNCRET(win32_setmode(handle, mode))
+ };
+ virtual int NameStat(const char *path, struct stat *buffer, int &err)
+ {
+ return win32_stat(path, buffer);
+ };
+ virtual char *Tmpnam(char *string, int &err)
+ {
+ return tmpnam(string);
+ };
+ virtual int Umask(int pmode, int &err)
+ {
+ return umask(pmode);
+ };
+ virtual int Unlink(const char *filename, int &err)
+ {
+ chmod(filename, S_IREAD | S_IWRITE);
+ CALLFUNCRET(unlink(filename))
+ };
+ virtual int Utime(char *filename, struct utimbuf *times, int &err)
+ {
+ CALLFUNCRET(win32_utime(filename, times))
+ };
+ virtual int Write(int handle, const void *buffer, unsigned int count, int &err)
+ {
+ CALLFUNCERR(win32_write(handle, buffer, count))
+ };
+};
+
+class CPerlMem : public IPerlMem
+{
+public:
+ CPerlMem() {};
+ virtual void* Malloc(size_t size)
+ {
+ return win32_malloc(size);
+ };
+ virtual void* Realloc(void* ptr, size_t size)
+ {
+ return win32_realloc(ptr, size);
+ };
+ virtual void Free(void* ptr)
+ {
+ win32_free(ptr);
+ };
+};
+
+#define EXECF_EXEC 1
+#define EXECF_SPAWN 2
+
+extern char *g_getlogin(void);
+extern int do_spawn2(char *cmd, int exectype);
+extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
+class CPerlProc : public IPerlProc
+{
+public:
+ CPerlProc() {};
+ virtual void Abort(void)
+ {
+ win32_abort();
+ };
+ virtual void Exit(int status)
+ {
+ exit(status);
+ };
+ virtual void _Exit(int status)
+ {
+ _exit(status);
+ };
+ virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
+ {
+ return execl(cmdname, arg0, arg1, arg2, arg3);
+ };
+ virtual int Execv(const char *cmdname, const char *const *argv)
+ {
+ return win32_execvp(cmdname, argv);
+ };
+ virtual int Execvp(const char *cmdname, const char *const *argv)
+ {
+ return win32_execvp(cmdname, argv);
+ };
+ virtual uid_t Getuid(void)
+ {
+ return getuid();
+ };
+ virtual uid_t Geteuid(void)
+ {
+ return geteuid();
+ };
+ virtual gid_t Getgid(void)
+ {
+ return getgid();
+ };
+ virtual gid_t Getegid(void)
+ {
+ return getegid();
+ };
+ virtual char *Getlogin(void)
+ {
+ return g_getlogin();
+ };
+ virtual int Kill(int pid, int sig)
+ {
+ return kill(pid, sig);
+ };
+ virtual int Killpg(int pid, int sig)
+ {
+ croak("killpg not implemented!\n");
+ return 0;
+ };
+ virtual int PauseProc(void)
+ {
+ return win32_sleep((32767L << 16) + 32767);
+ };
+ virtual PerlIO* Popen(const char *command, const char *mode)
+ {
+ win32_fflush(stdout);
+ win32_fflush(stderr);
+ return (PerlIO*)win32_popen(command, mode);
+ };
+ virtual int Pclose(PerlIO *stream)
+ {
+ return win32_pclose((FILE*)stream);
+ };
+ virtual int Pipe(int *phandles)
+ {
+ return win32_pipe(phandles, 512, O_BINARY);
+ };
+ virtual int Setuid(uid_t u)
+ {
+ return setuid(u);
+ };
+ virtual int Setgid(gid_t g)
+ {
+ return setgid(g);
+ };
+ virtual int Sleep(unsigned int s)
+ {
+ return win32_sleep(s);
+ };
+ virtual int Times(struct tms *timebuf)
+ {
+ return win32_times(timebuf);
+ };
+ virtual int Wait(int *status)
+ {
+ return win32_wait(status);
+ };
+ virtual Sighandler_t Signal(int sig, Sighandler_t subcode)
+ {
+ return 0;
+ };
+ virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr)
+ {
+ dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER
+ |FORMAT_MESSAGE_IGNORE_INSERTS
+ |FORMAT_MESSAGE_FROM_SYSTEM, NULL,
+ dwErr, 0, (char *)&sMsg, 1, NULL);
+ if (0 < dwLen) {
+ while (0 < dwLen && isspace(sMsg[--dwLen]))
+ ;
+ if ('.' != sMsg[dwLen])
+ dwLen++;
+ sMsg[dwLen]= '\0';
+ }
+ if (0 == dwLen) {
+ sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
+ dwLen = sprintf(sMsg,
+ "Unknown error #0x%lX (lookup 0x%lX)",
+ dwErr, GetLastError());
+ }
+ };
+ virtual void FreeBuf(char* sMsg)
+ {
+ LocalFree(sMsg);
+ };
+ virtual BOOL DoCmd(char *cmd)
+ {
+ do_spawn2(cmd, EXECF_EXEC);
+ return FALSE;
+ };
+ virtual int Spawn(char* cmds)
+ {
+ return do_spawn2(cmds, EXECF_SPAWN);
+ };
+ virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv)
+ {
+ return win32_spawnvp(mode, cmdname, argv);
+ };
+ virtual int ASpawn(void *vreally, void **vmark, void **vsp)
+ {
+ return g_do_aspawn(vreally, vmark, vsp);
+ };
+};
+
+
+class CPerlStdIO : public IPerlStdIO
+{
+public:
+ CPerlStdIO() {};
+ virtual PerlIO* Stdin(void)
+ {
+ return (PerlIO*)win32_stdin();
+ };
+ virtual PerlIO* Stdout(void)
+ {
+ return (PerlIO*)win32_stdout();
+ };
+ virtual PerlIO* Stderr(void)
+ {
+ return (PerlIO*)win32_stderr();
+ };
+ virtual PerlIO* Open(const char *path, const char *mode, int &err)
+ {
+ PerlIO*pf = (PerlIO*)win32_fopen(path, mode);
+ if(errno)
+ err = errno;
+ return pf;
+ };
+ virtual int Close(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_fclose(((FILE*)pf)))
+ };
+ virtual int Eof(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_feof((FILE*)pf))
+ };
+ virtual int Error(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_ferror((FILE*)pf))
+ };
+ virtual void Clearerr(PerlIO* pf, int &err)
+ {
+ win32_clearerr((FILE*)pf);
+ };
+ virtual int Getc(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_getc((FILE*)pf))
+ };
+ virtual char* GetBase(PerlIO* pf, int &err)
+ {
+ FILE *f = (FILE*)pf;
+ return FILE_base(f);
+ };
+ virtual int GetBufsiz(PerlIO* pf, int &err)
+ {
+ FILE *f = (FILE*)pf;
+ return FILE_bufsiz(f);
+ };
+ virtual int GetCnt(PerlIO* pf, int &err)
+ {
+ FILE *f = (FILE*)pf;
+ return FILE_cnt(f);
+ };
+ virtual char* GetPtr(PerlIO* pf, int &err)
+ {
+ FILE *f = (FILE*)pf;
+ return FILE_ptr(f);
+ };
+ virtual char* Gets(PerlIO* pf, char* s, int n, int& err)
+ {
+ char* ret = win32_fgets(s, n, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return ret;
+ };
+ virtual int Putc(PerlIO* pf, int c, int &err)
+ {
+ CALLFUNCERR(win32_fputc(c, (FILE*)pf))
+ };
+ virtual int Puts(PerlIO* pf, const char *s, int &err)
+ {
+ CALLFUNCERR(win32_fputs(s, (FILE*)pf))
+ };
+ virtual int Flush(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_fflush((FILE*)pf))
+ };
+ virtual int Ungetc(PerlIO* pf,int c, int &err)
+ {
+ CALLFUNCERR(win32_ungetc(c, (FILE*)pf))
+ };
+ virtual int Fileno(PerlIO* pf, int &err)
+ {
+ CALLFUNCERR(win32_fileno((FILE*)pf))
+ };
+ virtual PerlIO* Fdopen(int fd, const char *mode, int &err)
+ {
+ PerlIO* pf = (PerlIO*)win32_fdopen(fd, mode);
+ if(errno)
+ err = errno;
+ return pf;
+ };
+ virtual PerlIO* Reopen(const char*path, const char*mode, PerlIO* pf, int &err)
+ {
+ PerlIO* newPf = (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return newPf;
+ };
+ virtual SSize_t Read(PerlIO* pf, void *buffer, Size_t size, int &err)
+ {
+ SSize_t i = win32_fread(buffer, 1, size, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual SSize_t Write(PerlIO* pf, const void *buffer, Size_t size, int &err)
+ {
+ SSize_t i = win32_fwrite(buffer, 1, size, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void SetBuf(PerlIO* pf, char* buffer, int &err)
+ {
+ win32_setbuf((FILE*)pf, buffer);
+ };
+ virtual int SetVBuf(PerlIO* pf, char* buffer, int type, Size_t size, int &err)
+ {
+ int i = win32_setvbuf((FILE*)pf, buffer, type, size);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void SetCnt(PerlIO* pf, int n, int &err)
+ {
+ FILE *f = (FILE*)pf;
+ FILE_cnt(f) = n;
+ };
+ virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err)
+ {
+ FILE *f = (FILE*)pf;
+ FILE_ptr(f) = ptr;
+ FILE_cnt(f) = n;
+ };
+ virtual void Setlinebuf(PerlIO* pf, int &err)
+ {
+ win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
+ };
+ virtual int Printf(PerlIO* pf, int &err, const char *format,...)
+ {
+ va_list(arglist);
+ va_start(arglist, format);
+ int i = win32_vfprintf((FILE*)pf, format, arglist);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual int Vprintf(PerlIO* pf, int &err, const char *format, va_list arglist)
+ {
+ int i = win32_vfprintf((FILE*)pf, format, arglist);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual long Tell(PerlIO* pf, int &err)
+ {
+ long l = win32_ftell((FILE*)pf);
+ if(errno)
+ err = errno;
+ return l;
+ };
+ virtual int Seek(PerlIO* pf, off_t offset, int origin, int &err)
+ {
+ int i = win32_fseek((FILE*)pf, offset, origin);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void Rewind(PerlIO* pf, int &err)
+ {
+ win32_rewind((FILE*)pf);
+ };
+ virtual PerlIO* Tmpfile(int &err)
+ {
+ PerlIO* pf = (PerlIO*)win32_tmpfile();
+ if(errno)
+ err = errno;
+ return pf;
+ };
+ virtual int Getpos(PerlIO* pf, Fpos_t *p, int &err)
+ {
+ int i = win32_fgetpos((FILE*)pf, p);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual int Setpos(PerlIO* pf, const Fpos_t *p, int &err)
+ {
+ int i = win32_fsetpos((FILE*)pf, p);
+ if(errno)
+ err = errno;
+ return i;
+ };
+ virtual void Init(int &err)
+ {
+ };
+ virtual void InitOSExtras(void* p)
+ {
+ Perl_init_os_extras();
+ };
+ virtual int OpenOSfhandle(long osfhandle, int flags)
+ {
+ return win32_open_osfhandle(osfhandle, flags);
+ }
+ virtual int GetOSfhandle(int filenum)
+ {
+ return win32_get_osfhandle(filenum);
+ }
+};
+
+
+static void xs_init _((CPERLarg));
+
+class CPerlHost
+{
+public:
+ CPerlHost() { pPerl = NULL; };
+ inline BOOL PerlCreate(void)
+ {
+ try
+ {
+ pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, &perlDir, &perlSock, &perlProc);
+ if(pPerl != NULL)
+ {
+ try
+ {
+ pPerl->perl_construct();
+ }
+ catch(...)
+ {
+ win32_fprintf(stderr, "%s\n", "Error: Unable to construct data structures");
+ pPerl->perl_free();
+ pPerl = NULL;
+ }
+ }
+ }
+ catch(...)
+ {
+ win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
+ pPerl = NULL;
+ }
+ return (pPerl != NULL);
+ };
+ inline int PerlParse(int argc, char** argv, char** env)
+ {
+ int retVal;
+ try
+ {
+ retVal = pPerl->perl_parse(xs_init, argc, argv, env);
+ }
+ catch(int x)
+ {
+ // this is where exit() should arrive
+ retVal = x;
+ }
+ catch(...)
+ {
+ win32_fprintf(stderr, "Error: Parse exception\n");
+ retVal = -1;
+ }
+ *win32_errno() = 0;
+ return retVal;
+ };
+ inline int PerlRun(void)
+ {
+ int retVal;
+ try
+ {
+ retVal = pPerl->perl_run();
+ }
+ catch(int x)
+ {
+ // this is where exit() should arrive
+ retVal = x;
+ }
+ catch(...)
+ {
+ win32_fprintf(stderr, "Error: Runtime exception\n");
+ retVal = -1;
+ }
+ return retVal;
+ };
+ inline void PerlDestroy(void)
+ {
+ try
+ {
+ pPerl->perl_destruct();
+ pPerl->perl_free();
+ }
+ catch(...)
+ {
+ }
+ };
+
+protected:
+ CPerlDir perlDir;
+ CPerlEnv perlEnv;
+ CPerlLIO perlLIO;
+ CPerlMem perlMem;
+ CPerlProc perlProc;
+ CPerlSock perlSock;
+ CPerlStdIO perlStdIO;
+};
+
+#undef PERL_SYS_INIT
+#define PERL_SYS_INIT(a, c)
+
+int
+main(int argc, char **argv, char **env)
+{
+ CPerlHost host;
+ int exitstatus = 1;
+
+ if(!host.PerlCreate())
+ exit(exitstatus);
+
+
+ exitstatus = host.PerlParse(argc, argv, NULL);
+
+ if (!exitstatus)
+ {
+ exitstatus = host.PerlRun();
+ }
+
+ host.PerlDestroy();
+
+ return exitstatus;
+}
+
+char *staticlinkmodules[] = {
+ "DynaLoader",
+ NULL,
+};
+
+EXTERN_C void boot_DynaLoader _((CV* cv _CPERLarg));
+
+static void
+xs_init(CPERLarg)
+{
+ char *file = __FILE__;
+ dXSUB_SYS;
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
+#else /* PERL_OBJECT */
+
#ifdef __GNUC__
/*
* GNU C does not do __declspec()
@@ -22,3 +1044,5 @@ main(int argc, char **argv, char **env)
{
return RunPerl(argc, argv, env, (void*)0);
}
+
+#endif /* PERL_OBJECT */
diff --git a/win32/win32.c b/win32/win32.c
index 9cee6b51fa..21da8434df 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -13,6 +13,10 @@
#include <tchar.h>
#ifdef __GNUC__
#define Win32_Winsock
+# ifdef __cplusplus
+#undef __attribute__ /* seems broken in 2.8.0 */
+#define __attribute__(p)
+# endif
#endif
#include <windows.h>
@@ -37,7 +41,14 @@
#include "EXTERN.h"
#include "perl.h"
+
+#define NO_XSLOCKS
+#ifdef PERL_OBJECT
+extern CPerlObj* pPerl;
+#endif
#include "XSUB.h"
+
+#include "Win32iop.h"
#include <fcntl.h>
#include <sys/stat.h>
#ifndef __GNUC__
@@ -65,14 +76,42 @@ int _CRT_glob = 0;
#define EXECF_SPAWN 2
#define EXECF_SPAWN_NOWAIT 3
+#if defined(PERL_OBJECT)
+#undef win32_get_stdlib
+#define win32_get_stdlib g_win32_get_stdlib
+#undef win32_get_sitelib
+#define win32_get_sitelib g_win32_get_sitelib
+#undef do_aspawn
+#define do_aspawn g_do_aspawn
+#undef do_spawn
+#define do_spawn g_do_spawn
+#undef do_exec
+#define do_exec g_do_exec
+#undef opendir
+#define opendir g_opendir
+#undef readdir
+#define readdir g_readdir
+#undef telldir
+#define telldir g_telldir
+#undef seekdir
+#define seekdir g_seekdir
+#undef rewinddir
+#define rewinddir g_rewinddir
+#undef closedir
+#define closedir g_closedir
+#undef getlogin
+#define getlogin g_getlogin
+#endif
+
static DWORD os_id(void);
static void get_shell(void);
static long tokenize(char *str, char **dest, char ***destv);
-static int do_spawn2(char *cmd, int exectype);
+ int do_spawn2(char *cmd, int exectype);
static BOOL has_redirection(char *ptr);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
+
HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
static DWORD w32_platform = (DWORD)-1;
@@ -109,31 +148,214 @@ IsWinNT(void) {
return (os_id() == VER_PLATFORM_WIN32_NT);
}
+char*
+GetRegStrFromKey(HKEY hkey, const char *lpszValueName, char** ptr, DWORD* lpDataLen)
+{ /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
+ HKEY handle;
+ DWORD type;
+ const char *subkey = "Software\\Perl";
+ long retval;
+
+ retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
+ if (retval == ERROR_SUCCESS){
+ retval = RegQueryValueEx(handle, lpszValueName, 0, &type, NULL, lpDataLen);
+ if (retval == ERROR_SUCCESS && type == REG_SZ) {
+ if (*ptr != NULL) {
+ Renew(*ptr, *lpDataLen, char);
+ }
+ else {
+ New(1312, *ptr, *lpDataLen, char);
+ }
+ retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen);
+ if (retval != ERROR_SUCCESS) {
+ Safefree(ptr);
+ ptr = NULL;
+ }
+ }
+ RegCloseKey(handle);
+ }
+ return *ptr;
+}
+
+char*
+GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen)
+{
+ *ptr = GetRegStrFromKey(HKEY_CURRENT_USER, lpszValueName, ptr, lpDataLen);
+ if (*ptr == NULL)
+ {
+ *ptr = GetRegStrFromKey(HKEY_LOCAL_MACHINE, lpszValueName, ptr, lpDataLen);
+ }
+ return *ptr;
+}
+
+char *
+win32_get_stdlib(char *pl)
+{
+ static char szStdLib[] = "lib";
+ int len = 0, newSize;
+ char szBuffer[MAX_PATH+1];
+ char szModuleName[MAX_PATH];
+ int result;
+ DWORD dwDataLen;
+ char *lpPath = NULL;
+ char *ptr;
+
+ /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
+ sprintf(szBuffer, "%s-%s", szStdLib, pl);
+ lpPath = GetRegStr(szBuffer, &lpPath, &dwDataLen);
+ if (lpPath == NULL)
+ lpPath = GetRegStr(szStdLib, &lpPath, &dwDataLen);
+
+ /* $stdlib .= ";$EMD/../../lib" */
+ GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName));
+ ptr = strrchr(szModuleName, '\\');
+ if (ptr != NULL)
+ {
+ *ptr = '\0';
+ ptr = strrchr(szModuleName, '\\');
+ if (ptr != NULL)
+ {
+ *ptr = '\0';
+ ptr = strrchr(szModuleName, '\\');
+ }
+ }
+ if (ptr == NULL)
+ {
+ ptr = szModuleName;
+ *ptr = '\\';
+ }
+ strcpy(++ptr, szStdLib);
+
+ /* check that this path exists */
+ GetCurrentDirectory(sizeof(szBuffer), szBuffer);
+ result = SetCurrentDirectory(szModuleName);
+ SetCurrentDirectory(szBuffer);
+ if (result == 0)
+ {
+ GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName));
+ ptr = strrchr(szModuleName, '\\');
+ if (ptr != NULL)
+ strcpy(++ptr, szStdLib);
+ }
+
+ newSize = strlen(szModuleName) + 1;
+ if (lpPath != NULL)
+ {
+ len = strlen(lpPath);
+ newSize += len + 1; /* plus 1 for ';' */
+ lpPath = Renew(lpPath, newSize, char);
+ }
+ else
+ New(1310, lpPath, newSize, char);
+
+ if (lpPath != NULL)
+ {
+ if (len != 0)
+ lpPath[len++] = ';';
+ strcpy(&lpPath[len], szModuleName);
+ }
+ return lpPath;
+}
+
+char *
+get_sitelib_part(char* lpRegStr, char* lpPathStr)
+{
+ char szBuffer[MAX_PATH+1];
+ char szModuleName[MAX_PATH];
+ DWORD dwDataLen;
+ int len = 0;
+ int result;
+ char *lpPath = NULL;
+ char *ptr;
+
+ lpPath = GetRegStr(lpRegStr, &lpPath, &dwDataLen);
+
+ /* $sitelib .= ";$EMD/../../../<lpPathStr>" */
+ GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName));
+ ptr = strrchr(szModuleName, '\\');
+ if (ptr != NULL)
+ {
+ *ptr = '\0';
+ ptr = strrchr(szModuleName, '\\');
+ if (ptr != NULL)
+ {
+ *ptr = '\0';
+ ptr = strrchr(szModuleName, '\\');
+ if (ptr != NULL)
+ {
+ *ptr = '\0';
+ ptr = strrchr(szModuleName, '\\');
+ }
+ }
+ }
+ if (ptr == NULL)
+ {
+ ptr = szModuleName;
+ *ptr = '\\';
+ }
+ strcpy(++ptr, lpPathStr);
+
+ /* check that this path exists */
+ GetCurrentDirectory(sizeof(szBuffer), szBuffer);
+ result = SetCurrentDirectory(szModuleName);
+ SetCurrentDirectory(szBuffer);
+
+ if (result)
+ {
+ int newSize = strlen(szModuleName) + 1;
+ if (lpPath != NULL)
+ {
+ len = strlen(lpPath);
+ newSize += len + 1; /* plus 1 for ';' */
+ lpPath = Renew(lpPath, newSize, char);
+ }
+ else
+ New(1311, lpPath, newSize, char);
+
+ if (lpPath != NULL)
+ {
+ if (len != 0)
+ lpPath[len++] = ';';
+ strcpy(&lpPath[len], szModuleName);
+ }
+ }
+ return lpPath;
+}
+
char *
-win32_perllib_path(char *sfx,...)
+win32_get_sitelib(char *pl)
{
- dTHR;
- va_list ap;
- char *end;
-
- va_start(ap,sfx);
- GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE)
- ? GetModuleHandle(NULL)
- : w32_perldll_handle,
- w32_perllib_root,
- sizeof(w32_perllib_root));
- *(end = strrchr(w32_perllib_root, '\\')) = '\0';
- if (stricmp(end-4,"\\bin") == 0)
- end -= 4;
- strcpy(end,"\\lib");
- while (sfx)
- {
- strcat(end,"\\");
- strcat(end,sfx);
- sfx = va_arg(ap,char *);
- }
- va_end(ap);
- return (w32_perllib_root);
+ static char szSiteLib[] = "sitelib";
+ char szRegStr[40];
+ char szPathStr[MAX_PATH];
+ char *lpPath1;
+ char *lpPath2;
+ int len, newSize;
+
+ /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */
+ sprintf(szRegStr, "%s-%s", szSiteLib, pl);
+ sprintf(szPathStr, "site\\%s\\lib", pl);
+ lpPath1 = get_sitelib_part(szRegStr, szPathStr);
+
+ /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */
+ lpPath2 = get_sitelib_part(szSiteLib, "site\\lib");
+ if (lpPath1 == NULL)
+ return lpPath2;
+
+ if (lpPath2 == NULL)
+ return lpPath1;
+
+ len = strlen(lpPath1);
+ newSize = len + strlen(lpPath2) + 2; /* plus one for ';' */
+
+ lpPath1 = Renew(lpPath1, newSize, char);
+ if (lpPath1 != NULL)
+ {
+ lpPath1[len++] = ';';
+ strcpy(&lpPath1[len], lpPath2);
+ }
+ Safefree(lpPath2);
+ return lpPath1;
}
@@ -175,6 +397,7 @@ has_redirection(char *ptr)
return FALSE;
}
+#if !defined(PERL_OBJECT)
/* since the current process environment is being updated in util.c
* the library functions will get the correct environment
*/
@@ -207,6 +430,7 @@ my_pclose(PerlIO *fp)
{
return win32_pclose(fp);
}
+#endif
static DWORD
os_id(void)
@@ -325,7 +549,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
argv[index++] = 0;
status = win32_spawnvp(flag,
- (really ? SvPV(really,na) : argv[0]),
+ (const char*)(really ? SvPV(really,na) : argv[0]),
(const char* const*)argv);
if (status < 0 && errno == ENOEXEC) {
@@ -338,7 +562,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
argv[sh_items] = w32_perlshell_vec[sh_items];
status = win32_spawnvp(flag,
- (really ? SvPV(really,na) : argv[0]),
+ (const char*)(really ? SvPV(really,na) : argv[0]),
(const char* const*)argv);
}
@@ -356,7 +580,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
return (status);
}
-static int
+int
do_spawn2(char *cmd, int exectype)
{
char **a;
@@ -689,7 +913,7 @@ kill(int pid, int sig)
}
return 0;
}
-
+
/*
* File system stuff
*/
@@ -754,13 +978,34 @@ win32_getenv(const char *name)
DWORD needlen;
if (!curitem)
New(1305,curitem,curlen,char);
- if (!(needlen = GetEnvironmentVariable(name,curitem,curlen)))
- return Nullch;
- while (needlen > curlen) {
- Renew(curitem,needlen,char);
- curlen = needlen;
- needlen = GetEnvironmentVariable(name,curitem,curlen);
+
+ needlen = GetEnvironmentVariable(name,curitem,curlen);
+ if (needlen != 0) {
+ while (needlen > curlen) {
+ Renew(curitem,needlen,char);
+ curlen = needlen;
+ needlen = GetEnvironmentVariable(name,curitem,curlen);
+ }
+ }
+ else
+ {
+ /* allow any environment variables that begin with 'PERL5'
+ to be stored in the registry
+ */
+ if(curitem != NULL)
+ *curitem = '\0';
+
+ if (strncmp(name, "PERL5", 5) == 0) {
+ if (curitem != NULL) {
+ Safefree(curitem);
+ curitem = NULL;
+ }
+ curitem = GetRegStr(name, &curitem, &curlen);
+ }
}
+ if(curitem != NULL && *curitem == '\0')
+ return Nullch;
+
return curitem;
}
@@ -1199,7 +1444,7 @@ win32_str_os_error(void *sv, DWORD dwErr)
sMsg[dwLen]= '\0';
}
if (0 == dwLen) {
- sMsg = LocalAlloc(0, 64/**sizeof(TCHAR)*/);
+ sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
dwLen = sprintf(sMsg,
"Unknown error #0x%lX (lookup 0x%lX)",
dwErr, GetLastError());
@@ -2113,6 +2358,714 @@ XS(w32_Sleep)
XSRETURN_YES;
}
+#define TMPBUFSZ 1024
+#define MAX_LENGTH 2048
+#define SUCCESSRETURNED(x) (x == ERROR_SUCCESS)
+#define REGRETURN(x) XSRETURN_IV(SUCCESSRETURNED(x))
+#define SvHKEY(index) (HKEY)((unsigned long)SvIV(index))
+#define SETIV(index,value) sv_setiv(ST(index), value)
+#define SETNV(index,value) sv_setnv(ST(index), value)
+#define SETPV(index,string) sv_setpv(ST(index), string)
+#define SETPVN(index, buffer, length) sv_setpvn(ST(index), (char*)buffer, length)
+#define SETHKEY(index, hkey) SETIV(index,(long)hkey)
+
+static time_t ft2timet(FILETIME *ft)
+{
+ SYSTEMTIME st;
+ struct tm tm;
+
+ FileTimeToSystemTime(ft, &st);
+ tm.tm_sec = st.wSecond;
+ tm.tm_min = st.wMinute;
+ tm.tm_hour = st.wHour;
+ tm.tm_mday = st.wDay;
+ tm.tm_mon = st.wMonth - 1;
+ tm.tm_year = st.wYear - 1900;
+ tm.tm_wday = st.wDayOfWeek;
+ tm.tm_yday = -1;
+ tm.tm_isdst = -1;
+ return mktime (&tm);
+}
+
+static
+XS(w32_RegCloseKey)
+{
+ dXSARGS;
+
+ if (items != 1)
+ {
+ croak("usage: Win32::RegCloseKey($hkey);\n");
+ }
+
+ REGRETURN(RegCloseKey(SvHKEY(ST(0))));
+}
+
+static
+XS(w32_RegConnectRegistry)
+{
+ dXSARGS;
+ HKEY handle;
+
+ if (items != 3)
+ {
+ croak("usage: Win32::RegConnectRegistry($machine, $hkey, $handle);\n");
+ }
+
+ if (SUCCESSRETURNED(RegConnectRegistry((char *)SvPV(ST(0), na), SvHKEY(ST(1)), &handle)))
+ {
+ SETHKEY(2,handle);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegCreateKey)
+{
+ dXSARGS;
+ HKEY handle;
+ DWORD disposition;
+ long retval;
+
+ if (items != 3)
+ {
+ croak("usage: Win32::RegCreateKey($hkey, $subkey, $handle);\n");
+ }
+
+ retval = RegCreateKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS,
+ NULL, &handle, &disposition);
+
+ if (SUCCESSRETURNED(retval))
+ {
+ SETHKEY(2,handle);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegCreateKeyEx)
+{
+ dXSARGS;
+
+ unsigned int length;
+ long retval;
+ HKEY hkey, handle;
+ char *subkey;
+ char *keyclass;
+ DWORD options, disposition;
+ REGSAM sam;
+ SECURITY_ATTRIBUTES sa, *psa;
+
+ if (items != 9)
+ {
+ croak("usage: Win32::RegCreateKeyEx($hkey, $subkey, $reserved, $class, $options, $sam, "
+ "$security, $handle, $disposition);\n");
+ }
+
+ hkey = SvHKEY(ST(0));
+ subkey = (char *)SvPV(ST(1), na);
+ keyclass = (char *)SvPV(ST(3), na);
+ options = (DWORD) ((unsigned long)SvIV(ST(4)));
+ sam = (REGSAM) ((unsigned long)SvIV(ST(5)));
+ psa = (SECURITY_ATTRIBUTES*)SvPV(ST(6), length);
+ if (length != sizeof(SECURITY_ATTRIBUTES))
+ {
+ psa = &sa;
+ memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
+ sa.nLength = sizeof(SECURITY_ATTRIBUTES);
+ }
+
+ retval = RegCreateKeyEx(hkey, subkey, 0, keyclass, options, sam,
+ psa, &handle, &disposition);
+
+ if (SUCCESSRETURNED(retval))
+ {
+ if (psa == &sa)
+ SETPVN(6, &sa, sizeof(sa));
+
+ SETHKEY(7,handle);
+ SETIV(8,disposition);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegDeleteKey)
+{
+ dXSARGS;
+
+ if (items != 2)
+ {
+ croak("usage: Win32::RegDeleteKey($hkey, $subkey);\n");
+ }
+
+ REGRETURN(RegDeleteKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na)));
+}
+
+static
+XS(w32_RegDeleteValue)
+{
+ dXSARGS;
+
+ if (items != 2)
+ {
+ croak("usage: Win32::RegDeleteValue($hkey, $valname);\n");
+ }
+
+ REGRETURN(RegDeleteValue(SvHKEY(ST(0)), (char *)SvPV(ST(1), na)));
+}
+
+static
+XS(w32_RegEnumKey)
+{
+ dXSARGS;
+
+ char keybuffer[TMPBUFSZ];
+
+ if (items != 3)
+ {
+ croak("usage: Win32::RegEnumKey($hkey, $idx, $subkeyname);\n");
+ }
+
+ if (SUCCESSRETURNED(RegEnumKey(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, sizeof(keybuffer))))
+ {
+ SETPV(2, keybuffer);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegEnumKeyEx)
+{
+ dXSARGS;
+ int length;
+
+ DWORD keysz, classsz;
+ char keybuffer[TMPBUFSZ];
+ char classbuffer[TMPBUFSZ];
+ long retval;
+ FILETIME filetime;
+
+ if (items != 6)
+ {
+ croak("usage: Win32::RegEnumKeyEx($hkey, $idx, $subkeyname, $reserved, $class, $time);\n");
+ }
+
+ keysz = sizeof(keybuffer);
+ classsz = sizeof(classbuffer);
+ retval = RegEnumKeyEx(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, &keysz, 0,
+ classbuffer, &classsz, &filetime);
+ if (SUCCESSRETURNED(retval))
+ {
+ SETPV(2, keybuffer);
+ SETPV(4, classbuffer);
+ SETIV(5, ft2timet(&filetime));
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegEnumValue)
+{
+ dXSARGS;
+ HKEY hkey;
+ DWORD type, namesz, valsz;
+ long retval;
+ static HKEY last_hkey;
+ char myvalbuf[MAX_LENGTH];
+ char mynambuf[MAX_LENGTH];
+
+ if (items != 6)
+ {
+ croak("usage: Win32::RegEnumValue($hkey, $i, $name, $reserved, $type, $value);\n");
+ }
+
+ hkey = SvHKEY(ST(0));
+
+ // If this is a new key, find out how big the maximum name and value sizes are and
+ // allocate space for them. Free any old storage and set the old key value to the
+ // current key.
+
+ if (hkey != (HKEY)last_hkey)
+ {
+ char keyclass[TMPBUFSZ];
+ DWORD classsz, subkeys, maxsubkey, maxclass, values, salen, maxnamesz, maxvalsz;
+ FILETIME ft;
+ classsz = sizeof(keyclass);
+ retval = RegQueryInfoKey(hkey, keyclass, &classsz, 0, &subkeys, &maxsubkey, &maxclass,
+ &values, &maxnamesz, &maxvalsz, &salen, &ft);
+
+ if (!SUCCESSRETURNED(retval))
+ {
+ XSRETURN_NO;
+ }
+ memset(myvalbuf, 0, MAX_LENGTH);
+ memset(mynambuf, 0, MAX_LENGTH);
+ last_hkey = hkey;
+ }
+
+ namesz = MAX_LENGTH;
+ valsz = MAX_LENGTH;
+ retval = RegEnumValue(hkey, SvIV(ST(1)), mynambuf, &namesz, 0, &type, (LPBYTE) myvalbuf, &valsz);
+ if (!SUCCESSRETURNED(retval))
+ {
+ XSRETURN_NO;
+ }
+ else
+ {
+ SETPV(2, mynambuf);
+ SETIV(4, type);
+
+ // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ
+ switch(type)
+ {
+ case REG_SZ:
+ case REG_MULTI_SZ:
+ case REG_EXPAND_SZ:
+ if (valsz)
+ --valsz;
+ case REG_BINARY:
+ SETPVN(5, myvalbuf, valsz);
+ break;
+
+ case REG_DWORD_BIG_ENDIAN:
+ {
+ BYTE tmp = myvalbuf[0];
+ myvalbuf[0] = myvalbuf[3];
+ myvalbuf[3] = tmp;
+ tmp = myvalbuf[1];
+ myvalbuf[1] = myvalbuf[2];
+ myvalbuf[2] = tmp;
+ }
+ case REG_DWORD_LITTLE_ENDIAN: // same as REG_DWORD
+ SETNV(5, (double)*((DWORD*)myvalbuf));
+ break;
+
+ default:
+ break;
+ }
+
+ XSRETURN_YES;
+ }
+}
+
+static
+XS(w32_RegFlushKey)
+{
+ dXSARGS;
+
+ if (items != 1)
+ {
+ croak("usage: Win32::RegFlushKey($hkey);\n");
+ }
+
+ REGRETURN(RegFlushKey(SvHKEY(ST(0))));
+}
+
+static
+XS(w32_RegGetKeySecurity)
+{
+ dXSARGS;
+ SECURITY_DESCRIPTOR sd;
+ DWORD sdsz;
+
+ if (items != 3)
+ {
+ croak("usage: Win32::RegGetKeySecurity($hkey, $security_info, $security_descriptor);\n");
+ }
+
+ if (SUCCESSRETURNED(RegGetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), &sd, &sdsz)))
+ {
+ SETPVN(2, &sd, sdsz);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegLoadKey)
+{
+ dXSARGS;
+
+ if (items != 3)
+ {
+ croak("usage: Win32::RegLoadKey($hkey, $subkey, $filename);\n");
+ }
+
+ REGRETURN(RegLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na)));
+}
+
+static
+XS(w32_RegNotifyChangeKeyValue)
+{
+ croak("Win32::RegNotifyChangeKeyValue not yet implemented!\n");
+}
+
+static
+XS(w32_RegOpenKey)
+{
+ dXSARGS;
+ HKEY handle;
+
+ if (items != 3)
+ {
+ croak("usage: Win32::RegOpenKey($hkey, $subkey, $handle);\n");
+ }
+
+ if (SUCCESSRETURNED(RegOpenKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), &handle)))
+ {
+ SETHKEY(2,handle);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegOpenKeyEx)
+{
+ dXSARGS;
+ HKEY handle;
+
+ if (items != 5)
+ {
+ croak("usage: Win32::RegOpenKeyEx($hkey, $subkey, $reserved, $sam, $handle);\n");
+ }
+
+ if (SUCCESSRETURNED(RegOpenKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na),
+ 0, (REGSAM) ((unsigned long)SvIV(ST(3))), &handle)))
+ {
+ SETHKEY(4,handle);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+#pragma optimize("", off)
+static
+XS(w32_RegQueryInfoKey)
+{
+ dXSARGS;
+ int length;
+
+ char keyclass[TMPBUFSZ];
+ DWORD subkeys, maxsubkey, maxclass, values, maxvalname, maxvaldata;
+ DWORD seclen, classsz;
+ FILETIME ft;
+ long retval;
+
+ if (items != 10)
+ {
+ croak("usage: Win32::RegQueryInfoKey($hkey, $class, $numsubkeys, $maxsubkey,"
+ "$maxclass, $values, $maxvalname, $maxvaldata, $secdesclen,"
+ "$lastwritetime);\n");
+ }
+
+ classsz = sizeof(keyclass);
+ retval = RegQueryInfoKey(SvHKEY(ST(0)), keyclass, &classsz, 0, &subkeys, &maxsubkey,
+ &maxclass, &values, &maxvalname, &maxvaldata,
+ &seclen, &ft);
+ if (SUCCESSRETURNED(retval))
+ {
+ SETPV(1, keyclass);
+ SETIV(2, subkeys);
+ SETIV(3, maxsubkey);
+ SETIV(4, maxclass);
+ SETIV(5, values);
+ SETIV(6, maxvalname);
+ SETIV(7, maxvaldata);
+ SETIV(8, seclen);
+ SETIV(9, ft2timet(&ft));
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+#pragma optimize("", on)
+
+static
+XS(w32_RegQueryValue)
+{
+ dXSARGS;
+
+ unsigned char databuffer[TMPBUFSZ*2];
+ long datasz = sizeof(databuffer);
+
+ if (items != 3)
+ {
+ croak("usage: Win32::RegQueryValue($hkey, $valuename, $data);\n");
+ }
+
+ if (SUCCESSRETURNED(RegQueryValue(SvHKEY(ST(0)), SvPV(ST(1), na), (char*)databuffer, &datasz)))
+ {
+ // return includes the null terminator so delete it
+ SETPVN(2, databuffer, --datasz);
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegQueryValueEx)
+{
+ dXSARGS;
+
+ unsigned char databuffer[TMPBUFSZ*2];
+ DWORD datasz = sizeof(databuffer);
+ DWORD type;
+ LONG result;
+ LPBYTE ptr = databuffer;
+
+ if (items != 5)
+ {
+ croak("usage: Win32::RegQueryValueEx($hkey, $valuename, $reserved, $type, $data);\n");
+ }
+
+ result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz);
+ if (result == ERROR_MORE_DATA)
+ {
+ New(0, ptr, datasz+1, BYTE);
+ result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz);
+ }
+ if (SUCCESSRETURNED(result))
+ {
+ SETIV(3, type);
+
+ // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ
+ switch(type)
+ {
+ case REG_SZ:
+ case REG_MULTI_SZ:
+ case REG_EXPAND_SZ:
+ --datasz;
+ case REG_BINARY:
+ SETPVN(4, ptr, datasz);
+ break;
+
+ case REG_DWORD_BIG_ENDIAN:
+ {
+ BYTE tmp = ptr[0];
+ ptr[0] = ptr[3];
+ ptr[3] = tmp;
+ tmp = ptr[1];
+ ptr[1] = ptr[2];
+ ptr[2] = tmp;
+ }
+ case REG_DWORD_LITTLE_ENDIAN: // same as REG_DWORD
+ SETNV(4, (double)*((DWORD*)ptr));
+ break;
+
+ default:
+ break;
+ }
+
+ if (ptr != databuffer)
+ safefree(ptr);
+
+ XSRETURN_YES;
+ }
+ if (ptr != databuffer)
+ safefree(ptr);
+
+ XSRETURN_NO;
+}
+
+static
+XS(w32_RegReplaceKey)
+{
+ dXSARGS;
+
+ if (items != 4)
+ {
+ croak("usage: Win32::RegReplaceKey($hkey, $subkey, $newfile, $oldfile);\n");
+ }
+
+ REGRETURN(RegReplaceKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na), (char *)SvPV(ST(3), na)));
+}
+
+static
+XS(w32_RegRestoreKey)
+{
+ dXSARGS;
+
+ if (items < 2 || items > 3)
+ {
+ croak("usage: Win32::RegRestoreKey($hkey, $filename [, $flags]);\n");
+ }
+
+ REGRETURN(RegRestoreKey(SvHKEY(ST(0)), (char*)SvPV(ST(1), na), (DWORD)((items == 3) ? SvIV(ST(2)) : 0)));
+}
+
+static
+XS(w32_RegSaveKey)
+{
+ dXSARGS;
+
+ if (items != 2)
+ {
+ croak("usage: Win32::RegSaveKey($hkey, $filename);\n");
+ }
+
+ REGRETURN(RegSaveKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), NULL));
+}
+
+static
+XS(w32_RegSetKeySecurity)
+{
+ dXSARGS;
+
+ if (items != 3)
+ {
+ croak("usage: Win32::RegSetKeySecurity($hkey, $security_info, $security_descriptor);\n");
+ }
+
+ REGRETURN(RegSetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), (SECURITY_DESCRIPTOR*)SvPV(ST(2), na)));
+}
+
+static
+XS(w32_RegSetValue)
+{
+ dXSARGS;
+
+ unsigned int size;
+ char *buffer;
+ DWORD type;
+
+ if (items != 4)
+ {
+ croak("usage: Win32::RegSetValue($hkey, $subKey, $type, $data);\n");
+ }
+
+ 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));
+ }
+
+ buffer = (char *)SvPV(ST(3), size);
+ REGRETURN(RegSetValue(SvHKEY(ST(0)), SvPV(ST(1), na), REG_SZ, buffer, size));
+}
+
+static
+XS(w32_RegSetValueEx)
+{
+ dXSARGS;
+
+ DWORD type;
+ DWORD val;
+ unsigned int size;
+ char *buffer;
+
+ if (items != 5)
+ {
+ croak("usage: Win32::RegSetValueEx($hkey, $valname, $reserved, $type, $data);\n");
+ }
+
+ type = (DWORD)SvIV(ST(3));
+ switch(type)
+ {
+ case REG_SZ:
+ case REG_BINARY:
+ case REG_MULTI_SZ:
+ case REG_EXPAND_SZ:
+ buffer = (char *)SvPV(ST(4), size);
+ if (type != REG_BINARY)
+ size++; // include null terminator in size
+
+ REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) buffer, size));
+ break;
+
+ case REG_DWORD_BIG_ENDIAN:
+ case REG_DWORD_LITTLE_ENDIAN: // Same as REG_DWORD
+ val = (DWORD)SvIV(ST(4));
+ REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) &val, sizeof(DWORD)));
+ break;
+
+ default:
+ croak("Win32::RegSetValueEx: Type not specified, cannot set %s\n", (char *)SvPV(ST(1), na));
+ }
+}
+
+static
+XS(w32_RegUnloadKey)
+{
+ dXSARGS;
+
+ if (items != 2)
+ {
+ croak("usage: Win32::RegUnLoadKey($hkey, $subkey);\n");
+ }
+
+ REGRETURN(RegUnLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na)));
+}
+
+static
+XS(w32_RegisterServer)
+{
+ dXSARGS;
+ BOOL bSuccess = FALSE;
+ HINSTANCE hInstance;
+ unsigned int length;
+ FARPROC sFunc;
+
+ if (items != 1)
+ {
+ croak("usage: Win32::RegisterServer($LibraryName)\n");
+ }
+
+ hInstance = LoadLibrary((char *)SvPV(ST(0), length));
+ if (hInstance != NULL)
+ {
+ sFunc = GetProcAddress(hInstance, "DllRegisterServer");
+ if (sFunc != NULL)
+ {
+ bSuccess = (sFunc() == 0);
+ }
+ FreeLibrary(hInstance);
+ }
+
+ if (bSuccess)
+ {
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+static
+XS(w32_UnregisterServer)
+{
+ dXSARGS;
+ BOOL bSuccess = FALSE;
+ HINSTANCE hInstance;
+ unsigned int length;
+ FARPROC sFunc;
+
+ if (items != 1)
+ {
+ croak("usage: Win32::UnregisterServer($LibraryName)\n");
+ }
+
+ hInstance = LoadLibrary((char *)SvPV(ST(0), length));
+ if (hInstance != NULL)
+ {
+ sFunc = GetProcAddress(hInstance, "DllUnregisterServer");
+ if (sFunc != NULL)
+ {
+ bSuccess = (sFunc() == 0);
+ }
+ FreeLibrary(hInstance);
+ }
+
+ if (bSuccess)
+ {
+ XSRETURN_YES;
+ }
+ XSRETURN_NO;
+}
+
+
void
Perl_init_os_extras()
{
@@ -2144,6 +3097,40 @@ Perl_init_os_extras()
newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
newXS("Win32::Sleep", w32_Sleep, file);
+ /* the following extensions are used interally and may be changed at any time */
+ /* therefore no documentation is provided */
+ newXS("Win32::RegCloseKey", w32_RegCloseKey, file);
+ newXS("Win32::RegConnectRegistry", w32_RegConnectRegistry, file);
+ newXS("Win32::RegCreateKey", w32_RegCreateKey, file);
+ newXS("Win32::RegCreateKeyEx", w32_RegCreateKeyEx, file);
+ newXS("Win32::RegDeleteKey", w32_RegDeleteKey, file);
+ newXS("Win32::RegDeleteValue", w32_RegDeleteValue, file);
+
+ newXS("Win32::RegEnumKey", w32_RegEnumKey, file);
+ newXS("Win32::RegEnumKeyEx", w32_RegEnumKeyEx, file);
+ newXS("Win32::RegEnumValue", w32_RegEnumValue, file);
+
+ newXS("Win32::RegFlushKey", w32_RegFlushKey, file);
+ newXS("Win32::RegGetKeySecurity", w32_RegGetKeySecurity, file);
+
+ newXS("Win32::RegLoadKey", w32_RegLoadKey, file);
+ newXS("Win32::RegOpenKey", w32_RegOpenKey, file);
+ newXS("Win32::RegOpenKeyEx", w32_RegOpenKeyEx, file);
+ newXS("Win32::RegQueryInfoKey", w32_RegQueryInfoKey, file);
+ newXS("Win32::RegQueryValue", w32_RegQueryValue, file);
+ newXS("Win32::RegQueryValueEx", w32_RegQueryValueEx, file);
+
+ newXS("Win32::RegReplaceKey", w32_RegReplaceKey, file);
+ newXS("Win32::RegRestoreKey", w32_RegRestoreKey, file);
+ newXS("Win32::RegSaveKey", w32_RegSaveKey, file);
+ newXS("Win32::RegSetKeySecurity", w32_RegSetKeySecurity, file);
+ newXS("Win32::RegSetValue", w32_RegSetValue, file);
+ newXS("Win32::RegSetValueEx", w32_RegSetValueEx, file);
+ newXS("Win32::RegUnloadKey", w32_RegUnloadKey, file);
+
+ newXS("Win32::RegisterServer", w32_RegisterServer, file);
+ newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
+
/* XXX Bloat Alert! The following Activeware preloads really
* ought to be part of Win32::Sys::*, so they're not included
* here.
diff --git a/win32/win32.h b/win32/win32.h
index 270593da68..032b196698 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -9,9 +9,22 @@
#ifndef _INC_WIN32_PERL5
#define _INC_WIN32_PERL5
+#ifdef PERL_OBJECT
+# define WIN32IO_IS_STDIO /* don't pull in custom stdio layer */
+# ifdef PERL_GLOBAL_STRUCT
+# error PERL_GLOBAL_STRUCT cannot be defined with PERL_OBJECT
+# endif
+# define win32_get_stdlib PerlEnv_lib_path
+# define win32_get_sitelib PerlEnv_sitelib_path
+#endif
+
#ifdef __GNUC__
typedef long long __int64;
#define Win32_Winsock
+# ifdef __cplusplus
+#undef __attribute__ /* seems broken in 2.8.0 */
+#define __attribute__(p)
+# endif
/* GCC does not do __declspec() - render it a nop
* and turn on options to avoid importing data
*/
@@ -29,11 +42,15 @@ typedef long long __int64;
* otherwise import it.
*/
+#if defined(PERL_OBJECT)
+#define DllExport
+#else
#if defined(PERLDLL) || defined(WIN95FIX)
#define DllExport __declspec(dllexport)
#else
#define DllExport __declspec(dllimport)
#endif
+#endif
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
@@ -120,6 +137,11 @@ struct tms {
#define USE_RTL_WAIT /* Borland has a working wait() */
+/* Borland is picky about a bare member function name used as its ptr */
+#ifdef PERL_OBJECT
+#define FUNC_NAME_TO_PTR(name) &(name)
+#endif
+
#endif
#ifdef _MSC_VER /* Microsoft Visual C++ */
@@ -145,6 +167,13 @@ typedef long gid_t;
# endif
#endif
+#ifndef _O_NOINHERIT
+# define _O_NOINHERIT 0x0080
+# ifndef _NO_OLDNAMES
+# define O_NOINHERIT _O_NOINHERIT
+# endif
+#endif
+
#endif /* __MINGW32__ */
/* compatibility stuff for other compilers goes here */
@@ -183,7 +212,8 @@ extern int do_aspawn(void *really, void **mark, void **sp);
extern int do_spawn(char *cmd);
extern int do_spawn_nowait(char *cmd);
extern char do_exec(char *cmd);
-extern char * win32_perllib_path(char *sfx,...);
+extern char * win32_get_stdlib(char *pl);
+extern char * win32_get_sitelib(char *pl);
extern int IsWin95(void);
extern int IsWinNT(void);
diff --git a/win32/win32iop.h b/win32/win32iop.h
index ee2c2dbfa1..37794f1e1b 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -171,6 +171,7 @@ END_EXTERN_C
/*
* redirect to our own version
*/
+#undef fprintf
#define fprintf win32_fprintf
#define vfprintf win32_vfprintf
#define printf win32_printf
@@ -185,6 +186,7 @@ END_EXTERN_C
#define fputs(s,f) win32_fputs(s,f)
#define fputc(c,f) win32_fputc(c,f)
#define ungetc(c,f) win32_ungetc(c,f)
+#undef getc
#define getc(f) win32_getc(f)
#define fileno(f) win32_fileno(f)
#define clearerr(f) win32_clearerr(f)
@@ -226,9 +228,12 @@ END_EXTERN_C
#define fgets win32_fgets
#define gets win32_gets
#define fgetc win32_fgetc
+#undef putc
#define putc win32_putc
#define puts win32_puts
+#undef getchar
#define getchar win32_getchar
+#undef putchar
#define putchar win32_putchar
#if !defined(MYMALLOC) || !defined(PERL_CORE)
diff --git a/win32/win32sck.c b/win32/win32sck.c
index b07d1f1918..74af5d7756 100644
--- a/win32/win32sck.c
+++ b/win32/win32sck.c
@@ -13,10 +13,22 @@
#define WIN32_LEAN_AND_MEAN
#ifdef __GNUC__
#define Win32_Winsock
+# ifdef __cplusplus
+#undef __attribute__ /* seems broken in 2.8.0 */
+#define __attribute__(p)
+# endif
#endif
#include <windows.h>
#include "EXTERN.h"
#include "perl.h"
+
+#if defined(PERL_OBJECT)
+#define NO_XSLOCKS
+extern CPerlObj* pPerl;
+#include "XSUB.h"
+#endif
+
+#include "Win32iop.h"
#include <sys/socket.h>
#include <fcntl.h>
#include <sys/stat.h>
@@ -25,7 +37,7 @@
/* thanks to Beverly Brown (beverly@datacube.com) */
#ifdef USE_SOCKETS_AS_HANDLES
-# define OPEN_SOCKET(x) _open_osfhandle(x,O_RDWR|O_BINARY)
+# define OPEN_SOCKET(x) win32_open_osfhandle(x,O_RDWR|O_BINARY)
# define TO_SOCKET(x) _get_osfhandle(x)
#else
# define OPEN_SOCKET(x) (x)
@@ -638,7 +650,7 @@ win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
d->s_proto = s->s_proto;
else
#endif
- if (proto && strlen(proto))
+ if (proto && strlen(proto))
d->s_proto = (char *)proto;
else
d->s_proto = "tcp";
diff --git a/win32/win32thread.c b/win32/win32thread.c
index 44f32e27fd..e91830d38d 100644
--- a/win32/win32thread.c
+++ b/win32/win32thread.c
@@ -1,6 +1,12 @@
#include "EXTERN.h"
#include "perl.h"
+#if defined(PERL_OBJECT)
+#define NO_XSLOCKS
+extern CPerlObj* pPerl;
+#include "XSUB.h"
+#endif
+
#ifdef USE_DECLSPEC_THREAD
__declspec(thread) struct perl_thread *Perl_current_thread = NULL;
#endif
View Lorry Controller Status