diff options
| author | Gurusamy Sarathy <gsar@cpan.org> | 1999-07-12 01:55:15 +0000 |
|---|---|---|
| committer | Gurusamy Sarathy <gsar@cpan.org> | 1999-07-12 01:55:15 +0000 |
| commit | c5be433b5c5658093bc9cae4434721a0b63e7a85 (patch) | |
| tree | b5e25d83702fd5b6ebb6108c8cdf104a09f97040 /win32 | |
| parent | ed7ab888f26e9b2a3bcf98806b630e993179f8b4 (diff) | |
| download | perl-c5be433b5c5658093bc9cae4434721a0b63e7a85.tar.gz | |
yet more cleanups of the PERL_OBJECT, MULTIPLICITY and USE_THREADS
builds; passing the implicit context is unified among the three
flavors; PERL_IMPLICIT_CONTEXT is auto-enabled under all three
flavors (see the top of perl.h) for testing; all varargs functions
foo() have a va_list-taking variant vfoo() for generating the
context-free versions; the PERL_OBJECT build should now be
hyper-compatible with CPAN extensions (C++ is totally out of
the picture)
result has only been tested on Windows
TODO: write docs on the THX rationale and idiomatic usage of
the Perl API
p4raw-id: //depot/perl@3667
Diffstat (limited to 'win32')
| -rw-r--r-- | win32/GenCAPI.pl | 1674 | ||||
| -rw-r--r-- | win32/Makefile | 90 | ||||
| -rw-r--r-- | win32/TEST | 149 | ||||
| -rw-r--r-- | win32/autosplit.pl | 3 | ||||
| -rw-r--r-- | win32/config_H.bc | 4 | ||||
| -rw-r--r-- | win32/config_H.gc | 4 | ||||
| -rw-r--r-- | win32/config_H.vc | 4 | ||||
| -rw-r--r-- | win32/config_h.PL | 2 | ||||
| -rw-r--r-- | win32/dl_win32.xs | 2 | ||||
| -rw-r--r-- | win32/genxsdef.pl | 5 | ||||
| -rw-r--r-- | win32/include/dirent.h | 3 | ||||
| -rw-r--r-- | win32/include/sys/socket.h | 2 | ||||
| -rw-r--r-- | win32/makedef.pl | 10 | ||||
| -rw-r--r-- | win32/makefile.mk | 119 | ||||
| -rw-r--r-- | win32/makemain.pl | 45 | ||||
| -rw-r--r-- | win32/makeperldef.pl | 23 | ||||
| -rw-r--r-- | win32/perllib.c | 59 | ||||
| -rw-r--r-- | win32/runperl.c | 3 | ||||
| -rw-r--r-- | win32/win32.c | 201 | ||||
| -rw-r--r-- | win32/win32.h | 36 | ||||
| -rw-r--r-- | win32/win32iop.h | 7 | ||||
| -rw-r--r-- | win32/win32sck.c | 34 |
22 files changed, 270 insertions, 2209 deletions
diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl deleted file mode 100644 index 703a156795..0000000000 --- a/win32/GenCAPI.pl +++ /dev/null @@ -1,1674 +0,0 @@ - -# 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 @embedsyms = ('../global.sym', '../pp.sym'); -my $separateObj = 0; - -my %skip_list; -my %embed; - -sub readsyms(\%@) { - my ($syms, @files) = @_; - my ($line, @words); - %$syms = (); - foreach my $file (@files) { - local (*FILE, $_); - open(FILE, "< $file") - or die "$0: Can't open $file: $!\n"; - while (<FILE>) { - s/[ \t]*#.*$//; # delete comments - if (/^\s*(\S+)\s*$/) { - my $sym = $1; - $$syms{$sym} = $sym; - } - } - close(FILE); - } -} - -readsyms %embed, @embedsyms; - -sub skip_these { - my $list = shift; - foreach my $symbol (@$list) { - $skip_list{$symbol} = 1; - } -} - -skip_these [qw( -Perl_yylex -Perl_cando -Perl_cast_ulong -Perl_my_chsize -Perl_condpair_magic -Perl_deb -Perl_deb_growlevel -Perl_debprofdump -Perl_debop -Perl_debstack -Perl_debstackptrs -Perl_dump_fds -Perl_dump_mstats -fprintf -Perl_find_threadsv -Perl_magic_mutexfree -Perl_my_memcmp -Perl_my_memset -Perl_my_pclose -Perl_my_popen -Perl_my_swap -Perl_my_htonl -Perl_my_ntohl -Perl_new_struct_thread -Perl_same_dirent -Perl_unlnk -Perl_unlock_condpair -Perl_safexmalloc -Perl_safexcalloc -Perl_safexrealloc -Perl_safexfree -Perl_GetVars -Perl_malloced_size -Perl_do_exec3 -Perl_getenv_len -Perl_dump_indent -Perl_default_protect -Perl_croak_nocontext -Perl_die_nocontext -Perl_form_nocontext -Perl_warn_nocontext -Perl_newSVpvf_nocontext -Perl_sv_catpvf_nocontext -Perl_sv_catpvf_mg_nocontext -Perl_sv_setpvf_nocontext -Perl_sv_setpvf_mg_nocontext -Perl_do_ipcctl -Perl_do_ipcget -Perl_do_msgrcv -Perl_do_msgsnd -Perl_do_semop -Perl_do_shmio -Perl_my_bzero -perl_parse -perl_alloc -Perl_call_atexit -Perl_malloc -Perl_calloc -Perl_realloc -Perl_mfree -)]; - - - -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*))*/ - -#undef Perl_sv_2mortal -#undef Perl_newSVsv -#undef Perl_mess -#undef Perl_sv_2pv -#undef Perl_sv_vcatpvfn -#undef Perl_sv_vsetpvfn -#undef Perl_newSV -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); - -my %done; - -while () { - last unless defined ($_ = <INFILE>); - if (/^VIRTUAL\s+/) { - while (!/;$/) { - chomp; - $_ .= <INFILE>; - } - $_ =~ s/^VIRTUAL\s*//; - $_ =~ s/\s*__attribute__.*$/;/; - if ( /^(.+)\t(\w+)\((.*)\);/ ) { - $type = $1; - $name = $2; - $args = $3; - - $name =~ s/\s*$//; - $type =~ s/\s*$//; - next if (defined $skip_list{$name}); - next if $name =~ /^S_/; - next if exists $done{$name}; - - $done{$name}++; - if($args eq "ARGSproto" or $args eq "pTHX") { - $args = "void"; - } - $args =~ s/^pTHX_ //; - - $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 =~ /^Perl_(croak|deb|die|warn|form|warner)$/) { - print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0); - for (@args) { $_ = $1 if /(\w+)\W*$/; } - $arg = $args[$#args-1]; - my $start = ''; - $start = join(', ',@args[0 .. ($#args - 2)]) if @args > 2; - $start .= ', ' if $start; - print OUTFILE <<ENDCODE; - -#undef $name -extern "C" $type $funcName ($args) -{ - SV *pmsg; - va_list args; - va_start(args, $arg); - pmsg = pPerl->Perl_sv_2mortal(pPerl->Perl_newSVsv(pPerl->Perl_mess($arg, &args))); -$return pPerl->$name($start SvPV_nolen(pmsg)); - va_end(args); -} -ENDCODE - print OUTFILE "#endif\n" unless ($separateObj == 0); - } - elsif($name =~ /^Perl_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 =~ /^Perl_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 =~ /^Perl_sv_catpvf_mg/) { - 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 -#ifndef mg_set -#define mg_set pPerl->Perl_mg_set -#endif -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); - SvSETMAGIC(sv); -} -ENDCODE - print OUTFILE "#endif\n" unless ($separateObj == 0); - } - elsif($name =~ /^Perl_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 =~ /^Perl_sv_setpvf_mg/) { - 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 -#ifndef mg_set -#define mg_set pPerl->Perl_mg_set -#endif -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); - SvSETMAGIC(sv); -} -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 "Perl_newXS") { - next; - } - - print OUTFILE "\n#ifdef $name" . "defined" unless ($separateObj == 0); - - # handle specical case for save_destructor - if ($name eq "Perl_save_destructor") { - next; - } - # handle specical case for sighandler - if ($name eq "Perl_sighandler") { - next; - } - # handle special case for sv_grow - if ($name eq "Perl_sv_grow" and $args eq "SV* sv, unsigned long newlen") { - next; - } - # handle special case for newSV - if ($name eq "Perl_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_call_atexit") { - print OUTFILE <<ENDCODE; - -#undef $name -extern "C" $type $name ($args) -{ - pPerl->perl_call_atexit(fn, ptr); -} -ENDCODE - print OUTFILE "#endif\n" unless ($separateObj == 0); - next; - } - - - if($name eq "Perl_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 -oldlastpm -gensym -preambled -preambleav -Ilaststatval -Ilaststype -mess_sv -ors -opsave -eval_mutex -strtab_mutex -orslen -ofmt -modcount -generation -DBcv -archpat_auto -sortcxix -lastgotoprobe -regdummy -regcomp_parse -regxend -regcode -regnaughty -regsawback -regprecomp -regnpar -regsize -regflags -regseen -seen_zerolen -regcomp_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 -PL_Mem -PL_Env -PL_StdIO -PL_LIO -PL_Dir -PL_Sock -PL_Proc -cshname -threadsv_names -thread -nthreads -thr_key -threads_mutex -malloc_mutex -svref_mutex -sv_mutex -cred_mutex -nthreads_cond -eval_cond -cryptseen -cshlen -watchaddr -watchok -)]; - -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 (/PERLVARA?I?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); -void boot_CAPI_handler(CV *cv, void (*subaddr)(CV *c), 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; -#undef PL_$name -extern "C" $type * _PL_$name () -{ - return (($type *)&pPerl->PL_$name); -} - -ENDCODE - - print OUTFILE "#endif\n" unless ($separateObj == 0); - - print HDRFILE <<ENDCODE; - -#undef PL_$name -$type * _PL_$name (); -#define PL_$name (*_PL_$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 boot_CAPI_handler(CV *cv, void (*subaddr)(CV *c), void *pP) -{ -#ifndef NO_XSLOCKS - XSLock localLock((CPerlObj*)pP); -#endif - subaddr(cv); -} - -void xs_handler(CPerlObj* p, CV* cv) -{ - 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); - } -} - -#undef Perl_newXS -CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename) -{ - CV* cv = pPerl->Perl_newXS(name, xs_handler, filename); - pPerl->Perl_sv_magic((SV*)cv, pPerl->Perl_sv_2mortal(pPerl->Perl_newSViv((IV)subaddr)), '~', "CAPI", 4); - return cv; -} - -#undef Perl_deb -void Perl_deb(const char pat, ...) -{ -} - -#undef PL_Mem -#undef PL_Env -#undef PL_StdIO -#undef PL_LIO -#undef PL_Dir -#undef PL_Sock -#undef PL_Proc - -int * _win32_errno(void) -{ - return &pPerl->ErrorNo(); -} - -FILE* _win32_stdin(void) -{ - return (FILE*)pPerl->PL_StdIO->Stdin(); -} - -FILE* _win32_stdout(void) -{ - return (FILE*)pPerl->PL_StdIO->Stdout(); -} - -FILE* _win32_stderr(void) -{ - return (FILE*)pPerl->PL_StdIO->Stderr(); -} - -int _win32_ferror(FILE *fp) -{ - return pPerl->PL_StdIO->Error((PerlIO*)fp, ErrorNo()); -} - -int _win32_feof(FILE *fp) -{ - return pPerl->PL_StdIO->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->PL_StdIO->Vprintf((PerlIO*)pf, ErrorNo(), format, arg); -} - -int _win32_vprintf(const char *format, va_list arg) -{ - return pPerl->PL_StdIO->Vprintf(pPerl->PL_StdIO->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->PL_StdIO->Read((PerlIO*)pf, buf, (size*count), ErrorNo()); -} - -size_t _win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf) -{ - return pPerl->PL_StdIO->Write((PerlIO*)pf, buf, (size*count), ErrorNo()); -} - -FILE* _win32_fopen(const char *path, const char *mode) -{ - return (FILE*)pPerl->PL_StdIO->Open(path, mode, ErrorNo()); -} - -FILE* _win32_fdopen(int fh, const char *mode) -{ - return (FILE*)pPerl->PL_StdIO->Fdopen(fh, mode, ErrorNo()); -} - -FILE* _win32_freopen(const char *path, const char *mode, FILE *pf) -{ - return (FILE*)pPerl->PL_StdIO->Reopen(path, mode, (PerlIO*)pf, ErrorNo()); -} - -int _win32_fclose(FILE *pf) -{ - return pPerl->PL_StdIO->Close((PerlIO*)pf, ErrorNo()); -} - -int _win32_fputs(const char *s,FILE *pf) -{ - return pPerl->PL_StdIO->Puts((PerlIO*)pf, s, ErrorNo()); -} - -int _win32_fputc(int c,FILE *pf) -{ - return pPerl->PL_StdIO->Putc((PerlIO*)pf, c, ErrorNo()); -} - -int _win32_ungetc(int c,FILE *pf) -{ - return pPerl->PL_StdIO->Ungetc((PerlIO*)pf, c, ErrorNo()); -} - -int _win32_getc(FILE *pf) -{ - return pPerl->PL_StdIO->Getc((PerlIO*)pf, ErrorNo()); -} - -int _win32_fileno(FILE *pf) -{ - return pPerl->PL_StdIO->Fileno((PerlIO*)pf, ErrorNo()); -} - -void _win32_clearerr(FILE *pf) -{ - pPerl->PL_StdIO->Clearerr((PerlIO*)pf, ErrorNo()); -} - -int _win32_fflush(FILE *pf) -{ - return pPerl->PL_StdIO->Flush((PerlIO*)pf, ErrorNo()); -} - -long _win32_ftell(FILE *pf) -{ - return pPerl->PL_StdIO->Tell((PerlIO*)pf, ErrorNo()); -} - -int _win32_fseek(FILE *pf,long offset,int origin) -{ - return pPerl->PL_StdIO->Seek((PerlIO*)pf, offset, origin, ErrorNo()); -} - -int _win32_fgetpos(FILE *pf,fpos_t *p) -{ - return pPerl->PL_StdIO->Getpos((PerlIO*)pf, p, ErrorNo()); -} - -int _win32_fsetpos(FILE *pf,const fpos_t *p) -{ - return pPerl->PL_StdIO->Setpos((PerlIO*)pf, p, ErrorNo()); -} - -void _win32_rewind(FILE *pf) -{ - pPerl->PL_StdIO->Rewind((PerlIO*)pf, ErrorNo()); -} - -FILE* _win32_tmpfile(void) -{ - return (FILE*)pPerl->PL_StdIO->Tmpfile(ErrorNo()); -} - -void _win32_setbuf(FILE *pf, char *buf) -{ - pPerl->PL_StdIO->SetBuf((PerlIO*)pf, buf, ErrorNo()); -} - -int _win32_setvbuf(FILE *pf, char *buf, int type, size_t size) -{ - return pPerl->PL_StdIO->SetVBuf((PerlIO*)pf, buf, type, size, ErrorNo()); -} - -char* _win32_fgets(char *s, int n, FILE *pf) -{ - return pPerl->PL_StdIO->Gets((PerlIO*)pf, s, n, ErrorNo()); -} - -char* _win32_gets(char *s) -{ - return _win32_fgets(s, 80, (FILE*)pPerl->PL_StdIO->Stdin()); -} - -int _win32_fgetc(FILE *pf) -{ - return pPerl->PL_StdIO->Getc((PerlIO*)pf, ErrorNo()); -} - -int _win32_putc(int c, FILE *pf) -{ - return pPerl->PL_StdIO->Putc((PerlIO*)pf, c, ErrorNo()); -} - -int _win32_puts(const char *s) -{ - return pPerl->PL_StdIO->Puts(pPerl->PL_StdIO->Stdout(), s, ErrorNo()); -} - -int _win32_getchar(void) -{ - return pPerl->PL_StdIO->Getc(pPerl->PL_StdIO->Stdin(), ErrorNo()); -} - -int _win32_putchar(int c) -{ - return pPerl->PL_StdIO->Putc(pPerl->PL_StdIO->Stdout(), c, ErrorNo()); -} - -void* _win32_malloc(size_t size) -{ - return pPerl->PL_Mem->Malloc(size); -} - -void* _win32_calloc(size_t numitems, size_t size) -{ - return pPerl->PL_Mem->Malloc(numitems*size); -} - -void* _win32_realloc(void *block, size_t size) -{ - return pPerl->PL_Mem->Realloc(block, size); -} - -void _win32_free(void *block) -{ - pPerl->PL_Mem->Free(block); -} - -void _win32_abort(void) -{ - pPerl->PL_Proc->Abort(); -} - -int _win32_pipe(int *phandles, unsigned int psize, int textmode) -{ - return pPerl->PL_Proc->Pipe(phandles); -} - -FILE* _win32_popen(const char *command, const char *mode) -{ - return (FILE*)pPerl->PL_Proc->Popen(command, mode); -} - -int _win32_pclose(FILE *pf) -{ - return pPerl->PL_Proc->Pclose((PerlIO*)pf); -} - -unsigned _win32_sleep(unsigned int t) -{ - return pPerl->PL_Proc->Sleep(t); -} - -int _win32_spawnvp(int mode, const char *cmdname, const char *const *argv) -{ - return pPerl->PL_Proc->Spawnvp(mode, cmdname, argv); -} - -int _win32_mkdir(const char *dir, int mode) -{ - return pPerl->PL_Dir->Makedir(dir, mode, ErrorNo()); -} - -int _win32_rmdir(const char *dir) -{ - return pPerl->PL_Dir->Rmdir(dir, ErrorNo()); -} - -int _win32_chdir(const char *dir) -{ - return pPerl->PL_Dir->Chdir(dir, ErrorNo()); -} - -#undef stat -int _win32_fstat(int fd,struct stat *sbufptr) -{ - return pPerl->PL_LIO->FileStat(fd, sbufptr, ErrorNo()); -} - -int _win32_stat(const char *name,struct stat *sbufptr) -{ - return pPerl->PL_LIO->NameStat(name, sbufptr, ErrorNo()); -} - -int _win32_rename(const char *oname, const char *newname) -{ - return pPerl->PL_LIO->Rename(oname, newname, ErrorNo()); -} - -int _win32_setmode(int fd, int mode) -{ - return pPerl->PL_LIO->Setmode(fd, mode, ErrorNo()); -} - -long _win32_lseek(int fd, long offset, int origin) -{ - return pPerl->PL_LIO->Lseek(fd, offset, origin, ErrorNo()); -} - -long _win32_tell(int fd) -{ - return pPerl->PL_StdIO->Tell((PerlIO*)fd, ErrorNo()); -} - -int _win32_dup(int fd) -{ - return pPerl->PL_LIO->Dup(fd, ErrorNo()); -} - -int _win32_dup2(int h1, int h2) -{ - return pPerl->PL_LIO->Dup2(h1, h2, ErrorNo()); -} - -int _win32_open(const char *path, int oflag,...) -{ - return pPerl->PL_LIO->Open(path, oflag, ErrorNo()); -} - -int _win32_close(int fd) -{ - return pPerl->PL_LIO->Close(fd, ErrorNo()); -} - -int _win32_read(int fd, void *buf, unsigned int cnt) -{ - return pPerl->PL_LIO->Read(fd, buf, cnt, ErrorNo()); -} - -int _win32_write(int fd, const void *buf, unsigned int cnt) -{ - return pPerl->PL_LIO->Write(fd, buf, cnt, ErrorNo()); -} - -int _win32_times(struct tms *timebuf) -{ - return pPerl->PL_Proc->Times(timebuf); -} - -int _win32_ioctl(int i, unsigned int u, char *data) -{ - return pPerl->PL_LIO->IOCtl(i, u, data, ErrorNo()); -} - -int _win32_utime(const char *f, struct utimbuf *t) -{ - return pPerl->PL_LIO->Utime((char*)f, t, ErrorNo()); -} - -int _win32_uname(struct utsname *name) -{ - return pPerl->PL_Env->Uname(name, ErrorNo()); -} - -unsigned long _win32_os_id(void) -{ - return pPerl->PL_Env->OsID(); -} - -char* _win32_getenv(const char *name) -{ - return pPerl->PL_Env->Getenv(name, ErrorNo()); -} - -int _win32_putenv(const char *name) -{ - return pPerl->PL_Env->Putenv(name, ErrorNo()); -} - -int _win32_open_osfhandle(long handle, int flags) -{ - return pPerl->PL_StdIO->OpenOSfhandle(handle, flags); -} - -long _win32_get_osfhandle(int fd) -{ - return pPerl->PL_StdIO->GetOSfhandle(fd); -} - -u_long _win32_htonl (u_long hostlong) -{ - return pPerl->PL_Sock->Htonl(hostlong); -} - -u_short _win32_htons (u_short hostshort) -{ - return pPerl->PL_Sock->Htons(hostshort); -} - -u_long _win32_ntohl (u_long netlong) -{ - return pPerl->PL_Sock->Ntohl(netlong); -} - -u_short _win32_ntohs (u_short netshort) -{ - return pPerl->PL_Sock->Ntohs(netshort); -} - -unsigned long _win32_inet_addr (const char * cp) -{ - return pPerl->PL_Sock->InetAddr(cp, ErrorNo()); -} - -char * _win32_inet_ntoa (struct in_addr in) -{ - return pPerl->PL_Sock->InetNtoa(in, ErrorNo()); -} - -SOCKET _win32_socket (int af, int type, int protocol) -{ - return pPerl->PL_Sock->Socket(af, type, protocol, ErrorNo()); -} - -int _win32_bind (SOCKET s, const struct sockaddr *addr, int namelen) -{ - return pPerl->PL_Sock->Bind(s, addr, namelen, ErrorNo()); -} - -int _win32_listen (SOCKET s, int backlog) -{ - return pPerl->PL_Sock->Listen(s, backlog, ErrorNo()); -} - -SOCKET _win32_accept (SOCKET s, struct sockaddr *addr, int *addrlen) -{ - return pPerl->PL_Sock->Accept(s, addr, addrlen, ErrorNo()); -} - -int _win32_connect (SOCKET s, const struct sockaddr *name, int namelen) -{ - return pPerl->PL_Sock->Connect(s, name, namelen, ErrorNo()); -} - -int _win32_send (SOCKET s, const char * buf, int len, int flags) -{ - return pPerl->PL_Sock->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->PL_Sock->Sendto(s, buf, len, flags, to, tolen, ErrorNo()); -} - -int _win32_recv (SOCKET s, char * buf, int len, int flags) -{ - return pPerl->PL_Sock->Recv(s, buf, len, flags, ErrorNo()); -} - -int _win32_recvfrom (SOCKET s, char * buf, int len, int flags, - struct sockaddr *from, int * fromlen) -{ - return pPerl->PL_Sock->Recvfrom(s, buf, len, flags, from, fromlen, ErrorNo()); -} - -int _win32_shutdown (SOCKET s, int how) -{ - return pPerl->PL_Sock->Shutdown(s, how, ErrorNo()); -} - -int _win32_closesocket (SOCKET s) -{ - return pPerl->PL_Sock->Closesocket(s, ErrorNo()); -} - -int _win32_ioctlsocket (SOCKET s, long cmd, u_long *argp) -{ - return pPerl->PL_Sock->Ioctlsocket(s, cmd, argp, ErrorNo()); -} - -int _win32_setsockopt (SOCKET s, int level, int optname, - const char * optval, int optlen) -{ - return pPerl->PL_Sock->Setsockopt(s, level, optname, optval, optlen, ErrorNo()); -} - -int _win32_getsockopt (SOCKET s, int level, int optname, char * optval, int *optlen) -{ - return pPerl->PL_Sock->Getsockopt(s, level, optname, optval, optlen, ErrorNo()); -} - -int _win32_getpeername (SOCKET s, struct sockaddr *name, int * namelen) -{ - return pPerl->PL_Sock->Getpeername(s, name, namelen, ErrorNo()); -} - -int _win32_getsockname (SOCKET s, struct sockaddr *name, int * namelen) -{ - return pPerl->PL_Sock->Getsockname(s, name, namelen, ErrorNo()); -} - -int _win32_gethostname (char * name, int namelen) -{ - return pPerl->PL_Sock->Gethostname(name, namelen, ErrorNo()); -} - -struct hostent * _win32_gethostbyname(const char * name) -{ - return pPerl->PL_Sock->Gethostbyname(name, ErrorNo()); -} - -struct hostent * _win32_gethostbyaddr(const char * addr, int len, int type) -{ - return pPerl->PL_Sock->Gethostbyaddr(addr, len, type, ErrorNo()); -} - -struct protoent * _win32_getprotobyname(const char * name) -{ - return pPerl->PL_Sock->Getprotobyname(name, ErrorNo()); -} - -struct protoent * _win32_getprotobynumber(int proto) -{ - return pPerl->PL_Sock->Getprotobynumber(proto, ErrorNo()); -} - -struct servent * _win32_getservbyname(const char * name, const char * proto) -{ - return pPerl->PL_Sock->Getservbyname(name, proto, ErrorNo()); -} - -struct servent * _win32_getservbyport(int port, const char * proto) -{ - return pPerl->PL_Sock->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->PL_Sock->Select(nfds, (char*)rfds, (char*)wfds, (char*)xfds, timeout, ErrorNo()); -} - -void _win32_endnetent(void) -{ - pPerl->PL_Sock->Endnetent(ErrorNo()); -} - -void _win32_endhostent(void) -{ - pPerl->PL_Sock->Endhostent(ErrorNo()); -} - -void _win32_endprotoent(void) -{ - pPerl->PL_Sock->Endprotoent(ErrorNo()); -} - -void _win32_endservent(void) -{ - pPerl->PL_Sock->Endservent(ErrorNo()); -} - -struct netent * _win32_getnetent(void) -{ - return pPerl->PL_Sock->Getnetent(ErrorNo()); -} - -struct netent * _win32_getnetbyname(char *name) -{ - return pPerl->PL_Sock->Getnetbyname(name, ErrorNo()); -} - -struct netent * _win32_getnetbyaddr(long net, int type) -{ - return pPerl->PL_Sock->Getnetbyaddr(net, type, ErrorNo()); -} - -struct protoent *_win32_getprotoent(void) -{ - return pPerl->PL_Sock->Getprotoent(ErrorNo()); -} - -struct servent *_win32_getservent(void) -{ - return pPerl->PL_Sock->Getservent(ErrorNo()); -} - -void _win32_sethostent(int stayopen) -{ - pPerl->PL_Sock->Sethostent(stayopen, ErrorNo()); -} - -void _win32_setnetent(int stayopen) -{ - pPerl->PL_Sock->Setnetent(stayopen, ErrorNo()); -} - -void _win32_setprotoent(int stayopen) -{ - pPerl->PL_Sock->Setprotoent(stayopen, ErrorNo()); -} - -void _win32_setservent(int stayopen) -{ - pPerl->PL_Sock->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_rename -#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_uname -#undef win32_os_id -#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_rename _win32_rename -#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_uname _win32_uname -#define win32_os_id _win32_os_id -#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_rename( const char *oldname, const char *newname); -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); -int _win32_uname(struct utsname *n); -unsigned long _win32_os_id(void); -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 608d37e0bd..3139be66a4 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -43,16 +43,28 @@ INST_VER = \5.00557 INST_ARCH = \$(ARCHNAME) # +# XXX WARNING! This option currently undergoing changes. May be broken. +# # uncomment to enable threads-capabilities # #USE_THREADS = define # +# XXX WARNING! This option currently undergoing changes. May be broken. +# # uncomment to enable multiple interpreters # #USE_MULTI = define # +# XXX WARNING! This option currently undergoing changes. May be broken. +# +# uncomment next line if you want to use the perl object +# Currently, this cannot be enabled if you ask for threads above +# +#USE_OBJECT = define + +# # uncomment one of the following lines if you are using either # Visual C++ 2.x or Visual C++ 6.x (aka Visual Studio 98) # @@ -60,14 +72,6 @@ INST_ARCH = \$(ARCHNAME) #CCTYPE = MSVC60 # -# XXX Do not enable. This is currently undergoing a rewrite and will -# NOT work. -# 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 @@ -75,7 +79,7 @@ INST_ARCH = \$(ARCHNAME) # # uncomment to enable use of PerlCRT.DLL when using the Visual C compiler. # Highly recommended. It has patches that fix known bugs in MSVCRT.DLL. -# This currently requires VC 5.0 with Service Pack 3. +# This currently requires VC 5.0 with Service Pack 3 or later. # Get it from CPAN at http://www.perl.com/CPAN/authors/id/D/DO/DOUGL/ # and follow the directions in the package to install. # @@ -109,7 +113,7 @@ INST_ARCH = \$(ARCHNAME) # 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. Currently, this cannot be enabled -# if you ask for PERL_OBJECT above. +# if you ask for USE_OBJECT above. # #PERL_MALLOC = define @@ -134,8 +138,10 @@ CCLIBDIR = $(CCHOME)\lib # We don't enable this by default because we want the modules to get fixed # instead of clinging to shortcuts like this one. # -#BUILDOPT = -DPERL_POLLUTE -#BUILDOPT = -DPERL_IMPLICIT_CONTEXT +# Don't enable -DPERL_IMPLICIT_CONTEXT if you don't know what it is. :-) +# +#BUILDOPT = $(BUILDOPT) -DPERL_POLLUTE +#BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT # # specify semicolon-separated list of extra directories that modules will @@ -162,7 +168,7 @@ D_CRYPT = define CRYPT_FLAG = -DHAVE_DES_FCRYPT !ENDIF -!IF "$(OBJECT)" != "" +!IF "$(USE_OBJECT)" == "define" PERL_MALLOC = undef USE_THREADS = undef USE_MULTI = undef @@ -184,15 +190,19 @@ USE_MULTI = undef PROCESSOR_ARCHITECTURE = x86 !ENDIF -!IF "$(OBJECT)" != "" +!IF "$(USE_OBJECT)" == "define" ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-object !ELSE !IF "$(USE_THREADS)" == "define" ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread !ELSE +!IF "$(USE_MULTI)" == "define" +ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi +!ELSE ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) !ENDIF !ENDIF +!ENDIF # Visual Studio 98 specific !IF "$(CCTYPE)" == "MSVC60" @@ -226,7 +236,7 @@ LIB32 = $(LINK32) -lib RUNTIME = -MD INCLUDES = -I$(COREDIR) -I.\include -I. -I.. #PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX -DEFINES = -DWIN32 -D_CONSOLE -DNO_STRICT $(BUILDOPT) $(CRYPT_FLAG) +DEFINES = -DWIN32 -D_CONSOLE -DNO_STRICT $(CRYPT_FLAG) LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console CXX_FLAG = -TP -GX @@ -260,15 +270,18 @@ OPTIMIZE = -Od $(RUNTIME)d -Zi -D_DEBUG -DDEBUGGING LINK_DBG = -debug -pdb:none !ELSE ! IF "$(CFG)" == "Optimize" -OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG +# -O1 yields smaller code, which turns out to be faster than -O2 +#OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG +OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG ! ELSE OPTIMIZE = -Od $(RUNTIME) -DNDEBUG ! ENDIF LINK_DBG = -release !ENDIF -!IF "$(OBJECT)" != "" +!IF "$(USE_OBJECT)" == "define" OPTIMIZE = $(OPTIMIZE) $(CXX_FLAG) +BUILDOPT = $(BUILDOPT) -DPERL_OBJECT !ENDIF LIBBASEFILES = $(DELAYLOAD) $(CRYPT_LIB) \ @@ -286,7 +299,7 @@ LINK_FLAGS = -nologo -nodefaultlib $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE OBJOUT_FLAG = -Fo EXEOUT_FLAG = -Fe -CFLAGS_O = $(CFLAGS) $(OBJECT) +CFLAGS_O = $(CFLAGS) $(BUILDOPT) #################### do not edit below this line ####################### ############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## @@ -322,14 +335,12 @@ EXTUTILSDIR = $(LIBDIR)\extutils # # various targets -!IF "$(OBJECT)" == "-DPERL_OBJECT" +!IF "$(USE_OBJECT)" == "define" PERLIMPLIB = ..\perlcore.lib PERLDLL = ..\perlcore.dll -#CAPILIB = $(COREDIR)\perlapi.lib !ELSE PERLIMPLIB = ..\perl.lib PERLDLL = ..\perl.dll -CAPILIB = !ENDIF MINIPERL = ..\miniperl.exe @@ -423,7 +434,7 @@ EXTRACORE_SRC = $(EXTRACORE_SRC) perllib.c EXTRACORE_SRC = $(EXTRACORE_SRC) ..\malloc.c !ENDIF -!IF "$(OBJECT)" == "" +!IF "$(USE_OBJECT)" != "define" EXTRACORE_SRC = $(EXTRACORE_SRC) ..\perlio.c !ENDIF @@ -450,11 +461,6 @@ PERL95_SRC = $(PERL95_SRC) .\$(CRYPT_SRC) DLL_SRC = $(DYNALOADER).c - -#!IF "$(OBJECT)" == "" -#DLL_SRC = $(DLL_SRC) perllib.c -#!ENDIF - X2P_SRC = \ ..\x2p\a2p.c \ ..\x2p\hash.c \ @@ -590,18 +596,13 @@ EXTENSION_DLL = \ $(DUMPER_DLL) \ $(PEEK_DLL) \ $(B_DLL) \ + $(RE_DLL) \ + $(THREAD_DLL) \ $(BYTELOADER_DLL) EXTENSION_PM = \ $(ERRNO_PM) -!IF "$(OBJECT)" == "" -EXTENSION_DLL = \ - $(EXTENSION_DLL)\ - $(THREAD_DLL) \ - $(RE_DLL) -!ENDIF - POD2HTML = $(PODDIR)\pod2html POD2MAN = $(PODDIR)\pod2man POD2LATEX = $(PODDIR)\pod2latex @@ -614,7 +615,7 @@ CFG_VARS = \ "INST_ARCH=$(INST_ARCH)" \ "archname=$(ARCHNAME)" \ "cc=$(CC)" \ - "ccflags=$(OPTIMIZE:"=\") $(DEFINES) $(OBJECT)" \ + "ccflags=$(OPTIMIZE:"=\") $(DEFINES) $(BUILDOPT)" \ "cf_email=$(EMAIL)" \ "d_crypt=$(D_CRYPT)" \ "d_mymalloc=$(PERL_MALLOC)" \ @@ -637,7 +638,7 @@ CFG_VARS = \ # all : .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) \ - $(CAPILIB) $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM) + $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM) $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c @@ -708,7 +709,7 @@ $(PERL95_OBJ) : $(CORE_H) $(X2P_OBJ) : $(CORE_H) perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym makedef.pl - $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) $(OBJECT) \ + $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \ CCTYPE=$(CCTYPE) > perldll.def $(PERLDLL): perldll.def $(PERLDLL_OBJ) @@ -717,9 +718,6 @@ $(PERLDLL): perldll.def $(PERLDLL_OBJ) << $(XCOPY) $(PERLIMPLIB) $(COREDIR) -perl.def : $(MINIPERL) makeperldef.pl - $(MINIPERL) -I..\lib makeperldef.pl $(NULL) > perl.def - $(MINIMOD) : $(MINIPERL) ..\minimod.pl cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm @@ -794,15 +792,6 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) $(XSUBPP) dl_win32.xs > $(*B).c cd ..\..\win32 -#!IF "$(OBJECT)" == "-DPERL_OBJECT" -#perlapi$(o) : ..\perlapi.c -# $(CC) $(CFLAGS_O) $(RUNTIME) -UPERLDLL -c \ -# $(OBJOUT_FLAG)perlapi$(o) ..\perlapi.c -# -#$(CAPILIB) : ..\perlapi.c ..\perlapi$(o) -# lib /OUT:$(CAPILIB) ..\perlapi$(o) -#!ENDIF - $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs @@ -996,12 +985,11 @@ clean : -@erase $(PERLEXE) -@erase $(PERLDLL) -@erase $(CORE_OBJ) - -@erase $(CAPILIB) -rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR) -@erase $(WIN32_OBJ) -@erase $(DLL_OBJ) -@erase $(X2P_OBJ) - -@erase ..\*$(o) ..\*.lib ..\*.exp *$(o) *.lib *.exp + -@erase ..\*$(o) ..\*.lib ..\*.exp *$(o) *.lib *.exp *.res -@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat -@erase ..\x2p\*.exe ..\x2p\*.bat -@erase *.ilk diff --git a/win32/TEST b/win32/TEST deleted file mode 100644 index 1bda4ef793..0000000000 --- a/win32/TEST +++ /dev/null @@ -1,149 +0,0 @@ -#!./perl - -# Last change: Fri Jan 10 09:57:03 WET 1997 - -# This is written in a peculiar style, since we're trying to avoid -# most of the constructs we'll be testing for. - -$| = 1; - -if ($ARGV[0] eq '-v') { - $verbose = 1; - shift; -} - -chdir 't' if -f 't/TEST'; - -die "You need to run \"make test\" first to set things up.\n" - unless -e 'perl' or -e 'perl.exe'; - -$ENV{EMXSHELL} = 'sh'; # For OS/2 - -if ($ARGV[0] eq '') { - push( @ARGV, `dir/s/b base` ); - push( @ARGV, `dir/s/b comp` ); - push( @ARGV, `dir/s/b cmd` ); - push( @ARGV, `dir/s/b io` ); - push( @ARGV, `dir/s/b op` ); - push( @ARGV, `dir/s/b pragma` ); - push( @ARGV, `dir/s/b lib` ); - - grep( chomp, @ARGV ); - @ARGV = grep( /\.t$/, @ARGV ); - grep( s/.*t\\//, @ARGV ); -# @ARGV = split(/[ \n]/, -# `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`); -} else { - -@ARGV = map(glob($_),@ARGV); - -} - -if ($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'qnx' || 1) { - $sharpbang = 0; -} -else { - open(CONFIG, "../config.sh"); - while (<CONFIG>) { - if (/sharpbang='(.*)'/) { - $sharpbang = ($1 eq '#!'); - last; - } - } - close(CONFIG); -} - -$bad = 0; -$good = 0; -$total = @ARGV; -while ($test = shift) { - if ($test =~ /^$/) { - next; - } - $te = $test; - chop($te); - print "$te" . '.' x (18 - length($te)); - if ($sharpbang) { - open(results,"./$test |") || (print "can't run.\n"); - } else { - open(script,"$test") || die "Can't run $test.\n"; - $_ = <script>; - close(script); - if (/#!..perl(.*)/) { - $switch = $1; - if ($^O eq 'VMS') { - # Must protect uppercase switches with "" on command line - $switch =~ s/-([A-Z]\S*)/"-$1"/g; - } - } else { - $switch = ''; - } - open(results,"perl$switch $test |") || (print "can't run.\n"); - } - $ok = 0; - $next = 0; - while (<results>) { - if (/^$/) { next;}; - if ($verbose) { - print $_; - } - unless (/^#/) { - if (/^1\.\.([0-9]+)/) { - $max = $1; - $totmax += $max; - $files += 1; - $next = 1; - $ok = 1; - } else { - $next = $1, $ok = 0, last if /^not ok ([0-9]*)/; - if (/^ok (.*)/ && $1 == $next) { - $next = $next + 1; - } else { - $ok = 0; - } - } - } - } - $next = $next - 1; - if ($ok && $next == $max) { - if ($max) { - print "ok\n"; - $good = $good + 1; - } else { - print "skipping test on this platform\n"; - $files -= 1; - } - } else { - $next += 1; - print "FAILED on test $next\n"; - $bad = $bad + 1; - $_ = $test; - if (/^base/) { - die "Failed a basic test--cannot continue.\n"; - } - } -} - -if ($bad == 0) { - if ($ok) { - print "All tests successful.\n"; - } else { - die "FAILED--no tests were run for some reason.\n"; - } -} else { - $pct = sprintf("%.2f", $good / $total * 100); - if ($bad == 1) { - warn "Failed 1 test script out of $total, $pct% okay.\n"; - } else { - warn "Failed $bad test scripts out of $total, $pct% okay.\n"; - } - warn <<'SHRDLU'; - ### Since not all tests were successful, you may want to run some - ### of them individually and examine any diagnostic messages they - ### produce. See the INSTALL document's section on "make test". -SHRDLU -} -($user,$sys,$cuser,$csys) = times; -print sprintf("u=%g s=%g cu=%g cs=%g scripts=%d tests=%d\n", - $user,$sys,$cuser,$csys,$files,$totmax); -exit $bad != 0; diff --git a/win32/autosplit.pl b/win32/autosplit.pl deleted file mode 100644 index 26ce2c358c..0000000000 --- a/win32/autosplit.pl +++ /dev/null @@ -1,3 +0,0 @@ -use AutoSplit; - -autosplit($ARGV[0], $ARGV[1], 0, 1, 1); diff --git a/win32/config_H.bc b/win32/config_H.bc index 5b795f5d03..955a1de977 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -2357,7 +2357,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define PRIVLIB "c:\\perl\\5.00557\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib(aTHX_ "5.00557")) /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.00557")) /**/ /* SELECT_MIN_BITS: * This symbol holds the minimum number of bits operated by select. @@ -2398,7 +2398,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define SITELIB "c:\\perl\\site\\5.00557\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib(aTHX_ "5.00557")) /**/ +#define SITELIB_EXP (win32_get_sitelib("5.00557")) /**/ /* STARTPERL: * This variable contains the string to put in front of a perl diff --git a/win32/config_H.gc b/win32/config_H.gc index 783f4e2c0d..dfa1c7c56e 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -2357,7 +2357,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define PRIVLIB "c:\\perl\\5.00557\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib(aTHX_ "5.00557")) /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.00557")) /**/ /* SELECT_MIN_BITS: * This symbol holds the minimum number of bits operated by select. @@ -2398,7 +2398,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define SITELIB "c:\\perl\\site\\5.00557\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib(aTHX_ "5.00557")) /**/ +#define SITELIB_EXP (win32_get_sitelib("5.00557")) /**/ /* STARTPERL: * This variable contains the string to put in front of a perl diff --git a/win32/config_H.vc b/win32/config_H.vc index 4f858d71ac..cbe62652a7 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -2357,7 +2357,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define PRIVLIB "c:\\perl\\5.00557\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib(aTHX_ "5.00557")) /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.00557")) /**/ /* SELECT_MIN_BITS: * This symbol holds the minimum number of bits operated by select. @@ -2398,7 +2398,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define SITELIB "c:\\perl\\site\\5.00557\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib(aTHX_ "5.00557")) /**/ +#define SITELIB_EXP (win32_get_sitelib("5.00557")) /**/ /* STARTPERL: * This variable contains the string to put in front of a perl diff --git a/win32/config_h.PL b/win32/config_h.PL index 850b134ba3..16e467e915 100644 --- a/win32/config_h.PL +++ b/win32/config_h.PL @@ -51,7 +51,7 @@ while (<SH>) s#/[ *\*]*\*/#/**/#; if (/^\s*#define\s+(PRIVLIB|SITELIB)_EXP/) { - $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "(aTHX_ $patchlevel))\t/**/\n"; + $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "($patchlevel))\t/**/\n"; } # incpush() handles archlibs, so disable them elsif (/^\s*#define\s+(ARCHLIB|SITEARCH)_EXP/) diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index 3e7fdd4714..34dbb4ee17 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -24,6 +24,8 @@ calls. #include <windows.h> #include <string.h> +#define PERL_NO_GET_CONTEXT + #include "EXTERN.h" #include "perl.h" #include "win32.h" diff --git a/win32/genxsdef.pl b/win32/genxsdef.pl deleted file mode 100644 index b00a57e778..0000000000 --- a/win32/genxsdef.pl +++ /dev/null @@ -1,5 +0,0 @@ -print "LIBRARY $ARGV[0]\n"; -print "CODE LOADONCALL\n"; -print "DATA LOADONCALL NONSHARED MULTIPLE\n"; -print "EXPORTS\n"; -print "\tboot_$ARGV[0]\n" diff --git a/win32/include/dirent.h b/win32/include/dirent.h index be363ce804..d2ef6d54b7 100644 --- a/win32/include/dirent.h +++ b/win32/include/dirent.h @@ -38,12 +38,13 @@ typedef struct _dir_struc struct direct dirstr; // Directory structure to return } DIR; +#if 0 /* these have moved to win32iop.h */ DIR * win32_opendir(char *filename); struct direct * win32_readdir(DIR *dirp); long win32_telldir(DIR *dirp); void win32_seekdir(DIR *dirp,long loc); void win32_rewinddir(DIR *dirp); int win32_closedir(DIR *dirp); - +#endif #endif //_INC_DIRENT diff --git a/win32/include/sys/socket.h b/win32/include/sys/socket.h index 87506fbe87..194de9581f 100644 --- a/win32/include/sys/socket.h +++ b/win32/include/sys/socket.h @@ -142,7 +142,6 @@ void win32_endprotoent(void); void win32_endservent(void); #ifndef WIN32SCK_IS_STDSCK -#ifndef PERL_OBJECT // // direct to our version // @@ -204,7 +203,6 @@ 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 dc0869a5c7..96b540b6d4 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -37,7 +37,6 @@ if ($define{PERL_OBJECT}) { # output_symbol("perl_parse"); # output_symbol("perl_run"); # output_symbol("RunPerl"); - output_symbol("GetPerlInterpreter"); # exit(0); } else { @@ -188,13 +187,16 @@ Perl_unlock_condpair Perl_magic_mutexfree )]; } -unless ($define{'USE_THREADS'} or $define{'PERL_IMPLICIT_CONTEXT'}) - { +unless ($define{'USE_THREADS'} or $define{'PERL_IMPLICIT_CONTEXT'} + or $define{'PERL_OBJECT'}) +{ skip_symbols [qw( Perl_croak_nocontext Perl_die_nocontext + Perl_deb_nocontext Perl_form_nocontext Perl_warn_nocontext + Perl_warner_nocontext Perl_newSVpvf_nocontext Perl_sv_catpvf_nocontext Perl_sv_setpvf_nocontext @@ -507,4 +509,6 @@ Perl_init_os_extras Perl_getTHR Perl_setTHR RunPerl +GetPerlInterpreter +SetPerlInterpreter diff --git a/win32/makefile.mk b/win32/makefile.mk index 22b1d0a2be..f69f04dcf4 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -47,16 +47,29 @@ INST_VER *= \5.00557 INST_ARCH *= \$(ARCHNAME) # +# XXX WARNING! This option currently undergoing changes. May be broken. +# # uncomment to enable threads-capabilities # #USE_THREADS *= define # +# XXX WARNING! This option currently undergoing changes. May be broken. +# # uncomment to enable multiple interpreters # #USE_MULTI *= define # +# XXX WARNING! This option currently undergoing changes. May be broken. +# +# uncomment next line if you want to use the perl object +# Currently, this cannot be enabled if you ask for threads above, or +# if you are using GCC or EGCS. +# +#USE_OBJECT *= define + +# # uncomment exactly one of the following # # Visual C++ 2.x @@ -71,15 +84,6 @@ CCTYPE *= BORLAND #CCTYPE *= GCC # -# XXX Do not enable. This is currently undergoing a rewrite and will -# NOT work. -# uncomment next line if you want to use the perl object -# Currently, this cannot be enabled if you ask for threads above, or -# if you are using GCC or EGCS. -# -#OBJECT *= -DPERL_OBJECT - -# # uncomment next line if you want debug version of perl (big,slow) # If not enabled, we automatically try to use maximum optimization # with all compilers that are known to have a working optimizer. @@ -123,7 +127,7 @@ CCTYPE *= BORLAND # 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. Currently, this cannot be enabled -# if you ask for PERL_OBJECT above. +# if you ask for USE_OBJECT above. # #PERL_MALLOC *= define @@ -149,8 +153,10 @@ CCLIBDIR *= $(CCHOME)\lib # We don't enable this by default because we want the modules to get fixed # instead of clinging to shortcuts like this one. # -#BUILDOPT *= -DPERL_POLLUTE -#BUILDOPT *= -DPERL_IMPLICIT_CONTEXT +# Don't enable -DPERL_IMPLICIT_CONTEXT if you don't know what it is. :-) +# +#BUILDOPT += -DPERL_POLLUTE +#BUILDOPT += -DPERL_IMPLICIT_CONTEXT # # specify semicolon-separated list of extra directories that modules will @@ -168,7 +174,7 @@ EXTRALIBDIRS *= # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) # -#EMAIL *= +EMAIL *= support@activestate.com ## ## Build configuration ends. @@ -183,7 +189,7 @@ D_CRYPT = define CRYPT_FLAG = -DHAVE_DES_FCRYPT .ENDIF -.IF "$(OBJECT)" != "" +.IF "$(USE_OBJECT)" == "define" PERL_MALLOC != undef USE_THREADS != undef USE_MULTI != undef @@ -198,10 +204,12 @@ USE_MULTI *= undef PROCESSOR_ARCHITECTURE *= x86 -.IF "$(OBJECT)" != "" +.IF "$(USE_OBJECT)" == "define" ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-object .ELIF "$(USE_THREADS)" == "define" ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread +.ELIF "$(USE_MULTI)" == "define" +ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi .ELSE ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) .ENDIF @@ -240,7 +248,7 @@ IMPLIB = implib -c RUNTIME = -D_RTLDLL INCLUDES = -I$(COREDIR) -I.\include -I. -I.. -I"$(CCINCDIR)" #PCHFLAGS = -H -Hc -H=c:\temp\bcmoduls.pch -DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) +DEFINES = -DWIN32 $(CRYPT_FLAG) LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console CXX_FLAG = -P @@ -256,7 +264,7 @@ OPTIMIZE = -O2 $(RUNTIME) LINK_DBG = .ENDIF -CFLAGS = -w -g0 -tWM -tWD $(INCLUDES) $(DEFINES) $(LOCDEFS) \ +CFLAGS = -w -g0 -tWM -tWD $(INCLUDES) $(LOCDEFS) \ $(PCHFLAGS) $(OPTIMIZE) LINK_FLAGS = $(LINK_DBG) -L"$(CCLIBDIR)" OBJOUT_FLAG = -o @@ -278,7 +286,7 @@ a = .a # RUNTIME = INCLUDES = -I$(COREDIR) -I.\include -I. -I.. -DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG) +DEFINES = -DWIN32 $(CRYPT_FLAG) LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console CXX_FLAG = -xc++ @@ -314,7 +322,7 @@ LIB32 = $(LINK32) -lib RUNTIME = -MD INCLUDES = -I$(COREDIR) -I.\include -I. -I.. #PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX -DEFINES = -DWIN32 -D_CONSOLE -DNO_STRICT $(BUILDOPT) $(CRYPT_FLAG) +DEFINES = -DWIN32 -D_CONSOLE -DNO_STRICT $(CRYPT_FLAG) LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console CXX_FLAG = -TP -GX @@ -348,7 +356,9 @@ OPTIMIZE = -Od $(RUNTIME)d -Zi -D_DEBUG -DDEBUGGING LINK_DBG = -debug -pdb:none .ELSE .IF "$(CFG)" == "Optimize" -OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG +# -O1 yields smaller code, which turns out to be faster than -O2 +#OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG +OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG .ELSE OPTIMIZE = -Od $(RUNTIME) -DNDEBUG .ENDIF @@ -373,11 +383,12 @@ LIBOUT_FLAG = /out: .ENDIF -.IF "$(OBJECT)" != "" +.IF "$(USE_OBJECT)" == "define" OPTIMIZE += $(CXX_FLAG) +BUILDOPT += -DPERL_OBJECT .ENDIF -CFLAGS_O = $(CFLAGS) $(OBJECT) +CFLAGS_O = $(CFLAGS) $(BUILDOPT) #################### do not edit below this line ####################### ############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## @@ -470,7 +481,7 @@ CFGH_TMPL = config_H.bc CFGSH_TMPL = config.gc CFGH_TMPL = config_H.gc -.IF "$(OBJECT)" == "-DPERL_OBJECT" +.IF "$(USE_OBJECT)" == "define" PERLIMPLIB = ..\libperlcore$(a) .ELSE PERLIMPLIB = ..\libperl$(a) @@ -486,14 +497,12 @@ PERL95EXE = ..\perl95.exe .ENDIF -.IF "$(OBJECT)" == "-DPERL_OBJECT" +.IF "$(USE_OBJECT)" == "define" PERLIMPLIB *= ..\perlcore$(a) PERLDLL = ..\perlcore.dll -CAPILIB = $(COREDIR)\perlCAPI$(a) .ELSE PERLIMPLIB *= ..\perl$(a) PERLDLL = ..\perl.dll -CAPILIB = .ENDIF XCOPY = xcopy /f /r /i /d @@ -518,6 +527,7 @@ MICROCORE_SRC = \ ..\mg.c \ ..\op.c \ ..\perl.c \ + ..\perlapi.c \ ..\perly.c \ ..\pp.c \ ..\pp_ctl.c \ @@ -534,11 +544,13 @@ MICROCORE_SRC = \ ..\utf8.c \ ..\util.c +EXTRACORE_SRC += perllib.c + .IF "$(PERL_MALLOC)" == "define" EXTRACORE_SRC += ..\malloc.c .ENDIF -.IF "$(OBJECT)" == "" +.IF "$(USE_OBJECT)" != "define" EXTRACORE_SRC += ..\perlio.c .ENDIF @@ -565,11 +577,6 @@ PERL95_SRC += .\$(CRYPT_SRC) DLL_SRC = $(DYNALOADER).c - -.IF "$(OBJECT)" == "" -DLL_SRC += perllib.c -.ENDIF - X2P_SRC = \ ..\x2p\a2p.c \ ..\x2p\hash.c \ @@ -593,6 +600,7 @@ CORE_NOCFG_H = \ ..\op.h \ ..\opcode.h \ ..\perl.h \ + ..\perlapi.h \ ..\perlsdio.h \ ..\perlsfio.h \ ..\perly.h \ @@ -631,7 +639,7 @@ X2P_OBJ = $(X2P_SRC:db:+$(o)) PERLDLL_OBJ = $(CORE_OBJ) PERLEXE_OBJ = perlmain$(o) -.IF "$(OBJECT)" == "" +.IF "$(USE_OBJECT)" != "define" PERLDLL_OBJ += $(WIN32_OBJ) $(DLL_OBJ) .ELSE PERLEXE_OBJ += $(WIN32_OBJ) $(DLL_OBJ) @@ -705,18 +713,13 @@ EXTENSION_DLL = \ $(DUMPER_DLL) \ $(PEEK_DLL) \ $(B_DLL) \ + $(RE_DLL) \ + $(THREAD_DLL) \ $(BYTELOADER_DLL) EXTENSION_PM = \ $(ERRNO_PM) -# re.dll doesn't build with PERL_OBJECT yet -.IF "$(OBJECT)" == "" -EXTENSION_DLL += \ - $(THREAD_DLL) \ - $(RE_DLL) -.ENDIF - POD2HTML = $(PODDIR)\pod2html POD2MAN = $(PODDIR)\pod2man POD2LATEX = $(PODDIR)\pod2latex @@ -729,7 +732,7 @@ CFG_VARS = \ "INST_ARCH=$(INST_ARCH)" \ "archname=$(ARCHNAME)" \ "cc=$(CC)" \ - "ccflags=$(OPTIMIZE:s/"/\"/) $(DEFINES) $(OBJECT)" \ + "ccflags=$(OPTIMIZE:s/"/\"/) $(DEFINES) $(BUILDOPT)" \ "cf_email=$(EMAIL)" \ "d_crypt=$(D_CRYPT)" \ "d_mymalloc=$(PERL_MALLOC)" \ @@ -754,7 +757,7 @@ CFG_VARS = \ # all : .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) \ - $(CAPILIB) $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM) + $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM) $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c @@ -838,7 +841,7 @@ $(PERL95_OBJ) : $(CORE_H) $(X2P_OBJ) : $(CORE_H) perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym makedef.pl - $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) $(OBJECT) \ + $(MINIPERL) -w makedef.pl $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \ CCTYPE=$(CCTYPE) > perldll.def $(PERLDLL): perldll.def $(PERLDLL_OBJ) @@ -866,9 +869,6 @@ $(PERLDLL): perldll.def $(PERLDLL_OBJ) .ENDIF $(XCOPY) $(PERLIMPLIB) $(COREDIR) -perl.def : $(MINIPERL) makeperldef.pl - $(MINIPERL) -I..\lib makeperldef.pl $(NULL) > perl.def - $(MINIMOD) : $(MINIPERL) ..\minimod.pl cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm @@ -961,30 +961,6 @@ $(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) $(RUNTIME) -UPERLDLL -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 @@ -1154,7 +1130,6 @@ clean : -@erase $(MINIPERL) -@erase perlglob$(o) -@erase perlmain$(o) - -@erase perlCAPI.cpp -@erase config.w32 -@erase /f config.h -@erase $(GLOBEXE) @@ -1165,7 +1140,7 @@ clean : -@erase $(WIN32_OBJ) -@erase $(DLL_OBJ) -@erase $(X2P_OBJ) - -@erase ..\*$(o) ..\*$(a) ..\*.exp *$(o) *$(a) *.exp + -@erase ..\*$(o) ..\*$(a) ..\*.exp *$(o) *$(a) *.exp *.res -@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat -@erase ..\x2p\*.exe ..\x2p\*.bat -@erase *.ilk diff --git a/win32/makemain.pl b/win32/makemain.pl deleted file mode 100644 index b230f58ff0..0000000000 --- a/win32/makemain.pl +++ /dev/null @@ -1,45 +0,0 @@ -open (MINIMAIN, "<../miniperlmain.c") || die "failed to open miniperlmain.c" . $!; - -while (<MINIMAIN>) { - if (/Do not delete this line--writemain depends on it/) { - last; - } - else { - print $_; - } - }; - -close(MINIMAIN); - -print "char *staticlinkmodules[]={\n"; -foreach (@ARGV) { - print "\t\"".$_."\",\n"; - } -print "\tNULL,\n"; -print "\t};\n"; -print "\n"; -foreach (@ARGV) { - print "EXTERN_C void boot_$_ (CV* cv);\n" - } - -print <<EOP; - -static void -xs_init() -{ - dXSUB_SYS; - char *file = __FILE__; -EOP - -foreach (@ARGV) { - if (/DynaLoader/) { - print "\tnewXS(\"$_\:\:boot_$_\", boot_$_, file);\n"; - } - else { - print "\tnewXS(\"$_\:\:bootstrap\", boot_$_, file);\n"; - }; - } - -print <<EOP; -} -EOP diff --git a/win32/makeperldef.pl b/win32/makeperldef.pl deleted file mode 100644 index 620d2ebab3..0000000000 --- a/win32/makeperldef.pl +++ /dev/null @@ -1,23 +0,0 @@ -my $CCTYPE = ""; -print "EXPORTS\n"; -foreach (@ARGV) { - if (/CCTYPE=(.*)$/) { - $CCTYPE = $1; - next; - } - emit_symbol("boot_$_"); -} - -sub emit_symbol { - my $symbol = shift; - if ($CCTYPE eq "BORLAND") { - # workaround Borland quirk by export both the straight - # name and a name with leading underscore - print "\t$symbol=_$symbol\n"; - print "\t_$symbol\n"; - } - else { - print "\t$symbol\n"; - } -} - diff --git a/win32/perllib.c b/win32/perllib.c index 8682f77ab5..cba7e41881 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -771,7 +771,7 @@ PerlSockGethostbyname(struct IPerlSock*, const char* name) struct hostent* PerlSockGethostent(struct IPerlSock*) { - dPERLOBJ; + dTHXo; croak("gethostent not implemented!\n"); return NULL; } @@ -946,7 +946,7 @@ PerlSockSocket(struct IPerlSock*, int af, int type, int protocol) int PerlSockSocketpair(struct IPerlSock*, int domain, int type, int protocol, int* fds) { - dPERLOBJ; + dTHXo; croak("socketpair not implemented!\n"); return 0; } @@ -1102,7 +1102,7 @@ PerlProcKill(struct IPerlProc*, int pid, int sig) int PerlProcKillpg(struct IPerlProc*, int pid, int sig) { - dPERLOBJ; + dTHXo; croak("killpg not implemented!\n"); return 0; } @@ -1249,24 +1249,6 @@ struct IPerlProc perlProc = //#include "perlhost.h" -static DWORD g_TlsAllocIndex; -BOOL SetPerlInterpreter(CPerlObj* pPerl) -{ - return TlsSetValue(g_TlsAllocIndex, pPerl); -} - -EXTERN_C CPerlObj* GetPerlInterpreter(PerlInterpreter* sv_interp) -{ - if(GetCurrentThreadId() == (DWORD)sv_interp) - return (CPerlObj*)TlsGetValue(g_TlsAllocIndex); - return NULL; -} - -CPerlObj* GetPerlInter(void) -{ - return (CPerlObj*)TlsGetValue(g_TlsAllocIndex); -} - EXTERN_C void perl_get_host_info(IPerlMemInfo* perlMemInfo, IPerlEnvInfo* perlEnvInfo, IPerlStdIOInfo* perlStdIOInfo, @@ -1321,7 +1303,7 @@ EXTERN_C PerlInterpreter* perl_alloc_using(IPerlMem* pMem, if(pPerl) { SetPerlInterpreter(pPerl); - return (PerlInterpreter*)GetCurrentThreadId(); + return (PerlInterpreter*)pPerl; } SetPerlInterpreter(NULL); return NULL; @@ -1349,7 +1331,7 @@ EXTERN_C PerlInterpreter* perl_alloc(void) if(pPerl) { SetPerlInterpreter(pPerl); - return (PerlInterpreter*)GetCurrentThreadId(); + return (PerlInterpreter*)pPerl; } SetPerlInterpreter(NULL); return NULL; @@ -1357,7 +1339,7 @@ EXTERN_C PerlInterpreter* perl_alloc(void) EXTERN_C void perl_construct(PerlInterpreter* sv_interp) { - CPerlObj* pPerl = GetPerlInterpreter(sv_interp); + CPerlObj* pPerl = (CPerlObj*)sv_interp; try { pPerl->perl_construct(); @@ -1373,7 +1355,7 @@ EXTERN_C void perl_construct(PerlInterpreter* sv_interp) EXTERN_C void perl_destruct(PerlInterpreter* sv_interp) { - CPerlObj* pPerl = GetPerlInterpreter(sv_interp); + CPerlObj* pPerl = (CPerlObj*)sv_interp; try { pPerl->perl_destruct(); @@ -1385,7 +1367,7 @@ EXTERN_C void perl_destruct(PerlInterpreter* sv_interp) EXTERN_C void perl_free(PerlInterpreter* sv_interp) { - CPerlObj* pPerl = GetPerlInterpreter(sv_interp); + CPerlObj* pPerl = (CPerlObj*)sv_interp; try { pPerl->perl_free(); @@ -1398,7 +1380,7 @@ EXTERN_C void perl_free(PerlInterpreter* sv_interp) EXTERN_C int perl_run(PerlInterpreter* sv_interp) { - CPerlObj* pPerl = GetPerlInterpreter(sv_interp); + CPerlObj* pPerl = (CPerlObj*)sv_interp; int retVal; try { @@ -1422,7 +1404,7 @@ EXTERN_C int perl_run(PerlInterpreter* sv_interp) EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env) { int retVal; - CPerlObj* pPerl = GetPerlInterpreter(sv_interp); + CPerlObj* pPerl = (CPerlObj*)sv_interp; try { retVal = pPerl->perl_parse(xs_init, argc, argv, env); @@ -1452,7 +1434,21 @@ HANDLE g_w32_perldll_handle; extern HANDLE w32_perldll_handle; #endif /* PERL_OBJECT */ -DllExport int +static DWORD g_TlsAllocIndex; + +EXTERN_C DllExport bool +SetPerlInterpreter(void *interp) +{ + return TlsSetValue(g_TlsAllocIndex, interp); +} + +EXTERN_C DllExport void* +GetPerlInterpreter(void) +{ + return TlsGetValue(g_TlsAllocIndex); +} + +EXTERN_C DllExport int RunPerl(int argc, char **argv, char **env) { int exitstatus; @@ -1520,10 +1516,9 @@ DllMain(HANDLE hModule, /* DLL module handle */ setmode( fileno( stderr ), O_BINARY ); _fmode = O_BINARY; #endif -#ifdef PERL_OBJECT g_TlsAllocIndex = TlsAlloc(); DisableThreadLibraryCalls(hModule); -#else +#ifndef PERL_OBJECT w32_perldll_handle = hModule; #endif break; @@ -1532,9 +1527,7 @@ DllMain(HANDLE hModule, /* DLL module handle */ * process termination or call to FreeLibrary. */ case DLL_PROCESS_DETACH: -#ifdef PERL_OBJECT TlsFree(g_TlsAllocIndex); -#endif break; /* The attached process creates a new thread. */ diff --git a/win32/runperl.c b/win32/runperl.c index ef4453138d..8e6b249b44 100644 --- a/win32/runperl.c +++ b/win32/runperl.c @@ -16,9 +16,6 @@ int _CRT_glob = 0; #endif - -__declspec(dllimport) int RunPerl(int argc, char **argv, char **env); - int main(int argc, char **argv, char **env) { diff --git a/win32/win32.c b/win32/win32.c index cbe50c29f5..a0115732a0 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -40,6 +40,7 @@ #include "perl.h" #define NO_XSLOCKS +#define PERL_NO_GET_CONTEXT #include "XSUB.h" #include "Win32iop.h" @@ -86,11 +87,11 @@ int _CRT_glob = 0; static void get_shell(void); static long tokenize(char *str, char **dest, char ***destv); - int do_spawn2(pTHX_ char *cmd, int exectype); + int do_spawn2(char *cmd, int exectype); static BOOL has_shell_metachars(char *ptr); static long filetime_to_clock(PFILETIME ft); static BOOL filetime_from_time(PFILETIME ft, time_t t); -static char * get_emd_part(SV *leading, char *trailing, ...); +static char * get_emd_part(SV **leading, char *trailing, ...); static void remove_dead_process(long deceased); static long find_pid(int pid); static char * qualified_path(const char *cmd); @@ -134,9 +135,9 @@ IsWinNT(void) return (win32_os_id() == VER_PLATFORM_WIN32_NT); } -/* sv (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */ +/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */ static char* -get_regstr_from(HKEY hkey, const char *valuename, SV *sv) +get_regstr_from(HKEY hkey, const char *valuename, SV **svp) { /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */ HKEY handle; @@ -150,15 +151,15 @@ get_regstr_from(HKEY hkey, const char *valuename, SV *sv) DWORD datalen; retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen); if (retval == ERROR_SUCCESS && type == REG_SZ) { - dPERLOBJ; - if (!sv) - sv = sv_2mortal(newSVpvn("",0)); - SvGROW(sv, datalen); + dTHXo; + if (!*svp) + *svp = sv_2mortal(newSVpvn("",0)); + SvGROW(*svp, datalen); retval = RegQueryValueEx(handle, valuename, 0, NULL, - (PBYTE)SvPVX(sv), &datalen); + (PBYTE)SvPVX(*svp), &datalen); if (retval == ERROR_SUCCESS) { - str = SvPVX(sv); - SvCUR_set(sv,datalen-1); + str = SvPVX(*svp); + SvCUR_set(*svp,datalen-1); } } RegCloseKey(handle); @@ -166,19 +167,19 @@ get_regstr_from(HKEY hkey, const char *valuename, SV *sv) return str; } -/* sv (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */ +/* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */ static char* -get_regstr(const char *valuename, SV *sv) +get_regstr(const char *valuename, SV **svp) { - char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, sv); + char *str = get_regstr_from(HKEY_CURRENT_USER, valuename, svp); if (!str) - str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, sv); + str = get_regstr_from(HKEY_LOCAL_MACHINE, valuename, svp); return str; } -/* prev_path (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */ +/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */ static char * -get_emd_part(SV *prev_path, char *trailing_path, ...) +get_emd_part(SV **prev_pathp, char *trailing_path, ...) { char base[10]; va_list ap; @@ -246,38 +247,38 @@ get_emd_part(SV *prev_path, char *trailing_path, ...) /* only add directory if it exists */ if (GetFileAttributes(mod_name) != (DWORD) -1) { /* directory exists */ - dPERLOBJ; - if (!prev_path) - prev_path = sv_2mortal(newSVpvn("",0)); - sv_catpvn(prev_path, ";", 1); - sv_catpv(prev_path, mod_name); - return SvPVX(prev_path); + dTHXo; + if (!*prev_pathp) + *prev_pathp = sv_2mortal(newSVpvn("",0)); + sv_catpvn(*prev_pathp, ";", 1); + sv_catpv(*prev_pathp, mod_name); + return SvPVX(*prev_pathp); } return Nullch; } char * -win32_get_privlib(pTHX_ char *pl) +win32_get_privlib(char *pl) { - dPERLOBJ; + dTHXo; char *stdlib = "lib"; char buffer[MAX_PATH+1]; SV *sv = Nullsv; /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */ sprintf(buffer, "%s-%s", stdlib, pl); - if (!get_regstr(buffer, sv)) - (void)get_regstr(stdlib, sv); + if (!get_regstr(buffer, &sv)) + (void)get_regstr(stdlib, &sv); /* $stdlib .= ";$EMD/../../lib" */ - return get_emd_part(sv, stdlib, ARCHNAME, "bin", Nullch); + return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch); } char * -win32_get_sitelib(pTHX_ char *pl) +win32_get_sitelib(char *pl) { - dPERLOBJ; + dTHXo; char *sitelib = "sitelib"; char regstr[40]; char pathstr[MAX_PATH+1]; @@ -288,25 +289,25 @@ win32_get_sitelib(pTHX_ char *pl) /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */ sprintf(regstr, "%s-%s", sitelib, pl); - (void)get_regstr(regstr, sv1); + (void)get_regstr(regstr, &sv1); /* $sitelib .= * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */ sprintf(pathstr, "site/%s/lib", pl); - (void)get_emd_part(sv1, pathstr, ARCHNAME, "bin", pl, Nullch); + (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch); if (!sv1 && strlen(pl) == 7) { /* pl may have been SUBVERSION-specific; try again without * SUBVERSION */ sprintf(pathstr, "site/%.5s/lib", pl); - (void)get_emd_part(sv1, pathstr, ARCHNAME, "bin", pl, Nullch); + (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch); } /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */ - (void)get_regstr(sitelib, sv2); + (void)get_regstr(sitelib, &sv2); /* $sitelib .= * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib"; */ - (void)get_emd_part(sv2, "site/lib", ARCHNAME, "bin", pl, Nullch); + (void)get_emd_part(&sv2, "site/lib", ARCHNAME, "bin", pl, Nullch); if (!sv1 && !sv2) return Nullch; @@ -424,7 +425,7 @@ tokenize(char *str, char **dest, char ***destv) char **retvstart = 0; int items = -1; if (str) { - dPERLOBJ; + dTHXo; int slen = strlen(str); register char *ret; register char **retv; @@ -467,7 +468,7 @@ tokenize(char *str, char **dest, char ***destv) static void get_shell(void) { - dPERLOBJ; + dTHXo; if (!w32_perlshell_tokens) { /* we don't use COMSPEC here for two reasons: * 1. the same reason perl on UNIX doesn't use SHELL--rampant and @@ -485,9 +486,9 @@ get_shell(void) } int -do_aspawn(pTHX_ void *vreally, void **vmark, void **vsp) +do_aspawn(void *vreally, void **vmark, void **vsp) { - dPERLOBJ; + dTHXo; SV *really = (SV*)vreally; SV **mark = (SV**)vmark; SV **sp = (SV**)vsp; @@ -550,9 +551,9 @@ do_aspawn(pTHX_ void *vreally, void **vmark, void **vsp) } int -do_spawn2(pTHX_ char *cmd, int exectype) +do_spawn2(char *cmd, int exectype) { - dPERLOBJ; + dTHXo; char **a; char *s; char **argv; @@ -640,21 +641,21 @@ do_spawn2(pTHX_ char *cmd, int exectype) } int -do_spawn(pTHX_ char *cmd) +do_spawn(char *cmd) { - return do_spawn2(aTHX_ cmd, EXECF_SPAWN); + return do_spawn2(cmd, EXECF_SPAWN); } int -do_spawn_nowait(pTHX_ char *cmd) +do_spawn_nowait(char *cmd) { - return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT); + return do_spawn2(cmd, EXECF_SPAWN_NOWAIT); } bool Perl_do_exec(pTHX_ char *cmd) { - do_spawn2(aTHX_ cmd, EXECF_EXEC); + do_spawn2(cmd, EXECF_EXEC); return FALSE; } @@ -662,11 +663,10 @@ Perl_do_exec(pTHX_ char *cmd) * (separated by nulls) and when one of the other dir functions is called * return the pointer to the current file name. */ -DIR * +DllExport DIR * win32_opendir(char *filename) { - dTHX; - dPERLOBJ; + dTHXo; DIR *p; long len; long idx; @@ -748,7 +748,7 @@ win32_opendir(char *filename) ? FindNextFileW(fh, &wFindData) : FindNextFileA(fh, &aFindData)) { if (USING_WIDE()) { - W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer)); + W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer)); } /* ptr is set above to the correct area */ len = strlen(ptr); @@ -772,7 +772,7 @@ win32_opendir(char *filename) /* Readdir just returns the current string pointer and bumps the * string pointer to the nDllExport entry. */ -struct direct * +DllExport struct direct * win32_readdir(DIR *dirp) { int len; @@ -800,7 +800,7 @@ win32_readdir(DIR *dirp) } /* Telldir returns the current string pointer position */ -long +DllExport long win32_telldir(DIR *dirp) { return (long) dirp->curr; @@ -810,24 +810,24 @@ win32_telldir(DIR *dirp) /* Seekdir moves the string pointer to a previously saved position *(Saved by telldir). */ -void +DllExport void win32_seekdir(DIR *dirp, long loc) { dirp->curr = (char *)loc; } /* Rewinddir resets the string pointer to the start */ -void +DllExport void win32_rewinddir(DIR *dirp) { dirp->curr = dirp->start; } /* free the memory allocated by opendir */ -int +DllExport int win32_closedir(DIR *dirp) { - dPERLOBJ; + dTHXo; Safefree(dirp->start); Safefree(dirp); return 1; @@ -887,7 +887,7 @@ setgid(gid_t agid) char * getlogin(void) { - dTHX; + dTHXo; char *buf = getlogin_buffer; DWORD size = sizeof(getlogin_buffer); if (GetUserName(buf,&size)) @@ -905,7 +905,7 @@ chown(const char *path, uid_t owner, gid_t group) static long find_pid(int pid) { - dPERLOBJ; + dTHXo; long child; for (child = 0 ; child < w32_num_children ; ++child) { if (w32_child_pids[child] == pid) @@ -918,7 +918,7 @@ static void remove_dead_process(long child) { if (child >= 0) { - dPERLOBJ; + dTHXo; CloseHandle(w32_child_handles[child]); Copy(&w32_child_handles[child+1], &w32_child_handles[child], (w32_num_children-child-1), HANDLE); @@ -956,7 +956,7 @@ win32_sleep(unsigned int t) DllExport int win32_stat(const char *path, struct stat *buffer) { - dPERLOBJ; + dTHXo; char t[MAX_PATH+1]; int l = strlen(path); int res; @@ -983,7 +983,6 @@ win32_stat(const char *path, struct stat *buffer) } } if (USING_WIDE()) { - dTHX; A2WHELPER(path, wbuffer, sizeof(wbuffer)); res = _wstat(wbuffer, (struct _stat *)buffer); } @@ -1128,8 +1127,7 @@ win32_longpath(char *path) DllExport char * win32_getenv(const char *name) { - dTHX; - dPERLOBJ; + dTHXo; WCHAR wBuffer[MAX_PATH]; DWORD needlen; SV *curitem = Nullsv; @@ -1150,7 +1148,7 @@ win32_getenv(const char *name) (WCHAR*)SvPVX(curitem), needlen); } while (needlen >= SvLEN(curitem)/sizeof(WCHAR)); - SvCUR_set(curitem, needlen*sizeof(WCHAR)); + SvCUR_set(curitem, (needlen*sizeof(WCHAR))+1); acuritem = sv_2mortal(newSVsv(curitem)); W2AHELPER((WCHAR*)SvPVX(acuritem), SvPVX(curitem), SvCUR(curitem)); } @@ -1167,7 +1165,7 @@ win32_getenv(const char *name) /* allow any environment variables that begin with 'PERL' to be stored in the registry */ if (strncmp(name, "PERL", 4) == 0) - (void)get_regstr(name, curitem); + (void)get_regstr(name, &curitem); } if (curitem && SvCUR(curitem)) return SvPVX(curitem); @@ -1178,7 +1176,7 @@ win32_getenv(const char *name) DllExport int win32_putenv(const char *name) { - dPERLOBJ; + dTHXo; char* curitem; char* val; WCHAR* wCuritem; @@ -1187,10 +1185,9 @@ win32_putenv(const char *name) if (name) { if (USING_WIDE()) { - dTHX; length = strlen(name)+1; New(1309,wCuritem,length,WCHAR); - A2WHELPER(name, wCuritem, length*2); + A2WHELPER(name, wCuritem, length*sizeof(WCHAR)); wVal = wcschr(wCuritem, '='); if(wVal) { *wVal++ = '\0'; @@ -1290,7 +1287,7 @@ filetime_from_time(PFILETIME pFileTime, time_t Time) DllExport int win32_utime(const char *filename, struct utimbuf *times) { - dPERLOBJ; + dTHXo; HANDLE handle; FILETIME ftCreate; FILETIME ftAccess; @@ -1300,7 +1297,6 @@ win32_utime(const char *filename, struct utimbuf *times) int rc; if (USING_WIDE()) { - dTHX; A2WHELPER(filename, wbuffer, sizeof(wbuffer)); rc = _wutime(wbuffer, (struct _utimbuf*)times); } @@ -1436,7 +1432,7 @@ win32_uname(struct utsname *name) DllExport int win32_waitpid(int pid, int *status, int flags) { - dPERLOBJ; + dTHXo; int retval = -1; if (pid == -1) return win32_wait(status); @@ -1474,7 +1470,7 @@ win32_wait(int *status) /* XXX this wait emulation only knows about processes * spawned via win32_spawnvp(P_NOWAIT, ...). */ - dPERLOBJ; + dTHXo; int i, retval; DWORD exitcode, waitcode; @@ -1511,7 +1507,7 @@ static UINT timerid = 0; static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time) { - dPERLOBJ; + dTHXo; KillTimer(NULL,timerid); timerid=0; sighandler(14); @@ -1529,7 +1525,7 @@ win32_alarm(unsigned int sec) * Snag is unless something is looking at the message queue * nothing happens :-( */ - dPERLOBJ; + dTHXo; if (sec) { timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc); @@ -1557,7 +1553,7 @@ win32_crypt(const char *txt, const char *salt) { #ifdef HAVE_DES_FCRYPT dTHR; - dPERLOBJ; + dTHXo; return des_fcrypt(txt, salt, crypt_buffer); #else die("The crypt() function is unimplemented due to excessive paranoia."); @@ -1680,7 +1676,7 @@ win32_flock(int fd, int oper) HANDLE fh; if (!IsWinNT()) { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("flock() unimplemented on this platform"); return -1; } @@ -1779,7 +1775,7 @@ win32_strerror(int e) DWORD source = 0; if (e < 0 || e > sys_nerr) { - dTHX; + dTHXo; if (e < 0) e = GetLastError(); @@ -1793,7 +1789,7 @@ win32_strerror(int e) } DllExport void -win32_str_os_error(pTHX_ void *sv, DWORD dwErr) +win32_str_os_error(void *sv, DWORD dwErr) { DWORD dwLen; char *sMsg; @@ -1816,7 +1812,7 @@ win32_str_os_error(pTHX_ void *sv, DWORD dwErr) dwErr, GetLastError()); } if (sMsg) { - dPERLOBJ; + dTHXo; sv_setpvn((SV*)sv, sMsg, dwLen); LocalFree(sMsg); } @@ -1870,13 +1866,16 @@ win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp) DllExport FILE * win32_fopen(const char *filename, const char *mode) { - dPERLOBJ; + dTHXo; WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH]; + + if (!*filename) + return NULL; + if (stricmp(filename, "/dev/null")==0) filename = "NUL"; if (USING_WIDE()) { - dTHX; A2WHELPER(mode, wMode, sizeof(wMode)); A2WHELPER(filename, wBuffer, sizeof(wBuffer)); return _wfopen(wBuffer, wMode); @@ -1892,10 +1891,9 @@ win32_fopen(const char *filename, const char *mode) DllExport FILE * win32_fdopen(int handle, const char *mode) { - dPERLOBJ; + dTHXo; WCHAR wMode[MODE_SIZE]; if (USING_WIDE()) { - dTHX; A2WHELPER(mode, wMode, sizeof(wMode)); return _wfdopen(handle, wMode); } @@ -1905,13 +1903,12 @@ win32_fdopen(int handle, const char *mode) DllExport FILE * win32_freopen(const char *path, const char *mode, FILE *stream) { - dPERLOBJ; + dTHXo; WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH]; if (stricmp(path, "/dev/null")==0) path = "NUL"; if (USING_WIDE()) { - dTHX; A2WHELPER(mode, wMode, sizeof(wMode)); A2WHELPER(path, wBuffer, sizeof(wBuffer)); return _wfreopen(wBuffer, wMode, stream); @@ -2082,9 +2079,8 @@ win32_popen(const char *command, const char *mode) /* start the child */ { - dTHX; - dPERLOBJ; - if ((childpid = do_spawn_nowait(aTHX_ (char*)command)) == -1) + dTHXo; + if ((childpid = do_spawn_nowait((char*)command)) == -1) goto cleanup; /* revert stdfd to whatever it was before */ @@ -2126,8 +2122,7 @@ win32_pclose(FILE *pf) #ifdef USE_RTL_POPEN return _pclose(pf); #else - dTHX; - dPERLOBJ; + dTHXo; int childpid, status; SV *sv; @@ -2163,9 +2158,8 @@ win32_rename(const char *oname, const char *newname) * it doesn't work under Windows95! */ if (IsWinNT()) { - dPERLOBJ; + dTHXo; if (USING_WIDE()) { - dTHX; A2WHELPER(oname, wOldName, sizeof(wOldName)); A2WHELPER(newname, wNewName, sizeof(wNewName)); bResult = MoveFileExW(wOldName,wNewName, @@ -2289,7 +2283,7 @@ win32_tell(int fd) DllExport int win32_open(const char *path, int flag, ...) { - dPERLOBJ; + dTHXo; va_list ap; int pmode; WCHAR wBuffer[MAX_PATH]; @@ -2302,7 +2296,6 @@ win32_open(const char *path, int flag, ...) path = "NUL"; if (USING_WIDE()) { - dTHX; A2WHELPER(path, wBuffer, sizeof(wBuffer)); return _wopen(wBuffer, flag, pmode); } @@ -2366,7 +2359,7 @@ win32_chdir(const char *dir) static char * create_command_line(const char* command, const char * const *args) { - dPERLOBJ; + dTHXo; int index; char *cmd, *ptr, *arg; STRLEN len = strlen(command) + 1; @@ -2390,7 +2383,7 @@ create_command_line(const char* command, const char * const *args) static char * qualified_path(const char *cmd) { - dPERLOBJ; + dTHXo; char *pathstr; char *fullcmd, *curfullcmd; STRLEN cmdlen = 0; @@ -2492,7 +2485,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) #ifdef USE_RTL_SPAWNVP return spawnvp(mode, cmdname, (char * const *)argv); #else - dPERLOBJ; + dTHXo; DWORD ret; STARTUPINFO StartupInfo; PROCESS_INFORMATION ProcessInformation; @@ -2788,9 +2781,9 @@ win32_get_osfhandle(int fd) } DllExport void* -win32_dynaload(aTHX_ const char*filename) +win32_dynaload(const char* filename) { - dPERLOBJ; + dTHXo; HMODULE hModule; if (USING_WIDE()) { WCHAR wfilename[MAX_PATH]; @@ -2810,8 +2803,7 @@ win32_add_host(char *nameId, void *data) * This must be called before the script is parsed, * therefore no locking of threads is needed */ - dTHX; - dPERLOBJ; + dTHXo; struct host_link *link; New(1314, link, 1, struct host_link); link->host_data = data; @@ -2824,8 +2816,7 @@ win32_add_host(char *nameId, void *data) DllExport void * win32_get_host_data(char *nameId) { - dTHX; - dPERLOBJ; + dTHXo; struct host_link *link = w32_host_link; while(link) { if(strEQ(link->nameId, nameId)) @@ -3216,9 +3207,9 @@ XS(w32_CopyFile) } void -Perl_init_os_extras(pTHX) +Perl_init_os_extras(void) { - dPERLOBJ; + dTHXo; char *file = __FILE__; dXSUB_SYS; diff --git a/win32/win32.h b/win32/win32.h index 38d8688cdb..1110f7e18a 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -9,12 +9,13 @@ #ifndef _INC_WIN32_PERL5 #define _INC_WIN32_PERL5 -#ifdef PERL_OBJECT +#if defined(PERL_OBJECT) || defined(PERL_CAPI) # define DYNAMIC_ENV_FETCH # define ENV_HV_NAME "___ENV_HV_NAME___" # define HAS_GETENV_LEN # define prime_env_iter() # define WIN32IO_IS_STDIO /* don't pull in custom stdio layer */ +# define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */ # ifdef PERL_GLOBAL_STRUCT # error PERL_GLOBAL_STRUCT cannot be defined with PERL_OBJECT # endif @@ -22,6 +23,11 @@ # define win32_get_sitelib PerlEnv_sitelib_path #endif +#if defined(PERL_IMPLICIT_CONTEXT) +# define PERL_GET_INTERP ((PerlInterpreter*)GetPerlInterpreter()) +# define PERL_SET_INTERP(i) (SetPerlInterpreter(i)) +#endif + #ifdef __GNUC__ typedef long long __int64; # define Win32_Winsock @@ -188,10 +194,7 @@ typedef long gid_t; typedef unsigned short mode_t; #pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761) -#ifdef PERL_OBJECT -extern CPerlObj* GetPerlInter(void); -#define dPERLOBJ CPerlObj* pPerl = GetPerlInter() -#else /* PERL_OBJECT */ +#ifndef PERL_OBJECT /* Visual C thinks that a pointer to a member variable is 16 bytes in size. */ #define STRUCT_MGVTBL_DEFINITION \ @@ -238,8 +241,6 @@ struct mgvtbl { \ char handle_VC_problem[16]; \ } - -#define dPERLOBJ dNOOP #endif /* PERL_OBJECT */ #endif /* _MSC_VER */ @@ -299,18 +300,21 @@ extern int chown(const char *p, uid_t o, gid_t g); #define init_os_extras Perl_init_os_extras DllExport void Perl_win32_init(int *argcp, char ***argvp); -DllExport void Perl_init_os_extras(pTHX); -DllExport void win32_str_os_error(pTHX_ void *sv, DWORD err); +DllExport void Perl_init_os_extras(); +DllExport void win32_str_os_error(void *sv, DWORD err); +DllExport int RunPerl(int argc, char **argv, char **env); +DllExport bool SetPerlInterpreter(void* interp); +DllExport void* GetPerlInterpreter(void); #ifndef USE_SOCKETS_AS_HANDLES extern FILE * my_fdopen(int, char *); #endif extern int my_fclose(FILE *); -extern int do_aspawn(pTHX_ void *really, void **mark, void **sp); -extern int do_spawn(pTHX_ char *cmd); -extern int do_spawn_nowait(pTHX_ char *cmd); -extern char * win32_get_privlib(pTHX_ char *pl); -extern char * win32_get_sitelib(pTHX_ char *pl); +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 * win32_get_privlib(char *pl); +extern char * win32_get_sitelib(char *pl); extern int IsWin95(void); extern int IsWinNT(void); @@ -408,8 +412,8 @@ struct thread_intern { /* Use CP_ACP when mode is ANSI */ /* Use CP_UTF8 when mode is UTF8 */ -#define A2WHELPER(lpa, lpw, nChars)\ - lpw[0] = 0, MultiByteToWideChar((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpa, -1, lpw, nChars) +#define A2WHELPER(lpa, lpw, nBytes)\ + lpw[0] = 0, MultiByteToWideChar((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpa, -1, lpw, (nBytes/sizeof(WCHAR))) #define W2AHELPER(lpw, lpa, nChars)\ lpa[0] = '\0', WideCharToMultiByte((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpw, -1, (LPSTR)lpa, nChars, NULL, NULL) diff --git a/win32/win32iop.h b/win32/win32iop.h index e294e73109..9abb05fca6 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -113,6 +113,13 @@ DllExport void win32_free(void *block); DllExport int win32_open_osfhandle(long handle, int flags); DllExport long win32_get_osfhandle(int fd); +DllExport DIR* win32_opendir(char *filename); +DllExport struct direct* win32_readdir(DIR *dirp); +DllExport long win32_telldir(DIR *dirp); +DllExport void win32_seekdir(DIR *dirp, long loc); +DllExport void win32_rewinddir(DIR *dirp); +DllExport int win32_closedir(DIR *dirp); + #ifndef USE_WIN32_RTL_ENV DllExport char* win32_getenv(const char *name); DllExport int win32_putenv(const char *name); diff --git a/win32/win32sck.c b/win32/win32sck.c index abc6334d72..49d38f33f1 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -92,10 +92,10 @@ static int wsock_started = 0; void start_sockets(void) { + dTHXo; unsigned short version; WSADATA retdata; int ret; - dPERLOBJ; /* * initalize the winsock interface and insure that it is @@ -495,8 +495,8 @@ win32_getprotobynumber(int num) struct servent * win32_getservbyname(const char *name, const char *proto) { + dTHXo; struct servent *r; - dTHX; SOCKET_TEST(r = getservbyname(name, proto), NULL); if (r) { @@ -508,8 +508,8 @@ win32_getservbyname(const char *name, const char *proto) struct servent * win32_getservbyport(int port, const char *proto) { + dTHXo; struct servent *r; - dTHX; SOCKET_TEST(r = getservbyport(port, proto), NULL); if (r) { @@ -521,9 +521,9 @@ win32_getservbyport(int port, const char *proto) int win32_ioctl(int i, unsigned int u, char *data) { + dTHXo; u_long argp = (u_long)data; int retval; - dPERLOBJ; if (!wsock_started) { Perl_croak_nocontext("ioctl implemented only on sockets"); @@ -562,28 +562,28 @@ win32_inet_addr(const char FAR *cp) void win32_endhostent() { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("endhostent not implemented!\n"); } void win32_endnetent() { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("endnetent not implemented!\n"); } void win32_endprotoent() { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("endprotoent not implemented!\n"); } void win32_endservent() { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("endservent not implemented!\n"); } @@ -591,7 +591,7 @@ win32_endservent() struct netent * win32_getnetent(void) { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("getnetent not implemented!\n"); return (struct netent *) NULL; } @@ -599,7 +599,7 @@ win32_getnetent(void) struct netent * win32_getnetbyname(char *name) { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("getnetbyname not implemented!\n"); return (struct netent *)NULL; } @@ -607,7 +607,7 @@ win32_getnetbyname(char *name) struct netent * win32_getnetbyaddr(long net, int type) { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("getnetbyaddr not implemented!\n"); return (struct netent *)NULL; } @@ -615,7 +615,7 @@ win32_getnetbyaddr(long net, int type) struct protoent * win32_getprotoent(void) { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("getprotoent not implemented!\n"); return (struct protoent *) NULL; } @@ -623,7 +623,7 @@ win32_getprotoent(void) struct servent * win32_getservent(void) { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("getservent not implemented!\n"); return (struct servent *) NULL; } @@ -631,7 +631,7 @@ win32_getservent(void) void win32_sethostent(int stayopen) { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("sethostent not implemented!\n"); } @@ -639,7 +639,7 @@ win32_sethostent(int stayopen) void win32_setnetent(int stayopen) { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("setnetent not implemented!\n"); } @@ -647,7 +647,7 @@ win32_setnetent(int stayopen) void win32_setprotoent(int stayopen) { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("setprotoent not implemented!\n"); } @@ -655,7 +655,7 @@ win32_setprotoent(int stayopen) void win32_setservent(int stayopen) { - dPERLOBJ; + dTHXo; Perl_croak_nocontext("setservent not implemented!\n"); } |