# endif
# define win32_get_privlib PerlEnv_lib_path
# define win32_get_sitelib PerlEnv_sitelib_path
-#endif
-
-#if defined(PERL_IMPLICIT_CONTEXT)
-# define PERL_GET_INTERP ((PerlInterpreter*)GetPerlInterpreter())
-# define PERL_SET_INTERP(i) (SetPerlInterpreter(i))
+# define win32_get_vendorlib PerlEnv_vendorlib_path
#endif
#ifdef __GNUC__
#include <stdio.h>
#include <direct.h>
#include <stdlib.h>
+#include <fcntl.h>
#ifndef EXT
#include "EXTERN.h"
#endif
#define PERL_SOCK_SYSREAD_IS_RECV
#define PERL_SOCK_SYSWRITE_IS_SEND
+#define PERL_NO_FORCE_LINK /* no need for PL_force_link_funcs */
-/* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls
- * to read the environment, bypassing the runtime's (usually broken)
- * facilities for accessing the same. See note in util.c/my_setenv(). */
-/*#define USE_WIN32_RTL_ENV */
-
-/* Define USE_FIXED_OSFHANDLE to fix VC's _open_osfhandle() on W95.
- * Can only enable it if not using the DLL CRT (it doesn't expose internals) */
-#if defined(_MSC_VER) && !defined(_DLL) && defined(_M_IX86)
+/* Define USE_FIXED_OSFHANDLE to fix MSVCRT's _open_osfhandle() on W95.
+ It now uses some black magic to work seamlessly with the DLL CRT and
+ works with MSVC++ 4.0+ or GCC/Mingw32
+ -- BKS 1-24-2000 */
+#if (defined(_M_IX86) && _MSC_VER >= 1000) || defined(__MINGW32__)
#define USE_FIXED_OSFHANDLE
#endif
+/* Define PERL_WIN32_SOCK_DLOAD to have Perl dynamically load the winsock
+ DLL when needed. Don't use if your compiler supports delayloading (ie, VC++ 6.0)
+ -- BKS 5-29-2000 */
+#if !(defined(_M_IX86) && _MSC_VER >= 1200)
+#define PERL_WIN32_SOCK_DLOAD
+#endif
#define ENV_IS_CASELESS
#ifndef VER_PLATFORM_WIN32_WINDOWS /* VC-2.0 headers don't have this */
# define F_OK 0
#endif
+/* for waitpid() */
+#ifndef WNOHANG
+# define WNOHANG 1
+#endif
+
+#define PERL_GET_CONTEXT_DEFINED
+
/* Compiler-specific stuff. */
#ifdef __BORLANDC__ /* Borland C++ */
+#if (__BORLANDC__ <= 0x520)
#define _access access
#define _chdir chdir
+#endif
+
#define _getpid getpid
+#define wcsicmp _wcsicmp
#include <sys/types.h>
#ifndef DllMain
#pragma warn -aus /* "'foo' is assigned a value that is never used" */
#pragma warn -use /* "'foo' is declared but never used" */
#pragma warn -csu /* "comparing signed and unsigned values" */
-#pragma warn -pro /* "call to function with no prototype" */
-#pragma warn -stu /* "undefined structure 'foo'" */
/* Borland is picky about a bare member function name used as its ptr */
#ifdef PERL_OBJECT
# define MEMBER_TO_FPTR(name) &(name)
#endif
+/* Borland C thinks that a pointer to a member variable is 12 bytes in size. */
+#define PERL_MEMBER_PTR_SIZE 12
+
+#define isnan _isnan
+
#endif
#ifdef _MSC_VER /* Microsoft Visual C++ */
typedef unsigned short mode_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))(pTHX_ SV *sv, MAGIC* mg); \
- char handle_VC_problem1[16]; \
- }; \
- union { \
- int (CPERLscope(*svt_set))(pTHX_ SV *sv, MAGIC* mg); \
- char handle_VC_problem2[16]; \
- }; \
- union { \
- U32 (CPERLscope(*svt_len))(pTHX_ SV *sv, MAGIC* mg); \
- char handle_VC_problem3[16]; \
- }; \
- union { \
- int (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg); \
- char handle_VC_problem4[16]; \
- }; \
- union { \
- int (CPERLscope(*svt_free))(pTHX_ SV *sv, MAGIC* mg); \
- char handle_VC_problem5[16]; \
- }; \
-}
+#define PERL_MEMBER_PTR_SIZE 16
-#define BASEOP_DEFINITION \
- OP* op_next; \
- OP* op_sibling; \
- OP* (CPERLscope(*op_ppaddr))(pTHX); \
- char handle_VC_problem[12]; \
- PADOFFSET op_targ; \
- OPCODE op_type; \
- U16 op_seq; \
- U8 op_flags; \
- U8 op_private;
-
-#endif /* PERL_OBJECT */
+#define isnan _isnan
#endif /* _MSC_VER */
#endif
#define flushall _flushall
#define fcloseall _fcloseall
-
-#ifndef CP_UTF8
-# define CP_UTF8 65001
-#endif
+#define isnan _isnan /* ...same libraries as MSVC */
#ifdef PERL_OBJECT
# define MEMBER_TO_FPTR(name) &(name)
#endif /* __MINGW32__ */
+/* both GCC/Mingw32 and MSVC++ 4.0 are missing this, so we put it here */
+#ifndef CP_UTF8
+# define CP_UTF8 65001
+#endif
+
/* compatibility stuff for other compilers goes here */
+#if !defined(PERL_OBJECT) && defined(PERL_CAPI) && defined(PERL_MEMBER_PTR_SIZE)
+# define STRUCT_MGVTBL_DEFINITION \
+struct mgvtbl { \
+ union { \
+ int (CPERLscope(*svt_get))(pTHX_ SV *sv, MAGIC* mg); \
+ char handle_VC_problem1[PERL_MEMBER_PTR_SIZE]; \
+ }; \
+ union { \
+ int (CPERLscope(*svt_set))(pTHX_ SV *sv, MAGIC* mg); \
+ char handle_VC_problem2[PERL_MEMBER_PTR_SIZE]; \
+ }; \
+ union { \
+ U32 (CPERLscope(*svt_len))(pTHX_ SV *sv, MAGIC* mg); \
+ char handle_VC_problem3[PERL_MEMBER_PTR_SIZE]; \
+ }; \
+ union { \
+ int (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg); \
+ char handle_VC_problem4[PERL_MEMBER_PTR_SIZE]; \
+ }; \
+ union { \
+ int (CPERLscope(*svt_free))(pTHX_ SV *sv, MAGIC* mg); \
+ char handle_VC_problem5[PERL_MEMBER_PTR_SIZE]; \
+ }; \
+}
+
+# define BASEOP_DEFINITION \
+ OP* op_next; \
+ OP* op_sibling; \
+ OP* (CPERLscope(*op_ppaddr))(pTHX); \
+ char handle_VC_problem[PERL_MEMBER_PTR_SIZE-sizeof(OP*)]; \
+ PADOFFSET op_targ; \
+ OPCODE op_type; \
+ U16 op_seq; \
+ U8 op_flags; \
+ U8 op_private;
+
+#endif /* !PERL_OBJECT && PERL_CAPI && PERL_MEMBER_PTR_SIZE */
+
+
START_EXTERN_C
/* For UNIX compatibility. */
extern void *sbrk(int need);
extern char * getlogin(void);
extern int chown(const char *p, uid_t o, gid_t g);
+extern int mkstemp(const char *path);
#undef Stat
#define Stat win32_stat
#define init_os_extras Perl_init_os_extras
DllExport void Perl_win32_init(int *argcp, char ***argvp);
-DllExport void Perl_init_os_extras();
+DllExport void Perl_init_os_extras(void);
DllExport void win32_str_os_error(void *sv, DWORD err);
DllExport int RunPerl(int argc, char **argv, char **env);
-DllExport bool SetPerlInterpreter(void* interp);
-DllExport void* GetPerlInterpreter(void);
+
+typedef struct {
+ HANDLE childStdIn;
+ HANDLE childStdOut;
+ HANDLE childStdErr;
+ /*
+ * the following correspond to the fields of the same name
+ * in the STARTUPINFO structure. Embedders can use these to
+ * control the spawning process' look.
+ * Example - to hide the window of the spawned process:
+ * dwFlags = STARTF_USESHOWWINDOW;
+ * wShowWindow = SW_HIDE;
+ */
+ DWORD dwFlags;
+ DWORD dwX;
+ DWORD dwY;
+ DWORD dwXSize;
+ DWORD dwYSize;
+ DWORD dwXCountChars;
+ DWORD dwYCountChars;
+ DWORD dwFillAttribute;
+ WORD wShowWindow;
+} child_IO_table;
+
+DllExport void win32_get_child_IO(child_IO_table* ptr);
#ifndef USE_SOCKETS_AS_HANDLES
extern FILE * my_fdopen(int, char *);
#endif
extern int my_fclose(FILE *);
+extern int my_fstat(int fd, struct stat *sbufptr);
extern int do_aspawn(void *really, void **mark, void **sp);
extern int do_spawn(char *cmd);
extern int do_spawn_nowait(char *cmd);
-extern char * win32_get_privlib(char *pl);
-extern char * win32_get_sitelib(char *pl);
+extern char * win32_get_privlib(const char *pl);
+extern char * win32_get_sitelib(const char *pl);
+extern char * win32_get_vendorlib(const char *pl);
extern int IsWin95(void);
extern int IsWinNT(void);
+extern void win32_argv2utf8(int argc, char** argv);
+
+#ifdef PERL_IMPLICIT_SYS
+extern void win32_delete_internal_host(void *h);
+#endif
extern char * staticlinkmodules[];
#define PERL_CORE
#endif
-#ifdef USE_TEXTMODE_SCRIPTS
+#ifdef PERL_TEXTMODE_SCRIPTS
# define PERL_SCRIPT_MODE "r"
#else
# define PERL_SCRIPT_MODE "rb"
/* Use CP_ACP when mode is ANSI */
/* Use CP_UTF8 when mode is UTF8 */
-#define A2WHELPER(lpa, lpw, nBytes)\
- lpw[0] = 0, MultiByteToWideChar((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpa, -1, lpw, (nBytes/sizeof(WCHAR)))
+#define A2WHELPER_LEN(lpa, alen, lpw, nBytes)\
+ (lpw[0] = 0, MultiByteToWideChar((IN_BYTE) ? CP_ACP : CP_UTF8, 0, \
+ lpa, alen, lpw, (nBytes/sizeof(WCHAR))))
+#define A2WHELPER(lpa, lpw, nBytes) A2WHELPER_LEN(lpa, -1, lpw, nBytes)
-#define W2AHELPER(lpw, lpa, nChars)\
- lpa[0] = '\0', WideCharToMultiByte((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpw, -1, (LPSTR)lpa, nChars, NULL, NULL)
+#define W2AHELPER_LEN(lpw, wlen, lpa, nChars)\
+ (lpa[0] = '\0', WideCharToMultiByte((IN_BYTE) ? CP_ACP : CP_UTF8, 0, \
+ lpw, wlen, (LPSTR)lpa, nChars,NULL,NULL))
+#define W2AHELPER(lpw, lpa, nChars) W2AHELPER_LEN(lpw, -1, lpa, nChars)
-#define USING_WIDE() (PerlEnv_os_id() == VER_PLATFORM_WIN32_NT)
+#define USING_WIDE() (PL_widesyscalls && PerlEnv_os_id() == VER_PLATFORM_WIN32_NT)
#ifdef USE_ITHREADS
# define PERL_WAIT_FOR_CHILDREN \
} STMT_END
#endif
+#if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
+#ifdef PERL_CORE
+
+/* C doesn't like repeat struct definitions */
+#ifndef _CRTIMP
+#define _CRTIMP __declspec(dllimport)
+#endif
+
+/*
+ * Control structure for lowio file handles
+ */
+typedef struct {
+ long osfhnd; /* underlying OS file HANDLE */
+ char osfile; /* attributes of file (e.g., open in text mode?) */
+ char pipech; /* one char buffer for handles opened on pipes */
+ int lockinitflag;
+ CRITICAL_SECTION lock;
+} ioinfo;
+
+
+/*
+ * Array of arrays of control structures for lowio files.
+ */
+EXTERN_C _CRTIMP ioinfo* __pioinfo[];
+
+/*
+ * Definition of IOINFO_L2E, the log base 2 of the number of elements in each
+ * array of ioinfo structs.
+ */
+#define IOINFO_L2E 5
+
+/*
+ * Definition of IOINFO_ARRAY_ELTS, the number of elements in ioinfo array
+ */
+#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E)
+
+/*
+ * Access macros for getting at an ioinfo struct and its fields from a
+ * file handle
+ */
+#define _pioinfo(i) (__pioinfo[(i) >> IOINFO_L2E] + ((i) & (IOINFO_ARRAY_ELTS - 1)))
+#define _osfhnd(i) (_pioinfo(i)->osfhnd)
+#define _osfile(i) (_pioinfo(i)->osfile)
+#define _pipech(i) (_pioinfo(i)->pipech)
+
+/* since we are not doing a dup2(), this works fine */
+#define _set_osfhnd(fh, osfh) (void)(_osfhnd(fh) = (long)osfh)
+#endif
+#endif
+
+#define PERLIO_NOT_STDIO 0
+
+#include "perlio.h"
+
/*
* This provides a layer of functions and macros to ensure extensions will
* get to use the same RTL functions as the core.
*/
#include "win32iop.h"
+#define EXEC_ARGV_CAST(x) ((const char *const *) x)
+
#endif /* _INC_WIN32_PERL5 */