X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2FGenCAPI.pl;h=703a156795557d1d20efa0ffd9237bb0ebce5cb5;hb=ed7ab888f26e9b2a3bcf98806b630e993179f8b4;hp=e22038425ce4a367cd81f50dec7561647f046844;hpb=8d9b2e3c6958e5856b03a00694b8ae02817ed002;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl index e220384..703a156 100644 --- a/win32/GenCAPI.pl +++ b/win32/GenCAPI.pl @@ -1,36 +1,36 @@ # 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". +# creates 2 files: "perlCAPI.cpp" and "perlCAPI.h". -my $hdrfile = "$ARGV[0]\\PerlCAPI.h"; -my $infile = '..\\proto.h'; -my $embedfile = '..\\embed.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 readembed(\%$) { - my ($syms, $file) = @_; +sub readsyms(\%@) { + my ($syms, @files) = @_; my ($line, @words); %$syms = (); - local (*FILE, $_); - open(FILE, "< $file") - or die "$0: Can't open $file: $!\n"; - while ($line = ) { - chop($line); - if ($line =~ /^#define\s+\w+/) { - $line =~ s/^#define\s+//; - @words = split ' ', $line; -# print "$words[0]\t$words[1]\n"; - $$syms{$words[0]} = $words[1]; + foreach my $file (@files) { + local (*FILE, $_); + open(FILE, "< $file") + or die "$0: Can't open $file: $!\n"; + while () { + s/[ \t]*#.*$//; # delete comments + if (/^\s*(\S+)\s*$/) { + my $sym = $1; + $$syms{$sym} = $sym; + } } + close(FILE); } - close(FILE); } -readembed %embed, $embedfile; +readsyms %embed, @embedsyms; sub skip_these { my $list = shift; @@ -40,38 +40,66 @@ sub skip_these { } skip_these [qw( -cando -cast_ulong -my_chsize -condpair_magic -deb -deb_growlevel -debprofdump -debop -debstack -debstackptrs -dump_fds -dump_mstats +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 -find_threadsv -magic_mutexfree -my_memcmp -my_memset -my_pclose -my_popen -my_swap -my_htonl -my_ntohl -new_struct_thread -same_dirent -unlnk -unlock_condpair -safexmalloc -safexcalloc -safexrealloc -safexfree +Perl_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 -malloced_size +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 )]; @@ -81,8 +109,8 @@ if (!open(INFILE, "<$infile")) { return 1; } -if (!open(OUTFILE, ">PerlCAPI.cpp")) { - print "open of PerlCAPI.cpp failed: $!\n"; +if (!open(OUTFILE, ">perlCAPI.cpp")) { + print "open of perlCAPI.cpp failed: $!\n"; return 1; } @@ -91,8 +119,15 @@ print OUTFILE <); - if (/^VIRTUAL\s/) { + if (/^VIRTUAL\s+/) { while (!/;$/) { chomp; $_ .= ; } $_ =~ s/^VIRTUAL\s*//; $_ =~ s/\s*__attribute__.*$/;/; - if ( /(.*)\s([A-z_]*[0-9A-z_]+\s)_\(\((.*)\)\);/ || - /(.*)\*([A-z_]*[0-9A-z_]+\s)_\(\((.*)\)\);/ ) { + if ( /^(.+)\t(\w+)\((.*)\);/ ) { $type = $1; $name = $2; $args = $3; @@ -125,10 +161,14 @@ while () { $name =~ s/\s*$//; $type =~ s/\s*$//; next if (defined $skip_list{$name}); + next if $name =~ /^S_/; + next if exists $done{$name}; - if($args eq "ARGSproto") { + $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"; @@ -140,30 +180,29 @@ while () { @args = split(',', $args); if ($args[$#args] =~ /\s*\.\.\.\s*/) { - if(($name eq "croak") or ($name eq "deb") or ($name eq "die") - or ($name eq "form") or ($name eq "warn")) { + if ($name =~ /^Perl_(croak|deb|die|warn|form|warner)$/) { print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0); - $args[0] =~ /(\w+)\W*$/; - $arg = $1; + 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 <Perl_mess($arg, &args); - New(0, pstr, strlen(pmsg)+1, char); - strcpy(pstr, pmsg); -$return pPerl->Perl_$name(pstr); + 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 eq "newSVpvf") { + elsif($name =~ /^Perl_newSVpvf/) { print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0); $args[0] =~ /(\w+)\W*$/; $arg = $1; @@ -183,7 +222,7 @@ extern "C" $type $funcName ($args) ENDCODE print OUTFILE "#endif\n" unless ($separateObj == 0); } - elsif($name eq "sv_catpvf") { + elsif($name =~ /^Perl_sv_catpvf/) { print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0); $args[0] =~ /(\w+)\W*$/; $arg0 = $1; @@ -202,7 +241,49 @@ extern "C" $type $funcName ($args) ENDCODE print OUTFILE "#endif\n" unless ($separateObj == 0); } - elsif($name eq "sv_setpvf") { + 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 <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 <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; @@ -211,12 +292,16 @@ ENDCODE print OUTFILE <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); @@ -248,26 +333,26 @@ ENDCODE } # newXS special case - if ($name eq "newXS") { + if ($name eq "Perl_newXS") { next; } print OUTFILE "\n#ifdef $name" . "defined" unless ($separateObj == 0); # handle specical case for save_destructor - if ($name eq "save_destructor") { + if ($name eq "Perl_save_destructor") { next; } # handle specical case for sighandler - if ($name eq "sighandler") { + if ($name eq "Perl_sighandler") { next; } # handle special case for sv_grow - if ($name eq "sv_grow" and $args eq "SV* sv, unsigned long newlen") { + if ($name eq "Perl_sv_grow" and $args eq "SV* sv, unsigned long newlen") { next; } # handle special case for newSV - if ($name eq "newSV" and $args eq "I32 x, STRLEN len") { + if ($name eq "Perl_newSV" and $args eq "I32 x, STRLEN len") { next; } # handle special case for perl_parse @@ -284,13 +369,13 @@ ENDCODE next; } # handle special case for perl_atexit - if ($name eq "perl_atexit") { + if ($name eq "Perl_call_atexit") { print OUTFILE <perl_atexit(fn, ptr); + pPerl->perl_call_atexit(fn, ptr); } ENDCODE print OUTFILE "#endif\n" unless ($separateObj == 0); @@ -298,7 +383,7 @@ ENDCODE } - if($name eq "byterun" and $args eq "struct bytestream bs") { + if($name eq "Perl_byterun" and $args eq "struct bytestream bs") { next; } @@ -365,7 +450,6 @@ secondgv sortstack signalstack mystrk -dumplvl oldlastpm gensym preambled @@ -376,6 +460,7 @@ mess_sv ors opsave eval_mutex +strtab_mutex orslen ofmt modcount @@ -426,13 +511,13 @@ statusvalue_vms sublex_info thrsv threadnum -piMem -piENV -piStdIO -piLIO -piDir -piSock -piProc +PL_Mem +PL_Env +PL_StdIO +PL_LIO +PL_Dir +PL_Sock +PL_Proc cshname threadsv_names thread @@ -442,10 +527,13 @@ threads_mutex malloc_mutex svref_mutex sv_mutex +cred_mutex nthreads_cond eval_cond cryptseen cshlen +watchaddr +watchok )]; sub readvars(\%$$) { @@ -456,7 +544,7 @@ sub readvars(\%$$) { or die "$0: Can't open $file: $!\n"; while () { s/[ \t]*#.*//; # Delete comments. - if (/PERLVARI?C?\($pre(\w+),\s*([^,)]+)/) { + if (/PERLVARA?I?C?\($pre(\w+),\s*([^,)]+)/) { $$syms{$1} = $2; } } @@ -474,6 +562,7 @@ readvars %globvar, '..\perlvars.h','G'; open(HDRFILE, ">$hdrfile") or die "$0: Can't open $hdrfile: $!\n"; print HDRFILE <Perl_$name); + return (($type *)&pPerl->PL_$name); } ENDCODE @@ -498,9 +588,9 @@ ENDCODE print HDRFILE <Perl_get_opargs(); } -void xs_handler(CV* cv, CPerlObj* p) +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; @@ -564,6 +662,7 @@ void xs_handler(CV* cv, CPerlObj* p) } } +#undef Perl_newXS CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename) { CV* cv = pPerl->Perl_newXS(name, xs_handler, filename); @@ -571,18 +670,18 @@ CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename) return cv; } - +#undef Perl_deb void Perl_deb(const char pat, ...) { } -#undef piMem -#undef piENV -#undef piStdIO -#undef piLIO -#undef piDir -#undef piSock -#undef piProc +#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) { @@ -591,27 +690,27 @@ int * _win32_errno(void) FILE* _win32_stdin(void) { - return (FILE*)pPerl->piStdIO->Stdin(); + return (FILE*)pPerl->PL_StdIO->Stdin(); } FILE* _win32_stdout(void) { - return (FILE*)pPerl->piStdIO->Stdout(); + return (FILE*)pPerl->PL_StdIO->Stdout(); } FILE* _win32_stderr(void) { - return (FILE*)pPerl->piStdIO->Stderr(); + return (FILE*)pPerl->PL_StdIO->Stderr(); } int _win32_ferror(FILE *fp) { - return pPerl->piStdIO->Error((PerlIO*)fp, ErrorNo()); + return pPerl->PL_StdIO->Error((PerlIO*)fp, ErrorNo()); } int _win32_feof(FILE *fp) { - return pPerl->piStdIO->Eof((PerlIO*)fp, ErrorNo()); + return pPerl->PL_StdIO->Eof((PerlIO*)fp, ErrorNo()); } char* _win32_strerror(int e) @@ -626,12 +725,12 @@ void _win32_perror(const char *str) int _win32_vfprintf(FILE *pf, const char *format, va_list arg) { - return pPerl->piStdIO->Vprintf((PerlIO*)pf, ErrorNo(), format, arg); + return pPerl->PL_StdIO->Vprintf((PerlIO*)pf, ErrorNo(), format, arg); } int _win32_vprintf(const char *format, va_list arg) { - return pPerl->piStdIO->Vprintf(pPerl->piStdIO->Stdout(), ErrorNo(), format, arg); + return pPerl->PL_StdIO->Vprintf(pPerl->PL_StdIO->Stdout(), ErrorNo(), format, arg); } int _win32_fprintf(FILE *pf, const char *format, ...) @@ -656,517 +755,532 @@ int _win32_printf(const char *format, ...) size_t _win32_fread(void *buf, size_t size, size_t count, FILE *pf) { - return pPerl->piStdIO->Read((PerlIO*)pf, buf, (size*count), ErrorNo()); + 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->piStdIO->Write((PerlIO*)pf, buf, (size*count), ErrorNo()); + return pPerl->PL_StdIO->Write((PerlIO*)pf, buf, (size*count), ErrorNo()); } FILE* _win32_fopen(const char *path, const char *mode) { - return (FILE*)pPerl->piStdIO->Open(path, mode, ErrorNo()); + return (FILE*)pPerl->PL_StdIO->Open(path, mode, ErrorNo()); } FILE* _win32_fdopen(int fh, const char *mode) { - return (FILE*)pPerl->piStdIO->Fdopen(fh, mode, ErrorNo()); + return (FILE*)pPerl->PL_StdIO->Fdopen(fh, mode, ErrorNo()); } FILE* _win32_freopen(const char *path, const char *mode, FILE *pf) { - return (FILE*)pPerl->piStdIO->Reopen(path, mode, (PerlIO*)pf, ErrorNo()); + return (FILE*)pPerl->PL_StdIO->Reopen(path, mode, (PerlIO*)pf, ErrorNo()); } int _win32_fclose(FILE *pf) { - return pPerl->piStdIO->Close((PerlIO*)pf, ErrorNo()); + return pPerl->PL_StdIO->Close((PerlIO*)pf, ErrorNo()); } int _win32_fputs(const char *s,FILE *pf) { - return pPerl->piStdIO->Puts((PerlIO*)pf, s, ErrorNo()); + return pPerl->PL_StdIO->Puts((PerlIO*)pf, s, ErrorNo()); } int _win32_fputc(int c,FILE *pf) { - return pPerl->piStdIO->Putc((PerlIO*)pf, c, ErrorNo()); + return pPerl->PL_StdIO->Putc((PerlIO*)pf, c, ErrorNo()); } int _win32_ungetc(int c,FILE *pf) { - return pPerl->piStdIO->Ungetc((PerlIO*)pf, c, ErrorNo()); + return pPerl->PL_StdIO->Ungetc((PerlIO*)pf, c, ErrorNo()); } int _win32_getc(FILE *pf) { - return pPerl->piStdIO->Getc((PerlIO*)pf, ErrorNo()); + return pPerl->PL_StdIO->Getc((PerlIO*)pf, ErrorNo()); } int _win32_fileno(FILE *pf) { - return pPerl->piStdIO->Fileno((PerlIO*)pf, ErrorNo()); + return pPerl->PL_StdIO->Fileno((PerlIO*)pf, ErrorNo()); } void _win32_clearerr(FILE *pf) { - pPerl->piStdIO->Clearerr((PerlIO*)pf, ErrorNo()); + pPerl->PL_StdIO->Clearerr((PerlIO*)pf, ErrorNo()); } int _win32_fflush(FILE *pf) { - return pPerl->piStdIO->Flush((PerlIO*)pf, ErrorNo()); + return pPerl->PL_StdIO->Flush((PerlIO*)pf, ErrorNo()); } long _win32_ftell(FILE *pf) { - return pPerl->piStdIO->Tell((PerlIO*)pf, ErrorNo()); + return pPerl->PL_StdIO->Tell((PerlIO*)pf, ErrorNo()); } int _win32_fseek(FILE *pf,long offset,int origin) { - return pPerl->piStdIO->Seek((PerlIO*)pf, offset, origin, ErrorNo()); + return pPerl->PL_StdIO->Seek((PerlIO*)pf, offset, origin, ErrorNo()); } int _win32_fgetpos(FILE *pf,fpos_t *p) { - return pPerl->piStdIO->Getpos((PerlIO*)pf, p, ErrorNo()); + return pPerl->PL_StdIO->Getpos((PerlIO*)pf, p, ErrorNo()); } int _win32_fsetpos(FILE *pf,const fpos_t *p) { - return pPerl->piStdIO->Setpos((PerlIO*)pf, p, ErrorNo()); + return pPerl->PL_StdIO->Setpos((PerlIO*)pf, p, ErrorNo()); } void _win32_rewind(FILE *pf) { - pPerl->piStdIO->Rewind((PerlIO*)pf, ErrorNo()); + pPerl->PL_StdIO->Rewind((PerlIO*)pf, ErrorNo()); } FILE* _win32_tmpfile(void) { - return (FILE*)pPerl->piStdIO->Tmpfile(ErrorNo()); + return (FILE*)pPerl->PL_StdIO->Tmpfile(ErrorNo()); } void _win32_setbuf(FILE *pf, char *buf) { - pPerl->piStdIO->SetBuf((PerlIO*)pf, buf, ErrorNo()); + pPerl->PL_StdIO->SetBuf((PerlIO*)pf, buf, ErrorNo()); } int _win32_setvbuf(FILE *pf, char *buf, int type, size_t size) { - return pPerl->piStdIO->SetVBuf((PerlIO*)pf, buf, type, size, ErrorNo()); + return pPerl->PL_StdIO->SetVBuf((PerlIO*)pf, buf, type, size, ErrorNo()); } char* _win32_fgets(char *s, int n, FILE *pf) { - return pPerl->piStdIO->Gets((PerlIO*)pf, s, n, ErrorNo()); + return pPerl->PL_StdIO->Gets((PerlIO*)pf, s, n, ErrorNo()); } char* _win32_gets(char *s) { - return _win32_fgets(s, 80, (FILE*)pPerl->piStdIO->Stdin()); + return _win32_fgets(s, 80, (FILE*)pPerl->PL_StdIO->Stdin()); } int _win32_fgetc(FILE *pf) { - return pPerl->piStdIO->Getc((PerlIO*)pf, ErrorNo()); + return pPerl->PL_StdIO->Getc((PerlIO*)pf, ErrorNo()); } int _win32_putc(int c, FILE *pf) { - return pPerl->piStdIO->Putc((PerlIO*)pf, c, ErrorNo()); + return pPerl->PL_StdIO->Putc((PerlIO*)pf, c, ErrorNo()); } int _win32_puts(const char *s) { - return pPerl->piStdIO->Puts(pPerl->piStdIO->Stdout(), s, ErrorNo()); + return pPerl->PL_StdIO->Puts(pPerl->PL_StdIO->Stdout(), s, ErrorNo()); } int _win32_getchar(void) { - return pPerl->piStdIO->Getc(pPerl->piStdIO->Stdin(), ErrorNo()); + return pPerl->PL_StdIO->Getc(pPerl->PL_StdIO->Stdin(), ErrorNo()); } int _win32_putchar(int c) { - return pPerl->piStdIO->Putc(pPerl->piStdIO->Stdout(), c, ErrorNo()); + return pPerl->PL_StdIO->Putc(pPerl->PL_StdIO->Stdout(), c, ErrorNo()); } void* _win32_malloc(size_t size) { - return pPerl->piMem->Malloc(size); + return pPerl->PL_Mem->Malloc(size); } void* _win32_calloc(size_t numitems, size_t size) { - return pPerl->piMem->Malloc(numitems*size); + return pPerl->PL_Mem->Malloc(numitems*size); } void* _win32_realloc(void *block, size_t size) { - return pPerl->piMem->Realloc(block, size); + return pPerl->PL_Mem->Realloc(block, size); } void _win32_free(void *block) { - pPerl->piMem->Free(block); + pPerl->PL_Mem->Free(block); } void _win32_abort(void) { - pPerl->piProc->Abort(); + pPerl->PL_Proc->Abort(); } int _win32_pipe(int *phandles, unsigned int psize, int textmode) { - return pPerl->piProc->Pipe(phandles); + return pPerl->PL_Proc->Pipe(phandles); } FILE* _win32_popen(const char *command, const char *mode) { - return (FILE*)pPerl->piProc->Popen(command, mode); + return (FILE*)pPerl->PL_Proc->Popen(command, mode); } int _win32_pclose(FILE *pf) { - return pPerl->piProc->Pclose((PerlIO*)pf); + return pPerl->PL_Proc->Pclose((PerlIO*)pf); } unsigned _win32_sleep(unsigned int t) { - return pPerl->piProc->Sleep(t); + return pPerl->PL_Proc->Sleep(t); } int _win32_spawnvp(int mode, const char *cmdname, const char *const *argv) { - return pPerl->piProc->Spawnvp(mode, cmdname, argv); + return pPerl->PL_Proc->Spawnvp(mode, cmdname, argv); } int _win32_mkdir(const char *dir, int mode) { - return pPerl->piDir->Makedir(dir, mode, ErrorNo()); + return pPerl->PL_Dir->Makedir(dir, mode, ErrorNo()); } int _win32_rmdir(const char *dir) { - return pPerl->piDir->Rmdir(dir, ErrorNo()); + return pPerl->PL_Dir->Rmdir(dir, ErrorNo()); } int _win32_chdir(const char *dir) { - return pPerl->piDir->Chdir(dir, ErrorNo()); + return pPerl->PL_Dir->Chdir(dir, ErrorNo()); } #undef stat int _win32_fstat(int fd,struct stat *sbufptr) { - return pPerl->piLIO->FileStat(fd, sbufptr, ErrorNo()); + return pPerl->PL_LIO->FileStat(fd, sbufptr, ErrorNo()); } int _win32_stat(const char *name,struct stat *sbufptr) { - return pPerl->piLIO->NameStat(name, sbufptr, ErrorNo()); + return pPerl->PL_LIO->NameStat(name, sbufptr, ErrorNo()); } int _win32_rename(const char *oname, const char *newname) { - return pPerl->piLIO->Rename(oname, newname, ErrorNo()); + return pPerl->PL_LIO->Rename(oname, newname, ErrorNo()); } int _win32_setmode(int fd, int mode) { - return pPerl->piLIO->Setmode(fd, mode, ErrorNo()); + return pPerl->PL_LIO->Setmode(fd, mode, ErrorNo()); } long _win32_lseek(int fd, long offset, int origin) { - return pPerl->piLIO->Lseek(fd, offset, origin, ErrorNo()); + return pPerl->PL_LIO->Lseek(fd, offset, origin, ErrorNo()); } long _win32_tell(int fd) { - return pPerl->piStdIO->Tell((PerlIO*)fd, ErrorNo()); + return pPerl->PL_StdIO->Tell((PerlIO*)fd, ErrorNo()); } int _win32_dup(int fd) { - return pPerl->piLIO->Dup(fd, ErrorNo()); + return pPerl->PL_LIO->Dup(fd, ErrorNo()); } int _win32_dup2(int h1, int h2) { - return pPerl->piLIO->Dup2(h1, h2, ErrorNo()); + return pPerl->PL_LIO->Dup2(h1, h2, ErrorNo()); } int _win32_open(const char *path, int oflag,...) { - return pPerl->piLIO->Open(path, oflag, ErrorNo()); + return pPerl->PL_LIO->Open(path, oflag, ErrorNo()); } int _win32_close(int fd) { - return pPerl->piLIO->Close(fd, ErrorNo()); + return pPerl->PL_LIO->Close(fd, ErrorNo()); } int _win32_read(int fd, void *buf, unsigned int cnt) { - return pPerl->piLIO->Read(fd, buf, cnt, ErrorNo()); + return pPerl->PL_LIO->Read(fd, buf, cnt, ErrorNo()); } int _win32_write(int fd, const void *buf, unsigned int cnt) { - return pPerl->piLIO->Write(fd, buf, cnt, ErrorNo()); + return pPerl->PL_LIO->Write(fd, buf, cnt, ErrorNo()); } int _win32_times(struct tms *timebuf) { - return pPerl->piProc->Times(timebuf); + return pPerl->PL_Proc->Times(timebuf); } int _win32_ioctl(int i, unsigned int u, char *data) { - return pPerl->piLIO->IOCtl(i, u, data, ErrorNo()); + return pPerl->PL_LIO->IOCtl(i, u, data, ErrorNo()); } int _win32_utime(const char *f, struct utimbuf *t) { - return pPerl->piLIO->Utime((char*)f, t, ErrorNo()); + 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->piENV->Getenv(name, ErrorNo()); + 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->piStdIO->OpenOSfhandle(handle, flags); + return pPerl->PL_StdIO->OpenOSfhandle(handle, flags); } long _win32_get_osfhandle(int fd) { - return pPerl->piStdIO->GetOSfhandle(fd); + return pPerl->PL_StdIO->GetOSfhandle(fd); } u_long _win32_htonl (u_long hostlong) { - return pPerl->piSock->Htonl(hostlong); + return pPerl->PL_Sock->Htonl(hostlong); } u_short _win32_htons (u_short hostshort) { - return pPerl->piSock->Htons(hostshort); + return pPerl->PL_Sock->Htons(hostshort); } u_long _win32_ntohl (u_long netlong) { - return pPerl->piSock->Ntohl(netlong); + return pPerl->PL_Sock->Ntohl(netlong); } u_short _win32_ntohs (u_short netshort) { - return pPerl->piSock->Ntohs(netshort); + return pPerl->PL_Sock->Ntohs(netshort); } unsigned long _win32_inet_addr (const char * cp) { - return pPerl->piSock->InetAddr(cp, ErrorNo()); + return pPerl->PL_Sock->InetAddr(cp, ErrorNo()); } char * _win32_inet_ntoa (struct in_addr in) { - return pPerl->piSock->InetNtoa(in, ErrorNo()); + return pPerl->PL_Sock->InetNtoa(in, ErrorNo()); } SOCKET _win32_socket (int af, int type, int protocol) { - return pPerl->piSock->Socket(af, type, protocol, ErrorNo()); + return pPerl->PL_Sock->Socket(af, type, protocol, ErrorNo()); } int _win32_bind (SOCKET s, const struct sockaddr *addr, int namelen) { - return pPerl->piSock->Bind(s, addr, namelen, ErrorNo()); + return pPerl->PL_Sock->Bind(s, addr, namelen, ErrorNo()); } int _win32_listen (SOCKET s, int backlog) { - return pPerl->piSock->Listen(s, backlog, ErrorNo()); + return pPerl->PL_Sock->Listen(s, backlog, ErrorNo()); } SOCKET _win32_accept (SOCKET s, struct sockaddr *addr, int *addrlen) { - return pPerl->piSock->Accept(s, addr, addrlen, ErrorNo()); + return pPerl->PL_Sock->Accept(s, addr, addrlen, ErrorNo()); } int _win32_connect (SOCKET s, const struct sockaddr *name, int namelen) { - return pPerl->piSock->Connect(s, name, namelen, ErrorNo()); + return pPerl->PL_Sock->Connect(s, name, namelen, ErrorNo()); } int _win32_send (SOCKET s, const char * buf, int len, int flags) { - return pPerl->piSock->Send(s, buf, len, flags, ErrorNo()); + 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->piSock->Sendto(s, buf, len, flags, to, tolen, ErrorNo()); + 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->piSock->Recv(s, buf, len, flags, ErrorNo()); + 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->piSock->Recvfrom(s, buf, len, flags, from, fromlen, ErrorNo()); + return pPerl->PL_Sock->Recvfrom(s, buf, len, flags, from, fromlen, ErrorNo()); } int _win32_shutdown (SOCKET s, int how) { - return pPerl->piSock->Shutdown(s, how, ErrorNo()); + return pPerl->PL_Sock->Shutdown(s, how, ErrorNo()); } int _win32_closesocket (SOCKET s) { - return pPerl->piSock->Closesocket(s, ErrorNo()); + return pPerl->PL_Sock->Closesocket(s, ErrorNo()); } int _win32_ioctlsocket (SOCKET s, long cmd, u_long *argp) { - return pPerl->piSock->Ioctlsocket(s, cmd, argp, ErrorNo()); + 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->piSock->Setsockopt(s, level, optname, optval, optlen, ErrorNo()); + 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->piSock->Getsockopt(s, level, optname, optval, optlen, ErrorNo()); + return pPerl->PL_Sock->Getsockopt(s, level, optname, optval, optlen, ErrorNo()); } int _win32_getpeername (SOCKET s, struct sockaddr *name, int * namelen) { - return pPerl->piSock->Getpeername(s, name, namelen, ErrorNo()); + return pPerl->PL_Sock->Getpeername(s, name, namelen, ErrorNo()); } int _win32_getsockname (SOCKET s, struct sockaddr *name, int * namelen) { - return pPerl->piSock->Getsockname(s, name, namelen, ErrorNo()); + return pPerl->PL_Sock->Getsockname(s, name, namelen, ErrorNo()); } int _win32_gethostname (char * name, int namelen) { - return pPerl->piSock->Gethostname(name, namelen, ErrorNo()); + return pPerl->PL_Sock->Gethostname(name, namelen, ErrorNo()); } struct hostent * _win32_gethostbyname(const char * name) { - return pPerl->piSock->Gethostbyname(name, ErrorNo()); + return pPerl->PL_Sock->Gethostbyname(name, ErrorNo()); } struct hostent * _win32_gethostbyaddr(const char * addr, int len, int type) { - return pPerl->piSock->Gethostbyaddr(addr, len, type, ErrorNo()); + return pPerl->PL_Sock->Gethostbyaddr(addr, len, type, ErrorNo()); } struct protoent * _win32_getprotobyname(const char * name) { - return pPerl->piSock->Getprotobyname(name, ErrorNo()); + return pPerl->PL_Sock->Getprotobyname(name, ErrorNo()); } struct protoent * _win32_getprotobynumber(int proto) { - return pPerl->piSock->Getprotobynumber(proto, ErrorNo()); + return pPerl->PL_Sock->Getprotobynumber(proto, ErrorNo()); } struct servent * _win32_getservbyname(const char * name, const char * proto) { - return pPerl->piSock->Getservbyname(name, proto, ErrorNo()); + return pPerl->PL_Sock->Getservbyname(name, proto, ErrorNo()); } struct servent * _win32_getservbyport(int port, const char * proto) { - return pPerl->piSock->Getservbyport(port, proto, ErrorNo()); + 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->piSock->Select(nfds, (char*)rfds, (char*)wfds, (char*)xfds, timeout, ErrorNo()); + return pPerl->PL_Sock->Select(nfds, (char*)rfds, (char*)wfds, (char*)xfds, timeout, ErrorNo()); } void _win32_endnetent(void) { - pPerl->piSock->Endnetent(ErrorNo()); + pPerl->PL_Sock->Endnetent(ErrorNo()); } void _win32_endhostent(void) { - pPerl->piSock->Endhostent(ErrorNo()); + pPerl->PL_Sock->Endhostent(ErrorNo()); } void _win32_endprotoent(void) { - pPerl->piSock->Endprotoent(ErrorNo()); + pPerl->PL_Sock->Endprotoent(ErrorNo()); } void _win32_endservent(void) { - pPerl->piSock->Endservent(ErrorNo()); + pPerl->PL_Sock->Endservent(ErrorNo()); } struct netent * _win32_getnetent(void) { - return pPerl->piSock->Getnetent(ErrorNo()); + return pPerl->PL_Sock->Getnetent(ErrorNo()); } struct netent * _win32_getnetbyname(char *name) { - return pPerl->piSock->Getnetbyname(name, ErrorNo()); + return pPerl->PL_Sock->Getnetbyname(name, ErrorNo()); } struct netent * _win32_getnetbyaddr(long net, int type) { - return pPerl->piSock->Getnetbyaddr(net, type, ErrorNo()); + return pPerl->PL_Sock->Getnetbyaddr(net, type, ErrorNo()); } struct protoent *_win32_getprotoent(void) { - return pPerl->piSock->Getprotoent(ErrorNo()); + return pPerl->PL_Sock->Getprotoent(ErrorNo()); } struct servent *_win32_getservent(void) { - return pPerl->piSock->Getservent(ErrorNo()); + return pPerl->PL_Sock->Getservent(ErrorNo()); } void _win32_sethostent(int stayopen) { - pPerl->piSock->Sethostent(stayopen, ErrorNo()); + pPerl->PL_Sock->Sethostent(stayopen, ErrorNo()); } void _win32_setnetent(int stayopen) { - pPerl->piSock->Setnetent(stayopen, ErrorNo()); + pPerl->PL_Sock->Setnetent(stayopen, ErrorNo()); } void _win32_setprotoent(int stayopen) { - pPerl->piSock->Setprotoent(stayopen, ErrorNo()); + pPerl->PL_Sock->Setprotoent(stayopen, ErrorNo()); } void _win32_setservent(int stayopen) { - pPerl->piSock->Setservent(stayopen, ErrorNo()); + pPerl->PL_Sock->Setservent(stayopen, ErrorNo()); } } /* extern "C" */ EOCODE @@ -1257,6 +1371,8 @@ U32 * _Perl_opargs (); #undef win32_stat #undef win32_ioctl #undef win32_utime +#undef win32_uname +#undef win32_os_id #undef win32_getenv #undef win32_htonl @@ -1374,6 +1490,8 @@ U32 * _Perl_opargs (); #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 @@ -1493,6 +1611,8 @@ 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);