diff options
author | Nick Ing-Simmons <nik@tiuk.ti.com> | 1998-06-23 18:15:23 +0000 |
---|---|---|
committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 1998-06-23 18:15:23 +0000 |
commit | ba7e4437aa27a0775f31400cfe7bcaf273e14ef3 (patch) | |
tree | 9dd37616d934a5c958ddd16501d691dc025bf90a /win32 | |
parent | 4e61ee4d2394e4b120037f733150ee6041bf95f2 (diff) | |
parent | 9666903d92ab8cdd420a0bc714d5c94ce051cb2c (diff) | |
download | perl-ba7e4437aa27a0775f31400cfe7bcaf273e14ef3.tar.gz |
Integrate mainline c. 5.004_68 into ansiperl, mainly
so see what has changed...
p4raw-id: //depot/ansiperl@1208
Diffstat (limited to 'win32')
-rw-r--r-- | win32/GenCAPI.pl | 1 | ||||
-rw-r--r-- | win32/Makefile | 135 | ||||
-rw-r--r-- | win32/config.bc | 1 | ||||
-rw-r--r-- | win32/config.gc | 1 | ||||
-rw-r--r-- | win32/config.vc | 1 | ||||
-rw-r--r-- | win32/config_H.bc | 31 | ||||
-rw-r--r-- | win32/config_H.gc | 31 | ||||
-rw-r--r-- | win32/config_H.vc | 31 | ||||
-rw-r--r-- | win32/dl_win32.xs | 8 | ||||
-rw-r--r-- | win32/makefile.mk | 132 | ||||
-rw-r--r-- | win32/perlhost.h | 971 | ||||
-rw-r--r-- | win32/pod.mak | 62 | ||||
-rw-r--r-- | win32/runperl.c | 1006 | ||||
-rw-r--r-- | win32/win32.c | 4 | ||||
-rw-r--r-- | win32/win32.h | 49 |
15 files changed, 1350 insertions, 1114 deletions
diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl index 2e136ed5c6..dbe9fd7f8a 100644 --- a/win32/GenCAPI.pl +++ b/win32/GenCAPI.pl @@ -71,6 +71,7 @@ safexcalloc safexrealloc safexfree Perl_GetVars +malloced_size )]; diff --git a/win32/Makefile b/win32/Makefile index de36c42180..045834d9b1 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1,17 +1,22 @@ -# Makefile to build perl on Windowns NT using Microsoft NMAKE. -# Works with MS command line compilers from VC++ etc. +# +# Makefile to build perl on Windows NT using Microsoft NMAKE. # # This is set up to build a perl.exe that runs off a shared library # (perl.dll). Also makes individual DLLs for the XS extensions. -# NB: Miniperl has a different set of objects it depends on than -# perl.exe -# Also, Miniperl will not build with -DPERL_OBJECT defined +# + +## +## Build configuration. Edit the values below to suit your needs. +## + # # Set these to wherever you want "nmake install" to put your # newly built perl. +# INST_DRV = c: INST_TOP = $(INST_DRV)\perl +# # Comment this out if you DON'T want your perl installation to be versioned. # This means that the new installation will overwrite any files from the # old installation at the same INST_TOP location. Leaving it enabled is @@ -19,43 +24,58 @@ INST_TOP = $(INST_DRV)\perl # locations it installs files to. If you disable it, an alternative # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. -INST_VER = \5.00467 +# +INST_VER = \5.00468 # # uncomment to enable threads-capabilities +# #USE_THREADS = define # # uncomment next line if you are using Visual C++ 2.x +# #CCTYPE = MSVC20 # # uncomment next line if you want to use the perl object # Currently, this cannot be enabled if you ask for threads above +# #OBJECT = -DPERL_OBJECT # # uncomment next line if you want debug version of perl (big,slow) +# #CFG = Debug # +# uncomment to enable use of PerlCRT.DLL. Highly recommended. It has +# patches that fix known bugs in MSCVRT.DLL. You will need to download it +# from: <TBD> and follow the directions in the package to install. +# +#USE_PERLCRT = define + +# # if you have the source for des_fcrypt(), uncomment this and make sure the # file exists (see README.win32). File should be located at the perl # top level directory. +# #CRYPT_SRC = des_fcrypt.c # # if you didn't set CRYPT_SRC and if you have des_fcrypt() available in a # library, uncomment this, and make sure the library exists (see README.win32) # Specify the full pathname of the library. +# #CRYPT_LIB = des_fcrypt.lib # # set this if you wish to use perl's malloc # WARNING: Turning this on/off WILL break binary compatibility with extensions -# you may have compiled with/without it. Be prepared to recompile all extensions -# if you change the default. Currently, this cannot be enabled if you ask for -# PERL_OBJECT above. +# you may have compiled with/without it. Be prepared to recompile all +# extensions if you change the default. Currently, this cannot be enabled +# if you ask for PERL_OBJECT above. +# #PERL_MALLOC = define # @@ -67,10 +87,20 @@ CCINCDIR = $(CCHOME)\include CCLIBDIR = $(CCHOME)\lib # +# specify space-separated list of extra directories to look for libraries +# +EXTRALIBDIRS = + +# # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) +# #EMAIL = +## +## Build configuration ends. +## + ##################### CHANGE THESE ONLY IF YOU MUST ##################### !IF "$(CRYPT_SRC)$(CRYPT_LIB)" == "" @@ -130,8 +160,22 @@ LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console CXX_FLAG = -TP -GX +!IF "$(USE_PERLCRT)" == "" +! IF "$(CFG)" == "Debug" +PERLCRTLIBC = msvcrtd.lib +! ELSE +PERLCRTLIBC = msvcrt.lib +! ENDIF +!ELSE +! IF "$(CFG)" == "Debug" +PERLCRTLIBC = PerlCRTD.lib +! ELSE +PERLCRTLIBC = PerlCRT.lib +! ENDIF +!ENDIF + !IF "$(RUNTIME)" == "-MD" -LIBC = msvcrt.lib +LIBC = $(PERLCRTLIBC) !ELSE LIBC = libcmt.lib !ENDIF @@ -156,15 +200,17 @@ LINK_DBG = -release OPTIMIZE = $(OPTIMIZE) $(CXX_FLAG) !ENDIF -# we don't add LIBC here, the compiler does it based on -MD/-MT -LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ +LIBBASEFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ version.lib odbc32.lib odbccp32.lib +# we add LIBC here, since we may be using PerlCRT.dll +LIBFILES = $(LIBBASEFILES) $(LIBC) + CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \ $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) +LINK_FLAGS = -nologo -nodefaultlib $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) OBJOUT_FLAG = -Fo EXEOUT_FLAG = -Fe @@ -225,11 +271,37 @@ X2P = ..\x2p\a2p.exe PL2BAT = bin\pl2bat.pl GLOBBAT = bin\perlglob.bat +UTILS = \ + ..\utils\h2ph \ + ..\utils\splain \ + ..\utils\perlbug \ + ..\utils\pl2pm \ + ..\utils\c2ph \ + ..\utils\h2xs \ + ..\utils\perldoc \ + ..\utils\pstruct \ + ..\utils\perlcc \ + ..\pod\checkpods \ + ..\pod\pod2html \ + ..\pod\pod2latex \ + ..\pod\pod2man \ + ..\pod\pod2text \ + ..\x2p\find2perl \ + ..\x2p\s2p \ + bin\www.pl \ + bin\runperl.pl \ + bin\pl2bat.pl \ + bin\perlglob.pl \ + bin\search.pl + MAKE = nmake -nologo CFGSH_TMPL = config.vc CFGH_TMPL = config_H.vc + +!IF "$(USE_PERLCRT)" == "" PERL95EXE = ..\perl95.exe +!ENDIF XCOPY = xcopy /f /r /i /d RCOPY = xcopy /f /r /i /e /d @@ -325,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 \ @@ -444,8 +516,8 @@ CFG_VARS = \ "d_mymalloc=$(PERL_MALLOC)" \ "libs=$(LIBFILES)" \ "incpath=$(CCINCDIR)" \ - "libperl=$(PERLIMPLIB)" \ - "libpth=$(CCLIBDIR)" \ + "libperl=$(PERLIMPLIB:..\=)" \ + "libpth=$(CCLIBDIR) $(EXTRALIBDIRS)" \ "libc=$(LIBC)" \ "make=nmake" \ "static_ext=$(STATIC_EXT)" \ @@ -578,6 +650,8 @@ $(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) copy splittree.pl .. $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) +!IF "$(USE_PERLCRT)" == "" + perl95.c : runperl.c copy runperl.c perl95.c @@ -598,7 +672,9 @@ DynaLoadmt$(o) : $(DYNALOADER).c $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \ - $(LIBFILES) $(PERL95_OBJ) $(PERLIMPLIB) libcmt.lib + $(LIBBASEFILES) $(PERL95_OBJ) $(PERLIMPLIB) libcmt.lib + +!ENDIF $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) if not exist $(AUTODIR) mkdir $(AUTODIR) @@ -680,25 +756,18 @@ $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs cd ..\..\win32 doc: $(PERLEXE) - cd ..\pod - $(MAKE) -f ..\win32\pod.mak checkpods pod2html pod2latex \ - pod2man pod2text - $(XCOPY) *.bat ..\win32\bin\*.* - cd ..\win32 copy ..\README.win32 ..\pod\perlwin32.pod $(PERLEXE) -I..\lib ..\installhtml --podroot=.. --htmldir=./html \ --podpath=pod:lib:ext:utils --htmlroot="file://$(INST_HTML::=|)" \ --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse -utils: $(PERLEXE) +utils: $(PERLEXE) $(X2P) cd ..\utils $(MAKE) PERL=$(MINIPERL) - $(PERLEXE) -I..\lib ..\win32\$(PL2BAT) h2ph splain perlbug pl2pm c2ph - $(PERLEXE) ..\win32\$(PL2BAT) h2xs perldoc pstruct - $(XCOPY) *.bat ..\win32\bin\*.* + cd ..\pod + $(MAKE) -f ..\win32\pod.mak converters cd ..\win32 - $(PERLEXE) $(PL2BAT) bin\network.pl bin\www.pl bin\runperl.pl \ - bin\pl2bat.pl bin\perlglob.pl + $(PERLEXE) $(PL2BAT) $(UTILS) distclean: clean -del /f $(MINIPERL) $(PERLEXE) $(PERL95EXE) $(PERLDLL) $(GLOBEXE) \ @@ -735,16 +804,16 @@ distclean: clean -rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR) -rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR) -install : all installbare installutils installhtml +install : all installbare installhtml -installbare : +installbare : utils $(PERLEXE) ..\installperl +!IF "$(USE_PERLCRT)" == "" $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.* - -installutils : utils +!ENDIF $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* $(XCOPY) bin\*.bat $(INST_SCRIPT)\*.* - $(XCOPY) ..\pod\*.bat $(INST_SCRIPT)\*.* + $(XCOPY) bin\network.pl $(INST_LIB)\*.* installhtml : doc $(RCOPY) html\*.* $(INST_HTML)\*.* diff --git a/win32/config.bc b/win32/config.bc index 2d25e46ef3..0c62fc5722 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -279,6 +279,7 @@ date='date' db_hashtype='int' db_prefixtype='int' defvoidused='15' +devtype='dev_t' direntrytype='struct direct' dlext='dll' dlsrc='dl_win32.xs' diff --git a/win32/config.gc b/win32/config.gc index 1dfc04b112..5b8fb2ebef 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -279,6 +279,7 @@ date='date' db_hashtype='int' db_prefixtype='int' defvoidused='15' +devtype='dev_t' direntrytype='struct direct' dlext='dll' dlsrc='dl_win32.xs' diff --git a/win32/config.vc b/win32/config.vc index 806549c363..823532ae5f 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -279,6 +279,7 @@ date='date' db_hashtype='int' db_prefixtype='int' defvoidused='15' +devtype='dev_t' direntrytype='struct direct' dlext='dll' dlsrc='dl_win32.xs' diff --git a/win32/config_H.bc b/win32/config_H.bc index 35388fab09..e0efdacb3f 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -34,8 +34,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.00467\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.00467\\bin\\MSWin32-x86" /**/ +#define BIN "c:\\perl\\5.00468\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.00468\\bin\\MSWin32-x86" /**/ /* CPPSTDIN: * This symbol contains the first part of the string which will invoke @@ -410,6 +410,14 @@ */ /*#define HAS_MKFIFO /**/ +/* HAS_MKNOD: + * This symbol, if defined, indicates that the mknod routine is + * available to create character and block special files. Otherwise, + * mknod should be able to do it for you. However, if mknod is there, + * mknod might require super-user privileges which mknod will not. + */ +/*#define HAS_MKNOD /**/ + /* HAS_MKTIME: * This symbol, if defined, indicates that the mktime routine is * available. @@ -1463,7 +1471,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.00467\\lib\\MSWin32-x86" /**/ +#define ARCHLIB "c:\\perl\\5.00468\\lib\\MSWin32-x86" /**/ /*#define ARCHLIB_EXP "" /**/ /* CAT2: @@ -1765,8 +1773,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.00467\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.00467")) /**/ +#define PRIVLIB "c:\\perl\\5.00468\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.00468")) /**/ /* SIG_NAME: * This symbol contains a list of signal names in order of @@ -1812,7 +1820,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.00467\\lib\\MSWin32-x86" /**/ +#define SITEARCH "c:\\perl\\site\\5.00468\\lib\\MSWin32-x86" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -1828,8 +1836,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "c:\\perl\\site\\5.00467\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.00467")) /**/ +#define SITELIB "c:\\perl\\site\\5.00468\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.00468")) /**/ /* DLSYM_NEEDS_UNDERSCORE: * This symbol, if defined, indicates that we need to prepend an @@ -2007,6 +2015,13 @@ */ #define Gid_t gid_t /* Type for getgid(), etc... */ +/* Dev_t: + * This symbol holds the type used to declare device numbers. + * It can be int, long, dev_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Dev_t dev_t /* <device> type */ + /* Off_t: * This symbol holds the type used to declare offsets in the kernel. * It can be int, long, off_t, etc... It may be necessary to include diff --git a/win32/config_H.gc b/win32/config_H.gc index 16fab75490..6f9a382f9e 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -34,8 +34,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl.gcc\\5.00467\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl.gcc\\5.00467\\bin\\MSWin32-x86" /**/ +#define BIN "c:\\perl.gcc\\5.00468\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl.gcc\\5.00468\\bin\\MSWin32-x86" /**/ /* CPPSTDIN: * This symbol contains the first part of the string which will invoke @@ -410,6 +410,14 @@ */ /*#define HAS_MKFIFO /**/ +/* HAS_MKNOD: + * This symbol, if defined, indicates that the mknod routine is + * available to create character and block special files. Otherwise, + * mknod should be able to do it for you. However, if mknod is there, + * mknod might require super-user privileges which mknod will not. + */ +/*#define HAS_MKNOD /**/ + /* HAS_MKTIME: * This symbol, if defined, indicates that the mktime routine is * available. @@ -1463,7 +1471,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl.gcc\\5.00467\\lib\\MSWin32-x86" /**/ +#define ARCHLIB "c:\\perl.gcc\\5.00468\\lib\\MSWin32-x86" /**/ /*#define ARCHLIB_EXP "" /**/ /* CAT2: @@ -1765,8 +1773,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl.gcc\\5.00467\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.00467")) /**/ +#define PRIVLIB "c:\\perl.gcc\\5.00468\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.00468")) /**/ /* SIG_NAME: * This symbol contains a list of signal names in order of @@ -1812,7 +1820,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl.gcc\\site\\5.00467\\lib\\MSWin32-x86" /**/ +#define SITEARCH "c:\\perl.gcc\\site\\5.00468\\lib\\MSWin32-x86" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -1828,8 +1836,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "c:\\perl.gcc\\site\\5.00467\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.00467")) /**/ +#define SITELIB "c:\\perl.gcc\\site\\5.00468\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.00468")) /**/ /* DLSYM_NEEDS_UNDERSCORE: * This symbol, if defined, indicates that we need to prepend an @@ -2007,6 +2015,13 @@ */ #define Gid_t gid_t /* Type for getgid(), etc... */ +/* Dev_t: + * This symbol holds the type used to declare device numbers. + * It can be int, long, dev_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Dev_t dev_t /* <device> type */ + /* Off_t: * This symbol holds the type used to declare offsets in the kernel. * It can be int, long, off_t, etc... It may be necessary to include diff --git a/win32/config_H.vc b/win32/config_H.vc index 05e98e5a02..81c322e2ae 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -34,8 +34,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.00467\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.00467\\bin\\MSWin32-x86" /**/ +#define BIN "c:\\perl\\5.00468\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.00468\\bin\\MSWin32-x86" /**/ /* CPPSTDIN: * This symbol contains the first part of the string which will invoke @@ -410,6 +410,14 @@ */ /*#define HAS_MKFIFO /**/ +/* HAS_MKNOD: + * This symbol, if defined, indicates that the mknod routine is + * available to create character and block special files. Otherwise, + * mknod should be able to do it for you. However, if mknod is there, + * mknod might require super-user privileges which mknod will not. + */ +/*#define HAS_MKNOD /**/ + /* HAS_MKTIME: * This symbol, if defined, indicates that the mktime routine is * available. @@ -1463,7 +1471,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.00467\\lib\\MSWin32-x86" /**/ +#define ARCHLIB "c:\\perl\\5.00468\\lib\\MSWin32-x86" /**/ /*#define ARCHLIB_EXP "" /**/ /* CAT2: @@ -1765,8 +1773,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.00467\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.00467")) /**/ +#define PRIVLIB "c:\\perl\\5.00468\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.00468")) /**/ /* SIG_NAME: * This symbol contains a list of signal names in order of @@ -1812,7 +1820,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.00467\\lib\\MSWin32-x86" /**/ +#define SITEARCH "c:\\perl\\site\\5.00468\\lib\\MSWin32-x86" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -1828,8 +1836,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "c:\\perl\\site\\5.00467\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.00467")) /**/ +#define SITELIB "c:\\perl\\site\\5.00468\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.00468")) /**/ /* DLSYM_NEEDS_UNDERSCORE: * This symbol, if defined, indicates that we need to prepend an @@ -2007,6 +2015,13 @@ */ #define Gid_t gid_t /* Type for getgid(), etc... */ +/* Dev_t: + * This symbol holds the type used to declare device numbers. + * It can be int, long, dev_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Dev_t dev_t /* <device> type */ + /* Off_t: * This symbol holds the type used to declare offsets in the kernel. * It can be int, long, off_t, etc... It may be necessary to include 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 35004f8665..2b5742325f 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -1,20 +1,26 @@ # -# Makefile to build perl on Windowns NT using DMAKE. +# Makefile to build perl on Windows NT using DMAKE. # Supported compilers: # Visual C++ 2.0 thro 5.0 # Borland C++ 5.02 -# Mingw32-0.1.4 with gcc-2.7.2 +# Mingw32 with gcc-2.8.1 or egcs-1.0.2 # # This is set up to build a perl.exe that runs off a shared library # (perl.dll). Also makes individual DLLs for the XS extensions. # +## +## Build configuration. Edit the values below to suit your needs. +## + # # Set these to wherever you want "nmake install" to put your # newly built perl. +# INST_DRV *= c: INST_TOP *= $(INST_DRV)\perl.gcc +# # Comment this out if you DON'T want your perl installation to be versioned. # This means that the new installation will overwrite any files from the # old installation at the same INST_TOP location. Leaving it enabled is @@ -22,14 +28,17 @@ INST_TOP *= $(INST_DRV)\perl.gcc # locations it installs files to. If you disable it, an alternative # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. -INST_VER *= \5.00467 +# +INST_VER *= \5.00468 # # uncomment to enable threads-capabilities +# #USE_THREADS *= define # # uncomment one +# #CCTYPE *= MSVC20 #CCTYPE *= MSVC #CCTYPE *= BORLAND @@ -38,30 +47,42 @@ CCTYPE *= GCC # # uncomment next line if you want to use the perl object # Currently, this cannot be enabled if you ask for threads above +# #OBJECT *= -DPERL_OBJECT # # uncomment next line if you want debug version of perl (big,slow) +# CFG *= Debug # +# uncomment to enable use of PerlCRT.DLL. Highly recommended. It has +# patches that fix known bugs in MSCVRT.DLL. You will need to download it +# from: <TBD> and follow the directions in the package to install. +# +#USE_PERLCRT *= define + +# # if you have the source for des_fcrypt(), uncomment this and make sure the # file exists (see README.win32). File should be located at the perl # top level directory. +# #CRYPT_SRC *= des_fcrypt.c # # if you didn't set CRYPT_SRC and if you have des_fcrypt() available in a # library, uncomment this, and make sure the library exists (see README.win32) # Specify the full pathname of the library. +# #CRYPT_LIB *= des_fcrypt.lib # # set this if you wish to use perl's malloc # WARNING: Turning this on/off WILL break binary compatibility with extensions -# you may have compiled with/without it. Be prepared to recompile all extensions -# if you change the default. Currently, this cannot be enabled if you ask for -# PERL_OBJECT above. +# you may have compiled with/without it. Be prepared to recompile all +# extensions if you change the default. Currently, this cannot be enabled +# if you ask for PERL_OBJECT above. +# #PERL_MALLOC *= define # @@ -74,15 +95,26 @@ CCINCDIR *= $(CCHOME)\include CCLIBDIR *= $(CCHOME)\lib # +# specify space-separated list of extra directories to look for libraries +# +EXTRALIBDIRS *= + +# # set this to point to cmd.exe (only needed if you use some # alternate shell that doesn't grok cmd.exe style commands) +# #SHELL *= g:\winnt\system32\cmd.exe # # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) +# #EMAIL *= +## +## Build configuration ends. +## + ##################### CHANGE THESE ONLY IF YOU MUST ##################### .IF "$(CRYPT_SRC)$(CRYPT_LIB)" == "" @@ -155,7 +187,7 @@ LINK_DBG = CFLAGS = -w -d -tWM -tWD $(INCLUDES) $(DEFINES) $(LOCDEFS) \ $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) +LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) $(EXTRALIBDIRS:^"-L") OBJOUT_FLAG = -o EXEOUT_FLAG = -e LIBOUT_FLAG = @@ -193,7 +225,7 @@ LINK_DBG = .ENDIF CFLAGS = $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE) -LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) +LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) $(EXTRALIBDIRS:^"-L") OBJOUT_FLAG = -o EXEOUT_FLAG = -o LIBOUT_FLAG = @@ -216,8 +248,22 @@ LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console CXX_FLAG = -TP -GX +.IF "$(USE_PERLCRT)" == "" +.IF "$(CFG)" == "Debug" +PERLCRTLIBC = msvcrtd.lib +.ELSE +PERLCRTLIBC = msvcrt.lib +.ENDIF +.ELSE +.IF "$(CFG)" == "Debug" +PERLCRTLIBC = PerlCRTD.lib +.ELSE +PERLCRTLIBC = PerlCRT.lib +.ENDIF +.ENDIF + .IF "$(RUNTIME)" == "-MD" -LIBC = msvcrt.lib +LIBC = $(PERLCRTLIBC) .ELSE LIBC = libcmt.lib .ENDIF @@ -238,15 +284,17 @@ OPTIMIZE = -Od $(RUNTIME) -DNDEBUG LINK_DBG = -release .ENDIF -# we don't add LIBC here, the compiler does it based on -MD/-MT -LIBFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ +LIBBASEFILES = $(CRYPT_LIB) oldnames.lib kernel32.lib user32.lib gdi32.lib \ winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ version.lib odbc32.lib odbccp32.lib +# we add LIBC here, since we may be using PerlCRT.dll +LIBFILES = $(LIBBASEFILES) $(LIBC) + CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \ $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = -nologo $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) +LINK_FLAGS = -nologo -nodefaultlib $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) OBJOUT_FLAG = -Fo EXEOUT_FLAG = -Fe LIBOUT_FLAG = /out: @@ -316,6 +364,29 @@ X2P = ..\x2p\a2p.exe PL2BAT = bin\pl2bat.pl GLOBBAT = bin\perlglob.bat +UTILS = \ + ..\utils\h2ph \ + ..\utils\splain \ + ..\utils\perlbug \ + ..\utils\pl2pm \ + ..\utils\c2ph \ + ..\utils\h2xs \ + ..\utils\perldoc \ + ..\utils\pstruct \ + ..\utils\perlcc \ + ..\pod\checkpods \ + ..\pod\pod2html \ + ..\pod\pod2latex \ + ..\pod\pod2man \ + ..\pod\pod2text \ + ..\x2p\find2perl \ + ..\x2p\s2p \ + bin\www.pl \ + bin\runperl.pl \ + bin\pl2bat.pl \ + bin\perlglob.pl \ + bin\search.pl + .IF "$(CCTYPE)" == "BORLAND" CFGSH_TMPL = config.bc @@ -331,7 +402,9 @@ PERLIMPLIB *= ..\libperl$(a) CFGSH_TMPL = config.vc CFGH_TMPL = config_H.vc +.IF "$(USE_PERLCRT)" == "" PERL95EXE = ..\perl95.exe +.ENDIF .ENDIF @@ -440,12 +513,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 \ @@ -556,13 +629,12 @@ CFG_VARS = \ "d_mymalloc=$(PERL_MALLOC)" \ "libs=$(LIBFILES:f)" \ "incpath=$(CCINCDIR)" \ - "libperl=$(PERLIMPLIB:f)" \ - "libpth=$(strip $(CCLIBDIR) $(LIBFILES:d))" \ + "libperl=$(PERLIMPLIB:f)" \ + "libpth=$(strip $(CCLIBDIR) $(EXTRALIBDIRS) $(LIBFILES:d))" \ "libc=$(LIBC)" \ "make=dmake" \ - "_o=$(o)" \ - "_a=$(a)" \ - "lib_ext=$(a)" \ + "_o=$(o)" "obj_ext=$(o)" \ + "_a=$(a)" "lib_ext=$(a)" \ "static_ext=$(STATIC_EXT)" \ "dynamic_ext=$(DYNAMIC_EXT)" \ "usethreads=$(USE_THREADS)" \ @@ -744,6 +816,7 @@ $(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) .IF "$(CCTYPE)" != "BORLAND" .IF "$(CCTYPE)" != "GCC" +.IF "$(USE_PERLCRT)" == "" perl95.c : runperl.c copy runperl.c perl95.c @@ -765,10 +838,11 @@ DynaLoadmt$(o) : $(DYNALOADER).c $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \ - $(LIBFILES) $(PERL95_OBJ) $(PERLIMPLIB) libcmt.lib + $(LIBBASEFILES) $(PERL95_OBJ) $(PERLIMPLIB) libcmt.lib .ENDIF .ENDIF +.ENDIF $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) if not exist $(AUTODIR) mkdir $(AUTODIR) @@ -850,21 +924,15 @@ $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs cd $(EXTDIR)\$(*B) && $(MAKE) doc: $(PERLEXE) - cd ..\pod && $(MAKE) -f ..\win32\pod.mak checkpods \ - pod2html pod2latex pod2man pod2text - cd ..\pod && $(XCOPY) *.bat ..\win32\bin\*.* copy ..\README.win32 ..\pod\perlwin32.pod $(PERLEXE) -I..\lib ..\installhtml --podroot=.. --htmldir=./html \ --podpath=pod:lib:ext:utils --htmlroot="file://$(INST_HTML:s,:,|,)"\ --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse -utils: $(PERLEXE) +utils: $(PERLEXE) $(X2P) cd ..\utils && $(MAKE) PERL=$(MINIPERL) - cd ..\utils && $(PERLEXE) ..\win32\$(PL2BAT) h2ph splain perlbug \ - pl2pm c2ph h2xs perldoc pstruct - $(XCOPY) ..\utils\*.bat bin\*.* - $(PERLEXE) -I..\lib $(PL2BAT) bin\network.pl bin\www.pl bin\runperl.pl \ - bin\pl2bat.pl bin\perlglob.pl + cd ..\pod && $(MAKE) -f ..\win32\pod.mak converters + $(PERLEXE) $(PL2BAT) $(UTILS) distclean: clean -del /f $(MINIPERL) $(PERLEXE) $(PERL95EXE) $(PERLDLL) $(GLOBEXE) \ @@ -895,18 +963,16 @@ distclean: clean -rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR) -rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR) -install : all installbare installutils installhtml +install : all installbare installhtml -installbare : +installbare : utils $(PERLEXE) ..\installperl .IF "$(PERL95EXE)" != "" $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.* .ENDIF - -installutils : utils $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* $(XCOPY) bin\*.bat $(INST_SCRIPT)\*.* - $(XCOPY) ..\pod\*.bat $(INST_SCRIPT)\*.* + $(XCOPY) bin\network.pl $(INST_LIB)\*.* installhtml : doc $(RCOPY) html\*.* $(INST_HTML)\*.* 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/pod.mak b/win32/pod.mak index 9881ed882d..7ad153c000 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -8,8 +8,10 @@ POD2HTML = pod2html \ all: $(CONVERTERS) html +converters: $(CONVERTERS) + PERL = ..\miniperl.exe -PL2BAT = ..\win32\bin\pl2bat.pl +REALPERL = ..\perl.exe POD = \ perl.pod \ @@ -23,6 +25,7 @@ POD = \ perlvar.pod \ perlsub.pod \ perlmod.pod \ + perlmodlib.pod \ perlform.pod \ perllocale.pod \ perlref.pod \ @@ -70,6 +73,7 @@ MAN = \ perlvar.man \ perlsub.man \ perlmod.man \ + perlmodlib.man \ perlform.man \ perllocale.man \ perlref.man \ @@ -117,6 +121,7 @@ HTML = \ perlvar.html \ perlsub.html \ perlmod.html \ + perlmodlib.html \ perlform.html \ perllocale.html \ perlref.html \ @@ -164,6 +169,7 @@ TEX = \ perlvar.tex \ perlsub.tex \ perlmod.tex \ + perlmodlib.tex \ perlform.tex \ perllocale.tex \ perlref.tex \ @@ -206,67 +212,67 @@ html: pod2html $(HTML) tex: pod2latex $(TEX) toc: - $(PERL) -I..\lib buildtoc >perltoc.pod + $(PERL) -I../lib buildtoc >perltoc.pod .SUFFIXES: .pm .pod .SUFFIXES: .man .pm.man: - $(PERL) -I..\lib pod2man $*.pm >$*.man + $(PERL) -I../lib pod2man $*.pm >$*.man .pod.man: - $(PERL) -I..\lib pod2man $*.pod >$*.man + $(PERL) -I../lib pod2man $*.pod >$*.man .SUFFIXES: .html .pm.html: - $(PERL) -I..\lib $(POD2HTML) --infile=$*.pm --outfile=$*.html + $(PERL) -I../lib $(POD2HTML) --infile=$*.pm --outfile=$*.html .pod.html: - $(PERL) -I..\lib $(POD2HTML) --infile=$*.pod --outfile=$*.html + $(PERL) -I../lib $(POD2HTML) --infile=$*.pod --outfile=$*.html .SUFFIXES: .tex .pm.tex: - $(PERL) -I..\lib pod2latex $*.pm + $(PERL) -I../lib pod2latex $*.pm .pod.tex: - $(PERL) -I..\lib pod2latex $*.pod + $(PERL) -I../lib pod2latex $*.pod clean: - del /f $(MAN) $(HTML) $(TEX) - del /f pod2html-*cache - del /f *.aux *.log + rm -f $(MAN) + rm -f $(HTML) + rm -f $(TEX) + rm -f pod2html-*cache + rm -f *.aux *.log *.exe realclean: clean - del /f $(CONVERTERS) + rm -f $(CONVERTERS) distclean: realclean check: checkpods @echo "checking..."; \ - $(PERL) -I..\lib checkpods $(POD) + $(PERL) -I../lib checkpods $(POD) # Dependencies. -pod2latex: pod2latex.PL ..\lib\Config.pm - $(PERL) -I..\lib pod2latex.PL - $(PERL) $(PL2BAT) pod2latex +pod2latex: pod2latex.PL ../lib/Config.pm + $(PERL) -I../lib pod2latex.PL -pod2html: pod2html.PL ..\lib\Config.pm - $(PERL) -I..\lib pod2html.PL - $(PERL) $(PL2BAT) pod2html +pod2html: pod2html.PL ../lib/Config.pm + $(PERL) -I ../lib pod2html.PL -pod2man: pod2man.PL ..\lib\Config.pm - $(PERL) -I..\lib pod2man.PL - $(PERL) $(PL2BAT) pod2man +pod2man: pod2man.PL ../lib/Config.pm + $(PERL) -I ../lib pod2man.PL -pod2text: pod2text.PL ..\lib\Config.pm - $(PERL) -I..\lib pod2text.PL - $(PERL) $(PL2BAT) pod2text +pod2text: pod2text.PL ../lib/Config.pm + $(PERL) -I ../lib pod2text.PL -checkpods: checkpods.PL ..\lib\Config.pm - $(PERL) -I..\lib checkpods.PL - $(PERL) $(PL2BAT) checkpods +checkpods: checkpods.PL ../lib/Config.pm + $(PERL) -I ../lib checkpods.PL +compile: all + $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' pod2latex pod2man pod2text checkpods -prog -verbose dcf -log ../compilelog; + 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.c b/win32/win32.c index 9afb0bd687..68b6bb8962 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -202,7 +202,9 @@ get_emd_part(char *prev_path, char *trailing_path, ...) va_start(ap, trailing_path); strip = va_arg(ap, char *); - GetModuleFileName(GetModuleHandle(NULL), mod_name, sizeof(mod_name)); + GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE) + ? GetModuleHandle(NULL) + : w32_perldll_handle, mod_name, sizeof(mod_name)); ptr = strrchr(mod_name, '\\'); while (ptr && strip) { /* look for directories to skip back */ 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 */ |