summaryrefslogtreecommitdiff
path: root/win32
diff options
context:
space:
mode:
Diffstat (limited to 'win32')
-rw-r--r--win32/Makefile159
-rw-r--r--win32/bin/perlglob.pl2
-rw-r--r--win32/config.bc16
-rw-r--r--win32/config.gc26
-rw-r--r--win32/config.vc14
-rw-r--r--win32/config_H.bc190
-rw-r--r--win32/config_H.gc196
-rw-r--r--win32/config_H.vc190
-rw-r--r--win32/config_h.PL4
-rw-r--r--win32/config_sh.PL75
-rw-r--r--win32/genmk95.pl40
-rw-r--r--win32/makefile.mk366
-rw-r--r--win32/perlhost.h2307
-rw-r--r--win32/perllib.c1503
-rw-r--r--win32/runperl.c4
-rw-r--r--win32/vdir.h505
-rw-r--r--win32/vmem.h703
-rw-r--r--win32/win32.c756
-rw-r--r--win32/win32.h155
-rw-r--r--win32/win32iop.h10
-rw-r--r--win32/win32thread.h5
21 files changed, 5102 insertions, 2124 deletions
diff --git a/win32/Makefile b/win32/Makefile
index c4bb568570..c100d45777 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -29,7 +29,7 @@ INST_TOP = $(INST_DRV)\perl
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-INST_VER = \5.00563
+INST_VER = \5.5.640
#
# Comment this out if you DON'T want your perl installation to have
@@ -47,7 +47,7 @@ INST_ARCH = \$(ARCHNAME)
#
# uncomment to enable threads-capabilities
#
-#USE_THREADS = define
+#USE_5005THREADS= define
#
# XXX WARNING! This option currently undergoing changes. May be broken.
@@ -65,6 +65,22 @@ INST_ARCH = \$(ARCHNAME)
#USE_OBJECT = define
#
+# XXX WARNING! This option currently undergoing changes. May be broken.
+#
+# Beginnings of interpreter cloning/threads: still rather rough, fails
+# tests. This should be enabled to get the fork() emulation. Do not
+# enable unless you know what you're doing!
+#
+#USE_ITHREADS = define
+
+#
+# uncomment to enable the implicit "host" layer for all system calls
+# made by perl. This is needed and auto-enabled by USE_OBJECT above.
+# This is also needed to get fork().
+#
+#USE_IMP_SYS = define
+
+#
# uncomment one of the following lines if you are using either
# Visual C++ 2.x or Visual C++ 6.x (aka Visual Studio 98)
#
@@ -78,12 +94,15 @@ INST_ARCH = \$(ARCHNAME)
#
# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler.
-# Highly recommended. It has patches that fix known bugs in MSVCRT.DLL.
+# It has patches that fix known bugs in older versions of MSVCRT.DLL.
# This currently requires VC 5.0 with Service Pack 3 or later.
# Get it from CPAN at http://www.perl.com/CPAN/authors/id/D/DO/DOUGL/
# and follow the directions in the package to install.
#
+# Not recommended if you have VC 6.x and you're not running Windows 9x.
+#
#USE_PERLCRT = define
+#BUILD_FOR_WIN95 = define
#
# uncomment to enable linking with setargv.obj under the Visual C
@@ -130,26 +149,36 @@ CCINCDIR = $(CCHOME)\include
CCLIBDIR = $(CCHOME)\lib
#
-# additional compiler flags can be specified here.
+# Additional compiler flags can be specified here.
#
-# Adding -DPERL_POLLUTE enables support for old symbols, at the expense of
-# extreme pollution. You most probably want this if you're compiling modules
-# from CPAN, or other such serious uses of this experimental perl release.
-# We don't enable this by default because we want the modules to get fixed
-# instead of clinging to shortcuts like this one.
+
+#
+# This should normally be disabled. Adding -DPERL_POLLUTE enables support
+# for old symbols by default, at the expense of extreme pollution. You most
+# probably just want to build modules that won't compile with
+# perl Makefile.PL POLLUTE=1
+# instead of enabling this. Please report such modules to the respective
+# authors.
#
#BUILDOPT = $(BUILDOPT) -DPERL_POLLUTE
#
-# enable this to test the File::Glob implementation of CORE::glob
+# This should normally be disabled. Enabling it will disable the File::Glob
+# implementation of CORE::glob.
#
-#BUILDOPT = $(BUILDOPT) -DPERL_INTERNAL_GLOB
+#BUILDOPT = $(BUILDOPT) -DPERL_EXTERNAL_GLOB
+
+#
+# This should normally be disabled. Enabling it causes perl to read scripts
+# in text mode (which is the 5.005 behavior) and will break ByteLoader.
+#BUILDOPT = $(BUILDOPT) -DPERL_TEXTMODE_SCRIPTS
-# Beginnings of interpreter cloning/threads: still rather rough, fails
-# many tests. Do not enable unless you know what you're doing!
#
-#BUILDOPT = $(BUILDOPT) -DUSE_ITHREADS
+# This should normally be disabled. Enabling it runs a cloned toplevel
+# interpreter (*EXPERIMENTAL*, fails tests)
+#BUILDOPT = $(BUILDOPT) -DTOP_CLONE
+#
# specify semicolon-separated list of extra directories that modules will
# look for libraries (spaces in path names need not be quoted)
#
@@ -159,7 +188,7 @@ EXTRALIBDIRS =
# set this to your email address (perl will guess a value from
# from your loginname and your hostname, which may not be right)
#
-#EMAIL =
+#EMAIL =
##
## Build configuration ends.
@@ -176,16 +205,21 @@ CRYPT_FLAG = -DHAVE_DES_FCRYPT
!IF "$(USE_OBJECT)" == "define"
PERL_MALLOC = undef
-USE_THREADS = undef
+USE_5005THREADS = undef
USE_MULTI = undef
+USE_IMP_SYS = define
!ENDIF
!IF "$(PERL_MALLOC)" == ""
PERL_MALLOC = undef
!ENDIF
-!IF "$(USE_THREADS)" == ""
-USE_THREADS = undef
+!IF "$(USE_5005THREADS)" == ""
+USE_5005THREADS = undef
+!ENDIF
+
+!IF "$(USE_5005THREADS)" == "define"
+USE_ITHREADS = undef
!ENDIF
!IF "$(USE_MULTI)" == ""
@@ -196,10 +230,26 @@ USE_MULTI = undef
USE_OBJECT = undef
!ENDIF
-!IF "$(USE_MULTI)$(USE_THREADS)$(USE_OBJECT)" != "undefundefundef"
+!IF "$(USE_ITHREADS)" == ""
+USE_ITHREADS = undef
+!ENDIF
+
+!IF "$(USE_IMP_SYS)" == ""
+USE_IMP_SYS = undef
+!ENDIF
+
+!IF "$(USE_PERLCRT)" == ""
+USE_PERLCRT = undef
+!ENDIF
+
+!IF "$(USE_MULTI)$(USE_5005THREADS)$(USE_OBJECT)" != "undefundefundef"
BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT
!ENDIF
+!IF "$(USE_IMP_SYS)" != "undef"
+BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS
+!ENDIF
+
!IF "$(PROCESSOR_ARCHITECTURE)" == ""
PROCESSOR_ARCHITECTURE = x86
!ENDIF
@@ -207,7 +257,7 @@ PROCESSOR_ARCHITECTURE = x86
!IF "$(USE_OBJECT)" == "define"
ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-object
!ELSE
-!IF "$(USE_THREADS)" == "define"
+!IF "$(USE_5005THREADS)" == "define"
ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread
!ELSE
!IF "$(USE_MULTI)" == "define"
@@ -218,6 +268,10 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)
!ENDIF
!ENDIF
+!IF "$(USE_ITHREADS)" == "define"
+ARCHNAME = $(ARCHNAME)-thread
+!ENDIF
+
# Visual Studio 98 specific
!IF "$(CCTYPE)" == "MSVC60"
@@ -256,6 +310,7 @@ INST_HTML = $(INST_POD)\html
CC = cl
LINK32 = link
LIB32 = $(LINK32) -lib
+RSC = rc
#
# Options
@@ -269,7 +324,7 @@ LOCDEFS = -DPERLDLL -DPERL_CORE
SUBSYS = console
CXX_FLAG = -TP -GX
-!IF "$(USE_PERLCRT)" == ""
+!IF "$(USE_PERLCRT)" != "define"
! IF "$(CFG)" == "Debug"
PERLCRTLIBC = msvcrtd.lib
! ELSE
@@ -283,6 +338,9 @@ PERLCRTLIBC = PerlCRT.lib
! ENDIF
!ENDIF
+PERLEXE_RES =
+PERLDLL_RES =
+
!IF "$(RUNTIME)" == "-MD"
LIBC = $(PERLCRTLIBC)
!ELSE
@@ -312,10 +370,14 @@ OPTIMIZE = $(OPTIMIZE) $(CXX_FLAG)
BUILDOPT = $(BUILDOPT) -DPERL_OBJECT
!ENDIF
+!IF "$(USE_PERLCRT)" != "define"
+BUILDOPT = $(BUILDOPT) -DPERL_MSVCRT_READFIX
+!ENDIF
+
LIBBASEFILES = $(DELAYLOAD) $(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 \
+ 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
@@ -340,7 +402,7 @@ o = .obj
# Rules
#
-.SUFFIXES : .c $(o) .dll .lib .exe
+.SUFFIXES : .c $(o) .dll .lib .exe .rc .res
.c$(o):
$(CC) -c -I$(<D) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $<
@@ -352,6 +414,9 @@ $(o).dll:
$(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \
-out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL)
+.rc.res:
+ $(RSC) $<
+
#
# various targets
!IF "$(USE_OBJECT)" == "define"
@@ -365,6 +430,7 @@ PERLDLL = ..\perl.dll
MINIPERL = ..\miniperl.exe
MINIDIR = .\mini
PERLEXE = ..\perl.exe
+WPERLEXE = ..\wperl.exe
GLOBEXE = ..\perlglob.exe
CONFIGPM = ..\lib\Config.pm
MINIMOD = ..\lib\ExtUtils\Miniperl.pm
@@ -382,7 +448,6 @@ UTILS = \
..\utils\c2ph \
..\utils\h2xs \
..\utils\perldoc \
- ..\utils\pstruct \
..\utils\perlcc \
..\pod\checkpods \
..\pod\pod2html \
@@ -404,7 +469,7 @@ MAKE = nmake -nologo
CFGSH_TMPL = config.vc
CFGH_TMPL = config_H.vc
-!IF "$(USE_PERLCRT)" == ""
+!IF "$(BUILD_FOR_WIN95)" == "define"
PERL95EXE = ..\perl95.exe
!ENDIF
@@ -463,7 +528,7 @@ WIN32_SRC = \
.\win32.c \
.\win32sck.c
-!IF "$(USE_THREADS)" == "define"
+!IF "$(USE_5005THREADS)" == "define"
WIN32_SRC = $(WIN32_SRC) .\win32thread.c
!ENDIF
@@ -527,7 +592,10 @@ CORE_NOCFG_H = \
.\include\dirent.h \
.\include\netdb.h \
.\include\sys\socket.h \
- .\win32.h
+ .\win32.h \
+ .\perlhost.h \
+ .\vdir.h \
+ .\vmem.h
CORE_H = $(CORE_NOCFG_H) .\config.h
@@ -657,7 +725,9 @@ CFG_VARS = \
"static_ext=$(STATIC_EXT)" \
"dynamic_ext=$(DYNAMIC_EXT)" \
"nonxs_ext=$(NONXS_EXT)" \
- "usethreads=$(USE_THREADS)" \
+ "use5005threads=$(USE_5005THREADS)" \
+ "useithreads=$(USE_ITHREADS)" \
+ "usethreads=$(USE_5005THREADS)" \
"usemultiplicity=$(USE_MULTI)" \
"LINK_FLAGS=$(LINK_FLAGS:"=\")" \
"optimize=$(OPTIMIZE:"=\")"
@@ -722,11 +792,17 @@ $(MINIDIR) :
if not exist "$(MINIDIR)" mkdir "$(MINIDIR)"
$(MINICORE_OBJ) : $(CORE_NOCFG_H)
- $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*F).c
+ $(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB $(OBJOUT_FLAG)$@ ..\$(*F).c
$(MINIWIN32_OBJ) : $(CORE_NOCFG_H)
$(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*F).c
+# -DPERL_IMPLICIT_SYS needs C++ for perllib.c
+!IF "$(USE_IMP_SYS)$(USE_OBJECT)" == "defineundef"
+perllib$(o) : perllib.c
+ $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c
+!ENDIF
+
# 1. we don't want to rebuild miniperl.exe when config.h changes
# 2. we don't want to rebuild miniperl.exe with non-default config.h
$(MINI_OBJ) : $(CORE_NOCFG_H)
@@ -741,9 +817,9 @@ perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl
$(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \
CCTYPE=$(CCTYPE) > perldll.def
-$(PERLDLL): perldll.def $(PERLDLL_OBJ)
+$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES)
$(LINK32) -dll -def:perldll.def -out:$@ @<<
- $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ)
+ $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ) $(PERLDLL_RES)
<<
$(XCOPY) $(PERLIMPLIB) $(COREDIR)
@@ -778,13 +854,15 @@ perlmain.c : runperl.c
perlmain$(o) : perlmain.c
$(CC) $(CFLAGS_O) -UPERLDLL $(OBJOUT_FLAG)$@ -c perlmain.c
-$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ)
+$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) $(PERLEXE_RES)
$(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \
- $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB)
+ $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) $(PERLEXE_RES)
+ copy $(PERLEXE) $(WPERLEXE)
+ editbin /subsystem:windows $(WPERLEXE)
copy splittree.pl ..
$(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR)
-!IF "$(USE_PERLCRT)" == ""
+!IF "$(BUILD_FOR_WIN95)" == "define"
perl95.c : runperl.c
copy runperl.c perl95.c
@@ -815,8 +893,10 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
if not exist $(AUTODIR) mkdir $(AUTODIR)
cd $(EXTDIR)\$(*B)
..\$(MINIPERL) -I..\..\lib $(*B)_pm.PL
+ ..\$(MINIPERL) -I..\..\lib XSLoader_pm.PL
cd ..\..\win32
$(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
+ $(XCOPY) $(EXTDIR)\$(*B)\XSLoader.pm $(LIBDIR)\$(NULL)
cd $(EXTDIR)\$(*B)
$(XSUBPP) dl_win32.xs > $(*B).c
cd ..\..\win32
@@ -942,6 +1022,7 @@ distclean: clean
-del /f $(EXTENSION_C) $(DYNALOADER).c $(ERRNO).pm
-del /f $(EXTDIR)\DynaLoader\dl_win32.xs
-del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm
+ -del /f $(LIBDIR)\XSLoader.pm
-del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm
-del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm
-del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm
@@ -956,7 +1037,7 @@ distclean: clean
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
cd ..\utils
- -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc pstruct dprofpp
+ -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc dprofpp
-del /f *.bat
cd ..\win32
cd ..\x2p
@@ -977,9 +1058,10 @@ install : all installbare installhtml
installbare : utils
$(PERLEXE) ..\installperl
-!IF "$(USE_PERLCRT)" == ""
+!IF "$(BUILD_FOR_WIN95)" == "define"
$(XCOPY) $(PERL95EXE) $(INST_BIN)\*.*
!ENDIF
+ if exist $(WPERLEXE) $(XCOPY) $(WPERLEXE) $(INST_BIN)\*.*
$(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
$(XCOPY) bin\*.bat $(INST_SCRIPT)\*.*
@@ -1025,6 +1107,7 @@ clean :
-@erase /f config.h
-@erase $(GLOBEXE)
-@erase $(PERLEXE)
+ -@erase $(WPERLEXE)
-@erase $(PERLDLL)
-@erase $(CORE_OBJ)
-rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR)
diff --git a/win32/bin/perlglob.pl b/win32/bin/perlglob.pl
index 6467e573b5..17843c877a 100644
--- a/win32/bin/perlglob.pl
+++ b/win32/bin/perlglob.pl
@@ -41,7 +41,7 @@ builtins.
=head1 AUTHOR
-Gurusamy Sarathy <gsar@umich.edu>
+Gurusamy Sarathy <gsar@activestate.com>
=head1 SEE ALSO
diff --git a/win32/config.bc b/win32/config.bc
index 81ec602bac..8dba78c0f1 100644
--- a/win32/config.bc
+++ b/win32/config.bc
@@ -19,7 +19,9 @@ afs='false'
alignbytes='8'
ansi2knr=''
aphostname=''
-apiversion='~PERL_APIVERSION~'
+apirevision='~PERL_API_REVISION~'
+apisubversion='~PERL_API_SUBVERSION~'
+apiversion='~PERL_API_VERSION~'
ar='tlib /P128'
archlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
archlibexp='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
@@ -27,7 +29,7 @@ archname64=''
archname='MSWin32'
archobjs=''
awk='awk'
-baserev='5.0'
+baserev='5'
bash=''
bin='~INST_TOP~~INST_VER~\bin~INST_ARCH~'
bincompat5005='undef'
@@ -572,7 +574,6 @@ pg=''
phostname='hostname'
pidtype='int'
plibpth=''
-pm_apiversion='5.005'
pmake=''
pr=''
prefix='~INST_TOP~'
@@ -685,8 +686,10 @@ uidtype='uid_t'
uname='uname'
uniq='uniq'
uquadtype='unsigned __int64'
+use5005threads='undef'
use64bits='undef'
usedl='define'
+useithreads='undef'
uselargefiles='undef'
uselongdouble='undef'
uselonglong='undef'
@@ -720,12 +723,13 @@ version='~VERSION~'
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
-xs_apiversion='~PERL_APIVERSION~'
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
-PERL_VERSION='~PERL_VERSION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
-PERL_APIVERSION='~PERL_APIVERSION~'
+PERL_VERSION='~PERL_VERSION~'
+PERL_API_REVISION='~PERL_API_REVISION~'
+PERL_API_SUBVERSION='~PERL_API_SUBVERSION~'
+PERL_API_VERSION='~PERL_API_VERSION~'
PATCHLEVEL='~PERL_VERSION~'
SUBVERSION='~PERL_SUBVERSION~'
diff --git a/win32/config.gc b/win32/config.gc
index ac0345f262..556ba2b581 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -19,7 +19,9 @@ afs='false'
alignbytes='8'
ansi2knr=''
aphostname=''
-apiversion='~PERL_APIVERSION~'
+apirevision='~PERL_API_REVISION~'
+apisubversion='~PERL_API_SUBVERSION~'
+apiversion='~PERL_API_VERSION~'
ar='ar'
archlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
archlibexp='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
@@ -27,7 +29,7 @@ archname64=''
archname='MSWin32'
archobjs=''
awk='awk'
-baserev='5.0'
+baserev='5'
bash=''
bin='~INST_TOP~~INST_VER~\bin~INST_ARCH~'
bincompat5005='undef'
@@ -297,8 +299,8 @@ d_statvfs='undef'
d_stdio_cnt_lval='define'
d_stdio_ptr_lval='define'
d_stdio_stream_array='undef'
-d_stdiobase='undef'
-d_stdstdio='undef'
+d_stdiobase='define'
+d_stdstdio='define'
d_strchr='define'
d_strcoll='define'
d_strctcpy='define'
@@ -323,7 +325,7 @@ d_telldirproto='define'
d_time='define'
d_times='define'
d_truncate='undef'
-d_tzname='undef'
+d_tzname='define'
d_umask='define'
d_uname='define'
d_union_semun='define'
@@ -496,7 +498,7 @@ ldflags='~LINK_FLAGS~'
ldlibpthname=''
less='less'
lib_ext='.a'
-libc='libcrtdll.a'
+libc='libmsvcrt.a'
libperl='libperl.a'
libpth=''
libs=''
@@ -572,7 +574,6 @@ pg=''
phostname='hostname'
pidtype='int'
plibpth=''
-pm_apiversion='5.005'
pmake=''
pr=''
prefix='~INST_TOP~'
@@ -685,13 +686,15 @@ uidtype='uid_t'
uname='uname'
uniq='uniq'
uquadtype='unsigned long long'
+use5005threads='undef'
use64bits='undef'
usedl='define'
+useithreads='undef'
uselargefiles='undef'
uselongdouble='undef'
uselonglong='undef'
usemorebits='undef'
-usemultiplicity='define'
+usemultiplicity='undef'
usemymalloc='n'
usenm='false'
useopcode='true'
@@ -720,12 +723,13 @@ version='~VERSION~'
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
-xs_apiversion='~PERL_APIVERSION~'
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
-PERL_VERSION='~PERL_VERSION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
-PERL_APIVERSION='~PERL_APIVERSION~'
+PERL_VERSION='~PERL_VERSION~'
+PERL_API_REVISION='~PERL_API_REVISION~'
+PERL_API_SUBVERSION='~PERL_API_SUBVERSION~'
+PERL_API_VERSION='~PERL_API_VERSION~'
PATCHLEVEL='~PERL_VERSION~'
SUBVERSION='~PERL_SUBVERSION~'
diff --git a/win32/config.vc b/win32/config.vc
index a294dbcf43..0e37b3c056 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -19,7 +19,9 @@ afs='false'
alignbytes='8'
ansi2knr=''
aphostname=''
-apiversion='~PERL_APIVERSION~'
+apirevision='~PERL_API_REVISION~'
+apisubversion='~PERL_API_SUBVERSION~'
+apiversion='~PERL_API_VERSION~'
ar='lib'
archlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
archlibexp='~INST_TOP~~INST_VER~\lib~INST_ARCH~'
@@ -27,7 +29,7 @@ archname64=''
archname='MSWin32'
archobjs=''
awk='awk'
-baserev='5.0'
+baserev='5'
bash=''
bin='~INST_TOP~~INST_VER~\bin~INST_ARCH~'
bincompat5005='undef'
@@ -572,7 +574,6 @@ pg=''
phostname='hostname'
pidtype='int'
plibpth=''
-pm_apiversion='5.005'
pmake=''
pr=''
prefix='~INST_TOP~'
@@ -685,8 +686,10 @@ uidtype='uid_t'
uname='uname'
uniq='uniq'
uquadtype='unsigned __int64'
+use5005threads='undef'
use64bits='undef'
usedl='define'
+useithreads='undef'
uselargefiles='undef'
uselongdouble='undef'
uselonglong='undef'
@@ -720,12 +723,13 @@ version='~VERSION~'
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
-xs_apiversion='~PERL_APIVERSION~'
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
PERL_VERSION='~PERL_VERSION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
-PERL_APIVERSION='~PERL_APIVERSION~'
+PERL_API_REVISION='~PERL_API_REVISION~'
+PERL_API_SUBVERSION='~PERL_API_SUBVERSION~'
+PERL_API_VERSION='~PERL_API_VERSION~'
PATCHLEVEL='~PERL_VERSION~'
SUBVERSION='~PERL_SUBVERSION~'
diff --git a/win32/config_H.bc b/win32/config_H.bc
index de0fb35bd6..e1e06b340b 100644
--- a/win32/config_H.bc
+++ b/win32/config_H.bc
@@ -13,7 +13,7 @@
/*
* Package name : perl5
* Source directory :
- * Configuration time: Sun Oct 31 02:10:33 1999
+ * Configuration time: Sun Jan 9 15:13:13 2000
* Configured by : gsar
* Target system :
*/
@@ -980,52 +980,6 @@
*/
#define STDCHAR unsigned char /**/
-/* HAS_QUAD:
- * This symbol, if defined, tells that there's a 64-bit integer type,
- * Quad_t.
- */
-/* Quad_t:
- * This symbol holds the type used for 64-bit integers.
- * It can be int, long, long long, int64_t etc...
- */
-/* QUADCASE:
- * This symbol, if defined, encodes the type of a quad:
- * 1 = int, 2 = long, 3 = long long, 4 = int64_t.
- */
-/* Uquad_t:
- * This symbol holds the type used for unsigned 64-bit integers.
- * It can be unsigned int, unsigned long, unsigned long long,
- * uint64_t etc...
- */
-/*#define HAS_QUAD /**/
-/*#define Quad_t __int64 /**/
-/*#define Uquad_t unsigned __int64 /**/
-/*#define QUADCASE 5 /**/
-
-/* HAS_ACCESSX:
- * This symbol, if defined, indicates that the accessx routine is
- * available to do extended access checks.
- */
-/*#define HAS_ACCESSX /**/
-
-/* HAS_EACCESS:
- * This symbol, if defined, indicates that the eaccess routine is
- * available to do extended access checks.
- */
-/*#define HAS_EACCESS /**/
-
-/* I_SYS_ACCESS:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/access.h>.
- */
-/*#define I_SYS_ACCESS /**/
-
-/* I_SYS_SECURITY:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/security.h>.
- */
-/*#define I_SYS_SECURITY /**/
-
/* CROSSCOMPILE:
* This symbol, if defined, signifies that we our
* build process is a cross-compilation.
@@ -1057,6 +1011,46 @@
*/
/*#define MULTIARCH /**/
+/* HAS_QUAD:
+ * This symbol, if defined, tells that there's a 64-bit integer type,
+ * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
+ * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T.
+ */
+/*#define HAS_QUAD /**/
+#ifdef HAS_QUAD
+# define Quad_t __int64 /**/
+# define Uquad_t unsigned __int64 /**/
+# define QUADKIND undef /**/
+# define QUAD_IS_INT 1
+# define QUAD_IS_LONG 2
+# define QUAD_IS_LONG_LONG 3
+# define QUAD_IS_INT64_T 4
+#endif
+
+/* HAS_ACCESSX:
+ * This symbol, if defined, indicates that the accessx routine is
+ * available to do extended access checks.
+ */
+/*#define HAS_ACCESSX /**/
+
+/* HAS_EACCESS:
+ * This symbol, if defined, indicates that the eaccess routine is
+ * available to do extended access checks.
+ */
+/*#define HAS_EACCESS /**/
+
+/* I_SYS_ACCESS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/access.h>.
+ */
+/*#define I_SYS_ACCESS /**/
+
+/* I_SYS_SECURITY:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/security.h>.
+ */
+/*#define I_SYS_SECURITY /**/
+
/* MEM_ALIGNBYTES:
* This symbol contains the number of bytes required to align a
* double. Usual values are 2, 4 and 8. The default is eight,
@@ -1429,7 +1423,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.00563\\lib\\MSWin32-x86" /**/
+#define ARCHLIB "c:\\perl\\5.5.640\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* BIN:
@@ -1440,8 +1434,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.00563\\bin\\MSWin32-x86" /**/
-#define BIN_EXP "c:\\perl\\5.00563\\bin\\MSWin32-x86" /**/
+#define BIN "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/
+#define BIN_EXP "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
@@ -1459,8 +1453,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.00563\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.00563")) /**/
+#define PRIVLIB "c:\\perl\\5.5.640\\lib" /**/
+#define PRIVLIB_EXP (win32_get_privlib("5.5.640")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
@@ -1477,7 +1471,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.00563\\lib\\MSWin32-x86" /**/
+#define SITEARCH "c:\\perl\\site\\5.5.640\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
@@ -1495,8 +1489,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.00563\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.00563")) /**/
+#define SITELIB "c:\\perl\\site\\5.5.640\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib("5.5.640")) /**/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
@@ -2202,6 +2196,13 @@
*/
/*#define HAS_HASMNTOPT /**/
+/* HAS_INT64_T:
+ * This symbol will defined if the C compiler supports int64_t.
+ * Usually the <inttypes.h> needs to be included, but sometimes
+ * <sys/types.h> is enough.
+ */
+/*#define HAS_INT64_T /**/
+
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* or <limits.h> defines the symbol LDBL_DIG, which is the number
@@ -2302,13 +2303,7 @@
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/* HAS_INT64_T:
- * This symbol will defined if the C compiler supports int64_t.
- * Usually the <inttypes.h> needs to be included, but sometimes
- * <sys/types.h> is enough.
- */
/*#define I_INTTYPES /**/
-/*#define HAS_INT64_T /**/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
@@ -2452,9 +2447,6 @@
/* U64SIZE:
* This symbol contains the sizeof(U64).
*/
-/* NVSIZE:
- * This symbol contains the sizeof(NV).
- */
#define IVTYPE long /**/
#define UVTYPE unsigned long /**/
#define I8TYPE char /**/
@@ -2480,7 +2472,6 @@
#define I64SIZE 8 /**/
#define U64SIZE 8 /**/
#endif
-#define NVSIZE 8 /**/
/* IVdf:
* This symbol defines the format string used for printing a Perl IV
@@ -2537,8 +2528,8 @@
/*#define HAS_STRTOULL /**/
/* USE_64_BITS:
- * This symbol, if defined, indicates that 64-bit interfaces should
- * be used when available. If not defined, the native default interfaces
+ * This symbol, if defined, indicates that 64-bit integers should
+ * be used when available. If not defined, the native integers
* will be used (be they 32 or 64 bits).
*/
#ifndef USE_64_BITS
@@ -2599,41 +2590,6 @@
/*#define USE_SOCKS /**/
#endif
-/* PERL_XS_APIVERSION:
- * This variable contains the version of the oldest perl binary
- * compatible with the present perl. perl.c:incpush() and
- * lib/lib.pm will automatically search in c:\\perl\\site\\5.00563\\lib\\MSWin32-x86 for older
- * directories across major versions back to xs_apiversion.
- * This is only useful if you have a perl library directory tree
- * structured like the default one.
- * See INSTALL for how this works.
- * The versioned site_perl directory was introduced in 5.005,
- * so that is the lowest possible value.
- * Since this can depend on compile time options (such as
- * bincompat) it is set by Configure. Other non-default sources
- * of potential incompatibility, such as multiplicity, threads,
- * debugging, 64bits, sfio, etc., are not checked for currently,
- * though in principle we could go snooping around in old
- * Config.pm files.
- */
-/* PERL_PM_APIVERSION:
- * This variable contains the version of the oldest perl
- * compatible with the present perl. (That is, pure perl modules
- * written for pm_apiversion will still work for the current
- * version). perl.c:incpush() and lib/lib.pm will automatically
- * search in c:\\perl\\site\\5.00563\\lib for older directories across major versions
- * back to pm_apiversion. This is only useful if you have a perl
- * library directory tree structured like the default one. The
- * versioned site_perl library was introduced in 5.005, so that's
- * the default setting for this variable. It's hard to imagine
- * it changing before Perl6. It is included here for symmetry
- * with xs_apiveprsion -- the searching algorithms will
- * (presumably) be similar.
- * See the INSTALL file for how this works.
- */
-#define PERL_XS_APIVERSION 5.00563 /* Change to string for tuples?*/
-#define PERL_PM_APIVERSION 5.005 /* Change to string for tuples?*/
-
/* HAS_DRAND48_PROTO:
* This symbol, if defined, indicates that the system provides
* a prototype for the drand48() function. Otherwise, it is up
@@ -2752,16 +2708,22 @@
*/
/*#define I_PTHREAD /**/
-/* USE_THREADS:
- * This symbol, if defined, indicates that Perl should
- * be built to use threads.
+/* USE_ITHREADS:
+ * This symbol, if defined, indicates that Perl should be built to
+ * use the interpreter-based threading implementation.
+ */
+/* USE_5005THREADS:
+ * This symbol, if defined, indicates that Perl should be built to
+ * use the 5.005-based threading implementation.
*/
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
*/
-#ifndef USE_TTHREADS
-/*#define USE_THREADS /**/
+/*#define USE_5005THREADS /**/
+/*#define USE_ITHREADS /**/
+#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
+#define USE_THREADS /* until src is revised*/
#endif
/*#define OLD_PTHREADS_API /**/
@@ -2791,6 +2753,11 @@
*/
#define Gid_t_f "d" /**/
+/* Gid_t_size:
+ * This symbol holds the size of a Gid_t in bytes.
+ */
+#define Gid_t_size 4 /* GID size */
+
/* Gid_t:
* This symbol holds the return type of getgid() and the type of
* argument to setrgid() and related functions. Typically,
@@ -2808,8 +2775,12 @@
/* LSEEKSIZE:
* This symbol holds the number of bytes used by the Off_t.
*/
+/* Off_t_size:
+ * This symbol holds the number of bytes used by the Off_t.
+ */
#define Off_t off_t /* <offset> type */
#define LSEEKSIZE 4 /* <offset> size */
+#define Off_t_size 4 /* <offset> size */
/* Mode_t:
* This symbol holds the type used to declare file modes
@@ -2839,6 +2810,11 @@
*/
#define Uid_t_f "d" /**/
+/* Uid_t_size:
+ * This symbol holds the size of a Uid_t in bytes.
+ */
+#define Uid_t_size 4 /* UID size */
+
/* Uid_t:
* This symbol holds the type used to declare user ids in the kernel.
* It can be int, ushort, uid_t, etc... It may be necessary to include
diff --git a/win32/config_H.gc b/win32/config_H.gc
index cd4efc2a2e..fc91cb7d1d 100644
--- a/win32/config_H.gc
+++ b/win32/config_H.gc
@@ -13,7 +13,7 @@
/*
* Package name : perl5
* Source directory :
- * Configuration time: Sun Oct 31 02:10:12 1999
+ * Configuration time: Sun Jan 9 15:13:25 2000
* Configured by : gsar
* Target system :
*/
@@ -656,7 +656,7 @@
* This symbol, if defined, indicates that the tzname[] array is
* available to access timezone names.
*/
-/*#define HAS_TZNAME /**/
+#define HAS_TZNAME /**/
/* HAS_UMASK:
* This symbol, if defined, indicates that the umask routine is
@@ -980,52 +980,6 @@
*/
#define STDCHAR char /**/
-/* HAS_QUAD:
- * This symbol, if defined, tells that there's a 64-bit integer type,
- * Quad_t.
- */
-/* Quad_t:
- * This symbol holds the type used for 64-bit integers.
- * It can be int, long, long long, int64_t etc...
- */
-/* QUADCASE:
- * This symbol, if defined, encodes the type of a quad:
- * 1 = int, 2 = long, 3 = long long, 4 = int64_t.
- */
-/* Uquad_t:
- * This symbol holds the type used for unsigned 64-bit integers.
- * It can be unsigned int, unsigned long, unsigned long long,
- * uint64_t etc...
- */
-/*#define HAS_QUAD /**/
-/*#define Quad_t long long /**/
-/*#define Uquad_t unsigned long long /**/
-/*#define QUADCASE 5 /**/
-
-/* HAS_ACCESSX:
- * This symbol, if defined, indicates that the accessx routine is
- * available to do extended access checks.
- */
-/*#define HAS_ACCESSX /**/
-
-/* HAS_EACCESS:
- * This symbol, if defined, indicates that the eaccess routine is
- * available to do extended access checks.
- */
-/*#define HAS_EACCESS /**/
-
-/* I_SYS_ACCESS:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/access.h>.
- */
-/*#define I_SYS_ACCESS /**/
-
-/* I_SYS_SECURITY:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/security.h>.
- */
-/*#define I_SYS_SECURITY /**/
-
/* CROSSCOMPILE:
* This symbol, if defined, signifies that we our
* build process is a cross-compilation.
@@ -1057,6 +1011,46 @@
*/
/*#define MULTIARCH /**/
+/* HAS_QUAD:
+ * This symbol, if defined, tells that there's a 64-bit integer type,
+ * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
+ * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T.
+ */
+/*#define HAS_QUAD /**/
+#ifdef HAS_QUAD
+# define Quad_t long long /**/
+# define Uquad_t unsigned long long /**/
+# define QUADKIND undef /**/
+# define QUAD_IS_INT 1
+# define QUAD_IS_LONG 2
+# define QUAD_IS_LONG_LONG 3
+# define QUAD_IS_INT64_T 4
+#endif
+
+/* HAS_ACCESSX:
+ * This symbol, if defined, indicates that the accessx routine is
+ * available to do extended access checks.
+ */
+/*#define HAS_ACCESSX /**/
+
+/* HAS_EACCESS:
+ * This symbol, if defined, indicates that the eaccess routine is
+ * available to do extended access checks.
+ */
+/*#define HAS_EACCESS /**/
+
+/* I_SYS_ACCESS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/access.h>.
+ */
+/*#define I_SYS_ACCESS /**/
+
+/* I_SYS_SECURITY:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/security.h>.
+ */
+/*#define I_SYS_SECURITY /**/
+
/* MEM_ALIGNBYTES:
* This symbol contains the number of bytes required to align a
* double. Usual values are 2, 4 and 8. The default is eight,
@@ -1270,7 +1264,7 @@
* This symbol is defined if the FILE_cnt macro can be used as an
* lvalue.
*/
-/*#define USE_STDIO_PTR /**/
+#define USE_STDIO_PTR /**/
#ifdef USE_STDIO_PTR
#define FILE_ptr(fp) ((fp)->_ptr)
#define STDIO_PTR_LVALUE /**/
@@ -1298,7 +1292,7 @@
* structure pointed to its argument. This macro will always be defined
* if USE_STDIO_BASE is defined.
*/
-/*#define USE_STDIO_BASE /**/
+#define USE_STDIO_BASE /**/
#ifdef USE_STDIO_BASE
#define FILE_base(fp) ((fp)->_base)
#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base)
@@ -1429,7 +1423,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.00563\\lib\\MSWin32-x86" /**/
+#define ARCHLIB "c:\\perl\\5.5.640\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* BIN:
@@ -1440,8 +1434,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.00563\\bin\\MSWin32-x86" /**/
-#define BIN_EXP "c:\\perl\\5.00563\\bin\\MSWin32-x86" /**/
+#define BIN "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/
+#define BIN_EXP "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
@@ -1459,8 +1453,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.00563\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.00563")) /**/
+#define PRIVLIB "c:\\perl\\5.5.640\\lib" /**/
+#define PRIVLIB_EXP (win32_get_privlib("5.5.640")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
@@ -1477,7 +1471,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.00563\\lib\\MSWin32-x86" /**/
+#define SITEARCH "c:\\perl\\site\\5.5.640\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
@@ -1495,8 +1489,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.00563\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.00563")) /**/
+#define SITELIB "c:\\perl\\site\\5.5.640\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib("5.5.640")) /**/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
@@ -2202,6 +2196,13 @@
*/
/*#define HAS_HASMNTOPT /**/
+/* HAS_INT64_T:
+ * This symbol will defined if the C compiler supports int64_t.
+ * Usually the <inttypes.h> needs to be included, but sometimes
+ * <sys/types.h> is enough.
+ */
+/*#define HAS_INT64_T /**/
+
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* or <limits.h> defines the symbol LDBL_DIG, which is the number
@@ -2302,13 +2303,7 @@
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/* HAS_INT64_T:
- * This symbol will defined if the C compiler supports int64_t.
- * Usually the <inttypes.h> needs to be included, but sometimes
- * <sys/types.h> is enough.
- */
/*#define I_INTTYPES /**/
-/*#define HAS_INT64_T /**/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
@@ -2452,9 +2447,6 @@
/* U64SIZE:
* This symbol contains the sizeof(U64).
*/
-/* NVSIZE:
- * This symbol contains the sizeof(NV).
- */
#define IVTYPE long /**/
#define UVTYPE unsigned long /**/
#define I8TYPE char /**/
@@ -2480,7 +2472,6 @@
#define I64SIZE 8 /**/
#define U64SIZE 8 /**/
#endif
-#define NVSIZE 8 /**/
/* IVdf:
* This symbol defines the format string used for printing a Perl IV
@@ -2537,8 +2528,8 @@
/*#define HAS_STRTOULL /**/
/* USE_64_BITS:
- * This symbol, if defined, indicates that 64-bit interfaces should
- * be used when available. If not defined, the native default interfaces
+ * This symbol, if defined, indicates that 64-bit integers should
+ * be used when available. If not defined, the native integers
* will be used (be they 32 or 64 bits).
*/
#ifndef USE_64_BITS
@@ -2599,41 +2590,6 @@
/*#define USE_SOCKS /**/
#endif
-/* PERL_XS_APIVERSION:
- * This variable contains the version of the oldest perl binary
- * compatible with the present perl. perl.c:incpush() and
- * lib/lib.pm will automatically search in c:\\perl\\site\\5.00563\\lib\\MSWin32-x86 for older
- * directories across major versions back to xs_apiversion.
- * This is only useful if you have a perl library directory tree
- * structured like the default one.
- * See INSTALL for how this works.
- * The versioned site_perl directory was introduced in 5.005,
- * so that is the lowest possible value.
- * Since this can depend on compile time options (such as
- * bincompat) it is set by Configure. Other non-default sources
- * of potential incompatibility, such as multiplicity, threads,
- * debugging, 64bits, sfio, etc., are not checked for currently,
- * though in principle we could go snooping around in old
- * Config.pm files.
- */
-/* PERL_PM_APIVERSION:
- * This variable contains the version of the oldest perl
- * compatible with the present perl. (That is, pure perl modules
- * written for pm_apiversion will still work for the current
- * version). perl.c:incpush() and lib/lib.pm will automatically
- * search in c:\\perl\\site\\5.00563\\lib for older directories across major versions
- * back to pm_apiversion. This is only useful if you have a perl
- * library directory tree structured like the default one. The
- * versioned site_perl library was introduced in 5.005, so that's
- * the default setting for this variable. It's hard to imagine
- * it changing before Perl6. It is included here for symmetry
- * with xs_apiveprsion -- the searching algorithms will
- * (presumably) be similar.
- * See the INSTALL file for how this works.
- */
-#define PERL_XS_APIVERSION 5.00563 /* Change to string for tuples?*/
-#define PERL_PM_APIVERSION 5.005 /* Change to string for tuples?*/
-
/* HAS_DRAND48_PROTO:
* This symbol, if defined, indicates that the system provides
* a prototype for the drand48() function. Otherwise, it is up
@@ -2752,16 +2708,22 @@
*/
/*#define I_PTHREAD /**/
-/* USE_THREADS:
- * This symbol, if defined, indicates that Perl should
- * be built to use threads.
+/* USE_ITHREADS:
+ * This symbol, if defined, indicates that Perl should be built to
+ * use the interpreter-based threading implementation.
+ */
+/* USE_5005THREADS:
+ * This symbol, if defined, indicates that Perl should be built to
+ * use the 5.005-based threading implementation.
*/
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
*/
-#ifndef USE_TTHREADS
-/*#define USE_THREADS /**/
+/*#define USE_5005THREADS /**/
+/*#define USE_ITHREADS /**/
+#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
+#define USE_THREADS /* until src is revised*/
#endif
/*#define OLD_PTHREADS_API /**/
@@ -2791,6 +2753,11 @@
*/
#define Gid_t_f "ld" /**/
+/* Gid_t_size:
+ * This symbol holds the size of a Gid_t in bytes.
+ */
+#define Gid_t_size 4 /* GID size */
+
/* Gid_t:
* This symbol holds the return type of getgid() and the type of
* argument to setrgid() and related functions. Typically,
@@ -2808,8 +2775,12 @@
/* LSEEKSIZE:
* This symbol holds the number of bytes used by the Off_t.
*/
+/* Off_t_size:
+ * This symbol holds the number of bytes used by the Off_t.
+ */
#define Off_t off_t /* <offset> type */
#define LSEEKSIZE 4 /* <offset> size */
+#define Off_t_size 4 /* <offset> size */
/* Mode_t:
* This symbol holds the type used to declare file modes
@@ -2839,6 +2810,11 @@
*/
#define Uid_t_f "ld" /**/
+/* Uid_t_size:
+ * This symbol holds the size of a Uid_t in bytes.
+ */
+#define Uid_t_size 4 /* UID size */
+
/* Uid_t:
* This symbol holds the type used to declare user ids in the kernel.
* It can be int, ushort, uid_t, etc... It may be necessary to include
diff --git a/win32/config_H.vc b/win32/config_H.vc
index 032a9c8cbc..4e1964f323 100644
--- a/win32/config_H.vc
+++ b/win32/config_H.vc
@@ -13,7 +13,7 @@
/*
* Package name : perl5
* Source directory :
- * Configuration time: Sun Oct 31 02:10:23 1999
+ * Configuration time: Sun Jan 9 15:13:19 2000
* Configured by : gsar
* Target system :
*/
@@ -980,52 +980,6 @@
*/
#define STDCHAR char /**/
-/* HAS_QUAD:
- * This symbol, if defined, tells that there's a 64-bit integer type,
- * Quad_t.
- */
-/* Quad_t:
- * This symbol holds the type used for 64-bit integers.
- * It can be int, long, long long, int64_t etc...
- */
-/* QUADCASE:
- * This symbol, if defined, encodes the type of a quad:
- * 1 = int, 2 = long, 3 = long long, 4 = int64_t.
- */
-/* Uquad_t:
- * This symbol holds the type used for unsigned 64-bit integers.
- * It can be unsigned int, unsigned long, unsigned long long,
- * uint64_t etc...
- */
-/*#define HAS_QUAD /**/
-/*#define Quad_t __int64 /**/
-/*#define Uquad_t unsigned __int64 /**/
-/*#define QUADCASE 5 /**/
-
-/* HAS_ACCESSX:
- * This symbol, if defined, indicates that the accessx routine is
- * available to do extended access checks.
- */
-/*#define HAS_ACCESSX /**/
-
-/* HAS_EACCESS:
- * This symbol, if defined, indicates that the eaccess routine is
- * available to do extended access checks.
- */
-/*#define HAS_EACCESS /**/
-
-/* I_SYS_ACCESS:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/access.h>.
- */
-/*#define I_SYS_ACCESS /**/
-
-/* I_SYS_SECURITY:
- * This symbol, if defined, indicates to the C program that it should
- * include <sys/security.h>.
- */
-/*#define I_SYS_SECURITY /**/
-
/* CROSSCOMPILE:
* This symbol, if defined, signifies that we our
* build process is a cross-compilation.
@@ -1057,6 +1011,46 @@
*/
/*#define MULTIARCH /**/
+/* HAS_QUAD:
+ * This symbol, if defined, tells that there's a 64-bit integer type,
+ * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one
+ * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T.
+ */
+/*#define HAS_QUAD /**/
+#ifdef HAS_QUAD
+# define Quad_t __int64 /**/
+# define Uquad_t unsigned __int64 /**/
+# define QUADKIND undef /**/
+# define QUAD_IS_INT 1
+# define QUAD_IS_LONG 2
+# define QUAD_IS_LONG_LONG 3
+# define QUAD_IS_INT64_T 4
+#endif
+
+/* HAS_ACCESSX:
+ * This symbol, if defined, indicates that the accessx routine is
+ * available to do extended access checks.
+ */
+/*#define HAS_ACCESSX /**/
+
+/* HAS_EACCESS:
+ * This symbol, if defined, indicates that the eaccess routine is
+ * available to do extended access checks.
+ */
+/*#define HAS_EACCESS /**/
+
+/* I_SYS_ACCESS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/access.h>.
+ */
+/*#define I_SYS_ACCESS /**/
+
+/* I_SYS_SECURITY:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/security.h>.
+ */
+/*#define I_SYS_SECURITY /**/
+
/* MEM_ALIGNBYTES:
* This symbol contains the number of bytes required to align a
* double. Usual values are 2, 4 and 8. The default is eight,
@@ -1429,7 +1423,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.00563\\lib\\MSWin32-x86" /**/
+#define ARCHLIB "c:\\perl\\5.5.640\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* BIN:
@@ -1440,8 +1434,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.00563\\bin\\MSWin32-x86" /**/
-#define BIN_EXP "c:\\perl\\5.00563\\bin\\MSWin32-x86" /**/
+#define BIN "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/
+#define BIN_EXP "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
@@ -1459,8 +1453,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.00563\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.00563")) /**/
+#define PRIVLIB "c:\\perl\\5.5.640\\lib" /**/
+#define PRIVLIB_EXP (win32_get_privlib("5.5.640")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
@@ -1477,7 +1471,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.00563\\lib\\MSWin32-x86" /**/
+#define SITEARCH "c:\\perl\\site\\5.5.640\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
@@ -1495,8 +1489,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.00563\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.00563")) /**/
+#define SITELIB "c:\\perl\\site\\5.5.640\\lib" /**/
+#define SITELIB_EXP (win32_get_sitelib("5.5.640")) /**/
/* PERL_VENDORLIB_EXP:
* This symbol contains the ~name expanded version of VENDORLIB, to be used
@@ -2202,6 +2196,13 @@
*/
/*#define HAS_HASMNTOPT /**/
+/* HAS_INT64_T:
+ * This symbol will defined if the C compiler supports int64_t.
+ * Usually the <inttypes.h> needs to be included, but sometimes
+ * <sys/types.h> is enough.
+ */
+/*#define HAS_INT64_T /**/
+
/* HAS_LDBL_DIG:
* This symbol, if defined, indicates that this system's <float.h>
* or <limits.h> defines the symbol LDBL_DIG, which is the number
@@ -2302,13 +2303,7 @@
* This symbol, if defined, indicates to the C program that it should
* include <inttypes.h>.
*/
-/* HAS_INT64_T:
- * This symbol will defined if the C compiler supports int64_t.
- * Usually the <inttypes.h> needs to be included, but sometimes
- * <sys/types.h> is enough.
- */
/*#define I_INTTYPES /**/
-/*#define HAS_INT64_T /**/
/* I_MNTENT:
* This symbol, if defined, indicates that <mntent.h> exists and
@@ -2452,9 +2447,6 @@
/* U64SIZE:
* This symbol contains the sizeof(U64).
*/
-/* NVSIZE:
- * This symbol contains the sizeof(NV).
- */
#define IVTYPE long /**/
#define UVTYPE unsigned long /**/
#define I8TYPE char /**/
@@ -2480,7 +2472,6 @@
#define I64SIZE 8 /**/
#define U64SIZE 8 /**/
#endif
-#define NVSIZE 8 /**/
/* IVdf:
* This symbol defines the format string used for printing a Perl IV
@@ -2537,8 +2528,8 @@
/*#define HAS_STRTOULL /**/
/* USE_64_BITS:
- * This symbol, if defined, indicates that 64-bit interfaces should
- * be used when available. If not defined, the native default interfaces
+ * This symbol, if defined, indicates that 64-bit integers should
+ * be used when available. If not defined, the native integers
* will be used (be they 32 or 64 bits).
*/
#ifndef USE_64_BITS
@@ -2599,41 +2590,6 @@
/*#define USE_SOCKS /**/
#endif
-/* PERL_XS_APIVERSION:
- * This variable contains the version of the oldest perl binary
- * compatible with the present perl. perl.c:incpush() and
- * lib/lib.pm will automatically search in c:\\perl\\site\\5.00563\\lib\\MSWin32-x86 for older
- * directories across major versions back to xs_apiversion.
- * This is only useful if you have a perl library directory tree
- * structured like the default one.
- * See INSTALL for how this works.
- * The versioned site_perl directory was introduced in 5.005,
- * so that is the lowest possible value.
- * Since this can depend on compile time options (such as
- * bincompat) it is set by Configure. Other non-default sources
- * of potential incompatibility, such as multiplicity, threads,
- * debugging, 64bits, sfio, etc., are not checked for currently,
- * though in principle we could go snooping around in old
- * Config.pm files.
- */
-/* PERL_PM_APIVERSION:
- * This variable contains the version of the oldest perl
- * compatible with the present perl. (That is, pure perl modules
- * written for pm_apiversion will still work for the current
- * version). perl.c:incpush() and lib/lib.pm will automatically
- * search in c:\\perl\\site\\5.00563\\lib for older directories across major versions
- * back to pm_apiversion. This is only useful if you have a perl
- * library directory tree structured like the default one. The
- * versioned site_perl library was introduced in 5.005, so that's
- * the default setting for this variable. It's hard to imagine
- * it changing before Perl6. It is included here for symmetry
- * with xs_apiveprsion -- the searching algorithms will
- * (presumably) be similar.
- * See the INSTALL file for how this works.
- */
-#define PERL_XS_APIVERSION 5.00563 /* Change to string for tuples?*/
-#define PERL_PM_APIVERSION 5.005 /* Change to string for tuples?*/
-
/* HAS_DRAND48_PROTO:
* This symbol, if defined, indicates that the system provides
* a prototype for the drand48() function. Otherwise, it is up
@@ -2752,16 +2708,22 @@
*/
/*#define I_PTHREAD /**/
-/* USE_THREADS:
- * This symbol, if defined, indicates that Perl should
- * be built to use threads.
+/* USE_ITHREADS:
+ * This symbol, if defined, indicates that Perl should be built to
+ * use the interpreter-based threading implementation.
+ */
+/* USE_5005THREADS:
+ * This symbol, if defined, indicates that Perl should be built to
+ * use the 5.005-based threading implementation.
*/
/* OLD_PTHREADS_API:
* This symbol, if defined, indicates that Perl should
* be built to use the old draft POSIX threads API.
*/
-#ifndef USE_TTHREADS
-/*#define USE_THREADS /**/
+/*#define USE_5005THREADS /**/
+/*#define USE_ITHREADS /**/
+#if defined(USE_5005THREADS) && !defined(USE_ITHREADS)
+#define USE_THREADS /* until src is revised*/
#endif
/*#define OLD_PTHREADS_API /**/
@@ -2791,6 +2753,11 @@
*/
#define Gid_t_f "ld" /**/
+/* Gid_t_size:
+ * This symbol holds the size of a Gid_t in bytes.
+ */
+#define Gid_t_size 4 /* GID size */
+
/* Gid_t:
* This symbol holds the return type of getgid() and the type of
* argument to setrgid() and related functions. Typically,
@@ -2808,8 +2775,12 @@
/* LSEEKSIZE:
* This symbol holds the number of bytes used by the Off_t.
*/
+/* Off_t_size:
+ * This symbol holds the number of bytes used by the Off_t.
+ */
#define Off_t off_t /* <offset> type */
#define LSEEKSIZE 4 /* <offset> size */
+#define Off_t_size 4 /* <offset> size */
/* Mode_t:
* This symbol holds the type used to declare file modes
@@ -2839,6 +2810,11 @@
*/
#define Uid_t_f "ld" /**/
+/* Uid_t_size:
+ * This symbol holds the size of a Uid_t in bytes.
+ */
+#define Uid_t_size 4 /* UID size */
+
/* Uid_t:
* This symbol holds the type used to declare user ids in the kernel.
* It can be int, ushort, uid_t, etc... It may be necessary to include
diff --git a/win32/config_h.PL b/win32/config_h.PL
index 16e467e915..17f3fc2163 100644
--- a/win32/config_h.PL
+++ b/win32/config_h.PL
@@ -13,8 +13,8 @@ while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
}
my $patchlevel = $opt{INST_VER};
$patchlevel =~ s|^[\\/]||;
-$patchlevel =~ s|~VERSION~|$]|g;
-$patchlevel ||= $];
+$patchlevel =~ s|~VERSION~|$Config{version}|g;
+$patchlevel ||= $Config{version};
$patchlevel = qq["$patchlevel"];
open(SH,"<$name") || die "Cannot open $name:$!";
diff --git a/win32/config_sh.PL b/win32/config_sh.PL
index 9e53b54827..0e1d351c1a 100644
--- a/win32/config_sh.PL
+++ b/win32/config_sh.PL
@@ -10,17 +10,38 @@ sub mungepath {
return join(' ', @p);
}
+# generate an array of option strings from command-line args
+# or an option file
+# -- added by BKS, 10-17-1999 to fix command-line overflow problems
+sub loadopts {
+ if ($ARGV[0] =~ /--cfgsh-option-file/) {
+ shift @ARGV;
+ my $optfile = shift @ARGV;
+ local (*F);
+ open OPTF, $optfile or die "Can't open $optfile: $!\n";
+ my @opts;
+ chomp(my $line = <OPTF>);
+ my @vars = split(/\t+~\t+/, $line);
+ for (@vars) {
+ push(@opts, $_) unless (/^\s*$/);
+ }
+ close OPTF;
+ return \@opts;
+ }
+ else {
+ return \@ARGV;
+ }
+}
+
my %opt;
-while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
- {
- $opt{$1}=$2;
- shift(@ARGV);
- }
+my $optref = loadopts();
+while (@{$optref} && $optref->[0] =~ /^([\w_]+)=(.*)$/) {
+ $opt{$1}=$2;
+ shift(@{$optref});
+}
my $pl_h = '../patchlevel.h';
-$opt{VERSION} = $];
-$opt{INST_VER} =~ s|~VERSION~|$]|g;
if (-e $pl_h) {
open PL, "<$pl_h" or die "Can't open $pl_h: $!";
while (<PL>) {
@@ -30,17 +51,11 @@ if (-e $pl_h) {
}
close PL;
}
-elsif ($] =~ /^(\d+)\.(\d\d\d)?(\d\d)?$/) { # should always be true
- $opt{PERL_REVISION} = $1;
- $opt{PERL_VERSION} = int($2 || 0);
- $opt{PERL_SUBVERSION} = $3;
- $opt{PERL_APIVERSION} = $];
-}
else {
- die "Can't parse perl version ($])";
+ die "Can't find $pl_h: $!";
}
-
-$opt{PERL_SUBVERSION} ||= '00';
+$opt{VERSION} = "$opt{PERL_REVISION}.$opt{PERL_VERSION}.$opt{PERL_SUBVERSION}";
+$opt{INST_VER} =~ s|~VERSION~|$opt{VERSION}|g;
$opt{'cf_by'} = $ENV{USERNAME} unless $opt{'cf_by'};
$opt{'cf_email'} = $opt{'cf_by'} . '@' . (gethostbyname('localhost'))[0]
@@ -50,19 +65,19 @@ $opt{'usemymalloc'} = 'y' if $opt{'d_mymalloc'} eq 'define';
$opt{libpth} = mungepath($opt{libpth}) if exists $opt{libpth};
$opt{incpath} = mungepath($opt{incpath}) if exists $opt{incpath};
-while (<>)
- {
- s/~([\w_]+)~/$opt{$1}/g;
- if (/^([\w_]+)=(.*)$/) {
- my($k,$v) = ($1,$2);
- # this depends on cf_time being empty in the template (or we'll get a loop)
- if ($k eq 'cf_time') {
- $_ = "$k='" . localtime(time) . "'\n" if $v =~ /^\s*'\s*'/;
- }
- elsif (exists $opt{$k}) {
- $_ = "$k='$opt{$k}'\n";
+while (<>) {
+ s/~([\w_]+)~/$opt{$1}/g;
+ if (/^([\w_]+)=(.*)$/) {
+ my($k,$v) = ($1,$2);
+ # this depends on cf_time being empty in the template (or we'll
+ # get a loop)
+ if ($k eq 'cf_time') {
+ $_ = "$k='" . localtime(time) . "'\n" if $v =~ /^\s*'\s*'/;
+ }
+ elsif (exists $opt{$k}) {
+ $_ = "$k='$opt{$k}'\n";
+ }
}
- }
- print;
- }
+ print;
+}
diff --git a/win32/genmk95.pl b/win32/genmk95.pl
index 74788ff3cb..8fe4f86dbf 100644
--- a/win32/genmk95.pl
+++ b/win32/genmk95.pl
@@ -1,28 +1,28 @@
-# genmk95.pl - uses miniperl to generate a makefile that command.com
-# (and dmake) will understand given one that cmd.exe will understand
+# genmk95.pl - uses miniperl to generate a makefile that command.com will
+# understand given one that cmd.exe will understand
# Author: Benjamin K. Stuhl
-# Date: 8-18-1999
+# Date: 10-16-1999
# how it works:
# dmake supports an alternative form for its recipes, called "group
-# recipes", in which all elements of a recipe are run with only one
-# shell. This program converts the standard dmake makefile.mk to
-# one using group recipes. This is done so that lines using && or
-# || (which command.com doesn't understand) may be split into two
-# lines.
+# recipes", in which all elements of a recipe are run with only one shell.
+# This program converts the standard dmake makefile.mk to one using group
+# recipes. This is done so that lines using && or || (which command.com
+# doesn't understand) may be split into two lines that will still be run
+# with one shell.
my ($filein, $fileout) = @ARGV;
-chomp (my $loc = `cd`);
-
-open my $in, $filein or die "Error opening input file: $!";
-open my $out, "> $fileout" or die "Error opening output file: $!";
+open my $in, $filein or die "Error opening input file: $!\n";
+open my $out, "> $fileout" or die "Error opening output file: $!\n";
print $out <<_EOH_;
# *** Warning: this file is autogenerated from $filein by $0 ***
# *** Do not edit this file - edit $filein instead ***
+_HOME_DIR := \$(PWD)
+
_EOH_
my $inrec = 0;
@@ -30,12 +30,12 @@ my $inrec = 0;
while (<$in>)
{
chomp;
- if (/^[^#.\t][^#=]*?:/)
+ if (/^[^#.\t][^#=]*?:(?:[^=]|$)/)
{
if (! $inrec)
{
print $out "$_\n";
- while (/\\$/)
+ while (/\\\s*$/)
{
chomp($_ = <$in>);
print $out "$_\n";
@@ -45,9 +45,12 @@ while (<$in>)
next;
}
else {
- seek ($out, -3, 2); # no recipe, so back up and undo grouping
+ if (!/^\t/) {
+ seek ($out, -4, 2); # no recipe, so back up and undo grouping
+ # should be -3, but MS has its CR/LF thing...
+ $inrec = 0;
+ }
print $out "$_\n";
- $inrec = 0;
next;
}
}
@@ -70,7 +73,7 @@ LINE_CONT:
s/^\s*// for ($one, $two);
print $out "\t$one\n\t$two\n" if ($sep eq "&&");
print $out "\t$one\n\tif errorlevel 1 $two\n" if ($sep eq "||");
- print $out "\tcd $loc\n";
+ print $out "\tcd \$(_HOME_DIR)\n";
next;
}
# fall through - no need for special handling
@@ -78,4 +81,5 @@ LINE_CONT:
}
print $out "]\n" if ($inrec);
-close $in; close $out;
+close $in or warn "Error closing \$in: $!\n";
+close $out or warn "Error closing \$out: $!\n";
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 2550611c88..e6ed1765a7 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -1,9 +1,9 @@
#
# Makefile to build perl on Windows NT using DMAKE.
# Supported compilers:
-# Visual C++ 2.0 thro 5.0
+# Visual C++ 2.0 thro 6.0
# Borland C++ 5.02
-# Mingw32 with gcc-2.8.1 or egcs-1.0.2 **experimental**
+# Mingw32 with gcc-2.95.2 or better **experimental**
#
# 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.
@@ -18,7 +18,7 @@
##
#
-# Set these to wherever you want "nmake install" to put your
+# Set these to wherever you want "dmake install" to put your
# newly built perl.
#
INST_DRV *= c:
@@ -33,7 +33,7 @@ INST_TOP *= $(INST_DRV)\perl
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-INST_VER *= \5.00563
+INST_VER *= \5.5.640
#
# Comment this out if you DON'T want your perl installation to have
@@ -51,7 +51,7 @@ INST_ARCH *= \$(ARCHNAME)
#
# uncomment to enable threads-capabilities
#
-#USE_THREADS *= define
+#USE_5005THREADS *= define
#
# XXX WARNING! This option currently undergoing changes. May be broken.
@@ -70,6 +70,22 @@ INST_ARCH *= \$(ARCHNAME)
#USE_OBJECT *= define
#
+# XXX WARNING! This option currently undergoing changes. May be broken.
+#
+# Beginnings of interpreter cloning/threads: still rather rough, fails
+# tests. This should be enabled to get the fork() emulation. Do not
+# enable unless you know what you're doing!
+#
+#USE_ITHREADS *= define
+
+#
+# uncomment to enable the implicit "host" layer for all system calls
+# made by perl. This is needed and auto-enabled by USE_OBJECT above.
+# This is also needed to get fork().
+#
+#USE_IMP_SYS *= define
+
+#
# uncomment exactly one of the following
#
# Visual C++ 2.x
@@ -80,7 +96,7 @@ INST_ARCH *= \$(ARCHNAME)
#CCTYPE *= MSVC60
# Borland 5.02 or later
CCTYPE *= BORLAND
-# mingw32/egcs or mingw32/gcc
+# mingw32/gcc-2.95.2 or better
#CCTYPE *= GCC
#
@@ -97,11 +113,13 @@ CCTYPE *= BORLAND
#
# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler.
-# Highly recommended. It has patches that fix known bugs in MSVCRT.DLL.
+# It has patches that fix known bugs in older versions of MSVCRT.DLL.
# This currently requires VC 5.0 with Service Pack 3 or later.
# Get it from CPAN at http://www.perl.com/CPAN/authors/id/D/DO/DOUGL/
# and follow the directions in the package to install.
#
+# Not recommended if you have VC 6.x and you're not running Windows 9x.
+#
#USE_PERLCRT *= define
#
@@ -143,27 +161,41 @@ CCTYPE *= BORLAND
# so you may have to set CCHOME explicitly (spaces in the path name should
# not be quoted)
#
-CCHOME *= d:\bc5
+CCHOME *= c:\bc5
#CCHOME *= $(MSVCDIR)
#CCHOME *= D:\packages\mingw32
CCINCDIR *= $(CCHOME)\include
CCLIBDIR *= $(CCHOME)\lib
#
-# additional compiler flags can be specified here.
+# Additional compiler flags can be specified here.
+#
+
#
-# Adding -DPERL_POLLUTE enables support for old symbols, at the expense of
-# extreme pollution. You most probably want this if you're compiling modules
-# from CPAN, or other such serious uses of this experimental perl release.
-# We don't enable this by default because we want the modules to get fixed
-# instead of clinging to shortcuts like this one.
+# This should normally be disabled. Adding -DPERL_POLLUTE enables support
+# for old symbols by default, at the expense of extreme pollution. You most
+# probably just want to build modules that won't compile with
+# perl Makefile.PL POLLUTE=1
+# instead of enabling this. Please report such modules to the respective
+# authors.
#
#BUILDOPT += -DPERL_POLLUTE
#
-# enable this to test the File::Glob implementation of CORE::glob
+# This should normally be disabled. Enabling it will disable the File::Glob
+# implementation of CORE::glob.
+#
+#BUILDOPT += -DPERL_EXTERNAL_GLOB
+
+#
+# This should normally be disabled. Enabling it causes perl to read scripts
+# in text mode (which is the 5.005 behavior) and will break ByteLoader.
+#BUILDOPT += -DPERL_TEXTMODE_SCRIPTS
+
#
-#BUILDOPT += -DPERL_INTERNAL_GLOB
+# This should normally be disabled. Enabling it runs a cloned toplevel
+# interpreter (*EXPERIMENTAL*, fails tests)
+#BUILDOPT += -DTOP_CLONE
#
# specify semicolon-separated list of extra directories that modules will
@@ -198,20 +230,32 @@ CRYPT_FLAG = -DHAVE_DES_FCRYPT
.IF "$(USE_OBJECT)" == "define"
PERL_MALLOC != undef
-USE_THREADS != undef
+USE_5005THREADS != undef
USE_MULTI != undef
+USE_IMP_SYS != define
.ENDIF
PERL_MALLOC *= undef
-USE_THREADS *= undef
+USE_5005THREADS *= undef
+
+.IF "$(USE_5005THREADS)" == "define"
+USE_ITHREADS != undef
+.ENDIF
+
USE_MULTI *= undef
USE_OBJECT *= undef
+USE_ITHREADS *= undef
+USE_IMP_SYS *= undef
+USE_PERLCRT *= undef
-.IF "$(USE_MULTI)$(USE_THREADS)$(USE_OBJECT)" != "undefundefundef"
+.IF "$(USE_MULTI)$(USE_5005THREADS)$(USE_OBJECT)" != "undefundefundef"
BUILDOPT += -DPERL_IMPLICIT_CONTEXT
.ENDIF
+.IF "$(USE_IMP_SYS)" != "undef"
+BUILDOPT += -DPERL_IMPLICIT_SYS
+.ENDIF
.IMPORT .IGNORE : PROCESSOR_ARCHITECTURE
@@ -219,7 +263,7 @@ PROCESSOR_ARCHITECTURE *= x86
.IF "$(USE_OBJECT)" == "define"
ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-object
-.ELIF "$(USE_THREADS)" == "define"
+.ELIF "$(USE_5005THREADS)" == "define"
ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread
.ELIF "$(USE_MULTI)" == "define"
ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi
@@ -227,6 +271,10 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi
ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)
.ENDIF
+.IF "$(USE_OBJECT)" == "define"
+ARCHNAME = $(ARCHNAME)-thread
+.ENDIF
+
# Visual Studio 98 specific
.IF "$(CCTYPE)" == "MSVC60"
@@ -268,6 +316,7 @@ CC = bcc32
LINK32 = tlink32
LIB32 = tlib /P128
IMPLIB = implib -c
+RSC = rc
#
# Options
@@ -304,6 +353,7 @@ CC = gcc
LINK32 = gcc
LIB32 = ar rc
IMPLIB = dlltool
+RSC = rc
o = .o
a = .a
@@ -311,6 +361,7 @@ a = .a
#
# Options
#
+
RUNTIME =
INCLUDES = -I$(COREDIR) -I.\include -I. -I..
DEFINES = -DWIN32 $(CRYPT_FLAG)
@@ -318,11 +369,14 @@ LOCDEFS = -DPERLDLL -DPERL_CORE
SUBSYS = console
CXX_FLAG = -xc++
-# crtdll doesn't define _wopen and friends
-#LIBC = -lcrtdll
LIBC = -lmsvcrt
-LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lnetapi32 -lwsock32 \
- -lmingw32 -lgcc -lmoldname $(LIBC) -lkernel32
+
+# same libs as MSVC
+LIBFILES = $(CRYPT_LIB) $(LIBC) \
+ -lmoldname -lkernel32 -luser32 -lgdi32 \
+ -lwinspool -lcomdlg32 -ladvapi32 -lshell32 -lole32 \
+ -loleaut32 -lnetapi32 -luuid -lwsock32 -lmpr \
+ -lwinmm -lversion -lodbc32
.IF "$(CFG)" == "Debug"
OPTIMIZE = -g $(RUNTIME) -DDEBUGGING
@@ -343,6 +397,7 @@ LIBOUT_FLAG =
CC = cl
LINK32 = link
LIB32 = $(LINK32) -lib
+RSC = rc
#
# Options
@@ -356,7 +411,7 @@ LOCDEFS = -DPERLDLL -DPERL_CORE
SUBSYS = console
CXX_FLAG = -TP -GX
-.IF "$(USE_PERLCRT)" == ""
+.IF "$(USE_PERLCRT)" != "define"
.IF "$(CFG)" == "Debug"
PERLCRTLIBC = msvcrtd.lib
.ELSE
@@ -370,6 +425,9 @@ PERLCRTLIBC = PerlCRT.lib
.ENDIF
.ENDIF
+PERLEXE_RES =
+PERLDLL_RES =
+
.IF "$(RUNTIME)" == "-MD"
LIBC = $(PERLCRTLIBC)
.ELSE
@@ -395,9 +453,9 @@ LINK_DBG = -release
.ENDIF
LIBBASEFILES = $(DELAYLOAD) $(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 \
+ 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
@@ -412,6 +470,10 @@ OBJOUT_FLAG = -Fo
EXEOUT_FLAG = -Fe
LIBOUT_FLAG = /out:
+.IF "$(USE_PERLCRT)" != "define"
+BUILDOPT += -DPERL_MSVCRT_READFIX
+.ENDIF
+
.ENDIF
.IF "$(USE_OBJECT)" == "define"
@@ -421,6 +483,12 @@ BUILDOPT += -DPERL_OBJECT
CFLAGS_O = $(CFLAGS) $(BUILDOPT)
+# used to allow local linking flags that are not propogated into Config.pm,
+# currently unused
+# -- BKS, 12-12-1999
+PRIV_LINK_FLAGS *=
+BLINK_FLAGS = $(PRIV_LINK_FLAGS) $(LINK_FLAGS)
+
#################### do not edit below this line #######################
############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ##############
@@ -434,7 +502,7 @@ LKPOST = )
# Rules
#
-.SUFFIXES : .c $(o) .dll $(a) .exe
+.SUFFIXES : .c $(o) .dll $(a) .exe .rc .res
.c$(o):
$(CC) -c $(null,$(<:d) $(NULL) -I$(<:d)) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $<
@@ -444,21 +512,25 @@ LKPOST = )
$(o).dll:
.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpd -ap $(LINK_FLAGS) c0d32$(o) $<,$@,,$(LIBFILES),$(*B).def
+ $(LINK32) -Tpd -ap $(BLINK_FLAGS) c0d32$(o) $<,$@,,$(LIBFILES),$(*B).def
$(IMPLIB) $(*B).lib $@
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) -o $@ $(LINK_FLAGS) $< $(LIBFILES)
- $(IMPLIB) -def $(*B).def $(*B).a $@
+ $(LINK32) -o $@ $(BLINK_FLAGS) $< $(LIBFILES)
+ $(IMPLIB) --input-def $(*B).def --output-lib $(*B).a $@
.ELSE
$(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \
- -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL)
+ -out:$@ $(BLINK_FLAGS) $(LIBFILES) $< $(LIBPERL)
.ENDIF
+.rc.res:
+ $(RSC) $<
+
#
# various targets
MINIPERL = ..\miniperl.exe
MINIDIR = .\mini
PERLEXE = ..\perl.exe
+WPERLEXE = ..\wperl.exe
GLOBEXE = ..\perlglob.exe
CONFIGPM = ..\lib\Config.pm
MINIMOD = ..\lib\ExtUtils\Miniperl.pm
@@ -476,7 +548,6 @@ UTILS = \
..\utils\c2ph \
..\utils\h2xs \
..\utils\perldoc \
- ..\utils\pstruct \
..\utils\perlcc \
..\pod\checkpods \
..\pod\pod2html \
@@ -512,7 +583,7 @@ PERLIMPLIB = ..\libperl$(a)
CFGSH_TMPL = config.vc
CFGH_TMPL = config_H.vc
-.IF "$(USE_PERLCRT)" == ""
+.IF "$(USE_PERLCRT)" != "define"
PERL95EXE = ..\perl95.exe
.ENDIF
@@ -580,7 +651,7 @@ WIN32_SRC = \
.\win32.c \
.\win32sck.c
-.IF "$(USE_THREADS)" == "define"
+.IF "$(USE_5005THREADS)" == "define"
WIN32_SRC += .\win32thread.c
.ENDIF
@@ -644,7 +715,10 @@ CORE_NOCFG_H = \
.\include\dirent.h \
.\include\netdb.h \
.\include\sys\socket.h \
- .\win32.h
+ .\win32.h \
+ .\perlhost.h \
+ .\vdir.h \
+ .\vmem.h
CORE_H = $(CORE_NOCFG_H) .\config.h
@@ -750,68 +824,119 @@ POD2MAN = $(PODDIR)\pod2man
POD2LATEX = $(PODDIR)\pod2latex
POD2TEXT = $(PODDIR)\pod2text
+# vars must be separated by "\t+~\t+", since we're using the tempfile
+# version of config_sh.pl (we were overflowing someone's buffer by
+# trying to fit them all on the command line)
+# -- BKS 10-17-1999
CFG_VARS = \
- "INST_DRV=$(INST_DRV)" \
- "INST_TOP=$(INST_TOP)" \
- "INST_VER=$(INST_VER)" \
- "INST_ARCH=$(INST_ARCH)" \
- "archname=$(ARCHNAME)" \
- "cc=$(CC)" \
- "ccflags=$(OPTIMIZE:s/"/\"/) $(DEFINES) $(BUILDOPT)" \
- "cf_email=$(EMAIL)" \
- "d_crypt=$(D_CRYPT)" \
- "d_mymalloc=$(PERL_MALLOC)" \
- "libs=$(LIBFILES:f)" \
- "incpath=$(CCINCDIR:s/"/\"/)" \
- "libperl=$(PERLIMPLIB:f)" \
- "libpth=$(CCLIBDIR:s/"/\"/);$(EXTRALIBDIRS:s/"/\"/)" \
- "libc=$(LIBC)" \
- "make=dmake" \
- "_o=$(o)" "obj_ext=$(o)" \
- "_a=$(a)" "lib_ext=$(a)" \
- "static_ext=$(STATIC_EXT)" \
- "dynamic_ext=$(DYNAMIC_EXT)" \
- "nonxs_ext=$(NONXS_EXT)" \
- "usethreads=$(USE_THREADS)" \
- "usemultiplicity=$(USE_MULTI)" \
- "LINK_FLAGS=$(LINK_FLAGS:s/"/\"/)" \
- "optimize=$(OPTIMIZE:s/"/\"/)"
+ INST_DRV=$(INST_DRV) ~ \
+ INST_TOP=$(INST_TOP) ~ \
+ INST_VER=$(INST_VER:s/\/\\/) ~ \
+ INST_ARCH=$(INST_ARCH) ~ \
+ archname=$(ARCHNAME) ~ \
+ cc=$(CC) ~ \
+ ccflags=$(OPTIMIZE) $(DEFINES) $(BUILDOPT) ~ \
+ cf_email=$(EMAIL) ~ \
+ d_crypt=$(D_CRYPT) ~ \
+ d_mymalloc=$(PERL_MALLOC) ~ \
+ libs=$(LIBFILES:f) ~ \
+ incpath=$(CCINCDIR) ~ \
+ libperl=$(PERLIMPLIB:f) ~ \
+ libpth=$(CCLIBDIR);$(EXTRALIBDIRS) ~ \
+ libc=$(LIBC) ~ \
+ make=dmake ~ \
+ _o=$(o) obj_ext=$(o) ~ \
+ _a=$(a) lib_ext=$(a) ~ \
+ static_ext=$(STATIC_EXT) ~ \
+ dynamic_ext=$(DYNAMIC_EXT) ~ \
+ nonxs_ext=$(NONXS_EXT) ~ \
+ use5005threads=$(USE_5005THREADS) ~ \
+ useithreads=$(USE_ITHREADS) ~ \
+ usethreads=$(USE_5005THREADS) ~ \
+ usemultiplicity=$(USE_MULTI) ~ \
+ LINK_FLAGS=$(LINK_FLAGS:s/\/\\/) ~ \
+ optimize=$(OPTIMIZE)
+
+#
+# set up targets varying between Win95 and WinNT builds
+#
+
+.IF "$(IS_WIN95)" == "define"
+MK2 = .\makefile.95
+RIGHTMAKE = __switch_makefiles
+NOOP = @rem
+.ELSE
+MK2 = __not_needed
+RIGHTMAKE = __not_needed
+.ENDIF
#
# Top targets
#
-.IF "$(IS_WIN95)" != ""
-MK2 = .\makew95.mk
+all : .\config.h $(GLOBEXE) $(MINIPERL) $(MK2) \
+ $(RIGHTMAKE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) \
+ $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM)
+
+$(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
-all : .\config.h $(GLOBEXE) $(MINIMOD) $(MK2)
-all2 : $(CONFIGPM) $(PERLEXE) $(PERL95EXE) $(X2P) $(EXTENSION_DLL) \
- $(EXTENSIOM_PM)
+#----------------------------------------------------------------
+
+#-------------------- BEGIN Win95 SPECIFIC ----------------------
+
+# this target is a jump-off point for Win95
+# 1. it switches to the Win95-specific makefile if it exists
+# (__do_switch_makefiles)
+# 2. it prints a message when the Win95-specific one finishes (__done)
+# 3. it then kills this makefile by trying to make __no_such_target
+
+__switch_makefiles: __do_switch_makefiles __done __no_such_target
+
+__do_switch_makefiles:
+.IF "$(NOTFIRST)" != "true"
+ if exist $(MK2) $(MAKE:s/-S//) -f $(MK2) $(MAKETARGETS) NOTFIRST=true
.ELSE
-all : .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) \
- $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM)
+ $(NOOP)
.ENDIF
-$(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
+.IF "$(NOTFIRST)" != "true"
+__done:
+ @echo Build process complete. Ignore any errors after this message.
+ @echo Run "dmake test" to test and "dmake install" to install
-#------------------------------------------------------------
+.ELSE
+# dummy targets for Win95-specific makefile
+
+__done:
+ $(NOOP)
+
+__no_such_target:
+ $(NOOP)
-# This target is used to generate the makew95.mk for Win95
-.IF "$(IS_WIN95)" != ""
-$(MK2): makefile.mk
- $(MINIPERL) genmk95.pl makefile.mk $(MK2)
- $(MAKE) -f $(MK2) all2
.ENDIF
+# This target is used to generate the new makefile (.\makefile.95) for Win95
+
+.\makefile.95: .\makefile.mk
+ $(MINIPERL) genmk95.pl makefile.mk $(MK2)
+
+#--------------------- END Win95 SPECIFIC ---------------------
+
+# a blank target for when builds don't need to do certain things
+# this target added for Win95 port but used to keep the WinNT port able to
+# use this file
+__not_needed:
+ $(NOOP)
+
$(GLOBEXE) : perlglob$(o)
.IF "$(CCTYPE)" == "BORLAND"
$(CC) -c -w -v -tWM -I"$(CCINCDIR)" perlglob.c
- $(LINK32) -Tpe -ap $(LINK_FLAGS) c0x32$(o) perlglob$(o) \
+ $(LINK32) -Tpe -ap $(BLINK_FLAGS) c0x32$(o) perlglob$(o) \
"$(CCLIBDIR)\32BIT\wildargs$(o)",$@,,import32.lib cw32mt.lib,
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) $(LINK_FLAGS) -o $@ perlglob$(o) $(LIBFILES)
+ $(LINK32) $(BLINK_FLAGS) -mconsole -o $@ perlglob$(o) $(LIBFILES)
.ELSE
- $(LINK32) $(LINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \
+ $(LINK32) $(BLINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \
perlglob$(o) setargv$(o)
.ENDIF
@@ -825,13 +950,15 @@ config.w32 : $(CFGSH_TMPL)
copy $(CFGH_TMPL) config.h
..\config.sh : config.w32 $(MINIPERL) config_sh.PL
- $(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) config.w32 > ..\config.sh
+ $(MINIPERL) -I..\lib config_sh.PL --cfgsh-option-file \
+ $(mktmp $(CFG_VARS)) config.w32 > ..\config.sh
# this target is for when changes to the main config.sh happen
# edit config.{b,v,g}c and make this target once for each supported
# compiler (e.g. `dmake CCTYPE=BORLAND regen_config_h`)
regen_config_h:
- perl config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh
+ perl config_sh.PL --cfgsh-option-file $(mktmp $(CFG_VARS)) \
+ $(CFGSH_TMPL) > ..\config.sh
-cd .. && del /f perl.exe
cd .. && perl configpm
-del /f $(CFGH_TMPL)
@@ -849,27 +976,37 @@ $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl
$(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" \
|| $(MAKE) $(MAKEMACROS) $(CONFIGPM) $(MAKEFILE)
-$(MINIPERL) : $(MINIDIR) $(MINI_OBJ)
+$(MINIPERL) : $(MINIDIR) $(MINI_OBJ) $(CRTIPMLIBS)
.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpe -ap $(LINK_FLAGS) \
+ $(LINK32) -Tpe -ap $(BLINK_FLAGS) \
@$(mktmp c0x32$(o) $(MINI_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),)
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) -v -o $@ $(LINK_FLAGS) \
- $(mktmp $(LKPRE) $(MINI_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
+ $(LINK32) -v -mconsole -o $@ $(BLINK_FLAGS) \
+ $(mktmp $(LKPRE) $(MINI_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
.ELSE
$(LINK32) -subsystem:console -out:$@ \
- @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ:s,\,\\))
+ @$(mktmp $(BLINK_FLAGS) $(LIBFILES) $(MINI_OBJ:s,\,\\))
.ENDIF
$(MINIDIR) :
if not exist "$(MINIDIR)" mkdir "$(MINIDIR)"
$(MINICORE_OBJ) : $(CORE_NOCFG_H)
- $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*B).c
+ $(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB $(OBJOUT_FLAG)$@ ..\$(*B).c
$(MINIWIN32_OBJ) : $(CORE_NOCFG_H)
$(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*B).c
+# -DPERL_IMPLICIT_SYS needs C++ for perllib.c
+# rules wrapped in .IFs break Win9X build (we end up with unbalanced []s unless
+# unless the .IF is true), so instead we use a .ELSE with the default
+perllib$(o) : perllib.c
+.IF "$(USE_IMP_SYS)$(USE_OBJECT)" == "defineundef"
+ $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c
+.ELSE
+ $(CC) -c -I. $(CFLAGS_O) $(OBJOUT_FLAG)$@ perllib.c
+.ENDIF
+
# 1. we don't want to rebuild miniperl.exe when config.h changes
# 2. we don't want to rebuild miniperl.exe with non-default config.h
$(MINI_OBJ) : $(CORE_NOCFG_H)
@@ -881,31 +1018,31 @@ $(PERL95_OBJ) : $(CORE_H)
$(X2P_OBJ) : $(CORE_H)
perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl
- $(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \
- CCTYPE=$(CCTYPE) > perldll.def
+ $(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) \
+ $(BUILDOPT) CCTYPE=$(CCTYPE) > perldll.def
-$(PERLDLL): perldll.def $(PERLDLL_OBJ)
+$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES)
.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpd -ap $(LINK_FLAGS) \
+ $(LINK32) -Tpd -ap $(BLINK_FLAGS) \
@$(mktmp c0d32$(o) $(PERLDLL_OBJ:s,\,\\)\n \
$@,\n \
$(LIBFILES)\n \
perldll.def\n)
$(IMPLIB) $*.lib $@
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(LINK_FLAGS) \
+ $(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(BLINK_FLAGS) \
$(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
dlltool --output-lib $(PERLIMPLIB) \
- --dllname $(PERLDLL:b).dll \
- --def perldll.def \
- --base-file perl.base \
- --output-exp perl.exp
- $(LINK32) -mdll -o $@ $(LINK_FLAGS) \
+ --dllname $(PERLDLL:b).dll \
+ --def perldll.def \
+ --base-file perl.base \
+ --output-exp perl.exp
+ $(LINK32) -mdll -o $@ $(BLINK_FLAGS) \
$(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) \
perl.exp $(LKPOST))
.ELSE
$(LINK32) -dll -def:perldll.def -out:$@ \
- @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ:s,\,\\))
+ @$(mktmp $(BLINK_FLAGS) $(LIBFILES) $(PERLDLL_RES) $(PERLDLL_OBJ:s,\,\\))
.ENDIF
$(XCOPY) $(PERLIMPLIB) $(COREDIR)
@@ -931,14 +1068,14 @@ $(X2P) : $(MINIPERL) $(X2P_OBJ)
$(MINIPERL) ..\x2p\find2perl.PL
$(MINIPERL) ..\x2p\s2p.PL
.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpe -ap $(LINK_FLAGS) \
+ $(LINK32) -Tpe -ap $(BLINK_FLAGS) \
@$(mktmp c0x32$(o) $(X2P_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),)
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) -v -o $@ $(LINK_FLAGS) \
+ $(LINK32) -v -o $@ $(BLINK_FLAGS) \
$(mktmp $(LKPRE) $(X2P_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
.ELSE
$(LINK32) -subsystem:console -out:$@ \
- @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ:s,\,\\))
+ @$(mktmp $(BLINK_FLAGS) $(LIBFILES) $(X2P_OBJ:s,\,\\))
.ENDIF
perlmain.c : runperl.c
@@ -947,25 +1084,27 @@ perlmain.c : runperl.c
perlmain$(o) : perlmain.c
$(CC) $(CFLAGS_O) -UPERLDLL $(OBJOUT_FLAG)$@ -c perlmain.c
-$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ)
+$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) $(PERLEXE_RES)
.IF "$(CCTYPE)" == "BORLAND"
- $(LINK32) -Tpe -ap $(LINK_FLAGS) \
+ $(LINK32) -Tpe -ap $(BLINK_FLAGS) \
@$(mktmp c0x32$(o) $(PERLEXE_OBJ:s,\,\\)\n \
$(@:s,\,\\),\n \
$(PERLIMPLIB) $(LIBFILES)\n)
.ELIF "$(CCTYPE)" == "GCC"
- $(LINK32) -o $@ $(LINK_FLAGS) \
+ $(LINK32) -mconsole -o $@ $(BLINK_FLAGS) \
$(PERLEXE_OBJ) $(PERLIMPLIB) $(LIBFILES)
.ELSE
- $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \
- $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB)
+ $(LINK32) -subsystem:console -out:$@ $(BLINK_FLAGS) $(LIBFILES) \
+ $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) $(PERLEXE_RES)
+ copy $(PERLEXE) $(WPERLEXE)
+ editbin /subsystem:windows $(WPERLEXE)
.ENDIF
copy splittree.pl ..
$(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR)
.IF "$(CCTYPE)" != "BORLAND"
.IF "$(CCTYPE)" != "GCC"
-.IF "$(USE_PERLCRT)" == ""
+.IF "$(USE_PERLCRT)" != "define"
perl95.c : runperl.c
copy runperl.c perl95.c
@@ -986,7 +1125,7 @@ DynaLoadmt$(o) : $(DYNALOADER).c
$(OBJOUT_FLAG)DynaLoadmt$(o) $(DYNALOADER).c
$(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ)
- $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \
+ $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(BLINK_FLAGS) \
$(LIBBASEFILES) $(PERL95_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) \
libcmt.lib
@@ -997,7 +1136,9 @@ $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ)
$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
if not exist $(AUTODIR) mkdir $(AUTODIR)
cd $(EXTDIR)\$(*B) && ..\$(MINIPERL) -I..\..\lib $(*B)_pm.PL
+ cd $(EXTDIR)\$(*B) && ..\$(MINIPERL) -I..\..\lib XSLoader_pm.PL
$(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
+ $(XCOPY) $(EXTDIR)\$(*B)\XSLoader.pm $(LIBDIR)\$(NULL)
cd $(EXTDIR)\$(*B) && $(XSUBPP) dl_win32.xs > $(*B).c
$(XCOPY) $(EXTDIR)\$(*B)\dlutils.c .
@@ -1103,6 +1244,7 @@ distclean: clean
-del /f $(EXTENSION_C) $(DYNALOADER).c $(ERRNO).pm
-del /f $(EXTDIR)\DynaLoader\dl_win32.xs
-del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm
+ -del /f $(LIBDIR)\XSLoader.pm
-del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm
-del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm
-del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm
@@ -1117,7 +1259,7 @@ distclean: clean
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc \
- dprofpp pstruct *.bat
+ dprofpp *.bat
-cd ..\x2p && del /f find2perl s2p *.bat
-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
-del /f $(CONFIGPM)
@@ -1132,11 +1274,12 @@ distclean: clean
install : all installbare installhtml
-installbare : utils
+installbare : $(RIGHTMAKE) utils
$(PERLEXE) ..\installperl
.IF "$(PERL95EXE)" != ""
$(XCOPY) $(PERL95EXE) $(INST_BIN)\*.*
.ENDIF
+ if exist $(WPERLEXE) $(XCOPY) $(WPERLEXE) $(INST_BIN)\*.*
$(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
$(XCOPY) bin\*.bat $(INST_SCRIPT)\*.*
@@ -1169,7 +1312,7 @@ test-prep : all utils
$(XCOPY) $(GLOBEXE) ..\t\$(NULL)
.ENDIF
-test : test-prep
+test : $(RIGHTMAKE) test-prep
cd ..\t && $(PERLEXE) -I..\lib harness
test-notty : test-prep
@@ -1185,6 +1328,7 @@ clean :
-@erase /f config.h
-@erase $(GLOBEXE)
-@erase $(PERLEXE)
+ -@erase $(WPERLEXE)
-@erase $(PERLDLL)
-@erase $(CORE_OBJ)
-rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR)
diff --git a/win32/perlhost.h b/win32/perlhost.h
new file mode 100644
index 0000000000..93cb4580b0
--- /dev/null
+++ b/win32/perlhost.h
@@ -0,0 +1,2307 @@
+/* perlhost.h
+ *
+ * (c) 1999 Microsoft Corporation. All rights reserved.
+ * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ */
+
+#ifndef ___PerlHost_H___
+#define ___PerlHost_H___
+
+#include "iperlsys.h"
+#include "vmem.h"
+#include "vdir.h"
+
+#if !defined(PERL_OBJECT)
+START_EXTERN_C
+#endif
+extern char * g_win32_get_privlib(char *pl);
+extern char * g_win32_get_sitelib(char *pl);
+extern char * g_getlogin(void);
+extern int do_spawn2(char *cmd, int exectype);
+#if !defined(PERL_OBJECT)
+END_EXTERN_C
+#endif
+
+#ifdef PERL_OBJECT
+extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
+#define do_aspawn g_do_aspawn
+#endif
+
+class CPerlHost
+{
+public:
+ CPerlHost(void);
+ CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
+ struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
+ struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
+ struct IPerlDir** ppDir, struct IPerlSock** ppSock,
+ struct IPerlProc** ppProc);
+ CPerlHost(CPerlHost& host);
+ ~CPerlHost(void);
+
+ static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
+ static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
+ static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
+ static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
+ static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
+ static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
+ static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
+ static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
+ static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
+
+ BOOL PerlCreate(void);
+ int PerlParse(int argc, char** argv, char** env);
+ int PerlRun(void);
+ void PerlDestroy(void);
+
+/* IPerlMem */
+ inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
+ inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
+ inline void Free(void* ptr) { m_pVMem->Free(ptr); };
+ inline void* Calloc(size_t num, size_t size)
+ {
+ size_t count = num*size;
+ void* lpVoid = Malloc(count);
+ if (lpVoid)
+ ZeroMemory(lpVoid, count);
+ return lpVoid;
+ };
+ inline void GetLock(void) { m_pVMem->GetLock(); };
+ inline void FreeLock(void) { m_pVMem->FreeLock(); };
+ inline int IsLocked(void) { return m_pVMem->IsLocked(); };
+
+/* IPerlMemShared */
+ inline void* MallocShared(size_t size)
+ {
+ return m_pVMemShared->Malloc(size);
+ };
+ inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
+ inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
+ inline void* CallocShared(size_t num, size_t size)
+ {
+ size_t count = num*size;
+ void* lpVoid = MallocShared(count);
+ if (lpVoid)
+ ZeroMemory(lpVoid, count);
+ return lpVoid;
+ };
+ inline void GetLockShared(void) { m_pVMem->GetLock(); };
+ inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
+ inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
+
+/* IPerlMemParse */
+ inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
+ inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
+ inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
+ inline void* CallocParse(size_t num, size_t size)
+ {
+ size_t count = num*size;
+ void* lpVoid = MallocParse(count);
+ if (lpVoid)
+ ZeroMemory(lpVoid, count);
+ return lpVoid;
+ };
+ inline void GetLockParse(void) { m_pVMem->GetLock(); };
+ inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
+ inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
+
+/* IPerlEnv */
+ char *Getenv(const char *varname);
+ int Putenv(const char *envstring);
+ inline char *Getenv(const char *varname, unsigned long *len)
+ {
+ *len = 0;
+ char *e = Getenv(varname);
+ if (e)
+ *len = strlen(e);
+ return e;
+ }
+ void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
+ void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
+ char* GetChildDir(void);
+ void FreeChildDir(char* pStr);
+ void Reset(void);
+ void Clearenv(void);
+
+ inline LPSTR GetIndex(DWORD &dwIndex)
+ {
+ if(dwIndex < m_dwEnvCount)
+ {
+ ++dwIndex;
+ return m_lppEnvList[dwIndex-1];
+ }
+ return NULL;
+ };
+
+protected:
+ LPSTR Find(LPCSTR lpStr);
+ void Add(LPCSTR lpStr);
+
+ LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
+ void FreeLocalEnvironmentStrings(LPSTR lpStr);
+ LPSTR* Lookup(LPCSTR lpStr);
+ DWORD CalculateEnvironmentSpace(void);
+
+public:
+
+/* IPerlDIR */
+ virtual int Chdir(const char *dirname);
+
+/* IPerllProc */
+ void Abort(void);
+ void Exit(int status);
+ void _Exit(int status);
+ int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
+ int Execv(const char *cmdname, const char *const *argv);
+ int Execvp(const char *cmdname, const char *const *argv);
+
+ inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
+ inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
+ inline VDir* GetDir(void) { return m_pvDir; };
+
+public:
+
+ struct IPerlMem m_hostperlMem;
+ struct IPerlMem m_hostperlMemShared;
+ struct IPerlMem m_hostperlMemParse;
+ struct IPerlEnv m_hostperlEnv;
+ struct IPerlStdIO m_hostperlStdIO;
+ struct IPerlLIO m_hostperlLIO;
+ struct IPerlDir m_hostperlDir;
+ struct IPerlSock m_hostperlSock;
+ struct IPerlProc m_hostperlProc;
+
+ struct IPerlMem* m_pHostperlMem;
+ struct IPerlMem* m_pHostperlMemShared;
+ struct IPerlMem* m_pHostperlMemParse;
+ struct IPerlEnv* m_pHostperlEnv;
+ struct IPerlStdIO* m_pHostperlStdIO;
+ struct IPerlLIO* m_pHostperlLIO;
+ struct IPerlDir* m_pHostperlDir;
+ struct IPerlSock* m_pHostperlSock;
+ struct IPerlProc* m_pHostperlProc;
+
+ inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
+ inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
+protected:
+
+ VDir* m_pvDir;
+ VMem* m_pVMem;
+ VMem* m_pVMemShared;
+ VMem* m_pVMemParse;
+
+ DWORD m_dwEnvCount;
+ LPSTR* m_lppEnvList;
+};
+
+
+#define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
+
+inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlMem);
+}
+
+inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlMemShared);
+}
+
+inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlMemParse);
+}
+
+inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlEnv);
+}
+
+inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlStdIO);
+}
+
+inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlLIO);
+}
+
+inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlDir);
+}
+
+inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlSock);
+}
+
+inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
+{
+ return STRUCT2PTR(piPerl, m_hostperlProc);
+}
+
+
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlMem2Host(x)
+
+/* IPerlMem */
+void*
+PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
+{
+ return IPERL2HOST(piPerl)->Malloc(size);
+}
+void*
+PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
+{
+ return IPERL2HOST(piPerl)->Realloc(ptr, size);
+}
+void
+PerlMemFree(struct IPerlMem* piPerl, void* ptr)
+{
+ IPERL2HOST(piPerl)->Free(ptr);
+}
+void*
+PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
+{
+ return IPERL2HOST(piPerl)->Calloc(num, size);
+}
+
+void
+PerlMemGetLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->GetLock();
+}
+
+void
+PerlMemFreeLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->FreeLock();
+}
+
+int
+PerlMemIsLocked(struct IPerlMem* piPerl)
+{
+ return IPERL2HOST(piPerl)->IsLocked();
+}
+
+struct IPerlMem perlMem =
+{
+ PerlMemMalloc,
+ PerlMemRealloc,
+ PerlMemFree,
+ PerlMemCalloc,
+ PerlMemGetLock,
+ PerlMemFreeLock,
+ PerlMemIsLocked,
+};
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlMemShared2Host(x)
+
+/* IPerlMemShared */
+void*
+PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
+{
+ return IPERL2HOST(piPerl)->MallocShared(size);
+}
+void*
+PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
+{
+ return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
+}
+void
+PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
+{
+ IPERL2HOST(piPerl)->FreeShared(ptr);
+}
+void*
+PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
+{
+ return IPERL2HOST(piPerl)->CallocShared(num, size);
+}
+
+void
+PerlMemSharedGetLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->GetLockShared();
+}
+
+void
+PerlMemSharedFreeLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->FreeLockShared();
+}
+
+int
+PerlMemSharedIsLocked(struct IPerlMem* piPerl)
+{
+ return IPERL2HOST(piPerl)->IsLockedShared();
+}
+
+struct IPerlMem perlMemShared =
+{
+ PerlMemSharedMalloc,
+ PerlMemSharedRealloc,
+ PerlMemSharedFree,
+ PerlMemSharedCalloc,
+ PerlMemSharedGetLock,
+ PerlMemSharedFreeLock,
+ PerlMemSharedIsLocked,
+};
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlMemParse2Host(x)
+
+/* IPerlMemParse */
+void*
+PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
+{
+ return IPERL2HOST(piPerl)->MallocParse(size);
+}
+void*
+PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
+{
+ return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
+}
+void
+PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
+{
+ IPERL2HOST(piPerl)->FreeParse(ptr);
+}
+void*
+PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
+{
+ return IPERL2HOST(piPerl)->CallocParse(num, size);
+}
+
+void
+PerlMemParseGetLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->GetLockParse();
+}
+
+void
+PerlMemParseFreeLock(struct IPerlMem* piPerl)
+{
+ IPERL2HOST(piPerl)->FreeLockParse();
+}
+
+int
+PerlMemParseIsLocked(struct IPerlMem* piPerl)
+{
+ return IPERL2HOST(piPerl)->IsLockedParse();
+}
+
+struct IPerlMem perlMemParse =
+{
+ PerlMemParseMalloc,
+ PerlMemParseRealloc,
+ PerlMemParseFree,
+ PerlMemParseCalloc,
+ PerlMemParseGetLock,
+ PerlMemParseFreeLock,
+ PerlMemParseIsLocked,
+};
+
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlEnv2Host(x)
+
+/* IPerlEnv */
+char*
+PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
+{
+ return IPERL2HOST(piPerl)->Getenv(varname);
+};
+
+int
+PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
+{
+ return IPERL2HOST(piPerl)->Putenv(envstring);
+};
+
+char*
+PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
+{
+ return IPERL2HOST(piPerl)->Getenv(varname, len);
+}
+
+int
+PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
+{
+ return win32_uname(name);
+}
+
+void
+PerlEnvClearenv(struct IPerlEnv* piPerl)
+{
+ IPERL2HOST(piPerl)->Clearenv();
+}
+
+void*
+PerlEnvGetChildenv(struct IPerlEnv* piPerl)
+{
+ return IPERL2HOST(piPerl)->CreateChildEnv();
+}
+
+void
+PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
+{
+ IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
+}
+
+char*
+PerlEnvGetChilddir(struct IPerlEnv* piPerl)
+{
+ return IPERL2HOST(piPerl)->GetChildDir();
+}
+
+void
+PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
+{
+ IPERL2HOST(piPerl)->FreeChildDir(childDir);
+}
+
+unsigned long
+PerlEnvOsId(struct IPerlEnv* piPerl)
+{
+ return win32_os_id();
+}
+
+char*
+PerlEnvLibPath(struct IPerlEnv* piPerl, char *pl)
+{
+ return g_win32_get_privlib(pl);
+}
+
+char*
+PerlEnvSiteLibPath(struct IPerlEnv* piPerl, char *pl)
+{
+ return g_win32_get_sitelib(pl);
+}
+
+struct IPerlEnv perlEnv =
+{
+ PerlEnvGetenv,
+ PerlEnvPutenv,
+ PerlEnvGetenv_len,
+ PerlEnvUname,
+ PerlEnvClearenv,
+ PerlEnvGetChildenv,
+ PerlEnvFreeChildenv,
+ PerlEnvGetChilddir,
+ PerlEnvFreeChilddir,
+ PerlEnvOsId,
+ PerlEnvLibPath,
+ PerlEnvSiteLibPath,
+};
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlStdIO2Host(x)
+
+/* PerlStdIO */
+PerlIO*
+PerlStdIOStdin(struct IPerlStdIO* piPerl)
+{
+ return (PerlIO*)win32_stdin();
+}
+
+PerlIO*
+PerlStdIOStdout(struct IPerlStdIO* piPerl)
+{
+ return (PerlIO*)win32_stdout();
+}
+
+PerlIO*
+PerlStdIOStderr(struct IPerlStdIO* piPerl)
+{
+ return (PerlIO*)win32_stderr();
+}
+
+PerlIO*
+PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
+{
+ return (PerlIO*)win32_fopen(path, mode);
+}
+
+int
+PerlStdIOClose(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_fclose(((FILE*)pf));
+}
+
+int
+PerlStdIOEof(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_feof((FILE*)pf);
+}
+
+int
+PerlStdIOError(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_ferror((FILE*)pf);
+}
+
+void
+PerlStdIOClearerr(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ win32_clearerr((FILE*)pf);
+}
+
+int
+PerlStdIOGetc(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_getc((FILE*)pf);
+}
+
+char*
+PerlStdIOGetBase(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+#ifdef FILE_base
+ FILE *f = (FILE*)pf;
+ return FILE_base(f);
+#else
+ return Nullch;
+#endif
+}
+
+int
+PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+#ifdef FILE_bufsiz
+ FILE *f = (FILE*)pf;
+ return FILE_bufsiz(f);
+#else
+ return (-1);
+#endif
+}
+
+int
+PerlStdIOGetCnt(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+#ifdef USE_STDIO_PTR
+ FILE *f = (FILE*)pf;
+ return FILE_cnt(f);
+#else
+ return (-1);
+#endif
+}
+
+char*
+PerlStdIOGetPtr(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+#ifdef USE_STDIO_PTR
+ FILE *f = (FILE*)pf;
+ return FILE_ptr(f);
+#else
+ return Nullch;
+#endif
+}
+
+char*
+PerlStdIOGets(struct IPerlStdIO* piPerl, PerlIO* pf, char* s, int n)
+{
+ return win32_fgets(s, n, (FILE*)pf);
+}
+
+int
+PerlStdIOPutc(struct IPerlStdIO* piPerl, PerlIO* pf, int c)
+{
+ return win32_fputc(c, (FILE*)pf);
+}
+
+int
+PerlStdIOPuts(struct IPerlStdIO* piPerl, PerlIO* pf, const char *s)
+{
+ return win32_fputs(s, (FILE*)pf);
+}
+
+int
+PerlStdIOFlush(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_fflush((FILE*)pf);
+}
+
+int
+PerlStdIOUngetc(struct IPerlStdIO* piPerl, PerlIO* pf,int c)
+{
+ return win32_ungetc(c, (FILE*)pf);
+}
+
+int
+PerlStdIOFileno(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_fileno((FILE*)pf);
+}
+
+PerlIO*
+PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
+{
+ return (PerlIO*)win32_fdopen(fd, mode);
+}
+
+PerlIO*
+PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, PerlIO* pf)
+{
+ return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
+}
+
+SSize_t
+PerlStdIORead(struct IPerlStdIO* piPerl, PerlIO* pf, void *buffer, Size_t size)
+{
+ return win32_fread(buffer, 1, size, (FILE*)pf);
+}
+
+SSize_t
+PerlStdIOWrite(struct IPerlStdIO* piPerl, PerlIO* pf, const void *buffer, Size_t size)
+{
+ return win32_fwrite(buffer, 1, size, (FILE*)pf);
+}
+
+void
+PerlStdIOSetBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer)
+{
+ win32_setbuf((FILE*)pf, buffer);
+}
+
+int
+PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer, int type, Size_t size)
+{
+ return win32_setvbuf((FILE*)pf, buffer, type, size);
+}
+
+void
+PerlStdIOSetCnt(struct IPerlStdIO* piPerl, PerlIO* pf, int n)
+{
+#ifdef STDIO_CNT_LVALUE
+ FILE *f = (FILE*)pf;
+ FILE_cnt(f) = n;
+#endif
+}
+
+void
+PerlStdIOSetPtrCnt(struct IPerlStdIO* piPerl, PerlIO* pf, char * ptr, int n)
+{
+#ifdef STDIO_PTR_LVALUE
+ FILE *f = (FILE*)pf;
+ FILE_ptr(f) = ptr;
+ FILE_cnt(f) = n;
+#endif
+}
+
+void
+PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
+}
+
+int
+PerlStdIOPrintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format,...)
+{
+ va_list(arglist);
+ va_start(arglist, format);
+ return win32_vfprintf((FILE*)pf, format, arglist);
+}
+
+int
+PerlStdIOVprintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format, va_list arglist)
+{
+ return win32_vfprintf((FILE*)pf, format, arglist);
+}
+
+long
+PerlStdIOTell(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ return win32_ftell((FILE*)pf);
+}
+
+int
+PerlStdIOSeek(struct IPerlStdIO* piPerl, PerlIO* pf, off_t offset, int origin)
+{
+ return win32_fseek((FILE*)pf, offset, origin);
+}
+
+void
+PerlStdIORewind(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ win32_rewind((FILE*)pf);
+}
+
+PerlIO*
+PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
+{
+ return (PerlIO*)win32_tmpfile();
+}
+
+int
+PerlStdIOGetpos(struct IPerlStdIO* piPerl, PerlIO* pf, Fpos_t *p)
+{
+ return win32_fgetpos((FILE*)pf, p);
+}
+
+int
+PerlStdIOSetpos(struct IPerlStdIO* piPerl, PerlIO* pf, const Fpos_t *p)
+{
+ return win32_fsetpos((FILE*)pf, p);
+}
+void
+PerlStdIOInit(struct IPerlStdIO* piPerl)
+{
+}
+
+void
+PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
+{
+ Perl_init_os_extras();
+}
+
+int
+PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
+{
+ return win32_open_osfhandle(osfhandle, flags);
+}
+
+int
+PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
+{
+ return win32_get_osfhandle(filenum);
+}
+
+PerlIO*
+PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf)
+{
+ PerlIO* pfdup;
+ fpos_t pos;
+ char mode[3];
+ int fileno = win32_dup(win32_fileno((FILE*)pf));
+
+ /* open the file in the same mode */
+#ifdef __BORLANDC__
+ if(((FILE*)pf)->flags & _F_READ) {
+ mode[0] = 'r';
+ mode[1] = 0;
+ }
+ else if(((FILE*)pf)->flags & _F_WRIT) {
+ mode[0] = 'a';
+ mode[1] = 0;
+ }
+ else if(((FILE*)pf)->flags & _F_RDWR) {
+ mode[0] = 'r';
+ mode[1] = '+';
+ mode[2] = 0;
+ }
+#else
+ if(((FILE*)pf)->_flag & _IOREAD) {
+ mode[0] = 'r';
+ mode[1] = 0;
+ }
+ else if(((FILE*)pf)->_flag & _IOWRT) {
+ mode[0] = 'a';
+ mode[1] = 0;
+ }
+ else if(((FILE*)pf)->_flag & _IORW) {
+ mode[0] = 'r';
+ mode[1] = '+';
+ mode[2] = 0;
+ }
+#endif
+
+ /* it appears that the binmode is attached to the
+ * file descriptor so binmode files will be handled
+ * correctly
+ */
+ pfdup = (PerlIO*)win32_fdopen(fileno, mode);
+
+ /* move the file pointer to the same position */
+ if (!fgetpos((FILE*)pf, &pos)) {
+ fsetpos((FILE*)pfdup, &pos);
+ }
+ return pfdup;
+}
+
+struct IPerlStdIO perlStdIO =
+{
+ PerlStdIOStdin,
+ PerlStdIOStdout,
+ PerlStdIOStderr,
+ PerlStdIOOpen,
+ PerlStdIOClose,
+ PerlStdIOEof,
+ PerlStdIOError,
+ PerlStdIOClearerr,
+ PerlStdIOGetc,
+ PerlStdIOGetBase,
+ PerlStdIOGetBufsiz,
+ PerlStdIOGetCnt,
+ PerlStdIOGetPtr,
+ PerlStdIOGets,
+ PerlStdIOPutc,
+ PerlStdIOPuts,
+ PerlStdIOFlush,
+ PerlStdIOUngetc,
+ PerlStdIOFileno,
+ PerlStdIOFdopen,
+ PerlStdIOReopen,
+ PerlStdIORead,
+ PerlStdIOWrite,
+ PerlStdIOSetBuf,
+ PerlStdIOSetVBuf,
+ PerlStdIOSetCnt,
+ PerlStdIOSetPtrCnt,
+ PerlStdIOSetlinebuf,
+ PerlStdIOPrintf,
+ PerlStdIOVprintf,
+ PerlStdIOTell,
+ PerlStdIOSeek,
+ PerlStdIORewind,
+ PerlStdIOTmpfile,
+ PerlStdIOGetpos,
+ PerlStdIOSetpos,
+ PerlStdIOInit,
+ PerlStdIOInitOSExtras,
+ PerlStdIOFdupopen,
+};
+
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlLIO2Host(x)
+
+/* IPerlLIO */
+int
+PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
+{
+ return win32_access(path, mode);
+}
+
+int
+PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
+{
+ return win32_chmod(filename, pmode);
+}
+
+int
+PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
+{
+ return chown(filename, owner, group);
+}
+
+int
+PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
+{
+ return chsize(handle, size);
+}
+
+int
+PerlLIOClose(struct IPerlLIO* piPerl, int handle)
+{
+ return win32_close(handle);
+}
+
+int
+PerlLIODup(struct IPerlLIO* piPerl, int handle)
+{
+ return win32_dup(handle);
+}
+
+int
+PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
+{
+ return win32_dup2(handle1, handle2);
+}
+
+int
+PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
+{
+ return win32_flock(fd, oper);
+}
+
+int
+PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
+{
+ return fstat(handle, buffer);
+}
+
+int
+PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
+{
+ return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
+}
+
+int
+PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
+{
+ return isatty(fd);
+}
+
+int
+PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
+{
+ return win32_link(oldname, newname);
+}
+
+long
+PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
+{
+ return win32_lseek(handle, offset, origin);
+}
+
+int
+PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
+{
+ return win32_stat(path, buffer);
+}
+
+char*
+PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
+{
+ return mktemp(Template);
+}
+
+int
+PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
+{
+ return win32_open(filename, oflag);
+}
+
+int
+PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
+{
+ return win32_open(filename, oflag, pmode);
+}
+
+int
+PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
+{
+ return win32_read(handle, buffer, count);
+}
+
+int
+PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
+{
+ return win32_rename(OldFileName, newname);
+}
+
+int
+PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
+{
+ return win32_setmode(handle, mode);
+}
+
+int
+PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
+{
+ return win32_stat(path, buffer);
+}
+
+char*
+PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
+{
+ return tmpnam(string);
+}
+
+int
+PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
+{
+ return umask(pmode);
+}
+
+int
+PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
+{
+ return win32_unlink(filename);
+}
+
+int
+PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
+{
+ return win32_utime(filename, times);
+}
+
+int
+PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
+{
+ return win32_write(handle, buffer, count);
+}
+
+struct IPerlLIO perlLIO =
+{
+ PerlLIOAccess,
+ PerlLIOChmod,
+ PerlLIOChown,
+ PerlLIOChsize,
+ PerlLIOClose,
+ PerlLIODup,
+ PerlLIODup2,
+ PerlLIOFlock,
+ PerlLIOFileStat,
+ PerlLIOIOCtl,
+ PerlLIOIsatty,
+ PerlLIOLink,
+ PerlLIOLseek,
+ PerlLIOLstat,
+ PerlLIOMktemp,
+ PerlLIOOpen,
+ PerlLIOOpen3,
+ PerlLIORead,
+ PerlLIORename,
+ PerlLIOSetmode,
+ PerlLIONameStat,
+ PerlLIOTmpnam,
+ PerlLIOUmask,
+ PerlLIOUnlink,
+ PerlLIOUtime,
+ PerlLIOWrite,
+};
+
+
+#undef IPERL2HOST
+#define IPERL2HOST(x) IPerlDir2Host(x)
+
+/* IPerlDIR */
+int
+PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
+{
+ return win32_mkdir(dirname, mode);
+}
+
+int
+PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
+{
+ return IPERL2HOST(piPerl)->Chdir(dirname);
+}
+
+int
+PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
+{
+ return win32_rmdir(dirname);
+}
+
+int
+PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
+{
+ return win32_closedir(dirp);
+}
+
+DIR*
+PerlDirOpen(struct IPerlDir* piPerl, char *filename)
+{
+ return win32_opendir(filename);
+}
+
+struct direct *
+PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
+{
+ return win32_readdir(dirp);
+}
+
+void
+PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
+{
+ win32_rewinddir(dirp);
+}
+
+void
+PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
+{
+ win32_seekdir(dirp, loc);
+}
+
+long
+PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
+{
+ return win32_telldir(dirp);
+}
+
+char*
+PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
+{
+ return IPERL2HOST(piPerl)->MapPathA(path);
+}
+
+WCHAR*
+PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
+{
+ return IPERL2HOST(piPerl)->MapPathW(path);
+}
+
+struct IPerlDir perlDir =
+{
+ PerlDirMakedir,
+ PerlDirChdir,
+ PerlDirRmdir,
+ PerlDirClose,
+ PerlDirOpen,
+ PerlDirRead,
+ PerlDirRewind,
+ PerlDirSeek,
+ PerlDirTell,
+ PerlDirMapPathA,
+ PerlDirMapPathW,
+};
+
+
+/* IPerlSock */
+u_long
+PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
+{
+ return win32_htonl(hostlong);
+}
+
+u_short
+PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
+{
+ return win32_htons(hostshort);
+}
+
+u_long
+PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
+{
+ return win32_ntohl(netlong);
+}
+
+u_short
+PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
+{
+ return win32_ntohs(netshort);
+}
+
+SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
+{
+ return win32_accept(s, addr, addrlen);
+}
+
+int
+PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
+{
+ return win32_bind(s, name, namelen);
+}
+
+int
+PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
+{
+ return win32_connect(s, name, namelen);
+}
+
+void
+PerlSockEndhostent(struct IPerlSock* piPerl)
+{
+ win32_endhostent();
+}
+
+void
+PerlSockEndnetent(struct IPerlSock* piPerl)
+{
+ win32_endnetent();
+}
+
+void
+PerlSockEndprotoent(struct IPerlSock* piPerl)
+{
+ win32_endprotoent();
+}
+
+void
+PerlSockEndservent(struct IPerlSock* piPerl)
+{
+ win32_endservent();
+}
+
+struct hostent*
+PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
+{
+ return win32_gethostbyaddr(addr, len, type);
+}
+
+struct hostent*
+PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
+{
+ return win32_gethostbyname(name);
+}
+
+struct hostent*
+PerlSockGethostent(struct IPerlSock* piPerl)
+{
+ dTHXo;
+ Perl_croak(aTHX_ "gethostent not implemented!\n");
+ return NULL;
+}
+
+int
+PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
+{
+ return win32_gethostname(name, namelen);
+}
+
+struct netent *
+PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
+{
+ return win32_getnetbyaddr(net, type);
+}
+
+struct netent *
+PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
+{
+ return win32_getnetbyname((char*)name);
+}
+
+struct netent *
+PerlSockGetnetent(struct IPerlSock* piPerl)
+{
+ return win32_getnetent();
+}
+
+int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
+{
+ return win32_getpeername(s, name, namelen);
+}
+
+struct protoent*
+PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
+{
+ return win32_getprotobyname(name);
+}
+
+struct protoent*
+PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
+{
+ return win32_getprotobynumber(number);
+}
+
+struct protoent*
+PerlSockGetprotoent(struct IPerlSock* piPerl)
+{
+ return win32_getprotoent();
+}
+
+struct servent*
+PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
+{
+ return win32_getservbyname(name, proto);
+}
+
+struct servent*
+PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
+{
+ return win32_getservbyport(port, proto);
+}
+
+struct servent*
+PerlSockGetservent(struct IPerlSock* piPerl)
+{
+ return win32_getservent();
+}
+
+int
+PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
+{
+ return win32_getsockname(s, name, namelen);
+}
+
+int
+PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
+{
+ return win32_getsockopt(s, level, optname, optval, optlen);
+}
+
+unsigned long
+PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
+{
+ return win32_inet_addr(cp);
+}
+
+char*
+PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
+{
+ return win32_inet_ntoa(in);
+}
+
+int
+PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
+{
+ return win32_listen(s, backlog);
+}
+
+int
+PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
+{
+ return win32_recv(s, buffer, len, flags);
+}
+
+int
+PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
+{
+ return win32_recvfrom(s, buffer, len, flags, from, fromlen);
+}
+
+int
+PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
+{
+ return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
+}
+
+int
+PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
+{
+ return win32_send(s, buffer, len, flags);
+}
+
+int
+PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
+{
+ return win32_sendto(s, buffer, len, flags, to, tolen);
+}
+
+void
+PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
+{
+ win32_sethostent(stayopen);
+}
+
+void
+PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
+{
+ win32_setnetent(stayopen);
+}
+
+void
+PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
+{
+ win32_setprotoent(stayopen);
+}
+
+void
+PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
+{
+ win32_setservent(stayopen);
+}
+
+int
+PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
+{
+ return win32_setsockopt(s, level, optname, optval, optlen);
+}
+
+int
+PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
+{
+ return win32_shutdown(s, how);
+}
+
+SOCKET
+PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
+{
+ return win32_socket(af, type, protocol);
+}
+
+int
+PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
+{
+ dTHXo;
+ Perl_croak(aTHX_ "socketpair not implemented!\n");
+ return 0;
+}
+
+int
+PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
+{
+ return win32_closesocket(s);
+}
+
+int
+PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
+{
+ return win32_ioctlsocket(s, cmd, argp);
+}
+
+struct IPerlSock perlSock =
+{
+ PerlSockHtonl,
+ PerlSockHtons,
+ PerlSockNtohl,
+ PerlSockNtohs,
+ PerlSockAccept,
+ PerlSockBind,
+ PerlSockConnect,
+ PerlSockEndhostent,
+ PerlSockEndnetent,
+ PerlSockEndprotoent,
+ PerlSockEndservent,
+ PerlSockGethostname,
+ PerlSockGetpeername,
+ PerlSockGethostbyaddr,
+ PerlSockGethostbyname,
+ PerlSockGethostent,
+ PerlSockGetnetbyaddr,
+ PerlSockGetnetbyname,
+ PerlSockGetnetent,
+ PerlSockGetprotobyname,
+ PerlSockGetprotobynumber,
+ PerlSockGetprotoent,
+ PerlSockGetservbyname,
+ PerlSockGetservbyport,
+ PerlSockGetservent,
+ PerlSockGetsockname,
+ PerlSockGetsockopt,
+ PerlSockInetAddr,
+ PerlSockInetNtoa,
+ PerlSockListen,
+ PerlSockRecv,
+ PerlSockRecvfrom,
+ PerlSockSelect,
+ PerlSockSend,
+ PerlSockSendto,
+ PerlSockSethostent,
+ PerlSockSetnetent,
+ PerlSockSetprotoent,
+ PerlSockSetservent,
+ PerlSockSetsockopt,
+ PerlSockShutdown,
+ PerlSockSocket,
+ PerlSockSocketpair,
+ PerlSockClosesocket,
+};
+
+
+/* IPerlProc */
+
+#define EXECF_EXEC 1
+#define EXECF_SPAWN 2
+
+void
+PerlProcAbort(struct IPerlProc* piPerl)
+{
+ win32_abort();
+}
+
+char *
+PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
+{
+ return win32_crypt(clear, salt);
+}
+
+void
+PerlProcExit(struct IPerlProc* piPerl, int status)
+{
+ exit(status);
+}
+
+void
+PerlProc_Exit(struct IPerlProc* piPerl, int status)
+{
+ _exit(status);
+}
+
+int
+PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
+{
+ return execl(cmdname, arg0, arg1, arg2, arg3);
+}
+
+int
+PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
+{
+ return win32_execvp(cmdname, argv);
+}
+
+int
+PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
+{
+ return win32_execvp(cmdname, argv);
+}
+
+uid_t
+PerlProcGetuid(struct IPerlProc* piPerl)
+{
+ return getuid();
+}
+
+uid_t
+PerlProcGeteuid(struct IPerlProc* piPerl)
+{
+ return geteuid();
+}
+
+gid_t
+PerlProcGetgid(struct IPerlProc* piPerl)
+{
+ return getgid();
+}
+
+gid_t
+PerlProcGetegid(struct IPerlProc* piPerl)
+{
+ return getegid();
+}
+
+char *
+PerlProcGetlogin(struct IPerlProc* piPerl)
+{
+ return g_getlogin();
+}
+
+int
+PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
+{
+ return win32_kill(pid, sig);
+}
+
+int
+PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
+{
+ dTHXo;
+ Perl_croak(aTHX_ "killpg not implemented!\n");
+ return 0;
+}
+
+int
+PerlProcPauseProc(struct IPerlProc* piPerl)
+{
+ return win32_sleep((32767L << 16) + 32767);
+}
+
+PerlIO*
+PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
+{
+ dTHXo;
+ PERL_FLUSHALL_FOR_CHILD;
+ return (PerlIO*)win32_popen(command, mode);
+}
+
+int
+PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
+{
+ return win32_pclose((FILE*)stream);
+}
+
+int
+PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
+{
+ return win32_pipe(phandles, 512, O_BINARY);
+}
+
+int
+PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
+{
+ return setuid(u);
+}
+
+int
+PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
+{
+ return setgid(g);
+}
+
+int
+PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
+{
+ return win32_sleep(s);
+}
+
+int
+PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
+{
+ return win32_times(timebuf);
+}
+
+int
+PerlProcWait(struct IPerlProc* piPerl, int *status)
+{
+ return win32_wait(status);
+}
+
+int
+PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
+{
+ return win32_waitpid(pid, status, flags);
+}
+
+Sighandler_t
+PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
+{
+ return 0;
+}
+
+#ifdef USE_ITHREADS
+static DWORD WINAPI
+win32_start_child(LPVOID arg)
+{
+ PerlInterpreter *my_perl = (PerlInterpreter*)arg;
+ GV *tmpgv;
+ int status;
+#ifdef PERL_OBJECT
+ CPerlObj *pPerl = (CPerlObj*)my_perl;
+#endif
+#ifdef PERL_SYNC_FORK
+ static long sync_fork_id = 0;
+ long id = ++sync_fork_id;
+#endif
+
+
+ PERL_SET_INTERP(my_perl);
+
+ /* set $$ to pseudo id */
+#ifdef PERL_SYNC_FORK
+ w32_pseudo_id = id;
+#else
+ w32_pseudo_id = GetCurrentThreadId();
+#endif
+ if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
+ sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
+ hv_clear(PL_pidstatus);
+
+ /* push a zero on the stack (we are the child) */
+ {
+ djSP;
+ dTARGET;
+ PUSHi(0);
+ PUTBACK;
+ }
+
+ /* continue from next op */
+ PL_op = PL_op->op_next;
+
+ {
+ dJMPENV;
+ volatile int oldscope = PL_scopestack_ix;
+
+restart:
+ JMPENV_PUSH(status);
+ switch (status) {
+ case 0:
+ CALLRUNOPS(aTHX);
+ status = 0;
+ break;
+ case 2:
+ while (PL_scopestack_ix > oldscope)
+ LEAVE;
+ FREETMPS;
+ PL_curstash = PL_defstash;
+ if (PL_endav && !PL_minus_c)
+ call_list(oldscope, PL_endav);
+ status = STATUS_NATIVE_EXPORT;
+ break;
+ case 3:
+ if (PL_restartop) {
+ POPSTACK_TO(PL_mainstack);
+ PL_op = PL_restartop;
+ PL_restartop = Nullop;
+ goto restart;
+ }
+ PerlIO_printf(Perl_error_log, "panic: restartop\n");
+ FREETMPS;
+ status = 1;
+ break;
+ }
+ JMPENV_POP;
+
+ /* XXX hack to avoid perl_destruct() freeing optree */
+ PL_main_root = Nullop;
+ }
+
+ /* destroy everything (waits for any pseudo-forked children) */
+ perl_destruct(my_perl);
+ perl_free(my_perl);
+
+#ifdef PERL_SYNC_FORK
+ return id;
+#else
+ return (DWORD)status;
+#endif
+}
+#endif /* USE_ITHREADS */
+
+int
+PerlProcFork(struct IPerlProc* piPerl)
+{
+ dTHXo;
+#ifdef USE_ITHREADS
+ DWORD id;
+ HANDLE handle;
+ CPerlHost *h = new CPerlHost(*(CPerlHost*)w32_internal_host);
+ PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
+ h->m_pHostperlMem,
+ h->m_pHostperlMemShared,
+ h->m_pHostperlMemParse,
+ h->m_pHostperlEnv,
+ h->m_pHostperlStdIO,
+ h->m_pHostperlLIO,
+ h->m_pHostperlDir,
+ h->m_pHostperlSock,
+ h->m_pHostperlProc
+ );
+ new_perl->Isys_intern.internal_host = h;
+# ifdef PERL_SYNC_FORK
+ id = win32_start_child((LPVOID)new_perl);
+ PERL_SET_INTERP(aTHXo);
+# else
+ handle = CreateThread(NULL, 0, win32_start_child,
+ (LPVOID)new_perl, 0, &id);
+ PERL_SET_INTERP(aTHXo);
+ if (!handle)
+ Perl_croak(aTHX_ "panic: pseudo fork() failed");
+ w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
+ w32_pseudo_child_pids[w32_num_pseudo_children] = id;
+ ++w32_num_pseudo_children;
+# endif
+ return -(int)id;
+#else
+ Perl_croak(aTHX_ "fork() not implemented!\n");
+ return -1;
+#endif /* USE_ITHREADS */
+}
+
+int
+PerlProcGetpid(struct IPerlProc* piPerl)
+{
+ return win32_getpid();
+}
+
+void*
+PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
+{
+ return win32_dynaload(filename);
+}
+
+void
+PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
+{
+ win32_str_os_error(sv, dwErr);
+}
+
+BOOL
+PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
+{
+ do_spawn2(cmd, EXECF_EXEC);
+ return FALSE;
+}
+
+int
+PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
+{
+ return do_spawn2(cmds, EXECF_SPAWN);
+}
+
+int
+PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
+{
+ return win32_spawnvp(mode, cmdname, argv);
+}
+
+int
+PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
+{
+ return do_aspawn(vreally, vmark, vsp);
+}
+
+struct IPerlProc perlProc =
+{
+ PerlProcAbort,
+ PerlProcCrypt,
+ PerlProcExit,
+ PerlProc_Exit,
+ PerlProcExecl,
+ PerlProcExecv,
+ PerlProcExecvp,
+ PerlProcGetuid,
+ PerlProcGeteuid,
+ PerlProcGetgid,
+ PerlProcGetegid,
+ PerlProcGetlogin,
+ PerlProcKill,
+ PerlProcKillpg,
+ PerlProcPauseProc,
+ PerlProcPopen,
+ PerlProcPclose,
+ PerlProcPipe,
+ PerlProcSetuid,
+ PerlProcSetgid,
+ PerlProcSleep,
+ PerlProcTimes,
+ PerlProcWait,
+ PerlProcWaitpid,
+ PerlProcSignal,
+ PerlProcFork,
+ PerlProcGetpid,
+ PerlProcDynaLoader,
+ PerlProcGetOSError,
+ PerlProcDoCmd,
+ PerlProcSpawn,
+ PerlProcSpawnvp,
+ PerlProcASpawn,
+};
+
+
+/*
+ * CPerlHost
+ */
+
+CPerlHost::CPerlHost(void)
+{
+ m_pvDir = new VDir();
+ m_pVMem = new VMem();
+ m_pVMemShared = new VMem();
+ m_pVMemParse = new VMem();
+
+ m_pvDir->Init(NULL, m_pVMem);
+
+ m_dwEnvCount = 0;
+ m_lppEnvList = NULL;
+
+ CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
+ CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
+ CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
+ CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
+ CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
+ CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
+ CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
+ CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
+ CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
+
+ m_pHostperlMem = &m_hostperlMem;
+ m_pHostperlMemShared = &m_hostperlMemShared;
+ m_pHostperlMemParse = &m_hostperlMemParse;
+ m_pHostperlEnv = &m_hostperlEnv;
+ m_pHostperlStdIO = &m_hostperlStdIO;
+ m_pHostperlLIO = &m_hostperlLIO;
+ m_pHostperlDir = &m_hostperlDir;
+ m_pHostperlSock = &m_hostperlSock;
+ m_pHostperlProc = &m_hostperlProc;
+}
+
+#define SETUPEXCHANGE(xptr, iptr, table) \
+ STMT_START { \
+ if (xptr) { \
+ iptr = *xptr; \
+ *xptr = &table; \
+ } \
+ else { \
+ iptr = &table; \
+ } \
+ } STMT_END
+
+CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
+ struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
+ struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
+ struct IPerlDir** ppDir, struct IPerlSock** ppSock,
+ struct IPerlProc** ppProc)
+{
+ m_pvDir = new VDir(0);
+ m_pVMem = new VMem();
+ m_pVMemShared = new VMem();
+ m_pVMemParse = new VMem();
+
+ m_pvDir->Init(NULL, m_pVMem);
+
+ m_dwEnvCount = 0;
+ m_lppEnvList = NULL;
+
+ CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
+ CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
+ CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
+ CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
+ CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
+ CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
+ CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
+ CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
+ CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
+
+ SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
+ SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
+ SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
+ SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
+ SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
+ SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
+ SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
+ SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
+ SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
+}
+#undef SETUPEXCHANGE
+
+CPerlHost::CPerlHost(CPerlHost& host)
+{
+ m_pVMem = new VMem();
+ m_pVMemShared = host.GetMemShared();
+ m_pVMemParse = host.GetMemParse();
+
+ /* duplicate directory info */
+ m_pvDir = new VDir(0);
+ m_pvDir->Init(host.GetDir(), m_pVMem);
+
+ CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
+ CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
+ CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
+ CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
+ CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
+ CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
+ CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
+ CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
+ CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
+ m_pHostperlMem = &m_hostperlMem;
+ m_pHostperlMemShared = &m_hostperlMemShared;
+ m_pHostperlMemParse = &m_hostperlMemParse;
+ m_pHostperlEnv = &m_hostperlEnv;
+ m_pHostperlStdIO = &m_hostperlStdIO;
+ m_pHostperlLIO = &m_hostperlLIO;
+ m_pHostperlDir = &m_hostperlDir;
+ m_pHostperlSock = &m_hostperlSock;
+ m_pHostperlProc = &m_hostperlProc;
+
+ m_dwEnvCount = 0;
+ m_lppEnvList = NULL;
+
+ /* duplicate environment info */
+ LPSTR lpPtr;
+ DWORD dwIndex = 0;
+ while(lpPtr = host.GetIndex(dwIndex))
+ Add(lpPtr);
+}
+
+CPerlHost::~CPerlHost(void)
+{
+// Reset();
+ delete m_pvDir;
+ m_pVMemParse->Release();
+ m_pVMemShared->Release();
+ m_pVMem->Release();
+}
+
+LPSTR
+CPerlHost::Find(LPCSTR lpStr)
+{
+ LPSTR lpPtr;
+ LPSTR* lppPtr = Lookup(lpStr);
+ if(lppPtr != NULL) {
+ for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
+ ;
+
+ if(*lpPtr == '=')
+ ++lpPtr;
+
+ return lpPtr;
+ }
+ return NULL;
+}
+
+int
+lookup(const void *arg1, const void *arg2)
+{ // Compare strings
+ char*ptr1, *ptr2;
+ char c1,c2;
+
+ ptr1 = *(char**)arg1;
+ ptr2 = *(char**)arg2;
+ for(;;) {
+ c1 = *ptr1++;
+ c2 = *ptr2++;
+ if(c1 == '\0' || c1 == '=') {
+ if(c2 == '\0' || c2 == '=')
+ break;
+
+ return -1; // string 1 < string 2
+ }
+ else if(c2 == '\0' || c2 == '=')
+ return 1; // string 1 > string 2
+ else if(c1 != c2) {
+ c1 = toupper(c1);
+ c2 = toupper(c2);
+ if(c1 != c2) {
+ if(c1 < c2)
+ return -1; // string 1 < string 2
+
+ return 1; // string 1 > string 2
+ }
+ }
+ }
+ return 0;
+}
+
+LPSTR*
+CPerlHost::Lookup(LPCSTR lpStr)
+{
+ return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
+}
+
+int
+compare(const void *arg1, const void *arg2)
+{ // Compare strings
+ char*ptr1, *ptr2;
+ char c1,c2;
+
+ ptr1 = *(char**)arg1;
+ ptr2 = *(char**)arg2;
+ for(;;) {
+ c1 = *ptr1++;
+ c2 = *ptr2++;
+ if(c1 == '\0' || c1 == '=') {
+ if(c1 == c2)
+ break;
+
+ return -1; // string 1 < string 2
+ }
+ else if(c2 == '\0' || c2 == '=')
+ return 1; // string 1 > string 2
+ else if(c1 != c2) {
+ c1 = toupper(c1);
+ c2 = toupper(c2);
+ if(c1 != c2) {
+ if(c1 < c2)
+ return -1; // string 1 < string 2
+
+ return 1; // string 1 > string 2
+ }
+ }
+ }
+ return 0;
+}
+
+void
+CPerlHost::Add(LPCSTR lpStr)
+{
+ dTHXo;
+ char szBuffer[1024];
+ LPSTR *lpPtr;
+ int index, length = strlen(lpStr)+1;
+
+ for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index)
+ szBuffer[index] = lpStr[index];
+
+ szBuffer[index] = '\0';
+
+ // replacing ?
+ lpPtr = Lookup(szBuffer);
+ if(lpPtr != NULL) {
+ Renew(*lpPtr, length, char);
+ strcpy(*lpPtr, lpStr);
+ }
+ else {
+ ++m_dwEnvCount;
+ Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
+ New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
+ if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
+ strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
+ qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
+ }
+ else
+ --m_dwEnvCount;
+ }
+}
+
+DWORD
+CPerlHost::CalculateEnvironmentSpace(void)
+{
+ DWORD index;
+ DWORD dwSize = 0;
+ for(index = 0; index < m_dwEnvCount; ++index)
+ dwSize += strlen(m_lppEnvList[index]) + 1;
+
+ return dwSize;
+}
+
+void
+CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
+{
+ dTHXo;
+ Safefree(lpStr);
+}
+
+char*
+CPerlHost::GetChildDir(void)
+{
+ dTHXo;
+ int length;
+ char* ptr;
+ New(0, ptr, MAX_PATH+1, char);
+ if(ptr) {
+ m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
+ length = strlen(ptr)-1;
+ if(length > 0) {
+ if((ptr[length] == '\\') || (ptr[length] == '/'))
+ ptr[length] = 0;
+ }
+ }
+ return ptr;
+}
+
+void
+CPerlHost::FreeChildDir(char* pStr)
+{
+ dTHXo;
+ Safefree(pStr);
+}
+
+LPSTR
+CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
+{
+ dTHXo;
+ LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
+ DWORD dwSize, dwEnvIndex;
+ int nLength, compVal;
+
+ // get the process environment strings
+ lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
+
+ // step over current directory stuff
+ while(*lpTmp == '=')
+ lpTmp += strlen(lpTmp) + 1;
+
+ // save the start of the environment strings
+ lpEnvPtr = lpTmp;
+ for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
+ // calculate the size of the environment strings
+ dwSize += strlen(lpTmp) + 1;
+ }
+
+ // add the size of current directories
+ dwSize += vDir.CalculateEnvironmentSpace();
+
+ // add the additional space used by changes made to the environment
+ dwSize += CalculateEnvironmentSpace();
+
+ New(1, lpStr, dwSize, char);
+ lpPtr = lpStr;
+ if(lpStr != NULL) {
+ // build the local environment
+ lpStr = vDir.BuildEnvironmentSpace(lpStr);
+
+ dwEnvIndex = 0;
+ lpLocalEnv = GetIndex(dwEnvIndex);
+ while(*lpEnvPtr != '\0') {
+ if(lpLocalEnv == NULL) {
+ // all environment overrides have been added
+ // so copy string into place
+ strcpy(lpStr, lpEnvPtr);
+ nLength = strlen(lpEnvPtr) + 1;
+ lpStr += nLength;
+ lpEnvPtr += nLength;
+ }
+ else {
+ // determine which string to copy next
+ compVal = compare(&lpEnvPtr, &lpLocalEnv);
+ if(compVal < 0) {
+ strcpy(lpStr, lpEnvPtr);
+ nLength = strlen(lpEnvPtr) + 1;
+ lpStr += nLength;
+ lpEnvPtr += nLength;
+ }
+ else {
+ char *ptr = strchr(lpLocalEnv, '=');
+ if(ptr && ptr[1]) {
+ strcpy(lpStr, lpLocalEnv);
+ lpStr += strlen(lpLocalEnv) + 1;
+ }
+ lpLocalEnv = GetIndex(dwEnvIndex);
+ if(compVal == 0) {
+ // this string was replaced
+ lpEnvPtr += strlen(lpEnvPtr) + 1;
+ }
+ }
+ }
+ }
+
+ // add final NULL
+ *lpStr = '\0';
+ }
+
+ // release the process environment strings
+ FreeEnvironmentStrings(lpAllocPtr);
+
+ return lpPtr;
+}
+
+void
+CPerlHost::Reset(void)
+{
+ dTHXo;
+ if(m_lppEnvList != NULL) {
+ for(DWORD index = 0; index < m_dwEnvCount; ++index) {
+ Safefree(m_lppEnvList[index]);
+ m_lppEnvList[index] = NULL;
+ }
+ }
+ m_dwEnvCount = 0;
+}
+
+void
+CPerlHost::Clearenv(void)
+{
+ char ch;
+ LPSTR lpPtr, lpStr, lpEnvPtr;
+ if(m_lppEnvList != NULL) {
+ /* set every entry to an empty string */
+ for(DWORD index = 0; index < m_dwEnvCount; ++index) {
+ char* ptr = strchr(m_lppEnvList[index], '=');
+ if(ptr) {
+ *++ptr = 0;
+ }
+ }
+ }
+
+ /* get the process environment strings */
+ lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
+
+ /* step over current directory stuff */
+ while(*lpStr == '=')
+ lpStr += strlen(lpStr) + 1;
+
+ while(*lpStr) {
+ lpPtr = strchr(lpStr, '=');
+ if(lpPtr) {
+ ch = *++lpPtr;
+ *lpPtr = 0;
+ Add(lpStr);
+ *lpPtr = ch;
+ }
+ lpStr += strlen(lpStr) + 1;
+ }
+
+ FreeEnvironmentStrings(lpEnvPtr);
+}
+
+
+char*
+CPerlHost::Getenv(const char *varname)
+{
+ char* pEnv = Find(varname);
+ if(pEnv == NULL) {
+ pEnv = win32_getenv(varname);
+ }
+ else {
+ if(!*pEnv)
+ pEnv = 0;
+ }
+
+ return pEnv;
+}
+
+int
+CPerlHost::Putenv(const char *envstring)
+{
+ Add(envstring);
+ return 0;
+}
+
+int
+CPerlHost::Chdir(const char *dirname)
+{
+ dTHXo;
+ int ret;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
+ ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
+ }
+ else
+ ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
+ if(ret < 0) {
+ errno = ENOENT;
+ }
+ return ret;
+}
+
+#endif /* ___PerlHost_H___ */
diff --git a/win32/perllib.c b/win32/perllib.c
index 9cd542b9df..9ccf5a0043 100644
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -15,7 +15,7 @@
#ifdef PERL_IMPLICIT_SYS
#include "win32iop.h"
#include <fcntl.h>
-#endif
+#endif /* PERL_IMPLICIT_SYS */
/* Register any extra external extensions */
@@ -35,1284 +35,13 @@ xs_init(pTHXo)
}
#ifdef PERL_IMPLICIT_SYS
-/* IPerlMem */
-void*
-PerlMemMalloc(struct IPerlMem *I, size_t size)
-{
- return win32_malloc(size);
-}
-void*
-PerlMemRealloc(struct IPerlMem *I, void* ptr, size_t size)
-{
- return win32_realloc(ptr, size);
-}
-void
-PerlMemFree(struct IPerlMem *I, void* ptr)
-{
- win32_free(ptr);
-}
-
-struct IPerlMem perlMem =
-{
- PerlMemMalloc,
- PerlMemRealloc,
- PerlMemFree,
-};
-
-
-/* IPerlEnv */
-extern char * g_win32_get_privlib(char *pl);
-extern char * g_win32_get_sitelib(char *pl);
-
-
-char*
-PerlEnvGetenv(struct IPerlEnv *I, const char *varname)
-{
- return win32_getenv(varname);
-};
-int
-PerlEnvPutenv(struct IPerlEnv *I, const char *envstring)
-{
- return win32_putenv(envstring);
-};
-
-char*
-PerlEnvGetenv_len(struct IPerlEnv *I, const char* varname, unsigned long* len)
-{
- char *e = win32_getenv(varname);
- if (e)
- *len = strlen(e);
- return e;
-}
-
-int
-PerlEnvUname(struct IPerlEnv *I, struct utsname *name)
-{
- return win32_uname(name);
-}
-
-void
-PerlEnvClearenv(struct IPerlEnv *I)
-{
- dTHXo;
- char *envv = GetEnvironmentStrings();
- char *cur = envv;
- STRLEN len;
- while (*cur) {
- char *end = strchr(cur,'=');
- if (end && end != cur) {
- *end = '\0';
- my_setenv(cur,Nullch);
- *end = '=';
- cur = end + strlen(end+1)+2;
- }
- else if ((len = strlen(cur)))
- cur += len+1;
- }
- FreeEnvironmentStrings(envv);
-}
-
-void*
-PerlEnvGetChildEnv(struct IPerlEnv *I)
-{
- return NULL;
-}
-
-void
-PerlEnvFreeChildEnv(struct IPerlEnv *I, void* env)
-{
-}
-
-char*
-PerlEnvGetChildDir(struct IPerlEnv *I)
-{
- return NULL;
-}
-
-void
-PerlEnvFreeChildDir(struct IPerlEnv *I, char* dir)
-{
-}
-
-unsigned long
-PerlEnvOsId(struct IPerlEnv *I)
-{
- return win32_os_id();
-}
-
-char*
-PerlEnvLibPath(struct IPerlEnv *I, char *pl)
-{
- return g_win32_get_privlib(pl);
-}
-
-char*
-PerlEnvSiteLibPath(struct IPerlEnv *I, char *pl)
-{
- return g_win32_get_sitelib(pl);
-}
-
-struct IPerlEnv perlEnv =
-{
- PerlEnvGetenv,
- PerlEnvPutenv,
- PerlEnvGetenv_len,
- PerlEnvUname,
- PerlEnvClearenv,
- PerlEnvGetChildEnv,
- PerlEnvFreeChildEnv,
- PerlEnvGetChildDir,
- PerlEnvFreeChildDir,
- PerlEnvOsId,
- PerlEnvLibPath,
- PerlEnvSiteLibPath,
-};
-
-
-/* PerlStdIO */
-PerlIO*
-PerlStdIOStdin(struct IPerlStdIO *I)
-{
- return (PerlIO*)win32_stdin();
-}
-
-PerlIO*
-PerlStdIOStdout(struct IPerlStdIO *I)
-{
- return (PerlIO*)win32_stdout();
-}
-
-PerlIO*
-PerlStdIOStderr(struct IPerlStdIO *I)
-{
- return (PerlIO*)win32_stderr();
-}
-
-PerlIO*
-PerlStdIOOpen(struct IPerlStdIO *I, const char *path, const char *mode)
-{
- return (PerlIO*)win32_fopen(path, mode);
-}
-
-int
-PerlStdIOClose(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_fclose(((FILE*)pf));
-}
-
-int
-PerlStdIOEof(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_feof((FILE*)pf);
-}
-
-int
-PerlStdIOError(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_ferror((FILE*)pf);
-}
-
-void
-PerlStdIOClearerr(struct IPerlStdIO *I, PerlIO* pf)
-{
- win32_clearerr((FILE*)pf);
-}
-
-int
-PerlStdIOGetc(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_getc((FILE*)pf);
-}
-
-char*
-PerlStdIOGetBase(struct IPerlStdIO *I, PerlIO* pf)
-{
-#ifdef FILE_base
- FILE *f = (FILE*)pf;
- return FILE_base(f);
-#else
- return Nullch;
-#endif
-}
-
-int
-PerlStdIOGetBufsiz(struct IPerlStdIO *I, PerlIO* pf)
-{
-#ifdef FILE_bufsiz
- FILE *f = (FILE*)pf;
- return FILE_bufsiz(f);
-#else
- return (-1);
-#endif
-}
-
-int
-PerlStdIOGetCnt(struct IPerlStdIO *I, PerlIO* pf)
-{
-#ifdef USE_STDIO_PTR
- FILE *f = (FILE*)pf;
- return FILE_cnt(f);
-#else
- return (-1);
-#endif
-}
-
-char*
-PerlStdIOGetPtr(struct IPerlStdIO *I, PerlIO* pf)
-{
-#ifdef USE_STDIO_PTR
- FILE *f = (FILE*)pf;
- return FILE_ptr(f);
-#else
- return Nullch;
-#endif
-}
-
-char*
-PerlStdIOGets(struct IPerlStdIO *I, PerlIO* pf, char* s, int n)
-{
- return win32_fgets(s, n, (FILE*)pf);
-}
-
-int
-PerlStdIOPutc(struct IPerlStdIO *I, PerlIO* pf, int c)
-{
- return win32_fputc(c, (FILE*)pf);
-}
-
-int
-PerlStdIOPuts(struct IPerlStdIO *I, PerlIO* pf, const char *s)
-{
- return win32_fputs(s, (FILE*)pf);
-}
-
-int
-PerlStdIOFlush(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_fflush((FILE*)pf);
-}
-
-int
-PerlStdIOUngetc(struct IPerlStdIO *I, PerlIO* pf,int c)
-{
- return win32_ungetc(c, (FILE*)pf);
-}
-
-int
-PerlStdIOFileno(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_fileno((FILE*)pf);
-}
-
-PerlIO*
-PerlStdIOFdopen(struct IPerlStdIO *I, int fd, const char *mode)
-{
- return (PerlIO*)win32_fdopen(fd, mode);
-}
-
-PerlIO*
-PerlStdIOReopen(struct IPerlStdIO *I, const char*path, const char*mode, PerlIO* pf)
-{
- return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
-}
-
-SSize_t
-PerlStdIORead(struct IPerlStdIO *I, PerlIO* pf, void *buffer, Size_t size)
-{
- return win32_fread(buffer, 1, size, (FILE*)pf);
-}
-
-SSize_t
-PerlStdIOWrite(struct IPerlStdIO *I, PerlIO* pf, const void *buffer, Size_t size)
-{
- return win32_fwrite(buffer, 1, size, (FILE*)pf);
-}
-
-void
-PerlStdIOSetBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer)
-{
- win32_setbuf((FILE*)pf, buffer);
-}
-
-int
-PerlStdIOSetVBuf(struct IPerlStdIO *I, PerlIO* pf, char* buffer, int type, Size_t size)
-{
- return win32_setvbuf((FILE*)pf, buffer, type, size);
-}
-
-void
-PerlStdIOSetCnt(struct IPerlStdIO *I, PerlIO* pf, int n)
-{
-#ifdef STDIO_CNT_LVALUE
- FILE *f = (FILE*)pf;
- FILE_cnt(f) = n;
-#endif
-}
-
-void
-PerlStdIOSetPtrCnt(struct IPerlStdIO *I, PerlIO* pf, char * ptr, int n)
-{
-#ifdef STDIO_PTR_LVALUE
- FILE *f = (FILE*)pf;
- FILE_ptr(f) = ptr;
- FILE_cnt(f) = n;
-#endif
-}
-
-void
-PerlStdIOSetlinebuf(struct IPerlStdIO *I, PerlIO* pf)
-{
- win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
-}
-
-int
-PerlStdIOPrintf(struct IPerlStdIO *I, PerlIO* pf, const char *format,...)
-{
- va_list(arglist);
- va_start(arglist, format);
- return win32_vfprintf((FILE*)pf, format, arglist);
-}
-
-int
-PerlStdIOVprintf(struct IPerlStdIO *I, PerlIO* pf, const char *format, va_list arglist)
-{
- return win32_vfprintf((FILE*)pf, format, arglist);
-}
-
-long
-PerlStdIOTell(struct IPerlStdIO *I, PerlIO* pf)
-{
- return win32_ftell((FILE*)pf);
-}
-
-int
-PerlStdIOSeek(struct IPerlStdIO *I, PerlIO* pf, off_t offset, int origin)
-{
- return win32_fseek((FILE*)pf, offset, origin);
-}
-
-void
-PerlStdIORewind(struct IPerlStdIO *I, PerlIO* pf)
-{
- win32_rewind((FILE*)pf);
-}
-
-PerlIO*
-PerlStdIOTmpfile(struct IPerlStdIO *I)
-{
- return (PerlIO*)win32_tmpfile();
-}
-
-int
-PerlStdIOGetpos(struct IPerlStdIO *I, PerlIO* pf, Fpos_t *p)
-{
- return win32_fgetpos((FILE*)pf, p);
-}
-
-int
-PerlStdIOSetpos(struct IPerlStdIO *I, PerlIO* pf, const Fpos_t *p)
-{
- return win32_fsetpos((FILE*)pf, p);
-}
-void
-PerlStdIOInit(struct IPerlStdIO *I)
-{
-}
-
-void
-PerlStdIOInitOSExtras(struct IPerlStdIO *I)
-{
- Perl_init_os_extras();
-}
-
-int
-PerlStdIOOpenOSfhandle(struct IPerlStdIO *I, long osfhandle, int flags)
-{
- return win32_open_osfhandle(osfhandle, flags);
-}
-
-int
-PerlStdIOGetOSfhandle(struct IPerlStdIO *I, int filenum)
-{
- return win32_get_osfhandle(filenum);
-}
-
-
-struct IPerlStdIO perlStdIO =
-{
- PerlStdIOStdin,
- PerlStdIOStdout,
- PerlStdIOStderr,
- PerlStdIOOpen,
- PerlStdIOClose,
- PerlStdIOEof,
- PerlStdIOError,
- PerlStdIOClearerr,
- PerlStdIOGetc,
- PerlStdIOGetBase,
- PerlStdIOGetBufsiz,
- PerlStdIOGetCnt,
- PerlStdIOGetPtr,
- PerlStdIOGets,
- PerlStdIOPutc,
- PerlStdIOPuts,
- PerlStdIOFlush,
- PerlStdIOUngetc,
- PerlStdIOFileno,
- PerlStdIOFdopen,
- PerlStdIOReopen,
- PerlStdIORead,
- PerlStdIOWrite,
- PerlStdIOSetBuf,
- PerlStdIOSetVBuf,
- PerlStdIOSetCnt,
- PerlStdIOSetPtrCnt,
- PerlStdIOSetlinebuf,
- PerlStdIOPrintf,
- PerlStdIOVprintf,
- PerlStdIOTell,
- PerlStdIOSeek,
- PerlStdIORewind,
- PerlStdIOTmpfile,
- PerlStdIOGetpos,
- PerlStdIOSetpos,
- PerlStdIOInit,
- PerlStdIOInitOSExtras,
-};
-
-
-/* IPerlLIO */
-int
-PerlLIOAccess(struct IPerlLIO *I, const char *path, int mode)
-{
- return access(path, mode);
-}
-
-int
-PerlLIOChmod(struct IPerlLIO *I, const char *filename, int pmode)
-{
- return chmod(filename, pmode);
-}
-
-int
-PerlLIOChown(struct IPerlLIO *I, const char *filename, uid_t owner, gid_t group)
-{
- return chown(filename, owner, group);
-}
-
-int
-PerlLIOChsize(struct IPerlLIO *I, int handle, long size)
-{
- return chsize(handle, size);
-}
-
-int
-PerlLIOClose(struct IPerlLIO *I, int handle)
-{
- return win32_close(handle);
-}
-
-int
-PerlLIODup(struct IPerlLIO *I, int handle)
-{
- return win32_dup(handle);
-}
-
-int
-PerlLIODup2(struct IPerlLIO *I, int handle1, int handle2)
-{
- return win32_dup2(handle1, handle2);
-}
-
-int
-PerlLIOFlock(struct IPerlLIO *I, int fd, int oper)
-{
- return win32_flock(fd, oper);
-}
-
-int
-PerlLIOFileStat(struct IPerlLIO *I, int handle, struct stat *buffer)
-{
- return fstat(handle, buffer);
-}
-
-int
-PerlLIOIOCtl(struct IPerlLIO *I, int i, unsigned int u, char *data)
-{
- return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
-}
-
-int
-PerlLIOIsatty(struct IPerlLIO *I, int fd)
-{
- return isatty(fd);
-}
-
-int
-PerlLIOLink(struct IPerlLIO *I, const char*oldname, const char *newname)
-{
- return win32_link(oldname, newname);
-}
-
-long
-PerlLIOLseek(struct IPerlLIO *I, int handle, long offset, int origin)
-{
- return win32_lseek(handle, offset, origin);
-}
-
-int
-PerlLIOLstat(struct IPerlLIO* p, const char *path, struct stat *buffer)
-{
- return win32_stat(path, buffer);
-}
-
-char*
-PerlLIOMktemp(struct IPerlLIO *I, char *Template)
-{
- return mktemp(Template);
-}
-
-int
-PerlLIOOpen(struct IPerlLIO *I, const char *filename, int oflag)
-{
- return win32_open(filename, oflag);
-}
-
-int
-PerlLIOOpen3(struct IPerlLIO *I, const char *filename, int oflag, int pmode)
-{
- int ret;
- if(stricmp(filename, "/dev/null") == 0)
- ret = open("NUL", oflag, pmode);
- else
- ret = open(filename, oflag, pmode);
-
- return ret;
-}
-
-int
-PerlLIORead(struct IPerlLIO *I, int handle, void *buffer, unsigned int count)
-{
- return win32_read(handle, buffer, count);
-}
-
-int
-PerlLIORename(struct IPerlLIO *I, const char *OldFileName, const char *newname)
-{
- return win32_rename(OldFileName, newname);
-}
-
-int
-PerlLIOSetmode(struct IPerlLIO *I, int handle, int mode)
-{
- return win32_setmode(handle, mode);
-}
-
-int
-PerlLIONameStat(struct IPerlLIO *I, const char *path, struct stat *buffer)
-{
- return win32_stat(path, buffer);
-}
-
-char*
-PerlLIOTmpnam(struct IPerlLIO *I, char *string)
-{
- return tmpnam(string);
-}
-
-int
-PerlLIOUmask(struct IPerlLIO *I, int pmode)
-{
- return umask(pmode);
-}
-
-int
-PerlLIOUnlink(struct IPerlLIO *I, const char *filename)
-{
- chmod(filename, S_IREAD | S_IWRITE);
- return unlink(filename);
-}
-
-int
-PerlLIOUtime(struct IPerlLIO *I, char *filename, struct utimbuf *times)
-{
- return win32_utime(filename, times);
-}
-
-int
-PerlLIOWrite(struct IPerlLIO *I, int handle, const void *buffer, unsigned int count)
-{
- return win32_write(handle, buffer, count);
-}
-
-struct IPerlLIO perlLIO =
-{
- PerlLIOAccess,
- PerlLIOChmod,
- PerlLIOChown,
- PerlLIOChsize,
- PerlLIOClose,
- PerlLIODup,
- PerlLIODup2,
- PerlLIOFlock,
- PerlLIOFileStat,
- PerlLIOIOCtl,
- PerlLIOIsatty,
- PerlLIOLink,
- PerlLIOLseek,
- PerlLIOLstat,
- PerlLIOMktemp,
- PerlLIOOpen,
- PerlLIOOpen3,
- PerlLIORead,
- PerlLIORename,
- PerlLIOSetmode,
- PerlLIONameStat,
- PerlLIOTmpnam,
- PerlLIOUmask,
- PerlLIOUnlink,
- PerlLIOUtime,
- PerlLIOWrite,
-};
-
-/* IPerlDIR */
-int
-PerlDirMakedir(struct IPerlDir *I, const char *dirname, int mode)
-{
- return win32_mkdir(dirname, mode);
-}
-
-int
-PerlDirChdir(struct IPerlDir *I, const char *dirname)
-{
- return win32_chdir(dirname);
-}
-
-int
-PerlDirRmdir(struct IPerlDir *I, const char *dirname)
-{
- return win32_rmdir(dirname);
-}
-
-int
-PerlDirClose(struct IPerlDir *I, DIR *dirp)
-{
- return win32_closedir(dirp);
-}
-
-DIR*
-PerlDirOpen(struct IPerlDir *I, char *filename)
-{
- return win32_opendir(filename);
-}
-
-struct direct *
-PerlDirRead(struct IPerlDir *I, DIR *dirp)
-{
- return win32_readdir(dirp);
-}
-
-void
-PerlDirRewind(struct IPerlDir *I, DIR *dirp)
-{
- win32_rewinddir(dirp);
-}
-
-void
-PerlDirSeek(struct IPerlDir *I, DIR *dirp, long loc)
-{
- win32_seekdir(dirp, loc);
-}
-
-long
-PerlDirTell(struct IPerlDir *I, DIR *dirp)
-{
- return win32_telldir(dirp);
-}
-
-struct IPerlDir perlDir =
-{
- PerlDirMakedir,
- PerlDirChdir,
- PerlDirRmdir,
- PerlDirClose,
- PerlDirOpen,
- PerlDirRead,
- PerlDirRewind,
- PerlDirSeek,
- PerlDirTell,
-};
-
-
-/* IPerlSock */
-u_long
-PerlSockHtonl(struct IPerlSock *I, u_long hostlong)
-{
- return win32_htonl(hostlong);
-}
-
-u_short
-PerlSockHtons(struct IPerlSock *I, u_short hostshort)
-{
- return win32_htons(hostshort);
-}
-
-u_long
-PerlSockNtohl(struct IPerlSock *I, u_long netlong)
-{
- return win32_ntohl(netlong);
-}
-
-u_short
-PerlSockNtohs(struct IPerlSock *I, u_short netshort)
-{
- return win32_ntohs(netshort);
-}
-
-SOCKET PerlSockAccept(struct IPerlSock *I, SOCKET s, struct sockaddr* addr, int* addrlen)
-{
- return win32_accept(s, addr, addrlen);
-}
-
-int
-PerlSockBind(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen)
-{
- return win32_bind(s, name, namelen);
-}
-
-int
-PerlSockConnect(struct IPerlSock *I, SOCKET s, const struct sockaddr* name, int namelen)
-{
- return win32_connect(s, name, namelen);
-}
-
-void
-PerlSockEndhostent(struct IPerlSock *I)
-{
- win32_endhostent();
-}
-
-void
-PerlSockEndnetent(struct IPerlSock *I)
-{
- win32_endnetent();
-}
-
-void
-PerlSockEndprotoent(struct IPerlSock *I)
-{
- win32_endprotoent();
-}
-
-void
-PerlSockEndservent(struct IPerlSock *I)
-{
- win32_endservent();
-}
-
-struct hostent*
-PerlSockGethostbyaddr(struct IPerlSock *I, const char* addr, int len, int type)
-{
- return win32_gethostbyaddr(addr, len, type);
-}
-
-struct hostent*
-PerlSockGethostbyname(struct IPerlSock *I, const char* name)
-{
- return win32_gethostbyname(name);
-}
-
-struct hostent*
-PerlSockGethostent(struct IPerlSock *I)
-{
- dTHXo;
- Perl_croak(aTHX_ "gethostent not implemented!\n");
- return NULL;
-}
-
-int
-PerlSockGethostname(struct IPerlSock *I, char* name, int namelen)
-{
- return win32_gethostname(name, namelen);
-}
-
-struct netent *
-PerlSockGetnetbyaddr(struct IPerlSock *I, long net, int type)
-{
- return win32_getnetbyaddr(net, type);
-}
-
-struct netent *
-PerlSockGetnetbyname(struct IPerlSock *I, const char *name)
-{
- return win32_getnetbyname((char*)name);
-}
-
-struct netent *
-PerlSockGetnetent(struct IPerlSock *I)
-{
- return win32_getnetent();
-}
-
-int PerlSockGetpeername(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen)
-{
- return win32_getpeername(s, name, namelen);
-}
-
-struct protoent*
-PerlSockGetprotobyname(struct IPerlSock *I, const char* name)
-{
- return win32_getprotobyname(name);
-}
-
-struct protoent*
-PerlSockGetprotobynumber(struct IPerlSock *I, int number)
-{
- return win32_getprotobynumber(number);
-}
-
-struct protoent*
-PerlSockGetprotoent(struct IPerlSock *I)
-{
- return win32_getprotoent();
-}
-
-struct servent*
-PerlSockGetservbyname(struct IPerlSock *I, const char* name, const char* proto)
-{
- return win32_getservbyname(name, proto);
-}
-
-struct servent*
-PerlSockGetservbyport(struct IPerlSock *I, int port, const char* proto)
-{
- return win32_getservbyport(port, proto);
-}
-
-struct servent*
-PerlSockGetservent(struct IPerlSock *I)
-{
- return win32_getservent();
-}
-
-int
-PerlSockGetsockname(struct IPerlSock *I, SOCKET s, struct sockaddr* name, int* namelen)
-{
- return win32_getsockname(s, name, namelen);
-}
-
-int
-PerlSockGetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, char* optval, int* optlen)
-{
- return win32_getsockopt(s, level, optname, optval, optlen);
-}
-
-unsigned long
-PerlSockInetAddr(struct IPerlSock *I, const char* cp)
-{
- return win32_inet_addr(cp);
-}
-
-char*
-PerlSockInetNtoa(struct IPerlSock *I, struct in_addr in)
-{
- return win32_inet_ntoa(in);
-}
-
-int
-PerlSockListen(struct IPerlSock *I, SOCKET s, int backlog)
-{
- return win32_listen(s, backlog);
-}
-
-int
-PerlSockRecv(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags)
-{
- return win32_recv(s, buffer, len, flags);
-}
-
-int
-PerlSockRecvfrom(struct IPerlSock *I, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
-{
- return win32_recvfrom(s, buffer, len, flags, from, fromlen);
-}
-
-int
-PerlSockSelect(struct IPerlSock *I, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
-{
- return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
-}
-
-int
-PerlSockSend(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags)
-{
- return win32_send(s, buffer, len, flags);
-}
-
-int
-PerlSockSendto(struct IPerlSock *I, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
-{
- return win32_sendto(s, buffer, len, flags, to, tolen);
-}
-
-void
-PerlSockSethostent(struct IPerlSock *I, int stayopen)
-{
- win32_sethostent(stayopen);
-}
-
-void
-PerlSockSetnetent(struct IPerlSock *I, int stayopen)
-{
- win32_setnetent(stayopen);
-}
-
-void
-PerlSockSetprotoent(struct IPerlSock *I, int stayopen)
-{
- win32_setprotoent(stayopen);
-}
-
-void
-PerlSockSetservent(struct IPerlSock *I, int stayopen)
-{
- win32_setservent(stayopen);
-}
-
-int
-PerlSockSetsockopt(struct IPerlSock *I, SOCKET s, int level, int optname, const char* optval, int optlen)
-{
- return win32_setsockopt(s, level, optname, optval, optlen);
-}
-
-int
-PerlSockShutdown(struct IPerlSock *I, SOCKET s, int how)
-{
- return win32_shutdown(s, how);
-}
-
-SOCKET
-PerlSockSocket(struct IPerlSock *I, int af, int type, int protocol)
-{
- return win32_socket(af, type, protocol);
-}
-
-int
-PerlSockSocketpair(struct IPerlSock *I, int domain, int type, int protocol, int* fds)
-{
- dTHXo;
- Perl_croak(aTHX_ "socketpair not implemented!\n");
- return 0;
-}
-
-int
-PerlSockClosesocket(struct IPerlSock *I, SOCKET s)
-{
- return win32_closesocket(s);
-}
-
-int
-PerlSockIoctlsocket(struct IPerlSock *I, SOCKET s, long cmd, u_long *argp)
-{
- return win32_ioctlsocket(s, cmd, argp);
-}
-
-struct IPerlSock perlSock =
-{
- PerlSockHtonl,
- PerlSockHtons,
- PerlSockNtohl,
- PerlSockNtohs,
- PerlSockAccept,
- PerlSockBind,
- PerlSockConnect,
- PerlSockEndhostent,
- PerlSockEndnetent,
- PerlSockEndprotoent,
- PerlSockEndservent,
- PerlSockGethostname,
- PerlSockGetpeername,
- PerlSockGethostbyaddr,
- PerlSockGethostbyname,
- PerlSockGethostent,
- PerlSockGetnetbyaddr,
- PerlSockGetnetbyname,
- PerlSockGetnetent,
- PerlSockGetprotobyname,
- PerlSockGetprotobynumber,
- PerlSockGetprotoent,
- PerlSockGetservbyname,
- PerlSockGetservbyport,
- PerlSockGetservent,
- PerlSockGetsockname,
- PerlSockGetsockopt,
- PerlSockInetAddr,
- PerlSockInetNtoa,
- PerlSockListen,
- PerlSockRecv,
- PerlSockRecvfrom,
- PerlSockSelect,
- PerlSockSend,
- PerlSockSendto,
- PerlSockSethostent,
- PerlSockSetnetent,
- PerlSockSetprotoent,
- PerlSockSetservent,
- PerlSockSetsockopt,
- PerlSockShutdown,
- PerlSockSocket,
- PerlSockSocketpair,
- PerlSockClosesocket,
-};
-
-
-/* IPerlProc */
-
-#define EXECF_EXEC 1
-#define EXECF_SPAWN 2
-
-extern char * g_getlogin(void);
-extern int do_spawn2(char *cmd, int exectype);
-#ifdef PERL_OBJECT
-extern int g_do_aspawn(void *vreally, void **vmark, void **vsp);
-#define do_aspawn g_do_aspawn
-#endif
-EXTERN_C PerlInterpreter* perl_alloc_using(struct IPerlMem* pMem,
- struct IPerlEnv* pEnv, struct IPerlStdIO* pStdIO,
- struct IPerlLIO* pLIO, struct IPerlDir* pDir,
- struct IPerlSock* pSock, struct IPerlProc* pProc);
-
-void
-PerlProcAbort(struct IPerlProc *I)
-{
- win32_abort();
-}
-
-char *
-PerlProcCrypt(struct IPerlProc *I, const char* clear, const char* salt)
-{
- return win32_crypt(clear, salt);
-}
-
-void
-PerlProcExit(struct IPerlProc *I, int status)
-{
- exit(status);
-}
-
-void
-PerlProc_Exit(struct IPerlProc *I, int status)
-{
- _exit(status);
-}
-
-int
-PerlProcExecl(struct IPerlProc *I, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
-{
- return execl(cmdname, arg0, arg1, arg2, arg3);
-}
-
-int
-PerlProcExecv(struct IPerlProc *I, const char *cmdname, const char *const *argv)
-{
- return win32_execvp(cmdname, argv);
-}
-
-int
-PerlProcExecvp(struct IPerlProc *I, const char *cmdname, const char *const *argv)
-{
- return win32_execvp(cmdname, argv);
-}
-
-uid_t
-PerlProcGetuid(struct IPerlProc *I)
-{
- return getuid();
-}
-
-uid_t
-PerlProcGeteuid(struct IPerlProc *I)
-{
- return geteuid();
-}
-
-gid_t
-PerlProcGetgid(struct IPerlProc *I)
-{
- return getgid();
-}
-
-gid_t
-PerlProcGetegid(struct IPerlProc *I)
-{
- return getegid();
-}
-
-char *
-PerlProcGetlogin(struct IPerlProc *I)
-{
- return g_getlogin();
-}
-
-int
-PerlProcKill(struct IPerlProc *I, int pid, int sig)
-{
- return win32_kill(pid, sig);
-}
-
-int
-PerlProcKillpg(struct IPerlProc *I, int pid, int sig)
-{
- dTHXo;
- Perl_croak(aTHX_ "killpg not implemented!\n");
- return 0;
-}
-
-int
-PerlProcPauseProc(struct IPerlProc *I)
-{
- return win32_sleep((32767L << 16) + 32767);
-}
-
-PerlIO*
-PerlProcPopen(struct IPerlProc *I, const char *command, const char *mode)
-{
- dTHXo;
- PERL_FLUSHALL_FOR_CHILD;
- return (PerlIO*)win32_popen(command, mode);
-}
-
-int
-PerlProcPclose(struct IPerlProc *I, PerlIO *stream)
-{
- return win32_pclose((FILE*)stream);
-}
-
-int
-PerlProcPipe(struct IPerlProc *I, int *phandles)
-{
- return win32_pipe(phandles, 512, O_BINARY);
-}
-
-int
-PerlProcSetuid(struct IPerlProc *I, uid_t u)
-{
- return setuid(u);
-}
-
-int
-PerlProcSetgid(struct IPerlProc *I, gid_t g)
-{
- return setgid(g);
-}
-
-int
-PerlProcSleep(struct IPerlProc *I, unsigned int s)
-{
- return win32_sleep(s);
-}
-
-int
-PerlProcTimes(struct IPerlProc *I, struct tms *timebuf)
-{
- return win32_times(timebuf);
-}
-
-int
-PerlProcWait(struct IPerlProc *I, int *status)
-{
- return win32_wait(status);
-}
-
-int
-PerlProcWaitpid(struct IPerlProc *I, int pid, int *status, int flags)
-{
- return win32_waitpid(pid, status, flags);
-}
-
-Sighandler_t
-PerlProcSignal(struct IPerlProc *I, int sig, Sighandler_t subcode)
-{
- return 0;
-}
-
-void*
-PerlProcDynaLoader(struct IPerlProc *I, const char* filename)
-{
- return win32_dynaload(filename);
-}
-
-void
-PerlProcGetOSError(struct IPerlProc *I, SV* sv, DWORD dwErr)
-{
- win32_str_os_error(sv, dwErr);
-}
-
-BOOL
-PerlProcDoCmd(struct IPerlProc *I, char *cmd)
-{
- do_spawn2(cmd, EXECF_EXEC);
- return FALSE;
-}
-
-int
-PerlProcSpawn(struct IPerlProc *I, char* cmds)
-{
- return do_spawn2(cmds, EXECF_SPAWN);
-}
-
-int
-PerlProcSpawnvp(struct IPerlProc *I, int mode, const char *cmdname, const char *const *argv)
-{
- return win32_spawnvp(mode, cmdname, argv);
-}
-
-int
-PerlProcASpawn(struct IPerlProc *I, void *vreally, void **vmark, void **vsp)
-{
- return do_aspawn(vreally, vmark, vsp);
-}
-
-struct IPerlProc perlProc =
-{
- PerlProcAbort,
- PerlProcCrypt,
- PerlProcExit,
- PerlProc_Exit,
- PerlProcExecl,
- PerlProcExecv,
- PerlProcExecvp,
- PerlProcGetuid,
- PerlProcGeteuid,
- PerlProcGetgid,
- PerlProcGetegid,
- PerlProcGetlogin,
- PerlProcKill,
- PerlProcKillpg,
- PerlProcPauseProc,
- PerlProcPopen,
- PerlProcPclose,
- PerlProcPipe,
- PerlProcSetuid,
- PerlProcSetgid,
- PerlProcSleep,
- PerlProcTimes,
- PerlProcWait,
- PerlProcWaitpid,
- PerlProcSignal,
- PerlProcDynaLoader,
- PerlProcGetOSError,
- PerlProcDoCmd,
- PerlProcSpawn,
- PerlProcSpawnvp,
- PerlProcASpawn,
-};
-
-/*#include "perlhost.h" */
+#include "perlhost.h"
EXTERN_C void
perl_get_host_info(struct IPerlMemInfo* perlMemInfo,
+ struct IPerlMemInfo* perlMemSharedInfo,
+ struct IPerlMemInfo* perlMemParseInfo,
struct IPerlEnvInfo* perlEnvInfo,
struct IPerlStdIOInfo* perlStdIOInfo,
struct IPerlLIOInfo* perlLIOInfo,
@@ -1320,31 +49,39 @@ perl_get_host_info(struct IPerlMemInfo* perlMemInfo,
struct IPerlSockInfo* perlSockInfo,
struct IPerlProcInfo* perlProcInfo)
{
- if(perlMemInfo) {
+ if (perlMemInfo) {
Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*);
perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
}
- if(perlEnvInfo) {
+ if (perlMemSharedInfo) {
+ Copy(&perlMem, &perlMemSharedInfo->perlMemList, perlMemSharedInfo->nCount, void*);
+ perlMemSharedInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
+ }
+ if (perlMemParseInfo) {
+ Copy(&perlMem, &perlMemParseInfo->perlMemList, perlMemParseInfo->nCount, void*);
+ perlMemParseInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
+ }
+ if (perlEnvInfo) {
Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*);
perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*));
}
- if(perlStdIOInfo) {
+ if (perlStdIOInfo) {
Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*);
perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*));
}
- if(perlLIOInfo) {
+ if (perlLIOInfo) {
Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*);
perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*));
}
- if(perlDirInfo) {
+ if (perlDirInfo) {
Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*);
perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*));
}
- if(perlSockInfo) {
+ if (perlSockInfo) {
Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*);
perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*));
}
- if(perlProcInfo) {
+ if (perlProcInfo) {
Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*);
perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*));
}
@@ -1352,142 +89,173 @@ perl_get_host_info(struct IPerlMemInfo* perlMemInfo,
#ifdef PERL_OBJECT
-EXTERN_C PerlInterpreter* perl_alloc_using(struct IPerlMem* pMem,
- struct IPerlEnv* pEnv, struct IPerlStdIO* pStdIO,
- struct IPerlLIO* pLIO, struct IPerlDir* pDir,
- struct IPerlSock* pSock, struct IPerlProc* pProc)
+EXTERN_C PerlInterpreter*
+perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
+ struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
+ struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
+ struct IPerlDir** ppDir, struct IPerlSock** ppSock,
+ struct IPerlProc** ppProc)
{
- CPerlObj* pPerl = NULL;
+ PerlInterpreter *my_perl = NULL;
try
{
- pPerl = Perl_alloc(pMem, pEnv, pStdIO, pLIO, pDir, pSock, pProc);
+ CPerlHost* pHost = new CPerlHost(ppMem, ppMemShared, ppMemParse, ppEnv,
+ ppStdIO, ppLIO, ppDir, ppSock, ppProc);
+
+ if (pHost) {
+ my_perl = perl_alloc_using(pHost->m_pHostperlMem,
+ pHost->m_pHostperlMemShared,
+ pHost->m_pHostperlMemParse,
+ pHost->m_pHostperlEnv,
+ pHost->m_pHostperlStdIO,
+ pHost->m_pHostperlLIO,
+ pHost->m_pHostperlDir,
+ pHost->m_pHostperlSock,
+ pHost->m_pHostperlProc);
+ if (my_perl) {
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+ w32_internal_host = pHost;
+ }
+ }
}
catch(...)
{
win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
- pPerl = NULL;
- }
- if(pPerl)
- {
- SetPerlInterpreter(pPerl);
- return (PerlInterpreter*)pPerl;
+ my_perl = NULL;
}
- SetPerlInterpreter(NULL);
- return NULL;
+
+ return my_perl;
}
-#undef perl_alloc
-#undef perl_construct
-#undef perl_destruct
-#undef perl_free
-#undef perl_run
-#undef perl_parse
-EXTERN_C PerlInterpreter* perl_alloc(void)
+EXTERN_C PerlInterpreter*
+perl_alloc(void)
{
- CPerlObj* pPerl = NULL;
+ PerlInterpreter* my_perl = NULL;
try
{
- pPerl = Perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
- &perlDir, &perlSock, &perlProc);
+ CPerlHost* pHost = new CPerlHost();
+ if (pHost) {
+ my_perl = perl_alloc_using(pHost->m_pHostperlMem,
+ pHost->m_pHostperlMemShared,
+ pHost->m_pHostperlMemParse,
+ pHost->m_pHostperlEnv,
+ pHost->m_pHostperlStdIO,
+ pHost->m_pHostperlLIO,
+ pHost->m_pHostperlDir,
+ pHost->m_pHostperlSock,
+ pHost->m_pHostperlProc);
+ if (my_perl) {
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+ w32_internal_host = pHost;
+ }
+ }
}
catch(...)
{
win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
- pPerl = NULL;
- }
- if(pPerl)
- {
- SetPerlInterpreter(pPerl);
- return (PerlInterpreter*)pPerl;
+ my_perl = NULL;
}
- SetPerlInterpreter(NULL);
- return NULL;
+
+ return my_perl;
}
-EXTERN_C void perl_construct(PerlInterpreter* sv_interp)
+EXTERN_C void
+perl_construct(PerlInterpreter* my_perl)
{
- CPerlObj* pPerl = (CPerlObj*)sv_interp;
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
try
{
- pPerl->perl_construct();
+ Perl_construct();
}
catch(...)
{
win32_fprintf(stderr, "%s\n",
"Error: Unable to construct data structures");
- pPerl->perl_free();
+ CPerlHost* pHost = (CPerlHost*)w32_internal_host;
+ Perl_free();
+ delete pHost;
SetPerlInterpreter(NULL);
}
}
-EXTERN_C void perl_destruct(PerlInterpreter* sv_interp)
+EXTERN_C void
+perl_destruct(PerlInterpreter* my_perl)
{
- CPerlObj* pPerl = (CPerlObj*)sv_interp;
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+#ifdef DEBUGGING
+ Perl_destruct();
+#else
try
{
- pPerl->perl_destruct();
+ Perl_destruct();
}
catch(...)
{
}
+#endif
}
-EXTERN_C void perl_free(PerlInterpreter* sv_interp)
+EXTERN_C void
+perl_free(PerlInterpreter* my_perl)
{
- CPerlObj* pPerl = (CPerlObj*)sv_interp;
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+#ifdef DEBUGGING
+ CPerlHost* pHost = (CPerlHost*)w32_internal_host;
+ Perl_free();
+ delete pHost;
+#else
try
{
- pPerl->perl_free();
+ CPerlHost* pHost = (CPerlHost*)w32_internal_host;
+ Perl_free();
+ delete pHost;
}
catch(...)
{
}
+#endif
SetPerlInterpreter(NULL);
}
-EXTERN_C int perl_run(PerlInterpreter* sv_interp)
+EXTERN_C int
+perl_run(PerlInterpreter* my_perl)
{
- CPerlObj* pPerl = (CPerlObj*)sv_interp;
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+#ifdef DEBUGGING
+ return Perl_run();
+#else
int retVal;
try
{
- retVal = pPerl->perl_run();
+ retVal = 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;
+#endif
}
-EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
+EXTERN_C int
+perl_parse(PerlInterpreter* my_perl, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
{
int retVal;
- CPerlObj* pPerl = (CPerlObj*)sv_interp;
+ CPerlObj* pPerl = (CPerlObj*)my_perl;
+#ifdef DEBUGGING
+ retVal = Perl_parse(xsinit, argc, argv, env);
+#else
try
{
- retVal = pPerl->perl_parse(xsinit, argc, argv, env);
+ retVal = Perl_parse(xsinit, argc, argv, env);
}
-/*
- catch(int x)
- {
- // this is where exit() should arrive
- retVal = x;
- }
-*/
catch(...)
{
win32_fprintf(stderr, "Error: Parse exception\n");
retVal = -1;
}
+#endif
*win32_errno() = 0;
return retVal;
}
@@ -1500,15 +268,30 @@ EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), i
EXTERN_C PerlInterpreter*
perl_alloc(void)
{
- return perl_alloc_using(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
- &perlDir, &perlSock, &perlProc);
+ PerlInterpreter *my_perl = NULL;
+ CPerlHost* pHost = new CPerlHost();
+ if (pHost) {
+ my_perl = perl_alloc_using(pHost->m_pHostperlMem,
+ pHost->m_pHostperlMemShared,
+ pHost->m_pHostperlMemParse,
+ pHost->m_pHostperlEnv,
+ pHost->m_pHostperlStdIO,
+ pHost->m_pHostperlLIO,
+ pHost->m_pHostperlDir,
+ pHost->m_pHostperlSock,
+ pHost->m_pHostperlProc);
+ if (my_perl) {
+ w32_internal_host = pHost;
+ }
+ }
+ return my_perl;
}
#endif /* PERL_OBJECT */
-
#endif /* PERL_IMPLICIT_SYS */
-extern HANDLE w32_perldll_handle;
+EXTERN_C HANDLE w32_perldll_handle;
+
static DWORD g_TlsAllocIndex;
EXTERN_C DllExport bool
@@ -1563,9 +346,24 @@ RunPerl(int argc, char **argv, char **env)
exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
if (!exitstatus) {
-#ifdef USE_ITHREADS /* XXXXXX testing */
- new_perl = perl_clone(my_perl, 0);
- Perl_push_scope(new_perl); /* ENTER; (hack in lieu of perl_destruct()) */
+#if defined(TOP_CLONE) && defined(USE_ITHREADS) /* XXXXXX testing */
+# ifdef PERL_OBJECT
+ CPerlHost *h = new CPerlHost();
+ new_perl = perl_clone_using(my_perl, 1,
+ h->m_pHostperlMem,
+ h->m_pHostperlMemShared,
+ h->m_pHostperlMemParse,
+ h->m_pHostperlEnv,
+ h->m_pHostperlStdIO,
+ h->m_pHostperlLIO,
+ h->m_pHostperlDir,
+ h->m_pHostperlSock,
+ h->m_pHostperlProc
+ );
+ CPerlObj *pPerl = (CPerlObj*)new_perl;
+# else
+ new_perl = perl_clone(my_perl, 1);
+# endif
exitstatus = perl_run( new_perl );
SetPerlInterpreter(my_perl);
#else
@@ -1606,7 +404,7 @@ DllMain(HANDLE hModule, /* DLL module handle */
_fmode = O_BINARY;
#endif
g_TlsAllocIndex = TlsAlloc();
- DisableThreadLibraryCalls(hModule);
+ DisableThreadLibraryCalls((HMODULE)hModule);
w32_perldll_handle = hModule;
break;
@@ -1630,4 +428,3 @@ DllMain(HANDLE hModule, /* DLL module handle */
}
return TRUE;
}
-
diff --git a/win32/runperl.c b/win32/runperl.c
index 8e6b249b44..85fd831759 100644
--- a/win32/runperl.c
+++ b/win32/runperl.c
@@ -2,10 +2,6 @@
#include "perl.h"
#ifdef __GNUC__
-/*
- * GNU C does not do __declspec()
- */
-#define __declspec(foo)
/* Mingw32 defaults to globing command line
* This is inconsistent with other Win32 ports and
diff --git a/win32/vdir.h b/win32/vdir.h
new file mode 100644
index 0000000000..50822a7aa4
--- /dev/null
+++ b/win32/vdir.h
@@ -0,0 +1,505 @@
+/* vdir.h
+ *
+ * (c) 1999 Microsoft Corporation. All rights reserved.
+ * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ */
+
+#ifndef ___VDir_H___
+#define ___VDir_H___
+
+const int driveCount = 30;
+
+class VDir
+{
+public:
+ VDir(int bManageDir = 1);
+ ~VDir() {};
+
+ void Init(VDir* pDir, VMem *pMem);
+ void SetDefaultA(char const *pDefault);
+ void SetDefaultW(WCHAR const *pDefault);
+ char* MapPathA(const char *pInName);
+ WCHAR* MapPathW(const WCHAR *pInName);
+ int SetCurrentDirectoryA(char *lpBuffer);
+ int SetCurrentDirectoryW(WCHAR *lpBuffer);
+ inline const char *GetDirA(int index)
+ {
+ return dirTableA[index];
+ };
+ inline const WCHAR *GetDirW(int index)
+ {
+ return dirTableW[index];
+ };
+ inline int GetDefault(void) { return nDefault; };
+
+ inline char* GetCurrentDirectoryA(int dwBufSize, char *lpBuffer)
+ {
+ char* ptr = dirTableA[nDefault];
+ while (dwBufSize--)
+ {
+ if ((*lpBuffer++ = *ptr++) == '\0')
+ break;
+ }
+ return lpBuffer;
+ };
+ inline WCHAR* GetCurrentDirectoryW(int dwBufSize, WCHAR *lpBuffer)
+ {
+ WCHAR* ptr = dirTableW[nDefault];
+ while (dwBufSize--)
+ {
+ if ((*lpBuffer++ = *ptr++) == '\0')
+ break;
+ }
+ return lpBuffer;
+ };
+
+
+ DWORD CalculateEnvironmentSpace(void);
+ LPSTR BuildEnvironmentSpace(LPSTR lpStr);
+
+protected:
+ int SetDirA(char const *pPath, int index);
+ void FromEnvA(char *pEnv, int index);
+ inline const char *GetDefaultDirA(void)
+ {
+ return dirTableA[nDefault];
+ };
+
+ inline void SetDefaultDirA(char const *pPath, int index)
+ {
+ SetDirA(pPath, index);
+ nDefault = index;
+ };
+ int SetDirW(WCHAR const *pPath, int index);
+ inline const WCHAR *GetDefaultDirW(void)
+ {
+ return dirTableW[nDefault];
+ };
+
+ inline void SetDefaultDirW(WCHAR const *pPath, int index)
+ {
+ SetDirW(pPath, index);
+ nDefault = index;
+ };
+
+ inline int DriveIndex(char chr)
+ {
+ return (chr | 0x20)-'a';
+ };
+
+ VMem *pMem;
+ int nDefault, bManageDirectory;
+ char *dirTableA[driveCount];
+ char szLocalBufferA[MAX_PATH+1];
+ WCHAR *dirTableW[driveCount];
+ WCHAR szLocalBufferW[MAX_PATH+1];
+};
+
+
+VDir::VDir(int bManageDir /* = 1 */)
+{
+ nDefault = 0;
+ bManageDirectory = bManageDir;
+ memset(dirTableA, 0, sizeof(dirTableA));
+ memset(dirTableW, 0, sizeof(dirTableW));
+}
+
+void VDir::Init(VDir* pDir, VMem *p)
+{
+ int index;
+ DWORD driveBits;
+ int nSave;
+ char szBuffer[MAX_PATH*driveCount];
+
+ pMem = p;
+ if (pDir) {
+ for (index = 0; index < driveCount; ++index) {
+ SetDirW(pDir->GetDirW(index), index);
+ }
+ nDefault = pDir->GetDefault();
+ }
+ else {
+ nSave = bManageDirectory;
+ bManageDirectory = 0;
+ driveBits = GetLogicalDrives();
+ if (GetLogicalDriveStrings(sizeof(szBuffer), szBuffer)) {
+ char* pEnv = GetEnvironmentStrings();
+ char* ptr = szBuffer;
+ for (index = 0; index < driveCount; ++index) {
+ if (driveBits & (1<<index)) {
+ ptr += SetDirA(ptr, index) + 1;
+ FromEnvA(pEnv, index);
+ }
+ }
+ FreeEnvironmentStrings(pEnv);
+ }
+ SetDefaultA(".");
+ bManageDirectory = nSave;
+ }
+}
+
+int VDir::SetDirA(char const *pPath, int index)
+{
+ char chr, *ptr;
+ int length = 0;
+ WCHAR wBuffer[MAX_PATH+1];
+ if (index < driveCount && pPath != NULL) {
+ length = strlen(pPath);
+ pMem->Free(dirTableA[index]);
+ ptr = dirTableA[index] = (char*)pMem->Malloc(length+2);
+ if (ptr != NULL) {
+ strcpy(ptr, pPath);
+ ptr += length-1;
+ chr = *ptr++;
+ if (chr != '\\' && chr != '/') {
+ *ptr++ = '\\';
+ *ptr = '\0';
+ }
+ MultiByteToWideChar(CP_ACP, 0, dirTableA[index], -1,
+ wBuffer, (sizeof(wBuffer)/sizeof(WCHAR)));
+ length = wcslen(wBuffer);
+ pMem->Free(dirTableW[index]);
+ dirTableW[index] = (WCHAR*)pMem->Malloc((length+1)*2);
+ if (dirTableW[index] != NULL) {
+ wcscpy(dirTableW[index], wBuffer);
+ }
+ }
+ }
+
+ if(bManageDirectory)
+ ::SetCurrentDirectoryA(pPath);
+
+ return length;
+}
+
+void VDir::FromEnvA(char *pEnv, int index)
+{ /* gets the directory for index from the environment variable. */
+ while (*pEnv != '\0') {
+ if ((pEnv[0] == '=') && (DriveIndex(pEnv[1]) == index)) {
+ SetDirA(&pEnv[4], index);
+ break;
+ }
+ else
+ pEnv += strlen(pEnv)+1;
+ }
+}
+
+void VDir::SetDefaultA(char const *pDefault)
+{
+ char szBuffer[MAX_PATH+1];
+ char *pPtr;
+
+ if (GetFullPathNameA(pDefault, sizeof(szBuffer), szBuffer, &pPtr)) {
+ if (*pDefault != '.' && pPtr != NULL)
+ *pPtr = '\0';
+
+ SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0]));
+ }
+}
+
+int VDir::SetDirW(WCHAR const *pPath, int index)
+{
+ WCHAR chr, *ptr;
+ char szBuffer[MAX_PATH+1];
+ int length = 0;
+ if (index < driveCount && pPath != NULL) {
+ length = wcslen(pPath);
+ pMem->Free(dirTableW[index]);
+ ptr = dirTableW[index] = (WCHAR*)pMem->Malloc((length+2)*2);
+ if (ptr != NULL) {
+ wcscpy(ptr, pPath);
+ ptr += length-1;
+ chr = *ptr++;
+ if (chr != '\\' && chr != '/') {
+ *ptr++ = '\\';
+ *ptr = '\0';
+ }
+ WideCharToMultiByte(CP_ACP, 0, dirTableW[index], -1, szBuffer, sizeof(szBuffer), NULL, NULL);
+ length = strlen(szBuffer);
+ pMem->Free(dirTableA[index]);
+ dirTableA[index] = (char*)pMem->Malloc(length+1);
+ if (dirTableA[index] != NULL) {
+ strcpy(dirTableA[index], szBuffer);
+ }
+ }
+ }
+
+ if(bManageDirectory)
+ ::SetCurrentDirectoryW(pPath);
+
+ return length;
+}
+
+void VDir::SetDefaultW(WCHAR const *pDefault)
+{
+ WCHAR szBuffer[MAX_PATH+1];
+ WCHAR *pPtr;
+
+ if (GetFullPathNameW(pDefault, (sizeof(szBuffer)/sizeof(WCHAR)), szBuffer, &pPtr)) {
+ if (*pDefault != '.' && pPtr != NULL)
+ *pPtr = '\0';
+
+ SetDefaultDirW(szBuffer, DriveIndex((char)szBuffer[0]));
+ }
+}
+
+inline BOOL IsPathSep(char ch)
+{
+ return (ch == '\\' || ch == '/');
+}
+
+inline void DoGetFullPathNameA(char* lpBuffer, DWORD dwSize, char* Dest)
+{
+ char *pPtr;
+
+ /*
+ * On WinNT GetFullPathName does not fail, (or at least always
+ * succeeds when the drive is valid) WinNT does set *Dest to Nullch
+ * On Win98 GetFullPathName will set last error if it fails, but
+ * does not touch *Dest
+ */
+ *Dest = '\0';
+ GetFullPathNameA(lpBuffer, dwSize, Dest, &pPtr);
+}
+
+char *VDir::MapPathA(const char *pInName)
+{ /*
+ * possiblities -- relative path or absolute path with or without drive letter
+ * OR UNC name
+ */
+ char szBuffer[(MAX_PATH+1)*2];
+ char szlBuf[MAX_PATH+1];
+
+ if (strlen(pInName) > MAX_PATH) {
+ strncpy(szlBuf, pInName, MAX_PATH);
+ if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) {
+ /* absolute path - reduce length by 2 for drive specifier */
+ szlBuf[MAX_PATH-2] = '\0';
+ }
+ else
+ szlBuf[MAX_PATH] = '\0';
+ pInName = szlBuf;
+ }
+ /* strlen(pInName) is now <= MAX_PATH */
+
+ if (pInName[1] == ':') {
+ /* has drive letter */
+ if (IsPathSep(pInName[2])) {
+ /* absolute with drive letter */
+ strcpy(szLocalBufferA, pInName);
+ }
+ else {
+ /* relative path with drive letter */
+ strcpy(szBuffer, GetDirA(DriveIndex(*pInName)));
+ strcat(szBuffer, &pInName[2]);
+ if(strlen(szBuffer) > MAX_PATH)
+ szBuffer[MAX_PATH] = '\0';
+
+ DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA);
+ }
+ }
+ else {
+ /* no drive letter */
+ if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
+ /* UNC name */
+ strcpy(szLocalBufferA, pInName);
+ }
+ else {
+ strcpy(szBuffer, GetDefaultDirA());
+ if (IsPathSep(pInName[0])) {
+ /* absolute path */
+ szLocalBufferA[0] = szBuffer[0];
+ szLocalBufferA[1] = szBuffer[1];
+ strcpy(&szLocalBufferA[2], pInName);
+ }
+ else {
+ /* relative path */
+ strcat(szBuffer, pInName);
+ if (strlen(szBuffer) > MAX_PATH)
+ szBuffer[MAX_PATH] = '\0';
+
+ DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA);
+ }
+ }
+ }
+
+ return szLocalBufferA;
+}
+
+int VDir::SetCurrentDirectoryA(char *lpBuffer)
+{
+ HANDLE hHandle;
+ WIN32_FIND_DATA win32FD;
+ char szBuffer[MAX_PATH+1], *pPtr;
+ int length, nRet = -1;
+
+ GetFullPathNameA(MapPathA(lpBuffer), sizeof(szBuffer), szBuffer, &pPtr);
+ /* if the last char is a '\\' or a '/' then add
+ * an '*' before calling FindFirstFile
+ */
+ length = strlen(szBuffer);
+ if(length > 0 && IsPathSep(szBuffer[length-1])) {
+ szBuffer[length] = '*';
+ szBuffer[length+1] = '\0';
+ }
+
+ hHandle = FindFirstFileA(szBuffer, &win32FD);
+ if (hHandle != INVALID_HANDLE_VALUE) {
+ FindClose(hHandle);
+
+ /* if an '*' was added remove it */
+ if(szBuffer[length] == '*')
+ szBuffer[length] = '\0';
+
+ SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0]));
+ nRet = 0;
+ }
+ return nRet;
+}
+
+DWORD VDir::CalculateEnvironmentSpace(void)
+{ /* the current directory environment strings are stored as '=d=d:\path' */
+ int index;
+ DWORD dwSize = 0;
+ for (index = 0; index < driveCount; ++index) {
+ if (dirTableA[index] != NULL) {
+ dwSize += strlen(dirTableA[index]) + 4; /* add 1 for trailing NULL and 3 for '=d=' */
+ }
+ }
+ return dwSize;
+}
+
+LPSTR VDir::BuildEnvironmentSpace(LPSTR lpStr)
+{ /* store the current directory environment strings as '=d=d:\path' */
+ int index;
+ LPSTR lpDirStr;
+ for (index = 0; index < driveCount; ++index) {
+ lpDirStr = dirTableA[index];
+ if (lpDirStr != NULL) {
+ lpStr[0] = '=';
+ lpStr[1] = lpDirStr[0];
+ lpStr[2] = '=';
+ strcpy(&lpStr[3], lpDirStr);
+ lpStr += strlen(lpDirStr) + 4; /* add 1 for trailing NULL and 3 for '=d=' */
+ }
+ }
+ return lpStr;
+}
+
+inline BOOL IsPathSep(WCHAR ch)
+{
+ return (ch == '\\' || ch == '/');
+}
+
+inline void DoGetFullPathNameW(WCHAR* lpBuffer, DWORD dwSize, WCHAR* Dest)
+{
+ WCHAR *pPtr;
+
+ /*
+ * On WinNT GetFullPathName does not fail, (or at least always
+ * succeeds when the drive is valid) WinNT does set *Dest to Nullch
+ * On Win98 GetFullPathName will set last error if it fails, but
+ * does not touch *Dest
+ */
+ *Dest = '\0';
+ GetFullPathNameW(lpBuffer, dwSize, Dest, &pPtr);
+}
+
+WCHAR* VDir::MapPathW(const WCHAR *pInName)
+{ /*
+ * possiblities -- relative path or absolute path with or without drive letter
+ * OR UNC name
+ */
+ WCHAR szBuffer[(MAX_PATH+1)*2];
+ WCHAR szlBuf[MAX_PATH+1];
+
+ if (wcslen(pInName) > MAX_PATH) {
+ wcsncpy(szlBuf, pInName, MAX_PATH);
+ if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) {
+ /* absolute path - reduce length by 2 for drive specifier */
+ szlBuf[MAX_PATH-2] = '\0';
+ }
+ else
+ szlBuf[MAX_PATH] = '\0';
+ pInName = szlBuf;
+ }
+ /* strlen(pInName) is now <= MAX_PATH */
+
+ if (pInName[1] == ':') {
+ /* has drive letter */
+ if (IsPathSep(pInName[2])) {
+ /* absolute with drive letter */
+ wcscpy(szLocalBufferW, pInName);
+ }
+ else {
+ /* relative path with drive letter */
+ wcscpy(szBuffer, GetDirW(DriveIndex((char)*pInName)));
+ wcscat(szBuffer, &pInName[2]);
+ if(wcslen(szBuffer) > MAX_PATH)
+ szBuffer[MAX_PATH] = '\0';
+
+ DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
+ }
+ }
+ else {
+ /* no drive letter */
+ if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
+ /* UNC name */
+ wcscpy(szLocalBufferW, pInName);
+ }
+ else {
+ wcscpy(szBuffer, GetDefaultDirW());
+ if (IsPathSep(pInName[0])) {
+ /* absolute path */
+ szLocalBufferW[0] = szBuffer[0];
+ szLocalBufferW[1] = szBuffer[1];
+ wcscpy(&szLocalBufferW[2], pInName);
+ }
+ else {
+ /* relative path */
+ wcscat(szBuffer, pInName);
+ if (wcslen(szBuffer) > MAX_PATH)
+ szBuffer[MAX_PATH] = '\0';
+
+ DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
+ }
+ }
+ }
+ return szLocalBufferW;
+}
+
+int VDir::SetCurrentDirectoryW(WCHAR *lpBuffer)
+{
+ HANDLE hHandle;
+ WIN32_FIND_DATAW win32FD;
+ WCHAR szBuffer[MAX_PATH+1], *pPtr;
+ int length, nRet = -1;
+
+ GetFullPathNameW(MapPathW(lpBuffer), (sizeof(szBuffer)/sizeof(WCHAR)), szBuffer, &pPtr);
+ /* if the last char is a '\\' or a '/' then add
+ * an '*' before calling FindFirstFile
+ */
+ length = wcslen(szBuffer);
+ if(length > 0 && IsPathSep(szBuffer[length-1])) {
+ szBuffer[length] = '*';
+ szBuffer[length+1] = '\0';
+ }
+
+ hHandle = FindFirstFileW(szBuffer, &win32FD);
+ if (hHandle != INVALID_HANDLE_VALUE) {
+ FindClose(hHandle);
+
+ /* if an '*' was added remove it */
+ if(szBuffer[length] == '*')
+ szBuffer[length] = '\0';
+
+ SetDefaultDirW(szBuffer, DriveIndex((char)szBuffer[0]));
+ nRet = 0;
+ }
+ return nRet;
+}
+
+#endif /* ___VDir_H___ */
diff --git a/win32/vmem.h b/win32/vmem.h
new file mode 100644
index 0000000000..cf3f502ca0
--- /dev/null
+++ b/win32/vmem.h
@@ -0,0 +1,703 @@
+/* vmem.h
+ *
+ * (c) 1999 Microsoft Corporation. All rights reserved.
+ * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ *
+ * Knuth's boundary tag algorithm Vol #1, Page 440.
+ *
+ * Each block in the heap has tag words before and after it,
+ * TAG
+ * block
+ * TAG
+ * The size is stored in these tags as a long word, and includes the 8 bytes
+ * of overhead that the boundary tags consume. Blocks are allocated on long
+ * word boundaries, so the size is always multiples of long words. When the
+ * block is allocated, bit 0, (the tag bit), of the size is set to 1. When
+ * a block is freed, it is merged with adjacent free blocks, and the tag bit
+ * is set to 0.
+ *
+ * A linked list is used to manage the free list. The first two long words of
+ * the block contain double links. These links are only valid when the block
+ * is freed, therefore space needs to be reserved for them. Thus, the minimum
+ * block size (not counting the tags) is 8 bytes.
+ *
+ * Since memory allocation may occur on a single threaded, explict locks are
+ * provided.
+ *
+ */
+
+#ifndef ___VMEM_H_INC___
+#define ___VMEM_H_INC___
+
+const long lAllocStart = 0x00010000; /* start at 64K */
+const long minBlockSize = sizeof(void*)*2;
+const long sizeofTag = sizeof(long);
+const long blockOverhead = sizeofTag*2;
+const long minAllocSize = minBlockSize+blockOverhead;
+
+typedef BYTE* PBLOCK; /* pointer to a memory block */
+
+/*
+ * Macros for accessing hidden fields in a memory block:
+ *
+ * SIZE size of this block (tag bit 0 is 1 if block is allocated)
+ * PSIZE size of previous physical block
+ */
+
+#define SIZE(block) (*(ULONG*)(((PBLOCK)(block))-sizeofTag))
+#define PSIZE(block) (*(ULONG*)(((PBLOCK)(block))-(sizeofTag*2)))
+inline void SetTags(PBLOCK block, long size)
+{
+ SIZE(block) = size;
+ PSIZE(block+(size&~1)) = size;
+}
+
+/*
+ * Free list pointers
+ * PREV pointer to previous block
+ * NEXT pointer to next block
+ */
+
+#define PREV(block) (*(PBLOCK*)(block))
+#define NEXT(block) (*(PBLOCK*)((block)+sizeof(PBLOCK)))
+inline void SetLink(PBLOCK block, PBLOCK prev, PBLOCK next)
+{
+ PREV(block) = prev;
+ NEXT(block) = next;
+}
+inline void Unlink(PBLOCK p)
+{
+ PBLOCK next = NEXT(p);
+ PBLOCK prev = PREV(p);
+ NEXT(prev) = next;
+ PREV(next) = prev;
+}
+inline void AddToFreeList(PBLOCK block, PBLOCK pInList)
+{
+ PBLOCK next = NEXT(pInList);
+ NEXT(pInList) = block;
+ SetLink(block, pInList, next);
+ PREV(next) = block;
+}
+
+
+/* Macro for rounding up to the next sizeof(long) */
+#define ROUND_UP(n) (((ULONG)(n)+sizeof(long)-1)&~(sizeof(long)-1))
+#define ROUND_UP64K(n) (((ULONG)(n)+0x10000-1)&~(0x10000-1))
+#define ROUND_DOWN(n) ((ULONG)(n)&~(sizeof(long)-1))
+
+/*
+ * HeapRec - a list of all non-contiguous heap areas
+ *
+ * Each record in this array contains information about a non-contiguous heap area.
+ */
+
+const int maxHeaps = 64;
+const long lAllocMax = 0x80000000; /* max size of allocation */
+
+typedef struct _HeapRec
+{
+ PBLOCK base; /* base of heap area */
+ ULONG len; /* size of heap area */
+} HeapRec;
+
+
+class VMem
+{
+public:
+ VMem();
+ ~VMem();
+ virtual void* Malloc(size_t size);
+ virtual void* Realloc(void* pMem, size_t size);
+ virtual void Free(void* pMem);
+ virtual void GetLock(void);
+ virtual void FreeLock(void);
+ virtual int IsLocked(void);
+ virtual long Release(void);
+ virtual long AddRef(void);
+
+ inline BOOL CreateOk(void)
+ {
+ return m_hHeap != NULL;
+ };
+
+ void ReInit(void);
+
+protected:
+ void Init(void);
+ int Getmem(size_t size);
+ int HeapAdd(void* ptr, size_t size);
+ void* Expand(void* block, size_t size);
+ void WalkHeap(void);
+
+ HANDLE m_hHeap; // memory heap for this script
+ char m_FreeDummy[minAllocSize]; // dummy free block
+ PBLOCK m_pFreeList; // pointer to first block on free list
+ PBLOCK m_pRover; // roving pointer into the free list
+ HeapRec m_heaps[maxHeaps]; // list of all non-contiguous heap areas
+ int m_nHeaps; // no. of heaps in m_heaps
+ long m_lAllocSize; // current alloc size
+ long m_lRefCount; // number of current users
+ CRITICAL_SECTION m_cs; // access lock
+};
+
+// #define _DEBUG_MEM
+#ifdef _DEBUG_MEM
+#define ASSERT(f) if(!(f)) DebugBreak();
+
+inline void MEMODS(char *str)
+{
+ OutputDebugString(str);
+ OutputDebugString("\n");
+}
+
+inline void MEMODSlx(char *str, long x)
+{
+ char szBuffer[512];
+ sprintf(szBuffer, "%s %lx\n", str, x);
+ OutputDebugString(szBuffer);
+}
+
+#define WALKHEAP() WalkHeap()
+#define WALKHEAPTRACE() m_pRover = NULL; WalkHeap()
+
+#else
+
+#define ASSERT(f)
+#define MEMODS(x)
+#define MEMODSlx(x, y)
+#define WALKHEAP()
+#define WALKHEAPTRACE()
+
+#endif
+
+
+VMem::VMem()
+{
+ m_lRefCount = 1;
+ BOOL bRet = (NULL != (m_hHeap = HeapCreate(HEAP_NO_SERIALIZE,
+ lAllocStart, /* initial size of heap */
+ 0))); /* no upper limit on size of heap */
+ ASSERT(bRet);
+
+ InitializeCriticalSection(&m_cs);
+
+ Init();
+}
+
+VMem::~VMem(void)
+{
+ ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, NULL));
+ WALKHEAPTRACE();
+ DeleteCriticalSection(&m_cs);
+ BOOL bRet = HeapDestroy(m_hHeap);
+ ASSERT(bRet);
+}
+
+void VMem::ReInit(void)
+{
+ for(int index = 0; index < m_nHeaps; ++index)
+ HeapFree(m_hHeap, HEAP_NO_SERIALIZE, m_heaps[index].base);
+
+ Init();
+}
+
+void VMem::Init(void)
+{ /*
+ * Initialize the free list by placing a dummy zero-length block on it.
+ * Set the number of non-contiguous heaps to zero.
+ */
+ m_pFreeList = m_pRover = (PBLOCK)(&m_FreeDummy[minBlockSize]);
+ PSIZE(m_pFreeList) = SIZE(m_pFreeList) = 0;
+ PREV(m_pFreeList) = NEXT(m_pFreeList) = m_pFreeList;
+
+ m_nHeaps = 0;
+ m_lAllocSize = lAllocStart;
+}
+
+void* VMem::Malloc(size_t size)
+{
+ WALKHEAP();
+
+ /*
+ * Adjust the real size of the block to be a multiple of sizeof(long), and add
+ * the overhead for the boundary tags. Disallow negative or zero sizes.
+ */
+ size_t realsize = (size < blockOverhead) ? minAllocSize : (size_t)ROUND_UP(size) + minBlockSize;
+ if((int)realsize < minAllocSize || size == 0)
+ return NULL;
+
+ /*
+ * Start searching the free list at the rover. If we arrive back at rover without
+ * finding anything, allocate some memory from the heap and try again.
+ */
+ PBLOCK ptr = m_pRover; /* start searching at rover */
+ int loops = 2; /* allow two times through the loop */
+ for(;;) {
+ size_t lsize = SIZE(ptr);
+ ASSERT((lsize&1)==0);
+ /* is block big enough? */
+ if(lsize >= realsize) {
+ /* if the remainder is too small, don't bother splitting the block. */
+ size_t rem = lsize - realsize;
+ if(rem < minAllocSize) {
+ if(m_pRover == ptr)
+ m_pRover = NEXT(ptr);
+
+ /* Unlink the block from the free list. */
+ Unlink(ptr);
+ }
+ else {
+ /*
+ * split the block
+ * The remainder is big enough to split off into a new block.
+ * Use the end of the block, resize the beginning of the block
+ * no need to change the free list.
+ */
+ SetTags(ptr, rem);
+ ptr += SIZE(ptr);
+ lsize = realsize;
+ }
+ /* Set the boundary tags to mark it as allocated. */
+ SetTags(ptr, lsize | 1);
+ return ((void *)ptr);
+ }
+
+ /*
+ * This block was unsuitable. If we've gone through this list once already without
+ * finding anything, allocate some new memory from the heap and try again.
+ */
+ ptr = NEXT(ptr);
+ if(ptr == m_pRover) {
+ if(!(loops-- && Getmem(realsize))) {
+ return NULL;
+ }
+ ptr = m_pRover;
+ }
+ }
+}
+
+void* VMem::Realloc(void* block, size_t size)
+{
+ WALKHEAP();
+
+ /* if size is zero, free the block. */
+ if(size == 0) {
+ Free(block);
+ return (NULL);
+ }
+
+ /* if block pointer is NULL, do a Malloc(). */
+ if(block == NULL)
+ return Malloc(size);
+
+ /*
+ * Grow or shrink the block in place.
+ * if the block grows then the next block will be used if free
+ */
+ if(Expand(block, size) != NULL)
+ return block;
+
+ /*
+ * adjust the real size of the block to be a multiple of sizeof(long), and add the
+ * overhead for the boundary tags. Disallow negative or zero sizes.
+ */
+ size_t realsize = (size < blockOverhead) ? minAllocSize : (size_t)ROUND_UP(size) + minBlockSize;
+ if((int)realsize < minAllocSize)
+ return NULL;
+
+ /*
+ * see if the previous block is free, and is it big enough to cover the new size
+ * if merged with the current block.
+ */
+ PBLOCK ptr = (PBLOCK)block;
+ size_t cursize = SIZE(ptr) & ~1;
+ size_t psize = PSIZE(ptr);
+ if((psize&1) == 0 && (psize + cursize) >= realsize) {
+ PBLOCK prev = ptr - psize;
+ if(m_pRover == prev)
+ m_pRover = NEXT(prev);
+
+ /* Unlink the next block from the free list. */
+ Unlink(prev);
+
+ /* Copy contents of old block to new location, make it the current block. */
+ memmove(prev, ptr, cursize);
+ cursize += psize; /* combine sizes */
+ ptr = prev;
+
+ size_t rem = cursize - realsize;
+ if(rem >= minAllocSize) {
+ /*
+ * The remainder is big enough to be a new block. Set boundary
+ * tags for the resized block and the new block.
+ */
+ prev = ptr + realsize;
+ /*
+ * add the new block to the free list.
+ * next block cannot be free
+ */
+ SetTags(prev, rem);
+ AddToFreeList(prev, m_pFreeList);
+ cursize = realsize;
+ }
+ /* Set the boundary tags to mark it as allocated. */
+ SetTags(ptr, cursize | 1);
+ return ((void *)ptr);
+ }
+
+ /* Allocate a new block, copy the old to the new, and free the old. */
+ if((ptr = (PBLOCK)Malloc(size)) != NULL) {
+ memmove(ptr, block, cursize-minBlockSize);
+ Free(block);
+ }
+ return ((void *)ptr);
+}
+
+void VMem::Free(void* p)
+{
+ WALKHEAP();
+
+ /* Ignore null pointer. */
+ if(p == NULL)
+ return;
+
+ PBLOCK ptr = (PBLOCK)p;
+
+ /* Check for attempt to free a block that's already free. */
+ size_t size = SIZE(ptr);
+ if((size&1) == 0) {
+ MEMODSlx("Attempt to free previously freed block", (long)p);
+ return;
+ }
+ size &= ~1; /* remove allocated tag */
+
+ /* if previous block is free, add this block to it. */
+ int linked = FALSE;
+ size_t psize = PSIZE(ptr);
+ if((psize&1) == 0) {
+ ptr -= psize; /* point to previous block */
+ size += psize; /* merge the sizes of the two blocks */
+ linked = TRUE; /* it's already on the free list */
+ }
+
+ /* if the next physical block is free, merge it with this block. */
+ PBLOCK next = ptr + size; /* point to next physical block */
+ size_t nsize = SIZE(next);
+ if((nsize&1) == 0) {
+ /* block is free move rover if needed */
+ if(m_pRover == next)
+ m_pRover = NEXT(next);
+
+ /* unlink the next block from the free list. */
+ Unlink(next);
+
+ /* merge the sizes of this block and the next block. */
+ size += nsize;
+ }
+
+ /* Set the boundary tags for the block; */
+ SetTags(ptr, size);
+
+ /* Link the block to the head of the free list. */
+ if(!linked) {
+ AddToFreeList(ptr, m_pFreeList);
+ }
+}
+
+void VMem::GetLock(void)
+{
+ EnterCriticalSection(&m_cs);
+}
+
+void VMem::FreeLock(void)
+{
+ LeaveCriticalSection(&m_cs);
+}
+
+int VMem::IsLocked(void)
+{
+ BOOL bAccessed = TryEnterCriticalSection(&m_cs);
+ if(bAccessed) {
+ LeaveCriticalSection(&m_cs);
+ }
+ return !bAccessed;
+}
+
+
+long VMem::Release(void)
+{
+ long lCount = InterlockedDecrement(&m_lRefCount);
+ if(!lCount)
+ delete this;
+ return lCount;
+}
+
+long VMem::AddRef(void)
+{
+ long lCount = InterlockedIncrement(&m_lRefCount);
+ return lCount;
+}
+
+
+int VMem::Getmem(size_t requestSize)
+{ /* returns -1 is successful 0 if not */
+ void *ptr;
+
+ /* Round up size to next multiple of 64K. */
+ size_t size = (size_t)ROUND_UP64K(requestSize);
+
+ /*
+ * if the size requested is smaller than our current allocation size
+ * adjust up
+ */
+ if(size < (unsigned long)m_lAllocSize)
+ size = m_lAllocSize;
+
+ /* Update the size to allocate on the next request */
+ if(m_lAllocSize != lAllocMax)
+ m_lAllocSize <<= 1;
+
+ if(m_nHeaps != 0) {
+ /* Expand the last allocated heap */
+ ptr = HeapReAlloc(m_hHeap, HEAP_REALLOC_IN_PLACE_ONLY|HEAP_ZERO_MEMORY|HEAP_NO_SERIALIZE,
+ m_heaps[m_nHeaps-1].base,
+ m_heaps[m_nHeaps-1].len + size);
+ if(ptr != 0) {
+ HeapAdd(((char*)ptr) + m_heaps[m_nHeaps-1].len, size);
+ return -1;
+ }
+ }
+
+ /*
+ * if we didn't expand a block to cover the requested size
+ * allocate a new Heap
+ * the size of this block must include the additional dummy tags at either end
+ * the above ROUND_UP64K may not have added any memory to include this.
+ */
+ if(size == requestSize)
+ size = (size_t)ROUND_UP64K(requestSize+(sizeofTag*2));
+
+ ptr = HeapAlloc(m_hHeap, HEAP_ZERO_MEMORY|HEAP_NO_SERIALIZE, size);
+ if(ptr == 0) {
+ MEMODSlx("HeapAlloc failed on size!!!", size);
+ return 0;
+ }
+
+ HeapAdd(ptr, size);
+ return -1;
+}
+
+int VMem::HeapAdd(void *p, size_t size)
+{ /* if the block can be succesfully added to the heap, returns 0; otherwise -1. */
+ int index;
+
+ /* Check size, then round size down to next long word boundary. */
+ if(size < minAllocSize)
+ return -1;
+
+ size = (size_t)ROUND_DOWN(size);
+ PBLOCK ptr = (PBLOCK)p;
+
+ /*
+ * Search for another heap area that's contiguous with the bottom of this new area.
+ * (It should be extremely unusual to find one that's contiguous with the top).
+ */
+ for(index = 0; index < m_nHeaps; ++index) {
+ if(ptr == m_heaps[index].base + (int)m_heaps[index].len) {
+ /*
+ * The new block is contiguous with a previously allocated heap area. Add its
+ * length to that of the previous heap. Merge it with the the dummy end-of-heap
+ * area marker of the previous heap.
+ */
+ m_heaps[index].len += size;
+ break;
+ }
+ }
+
+ if(index == m_nHeaps) {
+ /* The new block is not contiguous. Add it to the heap list. */
+ if(m_nHeaps == maxHeaps) {
+ return -1; /* too many non-contiguous heaps */
+ }
+ m_heaps[m_nHeaps].base = ptr;
+ m_heaps[m_nHeaps].len = size;
+ m_nHeaps++;
+
+ /*
+ * Reserve the first LONG in the block for the ending boundary tag of a dummy
+ * block at the start of the heap area.
+ */
+ size -= minBlockSize;
+ ptr += minBlockSize;
+ PSIZE(ptr) = 1; /* mark the dummy previous block as allocated */
+ }
+
+ /*
+ * Convert the heap to one large block. Set up its boundary tags, and those of
+ * marker block after it. The marker block before the heap will already have
+ * been set up if this heap is not contiguous with the end of another heap.
+ */
+ SetTags(ptr, size | 1);
+ PBLOCK next = ptr + size; /* point to dummy end block */
+ SIZE(next) = 1; /* mark the dummy end block as allocated */
+
+ /*
+ * Link the block to the start of the free list by calling free().
+ * This will merge the block with any adjacent free blocks.
+ */
+ Free(ptr);
+ return 0;
+}
+
+
+void* VMem::Expand(void* block, size_t size)
+{
+ /*
+ * Adjust the size of the block to be a multiple of sizeof(long), and add the
+ * overhead for the boundary tags. Disallow negative or zero sizes.
+ */
+ size_t realsize = (size < blockOverhead) ? minAllocSize : (size_t)ROUND_UP(size) + minBlockSize;
+ if((int)realsize < minAllocSize || size == 0)
+ return NULL;
+
+ PBLOCK ptr = (PBLOCK)block;
+
+ /* if the current size is the same as requested, do nothing. */
+ size_t cursize = SIZE(ptr) & ~1;
+ if(cursize == realsize) {
+ return block;
+ }
+
+ /* if the block is being shrunk, convert the remainder of the block into a new free block. */
+ if(realsize <= cursize) {
+ size_t nextsize = cursize - realsize; /* size of new remainder block */
+ if(nextsize >= minAllocSize) {
+ /*
+ * Split the block
+ * Set boundary tags for the resized block and the new block.
+ */
+ SetTags(ptr, realsize | 1);
+ ptr += realsize;
+
+ /*
+ * add the new block to the free list.
+ * call Free to merge this block with next block if free
+ */
+ SetTags(ptr, nextsize | 1);
+ Free(ptr);
+ }
+
+ return block;
+ }
+
+ PBLOCK next = ptr + cursize;
+ size_t nextsize = SIZE(next);
+
+ /* Check the next block for consistency.*/
+ if((nextsize&1) == 0 && (nextsize + cursize) >= realsize) {
+ /*
+ * The next block is free and big enough. Add the part that's needed
+ * to our block, and split the remainder off into a new block.
+ */
+ if(m_pRover == next)
+ m_pRover = NEXT(next);
+
+ /* Unlink the next block from the free list. */
+ Unlink(next);
+ cursize += nextsize; /* combine sizes */
+
+ size_t rem = cursize - realsize; /* size of remainder */
+ if(rem >= minAllocSize) {
+ /*
+ * The remainder is big enough to be a new block.
+ * Set boundary tags for the resized block and the new block.
+ */
+ next = ptr + realsize;
+ /*
+ * add the new block to the free list.
+ * next block cannot be free
+ */
+ SetTags(next, rem);
+ AddToFreeList(next, m_pFreeList);
+ cursize = realsize;
+ }
+ /* Set the boundary tags to mark it as allocated. */
+ SetTags(ptr, cursize | 1);
+ return ((void *)ptr);
+ }
+ return NULL;
+}
+
+#ifdef _DEBUG_MEM
+#define LOG_FILENAME "P:\\Apps\\Perl\\Result.txt"
+
+void MemoryUsageMessage(char *str, long x, long y, int c)
+{
+ static FILE* fp = NULL;
+ char szBuffer[512];
+ if(str) {
+ if(!fp)
+ fp = fopen(LOG_FILENAME, "w");
+ sprintf(szBuffer, str, x, y, c);
+ fputs(szBuffer, fp);
+ }
+ else {
+ fflush(fp);
+ fclose(fp);
+ }
+}
+
+void VMem::WalkHeap(void)
+{
+ if(!m_pRover) {
+ MemoryUsageMessage("VMem heaps used %d\n", m_nHeaps, 0, 0);
+ }
+
+ /* Walk all the heaps - verify structures */
+ for(int index = 0; index < m_nHeaps; ++index) {
+ PBLOCK ptr = m_heaps[index].base;
+ size_t size = m_heaps[index].len;
+ ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, p));
+
+ /* set over reserved header block */
+ size -= minBlockSize;
+ ptr += minBlockSize;
+ PBLOCK pLast = ptr + size;
+ ASSERT(PSIZE(ptr) == 1); /* dummy previous block is allocated */
+ ASSERT(SIZE(pLast) == 1); /* dummy next block is allocated */
+ while(ptr < pLast) {
+ ASSERT(ptr > m_heaps[index].base);
+ size_t cursize = SIZE(ptr) & ~1;
+ ASSERT((PSIZE(ptr+cursize) & ~1) == cursize);
+ if(!m_pRover) {
+ MemoryUsageMessage("Memory Block %08x: Size %08x %c\n", (long)ptr, cursize, (SIZE(p)&1) ? 'x' : ' ');
+ }
+ if(!(SIZE(ptr)&1)) {
+ /* this block is on the free list */
+ PBLOCK tmp = NEXT(ptr);
+ while(tmp != ptr) {
+ ASSERT((SIZE(tmp)&1)==0);
+ if(tmp == m_pFreeList)
+ break;
+ ASSERT(NEXT(tmp));
+ tmp = NEXT(tmp);
+ }
+ if(tmp == ptr) {
+ MemoryUsageMessage("Memory Block %08x: Size %08x free but not in free list\n", (long)ptr, cursize, 0);
+ }
+ }
+ ptr += cursize;
+ }
+ }
+ if(!m_pRover) {
+ MemoryUsageMessage(NULL, 0, 0, 0);
+ }
+}
+#endif
+
+#endif /* ___VMEM_H_INC___ */
diff --git a/win32/win32.c b/win32/win32.c
index 6566f9a7f4..78955fc046 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -15,6 +15,8 @@
#define Win32_Winsock
#endif
#include <windows.h>
+#include <winnt.h>
+#include <io.h>
/* #include "config.h" */
@@ -95,11 +97,20 @@ static char * get_emd_part(SV **leading, char *trailing, ...);
static void remove_dead_process(long deceased);
static long find_pid(int pid);
static char * qualified_path(const char *cmd);
+#ifdef USE_ITHREADS
+static void remove_dead_pseudo_process(long child);
+static long find_pseudo_pid(int pid);
+#endif
+START_EXTERN_C
HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
char w32_module_name[MAX_PATH+1];
+END_EXTERN_C
+
static DWORD w32_platform = (DWORD)-1;
+#define ONE_K_BUFSIZE 1024
+
int
IsWin95(void)
{
@@ -165,12 +176,13 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
char *optr;
char *strip;
int oldsize, newsize;
+ STRLEN baselen;
va_start(ap, trailing_path);
strip = va_arg(ap, char *);
- sprintf(base, "%5.3f",
- (double)PERL_REVISION + ((double)PERL_VERSION / (double)1000));
+ sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION);
+ baselen = strlen(base);
if (!*w32_module_name) {
GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
@@ -202,10 +214,10 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
/* avoid stripping component if there is no slash,
* or it doesn't match ... */
if (!ptr || stricmp(ptr+1, strip) != 0) {
- /* ... but not if component matches 5.00X* */
+ /* ... but not if component matches m|5\.$patchlevel.*| */
if (!ptr || !(*strip == '5' && *(ptr+1) == '5'
- && strncmp(strip, base, 5) == 0
- && strncmp(ptr+1, base, 5) == 0))
+ && strncmp(strip, base, baselen) == 0
+ && strncmp(ptr+1, base, baselen) == 0))
{
*optr = '/';
ptr = optr;
@@ -272,12 +284,6 @@ win32_get_sitelib(char *pl)
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */
sprintf(pathstr, "site/%s/lib", pl);
(void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
- if (!sv1 && strlen(pl) == 7) {
- /* pl may have been SUBVERSION-specific; try again without
- * SUBVERSION */
- sprintf(pathstr, "site/%.5s/lib", pl);
- (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
- }
/* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */
(void)get_regstr(sitelib, &sv2);
@@ -349,17 +355,17 @@ PerlIO *
Perl_my_popen(pTHX_ char *cmd, char *mode)
{
#ifdef FIXCMD
-#define fixcmd(x) { \
- char *pspace = strchr((x),' '); \
- if (pspace) { \
- char *p = (x); \
- while (p < pspace) { \
- if (*p == '/') \
- *p = '\\'; \
- p++; \
- } \
- } \
- }
+#define fixcmd(x) { \
+ char *pspace = strchr((x),' '); \
+ if (pspace) { \
+ char *p = (x); \
+ while (p < pspace) { \
+ if (*p == '/') \
+ *p = '\\'; \
+ p++; \
+ } \
+ } \
+ }
#else
#define fixcmd(x)
#endif
@@ -389,6 +395,17 @@ win32_os_id(void)
return (unsigned long)w32_platform;
}
+DllExport int
+win32_getpid(void)
+{
+#ifdef USE_ITHREADS
+ dTHXo;
+ if (w32_pseudo_id)
+ return -((int)w32_pseudo_id);
+#endif
+ return _getpid();
+}
+
/* Tokenize a string. Words are null-separated, and the list
* ends with a doubled null. Any character (except null and
* including backslash) may be escaped by preceding it with a
@@ -685,10 +702,10 @@ win32_opendir(char *filename)
/* do the FindFirstFile call */
if (USING_WIDE()) {
A2WHELPER(scanname, wbuffer, sizeof(wbuffer));
- fh = FindFirstFileW(wbuffer, &wFindData);
+ fh = FindFirstFileW(PerlDir_mapW(wbuffer), &wFindData);
}
else {
- fh = FindFirstFileA(scanname, &aFindData);
+ fh = FindFirstFileA(PerlDir_mapA(scanname), &aFindData);
}
dirp->handle = fh;
if (fh == INVALID_HANDLE_VALUE) {
@@ -911,8 +928,8 @@ static long
find_pid(int pid)
{
dTHXo;
- long child;
- for (child = 0 ; child < w32_num_children ; ++child) {
+ long child = w32_num_children;
+ while (--child >= 0) {
if (w32_child_pids[child] == pid)
return child;
}
@@ -933,18 +950,72 @@ remove_dead_process(long child)
}
}
+#ifdef USE_ITHREADS
+static long
+find_pseudo_pid(int pid)
+{
+ dTHXo;
+ long child = w32_num_pseudo_children;
+ while (--child >= 0) {
+ if (w32_pseudo_child_pids[child] == pid)
+ return child;
+ }
+ return -1;
+}
+
+static void
+remove_dead_pseudo_process(long child)
+{
+ if (child >= 0) {
+ dTHXo;
+ CloseHandle(w32_pseudo_child_handles[child]);
+ Copy(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child],
+ (w32_num_pseudo_children-child-1), HANDLE);
+ Copy(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child],
+ (w32_num_pseudo_children-child-1), DWORD);
+ w32_num_pseudo_children--;
+ }
+}
+#endif
+
DllExport int
win32_kill(int pid, int sig)
{
+ dTHXo;
HANDLE hProcess;
- hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
- if (hProcess && TerminateProcess(hProcess, sig))
- CloseHandle(hProcess);
- else {
- errno = EINVAL;
- return -1;
+#ifdef USE_ITHREADS
+ if (pid < 0) {
+ /* it is a pseudo-forked child */
+ long child = find_pseudo_pid(-pid);
+ if (child >= 0) {
+ hProcess = w32_pseudo_child_handles[child];
+ if (TerminateThread(hProcess, sig)) {
+ remove_dead_pseudo_process(child);
+ return 0;
+ }
+ }
}
- return 0;
+ else
+#endif
+ {
+ long child = find_pid(pid);
+ if (child >= 0) {
+ hProcess = w32_child_handles[child];
+ if (TerminateProcess(hProcess, sig)) {
+ remove_dead_process(child);
+ return 0;
+ }
+ }
+ else {
+ hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
+ if (hProcess && TerminateProcess(hProcess, sig)) {
+ CloseHandle(hProcess);
+ return 0;
+ }
+ }
+ }
+ errno = EINVAL;
+ return -1;
}
/*
@@ -995,9 +1066,11 @@ win32_stat(const char *path, struct stat *buffer)
/* This also gives us an opportunity to determine the number of links. */
if (USING_WIDE()) {
A2WHELPER(path, wbuffer, sizeof(wbuffer));
+ wcscpy(wbuffer, PerlDir_mapW(wbuffer));
handle = CreateFileW(wbuffer, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
}
else {
+ path = PerlDir_mapA(path);
handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
}
if (handle != INVALID_HANDLE_VALUE) {
@@ -1007,10 +1080,13 @@ win32_stat(const char *path, struct stat *buffer)
CloseHandle(handle);
}
- if (USING_WIDE())
+ /* wbuffer or path will be mapped correctly above */
+ if (USING_WIDE()) {
res = _wstat(wbuffer, (struct _stat *)buffer);
- else
+ }
+ else {
res = stat(path, buffer);
+ }
buffer->st_nlink = nlink;
if (res < 0) {
@@ -1213,9 +1289,9 @@ win32_putenv(const char *name)
New(1309,wCuritem,length,WCHAR);
A2WHELPER(name, wCuritem, length*sizeof(WCHAR));
wVal = wcschr(wCuritem, '=');
- if(wVal) {
+ if (wVal) {
*wVal++ = '\0';
- if(SetEnvironmentVariableW(wCuritem, *wVal ? wVal : NULL))
+ if (SetEnvironmentVariableW(wCuritem, *wVal ? wVal : NULL))
relval = 0;
}
Safefree(wCuritem);
@@ -1224,7 +1300,7 @@ win32_putenv(const char *name)
New(1309,curitem,strlen(name)+1,char);
strcpy(curitem, name);
val = strchr(curitem, '=');
- if(val) {
+ if (val) {
/* The sane way to deal with the environment.
* Has these advantages over putenv() & co.:
* * enables us to store a truly empty value in the
@@ -1240,7 +1316,7 @@ win32_putenv(const char *name)
* GSAR 97-06-07
*/
*val++ = '\0';
- if(SetEnvironmentVariableA(curitem, *val ? val : NULL))
+ if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
relval = 0;
}
Safefree(curitem);
@@ -1254,11 +1330,11 @@ win32_putenv(const char *name)
static long
filetime_to_clock(PFILETIME ft)
{
- __int64 qw = ft->dwHighDateTime;
- qw <<= 32;
- qw |= ft->dwLowDateTime;
- qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
- return (long) qw;
+ __int64 qw = ft->dwHighDateTime;
+ qw <<= 32;
+ qw |= ft->dwLowDateTime;
+ qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */
+ return (long) qw;
}
DllExport int
@@ -1309,6 +1385,43 @@ filetime_from_time(PFILETIME pFileTime, time_t Time)
}
DllExport int
+win32_unlink(const char *filename)
+{
+ dTHXo;
+ int ret;
+ DWORD attrs;
+
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+
+ A2WHELPER(filename, wBuffer, sizeof(wBuffer));
+ wcscpy(wBuffer, PerlDir_mapW(wBuffer));
+ attrs = GetFileAttributesW(wBuffer);
+ if (attrs & FILE_ATTRIBUTE_READONLY) {
+ (void)SetFileAttributesW(wBuffer, attrs & ~FILE_ATTRIBUTE_READONLY);
+ ret = _wunlink(wBuffer);
+ if (ret == -1)
+ (void)SetFileAttributesW(wBuffer, attrs);
+ }
+ else
+ ret = _wunlink(wBuffer);
+ }
+ else {
+ filename = PerlDir_mapA(filename);
+ attrs = GetFileAttributesA(filename);
+ if (attrs & FILE_ATTRIBUTE_READONLY) {
+ (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY);
+ ret = unlink(filename);
+ if (ret == -1)
+ (void)SetFileAttributesA(filename, attrs);
+ }
+ else
+ ret = unlink(filename);
+ }
+ return ret;
+}
+
+DllExport int
win32_utime(const char *filename, struct utimbuf *times)
{
dTHXo;
@@ -1322,9 +1435,11 @@ win32_utime(const char *filename, struct utimbuf *times)
int rc;
if (USING_WIDE()) {
A2WHELPER(filename, wbuffer, sizeof(wbuffer));
+ wcscpy(wbuffer, PerlDir_mapW(wbuffer));
rc = _wutime(wbuffer, (struct _utimbuf*)times);
}
else {
+ filename = PerlDir_mapA(filename);
rc = utime(filename, times);
}
/* EACCES: path specifies directory or readonly file */
@@ -1458,8 +1573,27 @@ win32_waitpid(int pid, int *status, int flags)
{
dTHXo;
int retval = -1;
- if (pid == -1)
+ if (pid == -1) /* XXX threadid == 1 ? */
return win32_wait(status);
+#ifdef USE_ITHREADS
+ else if (pid < 0) {
+ long child = find_pseudo_pid(-pid);
+ if (child >= 0) {
+ HANDLE hThread = w32_pseudo_child_handles[child];
+ DWORD waitcode = WaitForSingleObject(hThread, INFINITE);
+ if (waitcode != WAIT_FAILED) {
+ if (GetExitCodeThread(hThread, &waitcode)) {
+ *status = (int)((waitcode & 0xff) << 8);
+ retval = (int)w32_pseudo_child_pids[child];
+ remove_dead_pseudo_process(child);
+ return retval;
+ }
+ }
+ else
+ errno = ECHILD;
+ }
+ }
+#endif
else {
long child = find_pid(pid);
if (child >= 0) {
@@ -1498,6 +1632,28 @@ win32_wait(int *status)
int i, retval;
DWORD exitcode, waitcode;
+#ifdef USE_ITHREADS
+ if (w32_num_pseudo_children) {
+ waitcode = WaitForMultipleObjects(w32_num_pseudo_children,
+ w32_pseudo_child_handles,
+ FALSE,
+ INFINITE);
+ if (waitcode != WAIT_FAILED) {
+ if (waitcode >= WAIT_ABANDONED_0
+ && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children)
+ i = waitcode - WAIT_ABANDONED_0;
+ else
+ i = waitcode - WAIT_OBJECT_0;
+ if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) {
+ *status = (int)((exitcode & 0xff) << 8);
+ retval = (int)w32_pseudo_child_pids[i];
+ remove_dead_pseudo_process(i);
+ return retval;
+ }
+ }
+ }
+#endif
+
if (!w32_num_children) {
errno = ECHILD;
return -1;
@@ -1903,9 +2059,9 @@ win32_fopen(const char *filename, const char *mode)
if (USING_WIDE()) {
A2WHELPER(mode, wMode, sizeof(wMode));
A2WHELPER(filename, wBuffer, sizeof(wBuffer));
- return _wfopen(wBuffer, wMode);
+ return _wfopen(PerlDir_mapW(wBuffer), wMode);
}
- return fopen(filename, mode);
+ return fopen(PerlDir_mapA(filename), mode);
}
#ifndef USE_SOCKETS_AS_HANDLES
@@ -1936,9 +2092,9 @@ win32_freopen(const char *path, const char *mode, FILE *stream)
if (USING_WIDE()) {
A2WHELPER(mode, wMode, sizeof(wMode));
A2WHELPER(path, wBuffer, sizeof(wBuffer));
- return _wfreopen(wBuffer, wMode, stream);
+ return _wfreopen(PerlDir_mapW(wBuffer), wMode, stream);
}
- return freopen(path, mode, stream);
+ return freopen(PerlDir_mapA(path), mode, stream);
}
DllExport int
@@ -2210,8 +2366,13 @@ Nt4CreateHardLinkW(
StreamId.dwStreamId = BACKUP_LINK;
StreamId.dwStreamAttributes = 0;
StreamId.dwStreamNameSize = 0;
+#if defined(__BORLANDC__) || defined(__MINGW32__)
+ StreamId.Size.u.HighPart = 0;
+ StreamId.Size.u.LowPart = dwLen;
+#else
StreamId.Size.HighPart = 0;
StreamId.Size.LowPart = dwLen;
+#endif
bSuccess = pfnBackupWrite(handle, (LPBYTE)&StreamId, dwSize, &dwWritten,
FALSE, FALSE, &lpContext);
@@ -2244,7 +2405,8 @@ win32_link(const char *oldname, const char *newname)
if ((A2WHELPER(oldname, wOldName, sizeof(wOldName))) &&
(A2WHELPER(newname, wNewName, sizeof(wNewName))) &&
- pfnCreateHardLinkW(wNewName, wOldName, NULL))
+ (wcscpy(wOldName, PerlDir_mapW(wOldName)),
+ pfnCreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL)))
{
return 0;
}
@@ -2257,6 +2419,7 @@ win32_rename(const char *oname, const char *newname)
{
WCHAR wOldName[MAX_PATH];
WCHAR wNewName[MAX_PATH];
+ char szOldName[MAX_PATH];
BOOL bResult;
/* XXX despite what the documentation says about MoveFileEx(),
* it doesn't work under Windows95!
@@ -2266,11 +2429,13 @@ win32_rename(const char *oname, const char *newname)
if (USING_WIDE()) {
A2WHELPER(oname, wOldName, sizeof(wOldName));
A2WHELPER(newname, wNewName, sizeof(wNewName));
- bResult = MoveFileExW(wOldName,wNewName,
+ wcscpy(wOldName, PerlDir_mapW(wOldName));
+ bResult = MoveFileExW(wOldName,PerlDir_mapW(wNewName),
MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING);
}
else {
- bResult = MoveFileExA(oname,newname,
+ strcpy(szOldName, PerlDir_mapA(szOldName));
+ bResult = MoveFileExA(szOldName,PerlDir_mapA(newname),
MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING);
}
if (!bResult) {
@@ -2401,9 +2566,9 @@ win32_open(const char *path, int flag, ...)
if (USING_WIDE()) {
A2WHELPER(path, wBuffer, sizeof(wBuffer));
- return _wopen(wBuffer, flag, pmode);
+ return _wopen(PerlDir_mapW(wBuffer), flag, pmode);
}
- return open(path,flag,pmode);
+ return open(PerlDir_mapA(path), flag, pmode);
}
DllExport int
@@ -2430,10 +2595,240 @@ win32_dup2(int fd1,int fd2)
return dup2(fd1,fd2);
}
+#ifdef PERL_MSVCRT_READFIX
+
+#define LF 10 /* line feed */
+#define CR 13 /* carriage return */
+#define CTRLZ 26 /* ctrl-z means eof for text */
+#define FOPEN 0x01 /* file handle open */
+#define FEOFLAG 0x02 /* end of file has been encountered */
+#define FCRLF 0x04 /* CR-LF across read buffer (in text mode) */
+#define FPIPE 0x08 /* file handle refers to a pipe */
+#define FAPPEND 0x20 /* file handle opened O_APPEND */
+#define FDEV 0x40 /* file handle refers to device */
+#define FTEXT 0x80 /* file handle is in text mode */
+#define MAX_DESCRIPTOR_COUNT (64*32) /* this is the maximun that MSVCRT can handle */
+
+/*
+ * 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)
+
+int __cdecl _fixed_read(int fh, void *buf, unsigned cnt)
+{
+ int bytes_read; /* number of bytes read */
+ char *buffer; /* buffer to read to */
+ int os_read; /* bytes read on OS call */
+ char *p, *q; /* pointers into buffer */
+ char peekchr; /* peek-ahead character */
+ ULONG filepos; /* file position after seek */
+ ULONG dosretval; /* o.s. return value */
+
+ /* validate handle */
+ if (((unsigned)fh >= (unsigned)MAX_DESCRIPTOR_COUNT) ||
+ !(_osfile(fh) & FOPEN))
+ {
+ /* out of range -- return error */
+ errno = EBADF;
+ _doserrno = 0; /* not o.s. error */
+ return -1;
+ }
+
+ EnterCriticalSection(&(_pioinfo(fh)->lock)); /* lock file */
+
+ bytes_read = 0; /* nothing read yet */
+ buffer = (char*)buf;
+
+ if (cnt == 0 || (_osfile(fh) & FEOFLAG)) {
+ /* nothing to read or at EOF, so return 0 read */
+ goto functionexit;
+ }
+
+ if ((_osfile(fh) & (FPIPE|FDEV)) && _pipech(fh) != LF) {
+ /* a pipe/device and pipe lookahead non-empty: read the lookahead
+ * char */
+ *buffer++ = _pipech(fh);
+ ++bytes_read;
+ --cnt;
+ _pipech(fh) = LF; /* mark as empty */
+ }
+
+ /* read the data */
+
+ if (!ReadFile((HANDLE)_osfhnd(fh), buffer, cnt, (LPDWORD)&os_read, NULL))
+ {
+ /* ReadFile has reported an error. recognize two special cases.
+ *
+ * 1. map ERROR_ACCESS_DENIED to EBADF
+ *
+ * 2. just return 0 if ERROR_BROKEN_PIPE has occurred. it
+ * means the handle is a read-handle on a pipe for which
+ * all write-handles have been closed and all data has been
+ * read. */
+
+ if ((dosretval = GetLastError()) == ERROR_ACCESS_DENIED) {
+ /* wrong read/write mode should return EBADF, not EACCES */
+ errno = EBADF;
+ _doserrno = dosretval;
+ bytes_read = -1;
+ goto functionexit;
+ }
+ else if (dosretval == ERROR_BROKEN_PIPE) {
+ bytes_read = 0;
+ goto functionexit;
+ }
+ else {
+ bytes_read = -1;
+ goto functionexit;
+ }
+ }
+
+ bytes_read += os_read; /* update bytes read */
+
+ if (_osfile(fh) & FTEXT) {
+ /* now must translate CR-LFs to LFs in the buffer */
+
+ /* set CRLF flag to indicate LF at beginning of buffer */
+ /* if ((os_read != 0) && (*(char *)buf == LF)) */
+ /* _osfile(fh) |= FCRLF; */
+ /* else */
+ /* _osfile(fh) &= ~FCRLF; */
+
+ _osfile(fh) &= ~FCRLF;
+
+ /* convert chars in the buffer: p is src, q is dest */
+ p = q = (char*)buf;
+ while (p < (char *)buf + bytes_read) {
+ if (*p == CTRLZ) {
+ /* if fh is not a device, set ctrl-z flag */
+ if (!(_osfile(fh) & FDEV))
+ _osfile(fh) |= FEOFLAG;
+ break; /* stop translating */
+ }
+ else if (*p != CR)
+ *q++ = *p++;
+ else {
+ /* *p is CR, so must check next char for LF */
+ if (p < (char *)buf + bytes_read - 1) {
+ if (*(p+1) == LF) {
+ p += 2;
+ *q++ = LF; /* convert CR-LF to LF */
+ }
+ else
+ *q++ = *p++; /* store char normally */
+ }
+ else {
+ /* This is the hard part. We found a CR at end of
+ buffer. We must peek ahead to see if next char
+ is an LF. */
+ ++p;
+
+ dosretval = 0;
+ if (!ReadFile((HANDLE)_osfhnd(fh), &peekchr, 1,
+ (LPDWORD)&os_read, NULL))
+ dosretval = GetLastError();
+
+ if (dosretval != 0 || os_read == 0) {
+ /* couldn't read ahead, store CR */
+ *q++ = CR;
+ }
+ else {
+ /* peekchr now has the extra character -- we now
+ have several possibilities:
+ 1. disk file and char is not LF; just seek back
+ and copy CR
+ 2. disk file and char is LF; store LF, don't seek back
+ 3. pipe/device and char is LF; store LF.
+ 4. pipe/device and char isn't LF, store CR and
+ put char in pipe lookahead buffer. */
+ if (_osfile(fh) & (FDEV|FPIPE)) {
+ /* non-seekable device */
+ if (peekchr == LF)
+ *q++ = LF;
+ else {
+ *q++ = CR;
+ _pipech(fh) = peekchr;
+ }
+ }
+ else {
+ /* disk file */
+ if (peekchr == LF) {
+ /* nothing read yet; must make some
+ progress */
+ *q++ = LF;
+ /* turn on this flag for tell routine */
+ _osfile(fh) |= FCRLF;
+ }
+ else {
+ HANDLE osHandle; /* o.s. handle value */
+ /* seek back */
+ if ((osHandle = (HANDLE)_get_osfhandle(fh)) != (HANDLE)-1)
+ {
+ if ((filepos = SetFilePointer(osHandle, -1, NULL, FILE_CURRENT)) == -1)
+ dosretval = GetLastError();
+ }
+ if (peekchr != LF)
+ *q++ = CR;
+ }
+ }
+ }
+ }
+ }
+ }
+
+ /* we now change bytes_read to reflect the true number of chars
+ in the buffer */
+ bytes_read = q - (char *)buf;
+ }
+
+functionexit:
+ LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */
+
+ return bytes_read;
+}
+
+#endif /* PERL_MSVCRT_READFIX */
+
DllExport int
win32_read(int fd, void *buf, unsigned int cnt)
{
+#ifdef PERL_MSVCRT_READFIX
+ return _fixed_read(fd, buf, cnt);
+#else
return read(fd, buf, cnt);
+#endif
}
DllExport int
@@ -2445,21 +2840,64 @@ win32_write(int fd, const void *buf, unsigned int cnt)
DllExport int
win32_mkdir(const char *dir, int mode)
{
- return mkdir(dir); /* just ignore mode */
+ dTHXo;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(dir, wBuffer, sizeof(wBuffer));
+ return _wmkdir(PerlDir_mapW(wBuffer));
+ }
+ return mkdir(PerlDir_mapA(dir)); /* just ignore mode */
}
DllExport int
win32_rmdir(const char *dir)
{
- return rmdir(dir);
+ dTHXo;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(dir, wBuffer, sizeof(wBuffer));
+ return _wrmdir(PerlDir_mapW(wBuffer));
+ }
+ return rmdir(PerlDir_mapA(dir));
}
DllExport int
win32_chdir(const char *dir)
{
+ dTHXo;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(dir, wBuffer, sizeof(wBuffer));
+ return _wchdir(wBuffer);
+ }
return chdir(dir);
}
+DllExport int
+win32_access(const char *path, int mode)
+{
+ dTHXo;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(path, wBuffer, sizeof(wBuffer));
+ return _waccess(PerlDir_mapW(wBuffer), mode);
+ }
+ return access(PerlDir_mapA(path), mode);
+}
+
+DllExport int
+win32_chmod(const char *path, int mode)
+{
+ dTHXo;
+ if (USING_WIDE()) {
+ WCHAR wBuffer[MAX_PATH];
+ A2WHELPER(path, wBuffer, sizeof(wBuffer));
+ return _wchmod(PerlDir_mapW(wBuffer), mode);
+ }
+ return chmod(PerlDir_mapA(path), mode);
+}
+
+
static char *
create_command_line(const char* command, const char * const *args)
{
@@ -2592,12 +3030,28 @@ free_childenv(void* d)
char*
get_childdir(void)
{
- return NULL;
+ dTHXo;
+ char* ptr;
+ char szfilename[(MAX_PATH+1)*2];
+ if (USING_WIDE()) {
+ WCHAR wfilename[MAX_PATH+1];
+ GetCurrentDirectoryW(MAX_PATH+1, wfilename);
+ W2AHELPER(wfilename, szfilename, sizeof(szfilename));
+ }
+ else {
+ GetCurrentDirectoryA(MAX_PATH+1, szfilename);
+ }
+
+ New(0, ptr, strlen(szfilename)+1, char);
+ strcpy(ptr, szfilename);
+ return ptr;
}
void
free_childdir(char* d)
{
+ dTHXo;
+ Safefree(d);
}
@@ -2722,12 +3176,26 @@ RETVAL:
DllExport int
win32_execv(const char *cmdname, const char *const *argv)
{
+#ifdef USE_ITHREADS
+ dTHXo;
+ /* if this is a pseudo-forked child, we just want to spawn
+ * the new program, and return */
+ if (w32_pseudo_id)
+ return spawnv(P_WAIT, cmdname, (char *const *)argv);
+#endif
return execv(cmdname, (char *const *)argv);
}
DllExport int
win32_execvp(const char *cmdname, const char *const *argv)
{
+#ifdef USE_ITHREADS
+ dTHXo;
+ /* if this is a pseudo-forked child, we just want to spawn
+ * the new program, and return */
+ if (w32_pseudo_id)
+ return win32_spawnvp(P_WAIT, cmdname, (char *const *)argv);
+#endif
return execvp(cmdname, (char *const *)argv);
}
@@ -2927,44 +3395,14 @@ win32_dynaload(const char* filename)
if (USING_WIDE()) {
WCHAR wfilename[MAX_PATH];
A2WHELPER(filename, wfilename, sizeof(wfilename));
- hModule = LoadLibraryExW(wfilename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
+ hModule = LoadLibraryExW(PerlDir_mapW(wfilename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
}
else {
- hModule = LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
+ hModule = LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
}
return hModule;
}
-DllExport int
-win32_add_host(char *nameId, void *data)
-{
- /*
- * This must be called before the script is parsed,
- * therefore no locking of threads is needed
- */
- dTHXo;
- struct host_link *link;
- New(1314, link, 1, struct host_link);
- link->host_data = data;
- link->nameId = nameId;
- link->next = w32_host_link;
- w32_host_link = link;
- return 1;
-}
-
-DllExport void *
-win32_get_host_data(char *nameId)
-{
- dTHXo;
- struct host_link *link = w32_host_link;
- while(link) {
- if(strEQ(link->nameId, nameId))
- return link->host_data;
- link = link->next;
- }
- return Nullch;
-}
-
/*
* Extras.
*/
@@ -2973,19 +3411,19 @@ static
XS(w32_GetCwd)
{
dXSARGS;
- SV *sv = sv_newmortal();
- /* Make one call with zero size - return value is required size */
- DWORD len = GetCurrentDirectory((DWORD)0,NULL);
- SvUPGRADE(sv,SVt_PV);
- SvGROW(sv,len);
- SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
+ /* Make the host for current directory */
+ char* ptr = PerlEnv_get_childdir();
/*
- * If result != 0
+ * If ptr != Nullch
* then it worked, set PV valid,
- * else leave it 'undef'
+ * else return 'undef'
*/
- EXTEND(SP,1);
- if (SvCUR(sv)) {
+ if (ptr) {
+ SV *sv = sv_newmortal();
+ sv_setpv(sv, ptr);
+ PerlEnv_free_childdir(ptr);
+
+ EXTEND(SP,1);
SvPOK_on(sv);
ST(0) = sv;
XSRETURN(1);
@@ -2999,7 +3437,7 @@ XS(w32_SetCwd)
dXSARGS;
if (items != 1)
Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
- if (SetCurrentDirectory(SvPV_nolen(ST(0))))
+ if (!PerlDir_chdir(SvPV_nolen(ST(0))))
XSRETURN_YES;
XSRETURN_NO;
@@ -3122,7 +3560,7 @@ XS(w32_DomainName)
if (hNetApi32)
FreeLibrary(hNetApi32);
if (GetUserName(name,&size)) {
- char sid[1024];
+ char sid[ONE_K_BUFSIZE];
DWORD sidlen = sizeof(sid);
char dname[256];
DWORD dnamelen = sizeof(dname);
@@ -3161,19 +3599,34 @@ static
XS(w32_GetOSVersion)
{
dXSARGS;
- OSVERSIONINFO osver;
+ OSVERSIONINFOA osver;
- osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- if (GetVersionEx(&osver)) {
+ if (USING_WIDE()) {
+ OSVERSIONINFOW osverw;
+ char szCSDVersion[sizeof(osverw.szCSDVersion)];
+ osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
+ if (!GetVersionExW(&osverw)) {
+ XSRETURN_EMPTY;
+ }
+ W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion));
+ XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion)));
+ osver.dwMajorVersion = osverw.dwMajorVersion;
+ osver.dwMinorVersion = osverw.dwMinorVersion;
+ osver.dwBuildNumber = osverw.dwBuildNumber;
+ osver.dwPlatformId = osverw.dwPlatformId;
+ }
+ else {
+ osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
+ if (!GetVersionExA(&osver)) {
+ XSRETURN_EMPTY;
+ }
XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
- XPUSHs(newSViv(osver.dwMajorVersion));
- XPUSHs(newSViv(osver.dwMinorVersion));
- XPUSHs(newSViv(osver.dwBuildNumber));
- XPUSHs(newSViv(osver.dwPlatformId));
- PUTBACK;
- return;
}
- XSRETURN_EMPTY;
+ XPUSHs(newSViv(osver.dwMajorVersion));
+ XPUSHs(newSViv(osver.dwMinorVersion));
+ XPUSHs(newSViv(osver.dwBuildNumber));
+ XPUSHs(newSViv(osver.dwPlatformId));
+ PUTBACK;
}
static
@@ -3197,15 +3650,27 @@ XS(w32_FormatMessage)
{
dXSARGS;
DWORD source = 0;
- char msgbuf[1024];
+ char msgbuf[ONE_K_BUFSIZE];
if (items != 1)
Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
- if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
- &source, SvIV(ST(0)), 0,
- msgbuf, sizeof(msgbuf)-1, NULL))
- XSRETURN_PV(msgbuf);
+ if (USING_WIDE()) {
+ WCHAR wmsgbuf[ONE_K_BUFSIZE];
+ if (FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM,
+ &source, SvIV(ST(0)), 0,
+ wmsgbuf, ONE_K_BUFSIZE-1, NULL))
+ {
+ W2AHELPER(wmsgbuf, msgbuf, sizeof(msgbuf));
+ XSRETURN_PV(msgbuf);
+ }
+ }
+ else {
+ if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
+ &source, SvIV(ST(0)), 0,
+ msgbuf, sizeof(msgbuf)-1, NULL))
+ XSRETURN_PV(msgbuf);
+ }
XSRETURN_UNDEF;
}
@@ -3358,9 +3823,24 @@ static
XS(w32_CopyFile)
{
dXSARGS;
+ BOOL bResult;
if (items != 3)
Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
- if (CopyFile(SvPV_nolen(ST(0)), SvPV_nolen(ST(1)), !SvTRUE(ST(2))))
+ if (USING_WIDE()) {
+ WCHAR wSourceFile[MAX_PATH];
+ WCHAR wDestFile[MAX_PATH];
+ A2WHELPER(SvPV_nolen(ST(0)), wSourceFile, sizeof(wSourceFile));
+ wcscpy(wSourceFile, PerlDir_mapW(wSourceFile));
+ A2WHELPER(SvPV_nolen(ST(1)), wDestFile, sizeof(wDestFile));
+ bResult = CopyFileW(wSourceFile, PerlDir_mapW(wDestFile), !SvTRUE(ST(2)));
+ }
+ else {
+ char szSourceFile[MAX_PATH];
+ strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
+ bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
+ }
+
+ if (bResult)
XSRETURN_YES;
XSRETURN_NO;
}
@@ -3377,6 +3857,12 @@ Perl_init_os_extras(void)
w32_fdpid = newAV(); /* XXX needs to be in Perl_win32_init()? */
New(1313, w32_children, 1, child_tab);
w32_num_children = 0;
+ w32_init_socktype = 0;
+#ifdef USE_ITHREADS
+ w32_pseudo_id = 0;
+ New(1313, w32_pseudo_children, 1, child_tab);
+ w32_num_pseudo_children = 0;
+#endif
/* these names are Activeware compatible */
newXS("Win32::GetCwd", w32_GetCwd, file);
@@ -3428,6 +3914,13 @@ Perl_win32_init(int *argcp, char ***argvp)
}
#ifdef USE_ITHREADS
+
+# ifdef PERL_OBJECT
+# undef Perl_sys_intern_dup
+# define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup
+# define pPerl this
+# endif
+
void
Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
{
@@ -3435,34 +3928,11 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
dst->perlshell_vec = (char**)NULL;
dst->perlshell_items = 0;
dst->fdpid = newAV();
- New(1313, dst->children, 1, child_tab);
+ Newz(1313, dst->children, 1, child_tab);
+ Newz(1313, dst->pseudo_children, 1, child_tab);
+ dst->pseudo_id = 0;
dst->children->num = 0;
- dst->hostlist = src->hostlist; /* XXX */
dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype;
}
#endif
-#ifdef USE_BINMODE_SCRIPTS
-
-void
-win32_strip_return(SV *sv)
-{
- char *s = SvPVX(sv);
- char *e = s+SvCUR(sv);
- char *d = s;
- while (s < e)
- {
- if (*s == '\r' && s[1] == '\n')
- {
- *d++ = '\n';
- s += 2;
- }
- else
- {
- *d++ = *s++;
- }
- }
- SvCUR_set(sv,d-SvPVX(sv));
-}
-
-#endif
diff --git a/win32/win32.h b/win32/win32.h
index 9eaf76a2d4..9d56578229 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -9,6 +9,10 @@
#ifndef _INC_WIN32_PERL5
#define _INC_WIN32_PERL5
+#ifndef _WIN32_WINNT
+# define _WIN32_WINNT 0x0400 /* needed for TryEnterCriticalSection() etc. */
+#endif
+
#if defined(PERL_OBJECT) || defined(PERL_IMPLICIT_SYS) || defined(PERL_CAPI)
# define DYNAMIC_ENV_FETCH
# define ENV_HV_NAME "___ENV_HV_NAME___"
@@ -33,18 +37,6 @@
# define __int64 long long
# endif
# define Win32_Winsock
-/* GCC does not do __declspec() - render it a nop
- * and turn on options to avoid importing data
- */
-#ifndef __declspec
-# define __declspec(x)
-#endif
-# ifndef PERL_OBJECT
-# define PERL_GLOBAL_STRUCT
-# ifndef MULTIPLICITY
-# define MULTIPLICITY
-# endif
-# endif
#endif
/* Define DllExport akin to perl's EXT,
@@ -53,6 +45,8 @@
* otherwise import it.
*/
+/* now even GCC supports __declspec() */
+
#if defined(PERL_OBJECT)
#define DllExport
#else
@@ -165,6 +159,7 @@ struct utsname {
#define _access access
#define _chdir chdir
+#define _getpid getpid
#include <sys/types.h>
#ifndef DllMain
@@ -187,6 +182,9 @@ struct utsname {
# 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
+
#endif
#ifdef _MSC_VER /* Microsoft Visual C++ */
@@ -196,45 +194,8 @@ typedef long gid_t;
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 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 PERL_MEMBER_PTR_SIZE 16
#endif /* _MSC_VER */
@@ -248,9 +209,6 @@ typedef long gid_t;
#define flushall _flushall
#define fcloseall _fcloseall
-#undef __attribute__
-#define __attribute__(x)
-
#ifndef CP_UTF8
# define CP_UTF8 65001
#endif
@@ -266,18 +224,50 @@ typedef long gid_t;
# endif
#endif
-#ifndef _O_NOINHERIT
-# define _O_NOINHERIT 0x0080
-# ifndef _NO_OLDNAMES
-# define O_NOINHERIT _O_NOINHERIT
-# endif
-#endif
-
#endif /* __MINGW32__ */
/* compatibility stuff for other compilers goes here */
+#if !defined(PERL_OBJECT) && 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_MEMBER_PTR_SIZE */
+
+
START_EXTERN_C
/* For UNIX compatibility. */
@@ -340,12 +330,10 @@ typedef char * caddr_t; /* In malloc.c (core address). */
#define PERL_CORE
#endif
-#ifdef USE_BINMODE_SCRIPTS
-#define PERL_SCRIPT_MODE "rb"
-EXT void win32_strip_return(struct sv *sv);
+#ifdef PERL_TEXTMODE_SCRIPTS
+# define PERL_SCRIPT_MODE "r"
#else
-#define PERL_SCRIPT_MODE "r"
-#define win32_strip_return(sv) NOOP
+# define PERL_SCRIPT_MODE "rb"
#endif
/*
@@ -378,22 +366,20 @@ struct thread_intern {
typedef struct {
long num;
DWORD pids[MAXIMUM_WAIT_OBJECTS];
+ HANDLE handles[MAXIMUM_WAIT_OBJECTS];
} child_tab;
-struct host_link {
- char * nameId;
- void * host_data;
- struct host_link * next;
-};
-
struct interp_intern {
char * perlshell_tokens;
char ** perlshell_vec;
long perlshell_items;
struct av * fdpid;
child_tab * children;
- HANDLE child_handles[MAXIMUM_WAIT_OBJECTS];
- struct host_link * hostlist;
+#ifdef USE_ITHREADS
+ DWORD pseudo_id;
+ child_tab * pseudo_children;
+#endif
+ void * internal_host;
#ifndef USE_THREADS
struct thread_intern thr_intern;
#endif
@@ -407,8 +393,13 @@ struct interp_intern {
#define w32_children (PL_sys_intern.children)
#define w32_num_children (w32_children->num)
#define w32_child_pids (w32_children->pids)
-#define w32_child_handles (PL_sys_intern.child_handles)
-#define w32_host_link (PL_sys_intern.hostlist)
+#define w32_child_handles (w32_children->handles)
+#define w32_pseudo_id (PL_sys_intern.pseudo_id)
+#define w32_pseudo_children (PL_sys_intern.pseudo_children)
+#define w32_num_pseudo_children (w32_pseudo_children->num)
+#define w32_pseudo_child_pids (w32_pseudo_children->pids)
+#define w32_pseudo_child_handles (w32_pseudo_children->handles)
+#define w32_internal_host (PL_sys_intern.internal_host)
#ifdef USE_THREADS
# define w32_strerror_buffer (thr->i.Wstrerror_buffer)
# define w32_getlogin_buffer (thr->i.Wgetlogin_buffer)
@@ -435,6 +426,20 @@ struct interp_intern {
#define USING_WIDE() (PerlEnv_os_id() == VER_PLATFORM_WIN32_NT)
+#ifdef USE_ITHREADS
+# define PERL_WAIT_FOR_CHILDREN \
+ STMT_START { \
+ if (w32_pseudo_children && w32_num_pseudo_children) { \
+ long children = w32_num_pseudo_children; \
+ WaitForMultipleObjects(children, \
+ w32_pseudo_child_handles, \
+ TRUE, INFINITE); \
+ while (children) \
+ CloseHandle(w32_pseudo_child_handles[--children]); \
+ } \
+ } STMT_END
+#endif
+
/*
* This provides a layer of functions and macros to ensure extensions will
* get to use the same RTL functions as the core.
diff --git a/win32/win32iop.h b/win32/win32iop.h
index 566ed57d51..d7c2ac4f74 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -132,6 +132,7 @@ DllExport int win32_stat(const char *path, struct stat *buf);
DllExport char* win32_longpath(char *path);
DllExport int win32_ioctl(int i, unsigned int u, char *data);
DllExport int win32_link(const char *oldname, const char *newname);
+DllExport int win32_unlink(const char *f);
DllExport int win32_utime(const char *f, struct utimbuf *t);
DllExport int win32_uname(struct utsname *n);
DllExport int win32_wait(int *status);
@@ -139,6 +140,9 @@ DllExport int win32_waitpid(int pid, int *status, int flags);
DllExport int win32_kill(int pid, int sig);
DllExport unsigned long win32_os_id(void);
DllExport void* win32_dynaload(const char*filename);
+DllExport int win32_access(const char *path, int mode);
+DllExport int win32_chmod(const char *path, int mode);
+DllExport int win32_getpid(void);
DllExport char * win32_crypt(const char *txt, const char *salt);
@@ -162,6 +166,7 @@ END_EXTERN_C
#undef times
#undef alarm
#undef ioctl
+#undef unlink
#undef utime
#undef uname
#undef wait
@@ -254,6 +259,9 @@ END_EXTERN_C
#define getchar win32_getchar
#undef putchar
#define putchar win32_putchar
+#define access(p,m) win32_access(p,m)
+#define chmod(p,m) win32_chmod(p,m)
+
#if !defined(MYMALLOC) || !defined(PERL_CORE)
#undef malloc
@@ -273,6 +281,7 @@ END_EXTERN_C
#define alarm win32_alarm
#define ioctl win32_ioctl
#define link win32_link
+#define unlink win32_unlink
#define utime win32_utime
#define uname win32_uname
#define wait win32_wait
@@ -286,6 +295,7 @@ END_EXTERN_C
#define rewinddir win32_rewinddir
#define closedir win32_closedir
#define os_id win32_os_id
+#define getpid win32_getpid
#undef crypt
#define crypt(t,s) win32_crypt(t,s)
diff --git a/win32/win32thread.h b/win32/win32thread.h
index 4fa3e2f3bf..d4f8ee409e 100644
--- a/win32/win32thread.h
+++ b/win32/win32thread.h
@@ -1,8 +1,7 @@
#ifndef _WIN32THREAD_H
#define _WIN32THREAD_H
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
+#include "win32.h"
typedef struct win32_cond { LONG waiters; HANDLE sem; } perl_cond;
typedef DWORD perl_key;
@@ -193,7 +192,7 @@ END_EXTERN_C
if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \
|| (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \
|| (CloseHandle((t)->self) == 0)) \
- Perl_croak(aTHX_ "panic: JOIN"); \
+ Perl_croak(aTHX_ "panic: JOIN"); \
} STMT_END
#endif /* !USE_RTL_THREAD_API || _MSC_VER */
View Lorry Controller Status