diff options
| -rw-r--r-- | MANIFEST | 16 | ||||
| -rw-r--r-- | ipdir.h | 60 | ||||
| -rw-r--r-- | ipenv.h | 21 | ||||
| -rw-r--r-- | iperlsys.h | 905 | ||||
| -rw-r--r-- | iplio.h | 41 | ||||
| -rw-r--r-- | ipmem.h | 20 | ||||
| -rw-r--r-- | ipproc.h | 56 | ||||
| -rw-r--r-- | ipsock.h | 64 | ||||
| -rw-r--r-- | ipstdio.h | 63 | ||||
| -rw-r--r-- | mg.h | 4 | ||||
| -rw-r--r-- | op.h | 4 | ||||
| -rw-r--r-- | perl.h | 20 | ||||
| -rw-r--r-- | perldir.h | 34 | ||||
| -rw-r--r-- | perlenv.h | 19 | ||||
| -rw-r--r-- | perlio.c | 2 | ||||
| -rw-r--r-- | perlio.h | 251 | ||||
| -rw-r--r-- | perllio.h | 63 | ||||
| -rw-r--r-- | perlmem.h | 19 | ||||
| -rw-r--r-- | perlproc.h | 71 | ||||
| -rw-r--r-- | perlsock.h | 102 | ||||
| -rw-r--r-- | proto.h | 7 | ||||
| -rw-r--r-- | util.c | 1 | ||||
| -rw-r--r-- | win32/Makefile | 2 | ||||
| -rw-r--r-- | win32/dl_win32.xs | 8 | ||||
| -rw-r--r-- | win32/makefile.mk | 2 | ||||
| -rw-r--r-- | win32/perlhost.h | 971 | ||||
| -rw-r--r-- | win32/runperl.c | 1006 | ||||
| -rw-r--r-- | win32/win32.h | 49 |
28 files changed, 1964 insertions, 1917 deletions
@@ -404,13 +404,7 @@ installman Perl script to install man pages for pods installperl Perl script to do "make install" dirty work interp.sym Interpreter specific symbols to hide in a struct intrpvar.h Variables held in each interpreter instance -ipdir.h Directory interface for Perl Object -ipenv.h Environment interface for Perl Object -iplio.h Low level IO interface for Perl Object -ipmem.h Memory interface for Perl Object -ipproc.h Process interface for Perl Object -ipsock.h Socket interface for Perl Object -ipstdio.h Stdio interface for Perl Object +iperlsys.h Perl's interface to the system keywords.h The keyword numbers keywords.pl Program to write keywords.h lib/AnyDBM_File.pm Perl module to emulate dbmopen @@ -632,18 +626,11 @@ patchlevel.h The current patch level of perl perl.c main() perl.h Global declarations perl_exp.SH Creates list of exported symbols for AIX -perldir.h Macros for directory abstraction -perlenv.h Macros for environment abstraction perlio.c C code for PerlIO abstraction -perlio.h Interface to PerlIO abstraction perlio.sym Symbols for PerlIO abstraction -perllio.h Macros for Low level IO abstraction -perlmem.h Macros for memory allocation abstraction -perlproc.h Macros for process abstraction perlsdio.h Fake stdio using perlio perlsfio.h Prototype sfio mapping for PerlIO perlsh A poor man's perl shell -perlsock.h Macros for socket abstraction perlvars.h Global variables perly.c A byacc'ed perly.y perly.c.diff Fixup perly.c to allow recursion @@ -1009,6 +996,7 @@ win32/makefile.mk Win32 makefile for DMAKE (BC++, VC++ builds) win32/makemain.pl Win32 port win32/makeperldef.pl Win32 port win32/perlglob.c Win32 port +win32/perlhost.h Perl host implementation win32/perllib.c Win32 port win32/pod.mak Win32 port win32/runperl.c Win32 port diff --git a/ipdir.h b/ipdir.h deleted file mode 100644 index f0dadc411e..0000000000 --- a/ipdir.h +++ /dev/null @@ -1,60 +0,0 @@ -/* - - ipdir.h - Interface for perl directory functions - -*/ - - -/* - PerlXXX_YYY explained - DickH and DougL @ ActiveState.com - -XXX := functional group -YYY := stdlib/OS function name - -Continuing with the theme of PerlIO, all OS functionality was -encapsulated into one of several interfaces. - -PerlIO - stdio -PerlLIO - low level I/O -PerlMem - malloc, realloc, free -PerlDir - directory related -PerlEnv - process environment handling -PerlProc - process control -PerlSock - socket functions - - -The features of this are: -1. All OS dependant code is in the Perl Host and not the Perl Core. - (At least this is the holy grail goal of this work) -2. The Perl Host (see perl.h for description) can provide a new and - improved interface to OS functionality if required. -3. Developers can easily hook into the OS calls for instrumentation - or diagnostic purposes. - -What was changed to do this: -1. All calls to OS functions were replaced with PerlXXX_YYY - -*/ - - - -#ifndef __Inc__IPerlDir___ -#define __Inc__IPerlDir___ - -class IPerlDir -{ -public: - virtual int Makedir(const char *dirname, int mode, int &err) = 0; - virtual int Chdir(const char *dirname, int &err) = 0; - virtual int Rmdir(const char *dirname, int &err) = 0; - virtual int Close(DIR *dirp, int &err) = 0; - virtual DIR *Open(char *filename, int &err) = 0; - virtual struct direct *Read(DIR *dirp, int &err) = 0; - virtual void Rewind(DIR *dirp, int &err) = 0; - virtual void Seek(DIR *dirp, long loc, int &err) = 0; - virtual long Tell(DIR *dirp, int &err) = 0; -}; - -#endif /* __Inc__IPerlDir___ */ - diff --git a/ipenv.h b/ipenv.h deleted file mode 100644 index 30acffbeb8..0000000000 --- a/ipenv.h +++ /dev/null @@ -1,21 +0,0 @@ -/* - - ipenv.h - Interface for perl environment functions - -*/ - -#ifndef __Inc__IPerlEnv___ -#define __Inc__IPerlEnv___ - -class IPerlEnv -{ -public: - virtual char* Getenv(const char *varname, int &err) = 0; - virtual int Putenv(const char *envstring, int &err) = 0; - virtual char* LibPath(char *patchlevel) =0; - virtual char* SiteLibPath(char *patchlevel) =0; -}; - -#endif /* __Inc__IPerlEnv___ */ - diff --git a/iperlsys.h b/iperlsys.h new file mode 100644 index 0000000000..2febe6ea4e --- /dev/null +++ b/iperlsys.h @@ -0,0 +1,905 @@ +/* + * iperlsys.h - Perl's interface to the system + * + * This file defines the system level functionality that perl needs. + * + * When using C, this definition is in the form of a set of macros + * that can be #defined to the system-level function (or a wrapper + * provided elsewhere). + * + * When using C++ with -DPERL_OBJECT, this definition is in the + * form of a set of virtual base classes which must be subclassed to + * provide a real implementation. The Perl Object will use instances + * of this implementation to use the system-level functionality. + * + * GSAR 21-JUN-98 + */ + +#ifndef __Inc__IPerl___ +#define __Inc__IPerl___ + +/* + * PerlXXX_YYY explained - DickH and DougL @ ActiveState.com + * + * XXX := functional group + * YYY := stdlib/OS function name + * + * Continuing with the theme of PerlIO, all OS functionality was + * encapsulated into one of several interfaces. + * + * PerlIO - stdio + * PerlLIO - low level I/O + * PerlMem - malloc, realloc, free + * PerlDir - directory related + * PerlEnv - process environment handling + * PerlProc - process control + * PerlSock - socket functions + * + * + * The features of this are: + * 1. All OS dependant code is in the Perl Host and not the Perl Core. + * (At least this is the holy grail goal of this work) + * 2. The Perl Host (see perl.h for description) can provide a new and + * improved interface to OS functionality if required. + * 3. Developers can easily hook into the OS calls for instrumentation + * or diagnostic purposes. + * + * What was changed to do this: + * 1. All calls to OS functions were replaced with PerlXXX_YYY + * + */ + + +/* + Interface for perl stdio functions +*/ + + +/* Clean up (or at least document) the various possible #defines. + This section attempts to match the 5.003_03 Configure variables + onto the 5.003_02 header file values. + I can't figure out where USE_STDIO was supposed to be set. + --AD +*/ +#ifndef USE_PERLIO +# define PERLIO_IS_STDIO +#endif + +/* Below is the 5.003_02 stuff. */ +#ifdef USE_STDIO +# ifndef PERLIO_IS_STDIO +# define PERLIO_IS_STDIO +# endif +#else +extern void PerlIO_init _((void)); +#endif + +#ifdef PERL_OBJECT + +#ifndef PerlIO +typedef struct _PerlIO PerlIO; +#endif + +class IPerlStdIO +{ +public: + virtual PerlIO * Stdin(void) = 0; + virtual PerlIO * Stdout(void) = 0; + virtual PerlIO * Stderr(void) = 0; + virtual PerlIO * Open(const char *, const char *, int &err) = 0; + virtual int Close(PerlIO*, int &err) = 0; + virtual int Eof(PerlIO*, int &err) = 0; + virtual int Error(PerlIO*, int &err) = 0; + virtual void Clearerr(PerlIO*, int &err) = 0; + virtual int Getc(PerlIO*, int &err) = 0; + virtual char * GetBase(PerlIO *, int &err) = 0; + virtual int GetBufsiz(PerlIO *, int &err) = 0; + virtual int GetCnt(PerlIO *, int &err) = 0; + virtual char * GetPtr(PerlIO *, int &err) = 0; + virtual char * Gets(PerlIO*, char*, int, int& err) = 0; + virtual int Putc(PerlIO*, int, int &err) = 0; + virtual int Puts(PerlIO*, const char *, int &err) = 0; + virtual int Flush(PerlIO*, int &err) = 0; + virtual int Ungetc(PerlIO*,int, int &err) = 0; + virtual int Fileno(PerlIO*, int &err) = 0; + virtual PerlIO * Fdopen(int, const char *, int &err) = 0; + virtual PerlIO * Reopen(const char*, const char*, PerlIO*, int &err) = 0; + virtual SSize_t Read(PerlIO*,void *,Size_t, int &err) = 0; + virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err) = 0; + virtual void SetBuf(PerlIO *, char*, int &err) = 0; + virtual int SetVBuf(PerlIO *, char*, int, Size_t, int &err) = 0; + virtual void SetCnt(PerlIO *, int, int &err) = 0; + virtual void SetPtrCnt(PerlIO *, char *, int, int& err) = 0; + virtual void Setlinebuf(PerlIO*, int &err) = 0; + virtual int Printf(PerlIO*, int &err, const char *,...) = 0; + virtual int Vprintf(PerlIO*, int &err, const char *, va_list) = 0; + virtual long Tell(PerlIO*, int &err) = 0; + virtual int Seek(PerlIO*, off_t, int, int &err) = 0; + virtual void Rewind(PerlIO*, int &err) = 0; + virtual PerlIO * Tmpfile(int &err) = 0; + virtual int Getpos(PerlIO*, Fpos_t *, int &err) = 0; + virtual int Setpos(PerlIO*, const Fpos_t *, int &err) = 0; + virtual void Init(int &err) = 0; + virtual void InitOSExtras(void* p) = 0; +#ifdef WIN32 + virtual int OpenOSfhandle(long osfhandle, int flags) = 0; + virtual int GetOSfhandle(int filenum) = 0; +#endif +}; + +#define PerlIO_canset_cnt(f) 1 +#define PerlIO_has_base(f) 1 +#define PerlIO_has_cntptr(f) 1 +#define PerlIO_fast_gets(f) 1 + +#define PerlIO_stdin() piStdIO->Stdin() +#define PerlIO_stdout() piStdIO->Stdout() +#define PerlIO_stderr() piStdIO->Stderr() +#define PerlIO_open(x,y) piStdIO->Open((x),(y), ErrorNo()) +#define PerlIO_close(f) piStdIO->Close((f), ErrorNo()) +#define PerlIO_eof(f) piStdIO->Eof((f), ErrorNo()) +#define PerlIO_error(f) piStdIO->Error((f), ErrorNo()) +#define PerlIO_clearerr(f) piStdIO->Clearerr((f), ErrorNo()) +#define PerlIO_getc(f) piStdIO->Getc((f), ErrorNo()) +#define PerlIO_get_base(f) piStdIO->GetBase((f), ErrorNo()) +#define PerlIO_get_bufsiz(f) piStdIO->GetBufsiz((f), ErrorNo()) +#define PerlIO_get_cnt(f) piStdIO->GetCnt((f), ErrorNo()) +#define PerlIO_get_ptr(f) piStdIO->GetPtr((f), ErrorNo()) +#define PerlIO_putc(f,c) piStdIO->Putc((f),(c), ErrorNo()) +#define PerlIO_puts(f,s) piStdIO->Puts((f),(s), ErrorNo()) +#define PerlIO_flush(f) piStdIO->Flush((f), ErrorNo()) +#define PerlIO_gets(s, n, fp) piStdIO->Gets((fp), s, n, ErrorNo()) +#define PerlIO_ungetc(f,c) piStdIO->Ungetc((f),(c), ErrorNo()) +#define PerlIO_fileno(f) piStdIO->Fileno((f), ErrorNo()) +#define PerlIO_fdopen(f, s) piStdIO->Fdopen((f),(s), ErrorNo()) +#define PerlIO_reopen(p, m, f) piStdIO->Reopen((p), (m), (f), ErrorNo()) +#define PerlIO_read(f,buf,count) \ + (SSize_t)piStdIO->Read((f), (buf), (count), ErrorNo()) +#define PerlIO_write(f,buf,count) \ + piStdIO->Write((f), (buf), (count), ErrorNo()) +#define PerlIO_setbuf(f,b) piStdIO->SetBuf((f), (b), ErrorNo()) +#define PerlIO_setvbuf(f,b,t,s) piStdIO->SetVBuf((f), (b), (t), (s), ErrorNo()) +#define PerlIO_set_cnt(f,c) piStdIO->SetCnt((f), (c), ErrorNo()) +#define PerlIO_set_ptrcnt(f,p,c) \ + piStdIO->SetPtrCnt((f), (p), (c), ErrorNo()) +#define PerlIO_setlinebuf(f) piStdIO->Setlinebuf((f), ErrorNo()) +#define PerlIO_printf fprintf +#define PerlIO_stdoutf piStdIO->Printf +#define PerlIO_vprintf(f,fmt,a) piStdIO->Vprintf((f), ErrorNo(), (fmt),a) +#define PerlIO_tell(f) piStdIO->Tell((f), ErrorNo()) +#define PerlIO_seek(f,o,w) piStdIO->Seek((f),(o),(w), ErrorNo()) +#define PerlIO_getpos(f,p) piStdIO->Getpos((f),(p), ErrorNo()) +#define PerlIO_setpos(f,p) piStdIO->Setpos((f),(p), ErrorNo()) +#define PerlIO_rewind(f) piStdIO->Rewind((f), ErrorNo()) +#define PerlIO_tmpfile() piStdIO->Tmpfile(ErrorNo()) +#define PerlIO_init() piStdIO->Init(ErrorNo()) +#undef init_os_extras +#define init_os_extras() piStdIO->InitOSExtras(this) + +#else /* PERL_OBJECT */ + +#include "perlsdio.h" + +#endif /* PERL_OBJECT */ + +#ifndef PERLIO_IS_STDIO +#ifdef USE_SFIO +#include "perlsfio.h" +#endif /* USE_SFIO */ +#endif /* PERLIO_IS_STDIO */ + +#ifndef EOF +#define EOF (-1) +#endif + +/* This is to catch case with no stdio */ +#ifndef BUFSIZ +#define BUFSIZ 1024 +#endif + +#ifndef SEEK_SET +#define SEEK_SET 0 +#endif + +#ifndef SEEK_CUR +#define SEEK_CUR 1 +#endif + +#ifndef SEEK_END +#define SEEK_END 2 +#endif + +#ifndef PerlIO +struct _PerlIO; +#define PerlIO struct _PerlIO +#endif /* No PerlIO */ + +#ifndef Fpos_t +#define Fpos_t long +#endif + +#ifndef NEXT30_NO_ATTRIBUTE +#ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ +#ifdef __attribute__ /* Avoid possible redefinition errors */ +#undef __attribute__ +#endif +#define __attribute__(attr) +#endif +#endif + +#ifndef PerlIO_stdoutf +extern int PerlIO_stdoutf _((const char *,...)) + __attribute__((format (printf, 1, 2))); +#endif +#ifndef PerlIO_puts +extern int PerlIO_puts _((PerlIO *,const char *)); +#endif +#ifndef PerlIO_open +extern PerlIO * PerlIO_open _((const char *,const char *)); +#endif +#ifndef PerlIO_close +extern int PerlIO_close _((PerlIO *)); +#endif +#ifndef PerlIO_eof +extern int PerlIO_eof _((PerlIO *)); +#endif +#ifndef PerlIO_error +extern int PerlIO_error _((PerlIO *)); +#endif +#ifndef PerlIO_clearerr +extern void PerlIO_clearerr _((PerlIO *)); +#endif +#ifndef PerlIO_getc +extern int PerlIO_getc _((PerlIO *)); +#endif +#ifndef PerlIO_putc +extern int PerlIO_putc _((PerlIO *,int)); +#endif +#ifndef PerlIO_flush +extern int PerlIO_flush _((PerlIO *)); +#endif +#ifndef PerlIO_ungetc +extern int PerlIO_ungetc _((PerlIO *,int)); +#endif +#ifndef PerlIO_fileno +extern int PerlIO_fileno _((PerlIO *)); +#endif +#ifndef PerlIO_fdopen +extern PerlIO * PerlIO_fdopen _((int, const char *)); +#endif +#ifndef PerlIO_importFILE +extern PerlIO * PerlIO_importFILE _((FILE *,int)); +#endif +#ifndef PerlIO_exportFILE +extern FILE * PerlIO_exportFILE _((PerlIO *,int)); +#endif +#ifndef PerlIO_findFILE +extern FILE * PerlIO_findFILE _((PerlIO *)); +#endif +#ifndef PerlIO_releaseFILE +extern void PerlIO_releaseFILE _((PerlIO *,FILE *)); +#endif +#ifndef PerlIO_read +extern SSize_t PerlIO_read _((PerlIO *,void *,Size_t)); +#endif +#ifndef PerlIO_write +extern SSize_t PerlIO_write _((PerlIO *,const void *,Size_t)); +#endif +#ifndef PerlIO_setlinebuf +extern void PerlIO_setlinebuf _((PerlIO *)); +#endif +#ifndef PerlIO_printf +extern int PerlIO_printf _((PerlIO *, const char *,...)) + __attribute__((format (printf, 2, 3))); +#endif +#ifndef PerlIO_sprintf +extern int PerlIO_sprintf _((char *, int, const char *,...)) + __attribute__((format (printf, 3, 4))); +#endif +#ifndef PerlIO_vprintf +extern int PerlIO_vprintf _((PerlIO *, const char *, va_list)); +#endif +#ifndef PerlIO_tell +extern long PerlIO_tell _((PerlIO *)); +#endif +#ifndef PerlIO_seek +extern int PerlIO_seek _((PerlIO *,off_t,int)); +#endif +#ifndef PerlIO_rewind +extern void PerlIO_rewind _((PerlIO *)); +#endif +#ifndef PerlIO_has_base +extern int PerlIO_has_base _((PerlIO *)); +#endif +#ifndef PerlIO_has_cntptr +extern int PerlIO_has_cntptr _((PerlIO *)); +#endif +#ifndef PerlIO_fast_gets +extern int PerlIO_fast_gets _((PerlIO *)); +#endif +#ifndef PerlIO_canset_cnt +extern int PerlIO_canset_cnt _((PerlIO *)); +#endif +#ifndef PerlIO_get_ptr +extern STDCHAR * PerlIO_get_ptr _((PerlIO *)); +#endif +#ifndef PerlIO_get_cnt +extern int PerlIO_get_cnt _((PerlIO *)); +#endif +#ifndef PerlIO_set_cnt +extern void PerlIO_set_cnt _((PerlIO *,int)); +#endif +#ifndef PerlIO_set_ptrcnt +extern void PerlIO_set_ptrcnt _((PerlIO *,STDCHAR *,int)); +#endif +#ifndef PerlIO_get_base +extern STDCHAR * PerlIO_get_base _((PerlIO *)); +#endif +#ifndef PerlIO_get_bufsiz +extern int PerlIO_get_bufsiz _((PerlIO *)); +#endif +#ifndef PerlIO_tmpfile +extern PerlIO * PerlIO_tmpfile _((void)); +#endif +#ifndef PerlIO_stdin +extern PerlIO * PerlIO_stdin _((void)); +#endif +#ifndef PerlIO_stdout +extern PerlIO * PerlIO_stdout _((void)); +#endif +#ifndef PerlIO_stderr +extern PerlIO * PerlIO_stderr _((void)); +#endif +#ifndef PerlIO_getpos +extern int PerlIO_getpos _((PerlIO *,Fpos_t *)); +#endif +#ifndef PerlIO_setpos +extern int PerlIO_setpos _((PerlIO *,const Fpos_t *)); +#endif + + +/* + * Interface for directory functions + */ + +#ifdef PERL_OBJECT + +class IPerlDir +{ +public: + virtual int Makedir(const char *dirname, int mode, int &err) = 0; + virtual int Chdir(const char *dirname, int &err) = 0; + virtual int Rmdir(const char *dirname, int &err) = 0; + virtual int Close(DIR *dirp, int &err) = 0; + virtual DIR * Open(char *filename, int &err) = 0; + virtual struct direct *Read(DIR *dirp, int &err) = 0; + virtual void Rewind(DIR *dirp, int &err) = 0; + virtual void Seek(DIR *dirp, long loc, int &err) = 0; + virtual long Tell(DIR *dirp, int &err) = 0; +}; + +#define PerlDir_mkdir(name, mode) \ + piDir->Makedir((name), (mode), ErrorNo()) +#define PerlDir_chdir(name) \ + piDir->Chdir((name), ErrorNo()) +#define PerlDir_rmdir(name) \ + piDir->Rmdir((name), ErrorNo()) +#define PerlDir_close(dir) \ + piDir->Close((dir), ErrorNo()) +#define PerlDir_open(name) \ + piDir->Open((name), ErrorNo()) +#define PerlDir_read(dir) \ + piDir->Read((dir), ErrorNo()) +#define PerlDir_rewind(dir) \ + piDir->Rewind((dir), ErrorNo()) +#define PerlDir_seek(dir, loc) \ + piDir->Seek((dir), (loc), ErrorNo()) +#define PerlDir_tell(dir) \ + piDir->Tell((dir), ErrorNo()) + +#else /* PERL_OBJECT */ + +#define PerlDir_mkdir(name, mode) Mkdir((name), (mode)) +#ifdef VMS +# define PerlDir_chdir(n) chdir(((n) && *(n)) ? (n) : "SYS$LOGIN") +#else +# define PerlDir_chdir(name) chdir((name)) +#endif +#define PerlDir_rmdir(name) rmdir((name)) +#define PerlDir_close(dir) closedir((dir)) +#define PerlDir_open(name) opendir((name)) +#define PerlDir_read(dir) readdir((dir)) +#define PerlDir_rewind(dir) rewinddir((dir)) +#define PerlDir_seek(dir, loc) seekdir((dir), (loc)) +#define PerlDir_tell(dir) telldir((dir)) + +#endif /* PERL_OBJECT */ + +/* + Interface for perl environment functions +*/ + +#ifdef PERL_OBJECT + +class IPerlEnv +{ +public: + virtual char * Getenv(const char *varname, int &err) = 0; + virtual int Putenv(const char *envstring, int &err) = 0; + virtual char * LibPath(char *patchlevel) =0; + virtual char * SiteLibPath(char *patchlevel) =0; +}; + +#define PerlEnv_putenv(str) piENV->Putenv((str), ErrorNo()) +#define PerlEnv_getenv(str) piENV->Getenv((str), ErrorNo()) +#ifdef WIN32 +#define PerlEnv_lib_path(str) piENV->LibPath((str)) +#define PerlEnv_sitelib_path(str) piENV->SiteLibPath((str)) +#endif + +#else /* PERL_OBJECT */ + +#define PerlEnv_putenv(str) putenv((str)) +#define PerlEnv_getenv(str) getenv((str)) + +#endif /* PERL_OBJECT */ + +/* + Interface for perl low-level IO functions +*/ + +#ifdef PERL_OBJECT + +class IPerlLIO +{ +public: + virtual int Access(const char *path, int mode, int &err) = 0; + virtual int Chmod(const char *filename, int pmode, int &err) = 0; + virtual int Chown(const char *filename, uid_t owner, + gid_t group, int &err) = 0; + virtual int Chsize(int handle, long size, int &err) = 0; + virtual int Close(int handle, int &err) = 0; + virtual int Dup(int handle, int &err) = 0; + virtual int Dup2(int handle1, int handle2, int &err) = 0; + virtual int Flock(int fd, int oper, int &err) = 0; + virtual int FileStat(int handle, struct stat *buffer, int &err) = 0; + virtual int IOCtl(int i, unsigned int u, char *data, int &err) = 0; + virtual int Isatty(int handle, int &err) = 0; + virtual long Lseek(int handle, long offset, int origin, int &err) = 0; + virtual int Lstat(const char *path, struct stat *buffer, int &err) = 0; + virtual char * Mktemp(char *Template, int &err) = 0; + virtual int Open(const char *filename, int oflag, int &err) = 0; + virtual int Open(const char *filename, int oflag, + int pmode, int &err) = 0; + virtual int Read(int handle, void *buffer, + unsigned int count, int &err) = 0; + virtual int Rename(const char *oldname, + const char *newname, int &err) = 0; + virtual int Setmode(int handle, int mode, int &err) = 0; + virtual int NameStat(const char *path, + struct stat *buffer, int &err) = 0; + virtual char * Tmpnam(char *string, int &err) = 0; + virtual int Umask(int pmode, int &err) = 0; + virtual int Unlink(const char *filename, int &err) = 0; + virtual int Utime(char *filename, struct utimbuf *times, int &err) = 0; + virtual int Write(int handle, const void *buffer, + unsigned int count, int &err) = 0; +}; + +#define PerlLIO_access(file, mode) \ + piLIO->Access((file), (mode), ErrorNo()) +#define PerlLIO_chmod(file, mode) \ + piLIO->Chmod((file), (mode), ErrorNo()) +#define PerlLIO_chown(file, owner, group) \ + piLIO->Chown((file), (owner), (group), ErrorNo()) +#define PerlLIO_chsize(fd, size) \ + piLIO->Chsize((fd), (size), ErrorNo()) +#define PerlLIO_close(fd) \ + piLIO->Close((fd), ErrorNo()) +#define PerlLIO_dup(fd) \ + piLIO->Dup((fd), ErrorNo()) +#define PerlLIO_dup2(fd1, fd2) \ + piLIO->Dup2((fd1), (fd2), ErrorNo()) +#define PerlLIO_flock(fd, op) \ + piLIO->Flock((fd), (op), ErrorNo()) +#define PerlLIO_fstat(fd, buf) \ + piLIO->FileStat((fd), (buf), ErrorNo()) +#define PerlLIO_ioctl(fd, u, buf) \ + piLIO->IOCtl((fd), (u), (buf), ErrorNo()) +#define PerlLIO_isatty(fd) \ + piLIO->Isatty((fd), ErrorNo()) +#define PerlLIO_lseek(fd, offset, mode) \ + piLIO->Lseek((fd), (offset), (mode), ErrorNo()) +#define PerlLIO_lstat(name, buf) \ + piLIO->Lstat((name), (buf), ErrorNo()) +#define PerlLIO_mktemp(file) \ + piLIO->Mktemp((file), ErrorNo()) +#define PerlLIO_open(file, flag) \ + piLIO->Open((file), (flag), ErrorNo()) +#define PerlLIO_open3(file, flag, perm) \ + piLIO->Open((file), (flag), (perm), ErrorNo()) +#define PerlLIO_read(fd, buf, count) \ + piLIO->Read((fd), (buf), (count), ErrorNo()) +#define PerlLIO_rename(oldname, newname) \ + piLIO->Rename((oldname), (newname), ErrorNo()) +#define PerlLIO_setmode(fd, mode) \ + piLIO->Setmode((fd), (mode), ErrorNo()) +#define PerlLIO_stat(name, buf) \ + piLIO->NameStat((name), (buf), ErrorNo()) +#define PerlLIO_tmpnam(str) \ + piLIO->Tmpnam((str), ErrorNo()) +#define PerlLIO_umask(mode) \ + piLIO->Umask((mode), ErrorNo()) +#define PerlLIO_unlink(file) \ + piLIO->Unlink((file), ErrorNo()) +#define PerlLIO_utime(file, time) \ + piLIO->Utime((file), (time), ErrorNo()) +#define PerlLIO_write(fd, buf, count) \ + piLIO->Write((fd), (buf), (count), ErrorNo()) + +#else /* PERL_OBJECT */ + +#define PerlLIO_access(file, mode) access((file), (mode)) +#define PerlLIO_chmod(file, mode) chmod((file), (mode)) +#define PerlLIO_chown(file, owner, grp) chown((file), (owner), (grp)) +#define PerlLIO_chsize(fd, size) chsize((fd), (size)) +#define PerlLIO_close(fd) close((fd)) +#define PerlLIO_dup(fd) dup((fd)) +#define PerlLIO_dup2(fd1, fd2) dup2((fd1), (fd2)) +#define PerlLIO_flock(fd, op) FLOCK((fd), (op)) +#define PerlLIO_fstat(fd, buf) Fstat((fd), (buf)) +#define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf)) +#define PerlLIO_isatty(fd) isatty((fd)) +#define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode)) +#define PerlLIO_lstat(name, buf) lstat((name), (buf)) +#define PerlLIO_mktemp(file) mktemp((file)) +#define PerlLIO_mkstemp(file) mkstemp((file)) +#define PerlLIO_open(file, flag) open((file), (flag)) +#define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) +#define PerlLIO_read(fd, buf, count) read((fd), (buf), (count)) +#define PerlLIO_rename(old, new) rename((old), (new)) +#define PerlLIO_setmode(fd, mode) setmode((fd), (mode)) +#define PerlLIO_stat(name, buf) Stat((name), (buf)) +#define PerlLIO_tmpnam(str) tmpnam((str)) +#define PerlLIO_umask(mode) umask((mode)) +#define PerlLIO_unlink(file) unlink((file)) +#define PerlLIO_utime(file, time) utime((file), (time)) +#define PerlLIO_write(fd, buf, count) write((fd), (buf), (count)) + +#endif /* PERL_OBJECT */ + +/* + Interface for perl memory allocation +*/ + +#ifdef PERL_OBJECT + +class IPerlMem +{ +public: + virtual void * Malloc(size_t) = 0; + virtual void * Realloc(void*, size_t) = 0; + virtual void Free(void*) = 0; +}; + +#define PerlMem_malloc(size) piMem->Malloc((size)) +#define PerlMem_realloc(buf, size) piMem->Realloc((buf), (size)) +#define PerlMem_free(buf) piMem->Free((buf)) + +#else /* PERL_OBJECT */ + +#define PerlMem_malloc(size) malloc((size)) +#define PerlMem_realloc(buf, size) realloc((buf), (size)) +#define PerlMem_free(buf) free((buf)) + +#endif /* PERL_OBJECT */ + +/* + Interface for perl process functions +*/ + + +#ifdef PERL_OBJECT + +#ifndef Sighandler_t +typedef Signal_t (*Sighandler_t) _((int)); +#endif +#ifndef jmp_buf +#include <setjmp.h> +#endif + +class IPerlProc +{ +public: + virtual void Abort(void) = 0; + virtual void Exit(int status) = 0; + virtual void _Exit(int status) = 0; + virtual int Execl(const char *cmdname, const char *arg0, + const char *arg1, const char *arg2, + const char *arg3) = 0; + virtual int Execv(const char *cmdname, const char *const *argv) = 0; + virtual int Execvp(const char *cmdname, const char *const *argv) = 0; + virtual uid_t Getuid(void) = 0; + virtual uid_t Geteuid(void) = 0; + virtual gid_t Getgid(void) = 0; + virtual gid_t Getegid(void) = 0; + virtual char * Getlogin(void) = 0; + virtual int Kill(int pid, int sig) = 0; + virtual int Killpg(int pid, int sig) = 0; + virtual int PauseProc(void) = 0; + virtual PerlIO * Popen(const char *command, const char *mode) = 0; + virtual int Pclose(PerlIO *stream) = 0; + virtual int Pipe(int *phandles) = 0; + virtual int Setuid(uid_t uid) = 0; + virtual int Setgid(gid_t gid) = 0; + virtual int Sleep(unsigned int) = 0; + virtual int Times(struct tms *timebuf) = 0; + virtual int Wait(int *status) = 0; + virtual int Waitpid(int pid, int *status, int flags) = 0; + virtual Sighandler_t Signal(int sig, Sighandler_t subcode) = 0; +#ifdef WIN32 + virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr) = 0; + virtual void FreeBuf(char* msg) = 0; + virtual BOOL DoCmd(char *cmd) = 0; + virtual int Spawn(char*cmds) = 0; + virtual int Spawnvp(int mode, const char *cmdname, + const char *const *argv) = 0; + virtual int ASpawn(void *vreally, void **vmark, void **vsp) = 0; +#endif +}; + +#define PerlProc_abort() piProc->Abort() +#define PerlProc_exit(s) piProc->Exit((s)) +#define PerlProc__exit(s) piProc->_Exit((s)) +#define PerlProc_execl(c, w, x, y, z) \ + piProc->Execl((c), (w), (x), (y), (z)) + +#define PerlProc_execv(c, a) piProc->Execv((c), (a)) +#define PerlProc_execvp(c, a) piProc->Execvp((c), (a)) +#define PerlProc_getuid() piProc->Getuid() +#define PerlProc_geteuid() piProc->Geteuid() +#define PerlProc_getgid() piProc->Getgid() +#define PerlProc_getegid() piProc->Getegid() +#define PerlProc_getlogin() piProc->Getlogin() +#define PerlProc_kill(i, a) piProc->Kill((i), (a)) +#define PerlProc_killpg(i, a) piProc->Killpg((i), (a)) +#define PerlProc_pause() piProc->PauseProc() +#define PerlProc_popen(c, m) piProc->Popen((c), (m)) +#define PerlProc_pclose(f) piProc->Pclose((f)) +#define PerlProc_pipe(fd) piProc->Pipe((fd)) +#define PerlProc_setuid(u) piProc->Setuid((u)) +#define PerlProc_setgid(g) piProc->Setgid((g)) +#define PerlProc_sleep(t) piProc->Sleep((t)) +#define PerlProc_times(t) piProc->Times((t)) +#define PerlProc_wait(t) piProc->Wait((t)) +#define PerlProc_waitpid(p,s,f) piProc->Waitpid((p), (s), (f)) +#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) +#define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) +#define PerlProc_signal(n, h) piProc->Signal((n), (h)) + +#ifdef WIN32 +#define PerlProc_GetSysMsg(s,l,e) \ + piProc->GetSysMsg((s), (l), (e)) + +#define PerlProc_FreeBuf(s) piProc->FreeBuf((s)) +#define PerlProc_Cmd(s) piProc->DoCmd((s)) +#define do_spawn(s) piProc->Spawn((s)) +#define do_spawnvp(m, c, a) piProc->Spawnvp((m), (c), (a)) +#define PerlProc_aspawn(m,c,a) piProc->ASpawn((m), (c), (a)) +#endif + +#else /* PERL_OBJECT */ + +#define PerlProc_abort() abort() +#define PerlProc_exit(s) exit((s)) +#define PerlProc__exit(s) _exit((s)) +#define PerlProc_execl(c,w,x,y,z) \ + execl((c), (w), (x), (y), (z)) +#define PerlProc_execv(c, a) execv((c), (a)) +#define PerlProc_execvp(c, a) execvp((c), (a)) +#define PerlProc_getuid() getuid() +#define PerlProc_geteuid() geteuid() +#define PerlProc_getgid() getgid() +#define PerlProc_getegid() getegid() +#define PerlProc_getlogin() getlogin() +#define PerlProc_kill(i, a) kill((i), (a)) +#define PerlProc_killpg(i, a) killpg((i), (a)) +#define PerlProc_pause() Pause() +#define PerlProc_popen(c, m) my_popen((c), (m)) +#define PerlProc_pclose(f) my_pclose((f)) +#define PerlProc_pipe(fd) pipe((fd)) +#define PerlProc_setuid(u) setuid((u)) +#define PerlProc_setgid(g) setgid((g)) +#define PerlProc_sleep(t) sleep((t)) +#define PerlProc_times(t) times((t)) +#define PerlProc_wait(t) wait((t)) +#define PerlProc_waitpid(p,s,f) waitpid((p), (s), (f)) +#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) +#define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) +#define PerlProc_signal(n, h) signal((n), (h)) + + +#endif /* PERL_OBJECT */ + +/* + Interface for perl socket functions +*/ + +#ifdef PERL_OBJECT + +class IPerlSock +{ +public: + virtual u_long Htonl(u_long hostlong) = 0; + virtual u_short Htons(u_short hostshort) = 0; + virtual u_long Ntohl(u_long netlong) = 0; + virtual u_short Ntohs(u_short netshort) = 0; + virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, + int* addrlen, int &err) = 0; + virtual int Bind(SOCKET s, const struct sockaddr* name, + int namelen, int &err) = 0; + virtual int Connect(SOCKET s, const struct sockaddr* name, + int namelen, int &err) = 0; + virtual void Endhostent(int &err) = 0; + virtual void Endnetent(int &err) = 0; + virtual void Endprotoent(int &err) = 0; + virtual void Endservent(int &err) = 0; + virtual int Gethostname(char* name, int namelen, int &err) = 0; + virtual int Getpeername(SOCKET s, struct sockaddr* name, + int* namelen, int &err) = 0; + virtual struct hostent * Gethostbyaddr(const char* addr, int len, + int type, int &err) = 0; + virtual struct hostent * Gethostbyname(const char* name, int &err) = 0; + virtual struct hostent * Gethostent(int &err) = 0; + virtual struct netent * Getnetbyaddr(long net, int type, int &err) = 0; + virtual struct netent * Getnetbyname(const char *, int &err) = 0; + virtual struct netent * Getnetent(int &err) = 0; + virtual struct protoent * Getprotobyname(const char* name, int &err) = 0; + virtual struct protoent * Getprotobynumber(int number, int &err) = 0; + virtual struct protoent * Getprotoent(int &err) = 0; + virtual struct servent * Getservbyname(const char* name, + const char* proto, int &err) = 0; + virtual struct servent * Getservbyport(int port, const char* proto, + int &err) = 0; + virtual struct servent * Getservent(int &err) = 0; + virtual int Getsockname(SOCKET s, struct sockaddr* name, + int* namelen, int &err) = 0; + virtual int Getsockopt(SOCKET s, int level, int optname, + char* optval, int* optlen, int &err) = 0; + virtual unsigned long InetAddr(const char* cp, int &err) = 0; + virtual char * InetNtoa(struct in_addr in, int &err) = 0; + virtual int Listen(SOCKET s, int backlog, int &err) = 0; + virtual int Recv(SOCKET s, char* buf, int len, + int flags, int &err) = 0; + virtual int Recvfrom(SOCKET s, char* buf, int len, int flags, + struct sockaddr* from, int* fromlen, int &err) = 0; + virtual int Select(int nfds, char* readfds, char* writefds, + char* exceptfds, const struct timeval* timeout, + int &err) = 0; + virtual int Send(SOCKET s, const char* buf, int len, + int flags, int &err) = 0; + virtual int Sendto(SOCKET s, const char* buf, int len, int flags, + const struct sockaddr* to, int tolen, int &err) = 0; + virtual void Sethostent(int stayopen, int &err) = 0; + virtual void Setnetent(int stayopen, int &err) = 0; + virtual void Setprotoent(int stayopen, int &err) = 0; + virtual void Setservent(int stayopen, int &err) = 0; + virtual int Setsockopt(SOCKET s, int level, int optname, + const char* optval, int optlen, int &err) = 0; + virtual int Shutdown(SOCKET s, int how, int &err) = 0; + virtual SOCKET Socket(int af, int type, int protocol, int &err) = 0; + virtual int Socketpair(int domain, int type, int protocol, + int* fds, int &err) = 0; +#ifdef WIN32 + virtual int Closesocket(SOCKET s, int& err) = 0; + virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, + int& err) = 0; +#endif +}; + +#define PerlSock_htonl(x) piSock->Htonl(x) +#define PerlSock_htons(x) piSock->Htons(x) +#define PerlSock_ntohl(x) piSock->Ntohl(x) +#define PerlSock_ntohs(x) piSock->Ntohs(x) +#define PerlSock_accept(s, a, l) piSock->Accept(s, a, l, ErrorNo()) +#define PerlSock_bind(s, n, l) piSock->Bind(s, n, l, ErrorNo()) +#define PerlSock_connect(s, n, l) piSock->Connect(s, n, l, ErrorNo()) +#define PerlSock_endhostent() piSock->Endhostent(ErrorNo()) +#define PerlSock_endnetent() piSock->Endnetent(ErrorNo()) +#define PerlSock_endprotoent() piSock->Endprotoent(ErrorNo()) +#define PerlSock_endservent() piSock->Endservent(ErrorNo()) +#define PerlSock_gethostbyaddr(a, l, t) piSock->Gethostbyaddr(a, l, t, ErrorNo()) +#define PerlSock_gethostbyname(n) piSock->Gethostbyname(n, ErrorNo()) +#define PerlSock_gethostent() piSock->Gethostent(ErrorNo()) +#define PerlSock_gethostname(n, l) piSock->Gethostname(n, l, ErrorNo()) +#define PerlSock_getnetbyaddr(n, t) piSock->Getnetbyaddr(n, t, ErrorNo()) +#define PerlSock_getnetbyname(c) piSock->Getnetbyname(c, ErrorNo()) +#define PerlSock_getnetent() piSock->Getnetent(ErrorNo()) +#define PerlSock_getpeername(s, n, l) piSock->Getpeername(s, n, l, ErrorNo()) +#define PerlSock_getprotobyname(n) piSock->Getprotobyname(n, ErrorNo()) +#define PerlSock_getprotobynumber(n) piSock->Getprotobynumber(n, ErrorNo()) +#define PerlSock_getprotoent() piSock->Getprotoent(ErrorNo()) +#define PerlSock_getservbyname(n, p) piSock->Getservbyname(n, p, ErrorNo()) +#define PerlSock_getservbyport(port, p) piSock->Getservbyport(port, p, ErrorNo()) +#define PerlSock_getservent() piSock->Getservent(ErrorNo()) +#define PerlSock_getsockname(s, n, l) piSock->Getsockname(s, n, l, ErrorNo()) +#define PerlSock_getsockopt(s,l,n,v,i) piSock->Getsockopt(s, l, n, v, i, ErrorNo()) +#define PerlSock_inet_addr(c) piSock->InetAddr(c, ErrorNo()) +#define PerlSock_inet_ntoa(i) piSock->InetNtoa(i, ErrorNo()) +#define PerlSock_listen(s, b) piSock->Listen(s, b, ErrorNo()) +#define PerlSock_recv(s, b, l, f) piSock->Recv(s, b, l, f, ErrorNo()) +#define PerlSock_recvfrom(s,b,l,f,from,fromlen) \ + piSock->Recvfrom(s, b, l, f, from, fromlen, ErrorNo()) +#define PerlSock_select(n, r, w, e, t) \ + piSock->Select(n, (char*)r, (char*)w, (char*)e, t, ErrorNo()) +#define PerlSock_send(s, b, l, f) piSock->Send(s, b, l, f, ErrorNo()) +#define PerlSock_sendto(s, b, l, f, t, tlen) \ + piSock->Sendto(s, b, l, f, t, tlen, ErrorNo()) +#define PerlSock_sethostent(f) piSock->Sethostent(f, ErrorNo()) +#define PerlSock_setnetent(f) piSock->Setnetent(f, ErrorNo()) +#define PerlSock_setprotoent(f) piSock->Setprotoent(f, ErrorNo()) +#define PerlSock_setservent(f) piSock->Setservent(f, ErrorNo()) +#define PerlSock_setsockopt(s, l, n, v, len) \ + piSock->Setsockopt(s, l, n, v, len, ErrorNo()) +#define PerlSock_shutdown(s, h) piSock->Shutdown(s, h, ErrorNo()) +#define PerlSock_socket(a, t, p) piSock->Socket(a, t, p, ErrorNo()) +#define PerlSock_socketpair(a, t, p, f) piSock->Socketpair(a, t, p, f, ErrorNo()) + +#else /* PERL_OBJECT */ + +#define PerlSock_htonl(x) htonl(x) +#define PerlSock_htons(x) htons(x) +#define PerlSock_ntohl(x) ntohl(x) +#define PerlSock_ntohs(x) ntohs(x) +#define PerlSock_accept(s, a, l) accept(s, a, l) +#define PerlSock_bind(s, n, l) bind(s, n, l) +#define PerlSock_connect(s, n, l) connect(s, n, l) + +#define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr(a, l, t) +#define PerlSock_gethostbyname(n) gethostbyname(n) +#define PerlSock_gethostent gethostent +#define PerlSock_endhostent endhostent +#define PerlSock_gethostname(n, l) gethostname(n, l) + +#define PerlSock_getnetbyaddr(n, t) getnetbyaddr(n, t) +#define PerlSock_getnetbyname(n) getnetbyname(n) +#define PerlSock_getnetent getnetent +#define PerlSock_endnetent endnetent +#define PerlSock_getpeername(s, n, l) getpeername(s, n, l) + +#define PerlSock_getprotobyname(n) getprotobyname(n) +#define PerlSock_getprotobynumber(n) getprotobynumber(n) +#define PerlSock_getprotoent getprotoent +#define PerlSock_endprotoent endprotoent + +#define PerlSock_getservbyname(n, p) getservbyname(n, p) +#define PerlSock_getservbyport(port, p) getservbyport(port, p) +#define PerlSock_getservent getservent +#define PerlSock_endservent endservent + +#define PerlSock_getsockname(s, n, l) getsockname(s, n, l) +#define PerlSock_getsockopt(s,l,n,v,i) getsockopt(s, l, n, v, i) +#define PerlSock_inet_addr(c) inet_addr(c) +#define PerlSock_inet_ntoa(i) inet_ntoa(i) +#define PerlSock_listen(s, b) listen(s, b) +#define PerlSock_recvfrom(s, b, l, f, from, fromlen) \ + recvfrom(s, b, l, f, from, fromlen) +#define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t) +#define PerlSock_send(s, b, l, f) send(s, b, l, f) +#define PerlSock_sendto(s, b, l, f, t, tlen) \ + sendto(s, b, l, f, t, tlen) +#define PerlSock_sethostent(f) sethostent(f) +#define PerlSock_setnetent(f) setnetent(f) +#define PerlSock_setprotoent(f) setprotoent(f) +#define PerlSock_setservent(f) setservent(f) +#define PerlSock_setsockopt(s, l, n, v, len) \ + setsockopt(s, l, n, v, len) +#define PerlSock_shutdown(s, h) shutdown(s, h) +#define PerlSock_socket(a, t, p) socket(a, t, p) +#define PerlSock_socketpair(a, t, p, f) socketpair(a, t, p, f) + + +#endif /* PERL_OBJECT */ + +#endif /* __Inc__IPerl___ */ + diff --git a/iplio.h b/iplio.h deleted file mode 100644 index 0c5455f116..0000000000 --- a/iplio.h +++ /dev/null @@ -1,41 +0,0 @@ -/* - - iplio.h - Interface for perl Low IO functions - -*/ - -#ifndef __Inc__IPerlLIO___ -#define __Inc__IPerlLIO___ - -class IPerlLIO -{ -public: - virtual int Access(const char *path, int mode, int &err) = 0; - virtual int Chmod(const char *filename, int pmode, int &err) = 0; - virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err) = 0; - virtual int Chsize(int handle, long size, int &err) = 0; - virtual int Close(int handle, int &err) = 0; - virtual int Dup(int handle, int &err) = 0; - virtual int Dup2(int handle1, int handle2, int &err) = 0; - virtual int Flock(int fd, int oper, int &err) = 0; - virtual int FileStat(int handle, struct stat *buffer, int &err) = 0; - virtual int IOCtl(int i, unsigned int u, char *data, int &err) = 0; - virtual int Isatty(int handle, int &err) = 0; - virtual long Lseek(int handle, long offset, int origin, int &err) = 0; - virtual int Lstat(const char *path, struct stat *buffer, int &err) = 0; - virtual char *Mktemp(char *Template, int &err) = 0; - virtual int Open(const char *filename, int oflag, int &err) = 0; - virtual int Open(const char *filename, int oflag, int pmode, int &err) = 0; - virtual int Read(int handle, void *buffer, unsigned int count, int &err) = 0; - virtual int Rename(const char *oldname, const char *newname, int &err) = 0; - virtual int Setmode(int handle, int mode, int &err) = 0; - virtual int NameStat(const char *path, struct stat *buffer, int &err) = 0; - virtual char *Tmpnam(char *string, int &err) = 0; - virtual int Umask(int pmode, int &err) = 0; - virtual int Unlink(const char *filename, int &err) = 0; - virtual int Utime(char *filename, struct utimbuf *times, int &err) = 0; - virtual int Write(int handle, const void *buffer, unsigned int count, int &err) = 0; -}; - -#endif /* __Inc__IPerlLIO___ */ diff --git a/ipmem.h b/ipmem.h deleted file mode 100644 index 0554cf5f95..0000000000 --- a/ipmem.h +++ /dev/null @@ -1,20 +0,0 @@ -/* - - ipmem.h - Interface for perl memory allocation - -*/ - -#ifndef __Inc__IPerlMem___ -#define __Inc__IPerlMem___ - -class IPerlMem -{ -public: - virtual void* Malloc(size_t) = 0; - virtual void* Realloc(void*, size_t) = 0; - virtual void Free(void*) = 0; -}; - -#endif /* __Inc__IPerlMem___ */ - diff --git a/ipproc.h b/ipproc.h deleted file mode 100644 index 0395b5bcd2..0000000000 --- a/ipproc.h +++ /dev/null @@ -1,56 +0,0 @@ -/* - - ipproc.h - Interface for perl process functions - -*/ - -#ifndef __Inc__IPerlProc___ -#define __Inc__IPerlProc___ - -#ifndef Sighandler_t -typedef Signal_t (*Sighandler_t) _((int)); -#endif -#ifndef jmp_buf -#include <setjmp.h> -#endif - -class IPerlProc -{ -public: - virtual void Abort(void) = 0; - virtual void Exit(int status) = 0; - virtual void _Exit(int status) = 0; - virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) = 0; - virtual int Execv(const char *cmdname, const char *const *argv) = 0; - virtual int Execvp(const char *cmdname, const char *const *argv) = 0; - virtual uid_t Getuid(void) = 0; - virtual uid_t Geteuid(void) = 0; - virtual gid_t Getgid(void) = 0; - virtual gid_t Getegid(void) = 0; - virtual char *Getlogin(void) = 0; - virtual int Kill(int pid, int sig) = 0; - virtual int Killpg(int pid, int sig) = 0; - virtual int PauseProc(void) = 0; - virtual PerlIO* Popen(const char *command, const char *mode) = 0; - virtual int Pclose(PerlIO *stream) = 0; - virtual int Pipe(int *phandles) = 0; - virtual int Setuid(uid_t uid) = 0; - virtual int Setgid(gid_t gid) = 0; - virtual int Sleep(unsigned int) = 0; - virtual int Times(struct tms *timebuf) = 0; - virtual int Wait(int *status) = 0; - virtual int Waitpid(int pid, int *status, int flags) = 0; - virtual Sighandler_t Signal(int sig, Sighandler_t subcode) = 0; -#ifdef WIN32 - virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr) = 0; - virtual void FreeBuf(char* msg) = 0; - virtual BOOL DoCmd(char *cmd) = 0; - virtual int Spawn(char*cmds) = 0; - virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv) = 0; - virtual int ASpawn(void *vreally, void **vmark, void **vsp) = 0; -#endif -}; - -#endif /* __Inc__IPerlProc___ */ - diff --git a/ipsock.h b/ipsock.h deleted file mode 100644 index 1875d5669f..0000000000 --- a/ipsock.h +++ /dev/null @@ -1,64 +0,0 @@ -/* - - ipsock.h - Interface for perl socket functions - -*/ - -#ifndef __Inc__IPerlSock___ -#define __Inc__IPerlSock___ - -class IPerlSock -{ -public: - virtual u_long Htonl(u_long hostlong) = 0; - virtual u_short Htons(u_short hostshort) = 0; - virtual u_long Ntohl(u_long netlong) = 0; - virtual u_short Ntohs(u_short netshort) = 0; - virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) = 0; - virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err) = 0; - virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err) = 0; - virtual void Endhostent(int &err) = 0; - virtual void Endnetent(int &err) = 0; - virtual void Endprotoent(int &err) = 0; - virtual void Endservent(int &err) = 0; - virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err) = 0; - virtual struct hostent* Gethostbyname(const char* name, int &err) = 0; - virtual struct hostent* Gethostent(int &err) = 0; - virtual int Gethostname(char* name, int namelen, int &err) = 0; - virtual struct netent *Getnetbyaddr(long net, int type, int &err) = 0; - virtual struct netent *Getnetbyname(const char *, int &err) = 0; - virtual struct netent *Getnetent(int &err) = 0; - virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err) = 0; - virtual struct protoent* Getprotobyname(const char* name, int &err) = 0; - virtual struct protoent* Getprotobynumber(int number, int &err) = 0; - virtual struct protoent* Getprotoent(int &err) = 0; - virtual struct servent* Getservbyname(const char* name, const char* proto, int &err) = 0; - virtual struct servent* Getservbyport(int port, const char* proto, int &err) = 0; - virtual struct servent* Getservent(int &err) = 0; - virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err) = 0; - virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err) = 0; - virtual unsigned long InetAddr(const char* cp, int &err) = 0; - virtual char* InetNtoa(struct in_addr in, int &err) = 0; - virtual int Listen(SOCKET s, int backlog, int &err) = 0; - virtual int Recv(SOCKET s, char* buf, int len, int flags, int &err) = 0; - virtual int Recvfrom(SOCKET s, char* buf, int len, int flags, struct sockaddr* from, int* fromlen, int &err) = 0; - virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err) = 0; - virtual int Send(SOCKET s, const char* buf, int len, int flags, int &err) = 0; - virtual int Sendto(SOCKET s, const char* buf, int len, int flags, const struct sockaddr* to, int tolen, int &err) = 0; - virtual void Sethostent(int stayopen, int &err) = 0; - virtual void Setnetent(int stayopen, int &err) = 0; - virtual void Setprotoent(int stayopen, int &err) = 0; - virtual void Setservent(int stayopen, int &err) = 0; - virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err) = 0; - virtual int Shutdown(SOCKET s, int how, int &err) = 0; - virtual SOCKET Socket(int af, int type, int protocol, int &err) = 0; - virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err) = 0; -#ifdef WIN32 - virtual int Closesocket(SOCKET s, int& err) = 0; - virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err) = 0; -#endif -}; - -#endif /* __Inc__IPerlSock___ */ - diff --git a/ipstdio.h b/ipstdio.h deleted file mode 100644 index d639aca072..0000000000 --- a/ipstdio.h +++ /dev/null @@ -1,63 +0,0 @@ -/* - - ipstdio.h - Interface for perl stdio functions - -*/ - -#ifndef __Inc__IPerlStdIO___ -#define __Inc__IPerlStdIO___ - -#ifndef PerlIO -typedef struct _PerlIO PerlIO; -#endif - -class IPerlStdIO -{ -public: - virtual PerlIO* Stdin(void) = 0; - virtual PerlIO* Stdout(void) = 0; - virtual PerlIO* Stderr(void) = 0; - virtual PerlIO* Open(const char *, const char *, int &err) = 0; - virtual int Close(PerlIO*, int &err) = 0; - virtual int Eof(PerlIO*, int &err) = 0; - virtual int Error(PerlIO*, int &err) = 0; - virtual void Clearerr(PerlIO*, int &err) = 0; - virtual int Getc(PerlIO*, int &err) = 0; - virtual char* GetBase(PerlIO *, int &err) = 0; - virtual int GetBufsiz(PerlIO *, int &err) = 0; - virtual int GetCnt(PerlIO *, int &err) = 0; - virtual char* GetPtr(PerlIO *, int &err) = 0; - virtual char* Gets(PerlIO*, char*, int, int& err) = 0; - virtual int Putc(PerlIO*, int, int &err) = 0; - virtual int Puts(PerlIO*, const char *, int &err) = 0; - virtual int Flush(PerlIO*, int &err) = 0; - virtual int Ungetc(PerlIO*,int, int &err) = 0; - virtual int Fileno(PerlIO*, int &err) = 0; - virtual PerlIO* Fdopen(int, const char *, int &err) = 0; - virtual PerlIO* Reopen(const char*, const char*, PerlIO*, int &err) = 0; - virtual SSize_t Read(PerlIO*,void *,Size_t, int &err) = 0; - virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err) = 0; - virtual void SetBuf(PerlIO *, char*, int &err) = 0; - virtual int SetVBuf(PerlIO *, char*, int, Size_t, int &err) = 0; - virtual void SetCnt(PerlIO *, int, int &err) = 0; - virtual void SetPtrCnt(PerlIO *, char *, int, int& err) = 0; - virtual void Setlinebuf(PerlIO*, int &err) = 0; - virtual int Printf(PerlIO*, int &err, const char *,...) = 0; - virtual int Vprintf(PerlIO*, int &err, const char *, va_list) = 0; - virtual long Tell(PerlIO*, int &err) = 0; - virtual int Seek(PerlIO*, off_t, int, int &err) = 0; - virtual void Rewind(PerlIO*, int &err) = 0; - virtual PerlIO* Tmpfile(int &err) = 0; - virtual int Getpos(PerlIO*, Fpos_t *, int &err) = 0; - virtual int Setpos(PerlIO*, const Fpos_t *, int &err) = 0; - virtual void Init(int &err) = 0; - virtual void InitOSExtras(void* p) = 0; -#ifdef WIN32 - virtual int OpenOSfhandle(long osfhandle, int flags) = 0; - virtual int GetOSfhandle(int filenum) = 0; -#endif -}; - -#endif /* __Inc__IPerlStdIO___ */ - @@ -7,6 +7,9 @@ * */ +#ifdef STRUCT_MGVTBL_DEFINITION +STRUCT_MGVTBL_DEFINITION; +#else struct mgvtbl { int (CPERLscope(*svt_get)) _((SV *sv, MAGIC* mg)); int (CPERLscope(*svt_set)) _((SV *sv, MAGIC* mg)); @@ -14,6 +17,7 @@ struct mgvtbl { int (CPERLscope(*svt_clear)) _((SV *sv, MAGIC* mg)); int (CPERLscope(*svt_free)) _((SV *sv, MAGIC* mg)); }; +#endif struct magic { MAGIC* mg_moremagic; @@ -32,6 +32,9 @@ typedef U32 PADOFFSET; #define OPCODE U16 #endif +#ifdef BASEOP_DEFINITION +#define BASEOP BASEOP_DEFINITION +#else #define BASEOP \ OP* op_next; \ OP* op_sibling; \ @@ -41,6 +44,7 @@ typedef U32 PADOFFSET; U16 op_seq; \ U8 op_flags; \ U8 op_private; +#endif #define OP_GIMME(op,dfl) \ (((op)->op_flags & OPf_WANT) == OPf_WANT_VOID ? G_VOID : \ @@ -90,8 +90,8 @@ are local to a function. PERL HOST 1. The perl host is linked with perlX.lib to get perl_alloc. This function will return a pointer to CPerlObj (the PERL_OBJECT). It -takes pointers to the various PerlXXX_YYY interfaces (see ipdir.h for -information on this). +takes pointers to the various PerlXXX_YYY interfaces (see iperlsys.h +for more information on this). 2. The perl host calls the same functions as normally would be called in setting up and running a perl script, except that the functions are now member functions of the PERL_OBJECT. @@ -312,13 +312,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); # endif #endif -#include "perlio.h" -#include "perlmem.h" -#include "perllio.h" -#include "perlsock.h" -#include "perlproc.h" -#include "perlenv.h" -#include "perldir.h" +#include "iperlsys.h" #ifdef USE_NEXT_CTYPE @@ -1207,17 +1201,17 @@ typedef pthread_key_t perl_key; # endif #endif +#ifdef UNION_ANY_DEFINITION +UNION_ANY_DEFINITION; +#else union any { void* any_ptr; I32 any_i32; IV any_iv; long any_long; void (CPERLscope(*any_dptr)) _((void*)); -#if defined(WIN32) && !defined(PERL_OBJECT) - /* Visual C thinks that a pointer to a member variable is 16 bytes in size. */ - char handle_VC_problem[16]; -#endif }; +#endif #ifdef USE_THREADS #define ARGSproto struct perl_thread *thr diff --git a/perldir.h b/perldir.h deleted file mode 100644 index 0272bac1c8..0000000000 --- a/perldir.h +++ /dev/null @@ -1,34 +0,0 @@ -#ifndef H_PERLDIR -#define H_PERLDIR 1 - -#ifdef PERL_OBJECT - -#include "ipdir.h" - -#define PerlDir_mkdir(name, mode) piDir->Makedir((name), (mode), ErrorNo()) -#define PerlDir_chdir(name) piDir->Chdir((name), ErrorNo()) -#define PerlDir_rmdir(name) piDir->Rmdir((name), ErrorNo()) -#define PerlDir_close(dir) piDir->Close((dir), ErrorNo()) -#define PerlDir_open(name) piDir->Open((name), ErrorNo()) -#define PerlDir_read(dir) piDir->Read((dir), ErrorNo()) -#define PerlDir_rewind(dir) piDir->Rewind((dir), ErrorNo()) -#define PerlDir_seek(dir, loc) piDir->Seek((dir), (loc), ErrorNo()) -#define PerlDir_tell(dir) piDir->Tell((dir), ErrorNo()) -#else -#define PerlDir_mkdir(name, mode) Mkdir((name), (mode)) -#ifdef VMS -# define PerlDir_chdir(name) chdir(((name) && *(name)) ? (name) : "SYS$LOGIN") -#else -# define PerlDir_chdir(name) chdir((name)) -#endif -#define PerlDir_rmdir(name) rmdir((name)) -#define PerlDir_close(dir) closedir((dir)) -#define PerlDir_open(name) opendir((name)) -#define PerlDir_read(dir) readdir((dir)) -#define PerlDir_rewind(dir) rewinddir((dir)) -#define PerlDir_seek(dir, loc) seekdir((dir), (loc)) -#define PerlDir_tell(dir) telldir((dir)) -#endif /* PERL_OBJECT */ - -#endif /* Include guard */ - diff --git a/perlenv.h b/perlenv.h deleted file mode 100644 index 07cce76e78..0000000000 --- a/perlenv.h +++ /dev/null @@ -1,19 +0,0 @@ -#ifndef H_PERLENV -#define H_PERLENV 1 - -#ifdef PERL_OBJECT - -#include "ipenv.h" - -#define PerlEnv_putenv(str) piENV->Putenv((str), ErrorNo()) -#define PerlEnv_getenv(str) piENV->Getenv((str), ErrorNo()) -#ifdef WIN32 -#define PerlEnv_lib_path(str) piENV->LibPath((str)) -#define PerlEnv_sitelib_path(str) piENV->SiteLibPath((str)) -#endif -#else -#define PerlEnv_putenv(str) putenv((str)) -#define PerlEnv_getenv(str) getenv((str)) -#endif /* PERL_OBJECT */ - -#endif /* Include guard */ @@ -16,7 +16,7 @@ #endif /* * This file provides those parts of PerlIO abstraction - * which are not #defined in perlio.h. + * which are not #defined in iperlsys.h. * Which these are depends on various Configure #ifdef's */ diff --git a/perlio.h b/perlio.h deleted file mode 100644 index 8d453a5977..0000000000 --- a/perlio.h +++ /dev/null @@ -1,251 +0,0 @@ -#ifndef H_PERLIO -#define H_PERLIO 1 - -/* Clean up (or at least document) the various possible #defines. - This section attempts to match the 5.003_03 Configure variables - onto the 5.003_02 header file values. - I can't figure out where USE_STDIO was supposed to be set. - --AD -*/ -#ifndef USE_PERLIO -# define PERLIO_IS_STDIO -#endif - -/* Below is the 5.003_02 stuff. */ -#ifdef USE_STDIO -# ifndef PERLIO_IS_STDIO -# define PERLIO_IS_STDIO -# endif -#else -extern void PerlIO_init _((void)); -#endif - -#ifdef PERL_OBJECT - -#include "ipstdio.h" - -#define PerlIO_canset_cnt(f) 1 -#define PerlIO_has_base(f) 1 -#define PerlIO_has_cntptr(f) 1 -#define PerlIO_fast_gets(f) 1 - -#define PerlIO_stdin() piStdIO->Stdin() -#define PerlIO_stdout() piStdIO->Stdout() -#define PerlIO_stderr() piStdIO->Stderr() -#define PerlIO_open(x,y) piStdIO->Open((x),(y), ErrorNo()) -#define PerlIO_close(f) piStdIO->Close((f), ErrorNo()) -#define PerlIO_eof(f) piStdIO->Eof((f), ErrorNo()) -#define PerlIO_error(f) piStdIO->Error((f), ErrorNo()) -#define PerlIO_clearerr(f) piStdIO->Clearerr((f), ErrorNo()) -#define PerlIO_getc(f) piStdIO->Getc((f), ErrorNo()) -#define PerlIO_get_base(f) piStdIO->GetBase((f), ErrorNo()) -#define PerlIO_get_bufsiz(f) piStdIO->GetBufsiz((f), ErrorNo()) -#define PerlIO_get_cnt(f) piStdIO->GetCnt((f), ErrorNo()) -#define PerlIO_get_ptr(f) piStdIO->GetPtr((f), ErrorNo()) -#define PerlIO_putc(f,c) piStdIO->Putc((f),(c), ErrorNo()) -#define PerlIO_puts(f,s) piStdIO->Puts((f),(s), ErrorNo()) -#define PerlIO_flush(f) piStdIO->Flush((f), ErrorNo()) -#define PerlIO_gets(s, n, fp) piStdIO->Gets((fp), s, n, ErrorNo()) -#define PerlIO_ungetc(f,c) piStdIO->Ungetc((f),(c), ErrorNo()) -#define PerlIO_fileno(f) piStdIO->Fileno((f), ErrorNo()) -#define PerlIO_fdopen(f, s) piStdIO->Fdopen((f),(s), ErrorNo()) -#define PerlIO_reopen(p, m, f) piStdIO->Reopen((p), (m), (f), ErrorNo()) -#define PerlIO_read(f,buf,count) (SSize_t)piStdIO->Read((f), (buf), (count), ErrorNo()) -#define PerlIO_write(f,buf,count) piStdIO->Write((f), (buf), (count), ErrorNo()) -#define PerlIO_setbuf(f,b) piStdIO->SetBuf((f), (b), ErrorNo()) -#define PerlIO_setvbuf(f,b,t,s) piStdIO->SetVBuf((f), (b), (t), (s), ErrorNo()) -#define PerlIO_set_cnt(f,c) piStdIO->SetCnt((f), (c), ErrorNo()) -#define PerlIO_set_ptrcnt(f,p,c) piStdIO->SetPtrCnt((f), (p), (c), ErrorNo()) -#define PerlIO_setlinebuf(f) piStdIO->Setlinebuf((f), ErrorNo()) -#define PerlIO_printf fprintf -#define PerlIO_stdoutf piStdIO->Printf -#define PerlIO_vprintf(f,fmt,a) piStdIO->Vprintf((f), ErrorNo(), (fmt),a) -#define PerlIO_tell(f) piStdIO->Tell((f), ErrorNo()) -#define PerlIO_seek(f,o,w) piStdIO->Seek((f),(o),(w), ErrorNo()) -#define PerlIO_getpos(f,p) piStdIO->Getpos((f),(p), ErrorNo()) -#define PerlIO_setpos(f,p) piStdIO->Setpos((f),(p), ErrorNo()) -#define PerlIO_rewind(f) piStdIO->Rewind((f), ErrorNo()) -#define PerlIO_tmpfile() piStdIO->Tmpfile(ErrorNo()) -#define PerlIO_init() piStdIO->Init(ErrorNo()) -#undef init_os_extras -#define init_os_extras() piStdIO->InitOSExtras(this) - -#else -#include "perlsdio.h" -#endif - -#ifndef PERLIO_IS_STDIO -#ifdef USE_SFIO -#include "perlsfio.h" -#endif /* USE_SFIO */ -#endif /* PERLIO_IS_STDIO */ - -#ifndef EOF -#define EOF (-1) -#endif - -/* This is to catch case with no stdio */ -#ifndef BUFSIZ -#define BUFSIZ 1024 -#endif - -#ifndef SEEK_SET -#define SEEK_SET 0 -#endif - -#ifndef SEEK_CUR -#define SEEK_CUR 1 -#endif - -#ifndef SEEK_END -#define SEEK_END 2 -#endif - -#ifndef PerlIO -struct _PerlIO; -#define PerlIO struct _PerlIO -#endif /* No PerlIO */ - -#ifndef Fpos_t -#define Fpos_t long -#endif - -#ifndef NEXT30_NO_ATTRIBUTE -#ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ -#ifdef __attribute__ /* Avoid possible redefinition errors */ -#undef __attribute__ -#endif -#define __attribute__(attr) -#endif -#endif - -#ifndef PerlIO_stdoutf -extern int PerlIO_stdoutf _((const char *,...)) - __attribute__((format (printf, 1, 2))); -#endif -#ifndef PerlIO_puts -extern int PerlIO_puts _((PerlIO *,const char *)); -#endif -#ifndef PerlIO_open -extern PerlIO * PerlIO_open _((const char *,const char *)); -#endif -#ifndef PerlIO_close -extern int PerlIO_close _((PerlIO *)); -#endif -#ifndef PerlIO_eof -extern int PerlIO_eof _((PerlIO *)); -#endif -#ifndef PerlIO_error -extern int PerlIO_error _((PerlIO *)); -#endif -#ifndef PerlIO_clearerr -extern void PerlIO_clearerr _((PerlIO *)); -#endif -#ifndef PerlIO_getc -extern int PerlIO_getc _((PerlIO *)); -#endif -#ifndef PerlIO_putc -extern int PerlIO_putc _((PerlIO *,int)); -#endif -#ifndef PerlIO_flush -extern int PerlIO_flush _((PerlIO *)); -#endif -#ifndef PerlIO_ungetc -extern int PerlIO_ungetc _((PerlIO *,int)); -#endif -#ifndef PerlIO_fileno -extern int PerlIO_fileno _((PerlIO *)); -#endif -#ifndef PerlIO_fdopen -extern PerlIO * PerlIO_fdopen _((int, const char *)); -#endif -#ifndef PerlIO_importFILE -extern PerlIO * PerlIO_importFILE _((FILE *,int)); -#endif -#ifndef PerlIO_exportFILE -extern FILE * PerlIO_exportFILE _((PerlIO *,int)); -#endif -#ifndef PerlIO_findFILE -extern FILE * PerlIO_findFILE _((PerlIO *)); -#endif -#ifndef PerlIO_releaseFILE -extern void PerlIO_releaseFILE _((PerlIO *,FILE *)); -#endif -#ifndef PerlIO_read -extern SSize_t PerlIO_read _((PerlIO *,void *,Size_t)); -#endif -#ifndef PerlIO_write -extern SSize_t PerlIO_write _((PerlIO *,const void *,Size_t)); -#endif -#ifndef PerlIO_setlinebuf -extern void PerlIO_setlinebuf _((PerlIO *)); -#endif -#ifndef PerlIO_printf -extern int PerlIO_printf _((PerlIO *, const char *,...)) - __attribute__((format (printf, 2, 3))); -#endif -#ifndef PerlIO_sprintf -extern int PerlIO_sprintf _((char *, int, const char *,...)) - __attribute__((format (printf, 3, 4))); -#endif -#ifndef PerlIO_vprintf -extern int PerlIO_vprintf _((PerlIO *, const char *, va_list)); -#endif -#ifndef PerlIO_tell -extern long PerlIO_tell _((PerlIO *)); -#endif -#ifndef PerlIO_seek -extern int PerlIO_seek _((PerlIO *,off_t,int)); -#endif -#ifndef PerlIO_rewind -extern void PerlIO_rewind _((PerlIO *)); -#endif -#ifndef PerlIO_has_base -extern int PerlIO_has_base _((PerlIO *)); -#endif -#ifndef PerlIO_has_cntptr -extern int PerlIO_has_cntptr _((PerlIO *)); -#endif -#ifndef PerlIO_fast_gets -extern int PerlIO_fast_gets _((PerlIO *)); -#endif -#ifndef PerlIO_canset_cnt -extern int PerlIO_canset_cnt _((PerlIO *)); -#endif -#ifndef PerlIO_get_ptr -extern STDCHAR * PerlIO_get_ptr _((PerlIO *)); -#endif -#ifndef PerlIO_get_cnt -extern int PerlIO_get_cnt _((PerlIO *)); -#endif -#ifndef PerlIO_set_cnt -extern void PerlIO_set_cnt _((PerlIO *,int)); -#endif -#ifndef PerlIO_set_ptrcnt -extern void PerlIO_set_ptrcnt _((PerlIO *,STDCHAR *,int)); -#endif -#ifndef PerlIO_get_base -extern STDCHAR * PerlIO_get_base _((PerlIO *)); -#endif -#ifndef PerlIO_get_bufsiz -extern int PerlIO_get_bufsiz _((PerlIO *)); -#endif -#ifndef PerlIO_tmpfile -extern PerlIO * PerlIO_tmpfile _((void)); -#endif -#ifndef PerlIO_stdin -extern PerlIO * PerlIO_stdin _((void)); -#endif -#ifndef PerlIO_stdout -extern PerlIO * PerlIO_stdout _((void)); -#endif -#ifndef PerlIO_stderr -extern PerlIO * PerlIO_stderr _((void)); -#endif -#ifndef PerlIO_getpos -extern int PerlIO_getpos _((PerlIO *,Fpos_t *)); -#endif -#ifndef PerlIO_setpos -extern int PerlIO_setpos _((PerlIO *,const Fpos_t *)); -#endif -#endif /* Include guard */ diff --git a/perllio.h b/perllio.h deleted file mode 100644 index 8ae606dc63..0000000000 --- a/perllio.h +++ /dev/null @@ -1,63 +0,0 @@ -#ifndef H_PERLLIO -#define H_PERLLIO 1 - -#ifdef PERL_OBJECT - -#include "iplio.h" - -#define PerlLIO_access(file, mode) piLIO->Access((file), (mode), ErrorNo()) -#define PerlLIO_chmod(file, mode) piLIO->Chmod((file), (mode), ErrorNo()) -#define PerlLIO_chown(file, owner, group) piLIO->Chown((file), (owner), (group), ErrorNo()) -#define PerlLIO_chsize(fd, size) piLIO->Chsize((fd), (size), ErrorNo()) -#define PerlLIO_close(fd) piLIO->Close((fd), ErrorNo()) -#define PerlLIO_dup(fd) piLIO->Dup((fd), ErrorNo()) -#define PerlLIO_dup2(fd1, fd2) piLIO->Dup2((fd1), (fd2), ErrorNo()) -#define PerlLIO_flock(fd, op) piLIO->Flock((fd), (op), ErrorNo()) -#define PerlLIO_fstat(fd, buf) piLIO->FileStat((fd), (buf), ErrorNo()) -#define PerlLIO_ioctl(fd, u, buf) piLIO->IOCtl((fd), (u), (buf), ErrorNo()) -#define PerlLIO_isatty(fd) piLIO->Isatty((fd), ErrorNo()) -#define PerlLIO_lseek(fd, offset, mode) piLIO->Lseek((fd), (offset), (mode), ErrorNo()) -#define PerlLIO_lstat(name, buf) piLIO->Lstat((name), (buf), ErrorNo()) -#define PerlLIO_mktemp(file) piLIO->Mktemp((file), ErrorNo()) -#define PerlLIO_open(file, flag) piLIO->Open((file), (flag), ErrorNo()) -#define PerlLIO_open3(file, flag, perm) piLIO->Open((file), (flag), (perm), ErrorNo()) -#define PerlLIO_read(fd, buf, count) piLIO->Read((fd), (buf), (count), ErrorNo()) -#define PerlLIO_rename(oldname, newname) piLIO->Rename((oldname), (newname), ErrorNo()) -#define PerlLIO_setmode(fd, mode) piLIO->Setmode((fd), (mode), ErrorNo()) -#define PerlLIO_stat(name, buf) piLIO->NameStat((name), (buf), ErrorNo()) -#define PerlLIO_tmpnam(str) piLIO->Tmpnam((str), ErrorNo()) -#define PerlLIO_umask(mode) piLIO->Umask((mode), ErrorNo()) -#define PerlLIO_unlink(file) piLIO->Unlink((file), ErrorNo()) -#define PerlLIO_utime(file, time) piLIO->Utime((file), (time), ErrorNo()) -#define PerlLIO_write(fd, buf, count) piLIO->Write((fd), (buf), (count), ErrorNo()) -#else -#define PerlLIO_access(file, mode) access((file), (mode)) -#define PerlLIO_chmod(file, mode) chmod((file), (mode)) -#define PerlLIO_chown(file, owner, group) chown((file), (owner), (group)) -#define PerlLIO_chsize(fd, size) chsize((fd), (size)) -#define PerlLIO_close(fd) close((fd)) -#define PerlLIO_dup(fd) dup((fd)) -#define PerlLIO_dup2(fd1, fd2) dup2((fd1), (fd2)) -#define PerlLIO_flock(fd, op) FLOCK((fd), (op)) -#define PerlLIO_fstat(fd, buf) Fstat((fd), (buf)) -#define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf)) -#define PerlLIO_isatty(fd) isatty((fd)) -#define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode)) -#define PerlLIO_lstat(name, buf) lstat((name), (buf)) -#define PerlLIO_mktemp(file) mktemp((file)) -#define PerlLIO_mkstemp(file) mkstemp((file)) -#define PerlLIO_open(file, flag) open((file), (flag)) -#define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) -#define PerlLIO_read(fd, buf, count) read((fd), (buf), (count)) -#define PerlLIO_rename(oldname, newname) rename((oldname), (newname)) -#define PerlLIO_setmode(fd, mode) setmode((fd), (mode)) -#define PerlLIO_stat(name, buf) Stat((name), (buf)) -#define PerlLIO_tmpnam(str) tmpnam((str)) -#define PerlLIO_umask(mode) umask((mode)) -#define PerlLIO_unlink(file) unlink((file)) -#define PerlLIO_utime(file, time) utime((file), (time)) -#define PerlLIO_write(fd, buf, count) write((fd), (buf), (count)) -#endif /* PERL_OBJECT */ - -#endif /* Include guard */ - diff --git a/perlmem.h b/perlmem.h deleted file mode 100644 index 5c2efdbf23..0000000000 --- a/perlmem.h +++ /dev/null @@ -1,19 +0,0 @@ -#ifndef H_PERLMEM -#define H_PERLMEM 1 - -#ifdef PERL_OBJECT - -#include "ipmem.h" - -#define PerlMem_malloc(size) piMem->Malloc((size)) -#define PerlMem_realloc(buf, size) piMem->Realloc((buf), (size)) -#define PerlMem_free(buf) piMem->Free((buf)) -#else -#define PerlMem_malloc(size) malloc((size)) -#define PerlMem_realloc(buf, size) realloc((buf), (size)) -#define PerlMem_free(buf) free((buf)) - -#endif /* PERL_OBJECT */ - -#endif /* Include guard */ - diff --git a/perlproc.h b/perlproc.h deleted file mode 100644 index adf66a2940..0000000000 --- a/perlproc.h +++ /dev/null @@ -1,71 +0,0 @@ -#ifndef H_PERLPROC -#define H_PERLPROC 1 - -#ifdef PERL_OBJECT - -#include "ipproc.h" - -#define PerlProc_abort() piProc->Abort() -#define PerlProc_exit(s) piProc->Exit((s)) -#define PerlProc__exit(s) piProc->_Exit((s)) -#define PerlProc_execl(c, w, x, y, z) piProc->Execl((c), (w), (x), (y), (z)) -#define PerlProc_execv(c, a) piProc->Execv((c), (a)) -#define PerlProc_execvp(c, a) piProc->Execvp((c), (a)) -#define PerlProc_getuid() piProc->Getuid() -#define PerlProc_geteuid() piProc->Geteuid() -#define PerlProc_getgid() piProc->Getgid() -#define PerlProc_getegid() piProc->Getegid() -#define PerlProc_getlogin() piProc->Getlogin() -#define PerlProc_kill(i, a) piProc->Kill((i), (a)) -#define PerlProc_killpg(i, a) piProc->Killpg((i), (a)) -#define PerlProc_pause() piProc->PauseProc() -#define PerlProc_popen(c, m) piProc->Popen((c), (m)) -#define PerlProc_pclose(f) piProc->Pclose((f)) -#define PerlProc_pipe(fd) piProc->Pipe((fd)) -#define PerlProc_setuid(u) piProc->Setuid((u)) -#define PerlProc_setgid(g) piProc->Setgid((g)) -#define PerlProc_sleep(t) piProc->Sleep((t)) -#define PerlProc_times(t) piProc->Times((t)) -#define PerlProc_wait(t) piProc->Wait((t)) -#define PerlProc_waitpid(p, s, f) piProc->Waitpid((p), (s), (f)) -#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) -#define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) -#define PerlProc_signal(n, h) piProc->Signal((n), (h)) -#ifdef WIN32 -#define PerlProc_GetSysMsg(s,l,e) piProc->GetSysMsg((s), (l), (e)) -#define PerlProc_FreeBuf(s) piProc->FreeBuf((s)) -#define PerlProc_Cmd(s) piProc->DoCmd((s)) -#define do_spawn(s) piProc->Spawn((s)) -#define do_spawnvp(m, c, a) piProc->Spawnvp((m), (c), (a)) -#define PerlProc_aspawn(m, c, a) piProc->ASpawn((m), (c), (a)) -#endif -#else -#define PerlProc_abort() abort() -#define PerlProc_exit(s) exit((s)) -#define PerlProc__exit(s) _exit((s)) -#define PerlProc_execl(c, w, x, y, z) execl((c), (w), (x), (y), (z)) -#define PerlProc_execv(c, a) execv((c), (a)) -#define PerlProc_execvp(c, a) execvp((c), (a)) -#define PerlProc_getuid() getuid() -#define PerlProc_geteuid() geteuid() -#define PerlProc_getgid() getgid() -#define PerlProc_getegid() getegid() -#define PerlProc_getlogin() getlogin() -#define PerlProc_kill(i, a) kill((i), (a)) -#define PerlProc_killpg(i, a) killpg((i), (a)) -#define PerlProc_pause() Pause() -#define PerlProc_popen(c, m) my_popen((c), (m)) -#define PerlProc_pclose(f) my_pclose((f)) -#define PerlProc_pipe(fd) pipe((fd)) -#define PerlProc_setuid(u) setuid((u)) -#define PerlProc_setgid(g) setgid((g)) -#define PerlProc_sleep(t) sleep((t)) -#define PerlProc_times(t) times((t)) -#define PerlProc_wait(t) wait((t)) -#define PerlProc_waitpid(p, s, f) waitpid((p), (s), (f)) -#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) -#define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) -#define PerlProc_signal(n, h) signal((n), (h)) -#endif /* PERL_OBJECT */ - -#endif /* Include guard */ diff --git a/perlsock.h b/perlsock.h deleted file mode 100644 index 70350bef54..0000000000 --- a/perlsock.h +++ /dev/null @@ -1,102 +0,0 @@ -#ifndef H_PERLSOCK -#define H_PERLSOCK 1 - -#ifdef PERL_OBJECT - -#include "ipsock.h" - -#define PerlSock_htonl(x) piSock->Htonl(x) -#define PerlSock_htons(x) piSock->Htons(x) -#define PerlSock_ntohl(x) piSock->Ntohl(x) -#define PerlSock_ntohs(x) piSock->Ntohs(x) -#define PerlSock_accept(s, a, l) piSock->Accept(s, a, l, ErrorNo()) -#define PerlSock_bind(s, n, l) piSock->Bind(s, n, l, ErrorNo()) -#define PerlSock_connect(s, n, l) piSock->Connect(s, n, l, ErrorNo()) -#define PerlSock_endhostent() piSock->Endhostent(ErrorNo()) -#define PerlSock_endnetent() piSock->Endnetent(ErrorNo()) -#define PerlSock_endprotoent() piSock->Endprotoent(ErrorNo()) -#define PerlSock_endservent() piSock->Endservent(ErrorNo()) -#define PerlSock_gethostbyaddr(a, l, t) piSock->Gethostbyaddr(a, l, t, ErrorNo()) -#define PerlSock_gethostbyname(n) piSock->Gethostbyname(n, ErrorNo()) -#define PerlSock_gethostent() piSock->Gethostent(ErrorNo()) -#define PerlSock_gethostname(n, l) piSock->Gethostname(n, l, ErrorNo()) -#define PerlSock_getnetbyaddr(n, t) piSock->Getnetbyaddr(n, t, ErrorNo()) -#define PerlSock_getnetbyname(c) piSock->Getnetbyname(c, ErrorNo()) -#define PerlSock_getnetent() piSock->Getnetent(ErrorNo()) -#define PerlSock_getpeername(s, n, l) piSock->Getpeername(s, n, l, ErrorNo()) -#define PerlSock_getprotobyname(n) piSock->Getprotobyname(n, ErrorNo()) -#define PerlSock_getprotobynumber(n) piSock->Getprotobynumber(n, ErrorNo()) -#define PerlSock_getprotoent() piSock->Getprotoent(ErrorNo()) -#define PerlSock_getservbyname(n, p) piSock->Getservbyname(n, p, ErrorNo()) -#define PerlSock_getservbyport(port, p) piSock->Getservbyport(port, p, ErrorNo()) -#define PerlSock_getservent() piSock->Getservent(ErrorNo()) -#define PerlSock_getsockname(s, n, l) piSock->Getsockname(s, n, l, ErrorNo()) -#define PerlSock_getsockopt(s, l, n, v, i) piSock->Getsockopt(s, l, n, v, i, ErrorNo()) -#define PerlSock_inet_addr(c) piSock->InetAddr(c, ErrorNo()) -#define PerlSock_inet_ntoa(i) piSock->InetNtoa(i, ErrorNo()) -#define PerlSock_listen(s, b) piSock->Listen(s, b, ErrorNo()) -#define PerlSock_recv(s, b, l, f) piSock->Recv(s, b, l, f, ErrorNo()) -#define PerlSock_recvfrom(s, b, l, f, from, fromlen) piSock->Recvfrom(s, b, l, f, from, fromlen, ErrorNo()) -#define PerlSock_select(n, r, w, e, t) piSock->Select(n, (char*)r, (char*)w, (char*)e, t, ErrorNo()) -#define PerlSock_send(s, b, l, f) piSock->Send(s, b, l, f, ErrorNo()) -#define PerlSock_sendto(s, b, l, f, t, tlen) piSock->Sendto(s, b, l, f, t, tlen, ErrorNo()) -#define PerlSock_sethostent(f) piSock->Sethostent(f, ErrorNo()) -#define PerlSock_setnetent(f) piSock->Setnetent(f, ErrorNo()) -#define PerlSock_setprotoent(f) piSock->Setprotoent(f, ErrorNo()) -#define PerlSock_setservent(f) piSock->Setservent(f, ErrorNo()) -#define PerlSock_setsockopt(s, l, n, v, len) piSock->Setsockopt(s, l, n, v, len, ErrorNo()) -#define PerlSock_shutdown(s, h) piSock->Shutdown(s, h, ErrorNo()) -#define PerlSock_socket(a, t, p) piSock->Socket(a, t, p, ErrorNo()) -#define PerlSock_socketpair(a, t, p, f) piSock->Socketpair(a, t, p, f, ErrorNo()) -#else -#define PerlSock_htonl(x) htonl(x) -#define PerlSock_htons(x) htons(x) -#define PerlSock_ntohl(x) ntohl(x) -#define PerlSock_ntohs(x) ntohs(x) -#define PerlSock_accept(s, a, l) accept(s, a, l) -#define PerlSock_bind(s, n, l) bind(s, n, l) -#define PerlSock_connect(s, n, l) connect(s, n, l) - -#define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr(a, l, t) -#define PerlSock_gethostbyname(n) gethostbyname(n) -#define PerlSock_gethostent gethostent -#define PerlSock_endhostent endhostent -#define PerlSock_gethostname(n, l) gethostname(n, l) - -#define PerlSock_getnetbyaddr(n, t) getnetbyaddr(n, t) -#define PerlSock_getnetbyname(n) getnetbyname(n) -#define PerlSock_getnetent getnetent -#define PerlSock_endnetent endnetent -#define PerlSock_getpeername(s, n, l) getpeername(s, n, l) - -#define PerlSock_getprotobyname(n) getprotobyname(n) -#define PerlSock_getprotobynumber(n) getprotobynumber(n) -#define PerlSock_getprotoent getprotoent -#define PerlSock_endprotoent endprotoent - -#define PerlSock_getservbyname(n, p) getservbyname(n, p) -#define PerlSock_getservbyport(port, p) getservbyport(port, p) -#define PerlSock_getservent getservent -#define PerlSock_endservent endservent - -#define PerlSock_getsockname(s, n, l) getsockname(s, n, l) -#define PerlSock_getsockopt(s, l, n, v, i) getsockopt(s, l, n, v, i) -#define PerlSock_inet_addr(c) inet_addr(c) -#define PerlSock_inet_ntoa(i) inet_ntoa(i) -#define PerlSock_listen(s, b) listen(s, b) -#define PerlSock_recvfrom(s, b, l, f, from, fromlen) recvfrom(s, b, l, f, from, fromlen) -#define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t) -#define PerlSock_send(s, b, l, f) send(s, b, l, f) -#define PerlSock_sendto(s, b, l, f, t, tlen) sendto(s, b, l, f, t, tlen) -#define PerlSock_sethostent(f) sethostent(f) -#define PerlSock_setnetent(f) setnetent(f) -#define PerlSock_setprotoent(f) setprotoent(f) -#define PerlSock_setservent(f) setservent(f) -#define PerlSock_setsockopt(s, l, n, v, len) setsockopt(s, l, n, v, len) -#define PerlSock_shutdown(s, h) shutdown(s, h) -#define PerlSock_socket(a, t, p) socket(a, t, p) -#define PerlSock_socketpair(a, t, p, f) socketpair(a, t, p, f) -#endif /* PERL_OBJECT */ - -#endif /* Include guard */ - @@ -1,11 +1,4 @@ #ifdef PERL_OBJECT -#include "ipstdio.h" -#include "ipdir.h" -#include "ipenv.h" -#include "iplio.h" -#include "ipmem.h" -#include "ipproc.h" -#include "ipsock.h" #define VIRTUAL virtual #else #define VIRTUAL @@ -14,7 +14,6 @@ #include "EXTERN.h" #include "perl.h" -#include "perlmem.h" #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include <signal.h> diff --git a/win32/Makefile b/win32/Makefile index a38e2d9272..a0f1d00d1b 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -397,12 +397,12 @@ CORE_NOCFG_H = \ ..\gv.h \ ..\handy.h \ ..\hv.h \ + ..\iperlsys.h \ ..\mg.h \ ..\nostdio.h \ ..\op.h \ ..\opcode.h \ ..\perl.h \ - ..\perlio.h \ ..\perlsdio.h \ ..\perlsfio.h \ ..\perly.h \ diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index a5183c3d90..c650acffb7 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -37,7 +37,7 @@ calls. static SV *error_sv; static char * -OS_Error_String(void) +OS_Error_String(CPERLarg) { DWORD err = GetLastError(); STRLEN len; @@ -110,7 +110,8 @@ dl_load_file(filename,flags=0) DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) - SaveError(PERL_OBJECT_THIS_ "load_file:%s",OS_Error_String()) ; + SaveError(PERL_OBJECT_THIS_ "load_file:%s", + OS_Error_String(PERL_OBJECT_THIS)) ; else sv_setiv( ST(0), (IV)RETVAL); @@ -126,7 +127,8 @@ dl_find_symbol(libhandle, symbolname) DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) - SaveError(PERL_OBJECT_THIS_ "find_symbol:%s",OS_Error_String()) ; + SaveError(PERL_OBJECT_THIS_ "find_symbol:%s", + OS_Error_String(PERL_OBJECT_THIS)) ; else sv_setiv( ST(0), (IV)RETVAL); diff --git a/win32/makefile.mk b/win32/makefile.mk index b5650a8c94..f0e258de59 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -511,12 +511,12 @@ CORE_NOCFG_H = \ ..\gv.h \ ..\handy.h \ ..\hv.h \ + ..\iperlsys.h \ ..\mg.h \ ..\nostdio.h \ ..\op.h \ ..\opcode.h \ ..\perl.h \ - ..\perlio.h \ ..\perlsdio.h \ ..\perlsfio.h \ ..\perly.h \ diff --git a/win32/perlhost.h b/win32/perlhost.h new file mode 100644 index 0000000000..a4c2e3ce51 --- /dev/null +++ b/win32/perlhost.h @@ -0,0 +1,971 @@ + +#include "iperlsys.h" + +extern CPerlObj *pPerl; + +#define CALLFUNC0RET(x)\ + int ret = x;\ + if (ret < 0)\ + err = errno;\ + return ret; + +#define PROCESS_AND_RETURN \ + if (errno) \ + err = errno; \ + return r + +#define CALLFUNCRET(x)\ + int ret = x;\ + if (ret)\ + err = errno;\ + return ret; + +#define CALLFUNCERR(x)\ + int ret = x;\ + if (errno)\ + err = errno;\ + return ret; + +#define LCALLFUNCERR(x)\ + long ret = x;\ + if (errno)\ + err = errno;\ + return ret; + +extern int g_closedir(DIR *dirp); +extern DIR * g_opendir(char *filename); +extern struct direct * g_readdir(DIR *dirp); +extern void g_rewinddir(DIR *dirp); +extern void g_seekdir(DIR *dirp, long loc); +extern long g_telldir(DIR *dirp); + +class CPerlDir : public IPerlDir +{ +public: + CPerlDir() {}; + virtual int Makedir(const char *dirname, int mode, int &err) + { + CALLFUNC0RET(win32_mkdir(dirname, mode)); + }; + virtual int Chdir(const char *dirname, int &err) + { + CALLFUNC0RET(win32_chdir(dirname)); + }; + virtual int Rmdir(const char *dirname, int &err) + { + CALLFUNC0RET(win32_rmdir(dirname)); + }; + virtual int Close(DIR *dirp, int &err) + { + return g_closedir(dirp); + }; + virtual DIR *Open(char *filename, int &err) + { + return g_opendir(filename); + }; + virtual struct direct *Read(DIR *dirp, int &err) + { + return g_readdir(dirp); + }; + virtual void Rewind(DIR *dirp, int &err) + { + g_rewinddir(dirp); + }; + virtual void Seek(DIR *dirp, long loc, int &err) + { + g_seekdir(dirp, loc); + }; + virtual long Tell(DIR *dirp, int &err) + { + return g_telldir(dirp); + }; +}; + + +extern char * g_win32_get_privlib(char *pl); +extern char * g_win32_get_sitelib(char *pl); + +class CPerlEnv : public IPerlEnv +{ +public: + CPerlEnv() {}; + virtual char *Getenv(const char *varname, int &err) + { + return win32_getenv(varname); + }; + virtual int Putenv(const char *envstring, int &err) + { + return putenv(envstring); + }; + virtual char* LibPath(char *pl) + { + return g_win32_get_privlib(pl); + }; + virtual char* SiteLibPath(char *pl) + { + return g_win32_get_sitelib(pl); + }; +}; + +class CPerlSock : public IPerlSock +{ +public: + CPerlSock() {}; + virtual u_long Htonl(u_long hostlong) + { + return win32_htonl(hostlong); + }; + virtual u_short Htons(u_short hostshort) + { + return win32_htons(hostshort); + }; + virtual u_long Ntohl(u_long netlong) + { + return win32_ntohl(netlong); + }; + virtual u_short Ntohs(u_short netshort) + { + return win32_ntohs(netshort); + } + + virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) + { + SOCKET r = win32_accept(s, addr, addrlen); + PROCESS_AND_RETURN; + }; + virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err) + { + int r = win32_bind(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err) + { + int r = win32_connect(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual void Endhostent(int &err) + { + win32_endhostent(); + }; + virtual void Endnetent(int &err) + { + win32_endnetent(); + }; + virtual void Endprotoent(int &err) + { + win32_endprotoent(); + }; + virtual void Endservent(int &err) + { + win32_endservent(); + }; + virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err) + { + struct hostent *r = win32_gethostbyaddr(addr, len, type); + PROCESS_AND_RETURN; + }; + virtual struct hostent* Gethostbyname(const char* name, int &err) + { + struct hostent *r = win32_gethostbyname(name); + PROCESS_AND_RETURN; + }; + virtual struct hostent* Gethostent(int &err) + { + croak("gethostent not implemented!\n"); + return NULL; + }; + virtual int Gethostname(char* name, int namelen, int &err) + { + int r = win32_gethostname(name, namelen); + PROCESS_AND_RETURN; + }; + virtual struct netent *Getnetbyaddr(long net, int type, int &err) + { + struct netent *r = win32_getnetbyaddr(net, type); + PROCESS_AND_RETURN; + }; + virtual struct netent *Getnetbyname(const char *name, int &err) + { + struct netent *r = win32_getnetbyname((char*)name); + PROCESS_AND_RETURN; + }; + virtual struct netent *Getnetent(int &err) + { + struct netent *r = win32_getnetent(); + PROCESS_AND_RETURN; + }; + virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err) + { + int r = win32_getpeername(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual struct protoent* Getprotobyname(const char* name, int &err) + { + struct protoent *r = win32_getprotobyname(name); + PROCESS_AND_RETURN; + }; + virtual struct protoent* Getprotobynumber(int number, int &err) + { + struct protoent *r = win32_getprotobynumber(number); + PROCESS_AND_RETURN; + }; + virtual struct protoent* Getprotoent(int &err) + { + struct protoent *r = win32_getprotoent(); + PROCESS_AND_RETURN; + }; + virtual struct servent* Getservbyname(const char* name, const char* proto, int &err) + { + struct servent *r = win32_getservbyname(name, proto); + PROCESS_AND_RETURN; + }; + virtual struct servent* Getservbyport(int port, const char* proto, int &err) + { + struct servent *r = win32_getservbyport(port, proto); + PROCESS_AND_RETURN; + }; + virtual struct servent* Getservent(int &err) + { + struct servent *r = win32_getservent(); + PROCESS_AND_RETURN; + }; + virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err) + { + int r = win32_getsockname(s, name, namelen); + PROCESS_AND_RETURN; + }; + virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err) + { + int r = win32_getsockopt(s, level, optname, optval, optlen); + PROCESS_AND_RETURN; + }; + virtual unsigned long InetAddr(const char* cp, int &err) + { + unsigned long r = win32_inet_addr(cp); + PROCESS_AND_RETURN; + }; + virtual char* InetNtoa(struct in_addr in, int &err) + { + char *r = win32_inet_ntoa(in); + PROCESS_AND_RETURN; + }; + virtual int Listen(SOCKET s, int backlog, int &err) + { + int r = win32_listen(s, backlog); + PROCESS_AND_RETURN; + }; + virtual int Recv(SOCKET s, char* buffer, int len, int flags, int &err) + { + int r = win32_recv(s, buffer, len, flags); + PROCESS_AND_RETURN; + }; + virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err) + { + int r = win32_recvfrom(s, buffer, len, flags, from, fromlen); + PROCESS_AND_RETURN; + }; + virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err) + { + int r = win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout); + PROCESS_AND_RETURN; + }; + virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err) + { + int r = win32_send(s, buffer, len, flags); + PROCESS_AND_RETURN; + }; + virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err) + { + int r = win32_sendto(s, buffer, len, flags, to, tolen); + PROCESS_AND_RETURN; + }; + virtual void Sethostent(int stayopen, int &err) + { + win32_sethostent(stayopen); + }; + virtual void Setnetent(int stayopen, int &err) + { + win32_setnetent(stayopen); + }; + virtual void Setprotoent(int stayopen, int &err) + { + win32_setprotoent(stayopen); + }; + virtual void Setservent(int stayopen, int &err) + { + win32_setservent(stayopen); + }; + virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err) + { + int r = win32_setsockopt(s, level, optname, optval, optlen); + PROCESS_AND_RETURN; + }; + virtual int Shutdown(SOCKET s, int how, int &err) + { + int r = win32_shutdown(s, how); + PROCESS_AND_RETURN; + }; + virtual SOCKET Socket(int af, int type, int protocol, int &err) + { + SOCKET r = win32_socket(af, type, protocol); + PROCESS_AND_RETURN; + }; + virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err) + { + croak("socketpair not implemented!\n"); + return 0; + }; + virtual int Closesocket(SOCKET s, int& err) + { + int r = win32_closesocket(s); + PROCESS_AND_RETURN; + }; + virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err) + { + int r = win32_ioctlsocket(s, cmd, argp); + PROCESS_AND_RETURN; + }; +}; + +class CPerlLIO : public IPerlLIO +{ +public: + CPerlLIO() {}; + virtual int Access(const char *path, int mode, int &err) + { + CALLFUNCRET(access(path, mode)) + }; + virtual int Chmod(const char *filename, int pmode, int &err) + { + CALLFUNCRET(chmod(filename, pmode)) + }; + virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err) + { + CALLFUNCERR(chown(filename, owner, group)) + }; + virtual int Chsize(int handle, long size, int &err) + { + CALLFUNCRET(chsize(handle, size)) + }; + virtual int Close(int handle, int &err) + { + CALLFUNCRET(win32_close(handle)) + }; + virtual int Dup(int handle, int &err) + { + CALLFUNCERR(win32_dup(handle)) + }; + virtual int Dup2(int handle1, int handle2, int &err) + { + CALLFUNCERR(win32_dup2(handle1, handle2)) + }; + virtual int Flock(int fd, int oper, int &err) + { + CALLFUNCERR(win32_flock(fd, oper)) + }; + virtual int FileStat(int handle, struct stat *buffer, int &err) + { + CALLFUNCERR(fstat(handle, buffer)) + }; + virtual int IOCtl(int i, unsigned int u, char *data, int &err) + { + CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data)) + }; + virtual int Isatty(int fd, int &err) + { + return isatty(fd); + }; + virtual long Lseek(int handle, long offset, int origin, int &err) + { + LCALLFUNCERR(win32_lseek(handle, offset, origin)) + }; + virtual int Lstat(const char *path, struct stat *buffer, int &err) + { + return NameStat(path, buffer, err); + }; + virtual char *Mktemp(char *Template, int &err) + { + return mktemp(Template); + }; + virtual int Open(const char *filename, int oflag, int &err) + { + CALLFUNCERR(win32_open(filename, oflag)) + }; + virtual int Open(const char *filename, int oflag, int pmode, int &err) + { + int ret; + if(stricmp(filename, "/dev/null") == 0) + ret = open("NUL", oflag, pmode); + else + ret = open(filename, oflag, pmode); + + if(errno) + err = errno; + return ret; + }; + virtual int Read(int handle, void *buffer, unsigned int count, int &err) + { + CALLFUNCERR(win32_read(handle, buffer, count)) + }; + virtual int Rename(const char *OldFileName, const char *newname, int &err) + { + char szNewWorkName[MAX_PATH+1]; + WIN32_FIND_DATA fdOldFile, fdNewFile; + HANDLE handle; + char *ptr; + + if((strchr(OldFileName, '\\') || strchr(OldFileName, '/')) + && strchr(newname, '\\') == NULL + && strchr(newname, '/') == NULL) + { + strcpy(szNewWorkName, OldFileName); + if((ptr = strrchr(szNewWorkName, '\\')) == NULL) + ptr = strrchr(szNewWorkName, '/'); + strcpy(++ptr, newname); + } + else + strcpy(szNewWorkName, newname); + + if(stricmp(OldFileName, szNewWorkName) != 0) + { // check that we're not being fooled by relative paths + // and only delete the new file + // 1) if it exists + // 2) it is not the same file as the old file + // 3) old file exist + // GetFullPathName does not return the long file name on some systems + handle = FindFirstFile(OldFileName, &fdOldFile); + if(handle != INVALID_HANDLE_VALUE) + { + FindClose(handle); + + handle = FindFirstFile(szNewWorkName, &fdNewFile); + + if(handle != INVALID_HANDLE_VALUE) + FindClose(handle); + else + fdNewFile.cFileName[0] = '\0'; + + if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0 + && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0) + { // file exists and not same file + DeleteFile(szNewWorkName); + } + } + } + int ret = rename(OldFileName, szNewWorkName); + if(ret) + err = errno; + + return ret; + }; + virtual int Setmode(int handle, int mode, int &err) + { + CALLFUNCRET(win32_setmode(handle, mode)) + }; + virtual int NameStat(const char *path, struct stat *buffer, int &err) + { + return win32_stat(path, buffer); + }; + virtual char *Tmpnam(char *string, int &err) + { + return tmpnam(string); + }; + virtual int Umask(int pmode, int &err) + { + return umask(pmode); + }; + virtual int Unlink(const char *filename, int &err) + { + chmod(filename, S_IREAD | S_IWRITE); + CALLFUNCRET(unlink(filename)) + }; + virtual int Utime(char *filename, struct utimbuf *times, int &err) + { + CALLFUNCRET(win32_utime(filename, times)) + }; + virtual int Write(int handle, const void *buffer, unsigned int count, int &err) + { + CALLFUNCERR(win32_write(handle, buffer, count)) + }; +}; + +class CPerlMem : public IPerlMem +{ +public: + CPerlMem() {}; + virtual void* Malloc(size_t size) + { + return win32_malloc(size); + }; + virtual void* Realloc(void* ptr, size_t size) + { + return win32_realloc(ptr, size); + }; + virtual void Free(void* ptr) + { + win32_free(ptr); + }; +}; + +#define EXECF_EXEC 1 +#define EXECF_SPAWN 2 + +extern char * g_getlogin(void); +extern int do_spawn2(char *cmd, int exectype); +extern int g_do_aspawn(void *vreally, void **vmark, void **vsp); + +class CPerlProc : public IPerlProc +{ +public: + CPerlProc() {}; + virtual void Abort(void) + { + win32_abort(); + }; + virtual void Exit(int status) + { + exit(status); + }; + virtual void _Exit(int status) + { + _exit(status); + }; + virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) + { + return execl(cmdname, arg0, arg1, arg2, arg3); + }; + virtual int Execv(const char *cmdname, const char *const *argv) + { + return win32_execvp(cmdname, argv); + }; + virtual int Execvp(const char *cmdname, const char *const *argv) + { + return win32_execvp(cmdname, argv); + }; + virtual uid_t Getuid(void) + { + return getuid(); + }; + virtual uid_t Geteuid(void) + { + return geteuid(); + }; + virtual gid_t Getgid(void) + { + return getgid(); + }; + virtual gid_t Getegid(void) + { + return getegid(); + }; + virtual char *Getlogin(void) + { + return g_getlogin(); + }; + virtual int Kill(int pid, int sig) + { + return win32_kill(pid, sig); + }; + virtual int Killpg(int pid, int sig) + { + croak("killpg not implemented!\n"); + return 0; + }; + virtual int PauseProc(void) + { + return win32_sleep((32767L << 16) + 32767); + }; + virtual PerlIO* Popen(const char *command, const char *mode) + { + win32_fflush(stdout); + win32_fflush(stderr); + return (PerlIO*)win32_popen(command, mode); + }; + virtual int Pclose(PerlIO *stream) + { + return win32_pclose((FILE*)stream); + }; + virtual int Pipe(int *phandles) + { + return win32_pipe(phandles, 512, O_BINARY); + }; + virtual int Setuid(uid_t u) + { + return setuid(u); + }; + virtual int Setgid(gid_t g) + { + return setgid(g); + }; + virtual int Sleep(unsigned int s) + { + return win32_sleep(s); + }; + virtual int Times(struct tms *timebuf) + { + return win32_times(timebuf); + }; + virtual int Wait(int *status) + { + return win32_wait(status); + }; + virtual int Waitpid(int pid, int *status, int flags) + { + return win32_waitpid(pid, status, flags); + }; + virtual Sighandler_t Signal(int sig, Sighandler_t subcode) + { + return 0; + }; + virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr) + { + dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER + |FORMAT_MESSAGE_IGNORE_INSERTS + |FORMAT_MESSAGE_FROM_SYSTEM, NULL, + dwErr, 0, (char *)&sMsg, 1, NULL); + if (0 < dwLen) { + while (0 < dwLen && isspace(sMsg[--dwLen])) + ; + if ('.' != sMsg[dwLen]) + dwLen++; + sMsg[dwLen]= '\0'; + } + if (0 == dwLen) { + sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); + dwLen = sprintf(sMsg, + "Unknown error #0x%lX (lookup 0x%lX)", + dwErr, GetLastError()); + } + }; + virtual void FreeBuf(char* sMsg) + { + LocalFree(sMsg); + }; + virtual BOOL DoCmd(char *cmd) + { + do_spawn2(cmd, EXECF_EXEC); + return FALSE; + }; + virtual int Spawn(char* cmds) + { + return do_spawn2(cmds, EXECF_SPAWN); + }; + virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv) + { + return win32_spawnvp(mode, cmdname, argv); + }; + virtual int ASpawn(void *vreally, void **vmark, void **vsp) + { + return g_do_aspawn(vreally, vmark, vsp); + }; +}; + + +class CPerlStdIO : public IPerlStdIO +{ +public: + CPerlStdIO() {}; + virtual PerlIO* Stdin(void) + { + return (PerlIO*)win32_stdin(); + }; + virtual PerlIO* Stdout(void) + { + return (PerlIO*)win32_stdout(); + }; + virtual PerlIO* Stderr(void) + { + return (PerlIO*)win32_stderr(); + }; + virtual PerlIO* Open(const char *path, const char *mode, int &err) + { + PerlIO*pf = (PerlIO*)win32_fopen(path, mode); + if(errno) + err = errno; + return pf; + }; + virtual int Close(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_fclose(((FILE*)pf))) + }; + virtual int Eof(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_feof((FILE*)pf)) + }; + virtual int Error(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_ferror((FILE*)pf)) + }; + virtual void Clearerr(PerlIO* pf, int &err) + { + win32_clearerr((FILE*)pf); + }; + virtual int Getc(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_getc((FILE*)pf)) + }; + virtual char* GetBase(PerlIO* pf, int &err) + { + FILE *f = (FILE*)pf; + return FILE_base(f); + }; + virtual int GetBufsiz(PerlIO* pf, int &err) + { + FILE *f = (FILE*)pf; + return FILE_bufsiz(f); + }; + virtual int GetCnt(PerlIO* pf, int &err) + { + FILE *f = (FILE*)pf; + return FILE_cnt(f); + }; + virtual char* GetPtr(PerlIO* pf, int &err) + { + FILE *f = (FILE*)pf; + return FILE_ptr(f); + }; + virtual char* Gets(PerlIO* pf, char* s, int n, int& err) + { + char* ret = win32_fgets(s, n, (FILE*)pf); + if(errno) + err = errno; + return ret; + }; + virtual int Putc(PerlIO* pf, int c, int &err) + { + CALLFUNCERR(win32_fputc(c, (FILE*)pf)) + }; + virtual int Puts(PerlIO* pf, const char *s, int &err) + { + CALLFUNCERR(win32_fputs(s, (FILE*)pf)) + }; + virtual int Flush(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_fflush((FILE*)pf)) + }; + virtual int Ungetc(PerlIO* pf,int c, int &err) + { + CALLFUNCERR(win32_ungetc(c, (FILE*)pf)) + }; + virtual int Fileno(PerlIO* pf, int &err) + { + CALLFUNCERR(win32_fileno((FILE*)pf)) + }; + virtual PerlIO* Fdopen(int fd, const char *mode, int &err) + { + PerlIO* pf = (PerlIO*)win32_fdopen(fd, mode); + if(errno) + err = errno; + return pf; + }; + virtual PerlIO* Reopen(const char*path, const char*mode, PerlIO* pf, int &err) + { + PerlIO* newPf = (PerlIO*)win32_freopen(path, mode, (FILE*)pf); + if(errno) + err = errno; + return newPf; + }; + virtual SSize_t Read(PerlIO* pf, void *buffer, Size_t size, int &err) + { + SSize_t i = win32_fread(buffer, 1, size, (FILE*)pf); + if(errno) + err = errno; + return i; + }; + virtual SSize_t Write(PerlIO* pf, const void *buffer, Size_t size, int &err) + { + SSize_t i = win32_fwrite(buffer, 1, size, (FILE*)pf); + if(errno) + err = errno; + return i; + }; + virtual void SetBuf(PerlIO* pf, char* buffer, int &err) + { + win32_setbuf((FILE*)pf, buffer); + }; + virtual int SetVBuf(PerlIO* pf, char* buffer, int type, Size_t size, int &err) + { + int i = win32_setvbuf((FILE*)pf, buffer, type, size); + if(errno) + err = errno; + return i; + }; + virtual void SetCnt(PerlIO* pf, int n, int &err) + { + FILE *f = (FILE*)pf; + FILE_cnt(f) = n; + }; + virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err) + { + FILE *f = (FILE*)pf; + FILE_ptr(f) = ptr; + FILE_cnt(f) = n; + }; + virtual void Setlinebuf(PerlIO* pf, int &err) + { + win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0); + }; + virtual int Printf(PerlIO* pf, int &err, const char *format,...) + { + va_list(arglist); + va_start(arglist, format); + int i = win32_vfprintf((FILE*)pf, format, arglist); + if(errno) + err = errno; + return i; + }; + virtual int Vprintf(PerlIO* pf, int &err, const char *format, va_list arglist) + { + int i = win32_vfprintf((FILE*)pf, format, arglist); + if(errno) + err = errno; + return i; + }; + virtual long Tell(PerlIO* pf, int &err) + { + long l = win32_ftell((FILE*)pf); + if(errno) + err = errno; + return l; + }; + virtual int Seek(PerlIO* pf, off_t offset, int origin, int &err) + { + int i = win32_fseek((FILE*)pf, offset, origin); + if(errno) + err = errno; + return i; + }; + virtual void Rewind(PerlIO* pf, int &err) + { + win32_rewind((FILE*)pf); + }; + virtual PerlIO* Tmpfile(int &err) + { + PerlIO* pf = (PerlIO*)win32_tmpfile(); + if(errno) + err = errno; + return pf; + }; + virtual int Getpos(PerlIO* pf, Fpos_t *p, int &err) + { + int i = win32_fgetpos((FILE*)pf, p); + if(errno) + err = errno; + return i; + }; + virtual int Setpos(PerlIO* pf, const Fpos_t *p, int &err) + { + int i = win32_fsetpos((FILE*)pf, p); + if(errno) + err = errno; + return i; + }; + virtual void Init(int &err) + { + }; + virtual void InitOSExtras(void* p) + { + Perl_init_os_extras(); + }; + virtual int OpenOSfhandle(long osfhandle, int flags) + { + return win32_open_osfhandle(osfhandle, flags); + } + virtual int GetOSfhandle(int filenum) + { + return win32_get_osfhandle(filenum); + } +}; + +class CPerlHost +{ +public: + CPerlHost() { pPerl = NULL; }; + inline BOOL PerlCreate(void) + { + try + { + pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, + &perlDir, &perlSock, &perlProc); + if(pPerl != NULL) + { + try + { + pPerl->perl_construct(); + } + catch(...) + { + win32_fprintf(stderr, "%s\n", + "Error: Unable to construct data structures"); + pPerl->perl_free(); + pPerl = NULL; + } + } + } + catch(...) + { + win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory"); + pPerl = NULL; + } + return (pPerl != NULL); + }; + inline int PerlParse(void (*xs_init)(CPerlObj*), int argc, char** argv, char** env) + { + int retVal; + try + { + retVal = pPerl->perl_parse(xs_init, argc, argv, env); + } + catch(int x) + { + // this is where exit() should arrive + retVal = x; + } + catch(...) + { + win32_fprintf(stderr, "Error: Parse exception\n"); + retVal = -1; + } + *win32_errno() = 0; + return retVal; + }; + inline int PerlRun(void) + { + int retVal; + try + { + retVal = pPerl->perl_run(); + } + catch(int x) + { + // this is where exit() should arrive + retVal = x; + } + catch(...) + { + win32_fprintf(stderr, "Error: Runtime exception\n"); + retVal = -1; + } + return retVal; + }; + inline void PerlDestroy(void) + { + try + { + pPerl->perl_destruct(); + pPerl->perl_free(); + } + catch(...) + { + } + }; + +protected: + CPerlDir perlDir; + CPerlEnv perlEnv; + CPerlLIO perlLIO; + CPerlMem perlMem; + CPerlProc perlProc; + CPerlSock perlSock; + CPerlStdIO perlStdIO; +}; diff --git a/win32/runperl.c b/win32/runperl.c index 7d49182168..3947f9ef37 100644 --- a/win32/runperl.c +++ b/win32/runperl.c @@ -6,988 +6,28 @@ #define NO_XSLOCKS #include "XSUB.H" -#include "Win32iop.h" - -#define errno (*win32_errno()) -#define stdout (win32_stdout()) -#define stderr (win32_stderr()) - -CPerlObj *pPerl; +#include "win32iop.h" #include <fcntl.h> -#include <ipdir.h> -#include <ipenv.h> -#include <ipsock.h> -#include <iplio.h> -#include <ipmem.h> -#include <ipproc.h> -#include <ipstdio.h> - -#define CALLFUNC0RET(x)\ - int ret = x;\ - if(ret < 0)\ - err = errno;\ - return ret; - -extern int g_closedir(DIR *dirp); -extern DIR *g_opendir(char *filename); -extern struct direct *g_readdir(DIR *dirp); -extern void g_rewinddir(DIR *dirp); -extern void g_seekdir(DIR *dirp, long loc); -extern long g_telldir(DIR *dirp); -class CPerlDir : public IPerlDir -{ -public: - CPerlDir() {}; - virtual int Makedir(const char *dirname, int mode, int &err) - { - CALLFUNC0RET(win32_mkdir(dirname, mode)); - }; - virtual int Chdir(const char *dirname, int &err) - { - CALLFUNC0RET(win32_chdir(dirname)); - }; - virtual int Rmdir(const char *dirname, int &err) - { - CALLFUNC0RET(win32_rmdir(dirname)); - }; - virtual int Close(DIR *dirp, int &err) - { - return g_closedir(dirp); - }; - virtual DIR *Open(char *filename, int &err) - { - return g_opendir(filename); - }; - virtual struct direct *Read(DIR *dirp, int &err) - { - return g_readdir(dirp); - }; - virtual void Rewind(DIR *dirp, int &err) - { - g_rewinddir(dirp); - }; - virtual void Seek(DIR *dirp, long loc, int &err) - { - g_seekdir(dirp, loc); - }; - virtual long Tell(DIR *dirp, int &err) - { - return g_telldir(dirp); - }; -}; - - -extern char * g_win32_get_privlib(char *pl); -extern char * g_win32_get_sitelib(char *pl); -class CPerlEnv : public IPerlEnv -{ -public: - CPerlEnv() {}; - virtual char *Getenv(const char *varname, int &err) - { - return win32_getenv(varname); - }; - virtual int Putenv(const char *envstring, int &err) - { - return putenv(envstring); - }; - virtual char* LibPath(char *pl) - { - return g_win32_get_privlib(pl); - }; - virtual char* SiteLibPath(char *pl) - { - return g_win32_get_sitelib(pl); - }; -}; - -#define PROCESS_AND_RETURN \ - if(errno) \ - err = errno; \ - return r - -class CPerlSock : public IPerlSock -{ -public: - CPerlSock() {}; - virtual u_long Htonl(u_long hostlong) - { - return win32_htonl(hostlong); - }; - virtual u_short Htons(u_short hostshort) - { - return win32_htons(hostshort); - }; - virtual u_long Ntohl(u_long netlong) - { - return win32_ntohl(netlong); - }; - virtual u_short Ntohs(u_short netshort) - { - return win32_ntohs(netshort); - } - - virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, int* addrlen, int &err) - { - SOCKET r = win32_accept(s, addr, addrlen); - PROCESS_AND_RETURN; - }; - virtual int Bind(SOCKET s, const struct sockaddr* name, int namelen, int &err) - { - int r = win32_bind(s, name, namelen); - PROCESS_AND_RETURN; - }; - virtual int Connect(SOCKET s, const struct sockaddr* name, int namelen, int &err) - { - int r = win32_connect(s, name, namelen); - PROCESS_AND_RETURN; - }; - virtual void Endhostent(int &err) - { - win32_endhostent(); - }; - virtual void Endnetent(int &err) - { - win32_endnetent(); - }; - virtual void Endprotoent(int &err) - { - win32_endprotoent(); - }; - virtual void Endservent(int &err) - { - win32_endservent(); - }; - virtual struct hostent* Gethostbyaddr(const char* addr, int len, int type, int &err) - { - struct hostent *r = win32_gethostbyaddr(addr, len, type); - PROCESS_AND_RETURN; - }; - virtual struct hostent* Gethostbyname(const char* name, int &err) - { - struct hostent *r = win32_gethostbyname(name); - PROCESS_AND_RETURN; - }; - virtual struct hostent* Gethostent(int &err) - { - croak("gethostent not implemented!\n"); - return NULL; - }; - virtual int Gethostname(char* name, int namelen, int &err) - { - int r = win32_gethostname(name, namelen); - PROCESS_AND_RETURN; - }; - virtual struct netent *Getnetbyaddr(long net, int type, int &err) - { - struct netent *r = win32_getnetbyaddr(net, type); - PROCESS_AND_RETURN; - }; - virtual struct netent *Getnetbyname(const char *name, int &err) - { - struct netent *r = win32_getnetbyname((char*)name); - PROCESS_AND_RETURN; - }; - virtual struct netent *Getnetent(int &err) - { - struct netent *r = win32_getnetent(); - PROCESS_AND_RETURN; - }; - virtual int Getpeername(SOCKET s, struct sockaddr* name, int* namelen, int &err) - { - int r = win32_getpeername(s, name, namelen); - PROCESS_AND_RETURN; - }; - virtual struct protoent* Getprotobyname(const char* name, int &err) - { - struct protoent *r = win32_getprotobyname(name); - PROCESS_AND_RETURN; - }; - virtual struct protoent* Getprotobynumber(int number, int &err) - { - struct protoent *r = win32_getprotobynumber(number); - PROCESS_AND_RETURN; - }; - virtual struct protoent* Getprotoent(int &err) - { - struct protoent *r = win32_getprotoent(); - PROCESS_AND_RETURN; - }; - virtual struct servent* Getservbyname(const char* name, const char* proto, int &err) - { - struct servent *r = win32_getservbyname(name, proto); - PROCESS_AND_RETURN; - }; - virtual struct servent* Getservbyport(int port, const char* proto, int &err) - { - struct servent *r = win32_getservbyport(port, proto); - PROCESS_AND_RETURN; - }; - virtual struct servent* Getservent(int &err) - { - struct servent *r = win32_getservent(); - PROCESS_AND_RETURN; - }; - virtual int Getsockname(SOCKET s, struct sockaddr* name, int* namelen, int &err) - { - int r = win32_getsockname(s, name, namelen); - PROCESS_AND_RETURN; - }; - virtual int Getsockopt(SOCKET s, int level, int optname, char* optval, int* optlen, int &err) - { - int r = win32_getsockopt(s, level, optname, optval, optlen); - PROCESS_AND_RETURN; - }; - virtual unsigned long InetAddr(const char* cp, int &err) - { - unsigned long r = win32_inet_addr(cp); - PROCESS_AND_RETURN; - }; - virtual char* InetNtoa(struct in_addr in, int &err) - { - char *r = win32_inet_ntoa(in); - PROCESS_AND_RETURN; - }; - virtual int Listen(SOCKET s, int backlog, int &err) - { - int r = win32_listen(s, backlog); - PROCESS_AND_RETURN; - }; - virtual int Recv(SOCKET s, char* buffer, int len, int flags, int &err) - { - int r = win32_recv(s, buffer, len, flags); - PROCESS_AND_RETURN; - }; - virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err) - { - int r = win32_recvfrom(s, buffer, len, flags, from, fromlen); - PROCESS_AND_RETURN; - }; - virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err) - { - int r = win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout); - PROCESS_AND_RETURN; - }; - virtual int Send(SOCKET s, const char* buffer, int len, int flags, int &err) - { - int r = win32_send(s, buffer, len, flags); - PROCESS_AND_RETURN; - }; - virtual int Sendto(SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen, int &err) - { - int r = win32_sendto(s, buffer, len, flags, to, tolen); - PROCESS_AND_RETURN; - }; - virtual void Sethostent(int stayopen, int &err) - { - win32_sethostent(stayopen); - }; - virtual void Setnetent(int stayopen, int &err) - { - win32_setnetent(stayopen); - }; - virtual void Setprotoent(int stayopen, int &err) - { - win32_setprotoent(stayopen); - }; - virtual void Setservent(int stayopen, int &err) - { - win32_setservent(stayopen); - }; - virtual int Setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen, int &err) - { - int r = win32_setsockopt(s, level, optname, optval, optlen); - PROCESS_AND_RETURN; - }; - virtual int Shutdown(SOCKET s, int how, int &err) - { - int r = win32_shutdown(s, how); - PROCESS_AND_RETURN; - }; - virtual SOCKET Socket(int af, int type, int protocol, int &err) - { - SOCKET r = win32_socket(af, type, protocol); - PROCESS_AND_RETURN; - }; - virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err) - { - croak("socketpair not implemented!\n"); - return 0; - }; - virtual int Closesocket(SOCKET s, int& err) - { - int r = win32_closesocket(s); - PROCESS_AND_RETURN; - }; - virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err) - { - int r = win32_ioctlsocket(s, cmd, argp); - PROCESS_AND_RETURN; - }; -}; - +#include "perlhost.h" -#define CALLFUNCRET(x)\ - int ret = x;\ - if(ret)\ - err = errno;\ - return ret; -#define CALLFUNCERR(x)\ - int ret = x;\ - if(errno)\ - err = errno;\ - return ret; - -#define LCALLFUNCERR(x)\ - long ret = x;\ - if(errno)\ - err = errno;\ - return ret; - -class CPerlLIO : public IPerlLIO -{ -public: - CPerlLIO() {}; - virtual int Access(const char *path, int mode, int &err) - { - CALLFUNCRET(access(path, mode)) - }; - virtual int Chmod(const char *filename, int pmode, int &err) - { - CALLFUNCRET(chmod(filename, pmode)) - }; - virtual int Chown(const char *filename, uid_t owner, gid_t group, int &err) - { - CALLFUNCERR(chown(filename, owner, group)) - }; - virtual int Chsize(int handle, long size, int &err) - { - CALLFUNCRET(chsize(handle, size)) - }; - virtual int Close(int handle, int &err) - { - CALLFUNCRET(win32_close(handle)) - }; - virtual int Dup(int handle, int &err) - { - CALLFUNCERR(win32_dup(handle)) - }; - virtual int Dup2(int handle1, int handle2, int &err) - { - CALLFUNCERR(win32_dup2(handle1, handle2)) - }; - virtual int Flock(int fd, int oper, int &err) - { - CALLFUNCERR(win32_flock(fd, oper)) - }; - virtual int FileStat(int handle, struct stat *buffer, int &err) - { - CALLFUNCERR(fstat(handle, buffer)) - }; - virtual int IOCtl(int i, unsigned int u, char *data, int &err) - { - CALLFUNCERR(win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data)) - }; - virtual int Isatty(int fd, int &err) - { - return isatty(fd); - }; - virtual long Lseek(int handle, long offset, int origin, int &err) - { - LCALLFUNCERR(win32_lseek(handle, offset, origin)) - }; - virtual int Lstat(const char *path, struct stat *buffer, int &err) - { - return NameStat(path, buffer, err); - }; - virtual char *Mktemp(char *Template, int &err) - { - return mktemp(Template); - }; - virtual int Open(const char *filename, int oflag, int &err) - { - CALLFUNCERR(win32_open(filename, oflag)) - }; - virtual int Open(const char *filename, int oflag, int pmode, int &err) - { - int ret; - if(stricmp(filename, "/dev/null") == 0) - ret = open("NUL", oflag, pmode); - else - ret = open(filename, oflag, pmode); - - if(errno) - err = errno; - return ret; - }; - virtual int Read(int handle, void *buffer, unsigned int count, int &err) - { - CALLFUNCERR(win32_read(handle, buffer, count)) - }; - virtual int Rename(const char *OldFileName, const char *newname, int &err) - { - char szNewWorkName[MAX_PATH+1]; - WIN32_FIND_DATA fdOldFile, fdNewFile; - HANDLE handle; - char *ptr; - - if((strchr(OldFileName, '\\') || strchr(OldFileName, '/')) - && strchr(newname, '\\') == NULL - && strchr(newname, '/') == NULL) - { - strcpy(szNewWorkName, OldFileName); - if((ptr = strrchr(szNewWorkName, '\\')) == NULL) - ptr = strrchr(szNewWorkName, '/'); - strcpy(++ptr, newname); - } - else - strcpy(szNewWorkName, newname); - - if(stricmp(OldFileName, szNewWorkName) != 0) - { // check that we're not being fooled by relative paths - // and only delete the new file - // 1) if it exists - // 2) it is not the same file as the old file - // 3) old file exist - // GetFullPathName does not return the long file name on some systems - handle = FindFirstFile(OldFileName, &fdOldFile); - if(handle != INVALID_HANDLE_VALUE) - { - FindClose(handle); - - handle = FindFirstFile(szNewWorkName, &fdNewFile); - - if(handle != INVALID_HANDLE_VALUE) - FindClose(handle); - else - fdNewFile.cFileName[0] = '\0'; - - if(strcmp(fdOldFile.cAlternateFileName, fdNewFile.cAlternateFileName) != 0 - && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0) - { // file exists and not same file - DeleteFile(szNewWorkName); - } - } - } - int ret = rename(OldFileName, szNewWorkName); - if(ret) - err = errno; - - return ret; - }; - virtual int Setmode(int handle, int mode, int &err) - { - CALLFUNCRET(win32_setmode(handle, mode)) - }; - virtual int NameStat(const char *path, struct stat *buffer, int &err) - { - return win32_stat(path, buffer); - }; - virtual char *Tmpnam(char *string, int &err) - { - return tmpnam(string); - }; - virtual int Umask(int pmode, int &err) - { - return umask(pmode); - }; - virtual int Unlink(const char *filename, int &err) - { - chmod(filename, S_IREAD | S_IWRITE); - CALLFUNCRET(unlink(filename)) - }; - virtual int Utime(char *filename, struct utimbuf *times, int &err) - { - CALLFUNCRET(win32_utime(filename, times)) - }; - virtual int Write(int handle, const void *buffer, unsigned int count, int &err) - { - CALLFUNCERR(win32_write(handle, buffer, count)) - }; -}; - -class CPerlMem : public IPerlMem -{ -public: - CPerlMem() {}; - virtual void* Malloc(size_t size) - { - return win32_malloc(size); - }; - virtual void* Realloc(void* ptr, size_t size) - { - return win32_realloc(ptr, size); - }; - virtual void Free(void* ptr) - { - win32_free(ptr); - }; -}; - -#define EXECF_EXEC 1 -#define EXECF_SPAWN 2 - -extern char *g_getlogin(void); -extern int do_spawn2(char *cmd, int exectype); -extern int g_do_aspawn(void *vreally, void **vmark, void **vsp); -class CPerlProc : public IPerlProc -{ -public: - CPerlProc() {}; - virtual void Abort(void) - { - win32_abort(); - }; - virtual void Exit(int status) - { - exit(status); - }; - virtual void _Exit(int status) - { - _exit(status); - }; - virtual int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) - { - return execl(cmdname, arg0, arg1, arg2, arg3); - }; - virtual int Execv(const char *cmdname, const char *const *argv) - { - return win32_execvp(cmdname, argv); - }; - virtual int Execvp(const char *cmdname, const char *const *argv) - { - return win32_execvp(cmdname, argv); - }; - virtual uid_t Getuid(void) - { - return getuid(); - }; - virtual uid_t Geteuid(void) - { - return geteuid(); - }; - virtual gid_t Getgid(void) - { - return getgid(); - }; - virtual gid_t Getegid(void) - { - return getegid(); - }; - virtual char *Getlogin(void) - { - return g_getlogin(); - }; - virtual int Kill(int pid, int sig) - { - return win32_kill(pid, sig); - }; - virtual int Killpg(int pid, int sig) - { - croak("killpg not implemented!\n"); - return 0; - }; - virtual int PauseProc(void) - { - return win32_sleep((32767L << 16) + 32767); - }; - virtual PerlIO* Popen(const char *command, const char *mode) - { - win32_fflush(stdout); - win32_fflush(stderr); - return (PerlIO*)win32_popen(command, mode); - }; - virtual int Pclose(PerlIO *stream) - { - return win32_pclose((FILE*)stream); - }; - virtual int Pipe(int *phandles) - { - return win32_pipe(phandles, 512, O_BINARY); - }; - virtual int Setuid(uid_t u) - { - return setuid(u); - }; - virtual int Setgid(gid_t g) - { - return setgid(g); - }; - virtual int Sleep(unsigned int s) - { - return win32_sleep(s); - }; - virtual int Times(struct tms *timebuf) - { - return win32_times(timebuf); - }; - virtual int Wait(int *status) - { - return win32_wait(status); - }; - virtual int Waitpid(int pid, int *status, int flags) - { - return win32_waitpid(pid, status, flags); - }; - virtual Sighandler_t Signal(int sig, Sighandler_t subcode) - { - return 0; - }; - virtual void GetSysMsg(char*& sMsg, DWORD& dwLen, DWORD dwErr) - { - dwLen = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER - |FORMAT_MESSAGE_IGNORE_INSERTS - |FORMAT_MESSAGE_FROM_SYSTEM, NULL, - dwErr, 0, (char *)&sMsg, 1, NULL); - if (0 < dwLen) { - while (0 < dwLen && isspace(sMsg[--dwLen])) - ; - if ('.' != sMsg[dwLen]) - dwLen++; - sMsg[dwLen]= '\0'; - } - if (0 == dwLen) { - sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); - dwLen = sprintf(sMsg, - "Unknown error #0x%lX (lookup 0x%lX)", - dwErr, GetLastError()); - } - }; - virtual void FreeBuf(char* sMsg) - { - LocalFree(sMsg); - }; - virtual BOOL DoCmd(char *cmd) - { - do_spawn2(cmd, EXECF_EXEC); - return FALSE; - }; - virtual int Spawn(char* cmds) - { - return do_spawn2(cmds, EXECF_SPAWN); - }; - virtual int Spawnvp(int mode, const char *cmdname, const char *const *argv) - { - return win32_spawnvp(mode, cmdname, argv); - }; - virtual int ASpawn(void *vreally, void **vmark, void **vsp) - { - return g_do_aspawn(vreally, vmark, vsp); - }; -}; - - -class CPerlStdIO : public IPerlStdIO -{ -public: - CPerlStdIO() {}; - virtual PerlIO* Stdin(void) - { - return (PerlIO*)win32_stdin(); - }; - virtual PerlIO* Stdout(void) - { - return (PerlIO*)win32_stdout(); - }; - virtual PerlIO* Stderr(void) - { - return (PerlIO*)win32_stderr(); - }; - virtual PerlIO* Open(const char *path, const char *mode, int &err) - { - PerlIO*pf = (PerlIO*)win32_fopen(path, mode); - if(errno) - err = errno; - return pf; - }; - virtual int Close(PerlIO* pf, int &err) - { - CALLFUNCERR(win32_fclose(((FILE*)pf))) - }; - virtual int Eof(PerlIO* pf, int &err) - { - CALLFUNCERR(win32_feof((FILE*)pf)) - }; - virtual int Error(PerlIO* pf, int &err) - { - CALLFUNCERR(win32_ferror((FILE*)pf)) - }; - virtual void Clearerr(PerlIO* pf, int &err) - { - win32_clearerr((FILE*)pf); - }; - virtual int Getc(PerlIO* pf, int &err) - { - CALLFUNCERR(win32_getc((FILE*)pf)) - }; - virtual char* GetBase(PerlIO* pf, int &err) - { - FILE *f = (FILE*)pf; - return FILE_base(f); - }; - virtual int GetBufsiz(PerlIO* pf, int &err) - { - FILE *f = (FILE*)pf; - return FILE_bufsiz(f); - }; - virtual int GetCnt(PerlIO* pf, int &err) - { - FILE *f = (FILE*)pf; - return FILE_cnt(f); - }; - virtual char* GetPtr(PerlIO* pf, int &err) - { - FILE *f = (FILE*)pf; - return FILE_ptr(f); - }; - virtual char* Gets(PerlIO* pf, char* s, int n, int& err) - { - char* ret = win32_fgets(s, n, (FILE*)pf); - if(errno) - err = errno; - return ret; - }; - virtual int Putc(PerlIO* pf, int c, int &err) - { - CALLFUNCERR(win32_fputc(c, (FILE*)pf)) - }; - virtual int Puts(PerlIO* pf, const char *s, int &err) - { - CALLFUNCERR(win32_fputs(s, (FILE*)pf)) - }; - virtual int Flush(PerlIO* pf, int &err) - { - CALLFUNCERR(win32_fflush((FILE*)pf)) - }; - virtual int Ungetc(PerlIO* pf,int c, int &err) - { - CALLFUNCERR(win32_ungetc(c, (FILE*)pf)) - }; - virtual int Fileno(PerlIO* pf, int &err) - { - CALLFUNCERR(win32_fileno((FILE*)pf)) - }; - virtual PerlIO* Fdopen(int fd, const char *mode, int &err) - { - PerlIO* pf = (PerlIO*)win32_fdopen(fd, mode); - if(errno) - err = errno; - return pf; - }; - virtual PerlIO* Reopen(const char*path, const char*mode, PerlIO* pf, int &err) - { - PerlIO* newPf = (PerlIO*)win32_freopen(path, mode, (FILE*)pf); - if(errno) - err = errno; - return newPf; - }; - virtual SSize_t Read(PerlIO* pf, void *buffer, Size_t size, int &err) - { - SSize_t i = win32_fread(buffer, 1, size, (FILE*)pf); - if(errno) - err = errno; - return i; - }; - virtual SSize_t Write(PerlIO* pf, const void *buffer, Size_t size, int &err) - { - SSize_t i = win32_fwrite(buffer, 1, size, (FILE*)pf); - if(errno) - err = errno; - return i; - }; - virtual void SetBuf(PerlIO* pf, char* buffer, int &err) - { - win32_setbuf((FILE*)pf, buffer); - }; - virtual int SetVBuf(PerlIO* pf, char* buffer, int type, Size_t size, int &err) - { - int i = win32_setvbuf((FILE*)pf, buffer, type, size); - if(errno) - err = errno; - return i; - }; - virtual void SetCnt(PerlIO* pf, int n, int &err) - { - FILE *f = (FILE*)pf; - FILE_cnt(f) = n; - }; - virtual void SetPtrCnt(PerlIO* pf, char * ptr, int n, int& err) - { - FILE *f = (FILE*)pf; - FILE_ptr(f) = ptr; - FILE_cnt(f) = n; - }; - virtual void Setlinebuf(PerlIO* pf, int &err) - { - win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0); - }; - virtual int Printf(PerlIO* pf, int &err, const char *format,...) - { - va_list(arglist); - va_start(arglist, format); - int i = win32_vfprintf((FILE*)pf, format, arglist); - if(errno) - err = errno; - return i; - }; - virtual int Vprintf(PerlIO* pf, int &err, const char *format, va_list arglist) - { - int i = win32_vfprintf((FILE*)pf, format, arglist); - if(errno) - err = errno; - return i; - }; - virtual long Tell(PerlIO* pf, int &err) - { - long l = win32_ftell((FILE*)pf); - if(errno) - err = errno; - return l; - }; - virtual int Seek(PerlIO* pf, off_t offset, int origin, int &err) - { - int i = win32_fseek((FILE*)pf, offset, origin); - if(errno) - err = errno; - return i; - }; - virtual void Rewind(PerlIO* pf, int &err) - { - win32_rewind((FILE*)pf); - }; - virtual PerlIO* Tmpfile(int &err) - { - PerlIO* pf = (PerlIO*)win32_tmpfile(); - if(errno) - err = errno; - return pf; - }; - virtual int Getpos(PerlIO* pf, Fpos_t *p, int &err) - { - int i = win32_fgetpos((FILE*)pf, p); - if(errno) - err = errno; - return i; - }; - virtual int Setpos(PerlIO* pf, const Fpos_t *p, int &err) - { - int i = win32_fsetpos((FILE*)pf, p); - if(errno) - err = errno; - return i; - }; - virtual void Init(int &err) - { - }; - virtual void InitOSExtras(void* p) - { - Perl_init_os_extras(); - }; - virtual int OpenOSfhandle(long osfhandle, int flags) - { - return win32_open_osfhandle(osfhandle, flags); - } - virtual int GetOSfhandle(int filenum) - { - return win32_get_osfhandle(filenum); - } +char *staticlinkmodules[] = { + "DynaLoader", + NULL, }; +EXTERN_C void boot_DynaLoader _((CV* cv _CPERLarg)); -static void xs_init _((CPERLarg)); - -class CPerlHost +static void +xs_init(CPERLarg) { -public: - CPerlHost() { pPerl = NULL; }; - inline BOOL PerlCreate(void) - { - try - { - pPerl = perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, &perlDir, &perlSock, &perlProc); - if(pPerl != NULL) - { - try - { - pPerl->perl_construct(); - } - catch(...) - { - win32_fprintf(stderr, "%s\n", "Error: Unable to construct data structures"); - pPerl->perl_free(); - pPerl = NULL; - } - } - } - catch(...) - { - win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory"); - pPerl = NULL; - } - return (pPerl != NULL); - }; - inline int PerlParse(int argc, char** argv, char** env) - { - int retVal; - try - { - retVal = pPerl->perl_parse(xs_init, argc, argv, env); - } - catch(int x) - { - // this is where exit() should arrive - retVal = x; - } - catch(...) - { - win32_fprintf(stderr, "Error: Parse exception\n"); - retVal = -1; - } - *win32_errno() = 0; - return retVal; - }; - inline int PerlRun(void) - { - int retVal; - try - { - retVal = pPerl->perl_run(); - } - catch(int x) - { - // this is where exit() should arrive - retVal = x; - } - catch(...) - { - win32_fprintf(stderr, "Error: Runtime exception\n"); - retVal = -1; - } - return retVal; - }; - inline void PerlDestroy(void) - { - try - { - pPerl->perl_destruct(); - pPerl->perl_free(); - } - catch(...) - { - } - }; + char *file = __FILE__; + dXSUB_SYS; + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); +} -protected: - CPerlDir perlDir; - CPerlEnv perlEnv; - CPerlLIO perlLIO; - CPerlMem perlMem; - CPerlProc perlProc; - CPerlSock perlSock; - CPerlStdIO perlStdIO; -}; +CPerlObj *pPerl; #undef PERL_SYS_INIT #define PERL_SYS_INIT(a, c) @@ -1001,34 +41,16 @@ main(int argc, char **argv, char **env) if(!host.PerlCreate()) exit(exitstatus); - - exitstatus = host.PerlParse(argc, argv, NULL); + exitstatus = host.PerlParse(xs_init, argc, argv, NULL); if (!exitstatus) - { exitstatus = host.PerlRun(); - } host.PerlDestroy(); return exitstatus; } -char *staticlinkmodules[] = { - "DynaLoader", - NULL, -}; - -EXTERN_C void boot_DynaLoader _((CV* cv _CPERLarg)); - -static void -xs_init(CPERLarg) -{ - char *file = __FILE__; - dXSUB_SYS; - newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); -} - #else /* PERL_OBJECT */ #ifdef __GNUC__ diff --git a/win32/win32.h b/win32/win32.h index eaced2821e..e1cf335435 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -152,6 +152,55 @@ typedef long uid_t; typedef long gid_t; #pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761) +#ifndef PERL_OBJECT + +/* Visual C thinks that a pointer to a member variable is 16 bytes in size. */ +#define STRUCT_MGVTBL_DEFINITION \ +struct mgvtbl { \ + union { \ + int (CPERLscope(*svt_get)) _((SV *sv, MAGIC* mg)); \ + char handle_VC_problem1[16]; \ + }; \ + union { \ + int (CPERLscope(*svt_set)) _((SV *sv, MAGIC* mg)); \ + char handle_VC_problem2[16]; \ + }; \ + union { \ + U32 (CPERLscope(*svt_len)) _((SV *sv, MAGIC* mg)); \ + char handle_VC_problem3[16]; \ + }; \ + union { \ + int (CPERLscope(*svt_clear)) _((SV *sv, MAGIC* mg)); \ + char handle_VC_problem4[16]; \ + }; \ + union { \ + int (CPERLscope(*svt_free)) _((SV *sv, MAGIC* mg)); \ + char handle_VC_problem5[16]; \ + }; \ +} + +#define BASEOP_DEFINITION \ + OP* op_next; \ + OP* op_sibling; \ + OP* (CPERLscope(*op_ppaddr))_((ARGSproto)); \ + char handle_VC_problem[12]; \ + PADOFFSET op_targ; \ + OPCODE op_type; \ + U16 op_seq; \ + U8 op_flags; \ + U8 op_private; + +#define UNION_ANY_DEFINITION union any { \ + void* any_ptr; \ + I32 any_i32; \ + IV any_iv; \ + long any_long; \ + void (CPERLscope(*any_dptr)) _((void*)); \ + char handle_VC_problem[16]; \ +} + +#endif /* PERL_OBJECT */ + #endif /* _MSC_VER */ #ifdef __MINGW32__ /* Minimal Gnu-Win32 */ |