vos/vosish.h VOS-specific header file
warnings.h The warning numbers
warnings.pl Program to write warnings.h and lib/warnings.pm
+win32/FindExt.pm Scan for extensions
+win32/Makefile Win32 makefile for NMAKE (Visual C++ build)
+win32/Makefile.ce WinCE port
win32/bin/exetype.pl Set executable type to CONSOLE or WINDOWS
win32/bin/perlglob.pl Win32 globbing
win32/bin/pl2bat.pl wrap perl scripts into batch files
win32/bin/runperl.pl run perl script via batch file namesake
win32/bin/search.pl Win32 port
win32/buildext.pl Build extensions once miniperl is built
+win32/cecopy-lib.pl WinCE port
+win32/comp.pl WinCE port
+win32/compile-all.bat WinCE port
+win32/compile.bat WinCE port
win32/config.bc Win32 base line config.sh (Borland C++ build)
+win32/config.ce WinCE port
win32/config.gc Win32 base line config.sh (mingw32/gcc build)
+win32/config.vc Win32 base line config.sh (Visual C++ build)
+win32/config.vc64 Win64 base line config.sh (Visual C++ build)
win32/config_H.bc Win32 config header (Borland C++ build)
+win32/config_H.ce WinCE port
win32/config_H.gc Win32 config header (GNU build)?
-win32/config_h.PL Perl code to convert Win32 config.sh to config.h
win32/config_H.vc Win32 config header (Visual C++ build)
win32/config_H.vc64 Win64 config header (Visual C++ build)
+win32/config_h.PL Perl code to convert Win32 config.sh to config.h
win32/config_sh.PL Perl code to update Win32 config.sh from Makefile
-win32/config.vc Win32 base line config.sh (Visual C++ build)
-win32/config.vc64 Win64 base line config.sh (Visual C++ build)
win32/distclean.bat Remove _ALL_ files not listed here in MANIFEST
win32/dl_win32.xs Win32 port
win32/ext/Win32/Makefile.PL Win32 extension makefile writer
win32/ext/Win32/Win32.pm Win32 extension Perl module
win32/ext/Win32/Win32.xs Win32 extension external subroutines
win32/fcrypt.c crypt() implementation
-win32/FindExt.pm Scan for extensions
win32/genmk95.pl Perl code to generate command.com-usable makefile.95
win32/include/arpa/inet.h Win32 port
win32/include/dirent.h Win32 port
win32/include/netdb.h Win32 port
win32/include/sys/socket.h Win32 port
-win32/Makefile Win32 makefile for NMAKE (Visual C++ build)
+win32/makedist.pl WinCE port
win32/makefile.mk Win32 makefile for DMAKE (BC++, VC++ builds)
win32/makeico.pl script to create perlexe.ico image file
win32/mdelete.bat multifile delete
+win32/perl.rc WinCE port
win32/perlexe.rc associated perl binary with icon
win32/perlglob.c Win32 port
win32/perlhost.h Perl "host" implementation
win32/perllib.c Win32 port
+win32/perlmain.c WinCE port
win32/pod.mak Win32 port
+win32/registry.bat WinCE port
win32/runperl.c Win32 port
win32/splittree.pl Win32 port
win32/sync_ext.pl Win32 port
-win32/vdir.h Perl "host" virtual directory manager
-win32/vmem.h Perl "host" memory manager
+win32/vdir.h Perl "host" virtual directory manager for CE
+win32/vmem.h Perl "host" memory manager for CE
win32/win32.c Win32 port
win32/win32.h Win32 port
+win32/win32-d.h WinCE port
+win32/win32ceio.c Win32/WinCE PerlIO layer support
win32/win32io.c Win32 PerlIO layer support
win32/win32iop.h Win32 port
+win32/win32iop-o.h WinCE port
win32/win32sck.c Win32 port
win32/win32thread.c Win32 functions for threads
win32/win32thread.h Win32 port mapping to threads
-wince/bin/exetype.pl WinCE port
-wince/bin/perlglob.pl WinCE port
-wince/bin/pl2bat.pl WinCE port
-wince/bin/runperl.pl WinCE port
-wince/bin/search.pl WinCE port
-wince/cecopy-lib.pl WinCE port
-wince/compile-all.bat WinCE port
-wince/compile.bat WinCE port
-wince/comp.pl WinCE port
-wince/config.ce WinCE port
-wince/config_H.ce WinCE port
-wince/config_h.PL WinCE port
-wince/config_sh.PL WinCE port
-wince/dl_win32.xs WinCE port
-wince/include/arpa/inet.h WinCE port
-wince/include/sys/socket.h WinCE port
-wince/makedist.pl WinCE port
-wince/Makefile.ce WinCE port
-wince/makeico.pl WinCE port
-wince/perlhost.h Perl "host" implementation
-wince/perllib.c WinCE port
-wince/perlmain.c WinCE port
-wince/perl.rc WinCE port
-wince/registry.bat WinCE port
-wince/runperl.c WinCE port
-wince/splittree.pl WinCE port
-wince/vdir.h Perl "host" virtual directory manager for CE
-wince/vmem.h Perl "host" memory manager for CE
-wince/win32.h WinCE port
-wince/win32io.c WinCE port
-wince/win32iop.h WinCE port
-wince/win32thread.c WinCE port
-wince/win32thread.h WinCE port
-wince/wince.c WinCE port
-wince/wince.h WinCE port
-wince/wincesck.c WinCE port
+win32/wince.c WinCE port
+win32/wince.h WinCE port
+win32/wincesck.c WinCE port
+win32/xconfig.h WinCE port
writemain.SH Generate perlmain.c from miniperlmain.c+extensions
x2p/a2p.c Output of a2p.y run through byacc
x2p/a2p.h Global declarations
INST_VER=
# PERLCEDIR shoud be set to current directory
-PERLCEDIR = H:\src\wince\perl\wince
+PERLCEDIR = H:\src\wince\perl\win32
# WCEROOT is a directory where Windows CE Tools was installed
WCEROOT = D:\Windows CE Tools
CECOPY = cecopy
#
-# Comment out next assign to disable perl's I/O subsystem and use compiler's
-# stdio for IO - depending on your compiler vendor and run time library you may
-# then get a number of fails from make test i.e. bugs - complain to them not us ;-).
-# You will also be unable to take full advantage of perl5.8's support for multiple
+# Comment out next assign to disable perl's I/O subsystem and use compiler's
+# stdio for IO - depending on your compiler vendor and run time library you may
+# then get a number of fails from make test i.e. bugs - complain to them not us ;-).
+# You will also be unable to take full advantage of perl5.8's support for multiple
# encodings and may see lower IO performance. You have been warned.
USE_PERLIO = define
PLATFORM = MS Pocket PC
MCFLAGS = -DX86 -D_X86_ -DPROCESSOR_X86 -D _MT -D _DLL \
-D_WIN32_WCE_EMULATION -DPALM_SIZE -DPOCKET_SIZE \
- -I $(CELIBDLLDIR)\inc
+ -I $(CELIBDLLDIR)\inc
MACH = -machine:x86
SUBSYS = -subsystem:windows
CELIBPATH = $(CELIBDLLDIR)\$(MACHINE)-release
PLATFORM = MS Pocket PC
MCFLAGS = -D MIPS -D mips -D _MIPS_ -D _mips_ -DPROCESSOR_MIPS \
-D _MT -D _DLL -DPALM_SIZE -DPOCKET_SIZE \
- -I $(CELIBDLLDIR)\inc
+ -I $(CELIBDLLDIR)\inc
MACH = -machine:mips
SUBSYS = -subsystem:windowsce,3.00
CELIBPATH = $(CELIBDLLDIR)\$(MACHINE)-release
PLATFORM = MS Pocket PC
MCFLAGS = -D _MT -D _DLL -DSH3 -D_SH3_ -DSHx -DPROCESSOR_SH3 \
-DPALM_SIZE -DPOCKET_SIZE \
- -I $(CELIBDLLDIR)\inc
+ -I $(CELIBDLLDIR)\inc
MACH = -machine:sh3
SUBSYS = -subsystem:windowsce,3.00
CELIBPATH = $(CELIBDLLDIR)\$(MACHINE)-release
PLATFORM = MS Pocket PC
MCFLAGS = -D ARM -D arm -D _ARM_ -D _arm_ -DPROCESSOR_ARM \
-D _MT -D _DLL -DPALM_SIZE -DPOCKET_SIZE \
- -I $(CELIBDLLDIR)\inc
+ -I $(CELIBDLLDIR)\inc
MACH = -machine:arm
SUBSYS = -subsystem:windowsce,3.00
CELIBPATH = $(CELIBDLLDIR)\$(MACHINE)-release
LIB32 = $(LINK32) -lib
RSC = rc
-INCLUDES = -I.\include -I..\win32\include -I. -I..
+INCLUDES = -I.\include -I. -I..
DEFINES = -DWIN32 -D_CONSOLE -DNO_STRICT $(CRYPT_FLAG) $(CECFLAGS)
LOCDEFS = -DPERLDLL -DPERL_CORE
CXX_FLAG = -TP
winsock.lib $(CELIB) coredll.lib
!if $(CEVersion) > 200
-CELIBS = $(CELIBS) corelibc.lib
+CELIBS = $(CELIBS) corelibc.lib
!else
-CELIBS = $(CELIBS) msvcrt.lib
+CELIBS = $(CELIBS) msvcrt.lib
!endif
LIBBASEFILES = $(CRYPT_LIB) $(CELIBS)
LINK_FLAGS = -nologo -machine:$(PROCESSOR_ARCHITECTURE)
!if "$(CFG)" == "DEBUG"
-LINK_FLAGS = $(LINK_FLAGS) -debug:full -pdb:none
+LINK_FLAGS = $(LINK_FLAGS) -debug:full -pdb:none
!else
-LINK_FLAGS = $(LINK_FLAGS) -release
+LINK_FLAGS = $(LINK_FLAGS) -release
!endif
OBJOUT_FLAG = -Fo
#
# Rules
-#
+#
.SUFFIXES : .c $(o) .dll .lib .exe .rc .res
$(o).dll:
$(LINK32) -dll $(SUBSYS) $(LDLIBPATH) \
-implib:$(*B).lib -def:$(*B).def \
- -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL)
+ -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL)
.rc.res:
$(RSC) -i.. $<
WIN32_SRC = \
.\wince.c \
.\wincesck.c \
- .\win32thread.c
+ .\win32thread.c
!IF "$(CRYPT_SRC)" != ""
WIN32_SRC = $(WIN32_SRC) .\$(CRYPT_SRC)
$(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
-$(CONFIGPM): .\config.h ..\config.sh ..\minimod.pl
+$(CONFIGPM): .\xconfig.h ..\config.sh ..\minimod.pl
cd .. && $(HPERL) configpm --cross=$(CROSS_NAME) --no-glossary
-mkdir $(XCOREDIR)
$(XCOPY) ..\*.h $(XCOREDIR)\*.*
$(XCOPY) ..\*.inc $(XCOREDIR)\*.*
$(XCOPY) *.h $(XCOREDIR)\*.*
+ $(XCOPY) xconfig.h $(XCOREDIR)\config.h
$(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.*
$(RCOPY) include $(XCOREDIR)\*.*
- $(XCOPY) ..\win32\include $(XCOREDIR)\*.*
- $(HPERL) -I..\lib -MCross=$(CROSS_NAME) config_h.PL "INST_VER=$(INST_VER)" "CORE_DIR=$(XCOREDIR)"
+ $(HPERL) -I..\lib -MCross=$(CROSS_NAME) config_h.PL "INST_VER=$(INST_VER)" "CORE_DIR=$(XCOREDIR)" "CONFIG_H=xconfig.h"
-.\config.h:
- -del /f config.h
- copy config_H.ce config.h
+.\xconfig.h:
+ -del /f xconfig.h
+ copy config_H.ce xconfig.h
..\config.sh: config.ce config_sh.PL
- $(HPERL) -I..\lib -I..\win32 config_sh.PL $(CFG_VARS) config.ce > ..\config.sh
+ $(HPERL) -I..\lib -I. config_sh.PL $(CFG_VARS) config.ce > ..\config.sh
$(MINIMOD) : ..\minimod.pl
cd .. && $(HPERL) minimod.pl > lib\ExtUtils\Miniperl.pm
-perlmain.c : runperl.c
+perlmain.c : runperl.c
$(COPY) runperl.c perlmain.c
$(DYNALOADER).c: $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
cd $(EXTDIR)\$(*B)
$(HPERL) -I..\..\lib -MCross=$(CROSS_NAME) $(*B)_pm.PL
$(HPERL) -I..\..\lib -MCross=$(CROSS_NAME) XSLoader_pm.PL
- cd ..\..\wince
+ cd ..\..\win
$(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL)
$(XCOPY) $(EXTDIR)\$(*B)\XSLoader.pm $(LIBDIR)\$(NULL)
cd $(EXTDIR)\$(*B)
$(XSUBPP) dl_win32.xs > $(*B).c
- cd ..\..\wince
+ cd ..\..\win
$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
$(COPY) dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
NOT_COMPILE_EXT = $(NOT_COMPILE_EXT) !XS/Typemap
!endif
-Extensions: ..\win32\buildext.pl $(PERLDEP) $(CONFIGPM)
- $(HPERL) -I..\lib -I..\win32 -MCross=$(CROSS_NAME) ..\win32\buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) \
+Extensions: .\buildext.pl $(PERLDEP) $(CONFIGPM)
+ $(HPERL) -I..\lib -I. -MCross=$(CROSS_NAME) .\buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) \
!POSIX $(NOT_COMPILE_EXT)
-Extensions_clean:
+Extensions_clean:
-if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) clean
#----------------------------------------------------------------------------------
$(PERLEXE_RES): perl.rc perl.ico
rc $(RCDEFS) perl.rc
-clean:
+clean:
-rm -f $(MACHINE)/dll/*
-rm -f $(MACHINE)/*.obj
-rm -f $(MACHINE)/*.exe
$(DLLDIR)\toke.obj:
$(CC) -c $(CFLAGS_O) -QMOb9000 -DPERL_EXTERNAL_GLOB -Fo$(DLLDIR)\ ..\toke.c
-{$(SRCDIR)/wince}.c{$(DLLDIR)}.obj:
+{$(SRCDIR)/win}.c{$(DLLDIR)}.obj:
$(CC) -c $(CFLAGS_O) -DPERL_EXTERNAL_GLOB -Fo$(DLLDIR)\ $<
# -DPERL_IMPLICIT_SYS needs C++ for perllib.c
!ENDIF
perldll.def : $(HPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl
+ $(HPERL) -MCross -I..\lib buildext.pl --create-perllibst-h
$(HPERL) -w ..\makedef.pl PLATFORM=wince $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \
CCTYPE=$(CCTYPE) -DPERL_DLL=$(PERLDLL) > perldll.def
$(HPERL) -I..\lib -MCross=$(CROSS_NAME) makedist.pl --distdir=dist-$(CROSS_NAME) --cross-name=$(CROSS_NAME) --zip
perl.ico:
- $(HPERL) makeico.pl
+ $(HPERL) makeico.pl perl.ico
hostminiperl: ..\miniperl.exe
..\miniperl.exe:
- cd ../win32
set PATH=$(CCHOME)\bin;$(PATH)
$(MAKE) -f Makefile "CCHOME=$(MSVCDIR)" "CCINCDIR=$(CCHOME)\include" "CCLIBDIR=$(CCHOME)\lib" "INCLUDE=$(CCHOME)\include" "LIB=$(CCHOME)\lib" "LINK_FLAGS=" .\config.h ..\miniperl.exe
- cd ../wince
host-install:
perl -MConfig -MExtUtils::Install -we "install({'../lib/CORE', qq#$$Config{installprefixexp}/xlib/$(CROSS_NAME)/CORE#},1)"
-@echo off\r
-rem\r
-rem Normally you do not need to run this file.\r
-rem Instead you should edit and execute compile.bat .\r
-rem\r
-rem This file assumes that you have a set of appropriate\r
-rem bat-files that prepare environment variables for build process\r
-rem and execute commands passed as arguments\r
-rem\r
-\r
-call wcearm-300 compile.bat "MACHINE=wince-arm-hpc-wce300"\r
-call wcearm-300 compile.bat "MACHINE=wince-arm-hpc-wce300" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
-call wcearm-211 compile.bat "MACHINE=wince-arm-hpc-wce211"\r
-call wcearm-211 compile.bat "MACHINE=wince-arm-hpc-wce211" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
-call wcesh3-211 compile.bat "MACHINE=wince-sh3-hpc-wce211"\r
-call wcesh3-211 compile.bat "MACHINE=wince-sh3-hpc-wce211" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
-call wcemips-211 compile.bat "MACHINE=wince-mips-hpc-wce211"\r
-call wcemips-211 compile.bat "MACHINE=wince-mips-hpc-wce211" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
-rem TODO call wcesh3-200 compile.bat "MACHINE=wince-sh3-hpc-wce200"\r
-rem TODO call wcesh3-200 compile.bat "MACHINE=wince-sh3-hpc-wce200" zipdist\r
-rem TODO ..\miniperl makedist.pl --clean-exts\r
-\r
-rem TODO call compile.bat "MACHINE=wince-mips-hpc-wce200"\r
-rem TODO call compile.bat "MACHINE=wince-mips-hpc-wce200" zipdist\r
-rem TODO ..\miniperl makedist.pl --clean-exts\r
-\r
-call WCEARM-p300 compile.bat "MACHINE=wince-arm-pocket-wce300"\r
-call WCEARM-p300 compile.bat "MACHINE=wince-arm-pocket-wce300" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
-call WCEMIPS-300 compile.bat "MACHINE=wince-mips-pocket-wce300"\r
-call WCEMIPS-300 compile.bat "MACHINE=wince-mips-pocket-wce300" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
-call WCESH3-300 compile.bat "MACHINE=wince-sh3-pocket-wce300"\r
-call WCESH3-300 compile.bat "MACHINE=wince-sh3-pocket-wce300" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
-call WCEx86-300 compile.bat "MACHINE=wince-x86em-pocket-wce300"\r
-call WCEx86-300 compile.bat "MACHINE=wince-x86em-pocket-wce300" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
-call WCEMIPS-palm211 compile.bat "MACHINE=wince-mips-palm-wce211"\r
-call WCEMIPS-palm211 compile.bat "MACHINE=wince-mips-palm-wce211" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
-call WCESH3-palm211 compile.bat "MACHINE=wince-sh3-palm-wce211"\r
-call WCESH3-palm211 compile.bat "MACHINE=wince-sh3-palm-wce211" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
-call WCEx86-palm211 compile.bat "MACHINE=wince-x86em-palm-wce211"\r
-call WCEx86-palm211 compile.bat "MACHINE=wince-x86em-palm-wce211" zipdist\r
-..\miniperl makedist.pl --clean-exts\r
-\r
+@echo off
+rem
+rem Normally you do not need to run this file.
+rem Instead you should edit and execute compile.bat .
+rem
+rem This file assumes that you have a set of appropriate
+rem bat-files that prepare environment variables for build process
+rem and execute commands passed as arguments
+rem
+
+call wcearm-300 compile.bat "MACHINE=wince-arm-hpc-wce300"
+call wcearm-300 compile.bat "MACHINE=wince-arm-hpc-wce300" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call wcearm-211 compile.bat "MACHINE=wince-arm-hpc-wce211"
+call wcearm-211 compile.bat "MACHINE=wince-arm-hpc-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call wcesh3-211 compile.bat "MACHINE=wince-sh3-hpc-wce211"
+call wcesh3-211 compile.bat "MACHINE=wince-sh3-hpc-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call wcemips-211 compile.bat "MACHINE=wince-mips-hpc-wce211"
+call wcemips-211 compile.bat "MACHINE=wince-mips-hpc-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
+rem TODO call wcesh3-200 compile.bat "MACHINE=wince-sh3-hpc-wce200"
+rem TODO call wcesh3-200 compile.bat "MACHINE=wince-sh3-hpc-wce200" zipdist
+rem TODO ..\miniperl makedist.pl --clean-exts
+
+rem TODO call compile.bat "MACHINE=wince-mips-hpc-wce200"
+rem TODO call compile.bat "MACHINE=wince-mips-hpc-wce200" zipdist
+rem TODO ..\miniperl makedist.pl --clean-exts
+
+call WCEARM-p300 compile.bat "MACHINE=wince-arm-pocket-wce300"
+call WCEARM-p300 compile.bat "MACHINE=wince-arm-pocket-wce300" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCEMIPS-300 compile.bat "MACHINE=wince-mips-pocket-wce300"
+call WCEMIPS-300 compile.bat "MACHINE=wince-mips-pocket-wce300" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCESH3-300 compile.bat "MACHINE=wince-sh3-pocket-wce300"
+call WCESH3-300 compile.bat "MACHINE=wince-sh3-pocket-wce300" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCEx86-300 compile.bat "MACHINE=wince-x86em-pocket-wce300"
+call WCEx86-300 compile.bat "MACHINE=wince-x86em-pocket-wce300" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCEMIPS-palm211 compile.bat "MACHINE=wince-mips-palm-wce211"
+call WCEMIPS-palm211 compile.bat "MACHINE=wince-mips-palm-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCESH3-palm211 compile.bat "MACHINE=wince-sh3-palm-wce211"
+call WCESH3-palm211 compile.bat "MACHINE=wince-sh3-palm-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
+call WCEx86-palm211 compile.bat "MACHINE=wince-x86em-palm-wce211"
+call WCEx86-palm211 compile.bat "MACHINE=wince-x86em-palm-wce211" zipdist
+..\miniperl makedist.pl --clean-exts
+
/*
* Package name : perl5
- * Source directory :
+ * Source directory :
* Configuration time: Thu Nov 10 20:47:18 2005
* Configured by : vkon
- * Target system :
+ * Target system :
*/
#ifndef _config_h_
#define HAS_GETLOGIN /**/
/* HAS_GETPGID:
- * This symbol, if defined, indicates to the C program that
+ * This symbol, if defined, indicates to the C program that
* the getpgid(pid) function is available to get the
* process group id.
*/
/*#define I_MEMORY /**/
/* I_NET_ERRNO:
- * This symbol, if defined, indicates that <net/errno.h> exists and
+ * This symbol, if defined, indicates that <net/errno.h> exists and
* should be included.
*/
/*#define I_NET_ERRNO /**/
* On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture
* Binaries (MAB) on either big endian or little endian machines.
* The endian-ness is available at compile-time. This only matters
- * for perl, where the config.h can be generated and installed on
+ * for perl, where the config.h can be generated and installed on
* one system, and used by a different architecture to build an
* extension. Older versions of NeXT that might not have
* defined either *_ENDIAN__ were all on Motorola 680x0 series,
- * so the default case (for NeXT) is big endian to catch them.
+ * so the default case (for NeXT) is big endian to catch them.
* This might matter for NeXT 3.0.
*/
#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
/* If you can get stringification with catify, tell me how! */
#endif
#if 42 == 42
-#define PeRl_CaTiFy(a, b) a ## b
+#define PeRl_CaTiFy(a, b) a ## b
#define PeRl_StGiFy(a) #a
/* the additional level of indirection enables these macros to be
* used as arguments to other macros. See K&R 2nd ed., page 231. */
#define GMTIME_R_PROTO 0 /**/
/* HAS_GNULIBC:
- * This symbol, if defined, indicates to the C program that
+ * This symbol, if defined, indicates to the C program that
* the GNU C library is being used. A better check is to use
* the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
*/
/*#define HAS_INT64_T /**/
/* HAS_ISASCII:
- * This manifest constant lets the C program know that isascii
+ * This manifest constant lets the C program know that isascii
* is available.
*/
#define HAS_ISASCII /**/
* doubles.
*/
/* LONG_DOUBLESIZE:
- * This symbol contains the size of a long double, so that the
+ * This symbol contains the size of a long double, so that the
* C preprocessor can make decisions based on it. It is only
* defined if the system supports long doubles.
*/
* This symbol will be defined if the C compiler supports long long.
*/
/* LONGLONGSIZE:
- * This symbol contains the size of a long long, so that the
+ * This symbol contains the size of a long long, so that the
* C preprocessor can make decisions based on it. It is only
* defined if the system supports long long.
*/
/*#define OLD_PTHREAD_CREATE_JOINABLE /**/
/* HAS_PTHREAD_YIELD:
- * This symbol, if defined, indicates that the pthread_yield
+ * This symbol, if defined, indicates that the pthread_yield
* routine is available to yield the execution of the current
* thread. sched_yield is preferable to pthread_yield.
*/
*/
/*#define USE_STDIO_PTR /**/
#ifdef USE_STDIO_PTR
-#define FILE_ptr(fp)
+#define FILE_ptr(fp)
/*#define STDIO_PTR_LVALUE /**/
-#define FILE_cnt(fp)
+#define FILE_cnt(fp)
/*#define STDIO_CNT_LVALUE /**/
/*#define STDIO_PTR_LVAL_SETS_CNT /**/
/*#define STDIO_PTR_LVAL_NOCHANGE_CNT /**/
*/
/*#define USE_STDIO_BASE /**/
#ifdef USE_STDIO_BASE
-#define FILE_base(fp)
-#define FILE_bufsiz(fp)
+#define FILE_base(fp)
+#define FILE_bufsiz(fp)
#endif
/* HAS_STRERROR:
* This symbol holds the type used for the second argument to
* getgroups() and setgroups(). Usually, this is the same as
* gidtype (gid_t) , but sometimes it isn't.
- * It can be int, ushort, gid_t, etc...
- * It may be necessary to include <sys/types.h> to get any
+ * It can be int, ushort, gid_t, etc...
+ * It may be necessary to include <sys/types.h> to get any
* typedef'ed information. This is only required if you have
* getgroups() or setgroups()..
*/
#define MYMALLOC /**/
/* Mode_t:
- * This symbol holds the type used to declare file modes
+ * This symbol holds the type used to declare file modes
* for systems calls. It is usually mode_t, but may be
* int or unsigned short. It may be necessary to include <sys/types.h>
* to get any typedef'ed information.
/* Select_fd_set_t:
* This symbol holds the type used for the 2nd, 3rd, and 4th
* arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
- * is defined, and 'int *' otherwise. This is only useful if you
+ * is defined, and 'int *' otherwise. This is only useful if you
* have select(), of course.
*/
#define Select_fd_set_t Perl_fd_set * /**/
* The signals in the list are separated with commas, and the indices
* within that list and the SIG_NAME list match, so it's easy to compute
* the signal name from a number or vice versa at the price of a small
- * dynamic linear lookup.
+ * dynamic linear lookup.
* Duplicates are allowed, but are moved to the end of the list.
* The signal number corresponding to sig_name[i] is sig_number[i].
- * if (i < NSIG) then sig_number[i] == i.
+ * if (i < NSIG) then sig_number[i] == i.
* The last element is 0, corresponding to the 0 at the end of
* the sig_name_init list.
* Note that this variable is initialized from the sig_num_init,
* Usual values include _iob, __iob, and __sF.
*/
/*#define HAS_STDIO_STREAM_ARRAY /**/
-#define STDIO_STREAM_ARRAY
+#define STDIO_STREAM_ARRAY
/* Uid_t_f:
* This symbol defines the format string used for printing a Uid_t.
* If defined, this symbol contains the name of a private library.
* The library is private in the sense that it needn't be in anyone's
* execution path, but it should be accessible by the world.
- * It may have a ~ on the front.
+ * It may have a ~ on the front.
* The standard distribution will put nothing in this directory.
* Vendors who distribute perl may wish to place their own
* architecture-dependent modules and extensions in this directory with
- * MakeMaker Makefile.PL INSTALLDIRS=vendor
+ * MakeMaker Makefile.PL INSTALLDIRS=vendor
* or equivalent. See INSTALL for details.
*/
/* PERL_VENDORARCH_EXP:
extern "C" {
#endif
-#ifndef _WINCE
-
#define WIN32_LEAN_AND_MEAN
#ifdef __GNUC__
# define Win32_Winsock
#endif
#include <windows.h>
-#else
-/*_WINCE*/
-#ifndef FAR
-#define FAR
-#endif
-
-#define PASCAL __stdcall
-#define WINAPI __stdcall
-
-#undef WORD
-typedef int BOOL;
-typedef unsigned short WORD;
-typedef void* HANDLE;
-typedef void* HWND;
-typedef int (FAR WINAPI *FARPROC)();
-
-typedef unsigned long DWORD;
-typedef void *PVOID;
-
-#define IN
-#define OUT
-
-#ifndef UNDER_CE
-typedef struct _OVERLAPPED {
- DWORD Internal;
- DWORD InternalHigh;
- DWORD Offset;
- DWORD OffsetHigh;
- HANDLE hEvent;
-} OVERLAPPED, *LPOVERLAPPED;
-#endif
-
-#undef HOST_NOT_FOUND
-
-#endif /*_WINCE*/
/* Too late to include winsock2.h if winsock.h has already been loaded */
#ifndef _WINSOCKAPI_
+# if defined(UNDER_CE) && UNDER_CE <= 300
+ /* winsock2 only for 4.00+ */
+# include <winsock.h>
+# else
# include <winsock2.h>
#endif
+#endif
#include "win32.h"
'unicode' => 1, # include unicode by default
'minimal' => 0, # minimal possible distribution.
# actually this is just perl.exe and perlXX.dll
- # but can be extended by additional exts
+ # but can be extended by additional exts
# ... (as soon as this will be implemented :)
'cross-name' => 'wince',
'strip-pod' => 0, # strip POD from perl modules
next unless -d $dir;
my $try = "$dir/$modfname.dll";
last if $file = ( (-f $try) && $try);
-
+
$try = "$dir/${modfname}_1.dll";
last if $file = ( (-f $try) && $try);
push @dirs, $dir;
--- /dev/null
+--- win32-o.h 2006-04-28 00:29:04.000000000 +0400
++++ win32.h 2006-04-28 19:34:28.000000000 +0400
+@@ -1,498 +1,579 @@
+-/* Time-stamp: <01/08/01 20:59:54 keuchel@w2k> */
+-
+ /* WIN32.H
+ *
+ * (c) 1995 Microsoft Corporation. All rights reserved.
+ * Developed by hip communications inc., http://info.hip.com/info/
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ */
+-
+ #ifndef _INC_WIN32_PERL5
+ #define _INC_WIN32_PERL5
+
+ #ifndef _WIN32_WINNT
+ # define _WIN32_WINNT 0x0400 /* needed for TryEnterCriticalSection() etc. */
+ #endif
+
+ #if defined(PERL_IMPLICIT_SYS)
+ # define DYNAMIC_ENV_FETCH
+-# define ENV_HV_NAME "___ENV_HV_NAME___"
+ # define HAS_GETENV_LEN
+ # define prime_env_iter()
+ # define WIN32IO_IS_STDIO /* don't pull in custom stdio layer */
+ # define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */
+ # ifdef PERL_GLOBAL_STRUCT
+ # error PERL_GLOBAL_STRUCT cannot be defined with PERL_IMPLICIT_SYS
+ # endif
+ # define win32_get_privlib PerlEnv_lib_path
+ # define win32_get_sitelib PerlEnv_sitelib_path
+ # define win32_get_vendorlib PerlEnv_vendorlib_path
+ #endif
+
+ #ifdef __GNUC__
+ # ifndef __int64 /* some versions seem to #define it already */
+ # define __int64 long long
+ # endif
+ # define Win32_Winsock
++#ifdef __cplusplus
++/* Mingw32 gcc -xc++ objects to __attribute((unused)) at least */
++#undef PERL_UNUSED_DECL
++#define PERL_UNUSED_DECL
+ #endif
++#endif
++
+
+ /* Define DllExport akin to perl's EXT,
+ * If we are in the DLL or mimicing the DLL for Win95 work round
+ * then Export the symbol,
+ * otherwise import it.
+ */
+
+ /* now even GCC supports __declspec() */
+
+ #if defined(PERLDLL) || defined(WIN95FIX)
+ #define DllExport
+ /*#define DllExport __declspec(dllexport)*/ /* noises with VC5+sp3 */
+ #else
+ #define DllExport __declspec(dllimport)
+ #endif
+
+ #define WIN32_LEAN_AND_MEAN
+ #include <windows.h>
+
+ #ifdef WIN32_LEAN_AND_MEAN /* C file is NOT a Perl5 original. */
+ #define CONTEXT PERL_CONTEXT /* Avoid conflict of CONTEXT defs. */
+ #endif /*WIN32_LEAN_AND_MEAN */
+
+ #ifndef TLS_OUT_OF_INDEXES
+ #define TLS_OUT_OF_INDEXES (DWORD)0xFFFFFFFF
+ #endif
+
+ #include <dirent.h>
+-#ifndef UNDER_CE
+ #include <io.h>
+ #include <process.h>
+-#include <direct.h>
+-#include <fcntl.h>
+-#endif
+ #include <stdio.h>
++#include <direct.h>
+ #include <stdlib.h>
++#include <stddef.h>
++#include <fcntl.h>
+ #ifndef EXT
+ #include "EXTERN.h"
+ #endif
+
+ struct tms {
+ long tms_utime;
+ long tms_stime;
+ long tms_cutime;
+ long tms_cstime;
+ };
+
+ #ifndef SYS_NMLN
+ #define SYS_NMLN 257
+ #endif
+
+ struct utsname {
+ char sysname[SYS_NMLN];
+ char nodename[SYS_NMLN];
+ char release[SYS_NMLN];
+ char version[SYS_NMLN];
+ char machine[SYS_NMLN];
+ };
+
+ #ifndef START_EXTERN_C
+ #undef EXTERN_C
+ #ifdef __cplusplus
+ # define START_EXTERN_C extern "C" {
+ # define END_EXTERN_C }
+ # define EXTERN_C extern "C"
+ #else
+ # define START_EXTERN_C
+ # define END_EXTERN_C
+ # define EXTERN_C
+ #endif
+ #endif
+
+ #define STANDARD_C 1
+ #define DOSISH 1 /* no escaping our roots */
+ #define OP_BINARY O_BINARY /* mistake in in pp_sys.c? */
+
+ /* Define USE_SOCKETS_AS_HANDLES to enable emulation of windows sockets as
+ * real filehandles. XXX Should always be defined (the other version is untested) */
+-
+ #define USE_SOCKETS_AS_HANDLES
+
+ /* read() and write() aren't transparent for socket handles */
+ #define PERL_SOCK_SYSREAD_IS_RECV
+ #define PERL_SOCK_SYSWRITE_IS_SEND
+
+ #define PERL_NO_FORCE_LINK /* no need for PL_force_link_funcs */
+
+-/* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls
+- * to read the environment, bypassing the runtime's (usually broken)
+- * facilities for accessing the same. See note in util.c/my_setenv(). */
+-/*#define USE_WIN32_RTL_ENV */
+-
+ /* Define USE_FIXED_OSFHANDLE to fix MSVCRT's _open_osfhandle() on W95.
+ It now uses some black magic to work seamlessly with the DLL CRT and
+ works with MSVC++ 4.0+ or GCC/Mingw32
+ -- BKS 1-24-2000 */
+ #if (defined(_M_IX86) && _MSC_VER >= 1000) || defined(__MINGW32__)
+ #define USE_FIXED_OSFHANDLE
+ #endif
+
++/* Define PERL_WIN32_SOCK_DLOAD to have Perl dynamically load the winsock
++ DLL when needed. Don't use if your compiler supports delayloading (ie, VC++ 6.0)
++ -- BKS 5-29-2000 */
++#if !(defined(_M_IX86) && _MSC_VER >= 1200)
++#define PERL_WIN32_SOCK_DLOAD
++#endif
+ #define ENV_IS_CASELESS
+
++#define PIPESOCK_MODE "b" /* pipes, sockets default to binmode */
++
+ #ifndef VER_PLATFORM_WIN32_WINDOWS /* VC-2.0 headers don't have this */
+ #define VER_PLATFORM_WIN32_WINDOWS 1
+ #endif
+
+ #ifndef FILE_SHARE_DELETE /* VC-4.0 headers don't have this */
+ #define FILE_SHARE_DELETE 0x00000004
+ #endif
+
+ /* access() mode bits */
+ #ifndef R_OK
+ # define R_OK 4
+ # define W_OK 2
+ # define X_OK 1
+ # define F_OK 0
+ #endif
+
++/* for waitpid() */
++#ifndef WNOHANG
++# define WNOHANG 1
++#endif
++
+ #define PERL_GET_CONTEXT_DEFINED
+
+ /* Compiler-specific stuff. */
+
+ #ifdef __BORLANDC__ /* Borland C++ */
+
++#if (__BORLANDC__ <= 0x520)
+ #define _access access
+ #define _chdir chdir
++#endif
++
+ #define _getpid getpid
+ #define wcsicmp _wcsicmp
+ #include <sys/types.h>
+
+ #ifndef DllMain
+ #define DllMain DllEntryPoint
+ #endif
+
+ #pragma warn -ccc /* "condition is always true/false" */
+ #pragma warn -rch /* "unreachable code" */
+ #pragma warn -sig /* "conversion may lose significant digits" */
+ #pragma warn -pia /* "possibly incorrect assignment" */
+ #pragma warn -par /* "parameter 'foo' is never used" */
+ #pragma warn -aus /* "'foo' is assigned a value that is never used" */
+ #pragma warn -use /* "'foo' is declared but never used" */
+ #pragma warn -csu /* "comparing signed and unsigned values" */
+-#pragma warn -pro /* "call to function with no prototype" */
+-#pragma warn -stu /* "undefined structure 'foo'" */
+
+ /* Borland C thinks that a pointer to a member variable is 12 bytes in size. */
+ #define PERL_MEMBER_PTR_SIZE 12
+
++#define isnan _isnan
++
+ #endif
+
+ #ifdef _MSC_VER /* Microsoft Visual C++ */
+
+-#ifndef _MODE_T_DEFINED_
+-typedef unsigned long mode_t;
+-#define _MODE_T_DEFINED_
+-#endif
+-
+-#pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761)
++typedef long uid_t;
++typedef long gid_t;
++typedef unsigned short mode_t;
++#pragma warning(disable: 4102) /* "unreferenced label" */
+
+ /* Visual C thinks that a pointer to a member variable is 16 bytes in size. */
+ #define PERL_MEMBER_PTR_SIZE 16
+
++#define isnan _isnan
++
++#if _MSC_VER < 1300
++/* VC6 has broken NaN semantics: NaN == NaN returns true instead of false */
++#define NAN_COMPARE_BROKEN 1
++#endif
++
+ #endif /* _MSC_VER */
+
+ #ifdef __MINGW32__ /* Minimal Gnu-Win32 */
+
+ typedef long uid_t;
+ typedef long gid_t;
+ #ifndef _environ
+ #define _environ environ
+ #endif
+ #define flushall _flushall
+ #define fcloseall _fcloseall
+-
+-#endif /* __MINGW32__ */
++#define isnan _isnan /* ...same libraries as MSVC */
+
+ #ifndef _O_NOINHERIT
+ # define _O_NOINHERIT 0x0080
+ # ifndef _NO_OLDNAMES
+ # define O_NOINHERIT _O_NOINHERIT
+ # endif
+ #endif
+
++/* <stdint.h>, pulled in by <io.h> as of mingw-runtime-3.3, typedef's
++ * (u)intptr_t but doesn't set the _(U)INTPTR_T_DEFINED defines */
++#ifdef _STDINT_H
++# ifndef _INTPTR_T_DEFINED
++# define _INTPTR_T_DEFINED
++# endif
++# ifndef _UINTPTR_T_DEFINED
++# define _UINTPTR_T_DEFINED
++# endif
++#endif
++
++#endif /* __MINGW32__ */
++
+ /* both GCC/Mingw32 and MSVC++ 4.0 are missing this, so we put it here */
+ #ifndef CP_UTF8
+ # define CP_UTF8 65001
+ #endif
+
+ /* compatibility stuff for other compilers goes here */
+
+ #ifndef _INTPTR_T_DEFINED
+ typedef int intptr_t;
+ # define _INTPTR_T_DEFINED
+ #endif
+
+ #ifndef _UINTPTR_T_DEFINED
+ typedef unsigned int uintptr_t;
+ # define _UINTPTR_T_DEFINED
+ #endif
+
+ START_EXTERN_C
+
++/* For UNIX compatibility. */
++
++extern uid_t getuid(void);
++extern gid_t getgid(void);
++extern uid_t geteuid(void);
++extern gid_t getegid(void);
++extern int setuid(uid_t uid);
++extern int setgid(gid_t gid);
++extern int kill(int pid, int sig);
++#ifndef USE_PERL_SBRK
++extern void *sbrk(ptrdiff_t need);
++# define HAS_SBRK_PROTO
++#endif
++extern char * getlogin(void);
++extern int chown(const char *p, uid_t o, gid_t g);
++extern int mkstemp(const char *path);
++
+ #undef Stat
+ #define Stat win32_stat
+
+ #undef init_os_extras
+ #define init_os_extras Perl_init_os_extras
+
+ DllExport void Perl_win32_init(int *argcp, char ***argvp);
+ DllExport void Perl_win32_term(void);
+-DllExport void Perl_init_os_extras();
++DllExport void Perl_init_os_extras(void);
+ DllExport void win32_str_os_error(void *sv, DWORD err);
+ DllExport int RunPerl(int argc, char **argv, char **env);
+
+ typedef struct {
+ HANDLE childStdIn;
+ HANDLE childStdOut;
+ HANDLE childStdErr;
+ /*
+ * the following correspond to the fields of the same name
+ * in the STARTUPINFO structure. Embedders can use these to
+ * control the spawning process' look.
+ * Example - to hide the window of the spawned process:
+ * dwFlags = STARTF_USESHOWWINDOW;
+ * wShowWindow = SW_HIDE;
+ */
+ DWORD dwFlags;
+ DWORD dwX;
+ DWORD dwY;
+ DWORD dwXSize;
+ DWORD dwYSize;
+ DWORD dwXCountChars;
+ DWORD dwYCountChars;
+ DWORD dwFillAttribute;
+ WORD wShowWindow;
+ } child_IO_table;
+
+ DllExport void win32_get_child_IO(child_IO_table* ptr);
++DllExport HWND win32_create_message_window();
+
+ #ifndef USE_SOCKETS_AS_HANDLES
+ extern FILE * my_fdopen(int, char *);
+ #endif
+-
+ extern int my_fclose(FILE *);
+-extern int do_aspawn(void *really, void **mark, void **sp);
+-extern int do_spawn(char *cmd);
+-extern int do_spawn_nowait(char *cmd);
++extern int my_fstat(int fd, Stat_t *sbufptr);
+ extern char * win32_get_privlib(const char *pl);
+ extern char * win32_get_sitelib(const char *pl);
+ extern char * win32_get_vendorlib(const char *pl);
+ extern int IsWin95(void);
+ extern int IsWinNT(void);
+ extern void win32_argv2utf8(int argc, char** argv);
+
+ #ifdef PERL_IMPLICIT_SYS
+ extern void win32_delete_internal_host(void *h);
+ #endif
+
+ extern char * staticlinkmodules[];
+
+ END_EXTERN_C
+
++typedef char * caddr_t; /* In malloc.c (core address). */
++
+ /*
+ * handle socket stuff, assuming socket is always available
+ */
+-
+ #include <sys/socket.h>
+ #include <netdb.h>
+
+ #ifdef MYMALLOC
+ #define EMBEDMYMALLOC /**/
+ /* #define USE_PERL_SBRK /**/
+ /* #define PERL_SBRK_VIA_MALLOC /**/
+ #endif
+
+ #if defined(PERLDLL) && !defined(PERL_CORE)
+ #define PERL_CORE
+ #endif
+
+ #ifdef PERL_TEXTMODE_SCRIPTS
+ # define PERL_SCRIPT_MODE "r"
+ #else
+ # define PERL_SCRIPT_MODE "rb"
+ #endif
+
+-#ifndef Sighandler_t
+-typedef Signal_t (*Sighandler_t) (int);
+-#define Sighandler_t Sighandler_t
+-#endif
+-
+ /*
+ * Now Win32 specific per-thread data stuff
+ */
+
++/* Leave the first couple ids after WM_USER unused because they
++ * might be used by an embedding application, and on Windows
++ * version before 2000 we might end up eating those messages
++ * if they were not meant for us.
++ */
++#define WM_USER_MIN (WM_USER+30)
++#define WM_USER_MESSAGE (WM_USER_MIN)
++#define WM_USER_KILL (WM_USER_MIN+1)
++#define WM_USER_MAX (WM_USER_MIN+1)
++
+ struct thread_intern {
+ /* XXX can probably use one buffer instead of several */
+ char Wstrerror_buffer[512];
+ struct servent Wservent;
+ char Wgetlogin_buffer[128];
+-# ifdef USE_SOCKETS_AS_HANDLES
+- int Winit_socktype;
+-# endif
+ # ifdef HAVE_DES_FCRYPT
+ char Wcrypt_buffer[30];
+ # endif
+ # ifdef USE_RTL_THREAD_API
+ void * retv; /* slot for thread return value */
+ # endif
+ BOOL Wuse_showwindow;
+ WORD Wshowwindow;
+ };
+
+ #define HAVE_INTERP_INTERN
+ typedef struct {
+ long num;
+ DWORD pids[MAXIMUM_WAIT_OBJECTS];
+ HANDLE handles[MAXIMUM_WAIT_OBJECTS];
+ } child_tab;
+
++#ifdef USE_ITHREADS
++typedef struct {
++ long num;
++ DWORD pids[MAXIMUM_WAIT_OBJECTS];
++ HANDLE handles[MAXIMUM_WAIT_OBJECTS];
++ HWND message_hwnds[MAXIMUM_WAIT_OBJECTS];
++} pseudo_child_tab;
++#endif
++
++#ifndef Sighandler_t
++typedef Signal_t (*Sighandler_t) (int);
++#define Sighandler_t Sighandler_t
++#endif
++
+ struct interp_intern {
+ char * perlshell_tokens;
+ char ** perlshell_vec;
+ long perlshell_items;
+ struct av * fdpid;
+ child_tab * children;
+ #ifdef USE_ITHREADS
+ DWORD pseudo_id;
+- child_tab * pseudo_children;
++ pseudo_child_tab * pseudo_children;
+ #endif
+ void * internal_host;
+ struct thread_intern thr_intern;
++ HWND message_hwnd;
+ UINT timerid;
+ unsigned poll_count;
+ Sighandler_t sigtable[SIG_SIZE];
+ };
+
+ DllExport int win32_async_check(pTHX);
+
+ #define WIN32_POLL_INTERVAL 32768
+ #define PERL_ASYNC_CHECK() if (w32_do_async || PL_sig_pending) win32_async_check(aTHX)
+
+ #define w32_perlshell_tokens (PL_sys_intern.perlshell_tokens)
+ #define w32_perlshell_vec (PL_sys_intern.perlshell_vec)
+ #define w32_perlshell_items (PL_sys_intern.perlshell_items)
+ #define w32_fdpid (PL_sys_intern.fdpid)
+ #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 (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_pseudo_child_message_hwnds (w32_pseudo_children->message_hwnds)
+ #define w32_internal_host (PL_sys_intern.internal_host)
+ #define w32_timerid (PL_sys_intern.timerid)
++#define w32_message_hwnd (PL_sys_intern.message_hwnd)
+ #define w32_sighandler (PL_sys_intern.sigtable)
+ #define w32_poll_count (PL_sys_intern.poll_count)
+ #define w32_do_async (w32_poll_count++ > WIN32_POLL_INTERVAL)
+ #define w32_strerror_buffer (PL_sys_intern.thr_intern.Wstrerror_buffer)
+ #define w32_getlogin_buffer (PL_sys_intern.thr_intern.Wgetlogin_buffer)
+ #define w32_crypt_buffer (PL_sys_intern.thr_intern.Wcrypt_buffer)
+ #define w32_servent (PL_sys_intern.thr_intern.Wservent)
+-#define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype)
+ #define w32_use_showwindow (PL_sys_intern.thr_intern.Wuse_showwindow)
+-#define w32_showwindow (PL_sys_intern.thr_intern.Wshowwindow)
++#define w32_showwindow (PL_sys_intern.thr_intern.Wshowwindow)
+
+ #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
+
+ #if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
+ #ifdef PERL_CORE
+
+ /* C doesn't like repeat struct definitions */
++#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION>=3)
++#undef _CRTIMP
++#endif
+ #ifndef _CRTIMP
+ #define _CRTIMP __declspec(dllimport)
+ #endif
+
+ /*
+ * Control structure for lowio file handles
+ */
+ typedef struct {
+ intptr_t osfhnd;/* underlying OS file HANDLE */
+ char osfile; /* attributes of file (e.g., open in text mode?) */
+ char pipech; /* one char buffer for handles opened on pipes */
+ int lockinitflag;
+ CRITICAL_SECTION lock;
+ } ioinfo;
+
+
+ /*
+ * Array of arrays of control structures for lowio files.
+ */
+ EXTERN_C _CRTIMP ioinfo* __pioinfo[];
+
+ /*
+ * Definition of IOINFO_L2E, the log base 2 of the number of elements in each
+ * array of ioinfo structs.
+ */
+ #define IOINFO_L2E 5
+
+ /*
+ * Definition of IOINFO_ARRAY_ELTS, the number of elements in ioinfo array
+ */
+ #define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E)
+
+ /*
+ * Access macros for getting at an ioinfo struct and its fields from a
+ * file handle
+ */
+ #define _pioinfo(i) (__pioinfo[(i) >> IOINFO_L2E] + ((i) & (IOINFO_ARRAY_ELTS - 1)))
+ #define _osfhnd(i) (_pioinfo(i)->osfhnd)
+ #define _osfile(i) (_pioinfo(i)->osfile)
+ #define _pipech(i) (_pioinfo(i)->pipech)
+
+ /* since we are not doing a dup2(), this works fine */
+ #define _set_osfhnd(fh, osfh) (void)(_osfhnd(fh) = (intptr_t)osfh)
+ #endif
+ #endif
+
+ /* IO.xs and POSIX.xs define PERLIO_NOT_STDIO to 1 */
+ #if defined(PERL_EXT_IO) || defined(PERL_EXT_POSIX)
+ #undef PERLIO_NOT_STDIO
+ #endif
+ #define PERLIO_NOT_STDIO 0
+
+ #include "perlio.h"
+
+ /*
+ * This provides a layer of functions and macros to ensure extensions will
+ * get to use the same RTL functions as the core.
+ */
+ #include "win32iop.h"
+
++#define EXEC_ARGV_CAST(x) ((const char *const *) x)
++
++#if !defined(ECONNABORTED) && defined(WSAECONNABORTED)
++#define ECONNABORTED WSAECONNABORTED
++#endif
++#if !defined(ECONNRESET) && defined(WSAECONNRESET)
++#define ECONNRESET WSAECONNRESET
++#endif
++#if !defined(EAFNOSUPPORT) && defined(WSAEAFNOSUPPORT)
++#define EAFNOSUPPORT WSAEAFNOSUPPORT
++#endif
++/* Why not needed for ECONNREFUSED? --abe */
++
++DllExport void *win32_signal_context(void);
++#define PERL_GET_SIG_CONTEXT win32_signal_context()
++
+ #ifdef _WIN_CE
+ #define Win_GetModuleHandle XCEGetModuleHandleA
+ #define Win_GetProcAddress XCEGetProcAddressA
+ #define Win_GetModuleFileName XCEGetModuleFileNameA
+ #define Win_CreateSemaphore CreateSemaphoreW
+ #else
+ #define Win_GetModuleHandle GetModuleHandle
+ #define Win_GetProcAddress GetProcAddress
+ #define Win_GetModuleFileName GetModuleFileName
+ #define Win_CreateSemaphore CreateSemaphore
+ #endif
+
+ #endif /* _INC_WIN32_PERL5 */
+
#ifdef _MSC_VER /* Microsoft Visual C++ */
+#ifndef UNDER_CE
typedef long uid_t;
typedef long gid_t;
typedef unsigned short mode_t;
+#endif
+
#pragma warning(disable: 4102) /* "unreferenced label" */
/* Visual C thinks that a pointer to a member variable is 16 bytes in size. */
char Wstrerror_buffer[512];
struct servent Wservent;
char Wgetlogin_buffer[128];
+# ifdef USE_SOCKETS_AS_HANDLES
+ int Winit_socktype;
+# endif
# ifdef HAVE_DES_FCRYPT
char Wcrypt_buffer[30];
# endif
#define w32_getlogin_buffer (PL_sys_intern.thr_intern.Wgetlogin_buffer)
#define w32_crypt_buffer (PL_sys_intern.thr_intern.Wcrypt_buffer)
#define w32_servent (PL_sys_intern.thr_intern.Wservent)
+#define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype)
#define w32_use_showwindow (PL_sys_intern.thr_intern.Wuse_showwindow)
#define w32_showwindow (PL_sys_intern.thr_intern.Wshowwindow)
PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
if (s->refcnt == 1)
{
- IV code = 0;
+ IV code = 0;
#if 0
- /* This does not do pipes etc. correctly */
+ /* This does not do pipes etc. correctly */
if (!CloseHandle(s->h))
{
s->h = INVALID_HANDLE_VALUE;
# define END_EXTERN_C }
# define EXTERN_C extern "C"
#else
-# define START_EXTERN_C
-# define END_EXTERN_C
+# define START_EXTERN_C
+# define END_EXTERN_C
# define EXTERN_C
#endif
#endif
#define COND_INIT(c) \
STMT_START { \
(c)->waiters = 0; \
- (c)->sem = CreateSemaphore(NULL,0,LONG_MAX,NULL); \
+ (c)->sem = Win_CreateSemaphore(NULL,0,LONG_MAX,NULL); \
if ((c)->sem == NULL) \
Perl_croak_nocontext("panic: COND_INIT (%ld)",GetLastError()); \
} STMT_END
#include <windows.h>
#include <signal.h>
-#define PERLIO_NOT_STDIO 0
+#define PERLIO_NOT_STDIO 0
#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
#define PerlIO FILE
static DWORD w32_platform = (DWORD)-1;
-int
+int
IsWin95(void)
{
return (win32_os_id() == VER_PLATFORM_WIN32_WINDOWS);
/* Timing related stuff */
int
-do_raise(pTHX_ int sig)
+do_raise(pTHX_ int sig)
{
if (sig < SIG_SIZE) {
Sighandler_t handler = w32_sighandler[sig];
sig_terminate(pTHX_ int sig)
{
Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig);
- /* exit() seems to be safe, my_exit() or die() is a problem in ^C
- thread
+ /* exit() seems to be safe, my_exit() or die() is a problem in ^C
+ thread
*/
exit(sig);
}
{
dTHX;
KillTimer(NULL,timerid);
- timerid=0;
+ timerid=0;
sighandler(14);
}
DllExport unsigned int
win32_alarm(unsigned int sec)
{
- /*
+ /*
* the 'obvious' implentation is SetTimer() with a callback
- * which does whatever receiving SIGALRM would do
- * we cannot use SIGALRM even via raise() as it is not
+ * which does whatever receiving SIGALRM would do
+ * we cannot use SIGALRM even via raise() as it is not
* one of the supported codes in <signal.h>
*
* Snag is unless something is looking at the message queue
* nothing happens :-(
- */
+ */
dTHX;
if (sec)
{
timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
if (!timerid)
Perl_croak_nocontext("Cannot set timer");
- }
+ }
else
{
if (timerid)
{
KillTimer(NULL,timerid);
- timerid=0;
+ timerid=0;
}
}
return 0;
}
/*
- * Since the errors returned by the socket error function
+ * Since the errors returned by the socket error function
* WSAGetLastError() are not known by the library routine strerror
* we have to roll our own.
*/
allocsize = info.dwAllocationGranularity;
}
/* This scheme fails eventually if request for contiguous
- * block is denied so reserve big blocks - this is only
+ * block is denied so reserve big blocks - this is only
* address space not memory ...
*/
if (brk+need >= reserved)
if (addr)
committed = reserved;
}
- /* Reserve some (more) space
+ /* Reserve some (more) space
* Note this is a little sneaky, 1st call passes NULL as reserved
* so lets system choose where we start, subsequent calls pass
* the old end address so ask for a contiguous block
{
char szSourceFile[MAX_PATH+1];
strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
- bResult = XCECopyFileA(szSourceFile, SvPV_nolen(ST(1)),
+ bResult = XCECopyFileA(szSourceFile, SvPV_nolen(ST(1)),
!SvTRUE(ST(2)));
}
unsigned int flags = MB_OK;
txt = SvPV_nolen(ST(0));
-
+
if (items < 1 || items > 2)
Perl_croak(aTHX_ "usage: Win32::MessageBox($txt, [$flags])");
si.cbSize = sizeof(si);
si.fMask = SEE_MASK_FLAG_NO_UI;
- MultiByteToWideChar(CP_ACP, 0, verb, -1,
+ MultiByteToWideChar(CP_ACP, 0, verb, -1,
wverb, sizeof(wverb)/2);
si.lpVerb = (TCHAR *)wverb;
- MultiByteToWideChar(CP_ACP, 0, file, -1,
+ MultiByteToWideChar(CP_ACP, 0, file, -1,
wfile, sizeof(wfile)/2);
si.lpFile = (TCHAR *)wfile;
int
wce_reopen_stdout(char *fname)
-{
+{
if(xcefreopen(fname, "w", stdout) == NULL)
return -1;
return xcegetcwd(buf, size);
}
-int
+int
isnan(double d)
{
return _isnan(d);
DllExport PerlIO*
win32_popen(const char *command, const char *mode)
{
-#ifdef USE_RTL_POPEN
return _popen(command, mode);
-#else
- dTHX;
- int p[2];
- int parent, child;
- int stdfd, oldfd;
- int ourmode;
- int childpid;
- DWORD nhandle;
- HANDLE old_h;
- int lock_held = 0;
-
- /* establish which ends read and write */
- if (strchr(mode,'w')) {
- stdfd = 0; /* stdin */
- parent = 1;
- child = 0;
- nhandle = STD_INPUT_HANDLE;
- }
- else if (strchr(mode,'r')) {
- stdfd = 1; /* stdout */
- parent = 0;
- child = 1;
- nhandle = STD_OUTPUT_HANDLE;
- }
- else
- return NULL;
-
- /* set the correct mode */
- if (strchr(mode,'b'))
- ourmode = O_BINARY;
- else if (strchr(mode,'t'))
- ourmode = O_TEXT;
- else
- ourmode = _fmode & (O_TEXT | O_BINARY);
-
- /* the child doesn't inherit handles */
- ourmode |= O_NOINHERIT;
-
- if (win32_pipe(p, 512, ourmode) == -1)
- return NULL;
-
- /* save current stdfd */
- if ((oldfd = win32_dup(stdfd)) == -1)
- goto cleanup;
-
- /* save the old std handle (this needs to happen before the
- * dup2(), since that might call SetStdHandle() too) */
- OP_REFCNT_LOCK;
- lock_held = 1;
- old_h = GetStdHandle(nhandle);
-
- /* make stdfd go to child end of pipe (implicitly closes stdfd) */
- /* stdfd will be inherited by the child */
- if (win32_dup2(p[child], stdfd) == -1)
- goto cleanup;
-
- /* close the child end in parent */
- win32_close(p[child]);
-
- /* set the new std handle (in case dup2() above didn't) */
- SetStdHandle(nhandle, (HANDLE)_get_osfhandle(stdfd));
-
- /* start the child */
- {
- dTHX;
- if ((childpid = do_spawn_nowait((char*)command)) == -1)
- goto cleanup;
-
- /* revert stdfd to whatever it was before */
- if (win32_dup2(oldfd, stdfd) == -1)
- goto cleanup;
-
- /* restore the old std handle (this needs to happen after the
- * dup2(), since that might call SetStdHandle() too */
- if (lock_held) {
- SetStdHandle(nhandle, old_h);
- OP_REFCNT_UNLOCK;
- lock_held = 0;
- }
-
- /* close saved handle */
- win32_close(oldfd);
-
- LOCK_FDPID_MUTEX;
- sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
- UNLOCK_FDPID_MUTEX;
-
- /* set process id so that it can be returned by perl's open() */
- PL_forkprocess = childpid;
- }
-
- /* we have an fd, return a file stream */
- return (PerlIO_fdopen(p[parent], (char *)mode));
-
-cleanup:
- /* we don't need to check for errors here */
- win32_close(p[0]);
- win32_close(p[1]);
- if (lock_held) {
- SetStdHandle(nhandle, old_h);
- OP_REFCNT_UNLOCK;
- lock_held = 0;
- }
- if (oldfd != -1) {
- win32_dup2(oldfd, stdfd);
- win32_close(oldfd);
- }
- return (NULL);
-
-#endif /* USE_RTL_POPEN */
}
/*
DllExport int
win32_pclose(PerlIO *pf)
{
-#ifdef USE_RTL_POPEN
return _pclose(pf);
-#else
- dTHX;
- int childpid, status;
- SV *sv;
-
- LOCK_FDPID_MUTEX;
- sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE);
-
- if (SvIOK(sv))
- childpid = SvIVX(sv);
- else
- childpid = 0;
-
- if (!childpid) {
- UNLOCK_FDPID_MUTEX;
- errno = EBADF;
- return -1;
- }
-
-#ifdef USE_PERLIO
- PerlIO_close(pf);
-#else
- fclose(pf);
-#endif
- SvIVX(sv) = 0;
- UNLOCK_FDPID_MUTEX;
-
- if (win32_waitpid(childpid, &status, 0) == -1)
- return -1;
-
- return status;
-
-#endif /* USE_RTL_POPEN */
}
#ifdef HAVE_INTERP_INTERN
#endif
#endif
-START_EXTERN_C
+START_EXTERN_C
#ifndef _IOFBF
#define _IOFBF 0x0000
#define gettimeofday xcegettimeofday
#define GetSystemTimeAsFileTime XCEGetSystemTimeAsFileTime
-XCE_EXPORT int xcesetuid(uid_t id);
-XCE_EXPORT int xceseteuid(uid_t id);
-XCE_EXPORT int xcegetuid();
-XCE_EXPORT int xcegeteuid();
-
-XCE_EXPORT int xcesetgid(int id);
-XCE_EXPORT int xcesetegid(int id);
-XCE_EXPORT int xcegetgid();
-XCE_EXPORT int xcegetegid();
-
#define setuid xcesetuid
#define getuid xcegetuid
#define geteuid xcegeteuid
void wce_hitreturn();
-END_EXTERN_C
+END_EXTERN_C
#endif
/* wincesck.c
*
- * (c) 1995 Microsoft Corporation. All rights reserved.
+ * (c) 1995 Microsoft Corporation. All rights reserved.
* Developed by hip communications inc., http://info.hip.com/info/
* Portions (c) 1993 Intergraph Corporation. All rights reserved.
*
} \
} STMT_END
-#define EndSockets() \
- STMT_START { \
- if (wsock_started) \
- WSACleanup(); \
- } STMT_END
-
#define SOCKET_TEST(x, y) \
STMT_START { \
StartSockets(); \
static int wsock_started = 0;
+EXTERN_C void
+EndSockets(void)
+{
+ if (wsock_started)
+ WSACleanup();
+}
+
void
-start_sockets(void)
+start_sockets(void)
{
dTHX;
unsigned short version;
}
int
-win32_recvfrom(SOCKET s, char *buf, int len, int flags,
+win32_recvfrom(SOCKET s, char *buf, int len, int flags,
struct sockaddr *from, int *fromlen)
{
StartSockets();
}
int
-win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr,
+win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr,
Perl_fd_set* ex, const struct timeval* timeout)
{
StartSockets();
}
int
-win32_setsockopt(SOCKET s, int level, int optname,
+win32_setsockopt(SOCKET s, int level, int optname,
const char *optval, int optlen)
{
StartSockets();
return xcesetsockopt(s, level, optname, optval, optlen);
}
-
+
int
win32_shutdown(SOCKET s, int how)
{
struct servent *
win32_getservbyname(const char *name, const char *proto)
{
- dTHX;
+ dTHX;
struct servent *r;
SOCKET_TEST(r = getservbyname(name, proto), NULL);
struct servent *
win32_getservbyport(int port, const char *proto)
{
- dTHX;
+ dTHX;
struct servent *r;
SOCKET_TEST(r = getservbyport(port, proto), NULL);
*/
void
-win32_endhostent()
+win32_endhostent()
{
dTHX;
Perl_croak_nocontext("endhostent not implemented!\n");
struct netent *
-win32_getnetent(void)
+win32_getnetent(void)
{
dTHX;
Perl_croak_nocontext("getnetent not implemented!\n");
}
struct netent *
-win32_getnetbyname(char *name)
+win32_getnetbyname(char *name)
{
dTHX;
Perl_croak_nocontext("getnetbyname not implemented!\n");
}
struct netent *
-win32_getnetbyaddr(long net, int type)
+win32_getnetbyaddr(long net, int type)
{
dTHX;
Perl_croak_nocontext("getnetbyaddr not implemented!\n");
}
struct protoent *
-win32_getprotoent(void)
+win32_getprotoent(void)
{
dTHX;
Perl_croak_nocontext("getprotoent not implemented!\n");
}
struct servent *
-win32_getservent(void)
+win32_getservent(void)
{
dTHX;
Perl_croak_nocontext("getservent not implemented!\n");
d->s_proto = (char *)proto;
else
d->s_proto = "tcp";
-
+
return d;
}
/*
* Package name : perl5
- * Source directory :
- * Configuration time: Thu Nov 10 20:47:18 2005
+ * Source directory :
+ * Configuration time: Mon May 1 01:21:59 2006
* Configured by : vkon
- * Target system :
+ * Target system :
*/
#ifndef _config_h_
#define HAS_GETLOGIN /**/
/* HAS_GETPGID:
- * This symbol, if defined, indicates to the C program that
+ * This symbol, if defined, indicates to the C program that
* the getpgid(pid) function is available to get the
* process group id.
*/
/*#define I_MEMORY /**/
/* I_NET_ERRNO:
- * This symbol, if defined, indicates that <net/errno.h> exists and
+ * This symbol, if defined, indicates that <net/errno.h> exists and
* should be included.
*/
/*#define I_NET_ERRNO /**/
*/
/*#define I_SYS_SECURITY /**/
-/* OSNAME:
- * This symbol contains the name of the operating system, as determined
- * by Configure. You shouldn't rely on it too much; the specific
- * feature tests from Configure are generally more reliable.
- */
-/* OSVERS:
- * This symbol contains the version of the operating system, as determined
- * by Configure. You shouldn't rely on it too much; the specific
- * feature tests from Configure are generally more reliable.
- */
-#define OSNAME "MSWin32" /**/
-#define OSVERS "4.0" /**/
-
/* USE_CROSS_COMPILE:
* This symbol, if defined, indicates that Perl is being cross-compiled.
*/
#define PERL_TARGETARCH "undef" /**/
#endif
+/* OSNAME:
+ * This symbol contains the name of the operating system, as determined
+ * by Configure. You shouldn't rely on it too much; the specific
+ * feature tests from Configure are generally more reliable.
+ */
+/* OSVERS:
+ * This symbol contains the version of the operating system, as determined
+ * by Configure. You shouldn't rely on it too much; the specific
+ * feature tests from Configure are generally more reliable.
+ */
+#define OSNAME "MSWin32" /**/
+#define OSVERS "5.0" /**/
+
/* MULTIARCH:
* This symbol, if defined, signifies that the build
* process will produce some binary files that are going to be
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
+/* PERL_RELOCATABLE_INC:
+ * This symbol, if defined, indicates that we'd like to relocate entries
+ * in @INC at run time based on the location of the perl binary.
+ */
#define BIN "\\Storage Card\\perl58m\\bin" /**/
#define BIN_EXP "\\Storage Card\\perl58m\\bin" /**/
+#define PERL_RELOCATABLE_INC "undef" /**/
/* INTSIZE:
* This symbol contains the value of sizeof(int) so that the C
* On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture
* Binaries (MAB) on either big endian or little endian machines.
* The endian-ness is available at compile-time. This only matters
- * for perl, where the config.h can be generated and installed on
+ * for perl, where the config.h can be generated and installed on
* one system, and used by a different architecture to build an
* extension. Older versions of NeXT that might not have
* defined either *_ENDIAN__ were all on Motorola 680x0 series,
- * so the default case (for NeXT) is big endian to catch them.
+ * so the default case (for NeXT) is big endian to catch them.
* This might matter for NeXT 3.0.
*/
#if defined(USE_CROSS_COMPILE) || defined(MULTIARCH)
/* If you can get stringification with catify, tell me how! */
#endif
#if 42 == 42
-#define PeRl_CaTiFy(a, b) a ## b
+#define PeRl_CaTiFy(a, b) a ## b
#define PeRl_StGiFy(a) #a
/* the additional level of indirection enables these macros to be
* used as arguments to other macros. See K&R 2nd ed., page 231. */
*/
#define HAS_ACCESS /**/
+/* HAS_AINTL:
+ * This symbol, if defined, indicates that the aintl routine is
+ * available. If copysignl is also present we can emulate modfl.
+ */
+/*#define HAS_AINTL /**/
+
/* HAS_ASCTIME_R:
* This symbol, if defined, indicates that the asctime_r routine
* is available to asctime re-entrantly.
/*#define HAS_ASCTIME_R /**/
#define ASCTIME_R_PROTO 0 /**/
+/* HASATTRIBUTE_FORMAT:
+ * Can we handle GCC attribute for checking printf-style formats
+ */
+/* HASATTRIBUTE_MALLOC:
+ * Can we handle GCC attribute for malloc-style functions.
+ */
+/* HASATTRIBUTE_NONNULL:
+ * Can we handle GCC attribute for nonnull function parms.
+ */
+/* HASATTRIBUTE_NORETURN:
+ * Can we handle GCC attribute for functions that do not return
+ */
+/* HASATTRIBUTE_PURE:
+ * Can we handle GCC attribute for pure functions
+ */
+/* HASATTRIBUTE_UNUSED:
+ * Can we handle GCC attribute for unused variables and arguments
+ */
+/* HASATTRIBUTE_WARN_UNUSED_RESULT:
+ * Can we handle GCC attribute for warning on unused results
+ */
+/*#define HASATTRIBUTE_FORMAT /**/
+/*#define HASATTRIBUTE_NORETURN /**/
+/*#define HASATTRIBUTE_MALLOC /**/
+/*#define HASATTRIBUTE_NONNULL /**/
+/*#define HASATTRIBUTE_PURE /**/
+/*#define HASATTRIBUTE_UNUSED /**/
+/*#define HASATTRIBUTE_WARN_UNUSED_RESULT /**/
+
+/* HAS_BUILTIN_CHOOSE_EXPR:
+ * Can we handle GCC builtin for compile-time ternary-like expressions
+ */
+/* HAS_BUILTIN_EXPECT:
+ * Can we handle GCC builtin for telling that certain values are more
+ * likely
+ */
+/*#define HAS_BUILTIN_EXPECT /**/
+/*#define HAS_BUILTIN_CHOOSE_EXPR /**/
+
/* CASTI32:
* This symbol is defined if the C compiler can cast negative
* or large floating point numbers to 32-bit ints.
*/
/*#define HAS_CLASS /**/
+/* HAS_CLEARENV:
+ * This symbol, if defined, indicates that the clearenv () routine is
+ * available for use.
+ */
+/*#define HAS_CLEARENV /**/
+
/* VOID_CLOSEDIR:
* This symbol, if defined, indicates that the closedir() routine
* does not return a value.
*/
/*#define HAS_STRUCT_CMSGHDR /**/
+/* HAS_COPYSIGNL:
+ * This symbol, if defined, indicates that the copysignl routine is
+ * available. If aintl is also present we can emulate modfl.
+ */
+/*#define HAS_COPYSIGNL /**/
+
+/* HAS_CRYPT:
+ * This symbol, if defined, indicates that the crypt routine is available
+ * to encrypt passwords and the like.
+ */
+/*#define HAS_CRYPT /**/
+
/* HAS_CRYPT_R:
* This symbol, if defined, indicates that the crypt_r routine
* is available to crypt re-entrantly.
#define CSH "" /**/
#endif
+/* HAS_CTERMID_R:
+ * This symbol, if defined, indicates that the ctermid_r routine
+ * is available to ctermid re-entrantly.
+ */
+/* CTERMID_R_PROTO:
+ * This symbol encodes the prototype of ctermid_r.
+ * It is zero if d_ctermid_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctermid_r
+ * is defined.
+ */
+/*#define HAS_CTERMID_R /**/
+#define CTERMID_R_PROTO 0 /**/
+
/* HAS_CTIME_R:
* This symbol, if defined, indicates that the ctime_r routine
* is available to ctime re-entrantly.
/*#define HAS_CTIME_R /**/
#define CTIME_R_PROTO 0 /**/
+/* HAS_DBMINIT_PROTO:
+ * This symbol, if defined, indicates that the system provides
+ * a prototype for the dbminit() function. Otherwise, it is up
+ * to the program to supply one. A good guess is
+ * extern int dbminit(char *);
+ */
+/*#define HAS_DBMINIT_PROTO /**/
+
+/* HAS_DIRFD:
+ * This manifest constant lets the C program know that dirfd
+ * is available.
+ */
+/*#define HAS_DIRFD /**/
+
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
* underscore to the symbol name before calling dlsym(). This only
*/
/*#define DLSYM_NEEDS_UNDERSCORE /**/
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
+/*#define DOSUID /**/
+
/* HAS_DRAND48_R:
* This symbol, if defined, indicates that the drand48_r routine
* is available to drand48 re-entrantly.
*/
/*#define HAS_ENDHOSTENT /**/
+/* HAS_ENDHOSTENT_R:
+ * This symbol, if defined, indicates that the endhostent_r routine
+ * is available to endhostent re-entrantly.
+ */
+/* ENDHOSTENT_R_PROTO:
+ * This symbol encodes the prototype of endhostent_r.
+ * It is zero if d_endhostent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endhostent_r
+ * is defined.
+ */
+/*#define HAS_ENDHOSTENT_R /**/
+#define ENDHOSTENT_R_PROTO 0 /**/
+
/* HAS_ENDNETENT:
* This symbol, if defined, indicates that the endnetent() routine is
* available to close whatever was being used for network queries.
*/
/*#define HAS_ENDNETENT /**/
+/* HAS_ENDNETENT_R:
+ * This symbol, if defined, indicates that the endnetent_r routine
+ * is available to endnetent re-entrantly.
+ */
+/* ENDNETENT_R_PROTO:
+ * This symbol encodes the prototype of endnetent_r.
+ * It is zero if d_endnetent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endnetent_r
+ * is defined.
+ */
+/*#define HAS_ENDNETENT_R /**/
+#define ENDNETENT_R_PROTO 0 /**/
+
/* HAS_ENDPROTOENT:
* This symbol, if defined, indicates that the endprotoent() routine is
* available to close whatever was being used for protocol queries.
*/
/*#define HAS_ENDPROTOENT /**/
+/* HAS_ENDPROTOENT_R:
+ * This symbol, if defined, indicates that the endprotoent_r routine
+ * is available to endprotoent re-entrantly.
+ */
+/* ENDPROTOENT_R_PROTO:
+ * This symbol encodes the prototype of endprotoent_r.
+ * It is zero if d_endprotoent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endprotoent_r
+ * is defined.
+ */
+/*#define HAS_ENDPROTOENT_R /**/
+#define ENDPROTOENT_R_PROTO 0 /**/
+
/* HAS_ENDPWENT:
* This symbol, if defined, indicates that the getgrent routine is
* available for finalizing sequential access of the passwd database.
*/
/*#define HAS_ENDSERVENT /**/
+/* HAS_ENDSERVENT_R:
+ * This symbol, if defined, indicates that the endservent_r routine
+ * is available to endservent re-entrantly.
+ */
+/* ENDSERVENT_R_PROTO:
+ * This symbol encodes the prototype of endservent_r.
+ * It is zero if d_endservent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endservent_r
+ * is defined.
+ */
+/*#define HAS_ENDSERVENT_R /**/
+#define ENDSERVENT_R_PROTO 0 /**/
+
+/* HAS_FAST_STDIO:
+ * This symbol, if defined, indicates that the "fast stdio"
+ * is available to manipulate the stdio buffers directly.
+ */
+/*#define HAS_FAST_STDIO /**/
+
/* HAS_FCHDIR:
* This symbol, if defined, indicates that the fchdir routine is
* available to change directory using a file descriptor.
*/
#define FLEXFILENAMES /**/
+/* HAS_FLOCK_PROTO:
+ * This symbol, if defined, indicates that the system provides
+ * a prototype for the flock() function. Otherwise, it is up
+ * to the program to supply one. A good guess is
+ * extern int flock(int, int);
+ */
+/*#define HAS_FLOCK_PROTO /**/
+
/* HAS_FP_CLASS:
* This symbol, if defined, indicates that the fp_class routine is
* available to classify doubles. Available for example in Digital UNIX.
*/
/*#define HAS_FPCLASSIFY /**/
+/* HAS_FPCLASSL:
+ * This symbol, if defined, indicates that the fpclassl routine is
+ * available to classify long doubles. Available for example in IRIX.
+ * The returned values are defined in <ieeefp.h> and are:
+ *
+ * FP_SNAN signaling NaN
+ * FP_QNAN quiet NaN
+ * FP_NINF negative infinity
+ * FP_PINF positive infinity
+ * FP_NDENORM negative denormalized non-zero
+ * FP_PDENORM positive denormalized non-zero
+ * FP_NZERO negative zero
+ * FP_PZERO positive zero
+ * FP_NNORM negative normalized non-zero
+ * FP_PNORM positive normalized non-zero
+ */
+/*#define HAS_FPCLASSL /**/
+
/* HAS_FPOS64_T:
* This symbol will be defined if the C compiler supports fpos64_t.
*/
#define PHOSTNAME "" /* How to get the host name */
#endif
+/* HAS_GETHOSTBYADDR_R:
+ * This symbol, if defined, indicates that the gethostbyaddr_r routine
+ * is available to gethostbyaddr re-entrantly.
+ */
+/* GETHOSTBYADDR_R_PROTO:
+ * This symbol encodes the prototype of gethostbyaddr_r.
+ * It is zero if d_gethostbyaddr_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyaddr_r
+ * is defined.
+ */
+/*#define HAS_GETHOSTBYADDR_R /**/
+#define GETHOSTBYADDR_R_PROTO 0 /**/
+
+/* HAS_GETHOSTBYNAME_R:
+ * This symbol, if defined, indicates that the gethostbyname_r routine
+ * is available to gethostbyname re-entrantly.
+ */
+/* GETHOSTBYNAME_R_PROTO:
+ * This symbol encodes the prototype of gethostbyname_r.
+ * It is zero if d_gethostbyname_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyname_r
+ * is defined.
+ */
+/*#define HAS_GETHOSTBYNAME_R /**/
+#define GETHOSTBYNAME_R_PROTO 0 /**/
+
+/* HAS_GETHOSTENT_R:
+ * This symbol, if defined, indicates that the gethostent_r routine
+ * is available to gethostent re-entrantly.
+ */
+/* GETHOSTENT_R_PROTO:
+ * This symbol encodes the prototype of gethostent_r.
+ * It is zero if d_gethostent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostent_r
+ * is defined.
+ */
+/*#define HAS_GETHOSTENT_R /**/
+#define GETHOSTENT_R_PROTO 0 /**/
+
/* HAS_GETHOST_PROTOS:
* This symbol, if defined, indicates that <netdb.h> includes
* prototypes for gethostent(), gethostbyname(), and
*/
/*#define HAS_GETNETENT /**/
+/* HAS_GETNETBYADDR_R:
+ * This symbol, if defined, indicates that the getnetbyaddr_r routine
+ * is available to getnetbyaddr re-entrantly.
+ */
+/* GETNETBYADDR_R_PROTO:
+ * This symbol encodes the prototype of getnetbyaddr_r.
+ * It is zero if d_getnetbyaddr_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyaddr_r
+ * is defined.
+ */
+/*#define HAS_GETNETBYADDR_R /**/
+#define GETNETBYADDR_R_PROTO 0 /**/
+
+/* HAS_GETNETBYNAME_R:
+ * This symbol, if defined, indicates that the getnetbyname_r routine
+ * is available to getnetbyname re-entrantly.
+ */
+/* GETNETBYNAME_R_PROTO:
+ * This symbol encodes the prototype of getnetbyname_r.
+ * It is zero if d_getnetbyname_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyname_r
+ * is defined.
+ */
+/*#define HAS_GETNETBYNAME_R /**/
+#define GETNETBYNAME_R_PROTO 0 /**/
+
+/* HAS_GETNETENT_R:
+ * This symbol, if defined, indicates that the getnetent_r routine
+ * is available to getnetent re-entrantly.
+ */
+/* GETNETENT_R_PROTO:
+ * This symbol encodes the prototype of getnetent_r.
+ * It is zero if d_getnetent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetent_r
+ * is defined.
+ */
+/*#define HAS_GETNETENT_R /**/
+#define GETNETENT_R_PROTO 0 /**/
+
/* HAS_GETNET_PROTOS:
* This symbol, if defined, indicates that <netdb.h> includes
* prototypes for getnetent(), getnetbyname(), and
#define HAS_GETPROTOBYNAME /**/
#define HAS_GETPROTOBYNUMBER /**/
+/* HAS_GETPROTOBYNAME_R:
+ * This symbol, if defined, indicates that the getprotobyname_r routine
+ * is available to getprotobyname re-entrantly.
+ */
+/* GETPROTOBYNAME_R_PROTO:
+ * This symbol encodes the prototype of getprotobyname_r.
+ * It is zero if d_getprotobyname_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobyname_r
+ * is defined.
+ */
+/*#define HAS_GETPROTOBYNAME_R /**/
+#define GETPROTOBYNAME_R_PROTO 0 /**/
+
+/* HAS_GETPROTOBYNUMBER_R:
+ * This symbol, if defined, indicates that the getprotobynumber_r routine
+ * is available to getprotobynumber re-entrantly.
+ */
+/* GETPROTOBYNUMBER_R_PROTO:
+ * This symbol encodes the prototype of getprotobynumber_r.
+ * It is zero if d_getprotobynumber_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobynumber_r
+ * is defined.
+ */
+/*#define HAS_GETPROTOBYNUMBER_R /**/
+#define GETPROTOBYNUMBER_R_PROTO 0 /**/
+
+/* HAS_GETPROTOENT_R:
+ * This symbol, if defined, indicates that the getprotoent_r routine
+ * is available to getprotoent re-entrantly.
+ */
+/* GETPROTOENT_R_PROTO:
+ * This symbol encodes the prototype of getprotoent_r.
+ * It is zero if d_getprotoent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotoent_r
+ * is defined.
+ */
+/*#define HAS_GETPROTOENT_R /**/
+#define GETPROTOENT_R_PROTO 0 /**/
+
/* HAS_GETPROTO_PROTOS:
* This symbol, if defined, indicates that <netdb.h> includes
* prototypes for getprotoent(), getprotobyname(), and
*/
/*#define HAS_GETSERVENT /**/
+/* HAS_GETSERVBYNAME_R:
+ * This symbol, if defined, indicates that the getservbyname_r routine
+ * is available to getservbyname re-entrantly.
+ */
+/* GETSERVBYNAME_R_PROTO:
+ * This symbol encodes the prototype of getservbyname_r.
+ * It is zero if d_getservbyname_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r
+ * is defined.
+ */
+/*#define HAS_GETSERVBYNAME_R /**/
+#define GETSERVBYNAME_R_PROTO 0 /**/
+
+/* HAS_GETSERVBYPORT_R:
+ * This symbol, if defined, indicates that the getservbyport_r routine
+ * is available to getservbyport re-entrantly.
+ */
+/* GETSERVBYPORT_R_PROTO:
+ * This symbol encodes the prototype of getservbyport_r.
+ * It is zero if d_getservbyport_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyport_r
+ * is defined.
+ */
+/*#define HAS_GETSERVBYPORT_R /**/
+#define GETSERVBYPORT_R_PROTO 0 /**/
+
+/* HAS_GETSERVENT_R:
+ * This symbol, if defined, indicates that the getservent_r routine
+ * is available to getservent re-entrantly.
+ */
+/* GETSERVENT_R_PROTO:
+ * This symbol encodes the prototype of getservent_r.
+ * It is zero if d_getservent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservent_r
+ * is defined.
+ */
+/*#define HAS_GETSERVENT_R /**/
+#define GETSERVENT_R_PROTO 0 /**/
+
/* HAS_GETSERV_PROTOS:
* This symbol, if defined, indicates that <netdb.h> includes
* prototypes for getservent(), getservbyname(), and
#define GMTIME_R_PROTO 0 /**/
/* HAS_GNULIBC:
- * This symbol, if defined, indicates to the C program that
+ * This symbol, if defined, indicates to the C program that
* the GNU C library is being used. A better check is to use
* the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc.
*/
#define HAS_NTOHL /**/
#define HAS_NTOHS /**/
+/* HAS_ILOGBL:
+ * This symbol, if defined, indicates that the ilogbl routine is
+ * available. If scalbnl is also present we can emulate frexpl.
+ */
+/*#define HAS_ILOGBL /**/
+
/* HAS_INT64_T:
* This symbol will defined if the C compiler supports int64_t.
* Usually the <inttypes.h> needs to be included, but sometimes
/*#define HAS_INT64_T /**/
/* HAS_ISASCII:
- * This manifest constant lets the C program know that isascii
+ * This manifest constant lets the C program know that isascii
* is available.
*/
#define HAS_ISASCII /**/
*/
#define HAS_LDBL_DIG /**/
+/* LIBM_LIB_VERSION:
+ * This symbol, if defined, indicates that libm exports _LIB_VERSION
+ * and that math.h defines the enum to manipulate it.
+ */
+/*#define LIBM_LIB_VERSION /**/
+
/* HAS_LOCALTIME_R:
* This symbol, if defined, indicates that the localtime_r routine
* is available to localtime re-entrantly.
* doubles.
*/
/* LONG_DOUBLESIZE:
- * This symbol contains the size of a long double, so that the
+ * This symbol contains the size of a long double, so that the
* C preprocessor can make decisions based on it. It is only
* defined if the system supports long doubles.
*/
* This symbol will be defined if the C compiler supports long long.
*/
/* LONGLONGSIZE:
- * This symbol contains the size of a long long, so that the
+ * This symbol contains the size of a long long, so that the
* C preprocessor can make decisions based on it. It is only
* defined if the system supports long long.
*/
*/
/*#define HAS_STRUCT_MSGHDR /**/
+/* HAS_NL_LANGINFO:
+ * This symbol, if defined, indicates that the nl_langinfo routine is
+ * available to return local data. You will also need <langinfo.h>
+ * and therefore I_LANGINFO.
+ */
+/*#define HAS_NL_LANGINFO /**/
+
/* HAS_OFF64_T:
* This symbol will be defined if the C compiler supports off64_t.
*/
*/
/*#define HAS_OPEN3 /**/
+/* HAS_PROCSELFEXE:
+ * This symbol is defined if PROCSELFEXE_PATH is a symlink
+ * to the absolute pathname of the executing program.
+ */
+/* PROCSELFEXE_PATH:
+ * If HAS_PROCSELFEXE is defined this symbol is the filename
+ * of the symbolic link pointing to the absolute pathname of
+ * the executing program.
+ */
+/*#define HAS_PROCSELFEXE /**/
+#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
+#define PROCSELFEXE_PATH /**/
+#endif
+
/* OLD_PTHREAD_CREATE_JOINABLE:
* This symbol, if defined, indicates how to create pthread
* in joinable (aka undetached) state. NOTE: not defined
*/
/*#define OLD_PTHREAD_CREATE_JOINABLE /**/
+/* HAS_PTHREAD_ATFORK:
+ * This symbol, if defined, indicates that the pthread_atfork routine
+ * is available to setup fork handlers.
+ */
+/*#define HAS_PTHREAD_ATFORK /**/
+
+/* HAS_PTHREAD_ATTR_SETSCOPE:
+ * This symbol, if defined, indicates that the pthread_attr_setscope
+ * system call is available to set the contention scope attribute of
+ * a thread attribute object.
+ */
+/*#define HAS_PTHREAD_ATTR_SETSCOPE /**/
+
/* HAS_PTHREAD_YIELD:
- * This symbol, if defined, indicates that the pthread_yield
+ * This symbol, if defined, indicates that the pthread_yield
* routine is available to yield the execution of the current
* thread. sched_yield is preferable to pthread_yield.
*/
/*#define HAS_RANDOM_R /**/
#define RANDOM_R_PROTO 0 /**/
+/* HAS_READDIR64_R:
+ * This symbol, if defined, indicates that the readdir64_r routine
+ * is available to readdir64 re-entrantly.
+ */
+/* READDIR64_R_PROTO:
+ * This symbol encodes the prototype of readdir64_r.
+ * It is zero if d_readdir64_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir64_r
+ * is defined.
+ */
+/*#define HAS_READDIR64_R /**/
+#define READDIR64_R_PROTO 0 /**/
+
/* HAS_READDIR_R:
* This symbol, if defined, indicates that the readdir_r routine
* is available to readdir re-entrantly.
*/
/*#define HAS_SBRK_PROTO /**/
+/* HAS_SCALBNL:
+ * This symbol, if defined, indicates that the scalbnl routine is
+ * available. If ilogbl is also present we can emulate frexpl.
+ */
+/*#define HAS_SCALBNL /**/
+
/* HAS_SEM:
* This symbol, if defined, indicates that the entire sem*(2) library is
* supported.
*/
/*#define HAS_SETHOSTENT /**/
+/* HAS_SETHOSTENT_R:
+ * This symbol, if defined, indicates that the sethostent_r routine
+ * is available to sethostent re-entrantly.
+ */
+/* SETHOSTENT_R_PROTO:
+ * This symbol encodes the prototype of sethostent_r.
+ * It is zero if d_sethostent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_sethostent_r
+ * is defined.
+ */
+/*#define HAS_SETHOSTENT_R /**/
+#define SETHOSTENT_R_PROTO 0 /**/
+
/* HAS_SETITIMER:
* This symbol, if defined, indicates that the setitimer routine is
* available to set interval timers.
*/
/*#define HAS_SETITIMER /**/
+/* HAS_SETLOCALE_R:
+ * This symbol, if defined, indicates that the setlocale_r routine
+ * is available to setlocale re-entrantly.
+ */
+/* SETLOCALE_R_PROTO:
+ * This symbol encodes the prototype of setlocale_r.
+ * It is zero if d_setlocale_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setlocale_r
+ * is defined.
+ */
+/*#define HAS_SETLOCALE_R /**/
+#define SETLOCALE_R_PROTO 0 /**/
+
/* HAS_SETNETENT:
* This symbol, if defined, indicates that the setnetent() routine is
* available.
*/
/*#define HAS_SETNETENT /**/
+/* HAS_SETNETENT_R:
+ * This symbol, if defined, indicates that the setnetent_r routine
+ * is available to setnetent re-entrantly.
+ */
+/* SETNETENT_R_PROTO:
+ * This symbol encodes the prototype of setnetent_r.
+ * It is zero if d_setnetent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setnetent_r
+ * is defined.
+ */
+/*#define HAS_SETNETENT_R /**/
+#define SETNETENT_R_PROTO 0 /**/
+
/* HAS_SETPROTOENT:
* This symbol, if defined, indicates that the setprotoent() routine is
* available.
*/
/*#define HAS_SETPROCTITLE /**/
+/* HAS_SETPROTOENT_R:
+ * This symbol, if defined, indicates that the setprotoent_r routine
+ * is available to setprotoent re-entrantly.
+ */
+/* SETPROTOENT_R_PROTO:
+ * This symbol encodes the prototype of setprotoent_r.
+ * It is zero if d_setprotoent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setprotoent_r
+ * is defined.
+ */
+/*#define HAS_SETPROTOENT_R /**/
+#define SETPROTOENT_R_PROTO 0 /**/
+
/* HAS_SETPWENT:
* This symbol, if defined, indicates that the setpwent routine is
* available for initializing sequential access of the passwd database.
*/
/*#define HAS_SETSERVENT /**/
+/* HAS_SETSERVENT_R:
+ * This symbol, if defined, indicates that the setservent_r routine
+ * is available to setservent re-entrantly.
+ */
+/* SETSERVENT_R_PROTO:
+ * This symbol encodes the prototype of setservent_r.
+ * It is zero if d_setservent_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r
+ * is defined.
+ */
+/*#define HAS_SETSERVENT_R /**/
+#define SETSERVENT_R_PROTO 0 /**/
+
/* HAS_SETVBUF:
* This symbol, if defined, indicates that the setvbuf routine is
* available to change buffering on an open stdio stream.
*/
/*#define HAS_SHM /**/
-/* HAS_SIGACTION:
- * This symbol, if defined, indicates that Vr4's sigaction() routine
- * is available.
+/* Shmat_t:
+ * This symbol holds the return type of the shmat() system call.
+ * Usually set to 'void *' or 'char *'.
*/
-/*#define HAS_SIGACTION /**/
-
+/* HAS_SHMAT_PROTOTYPE:
+ * This symbol, if defined, indicates that the sys/shm.h includes
+ * a prototype for shmat(). Otherwise, it is up to the program to
+ * guess one. Shmat_t shmat(int, Shmat_t, int) is a good guess,
+ * but not always right so it should be emitted by the program only
+ * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
+ */
+#define Shmat_t void * /**/
+/*#define HAS_SHMAT_PROTOTYPE /**/
+
+/* HAS_SIGACTION:
+ * This symbol, if defined, indicates that Vr4's sigaction() routine
+ * is available.
+ */
+/*#define HAS_SIGACTION /**/
+
+/* HAS_SIGPROCMASK:
+ * This symbol, if defined, indicates that the sigprocmask
+ * system call is available to examine or change the signal mask
+ * of the calling process.
+ */
+/*#define HAS_SIGPROCMASK /**/
+
/* HAS_SIGSETJMP:
* This variable indicates to the C program that the sigsetjmp()
* routine is available to save the calling process's registers
* This symbol, if defined, indicates that sitecustomize should
* be used.
*/
+#ifndef USE_SITECUSTOMIZE
/*#define USE_SITECUSTOMIZE /**/
+#endif
+
+/* HAS_SNPRINTF:
+ * This symbol, if defined, indicates that the snprintf () library
+ * function is available for use.
+ */
+/* HAS_VSNPRINTF:
+ * This symbol, if defined, indicates that the vsnprintf () library
+ * function is available for use.
+ */
+/*#define HAS_SNPRINTF /**/
+/*#define HAS_VSNPRINTF /**/
+
+/* HAS_SOCKATMARK:
+ * This symbol, if defined, indicates that the sockatmark routine is
+ * available to test whether a socket is at the out-of-band mark.
+ */
+/*#define HAS_SOCKATMARK /**/
+
+/* HAS_SOCKATMARK_PROTO:
+ * This symbol, if defined, indicates that the system provides
+ * a prototype for the sockatmark() function. Otherwise, it is up
+ * to the program to supply one. A good guess is
+ * extern int sockatmark(int);
+ */
+/*#define HAS_SOCKATMARK_PROTO /**/
/* HAS_SOCKET:
* This symbol, if defined, indicates that the BSD socket interface is
*/
/*#define HAS_SOCKS5_INIT /**/
+/* SPRINTF_RETURNS_STRLEN:
+ * This variable defines whether sprintf returns the length of the string
+ * (as per the ANSI spec). Some C libraries retain compatibility with
+ * pre-ANSI C and return a pointer to the passed in buffer; for these
+ * this variable will be undef.
+ */
+#define SPRINTF_RETURNS_STRLEN /**/
+
/* HAS_SQRTL:
* This symbol, if defined, indicates that the sqrtl routine is
* available to do long double square roots.
/*#define HAS_SRANDOM_R /**/
#define SRANDOM_R_PROTO 0 /**/
+/* HAS_SETRESGID_PROTO:
+ * This symbol, if defined, indicates that the system provides
+ * a prototype for the setresgid() function. Otherwise, it is up
+ * to the program to supply one. Good guesses are
+ * extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
+ */
+/*#define HAS_SETRESGID_PROTO /**/
+
+/* HAS_SETRESUID_PROTO:
+ * This symbol, if defined, indicates that the system provides
+ * a prototype for the setresuid() function. Otherwise, it is up
+ * to the program to supply one. Good guesses are
+ * extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
+ */
+/*#define HAS_SETRESUID_PROTO /**/
+
/* USE_STAT_BLOCKS:
* This symbol is defined if this system has a stat structure declaring
* st_blksize and st_blocks.
*/
/*#define USE_STDIO_PTR /**/
#ifdef USE_STDIO_PTR
-#define FILE_ptr(fp)
+#define FILE_ptr(fp)
/*#define STDIO_PTR_LVALUE /**/
-#define FILE_cnt(fp)
+#define FILE_cnt(fp)
/*#define STDIO_CNT_LVALUE /**/
/*#define STDIO_PTR_LVAL_SETS_CNT /**/
/*#define STDIO_PTR_LVAL_NOCHANGE_CNT /**/
*/
/*#define USE_STDIO_BASE /**/
#ifdef USE_STDIO_BASE
-#define FILE_base(fp)
-#define FILE_bufsiz(fp)
+#define FILE_base(fp)
+#define FILE_bufsiz(fp)
#endif
/* HAS_STRERROR:
/*#define HAS_STRERROR_R /**/
#define STRERROR_R_PROTO 0 /**/
+/* HAS_STRFTIME:
+ * This symbol, if defined, indicates that the strftime routine is
+ * available to do time formatting.
+ */
+/*#define HAS_STRFTIME /**/
+
+/* HAS_STRLCAT:
+ * This symbol, if defined, indicates that the strlcat () routine is
+ * available to do string concatenation.
+ */
+/*#define HAS_STRLCAT /**/
+
+/* HAS_STRLCPY:
+ * This symbol, if defined, indicates that the strlcpy () routine is
+ * available to do string copying.
+ */
+/*#define HAS_STRLCPY /**/
+
/* HAS_STRTOLD:
* This symbol, if defined, indicates that the strtold routine is
* available to convert strings to long doubles.
*/
/*#define HAS_STRTOUQ /**/
+/* HAS_SYSCALL_PROTO:
+ * This symbol, if defined, indicates that the system provides
+ * a prototype for the syscall() function. Otherwise, it is up
+ * to the program to supply one. Good guesses are
+ * extern int syscall(int, ...);
+ * extern int syscall(long, ...);
+ */
+/*#define HAS_SYSCALL_PROTO /**/
+
/* HAS_TELLDIR_PROTO:
* This symbol, if defined, indicates that the system provides
* a prototype for the telldir() function. Otherwise, it is up
/*#define HAS_TMPNAM_R /**/
#define TMPNAM_R_PROTO 0 /**/
+/* HAS_TTYNAME_R:
+ * This symbol, if defined, indicates that the ttyname_r routine
+ * is available to ttyname re-entrantly.
+ */
+/* TTYNAME_R_PROTO:
+ * This symbol encodes the prototype of ttyname_r.
+ * It is zero if d_ttyname_r is undef, and one of the
+ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
+ * is defined.
+ */
+/*#define HAS_TTYNAME_R /**/
+#define TTYNAME_R_PROTO 0 /**/
+
+/* U32_ALIGNMENT_REQUIRED:
+ * This symbol, if defined, indicates that you must access
+ * character data through U32-aligned pointers.
+ */
+#ifndef U32_ALIGNMENT_REQUIRED
+/*#define U32_ALIGNMENT_REQUIRED /**/
+#endif
+
/* HAS_UALARM:
* This symbol, if defined, indicates that the ualarm routine is
* available to do alarms with microsecond granularity.
*/
/*#define HAS_UNSETENV /**/
+/* HAS_USLEEP_PROTO:
+ * This symbol, if defined, indicates that the system provides
+ * a prototype for the usleep() function. Otherwise, it is up
+ * to the program to supply one. A good guess is
+ * extern int usleep(useconds_t);
+ */
+/*#define HAS_USLEEP_PROTO /**/
+
/* HAS_USTAT:
* This symbol, if defined, indicates that the ustat system call is
* available to query file system statistics by dev_t.
* This symbol holds the type used for the second argument to
* getgroups() and setgroups(). Usually, this is the same as
* gidtype (gid_t) , but sometimes it isn't.
- * It can be int, ushort, gid_t, etc...
- * It may be necessary to include <sys/types.h> to get any
+ * It can be int, ushort, gid_t, etc...
+ * It may be necessary to include <sys/types.h> to get any
* typedef'ed information. This is only required if you have
* getgroups() or setgroups()..
*/
#define Groups_t gid_t /* Type for 2nd arg to [sg]etgroups() */
#endif
+/* I_CRYPT:
+ * This symbol, if defined, indicates that <crypt.h> exists and
+ * should be included.
+ */
+/*#define I_CRYPT /**/
+
/* DB_Prefix_t:
* This symbol contains the type of the prefix structure element
* in the <db.h> header file. In older versions of DB, it was
#define DB_VERSION_MINOR_CFG undef /**/
#define DB_VERSION_PATCH_CFG undef /**/
+/* I_FP:
+ * This symbol, if defined, indicates that <fp.h> exists and
+ * should be included.
+ */
+/*#define I_FP /**/
+
/* I_FP_CLASS:
* This symbol, if defined, indicates that <fp_class.h> exists and
* should be included.
*/
/*#define I_INTTYPES /**/
+/* I_LANGINFO:
+ * This symbol, if defined, indicates that <langinfo.h> exists and
+ * should be included.
+ */
+/*#define I_LANGINFO /**/
+
/* I_LIBUTIL:
* This symbol, if defined, indicates that <libutil.h> exists and
* should be included.
*/
/*#define I_MNTENT /**/
+/* I_NDBM:
+ * This symbol, if defined, indicates that <ndbm.h> exists and should
+ * be included.
+ */
+/*#define I_NDBM /**/
+
/* I_NETDB:
* This symbol, if defined, indicates that <netdb.h> exists and
* should be included.
*/
/*#define I_USTAT /**/
+/* I_STDARG:
+ * This symbol, if defined, indicates that <stdarg.h> exists and should
+ * be included.
+ */
+/* I_VARARGS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <varargs.h>.
+ */
+#define I_STDARG /**/
+/*#define I_VARARGS /**/
+
/* PERL_INC_VERSION_LIST:
* This variable specifies the list of subdirectories in over
* which perl.c:incpush() and lib/lib.pm will automatically
* for a C initialization string. See the inc_version_list entry
* in Porting/Glossary for more details.
*/
-#define PERL_INC_VERSION_LIST 0 /**/
+/*#define PERL_INC_VERSION_LIST 0 /**/
/* INSTALL_USR_BIN_PERL:
* This symbol, if defined, indicates that Perl is to be installed
/*#define PERL_PRIfldbl "f" /**/
/*#define PERL_PRIgldbl "g" /**/
/*#define PERL_PRIeldbl "e" /**/
-/*#define PERL_SCNfldbl undef /**/
+/*#define PERL_SCNfldbl /**/
/* Off_t:
* This symbol holds the type used to declare offsets in the kernel.
/* Off_t_size:
* This symbol holds the number of bytes used by the Off_t.
*/
-#define Off_t long /* <offset> type */
+#define Off_t off_t /* <offset> type */
#define LSEEKSIZE 4 /* <offset> size */
#define Off_t_size 4 /* <offset> size */
+/* PERL_MAD:
+ * This symbol, if defined, indicates that the Misc Attribution
+ * Declaration code should be conditionally compiled.
+ */
+/*#define PERL_MAD /**/
+
/* Free_t:
* This variable contains the return type of free(). It is usually
* void, but occasionally int.
#define MYMALLOC /**/
/* Mode_t:
- * This symbol holds the type used to declare file modes
+ * This symbol holds the type used to declare file modes
* for systems calls. It is usually mode_t, but may be
* int or unsigned short. It may be necessary to include <sys/types.h>
* to get any typedef'ed information.
#endif
#define NVSIZE 8 /**/
#define NV_PRESERVES_UV
-#define NV_PRESERVES_UV_BITS undef
+#define NV_PRESERVES_UV_BITS 32
#undef NV_ZERO_IS_ALLBITS_ZERO
#if UVSIZE == 8
# ifdef BYTEORDER
#define PRIVLIB "\\Storage Card\\perl58m\\lib" /**/
#define PRIVLIB_EXP (win32_get_privlib("5.9.4")) /**/
+/* CAN_PROTOTYPE:
+ * If defined, this macro indicates that the C compiler can handle
+ * function prototypes.
+ */
+/* _:
+ * This macro is used to declare function parameters for folks who want
+ * to make declarations with prototypes using a different style than
+ * the above macros. Use double parentheses. For example:
+ *
+ * int main _((int argc, char *argv[]));
+ */
+#define CAN_PROTOTYPE /**/
+#ifdef CAN_PROTOTYPE
+#define _(args) args
+#else
+#define _(args) ()
+#endif
+
/* PTRSIZE:
* This symbol contains the size of a pointer, so that the C preprocessor
* can make decisions based on it. It will be sizeof(void *) if
/* Select_fd_set_t:
* This symbol holds the type used for the 2nd, 3rd, and 4th
* arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
- * is defined, and 'int *' otherwise. This is only useful if you
+ * is defined, and 'int *' otherwise. This is only useful if you
* have select(), of course.
*/
#define Select_fd_set_t Perl_fd_set * /**/
+/* SH_PATH:
+ * This symbol contains the full pathname to the shell used on this
+ * on this system to execute Bourne shell scripts. Usually, this will be
+ * /bin/sh, though it's possible that some systems will have /bin/ksh,
+ * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
+ * D:/bin/sh.exe.
+ */
+#define SH_PATH "cmd /x /c" /**/
+
/* SIG_NAME:
* This symbol contains a list of signal names in order of
* signal number. This is intended
* The signals in the list are separated with commas, and the indices
* within that list and the SIG_NAME list match, so it's easy to compute
* the signal name from a number or vice versa at the price of a small
- * dynamic linear lookup.
+ * dynamic linear lookup.
* Duplicates are allowed, but are moved to the end of the list.
* The signal number corresponding to sig_name[i] is sig_number[i].
- * if (i < NSIG) then sig_number[i] == i.
+ * if (i < NSIG) then sig_number[i] == i.
* The last element is 0, corresponding to the 0 at the end of
* the sig_name_init list.
* Note that this variable is initialized from the sig_num_init,
* Usual values include _iob, __iob, and __sF.
*/
/*#define HAS_STDIO_STREAM_ARRAY /**/
-#define STDIO_STREAM_ARRAY
+#define STDIO_STREAM_ARRAY
/* Uid_t_f:
* This symbol defines the format string used for printing a Uid_t.
/*#define USE_64_BIT_ALL /**/
#endif
+/* USE_FAST_STDIO:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use 'fast stdio'.
+ * Defaults to define in Perls 5.8 and earlier, to undef later.
+ */
+#ifndef USE_FAST_STDIO
+/*#define USE_FAST_STDIO /**/
+#endif
+
/* USE_LARGE_FILES:
* This symbol, if defined, indicates that large file support
* should be used when available.
* If defined, this symbol contains the name of a private library.
* The library is private in the sense that it needn't be in anyone's
* execution path, but it should be accessible by the world.
- * It may have a ~ on the front.
+ * It may have a ~ on the front.
* The standard distribution will put nothing in this directory.
* Vendors who distribute perl may wish to place their own
* architecture-dependent modules and extensions in this directory with
- * MakeMaker Makefile.PL INSTALLDIRS=vendor
+ * MakeMaker Makefile.PL INSTALLDIRS=vendor
* or equivalent. See INSTALL for details.
*/
/* PERL_VENDORARCH_EXP:
#define M_VOID /* Xenix strikes again */
#endif
-/* HASATTRIBUTE_FORMAT:
- * Can we handle GCC attribute for checking printf-style formats
- */
-/* HASATTRIBUTE_MALLOC:
- * Can we handle GCC attribute for malloc-style functions.
- */
-/* HASATTRIBUTE_NONNULL:
- * Can we handle GCC attribute for nonnull function parms.
- */
-/* HASATTRIBUTE_NORETURN:
- * Can we handle GCC attribute for functions that do not return
- */
-/* HASATTRIBUTE_PURE:
- * Can we handle GCC attribute for pure functions
- */
-/* HASATTRIBUTE_UNUSED:
- * Can we handle GCC attribute for unused variables and arguments
- */
-/* HASATTRIBUTE_WARN_UNUSED_RESULT:
- * Can we handle GCC attribute for warning on unused results
- */
-/*#define HASATTRIBUTE_FORMAT /**/
-/*#define HASATTRIBUTE_NORETURN /**/
-/*#define HASATTRIBUTE_MALLOC /**/
-/*#define HASATTRIBUTE_NONNULL /**/
-/*#define HASATTRIBUTE_PURE /**/
-/*#define HASATTRIBUTE_UNUSED /**/
-/*#define HASATTRIBUTE_WARN_UNUSED_RESULT /**/
-
-/* HAS_CRYPT:
- * This symbol, if defined, indicates that the crypt routine is available
- * to encrypt passwords and the like.
- */
-/*#define HAS_CRYPT /**/
-
-/* SETUID_SCRIPTS_ARE_SECURE_NOW:
- * This symbol, if defined, indicates that the bug that prevents
- * setuid scripts from being secure is not present in this kernel.
- */
-/* DOSUID:
- * This symbol, if defined, indicates that the C program should
- * check the script that it is executing for setuid/setgid bits, and
- * attempt to emulate setuid/setgid on systems that have disabled
- * setuid #! scripts because the kernel can't do it securely.
- * It is up to the package designer to make sure that this emulation
- * is done securely. Among other things, it should do an fstat on
- * the script it just opened to make sure it really is a setuid/setgid
- * script, it should make sure the arguments passed correspond exactly
- * to the argument on the #! line, and it should not trust any
- * subprocesses to which it must pass the filename rather than the
- * file descriptor of the script to be executed.
- */
-/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/
-/*#define DOSUID /**/
-
-/* Shmat_t:
- * This symbol holds the return type of the shmat() system call.
- * Usually set to 'void *' or 'char *'.
- */
-/* HAS_SHMAT_PROTOTYPE:
- * This symbol, if defined, indicates that the sys/shm.h includes
- * a prototype for shmat(). Otherwise, it is up to the program to
- * guess one. Shmat_t shmat(int, Shmat_t, int) is a good guess,
- * but not always right so it should be emitted by the program only
- * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
- */
-#define Shmat_t void * /**/
-/*#define HAS_SHMAT_PROTOTYPE /**/
-
-/* I_NDBM:
- * This symbol, if defined, indicates that <ndbm.h> exists and should
- * be included.
- */
-/*#define I_NDBM /**/
-
-/* I_STDARG:
- * This symbol, if defined, indicates that <stdarg.h> exists and should
- * be included.
- */
-/* I_VARARGS:
- * This symbol, if defined, indicates to the C program that it should
- * include <varargs.h>.
- */
-#define I_STDARG /**/
-/*#define I_VARARGS /**/
-
-/* CAN_PROTOTYPE:
- * If defined, this macro indicates that the C compiler can handle
- * function prototypes.
- */
-/* _:
- * This macro is used to declare function parameters for folks who want
- * to make declarations with prototypes using a different style than
- * the above macros. Use double parentheses. For example:
- *
- * int main _((int argc, char *argv[]));
- */
-#define CAN_PROTOTYPE /**/
-#ifdef CAN_PROTOTYPE
-#define _(args) args
-#else
-#define _(args) ()
-#endif
-
-/* SH_PATH:
- * This symbol contains the full pathname to the shell used on this
- * on this system to execute Bourne shell scripts. Usually, this will be
- * /bin/sh, though it's possible that some systems will have /bin/ksh,
- * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
- * D:/bin/sh.exe.
- */
-#define SH_PATH "cmd /x /c" /**/
-
-/* HAS_AINTL:
- * This symbol, if defined, indicates that the aintl routine is
- * available. If copysignl is also present we can emulate modfl.
- */
-/*#define HAS_AINTL /**/
-
-/* HAS_CLEARENV:
- * This symbol, if defined, indicates that the clearenv () routine is
- * available for use.
- */
-/*#define HAS_CLEARENV /**/
-
-/* HAS_COPYSIGNL:
- * This symbol, if defined, indicates that the copysignl routine is
- * available. If aintl is also present we can emulate modfl.
- */
-/*#define HAS_COPYSIGNL /**/
-
-/* HAS_DBMINIT_PROTO:
- * This symbol, if defined, indicates that the system provides
- * a prototype for the dbminit() function. Otherwise, it is up
- * to the program to supply one. A good guess is
- * extern int dbminit(char *);
- */
-/*#define HAS_DBMINIT_PROTO /**/
-
-/* HAS_DIRFD:
- * This manifest constant lets the C program know that dirfd
- * is available.
- */
-/*#define HAS_DIRFD /**/
-
-/* HAS_FAST_STDIO:
- * This symbol, if defined, indicates that the "fast stdio"
- * is available to manipulate the stdio buffers directly.
- */
-/*#define HAS_FAST_STDIO /**/
-
-/* HAS_FLOCK_PROTO:
- * This symbol, if defined, indicates that the system provides
- * a prototype for the flock() function. Otherwise, it is up
- * to the program to supply one. A good guess is
- * extern int flock(int, int);
- */
-/*#define HAS_FLOCK_PROTO /**/
-
-/* HAS_FPCLASSL:
- * This symbol, if defined, indicates that the fpclassl routine is
- * available to classify long doubles. Available for example in IRIX.
- * The returned values are defined in <ieeefp.h> and are:
- *
- * FP_SNAN signaling NaN
- * FP_QNAN quiet NaN
- * FP_NINF negative infinity
- * FP_PINF positive infinity
- * FP_NDENORM negative denormalized non-zero
- * FP_PDENORM positive denormalized non-zero
- * FP_NZERO negative zero
- * FP_PZERO positive zero
- * FP_NNORM negative normalized non-zero
- * FP_PNORM positive normalized non-zero
- */
-/*#define HAS_FPCLASSL /**/
-
-/* HAS_ILOGBL:
- * This symbol, if defined, indicates that the ilogbl routine is
- * available. If scalbnl is also present we can emulate frexpl.
- */
-/*#define HAS_ILOGBL /**/
-
-/* LIBM_LIB_VERSION:
- * This symbol, if defined, indicates that libm exports _LIB_VERSION
- * and that math.h defines the enum to manipulate it.
- */
-/*#define LIBM_LIB_VERSION /**/
-
-/* HAS_NL_LANGINFO:
- * This symbol, if defined, indicates that the nl_langinfo routine is
- * available to return local data. You will also need <langinfo.h>
- * and therefore I_LANGINFO.
- */
-/*#define HAS_NL_LANGINFO /**/
-
-/* HAS_PROCSELFEXE:
- * This symbol is defined if PROCSELFEXE_PATH is a symlink
- * to the absolute pathname of the executing program.
- */
-/* PROCSELFEXE_PATH:
- * If HAS_PROCSELFEXE is defined this symbol is the filename
- * of the symbolic link pointing to the absolute pathname of
- * the executing program.
- */
-/*#define HAS_PROCSELFEXE /**/
-#if defined(HAS_PROCSELFEXE) && !defined(PROCSELFEXE_PATH)
-#define PROCSELFEXE_PATH /**/
-#endif
-
-/* HAS_PTHREAD_ATTR_SETSCOPE:
- * This symbol, if defined, indicates that the pthread_attr_setscope
- * system call is available to set the contention scope attribute of
- * a thread attribute object.
- */
-/*#define HAS_PTHREAD_ATTR_SETSCOPE /**/
-
-/* HAS_SCALBNL:
- * This symbol, if defined, indicates that the scalbnl routine is
- * available. If ilogbl is also present we can emulate frexpl.
- */
-/*#define HAS_SCALBNL /**/
-
-/* HAS_SIGPROCMASK:
- * This symbol, if defined, indicates that the sigprocmask
- * system call is available to examine or change the signal mask
- * of the calling process.
- */
-/*#define HAS_SIGPROCMASK /**/
-
-/* HAS_SOCKATMARK:
- * This symbol, if defined, indicates that the sockatmark routine is
- * available to test whether a socket is at the out-of-band mark.
- */
-/*#define HAS_SOCKATMARK /**/
-
-/* HAS_SOCKATMARK_PROTO:
- * This symbol, if defined, indicates that the system provides
- * a prototype for the sockatmark() function. Otherwise, it is up
- * to the program to supply one. A good guess is
- * extern int sockatmark(int);
- */
-/*#define HAS_SOCKATMARK_PROTO /**/
-
-/* SPRINTF_RETURNS_STRLEN:
- * This variable defines whether sprintf returns the length of the string
- * (as per the ANSI spec). Some C libraries retain compatibility with
- * pre-ANSI C and return a pointer to the passed in buffer; for these
- * this variable will be undef.
- */
-#define SPRINTF_RETURNS_STRLEN /**/
-
-/* HAS_SETRESGID_PROTO:
- * This symbol, if defined, indicates that the system provides
- * a prototype for the setresgid() function. Otherwise, it is up
- * to the program to supply one. Good guesses are
- * extern int setresgid(uid_t ruid, uid_t euid, uid_t suid);
- */
-/*#define HAS_SETRESGID_PROTO /**/
-
-/* HAS_SETRESUID_PROTO:
- * This symbol, if defined, indicates that the system provides
- * a prototype for the setresuid() function. Otherwise, it is up
- * to the program to supply one. Good guesses are
- * extern int setresuid(uid_t ruid, uid_t euid, uid_t suid);
- */
-/*#define HAS_SETRESUID_PROTO /**/
-
-/* HAS_STRFTIME:
- * This symbol, if defined, indicates that the strftime routine is
- * available to do time formatting.
- */
-/*#define HAS_STRFTIME /**/
-
-/* HAS_STRLCAT:
- * This symbol, if defined, indicates that the strlcat () routine is
- * available to do string concatenation.
- */
-/*#define HAS_STRLCAT /**/
-
-/* HAS_STRLCPY:
- * This symbol, if defined, indicates that the strlcpy () routine is
- * available to do string copying.
- */
-/*#define HAS_STRLCPY /**/
-
-/* HAS_SYSCALL_PROTO:
- * This symbol, if defined, indicates that the system provides
- * a prototype for the syscall() function. Otherwise, it is up
- * to the program to supply one. Good guesses are
- * extern int syscall(int, ...);
- * extern int syscall(long, ...);
- */
-/*#define HAS_SYSCALL_PROTO /**/
-
-/* U32_ALIGNMENT_REQUIRED:
- * This symbol, if defined, indicates that you must access
- * character data through U32-aligned pointers.
- */
-#ifndef U32_ALIGNMENT_REQUIRED
-/*#define U32_ALIGNMENT_REQUIRED /**/
-#endif
-
-/* HAS_USLEEP_PROTO:
- * This symbol, if defined, indicates that the system provides
- * a prototype for the usleep() function. Otherwise, it is up
- * to the program to supply one. A good guess is
- * extern int usleep(useconds_t);
- */
-/*#define HAS_USLEEP_PROTO /**/
-
-/* I_CRYPT:
- * This symbol, if defined, indicates that <crypt.h> exists and
- * should be included.
- */
-/*#define I_CRYPT /**/
-
-/* I_FP:
- * This symbol, if defined, indicates that <fp.h> exists and
- * should be included.
- */
-/*#define I_FP /**/
-
-/* I_LANGINFO:
- * This symbol, if defined, indicates that <langinfo.h> exists and
- * should be included.
- */
-/*#define I_LANGINFO /**/
-
-/* USE_FAST_STDIO:
- * This symbol, if defined, indicates that Perl should
- * be built to use 'fast stdio'.
- * Defaults to define in Perls 5.8 and earlier, to undef later.
- */
-#ifndef USE_FAST_STDIO
-/*#define USE_FAST_STDIO /**/
-#endif
-
-/* PERL_RELOCATABLE_INC:
- * This symbol, if defined, indicates that we'd like to relocate entries
- * in @INC at run time based on the location of the perl binary.
- */
-#define PERL_RELOCATABLE_INC "undef" /**/
-
-/* HAS_CTERMID_R:
- * This symbol, if defined, indicates that the ctermid_r routine
- * is available to ctermid re-entrantly.
- */
-/* CTERMID_R_PROTO:
- * This symbol encodes the prototype of ctermid_r.
- * It is zero if d_ctermid_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctermid_r
- * is defined.
- */
-/*#define HAS_CTERMID_R /**/
-#define CTERMID_R_PROTO 0 /**/
-
-/* HAS_ENDHOSTENT_R:
- * This symbol, if defined, indicates that the endhostent_r routine
- * is available to endhostent re-entrantly.
- */
-/* ENDHOSTENT_R_PROTO:
- * This symbol encodes the prototype of endhostent_r.
- * It is zero if d_endhostent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endhostent_r
- * is defined.
- */
-/*#define HAS_ENDHOSTENT_R /**/
-#define ENDHOSTENT_R_PROTO 0 /**/
-
-/* HAS_ENDNETENT_R:
- * This symbol, if defined, indicates that the endnetent_r routine
- * is available to endnetent re-entrantly.
- */
-/* ENDNETENT_R_PROTO:
- * This symbol encodes the prototype of endnetent_r.
- * It is zero if d_endnetent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endnetent_r
- * is defined.
- */
-/*#define HAS_ENDNETENT_R /**/
-#define ENDNETENT_R_PROTO 0 /**/
-
-/* HAS_ENDPROTOENT_R:
- * This symbol, if defined, indicates that the endprotoent_r routine
- * is available to endprotoent re-entrantly.
- */
-/* ENDPROTOENT_R_PROTO:
- * This symbol encodes the prototype of endprotoent_r.
- * It is zero if d_endprotoent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endprotoent_r
- * is defined.
- */
-/*#define HAS_ENDPROTOENT_R /**/
-#define ENDPROTOENT_R_PROTO 0 /**/
-
-/* HAS_ENDSERVENT_R:
- * This symbol, if defined, indicates that the endservent_r routine
- * is available to endservent re-entrantly.
- */
-/* ENDSERVENT_R_PROTO:
- * This symbol encodes the prototype of endservent_r.
- * It is zero if d_endservent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endservent_r
- * is defined.
- */
-/*#define HAS_ENDSERVENT_R /**/
-#define ENDSERVENT_R_PROTO 0 /**/
-
-/* HAS_GETHOSTBYADDR_R:
- * This symbol, if defined, indicates that the gethostbyaddr_r routine
- * is available to gethostbyaddr re-entrantly.
- */
-/* GETHOSTBYADDR_R_PROTO:
- * This symbol encodes the prototype of gethostbyaddr_r.
- * It is zero if d_gethostbyaddr_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyaddr_r
- * is defined.
- */
-/*#define HAS_GETHOSTBYADDR_R /**/
-#define GETHOSTBYADDR_R_PROTO 0 /**/
-
-/* HAS_GETHOSTBYNAME_R:
- * This symbol, if defined, indicates that the gethostbyname_r routine
- * is available to gethostbyname re-entrantly.
- */
-/* GETHOSTBYNAME_R_PROTO:
- * This symbol encodes the prototype of gethostbyname_r.
- * It is zero if d_gethostbyname_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyname_r
- * is defined.
- */
-/*#define HAS_GETHOSTBYNAME_R /**/
-#define GETHOSTBYNAME_R_PROTO 0 /**/
-
-/* HAS_GETHOSTENT_R:
- * This symbol, if defined, indicates that the gethostent_r routine
- * is available to gethostent re-entrantly.
- */
-/* GETHOSTENT_R_PROTO:
- * This symbol encodes the prototype of gethostent_r.
- * It is zero if d_gethostent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostent_r
- * is defined.
- */
-/*#define HAS_GETHOSTENT_R /**/
-#define GETHOSTENT_R_PROTO 0 /**/
-
-/* HAS_GETNETBYADDR_R:
- * This symbol, if defined, indicates that the getnetbyaddr_r routine
- * is available to getnetbyaddr re-entrantly.
- */
-/* GETNETBYADDR_R_PROTO:
- * This symbol encodes the prototype of getnetbyaddr_r.
- * It is zero if d_getnetbyaddr_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyaddr_r
- * is defined.
- */
-/*#define HAS_GETNETBYADDR_R /**/
-#define GETNETBYADDR_R_PROTO 0 /**/
-
-/* HAS_GETNETBYNAME_R:
- * This symbol, if defined, indicates that the getnetbyname_r routine
- * is available to getnetbyname re-entrantly.
- */
-/* GETNETBYNAME_R_PROTO:
- * This symbol encodes the prototype of getnetbyname_r.
- * It is zero if d_getnetbyname_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyname_r
- * is defined.
- */
-/*#define HAS_GETNETBYNAME_R /**/
-#define GETNETBYNAME_R_PROTO 0 /**/
-
-/* HAS_GETNETENT_R:
- * This symbol, if defined, indicates that the getnetent_r routine
- * is available to getnetent re-entrantly.
- */
-/* GETNETENT_R_PROTO:
- * This symbol encodes the prototype of getnetent_r.
- * It is zero if d_getnetent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetent_r
- * is defined.
- */
-/*#define HAS_GETNETENT_R /**/
-#define GETNETENT_R_PROTO 0 /**/
-
-/* HAS_GETPROTOBYNAME_R:
- * This symbol, if defined, indicates that the getprotobyname_r routine
- * is available to getprotobyname re-entrantly.
- */
-/* GETPROTOBYNAME_R_PROTO:
- * This symbol encodes the prototype of getprotobyname_r.
- * It is zero if d_getprotobyname_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobyname_r
- * is defined.
- */
-/*#define HAS_GETPROTOBYNAME_R /**/
-#define GETPROTOBYNAME_R_PROTO 0 /**/
-
-/* HAS_GETPROTOBYNUMBER_R:
- * This symbol, if defined, indicates that the getprotobynumber_r routine
- * is available to getprotobynumber re-entrantly.
- */
-/* GETPROTOBYNUMBER_R_PROTO:
- * This symbol encodes the prototype of getprotobynumber_r.
- * It is zero if d_getprotobynumber_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobynumber_r
- * is defined.
- */
-/*#define HAS_GETPROTOBYNUMBER_R /**/
-#define GETPROTOBYNUMBER_R_PROTO 0 /**/
-
-/* HAS_GETPROTOENT_R:
- * This symbol, if defined, indicates that the getprotoent_r routine
- * is available to getprotoent re-entrantly.
- */
-/* GETPROTOENT_R_PROTO:
- * This symbol encodes the prototype of getprotoent_r.
- * It is zero if d_getprotoent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotoent_r
- * is defined.
- */
-/*#define HAS_GETPROTOENT_R /**/
-#define GETPROTOENT_R_PROTO 0 /**/
-
-/* HAS_GETSERVBYNAME_R:
- * This symbol, if defined, indicates that the getservbyname_r routine
- * is available to getservbyname re-entrantly.
- */
-/* GETSERVBYNAME_R_PROTO:
- * This symbol encodes the prototype of getservbyname_r.
- * It is zero if d_getservbyname_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r
- * is defined.
- */
-/*#define HAS_GETSERVBYNAME_R /**/
-#define GETSERVBYNAME_R_PROTO 0 /**/
-
-/* HAS_GETSERVBYPORT_R:
- * This symbol, if defined, indicates that the getservbyport_r routine
- * is available to getservbyport re-entrantly.
- */
-/* GETSERVBYPORT_R_PROTO:
- * This symbol encodes the prototype of getservbyport_r.
- * It is zero if d_getservbyport_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyport_r
- * is defined.
- */
-/*#define HAS_GETSERVBYPORT_R /**/
-#define GETSERVBYPORT_R_PROTO 0 /**/
-
-/* HAS_GETSERVENT_R:
- * This symbol, if defined, indicates that the getservent_r routine
- * is available to getservent re-entrantly.
- */
-/* GETSERVENT_R_PROTO:
- * This symbol encodes the prototype of getservent_r.
- * It is zero if d_getservent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservent_r
- * is defined.
- */
-/*#define HAS_GETSERVENT_R /**/
-#define GETSERVENT_R_PROTO 0 /**/
-
-/* HAS_PTHREAD_ATFORK:
- * This symbol, if defined, indicates that the pthread_atfork routine
- * is available to setup fork handlers.
- */
-/*#define HAS_PTHREAD_ATFORK /**/
-
-/* HAS_READDIR64_R:
- * This symbol, if defined, indicates that the readdir64_r routine
- * is available to readdir64 re-entrantly.
- */
-/* READDIR64_R_PROTO:
- * This symbol encodes the prototype of readdir64_r.
- * It is zero if d_readdir64_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir64_r
- * is defined.
- */
-/*#define HAS_READDIR64_R /**/
-#define READDIR64_R_PROTO 0 /**/
-
-/* HAS_SETHOSTENT_R:
- * This symbol, if defined, indicates that the sethostent_r routine
- * is available to sethostent re-entrantly.
- */
-/* SETHOSTENT_R_PROTO:
- * This symbol encodes the prototype of sethostent_r.
- * It is zero if d_sethostent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_sethostent_r
- * is defined.
- */
-/*#define HAS_SETHOSTENT_R /**/
-#define SETHOSTENT_R_PROTO 0 /**/
-
-/* HAS_SETLOCALE_R:
- * This symbol, if defined, indicates that the setlocale_r routine
- * is available to setlocale re-entrantly.
- */
-/* SETLOCALE_R_PROTO:
- * This symbol encodes the prototype of setlocale_r.
- * It is zero if d_setlocale_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setlocale_r
- * is defined.
- */
-/*#define HAS_SETLOCALE_R /**/
-#define SETLOCALE_R_PROTO 0 /**/
-
-/* HAS_SETNETENT_R:
- * This symbol, if defined, indicates that the setnetent_r routine
- * is available to setnetent re-entrantly.
- */
-/* SETNETENT_R_PROTO:
- * This symbol encodes the prototype of setnetent_r.
- * It is zero if d_setnetent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setnetent_r
- * is defined.
- */
-/*#define HAS_SETNETENT_R /**/
-#define SETNETENT_R_PROTO 0 /**/
-
-/* HAS_SETPROTOENT_R:
- * This symbol, if defined, indicates that the setprotoent_r routine
- * is available to setprotoent re-entrantly.
- */
-/* SETPROTOENT_R_PROTO:
- * This symbol encodes the prototype of setprotoent_r.
- * It is zero if d_setprotoent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setprotoent_r
- * is defined.
- */
-/*#define HAS_SETPROTOENT_R /**/
-#define SETPROTOENT_R_PROTO 0 /**/
-
-/* HAS_SETSERVENT_R:
- * This symbol, if defined, indicates that the setservent_r routine
- * is available to setservent re-entrantly.
- */
-/* SETSERVENT_R_PROTO:
- * This symbol encodes the prototype of setservent_r.
- * It is zero if d_setservent_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r
- * is defined.
- */
-/*#define HAS_SETSERVENT_R /**/
-#define SETSERVENT_R_PROTO 0 /**/
-
-/* HAS_TTYNAME_R:
- * This symbol, if defined, indicates that the ttyname_r routine
- * is available to ttyname re-entrantly.
- */
-/* TTYNAME_R_PROTO:
- * This symbol encodes the prototype of ttyname_r.
- * It is zero if d_ttyname_r is undef, and one of the
- * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r
- * is defined.
- */
-/*#define HAS_TTYNAME_R /**/
-#define TTYNAME_R_PROTO 0 /**/
-
#endif
+++ /dev/null
-#!perl -w
-use strict;
-
-# All the IMAGE_* structures are defined in the WINNT.H file
-# of the Microsoft Platform SDK.
-
-my %subsys = (NATIVE => 1,
- WINDOWS => 2,
- CONSOLE => 3,
- POSIX => 7,
- WINDOWSCE => 9);
-
-unless (0 < @ARGV && @ARGV < 3) {
- printf "Usage: $0 exefile [%s]\n", join '|', sort keys %subsys;
- exit;
-}
-
-$ARGV[1] = uc $ARGV[1] if $ARGV[1];
-unless (@ARGV == 1 || defined $subsys{$ARGV[1]}) {
- (my $subsys = join(', ', sort keys %subsys)) =~ s/, (\w+)$/ or $1/;
- print "Invalid subsystem $ARGV[1], please use $subsys\n";
- exit;
-}
-
-my ($record,$magic,$signature,$offset,$size);
-open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!\n";
-binmode EXE;
-
-# read IMAGE_DOS_HEADER structure
-read EXE, $record, 64;
-($magic,$offset) = unpack "Sx58L", $record;
-
-die "$ARGV[0] is not an MSDOS executable file.\n"
- unless $magic == 0x5a4d; # "MZ"
-
-# read signature, IMAGE_FILE_HEADER and first WORD of IMAGE_OPTIONAL_HEADER
-seek EXE, $offset, 0;
-read EXE, $record, 4+20+2;
-($signature,$size,$magic) = unpack "Lx16Sx2S", $record;
-
-die "PE header not found" unless $signature == 0x4550; # "PE\0\0"
-
-die "Optional header is neither in NT32 nor in NT64 format"
- unless ($size == 224 && $magic == 0x10b) || # IMAGE_NT_OPTIONAL_HDR32_MAGIC
- ($size == 240 && $magic == 0x20b); # IMAGE_NT_OPTIONAL_HDR64_MAGIC
-
-# Offset 68 in the IMAGE_OPTIONAL_HEADER(32|64) is the 16 bit subsystem code
-seek EXE, $offset+4+20+68, 0;
-if (@ARGV == 1) {
- read EXE, $record, 2;
- my ($subsys) = unpack "S", $record;
- $subsys = {reverse %subsys}->{$subsys} || "UNKNOWN($subsys)";
- print "$ARGV[0] uses the $subsys subsystem.\n";
-}
-else {
- print EXE pack "S", $subsys{$ARGV[1]};
-}
-close EXE;
-__END__
-
-=head1 NAME
-
-exetype - Change executable subsystem type between "Console" and "Windows"
-
-=head1 SYNOPSIS
-
- C:\perl\bin> copy perl.exe guiperl.exe
- C:\perl\bin> exetype guiperl.exe windows
-
-=head1 DESCRIPTION
-
-This program edits an executable file to indicate which subsystem the
-operating system must invoke for execution.
-
-You can specify any of the following subsystems:
-
-=over
-
-=item CONSOLE
-
-The CONSOLE subsystem handles a Win32 character-mode application that
-use a console supplied by the operating system.
-
-=item WINDOWS
-
-The WINDOWS subsystem handles an application that does not require a
-console and creates its own windows, if required.
-
-=item NATIVE
-
-The NATIVE subsystem handles a Windows NT device driver.
-
-=item WINDOWSCE
-
-The WINDOWSCE subsystem handles Windows CE consumer electronics
-applications.
-
-=item POSIX
-
-The POSIX subsystem handles a POSIX application in Windows NT.
-
-=back
-
-=head1 AUTHOR
-
-Jan Dubois <jand@activestate.com>
-
-=cut
+++ /dev/null
-#!perl -w
-use File::DosGlob;
-$| = 1;
-while (@ARGV) {
- my $arg = shift;
- my @m = File::DosGlob::doglob(1,$arg);
- print (@m ? join("\0", sort @m) : $arg);
- print "\0" if @ARGV;
-}
-__END__
-
-=head1 NAME
-
-perlglob.bat - a more capable perlglob.exe replacement
-
-=head1 SYNOPSIS
-
- @perlfiles = glob "..\\pe?l/*.p?";
- print <..\\pe?l/*.p?>;
-
- # more efficient version
- > perl -MFile::DosGlob=glob -e "print <../pe?l/*.p?>"
-
-=head1 DESCRIPTION
-
-This file is a portable replacement for perlglob.exe. It
-is largely compatible with perlglob.exe (the Microsoft setargv.obj
-version) in all but one respect--it understands wildcards in
-directory components.
-
-It prints null-separated filenames to standard output.
-
-For details of the globbing features implemented, see
-L<File::DosGlob>.
-
-While one may replace perlglob.exe with this, usage by overriding
-CORE::glob with File::DosGlob::glob should be much more efficient,
-because it avoids launching a separate process, and is therefore
-strongly recommended. See L<perlsub> for details of overriding
-builtins.
-
-=head1 AUTHOR
-
-Gurusamy Sarathy <gsar@activestate.com>
-
-=head1 SEE ALSO
-
-perl
-
-File::DosGlob
-
-=cut
-
+++ /dev/null
- eval 'exec perl -x -S "$0" ${1+"$@"}'
- if 0; # In case running under some shell
-
-require 5;
-use Getopt::Std;
-use Config;
-
-$0 =~ s|.*[/\\]||;
-
-my $usage = <<EOT;
-Usage: $0 [-h]
- or: $0 [-w] [-u] [-a argstring] [-s stripsuffix] [files]
- or: $0 [-w] [-u] [-n ntargs] [-o otherargs] [-s stripsuffix] [files]
- -n ntargs arguments to invoke perl with in generated file
- when run from Windows NT. Defaults to
- '-x -S "%0" %*'.
- -o otherargs arguments to invoke perl with in generated file
- other than when run from Windows NT. Defaults
- to '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9'.
- -a argstring arguments to invoke perl with in generated file
- ignoring operating system (for compatibility
- with previous pl2bat versions).
- -u update files that may have already been processed
- by (some version of) pl2bat.
- -w include "-w" on the /^#!.*perl/ line (unless
- a /^#!.*perl/ line was already present).
- -s stripsuffix strip this suffix from file before appending ".bat"
- Not case-sensitive
- Can be a regex if it begins with `/'
- Defaults to "/\.plx?/"
- -h show this help
-EOT
-
-my %OPT = ();
-warn($usage), exit(0) if !getopts('whun:o:a:s:',\%OPT) or $OPT{'h'};
-$OPT{'n'} = '-x -S "%0" %*' unless exists $OPT{'n'};
-$OPT{'o'} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $OPT{'o'};
-$OPT{'s'} = '/\\.plx?/' unless exists $OPT{'s'};
-$OPT{'s'} = ($OPT{'s'} =~ m#^/([^/]*[^/\$]|)\$?/?$# ? $1 : "\Q$OPT{'s'}\E");
-
-my $head;
-if( defined( $OPT{'a'} ) ) {
- $head = <<EOT;
- \@rem = '--*-Perl-*--
- \@echo off
- perl $OPT{'a'}
- goto endofperl
- \@rem ';
-EOT
-} else {
- $head = <<EOT;
- \@rem = '--*-Perl-*--
- \@echo off
- if "%OS%" == "Windows_NT" goto WinNT
- perl $OPT{'o'}
- goto endofperl
- :WinNT
- perl $OPT{'n'}
- if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl
- if %errorlevel% == 9009 echo You do not have Perl in your PATH.
- if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
- goto endofperl
- \@rem ';
-EOT
-}
-$head =~ s/^\t//gm;
-my $headlines = 2 + ($head =~ tr/\n/\n/);
-my $tail = "\n__END__\n:endofperl\n";
-
-@ARGV = ('-') unless @ARGV;
-
-foreach ( @ARGV ) {
- process($_);
-}
-
-sub process {
- my( $file )= @_;
- my $myhead = $head;
- my $linedone = 0;
- my $taildone = 0;
- my $linenum = 0;
- my $skiplines = 0;
- my $line;
- my $start= $Config{startperl};
- $start= "#!perl" unless $start =~ /^#!.*perl/;
- open( FILE, $file ) or die "$0: Can't open $file: $!";
- @file = <FILE>;
- foreach $line ( @file ) {
- $linenum++;
- if ( $line =~ /^:endofperl\b/ ) {
- if( ! exists $OPT{'u'} ) {
- warn "$0: $file has already been converted to a batch file!\n";
- return;
- }
- $taildone++;
- }
- if ( not $linedone and $line =~ /^#!.*perl/ ) {
- if( exists $OPT{'u'} ) {
- $skiplines = $linenum - 1;
- $line .= "#line ".(1+$headlines)."\n";
- } else {
- $line .= "#line ".($linenum+$headlines)."\n";
- }
- $linedone++;
- }
- if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) {
- $line = "";
- }
- }
- close( FILE );
- $file =~ s/$OPT{'s'}$//oi;
- $file .= '.bat' unless $file =~ /\.bat$/i or $file =~ /^-$/;
- open( FILE, ">$file" ) or die "Can't open $file: $!";
- print FILE $myhead;
- print FILE $start, ( $OPT{'w'} ? " -w" : "" ),
- "\n#line ", ($headlines+1), "\n" unless $linedone;
- print FILE @file[$skiplines..$#file];
- print FILE $tail unless $taildone;
- close( FILE );
-}
-__END__
-
-=head1 NAME
-
-pl2bat - wrap perl code into a batch file
-
-=head1 SYNOPSIS
-
-B<pl2bat> B<-h>
-
-B<pl2bat> [B<-w>] S<[B<-a> I<argstring>]> S<[B<-s> I<stripsuffix>]> [files]
-
-B<pl2bat> [B<-w>] S<[B<-n> I<ntargs>]> S<[B<-o> I<otherargs>]> S<[B<-s> I<stripsuffix>]> [files]
-
-=head1 DESCRIPTION
-
-This utility converts a perl script into a batch file that can be
-executed on DOS-like operating systems. This is intended to allow
-you to use a Perl script like regular programs and batch files where
-you just enter the name of the script [probably minus the extension]
-plus any command-line arguments and the script is found in your B<PATH>
-and run.
-
-=head2 ADVANTAGES
-
-There are several alternatives to this method of running a Perl script.
-They each have disadvantages that help you understand the motivation
-for using B<pl2bat>.
-
-=over
-
-=item 1
-
- C:> perl x:/path/to/script.pl [args]
-
-=item 2
-
- C:> perl -S script.pl [args]
-
-=item 3
-
- C:> perl -S script [args]
-
-=item 4
-
- C:> ftype Perl=perl.exe "%1" %*
- C:> assoc .pl=Perl
- then
- C:> script.pl [args]
-
-=item 5
-
- C:> ftype Perl=perl.exe "%1" %*
- C:> assoc .pl=Perl
- C:> set PathExt=%PathExt%;.PL
- then
- C:> script [args]
-
-=back
-
-B<1> and B<2> are the most basic invocation methods that should work on
-any system [DOS-like or not]. They require extra typing and require
-that the script user know that the script is written in Perl. This
-is a pain when you have lots of scripts, some written in Perl and some
-not. It can be quite difficult to keep track of which scripts need to
-be run through Perl and which do not. Even worse, scripts often get
-rewritten from simple batch files into more powerful Perl scripts in
-which case these methods would require all existing users of the scripts
-be updated.
-
-B<3> works on modern Win32 versions of Perl. It allows the user to
-omit the ".pl" or ".bat" file extension, which is a minor improvement.
-
-B<4> and B<5> work on some Win32 operating systems with some command
-shells. One major disadvantage with both is that you can't use them
-in pipelines nor with file redirection. For example, none of the
-following will work properly if you used method B<4> or B<5>:
-
- C:> script.pl <infile
- C:> script.pl >outfile
- C:> echo y | script.pl
- C:> script.pl | more
-
-This is due to a Win32 bug which Perl has no control over. This bug
-is the major motivation for B<pl2bat> [which was originally written
-for DOS] being used on Win32 systems.
-
-Note also that B<5> works on a smaller range of combinations of Win32
-systems and command shells while B<4> requires that the user know
-that the script is a Perl script [because the ".pl" extension must
-be entered]. This makes it hard to standardize on either of these
-methods.
-
-=head2 DISADVANTAGES
-
-There are several potential traps you should be aware of when you
-use B<pl2bat>.
-
-The generated batch file is initially processed as a batch file each
-time it is run. This means that, to use it from within another batch
-file you should precede it with C<call> or else the calling batch
-file will not run any commands after the script:
-
- call script [args]
-
-Except under Windows NT, if you specify more than 9 arguments to
-the generated batch file then the 10th and subsequent arguments
-are silently ignored.
-
-Except when using F<CMD.EXE> under Windows NT, if F<perl.exe> is not
-in your B<PATH>, then trying to run the script will give you a generic
-"Command not found"-type of error message that will probably make you
-think that the script itself is not in your B<PATH>. When using
-F<CMD.EXE> under Windows NT, the generic error message is followed by
-"You do not have Perl in your PATH", to make this clearer.
-
-On most DOS-like operating systems, the only way to exit a batch file
-is to "fall off the end" of the file. B<pl2bat> implements this by
-doing C<goto :endofperl> and adding C<__END__> and C<:endofperl> as
-the last two lines of the generated batch file. This means:
-
-=over
-
-=item No line of your script should start with a colon.
-
-In particular, for this version of B<pl2bat>, C<:endofperl>,
-C<:WinNT>, and C<:script_failed_so_exit_with_non_zero_val> should not
-be used.
-
-=item Care must be taken when using C<__END__> and the C<DATA> file handle.
-
-One approach is:
-
- . #!perl
- . while( <DATA> ) {
- . last if /^__END__$/;
- . [...]
- . }
- . __END__
- . lines of data
- . to be processed
- . __END__
- . :endofperl
-
-The dots in the first column are only there to prevent F<cmd.exe> to interpret
-the C<:endofperl> line in this documentation. Otherwise F<pl2bat.bat> itself
-wouldn't work. See the previous item. :-)
-
-=item The batch file always "succeeds"
-
-The following commands illustrate the problem:
-
- C:> echo exit(99); >fail.pl
- C:> pl2bat fail.pl
- C:> perl -e "print system('perl fail.pl')"
- 99
- C:> perl -e "print system('fail.bat')"
- 0
-
-So F<fail.bat> always reports that it completed successfully. Actually,
-under Windows NT, we have:
-
- C:> perl -e "print system('fail.bat')"
- 1
-
-So, for Windows NT, F<fail.bat> fails when the Perl script fails, but
-the return code is always C<1>, not the return code from the Perl script.
-
-=back
-
-=head2 FUNCTION
-
-By default, the ".pl" suffix will be stripped before adding a ".bat" suffix
-to the supplied file names. This can be controlled with the C<-s> option.
-
-The default behavior is to have the batch file compare the C<OS>
-environment variable against C<"Windows_NT">. If they match, it
-uses the C<%*> construct to refer to all the command line arguments
-that were given to it, so you'll need to make sure that works on your
-variant of the command shell. It is known to work in the F<CMD.EXE> shell
-under Windows NT. 4DOS/NT users will want to put a C<ParameterChar = *>
-line in their initialization file, or execute C<setdos /p*> in
-the shell startup file.
-
-On Windows95 and other platforms a nine-argument limit is imposed
-on command-line arguments given to the generated batch file, since
-they may not support C<%*> in batch files.
-
-These can be overridden using the C<-n> and C<-o> options or the
-deprecated C<-a> option.
-
-=head1 OPTIONS
-
-=over 8
-
-=item B<-n> I<ntargs>
-
-Arguments to invoke perl with in generated batch file when run from
-Windows NT (or Windows 98, probably). Defaults to S<'-x -S "%0" %*'>.
-
-=item B<-o> I<otherargs>
-
-Arguments to invoke perl with in generated batch file except when
-run from Windows NT (ie. when run from DOS, Windows 3.1, or Windows 95).
-Defaults to S<'-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9'>.
-
-=item B<-a> I<argstring>
-
-Arguments to invoke perl with in generated batch file. Specifying
-B<-a> prevents the batch file from checking the C<OS> environment
-variable to determine which operating system it is being run from.
-
-=item B<-s> I<stripsuffix>
-
-Strip a suffix string from file name before appending a ".bat"
-suffix. The suffix is not case-sensitive. It can be a regex if
-it begins with `/' (the trailing '/' is optional and a trailing
-C<$> is always assumed). Defaults to C</.plx?/>.
-
-=item B<-w>
-
-If no line matching C</^#!.*perl/> is found in the script, then such
-a line is inserted just after the new preamble. The exact line
-depends on C<$Config{startperl}> [see L<Config>]. With the B<-w>
-option, C<" -w"> is added after the value of C<$Config{startperl}>.
-If a line matching C</^#!.*perl/> already exists in the script,
-then it is not changed and the B<-w> option is ignored.
-
-=item B<-u>
-
-If the script appears to have already been processed by B<pl2bat>,
-then the script is skipped and not processed unless B<-u> was
-specified. If B<-u> is specified, the existing preamble is replaced.
-
-=item B<-h>
-
-Show command line usage.
-
-=back
-
-=head1 EXAMPLES
-
- C:\> pl2bat foo.pl bar.PM
- [..creates foo.bat, bar.PM.bat..]
-
- C:\> pl2bat -s "/\.pl|\.pm/" foo.pl bar.PM
- [..creates foo.bat, bar.bat..]
-
- C:\> pl2bat < somefile > another.bat
-
- C:\> pl2bat > another.bat
- print scalar reverse "rekcah lrep rehtona tsuj\n";
- ^Z
- [..another.bat is now a certified japh application..]
-
- C:\> ren *.bat *.pl
- C:\> pl2bat -u *.pl
- [..updates the wrapping of some previously wrapped scripts..]
-
- C:\> pl2bat -u -s .bat *.bat
- [..same as previous example except more dangerous..]
-
-=head1 BUGS
-
-C<$0> will contain the full name, including the ".bat" suffix
-when the generated batch file runs. If you don't like this,
-see runperl.bat for an alternative way to invoke perl scripts.
-
-Default behavior is to invoke Perl with the B<-S> flag, so Perl will
-search the B<PATH> to find the script. This may have undesirable
-effects.
-
-On really old versions of Win32 Perl, you can't run the script
-via
-
- C:> script.bat [args]
-
-and must use
-
- C:> script [args]
-
-A loop should be used to build up the argument list when not on
-Windows NT so more than 9 arguments can be processed.
-
-See also L</Disadvantages>.
-
-=head1 SEE ALSO
-
-perl, perlwin32, runperl.bat
-
-=cut
-
+++ /dev/null
-#!perl -w
-$0 =~ s|\.bat||i;
-unless (-f $0) {
- $0 =~ s|.*[/\\]||;
- for (".", split ';', $ENV{PATH}) {
- $_ = "." if $_ eq "";
- $0 = "$_/$0" , goto doit if -f "$_/$0";
- }
- die "`$0' not found.\n";
-}
-doit: exec "perl", "-x", $0, @ARGV;
-die "Failed to exec `$0': $!";
-__END__
-
-=head1 NAME
-
-runperl.bat - "universal" batch file to run perl scripts
-
-=head1 SYNOPSIS
-
- C:\> copy runperl.bat foo.bat
- C:\> foo
- [..runs the perl script `foo'..]
-
- C:\> foo.bat
- [..runs the perl script `foo'..]
-
-
-=head1 DESCRIPTION
-
-This file can be copied to any file name ending in the ".bat" suffix.
-When executed on a DOS-like operating system, it will invoke the perl
-script of the same name, but without the ".bat" suffix. It will
-look for the script in the same directory as itself, and then in
-the current directory, and then search the directories in your PATH.
-
-It relies on the C<exec()> operator, so you will need to make sure
-that works in your perl.
-
-This method of invoking perl scripts has some advantages over
-batch-file wrappers like C<pl2bat.bat>: it avoids duplication
-of all the code; it ensures C<$0> contains the same name as the
-executing file, without any egregious ".bat" suffix; it allows
-you to separate your perl scripts from the wrapper used to
-run them; since the wrapper is generic, you can use symbolic
-links to simply link to C<runperl.bat>, if you are serving your
-files on a filesystem that supports that.
-
-On the other hand, if the batch file is invoked with the ".bat"
-suffix, it does an extra C<exec()>. This may be a performance
-issue. You can avoid this by running it without specifying
-the ".bat" suffix.
-
-Perl is invoked with the -x flag, so the script must contain
-a C<#!perl> line. Any flags found on that line will be honored.
-
-=head1 BUGS
-
-Perl is invoked with the -S flag, so it will search the PATH to find
-the script. This may have undesirable effects.
-
-=head1 SEE ALSO
-
-perl, perlwin32, pl2bat.bat
-
-=cut
-
+++ /dev/null
-#!/usr/local/bin/perl -w
-'di';
-'ig00';
-##############################################################################
-##
-## search
-##
-## Jeffrey Friedl (jfriedl@omron.co.jp), Dec 1994.
-## Copyright 19.... ah hell, just take it.
-##
-## BLURB:
-## A combo of find and grep -- more or less do a 'grep' on a whole
-## directory tree. Fast, with lots of options. Much more powerful than
-## the simple "find ... | xargs grep ....". Has a full man page.
-## Powerfully customizable.
-##
-## This file is big, but mostly comments and man page.
-##
-## See man page for usage info.
-## Return value: 2=error, 1=nothing found, 0=something found.
-##
-
-$version = "950918.5";
-##
-## "950918.5";
-## Changed all 'sysread' to 'read' because Linux perl's don't seem
-## to like sysread()
-##
-## "941227.4";
-## Added -n, -u
-##
-## "941222.3"
-## Added -nice (due to Lionel Cons <Lionel.Cons@cern.ch>)
-## Removed any leading "./" from name.
-## Added default flags for ~/.search, including TTY, -nice, -list, etc.
-## Program name now has path removed when printed in diagnostics.
-## Added simple tilde-expansion to -dir arg.
-## Added -dskip, etc. Fixed -iregex bug.
-## Changed -dir to be additive, adding -ddir.
-## Now screen out devices, pipes, and sockets.
-## More tidying and lots of expanding of the man page
-##
-##
-## "941217.2";
-## initial release.
-
-$stripped=0;
-
-&init;
-$rc_file = join('/', $ENV{'HOME'}, ".search");
-
-&check_args;
-
-## Make sure we've got a regex.
-## Don't need one if -find or -showrc was specified.
-$!=2, die "expecting regex arguments.\n"
- if $FIND_ONLY == 0 && $showrc == 0 && @ARGV == 0;
-
-&prepare_to_search($rc_file);
-
-&import_program if !defined &dodir; ## BIG key to speed.
-
-## do search while there are directories to be done.
-&dodir(shift(@todo)) while @todo;
-
-&clear_message if $VERBOSE && $STDERR_IS_TTY;
-exit($retval);
-###############################################################################
-
-sub init
-{
- ## initialize variables that might be reset by command-line args
- $DOREP=0; ## set true by -dorep (redo multi-hardlink files)
- $DOREP=1 if $^O eq 'MSWin32';
- $DO_SORT=0; ## set by -sort (sort files in a dir before checking)
- $FIND_ONLY=0; ## set by -find (don't search files)
- $LIST_ONLY=0; ## set true by -l (list filenames only)
- $NEWER=0; ## set by -newer, "-mtime -###"
- $NICE=0; ## set by -nice (print human-readable output)
- $NOLINKS=0; ## set true by -nolinks (don't follow symlinks)
- $OLDER=0; ## set by -older, "-mtime ###"
- $PREPEND_FILENAME=1; ## set false by -h (don't prefix lines with filename)
- $REPORT_LINENUM=0; ## set true by -n (show line numbers)
- $VERBOSE=0; ## set to a value by -v, -vv, etc. (verbose messages)
- $WHY=0; ## set true by -why, -vvv+ (report why skipped)
- $XDEV=0; ## set true by -xdev (stay on one filesystem)
- $all=0; ## set true by -all (don't skip many kinds of files)
- $iflag = ''; ## set to 'i' by -i (ignore case);
- $norc=0; ## set by -norc (don't load rc file)
- $showrc=0; ## set by -showrc (show what happens with rc file)
- $underlineOK=0; ## set true by -u (watch for underline stuff)
- $words=0; ## set true by -w (match whole-words only)
- $DELAY=0; ## inter-file delay (seconds)
- $retval=1; ## will set to 0 if we find anything.
-
- ## various elements of stat() that we might access
- $STAT_DEV = 1;
- $STAT_INODE = 2;
- $STAT_MTIME = 9;
-
- $VV_PRINT_COUNT = 50; ## with -vv, print every VV_PRINT_COUNT files, or...
- $VV_SIZE = 1024*1024; ## ...every VV_SIZE bytes searched
- $vv_print = $vv_size = 0; ## running totals.
-
- ## set default options, in case the rc file wants them
- $opt{'TTY'}= 1 if -t STDOUT;
-
- ## want to know this for debugging message stuff
- $STDERR_IS_TTY = -t STDERR ? 1 : 0;
- $STDERR_SCREWS_STDOUT = ($STDERR_IS_TTY && -t STDOUT) ? 1 : 0;
-
- $0 =~ s,.*/,,; ## clean up $0 for any diagnostics we'll be printing.
-}
-
-##
-## Check arguments.
-##
-sub check_args
-{
- while (@ARGV && $ARGV[0] =~ m/^-/)
- {
- $arg = shift(@ARGV);
-
- if ($arg eq '-version' || ($VERBOSE && $arg eq '-help')) {
- print qq/Jeffrey's file search, version "$version".\n/;
- exit(0) unless $arg eq '-help';
- }
- if ($arg eq '-help') {
- print <<INLINE_LITERAL_TEXT;
-usage: $0 [options] [-e] [PerlRegex ....]
-OPTIONS TELLING *WHERE* TO SEARCH:
- -dir DIR start search at the named directory (default is current dir).
- -xdev stay on starting file system.
- -sort sort the files in each directory before processing.
- -nolinks don't follow symbolic links.
-OPTIONS TELLING WHICH FILES TO EVEN CONSIDER:
- -mtime # consider files modified > # days ago (-# for < # days old)
- -newer FILE consider files modified more recently than FILE (also -older)
- -name GLOB consider files whose name matches pattern (also -regex).
- -skip GLOB opposite of -name: identifies files to not consider.
- -path GLOB like -name, but for files whose whole path is described.
- -dpath/-dregex/-dskip versions for selecting or pruning directories.
- -all don't skip any files marked to be skipped by the startup file.
- -x<SPECIAL> (see manual, and/or try -showrc).
- -why report why a file isn't checked (also implied by -vvvv).
-OPTIONS TELLING WHAT TO DO WITH FILES THAT WILL BE CONSIDERED:
- -f | -find just list files (PerlRegex ignored). Default is to grep them.
- -ff | -ffind Does a faster -find (implies -find -all -dorep)
-OPTIONS CONTROLLING HOW THE SEARCH IS DONE (AND WHAT IS PRINTED):
- -l | -list only list files with matches, not the lines themselves.
- -nice | -nnice print more "human readable" output.
- -n prefix each output line with its line number in the file.
- -h don't prefix output lines with file name.
- -u also look "inside" manpage-style underlined text
- -i do case-insensitive searching.
- -w match words only (as defined by perl's \\b).
-OTHER OPTIONS:
- -v, -vv, -vvv various levels of message verbosity.
- -e end of options (in case a regex looks like an option).
- -showrc show what the rc file sets, then exit.
- -norc don't load the rc file.
- -dorep check files with multiple hard links multiple times.
-INLINE_LITERAL_TEXT
- print "Use -v -help for more verbose help.\n" unless $VERBOSE;
- print "This script file is also a man page.\n" unless $stripped;
- print <<INLINE_LITERAL_TEXT if $VERBOSE;
-
-If -f (or -find) given, PerlRegex is optional and ignored.
-Otherwise, will search for files with lines matching any of the given regexes.
-
-Combining things like -name and -mtime implies boolean AND.
-However, duplicating things (such as -name '*.c' -name '*.txt') implies OR.
-
--mtime may be given floating point (i.e. 1.5 is a day and a half).
--iskip/-idskip/-ipath/... etc are case-insensitive versions.
-
-If any letter in -newer/-older is upper case, "or equal" is
-inserted into the test.
-
-You can always find the latest version on the World Wide Web in
- http://www.wg.omron.co.jp/~jfriedl/perl/
-INLINE_LITERAL_TEXT
- exit(0);
- }
- $DOREP=1, next if $arg eq '-dorep'; ## do repeats
- $DO_SORT=1, next if $arg eq '-sort'; ## sort files
- $NOLINKS=1, next if $arg eq '-nolinks'; ## no sym. links
- $PREPEND_FILENAME=0, next if $arg eq '-h'; ## no filename prefix
- $REPORT_LINENUM=1, next if $arg eq '-n'; ## show line numbers
- $WHY=1, next if $arg eq '-why'; ## tell why skipped
- $XDEV=1, next if $arg eq '-xdev'; ## don't leave F.S.
- $all=1,$opt{'-all'}=1,next if $arg eq '-all'; ## don't skip *.Z, etc
- $iflag='i', next if $arg eq '-i'; ## ignore case
- $norc=1, next if $arg eq '-norc'; ## don't load rc file
- $showrc=1, next if $arg eq '-showrc'; ## show rc file
- $underlineOK=1, next if $arg eq '-u'; ## look throuh underln.
- $words=1, next if $arg eq '-w'; ## match "words" only
- &strip if $arg eq '-strip'; ## dump this program
- last if $arg eq '-e';
- $DELAY=$1, next if $arg =~ m/-delay(\d+)/;
-
- $FIND_ONLY=1, next if $arg =~/^-f(ind)?$/;## do "find" only
-
- $FIND_ONLY=1, $DOREP=1, $all=1,
- next if $arg =~/^-ff(ind)?$/;## fast -find
- $LIST_ONLY=1,$opt{'-list'}=1,
- next if $arg =~/^-l(ist)?$/;## only list files
-
- if ($arg =~ m/^-(v+)$/) { ## verbosity
- $VERBOSE =length($1);
- foreach $len (1..$VERBOSE) { $opt{'-'.('v' x $len)}=1 }
- next;
- }
- if ($arg =~ m/^-(n+)ice$/) { ## "nice" output
- $NICE =length($1);
- foreach $len (1..$NICE) { $opt{'-'.('n' x $len).'ice'}=1 }
- next;
- }
-
- if ($arg =~ m/^-(i?)(d?)skip$/) {
- local($i) = $1 eq 'i';
- local($d) = $2 eq 'd';
- $! = 2, die qq/$0: expecting glob arg to -$arg\n/ unless @ARGV;
- foreach (split(/\s+/, shift @ARGV)) {
- if ($d) {
- $idskip{$_}=1 if $i;
- $dskip{$_}=1;
- } else {
- $iskip{$_}=1 if $i;
- $skip{$_}=1;
- }
- }
- next;
- }
-
-
- if ($arg =~ m/^-(i?)(d?)(regex|path|name)$/) {
- local($i) = $1 eq 'i';
- $! = 2, die qq/$0: expecting arg to -$arg\n/ unless @ARGV;
- foreach (split(/\s+/, shift @ARGV)) {
- $iname{join(',', $arg, $_)}=1 if $i;
- $name{join(',', $arg, $_)}=1;
- }
- next;
- }
-
- if ($arg =~ m/^-d?dir$/) {
- $opt{'-dir'}=1;
- $! = 2, die qq/$0: expecting filename arg to -$arg\n/ unless @ARGV;
- $start = shift(@ARGV);
- $start =~ s#^~(/+|$)#$ENV{'HOME'}$1# if defined $ENV{'HOME'};
- $! = 2, die qq/$0: can't find ${arg}'s "$start"\n/ unless -e $start;
- $! = 2, die qq/$0: ${arg}'s "$start" not a directory.\n/ unless -d _;
- undef(@todo), $opt{'-ddir'}=1 if $arg eq '-ddir';
- push(@todo, $start);
- next;
- }
-
- if ($arg =~ m/^-(new|old)er$/i) {
- $! = 2, die "$0: expecting filename arg to -$arg\n" unless @ARGV;
- local($file, $time) = shift(@ARGV);
- $! = 2, die qq/$0: can't stat -${arg}'s "$file"./
- unless $time = (stat($file))[$STAT_MTIME];
- local($upper) = $arg =~ tr/A-Z//;
- if ($arg =~ m/new/i) {
- $time++ unless $upper;
- $NEWER = $time if $NEWER < $time;
- } else {
- $time-- unless $upper;
- $OLDER = $time if $OLDER == 0 || $OLDER > $time;
- }
- next;
- }
-
- if ($arg =~ m/-mtime/) {
- $! = 2, die "$0: expecting numerical arg to -$arg\n" unless @ARGV;
- local($days) = shift(@ARGV);
- $! = 2, die qq/$0: inappropriate arg ($days) to $arg\n/ if $days==0;
- $days *= 3600 * 24;
- if ($days < 0) {
- local($time) = $^T + $days;
- $NEWER = $time if $NEWER < $time;
- } else {
- local($time) = $^T - $days;
- $OLDER = $time if $OLDER == 0 || $OLDER > $time;
- }
- next;
- }
-
- ## special user options
- if ($arg =~ m/^-x(.+)/) {
- foreach (split(/[\s,]+/, $1)) { $user_opt{$_} = $opt{$_}= 1; }
- next;
- }
-
- $! = 2, die "$0: unknown arg [$arg]\n";
- }
-}
-
-##
-## Given a filename glob, return a regex.
-## If the glob has no globbing chars (no * ? or [..]), then
-## prepend an effective '*' to it.
-##
-sub glob_to_regex
-{
- local($glob) = @_;
- local(@parts) = $glob =~ m/\\.|[*?]|\[]?[^]]*]|[^[\\*?]+/g;
- local($trueglob)=0;
- foreach (@parts) {
- if ($_ eq '*' || $_ eq '?') {
- $_ = ".$_";
- $trueglob=1; ## * and ? are a real glob
- } elsif (substr($_, 0, 1) eq '[') {
- $trueglob=1; ## [..] is a real glob
- } else {
- s/^\\//; ## remove any leading backslash;
- s/\W/\\$&/g; ## now quote anything dangerous;
- }
- }
- unshift(@parts, '.*') unless $trueglob;
- join('', '^', @parts, '$');
-}
-
-sub prepare_to_search
-{
- local($rc_file) = @_;
-
- $HEADER_BYTES=0; ## Might be set nonzero in &read_rc;
- $last_message_length = 0; ## For &message and &clear_message.
-
- &read_rc($rc_file, $showrc) unless $norc;
- exit(0) if $showrc;
-
- $NEXT_DIR_ENTRY = $DO_SORT ? 'shift @files' : 'readdir(DIR)';
- $WHY = 1 if $VERBOSE > 3; ## Arg -vvvv or above implies -why.
- @todo = ('.') if @todo == 0; ## Where we'll start looking
-
- ## see if any user options were specified that weren't accounted for
- foreach $opt (keys %user_opt) {
- next if defined $seen_opt{$opt};
- warn "warning: -x$opt never considered.\n";
- }
-
- die "$0: multiple time constraints exclude all possible files.\n"
- if ($NEWER && $OLDER) && ($NEWER > $OLDER);
-
- ##
- ## Process any -skip/-iskip args that had been given
- ##
- local(@skip_test);
- foreach $glob (keys %skip) {
- $i = defined($iskip{$glob}) ? 'i': '';
- push(@skip_test, '$name =~ m/'. &glob_to_regex($glob). "/$i");
- }
- if (@skip_test) {
- $SKIP_TEST = join('||',@skip_test);
- $DO_SKIP_TEST = 1;
- } else {
- $DO_SKIP_TEST = $SKIP_TEST = 0;
- }
-
- ##
- ## Process any -dskip/-idskip args that had been given
- ##
- local(@dskip_test);
- foreach $glob (keys %dskip) {
- $i = defined($idskip{$glob}) ? 'i': '';
- push(@dskip_test, '$name =~ m/'. &glob_to_regex($glob). "/$i");
- }
- if (@dskip_test) {
- $DSKIP_TEST = join('||',@dskip_test);
- $DO_DSKIP_TEST = 1;
- } else {
- $DO_DSKIP_TEST = $DSKIP_TEST = 0;
- }
-
-
- ##
- ## Process any -name, -path, -regex, etc. args that had been given.
- ##
- undef @name_test;
- undef @dname_test;
- foreach $key (keys %name) {
- local($type, $pat) = split(/,/, $key, 2);
- local($i) = defined($iname{$key}) ? 'i' : '';
- if ($type =~ /regex/) {
- $pat =~ s/!/\\!/g;
- $test = "\$name =~ m!^$pat\$!$i";
- } else {
- local($var) = $type eq 'name' ? '$name' : '$file';
- $test = "$var =~ m/". &glob_to_regex($pat). "/$i";
- }
- if ($type =~ m/^-i?d/) {
- push(@dname_test, $test);
- } else {
- push(@name_test, $test);
- }
- }
- if (@name_test) {
- $GLOB_TESTS = join('||', @name_test);
-
- $DO_GLOB_TESTS = 1;
- } else {
- $GLOB_TESTS = $DO_GLOB_TESTS = 0;
- }
- if (@dname_test) {
- $DGLOB_TESTS = join('||', @dname_test);
- $DO_DGLOB_TESTS = 1;
- } else {
- $DGLOB_TESTS = $DO_DGLOB_TESTS = 0;
- }
-
-
- ##
- ## Process any 'magic' things from the startup file.
- ##
- if (@magic_tests && $HEADER_BYTES) {
- ## the $magic' one is for when &dodir is not inlined
- $tests = join('||',@magic_tests);
- $MAGIC_TESTS = " { package magic; \$val = ($tests) }";
- $DO_MAGIC_TESTS = 1;
- } else {
- $MAGIC_TESTS = 1;
- $DO_MAGIC_TESTS = 0;
- }
-
- ##
- ## Prepare regular expressions.
- ##
- {
- local(@regex_tests);
-
- if ($LIST_ONLY) {
- $mflag = '';
- ## need to have $* set, but perl5 just won''t shut up about it.
- if ($] >= 5) {
- $mflag = 'm';
- } else {
- eval ' $* = 1 ';
- }
- }
-
- ##
- ## Until I figure out a better way to deal with it,
- ## We have to worry about a regex like [^xyz] when doing $LIST_ONLY.
- ## Such a regex *will* match \n, and if I'm pulling in multiple
- ## lines, it can allow lines to match that would otherwise not match.
- ##
- ## Therefore, if there is a '[^' in a regex, we can NOT take a chance
- ## an use the fast listonly.
- ##
- $CAN_USE_FAST_LISTONLY = $LIST_ONLY;
-
- local(@extra);
- local($underline_glue) = ($] >= 5) ? '(:?_\cH)?' : '(_\cH)?';
- while (@ARGV) {
- $regex = shift(@ARGV);
- ##
- ## If watching for underlined things too, add another regex.
- ##
- if ($underlineOK) {
- if ($regex =~ m/[?*+{}()\\.|^\$[]/) {
- warn "$0: warning, can't underline-safe ``$regex''.\n";
- } else {
- $regex = join($underline_glue, split(//, $regex));
- }
- }
-
- ## If nothing special in the regex, just use index...
- ## is quite a bit faster.
- if (($iflag eq '') && ($words == 0) &&
- $regex !~ m/[?*+{}()\\.|^\$[]/)
- {
- push(@regex_tests, "(index(\$_, q+$regex+)>=0)");
-
- } else {
- $regex =~ s#[\$\@\/]\w#\\$&#;
- if ($words) {
- if ($regex =~ m/\|/) {
- ## could be dangerous -- see if we can wrap in parens.
- if ($regex =~ m/\\\d/) {
- warn "warning: -w and a | in a regex is dangerous.\n"
- } else {
- $regex = join($regex, '(', ')');
- }
- }
- $regex = join($regex, '\b', '\b');
- }
- $CAN_USE_FAST_LISTONLY = 0 if substr($regex, "[^") >= 0;
- push(@regex_tests, "m/$regex/$iflag$mflag");
- }
-
- ## If we're done, but still have @extra to do, get set for that.
- if (@ARGV == 0 && @extra) {
- @ARGV = @extra; ## now deal with the extra stuff.
- $underlineOK = 0; ## but no more of this.
- undef @extra; ## or this.
- }
- }
- if (@regex_tests) {
- $REGEX_TEST = join('||', @regex_tests);
- ## print STDERR $REGEX_TEST, "\n"; exit;
- } else {
- ## must be doing -find -- just give something syntactically correct.
- $REGEX_TEST = 1;
- }
- }
-
- ##
- ## Make sure we can read the first item(s).
- ##
- foreach $start (@todo) {
- $! = 2, die qq/$0: can't stat "$start"\n/
- unless ($dev,$inode) = (stat($start))[$STAT_DEV,$STAT_INODE];
-
- if (defined $dir_done{"$dev,$inode"}) {
- ## ignore the repeat.
- warn(qq/ignoring "$start" (same as "$dir_done{"$dev,$inode"}").\n/)
- if $VERBOSE;
- next;
- }
-
- ## if -xdev was given, remember the device.
- $xdev{$dev} = 1 if $XDEV;
-
- ## Note that we won't want to do it again
- $dir_done{"$dev,$inode"} = $start;
- }
-}
-
-
-##
-## See the comment above the __END__ above the 'sub dodir' below.
-##
-sub import_program
-{
- sub bad {
- print STDERR "$0: internal error (@_)\n";
- exit 2;
- }
-
- ## Read from data, up to next __END__. This will be &dodir.
- local($/) = "\n__END__";
- $prog = <DATA>;
- close(DATA);
-
- $prog =~ s/\beval\b//g; ## remove any 'eval'
-
- ## Inline uppercase $-variables by their current values.
- if ($] >= 5) {
- $prog =~ s/\$([A-Z][A-Z0-9_]{2,}\b)/
- &bad($1) if !defined ${$main::{$1}}; ${$main::{$1}};/eg;
- } else {
- $prog =~ s/\$([A-Z][A-Z0-9_]{2,}\b)/local(*VAR) = $_main{$1};
- &bad($1) if !defined $VAR; $VAR;/eg;
- }
-
- eval $prog; ## now do it. This will define &dodir;
- $!=2, die "$0 internal error: $@\n" if $@;
-}
-
-###########################################################################
-
-##
-## Read the .search file:
-## Blank lines and lines that are only #-comments ignored.
-## Newlines may be escaped to create long lines
-## Other lines are directives.
-##
-## A directive may begin with an optional tag in the form <...>
-## Things inside the <...> are evaluated as with:
-## <(this || that) && must>
-## will be true if
-## -xmust -xthis or -xmust -xthat
-## were specified on the command line (order doesn't matter, though)
-## A directive is not done if there is a tag and it's false.
-## Any characters but whitespace and &|()>,! may appear after an -x
-## (although "-xdev" is special). -xmust,this is the same as -xmust -xthis.
-## Something like -x~ would make <~> true, and <!~> false.
-##
-## Directives are in the form:
-## option: STRING
-## magic : NUMBYTES : EXPR
-##
-## With option:
-## The STRING is parsed like a Bourne shell command line, and the
-## options are used as if given on the command line.
-## No comments are allowed on 'option' lines.
-## Examples:
-## # skip objects and libraries
-## option: -skip '.o .a'
-## # skip emacs *~ and *# files, unless -x~ given:
-## <!~> option: -skip '~ #'
-##
-## With magic:
-## EXPR can be pretty much any perl (comments allowed!).
-## If it evaluates to true for any particular file, it is skipped.
-## The only info you'll have about a file is the variable $H, which
-## will have at least the first NUMBYTES of the file (less if the file
-## is shorter than that, of course, and maybe more). You'll also have
-## any variables you set in previous 'magic' lines.
-## Examples:
-## magic: 6 : ($x6 = substr($H, 0, 6)) eq 'GIF87a'
-## magic: 6 : $x6 eq 'GIF89a'
-##
-## magic: 6 : (($x6 = substr($H, 0, 6)) eq 'GIF87a' ## old gif \
-## || $x6 eq 'GIF89a' ## new gif
-## (the above two sets are the same)
-## ## Check the first 32 bytes for "binarish" looking bytes.
-## ## Don't blindly dump on any high-bit set, as non-ASCII text
-## ## often has them set. \x80 and \xff seem to be special, though.
-## ## Require two in a row to not get things like perl's $^T.
-## ## This is known to get *.Z, *.gz, pkzip, *.elc and about any
-## ## executable you'll find.
-## magic: 32 : $H =~ m/[\x00-\x06\x10-\x1a\x1c-\x1f\x80\xff]{2}/
-##
-sub read_rc
-{
- local($file, $show) = @_;
- local($line_num, $ln, $tag) = 0;
- local($use_default, @default) = 0;
-
- { package magic; $\17 = 0; } ## turn off warnings for when we run EXPR's
-
- unless (open(RC, "$file")) {
- $use_default=1;
- $file = "<internal default startup file>";
- ## no RC file -- use this default.
- @default = split(/\n/,<<'--------INLINE_LITERAL_TEXT');
- magic: 32 : $H =~ m/[\x00-\x06\x10-\x1a\x1c-\x1f\x80\xff]{2}/
- option: -skip '.a .COM .elc .EXE .gz .o .pbm .xbm .dvi'
- option: -iskip '.tarz .zip .z .lzh .jpg .jpeg .gif .uu'
- <!~> option: -skip '~ #'
---------INLINE_LITERAL_TEXT
- }
-
- ##
- ## Make an eval error pretty.
- ##
- sub clean_eval_error {
- local($_) = @_;
- s/ in file \(eval\) at line \d+,//g; ## perl4-style error
- s/ at \(eval \d+\) line \d+,//g; ## perl5-style error
- $_ = $` if m/\n/; ## remove all but first line
- "$_\n";
- }
-
- print "reading RC file: $file\n" if $show;
-
- while (defined($_ = ($use_default ? shift(@default) : <RC>))) {
- $ln = ++$line_num; ## note starting line num.
- $_ .= <RC>, $line_num++ while s/\\\n?$/\n/; ## allow continuations
- next if /^\s*(#.*)?$/; ## skip blank or comment-only lines.
- $do = '';
-
- ## look for an initial <...> tag.
- if (s/^\s*<([^>]*)>//) {
- ## This simple s// will make the tag ready to eval.
- ($tag = $msg = $1) =~
- s/[^\s&|(!)]+/
- $seen_opt{$&}=1; ## note seen option
- "defined(\$opt{q>$&>})" ## (q>> is safe quoting here)
- /eg;
-
- ## see if the tag is true or not, abort this line if not.
- $dothis = (eval $tag);
- $!=2, die "$file $ln <$msg>: $_".&clean_eval_error($@) if $@;
-
- if ($show) {
- $msg =~ s/[^\s&|(!)]+/-x$&/;
- $msg =~ s/\s*!\s*/ no /g;
- $msg =~ s/\s*&&\s*/ and /g;
- $msg =~ s/\s*\|\|\s*/ or /g;
- $msg =~ s/^\s+//; $msg =~ s/\s+$//;
- $do = $dothis ? "(doing because $msg)" :
- "(do if $msg)";
- } elsif (!$dothis) {
- next;
- }
- }
-
- if (m/^\s*option\s*:\s*/) {
- next if $all && !$show; ## -all turns off these checks;
- local($_) = $';
- s/\n$//;
- local($orig) = $_;
- print " $do option: $_\n" if $show;
- local($0) = "$0 ($file)"; ## for any error message.
- local(@ARGV);
- local($this);
- ##
- ## Parse $_ as a Bourne shell line -- fill @ARGV
- ##
- while (length) {
- if (s/^\s+//) {
- push(@ARGV, $this) if defined $this;
- undef $this;
- next;
- }
- $this = '' if !defined $this;
- $this .= $1 while s/^'([^']*)'// ||
- s/^"([^"]*)"// ||
- s/^([^'"\s\\]+)//||
- s/^(\\[\D\d])//;
- die "$file $ln: error parsing $orig at $_\n" if m/^\S/;
- }
- push(@ARGV, $this) if defined $this;
- &check_args;
- die qq/$file $ln: unused arg "@ARGV".\n/ if @ARGV;
- next;
- }
-
- if (m/^\s*magic\s*:\s*(\d+)\s*:\s*/) {
- next if $all && !$show; ## -all turns off these checks;
- local($bytes, $check) = ($1, $');
-
- if ($show) {
- $check =~ s/\n?$/\n/;
- print " $do contents: $check";
- }
- ## Check to make sure the thing at least compiles.
- eval "package magic; (\$H = '1'x \$main'bytes) && (\n$check\n)\n";
- $! = 2, die "$file $ln: ".&clean_eval_error($@) if $@;
-
- $HEADER_BYTES = $bytes if $bytes > $HEADER_BYTES;
- push(@magic_tests, "(\n$check\n)");
- next;
- }
- $! = 2, die "$file $ln: unknown command\n";
- }
- close(RC);
-}
-
-sub message
-{
- if (!$STDERR_IS_TTY) {
- print STDERR $_[0], "\n";
- } else {
- local($text) = @_;
- $thislength = length($text);
- if ($thislength >= $last_message_length) {
- print STDERR $text, "\r";
- } else {
- print STDERR $text, ' 'x ($last_message_length-$thislength),"\r";
- }
- $last_message_length = $thislength;
- }
-}
-
-sub clear_message
-{
- print STDERR ' ' x $last_message_length, "\r" if $last_message_length;
- $vv_print = $vv_size = $last_message_length = 0;
-}
-
-##
-## Output a copy of this program with comments, extra whitespace, and
-## the trailing man page removed. On an ultra slow machine, such a copy
-## might load faster (but I can't tell any difference on my machine).
-##
-sub strip {
- seek(DATA, 0, 0) || die "$0: can't reset internal pointer.\n";
- while(<DATA>) {
- print, next if /INLINE_LITERAL_TEXT/.../INLINE_LITERAL_TEXT/;
- ## must mention INLINE_LITERAL_TEXT on this line!
- s/\#\#.*|^\s+|\s+$//; ## remove cruft
- last if $_ eq '.00;';
- next if ($_ eq '') || ($_ eq "'di'") || ($_ eq "'ig00'");
- s/\$stripped=0;/\$stripped=1;/;
- s/\s\s+/ /; ## squish multiple whitespaces down to one.
- print $_, "\n";
- }
- exit(0);
-}
-
-##
-## Just to shut up -w. Never executed.
-##
-sub dummy {
-
- 1 || &dummy || &dir_done || &bad || &message || $NEXT_DIR_ENTRY ||
- $DELAY || $VV_SIZE || $VV_PRINT_COUNT || $STDERR_SCREWS_STDOUT ||
- @files || @files || $magic'H || $magic'H || $xdev{''} || &clear_message;
-
-}
-
-##
-## If the following __END__ is in place, what follows will be
-## inlined when the program first starts up. Any $ variable name
-## all in upper case, specifically, any string matching
-## \$([A-Z][A-Z0-9_]{2,}\b
-## will have the true value for that variable inlined. Also, any 'eval' is
-## removed
-##
-## The idea is that when the whole thing is then eval'ed to define &dodir,
-## the perl optimizer will make all the decisions that are based upon
-## command-line options (such as $VERBOSE), since they'll be inlined as
-## constants
-##
-## Also, and here's the big win, the tests for matching the regex, and a
-## few others, are all inlined. Should be blinding speed here.
-##
-## See the read from <DATA> above for where all this takes place.
-## But all-in-all, you *want* the __END__ here. Comment it out only for
-## debugging....
-##
-
-__END__
-
-##
-## Given a directory, check all "appropriate" files in it.
-## Shove any subdirectories into the global @todo, so they'll be done
-## later.
-##
-## Be careful about adding any upper-case variables, as they are subject
-## to being inlined. See comments above the __END__ above.
-##
-sub dodir
-{
- local($dir) = @_;
- $dir =~ s,/+$,,; ## remove any trailing slash.
- unless (opendir(DIR, "$dir/.")) {
- &clear_message if $VERBOSE && $STDERR_SCREWS_STDOUT;
- warn qq($0: can't opendir "$dir/".\n);
- return;
- }
-
- if ($VERBOSE) {
- &message($dir);
- $vv_print = $vv_size = 0;
- }
-
- @files = sort readdir(DIR) if $DO_SORT;
-
- while (defined($name = eval $NEXT_DIR_ENTRY))
- {
- next if $name eq '.' || $name eq '..'; ## never follow these.
-
- ## create full relative pathname.
- $file = $dir eq '.' ? $name : "$dir/$name";
-
- ## if link and skipping them, do so.
- if ($NOLINKS && -l $file) {
- warn qq/skip (symlink): $file\n/ if $WHY;
- next;
- }
-
- ## skip things unless files or directories
- unless (-f $file || -d _) {
- if ($WHY) {
- $why = (-S _ && "socket") ||
- (-p _ && "pipe") ||
- (-b _ && "block special")||
- (-c _ && "char special") || "somekinda special";
- warn qq/skip ($why): $file\n/;
- }
- next;
- }
-
- ## skip things we can't read
- unless (-r _) {
- if ($WHY) {
- $why = (-l $file) ? "follow" : "read";
- warn qq/skip (can't $why): $file\n/;
- }
- next;
- }
-
- ## skip things that are empty
- unless (-s _ || -d _) {
- warn qq/skip (empty): $file\n/ if $WHY;
- next;
- }
-
- ## Note file device & inode. If -xdev, skip if appropriate.
- ($dev, $inode) = (stat(_))[$STAT_DEV, $STAT_INODE];
- if ($XDEV && defined $xdev{$dev}) {
- warn qq/skip (other device): $file\n/ if $WHY;
- next;
- }
- $id = "$dev,$inode";
-
- ## special work for a directory
- if (-d _) {
- ## Do checks for directory file endings.
- if ($DO_DSKIP_TEST && (eval $DSKIP_TEST)) {
- warn qq/skip (-dskip): $file\n/ if $WHY;
- next;
- }
- ## do checks for -name/-regex/-path tests
- if ($DO_DGLOB_TESTS && !(eval $DGLOB_TESTS)) {
- warn qq/skip (dirname): $file\n/ if $WHY;
- next;
- }
-
- ## _never_ redo a directory
- if (defined $dir_done{$id} and $^O ne 'MSWin32') {
- warn qq/skip (did as "$dir_done{$id}"): $file\n/ if $WHY;
- next;
- }
- $dir_done{$id} = $file; ## mark it done.
- unshift(@todo, $file); ## add to the list to do.
- next;
- }
- if ($WHY == 0 && $VERBOSE > 1) {
- if ($VERBOSE>2||$vv_print++>$VV_PRINT_COUNT||($vv_size+=-s _)>$VV_SIZE){
- &message($file);
- $vv_print = $vv_size = 0;
- }
- }
-
- ## do time-related tests
- if ($NEWER || $OLDER) {
- $_ = (stat(_))[$STAT_MTIME];
- if ($NEWER && $_ < $NEWER) {
- warn qq/skip (too old): $file\n/ if $WHY;
- next;
- }
- if ($OLDER && $_ > $OLDER) {
- warn qq/skip (too new): $file\n/ if $WHY;
- next;
- }
- }
-
- ## do checks for file endings
- if ($DO_SKIP_TEST && (eval $SKIP_TEST)) {
- warn qq/skip (-skip): $file\n/ if $WHY;
- next;
- }
-
- ## do checks for -name/-regex/-path tests
- if ($DO_GLOB_TESTS && !(eval $GLOB_TESTS)) {
- warn qq/skip (filename): $file\n/ if $WHY;
- next;
- }
-
-
- ## If we're not repeating files,
- ## skip this one if we've done it, or note we're doing it.
- unless ($DOREP) {
- if (defined $file_done{$id}) {
- warn qq/skip (did as "$file_done{$id}"): $file\n/ if $WHY;
- next;
- }
- $file_done{$id} = $file;
- }
-
- if ($DO_MAGIC_TESTS) {
- if (!open(FILE_IN, $file)) {
- &clear_message if $VERBOSE && $STDERR_SCREWS_STDOUT;
- warn qq/$0: can't open: $file\n/;
- next;
- }
- unless (read(FILE_IN, $magic'H, $HEADER_BYTES)) {
- &clear_message if $VERBOSE && $STDERR_SCREWS_STDOUT;
- warn qq/$0: can't read from "$file"\n"/;
- close(FILE_IN);
- next;
- }
-
- eval $MAGIC_TESTS;
- if ($magic'val) {
- close(FILE_IN);
- warn qq/skip (magic): $file\n/ if $WHY;
- next;
- }
- seek(FILE_IN, 0, 0); ## reset for later <FILE_IN>
- }
-
- if ($WHY != 0 && $VERBOSE > 1) {
- if ($VERBOSE>2||$vv_print++>$VV_PRINT_COUNT||($vv_size+=-s _)>$VV_SIZE){
- &message($file);
- $vv_print = $vv_size = 0;
- }
- }
-
- if ($DELAY) {
- sleep($DELAY);
- }
-
- if ($FIND_ONLY) {
- &clear_message if $VERBOSE && $STDERR_SCREWS_STDOUT;
- print $file, "\n";
- $retval=0; ## we've found something
- close(FILE_IN) if $DO_MAGIC_TESTS;
- next;
- } else {
- ## if we weren't doing magic tests, file won't be open yet...
- if (!$DO_MAGIC_TESTS && !open(FILE_IN, $file)) {
- &clear_message if $VERBOSE && $STDERR_SCREWS_STDOUT;
- warn qq/$0: can't open: $file\n/;
- next;
- }
- if ($LIST_ONLY && $CAN_USE_FAST_LISTONLY) {
- ##
- ## This is rather complex, but buys us a LOT when we're just
- ## listing files and not the individual internal lines.
- ##
- local($size) = 4096; ## block-size in which to do reads
- local($nl); ## will point to $_'s ending newline.
- local($read); ## will be how many bytes read.
- local($_) = ''; ## Starts out empty
- local($hold); ## (see below)
-
- while (($read = read(FILE_IN,$_,$size,length($_)))||length($_))
- {
- undef @parts;
- ## if read a full block, but no newline, need to read more.
- while ($read == $size && ($nl = rindex($_, "\n")) < 0) {
- push(@parts, $_); ## save that part
- $read = read(FILE_IN, $_, $size); ## keep trying
- }
-
- ##
- ## If we had to save parts, must now combine them together.
- ## adjusting $nl to reflect the now-larger $_. This should
- ## be a lot more efficient than using any kind of .= in the
- ## loop above.
- ##
- if (@parts) {
- local($lastlen) = length($_); #only need if $nl >= 0
- $_ = join('', @parts, $_);
- $nl = length($_) - ($lastlen - $nl) if $nl >= 0;
- }
-
- ##
- ## If we're at the end of the file, then we can use $_ as
- ## is. Otherwise, we need to remove the final partial-line
- ## and save it so that it'll be at the beginning of the
- ## next read (where the rest of the line will be layed in
- ## right after it). $hold will be what we should save
- ## until next time.
- ##
- if ($read != $size || $nl < 0) {
- $hold = '';
- } else {
- $hold = substr($_, $nl + 1);
- substr($_, $nl + 1) = '';
- }
-
- ##
- ## Now have a bunch of full lines in $_. Use it.
- ##
- if (eval $REGEX_TEST) {
- &clear_message if $VERBOSE && $STDERR_SCREWS_STDOUT;
- print $file, "\n";
- $retval=0; ## we've found something
-
- last;
- }
-
- ## Prepare for next read....
- $_ = $hold;
- }
-
- } else { ## else not using faster block scanning.....
-
- $lines_printed = 0 if $NICE;
- while (<FILE_IN>) {
- study;
- next unless (eval $REGEX_TEST);
-
- ##
- ## We found a matching line.
- ##
- $retval=0;
- &clear_message if $VERBOSE && $STDERR_SCREWS_STDOUT;
- if ($LIST_ONLY) {
- print $file, "\n";
- last;
- } else {
- ## prepare to print line.
- if ($NICE && $lines_printed++ == 0) {
- print '-' x 70, "\n" if $NICE > 1;
- print $file, ":\n";
- }
-
- ##
- ## Print all the prelim stuff. This looks less efficient
- ## than it needs to be, but that's so that when the eval
- ## is compiled (and the tests are optimized away), the
- ## result will be less actual PRINTs than the more natural
- ## way of doing these tests....
- ##
- if ($NICE) {
- if ($REPORT_LINENUM) {
- print " line $.: ";
- } else {
- print " ";
- }
- } elsif ($REPORT_LINENUM && $PREPEND_FILENAME) {
- print "$file,:$.: ";
- } elsif ($PREPEND_FILENAME) {
- print "$file: ";
- } elsif ($REPORT_LINENUM) {
- print "$.: ";
- }
- print $_;
- print "\n" unless m/\n$/;
- }
- }
- print "\n" if ($NICE > 1) && $lines_printed;
- }
- close(FILE_IN);
- }
- }
- closedir(DIR);
-}
-
-__END__
-.00; ## finish .ig
-
-'di \" finish diversion--previous line must be blank
-.nr nl 0-1 \" fake up transition to first page again
-.nr % 0 \" start at page 1
-.\"__________________NORMAL_MAN_PAGE_BELOW_________________
-.ll+10n
-.TH search 1 "Dec 17, 1994"
-.SH SEARCH
-search \- search files (a'la grep) in a whole directory tree.
-.SH SYNOPSIS
-search [ grep-like and find-like options] [regex ....]
-.SH DESCRIPTION
-.I Search
-is more or less a combo of 'find' and 'grep' (although the regular
-expression flavor is that of the perl being used, which is closer to
-egrep's than grep's).
-
-.I Search
-does generally the same kind of thing that
-.nf
- find <blah blah> | xargs egrep <blah blah>
-.fi
-does, but is
-.I much
-more powerful and efficient (and intuitive, I think).
-
-This manual describes
-.I search
-as of version "941227.4". You can always find the latest version at
-.nf
- http://www.wg.omron.co.jp/~jfriedl/perl/index.html
-.fi
-
-.SH "QUICK EXAMPLE"
-Basic use is simple:
-.nf
- % search jeff
-.fi
-will search files in the current directory, and all sub directories, for
-files that have "jeff" in them. The lines will be listed with the
-containing file's name prepended.
-.PP
-If you list more than one regex, such as with
-.nf
- % search jeff Larry Randal+ 'Stoc?k' 'C.*son'
-.fi
-then a line containing any of the regexes will be listed.
-This makes it effectively the same as
-.nf
- % search 'jeff|Larry|Randal+|Stoc?k|C.*son'
-.fi
-However, listing them separately is much more efficient (and is easier
-to type).
-.PP
-Note that in the case of these examples, the
-.B \-w
-(list whole-words only) option would be useful.
-.PP
-Normally, various kinds of files are automatically removed from consideration.
-If it has has a certain ending (such as ".tar", ".Z", ".o", .etc), or if
-the beginning of the file looks like a binary, it'll be excluded.
-You can control exactly how this works -- see below. One quick way to
-override this is to use the
-.B \-all
-option, which means to consider all the files that would normally be
-automatically excluded.
-Or, if you're curious, you can use
-.B \-why
-to have notes about what files are skipped (and why) printed to stderr.
-
-.SH "BASIC OVERVIEW"
-Normally, the search starts in the current directory, considering files in
-all subdirectories.
-
-You can use the
-.I ~/.search
-file to control ways to automatically exclude files.
-If you don't have this file, a default one will kick in, which automatically
-add
-.nf
- -skip .o .Z .gif
-.fi
-(among others) to exclude those kinds of files (which you probably want to
-skip when searching for text, as is normal).
-Files that look to be be binary will also be excluded.
-
-Files ending with "#" and "~" will also be excluded unless the
-.B -x~
-option is given.
-
-You can use
-.B -showrc
-to show what kinds of files will normally be skipped.
-See the section on the startup file
-for more info.
-
-You can use the
-.B -all
-option to indicate you want to consider all files that would otherwise be
-skipped by the startup file.
-
-Based upon various other flags (see "WHICH FILES TO CONSIDER" below),
-more files might be removed from consideration. For example
-.nf
- -mtime 3
-.fi
-will exclude files that aren't at least three days old (change the 3 to -3
-to exclude files that are more than three days old), while
-.nf
- -skip .*
-.fi
-would exclude any file beginning with a dot (of course, '.' and '..' are
-special and always excluded).
-
-If you'd like to see what files are being excluded, and why, you can get the
-list via the
-.B \-why
-option.
-
-If a file makes it past all the checks, it is then "considered".
-This usually means it is greped for the regular expressions you gave
-on the command line.
-
-If any of the regexes match a line, the line is printed.
-However, if
-.B -list
-is given, just the filename is printed. Or, if
-.B -nice
-is given, a somewhat more (human-)readable output is generated.
-
-If you're searching a huge tree and want to keep informed about how
-the search is progressing,
-.B -v
-will print (to stderr) the current directory being searched.
-Using
-.B -vv
-will also print the current file "every so often", which could be useful
-if a directory is huge. Using
-.B -vvv
-will print the update with every file.
-
-Below is the full listing of options.
-
-.SH "OPTIONS TELLING *WHERE* TO SEARCH"
-.TP
-.BI -dir " DIR"
-Start searching at the named directory instead of the current directory.
-If multiple
-.B -dir
-arguments are given, multiple trees will be searched.
-.TP
-.BI -ddir " DIR"
-Like
-.B -dir
-except it flushes any previous
-.B -dir
-directories (i.e. "-dir A -dir B -dir C" will search A, B, and C, while
-"-dir A -ddir B -dir C" will search only B and C. This might be of use
-in the startup file (see that section below).
-.TP
-.B -xdev
-Stay on the same filesystem as the starting directory/directories.
-.TP
-.B -sort
-Sort the items in a directory before processing them.
-Normally they are processed in whatever order they happen to be read from
-the directory.
-.TP
-.B -nolinks
-Don't follow symbolic links. Normally they're followed.
-
-.SH "OPTIONS CONTROLLING WHICH FILES TO CONSIDER AND EXCLUDE"
-.TP
-.BI -mtime " NUM"
-Only consider files that were last changed more than
-.I NUM
-days ago
-(less than
-.I NUM
-days if
-.I NUM
-has '-' prepended, i.e. "-mtime -2.5" means to consider files that
-have been changed in the last two and a half days).
-.TP
-.B -older FILE
-Only consider files that have not changed since
-.I FILE
-was last changed.
-If there is any upper case in the "-older", "or equal" is added to the sense
-of the test. Therefore, "search -older ./file regex" will never consider
-"./file", while "search -Older ./file regex" will.
-
-If a file is a symbolic link, the time used is that of the file and not the
-link.
-.TP
-.BI -newer " FILE"
-Opposite of
-.BR -older .
-.TP
-.BI -name " GLOB"
-Only consider files that match the shell filename pattern
-.IR GLOB .
-The check is only done on a file's name (use
-.B -path
-to check the whole path, and use
-.B -dname
-to check directory names).
-
-Multiple specifications can be given by separating them with spaces, a'la
-.nf
- -name '*.c *.h'
-.fi
-to consider C source and header files.
-If
-.I GLOB
-doesn't contain any special pattern characters, a '*' is prepended.
-This last example could have been given as
-.nf
- -name '.c .h'
-.fi
-It could also be given as
-.nf
- -name .c -name .h
-.fi
-or
-.nf
- -name '*.c' -name '*.h'
-.fi
-or
-.nf
- -name '*.[ch]'
-.fi
-(among others)
-but in this last case, you have to be sure to supply the leading '*'.
-.TP
-.BI -path " GLOB"
-Like
-.B -name
-except the entire path is checked against the pattern.
-.TP
-.B -regex " REGEX"
-Considers files whose names (not paths) match the given perl regex
-exactly.
-.TP
-.BI -iname " GLOB"
-Case-insensitive version of
-.BR -name .
-.TP
-.BI -ipath " GLOB"
-Case-insensitive version of
-.BR -path .
-.TP
-.BI -iregex " REGEX"
-Case-insensitive version of
-.BR -regex .
-
-.TP
-.BI -dpath " GLOB"
-Only search down directories whose path matches the given pattern (this
-doesn't apply to the initial directory given by
-.BI -dir ,
-of course).
-Something like
-.nf
- -dir /usr/man -dpath /usr/man/man*
-.fi
-would completely skip
-"/usr/man/cat1", "/usr/man/cat2", etc.
-.TP
-.BI -dskip " GLOB"
-Skips directories whose name (not path) matches the given pattern.
-Something like
-.nf
- -dir /usr/man -dskip cat*
-.fi
-would completely skip any directory in the tree whose name begins with "cat"
-(including "/usr/man/cat1", "/usr/man/cat2", etc.).
-.TP
-.BI -dregex " REGEX"
-Like
-.BI -dpath ,
-but the pattern is a full perl regex. Note that this quite different
-from
-.B -regex
-which considers only file names (not paths). This option considers
-full directory paths (not just names). It's much more useful this way.
-Sorry if it's confusing.
-.TP
-.BI -dpath " GLOB"
-This option exists, but is probably not very useful. It probably wants to
-be like the '-below' or something I mention in the "TODO" section.
-.TP
-.BI -idpath " GLOB"
-Case-insensitive version of
-.BR -dpath .
-.TP
-.BI -idskip " GLOB"
-Case-insensitive version of
-.BR -dskip .
-.TP
-.BI -idregex " REGEX"
-Case-insensitive version of
-.BR -dregex .
-.TP
-.B -all
-Ignore any 'magic' or 'option' lines in the startup file.
-The effect is that all files that would otherwise be automatically
-excluded are considered.
-.TP
-.BI -x SPECIAL
-Arguments starting with
-.B -x
-(except
-.BR -xdev ,
-explained elsewhere) do special interaction with the
-.I ~/.search
-startup file. Something like
-.nf
- -xflag1 -xflag2
-.fi
-will turn on "flag1" and "flag2" in the startup file (and is
-the same as "-xflag1,flag2"). You can use this to write your own
-rules for what kinds of files are to be considered.
-
-For example, the internal-default startup file contains the line
-.nf
- <!~> option: -skip '~ #'
-.fi
-This means that if the
-.B -x~
-flag is
-.I not
-seen, the option
-.nf
- -skip '~ #'
-.fi
-should be done.
-The effect is that emacs temp and backup files are not normally
-considered, but you can included them with the -x~ flag.
-
-You can write your own rules to customize
-.I search
-in powerful ways. See the STARTUP FILE section below.
-.TP
-.B -why
-Print a message (to stderr) when and why a file is not considered.
-
-.SH "OPTIONS TELLING WHAT TO DO WITH FILES THAT WILL BE CONSIDERED"
-.TP
-.B -find
-(you can use
-.B -f
-as well).
-This option changes the basic action of
-.IR search .
-
-Normally, if a file is considered, it is searched
-for the regular expressions as described earlier. However, if this option
-is given, the filename is printed and no searching takes place. This turns
-.I search
-into a 'find' of some sorts.
-
-In this case, no regular expressions are needed on the command line
-(any that are there are silently ignored).
-
-This is not intended to be a replacement for the 'find' program,
-but to aid
-you in understanding just what files are getting past the exclusion checks.
-If you really want to use it as a sort of replacement for the 'find' program,
-you might want to use
-.B -all
-so that it doesn't waste time checking to see if the file is binary, etc
-(unless you really want that, of course).
-
-If you use
-.BR -find ,
-none of the "GREP-LIKE OPTIONS" (below) matter.
-
-As a replacement for 'find',
-.I search
-is probably a bit slower (or in the case of GNU find, a lot slower --
-GNU find is
-.I unbelievably
-fast).
-However, "search -ffind"
-might be more useful than 'find' when options such as
-.B -skip
-are used (at least until 'find' gets such functionality).
-.TP
-.B -ffind
-(or
-.BR -ff )
-A faster more 'find'-like find. Does
-.nf
- -find -all -dorep
-.fi
-.SH "GREP-LIKE OPTIONS"
-These options control how a searched file is accessed,
-and how things are printed.
-.TP
-.B -i
-Ignore letter case when matching.
-.TP
-.B -w
-Consider only whole-word matches ("whole word" as defined by perl's "\\b"
-regex).
-.TP
-.B -u
-If the regex(es) is/are simple, try to modify them so that they'll work
-in manpage-like underlined text (i.e. like _^Ht_^Hh_^Hi_^Hs).
-This is very rudimentary at the moment.
-.TP
-.B -list
-(you can use
-.B -l
-too).
-Don't print matching lines, but the names of files that contain matching
-lines. This will likely be *much* faster, as special optimizations are
-made -- particularly with large files.
-.TP
-.B -n
-Pepfix each line by its line number.
-.TP
-.B -nice
-Not a grep-like option, but similar to
-.BR -list ,
-so included here.
-.B -nice
-will have the output be a bit more human-readable, with matching lines printed
-slightly indented after the filename, a'la
-.nf
-
- % search foo
- somedir/somefile: line with foo in it
- somedir/somefile: some food for thought
- anotherdir/x: don't be a buffoon!
- %
-
-.fi
-will become
-.nf
-
- % search -nice foo
- somedir/somefile:
- line with foo in it
- some food for thought
- anotherdir/x:
- don't be a buffoon!
- %
-
-.fi
-This option due to Lionel Cons.
-.TP
-.B -nnice
-Be a bit nicer than
-.BR -nice .
-Prefix each file's output by a rule line, and follow with an extra blank line.
-.TP
-.B -h
-Don't prepend each output line with the name of the file
-(meaningless when
-.B -find
-or
-.B -l
-are given).
-
-.SH "OTHER OPTIONS"
-.TP
-.B -help
-Print the usage information.
-.TP
-.B -version
-Print the version information and quit.
-.TP
-.B -v
-Set the level of message verbosity.
-.B -v
-will print a note whenever a new directory is entered.
-.B -vv
-will also print a note "every so often". This can be useful to see
-what's happening when searching huge directories.
-.B -vvv
-will print a new with every file.
-.B -vvvv
-is
--vvv
-plus
-.BR -why .
-.TP
-.B -e
-This ends the options, and can be useful if the regex begins with '-'.
-.TP
-.B -showrc
-Shows what is being considered in the startup file, then exits.
-.TP
-.B -dorep
-Normally, an identical file won't be checked twice (even with multiple
-hard or symbolic links). If you're just trying to do a fast
-.BR -find ,
-the bookkeeping to remember which files have been seen is not desirable,
-so you can eliminate the bookkeeping with this flag.
-
-.SH "STARTUP FILE"
-When
-.I search
-starts up, it processes the directives in
-.IR ~/.search .
-If no such file exists, a default
-internal version is used.
-
-The internal version looks like:
-.nf
-
- magic: 32 : $H =~ m/[\ex00-\ex06\ex10-\ex1a\ex1c-\ex1f\ex80\exff]{2}/
- option: -skip '.a .COM .elc .EXE .gz .o .pbm .xbm .dvi'
- option: -iskip '.tarz .zip .z .lzh .jpg .jpeg .gif .uu'
- <!~> option: -skip '~ #'
-
-.fi
-If you wish to create your own "~/.search",
-you might consider copying the above, and then working from there.
-
-There are two kinds of directives in a startup file: "magic" and "option".
-.RS 0n
-.TP
-OPTION
-Option lines will automatically do the command-line options given.
-For example, the line
-.nf
- option: -v
-.fi
-in you startup file will turn on -v every time, without needing to type it
-on the command line.
-
-The text on the line after the "option:" directive is processed
-like the Bourne shell, so make sure to pay attention to quoting.
-.nf
- option: -skip .exe .com
-.fi
-will give an error (".com" by itself isn't a valid option), while
-.nf
- option: -skip ".exe .com"
-.fi
-will properly include it as part of -skip's argument.
-
-.TP
-MAGIC
-Magic lines are used to determine if a file should be considered a binary
-or not (the term "magic" refers to checking a file's magic number). These
-are described in more detail below.
-.RE
-
-Blank lines and comments (lines beginning with '#') are allowed.
-
-If a line begins with <...>, then it's a check to see if the
-directive on the line should be done or not. The stuff inside the <...>
-can contain perl's && (and), || (or), ! (not), and parens for grouping,
-along with "flags" that might be indicated by the user with
-.BI -x flag
-options.
-
-For example, using "-xfoo" will cause "foo" to be true inside the <...>
-blocks. Therefore, a line beginning with "<foo>" would be done only when
-"-xfoo" had been specified, while a line beginning with "<!foo>" would be
-done only when "-xfoo" is not specified (of course, a line without any <...>
-is done in either case).
-
-A realistic example might be
-.nf
- <!v> -vv
-.fi
-This will cause -vv messages to be the default, but allow "-xv" to override.
-
-There are a few flags that are set automatically:
-.RS
-.TP
-.B TTY
-true if the output is to the screen (as opposed to being redirected to a file).
-You can force this (as with all the other automatic flags) with -xTTY.
-.TP
-.B -v
-True if -v was specified. If -vv was specified, both
-.B -v
-and
-.B -vv
-flags are true (and so on).
-.TP
-.B -nice
-True if -nice was specified. Same thing about -nnice as for -vv.
-.PP
-.TP
-.B -list
-true if -list (or -l) was given.
-.TP
-.B -dir
-true if -dir was given.
-.RE
-
-Using this info, you might change the last example to
-.nf
-
- <!v && !-v> option: -vv
-
-.fi
-The added "&& !-v" means "and if the '-v' option not given".
-This will allow you to use "-v" alone on the command line, and not
-have this directive add the more verbose "-vv" automatically.
-
-.RS 0
-Some other examples:
-.TP
-<!-dir && !here> option: -dir ~/
-Effectively make the default directory your home directory (instead of the
-current directory). Using -dir or -xhere will undo this.
-.TP
-<tex> option: -name .tex -dir ~/pub
-Create '-xtex' to search only "*.tex" files in your ~/pub directory tree.
-Actually, this could be made a bit better. If you combine '-xtex' and '-dir'
-on the command line, this directive will add ~/pub to the list, when you
-probably want to use the -dir directory only. You could do
-.nf
-
- <tex> option: -name .tex
- <tex && !-dir> option: -dir ~/pub
-.fi
-
-to will allow '-xtex' to work as before, but allow a command-line "-dir"
-to take precedence with respect to ~/pub.
-.TP
-<fluff> option: -nnice -sort -i -vvv
-Combine a few user-friendly options into one '-xfluff' option.
-.TP
-<man> option: -ddir /usr/man -v -w
-When the '-xman' option is given, search "/usr/man" for whole-words
-(of whatever regex or regexes are given on the command line), with -v.
-.RE
-
-The lines in the startup file are executed from top to bottom, so something
-like
-.nf
-
- <both> option: -xflag1 -xflag2
- <flag1> option: ...whatever...
- <flag2> option: ...whatever...
-
-.fi
-will allow '-xboth' to be the same as '-xflag1 -xflag2' (or '-xflag1,flag2'
-for that matter). However, if you put the "<both>" line below the others,
-they will not be true when encountered, so the result would be different
-(and probably undesired).
-
-The "magic" directives are used to determine if a file looks to be binary
-or not. The form of a magic line is
-.nf
- magic: \fISIZE\fP : \fIPERLCODE\fP
-.fi
-where
-.I SIZE
-is the number of bytes of the file you need to check, and
-.I PERLCODE
-is the code to do the check. Within
-.IR PERLCODE ,
-the variable $H will hold at least the first
-.I SIZE
-bytes of the file (unless the file is shorter than that, of course).
-It might hold more bytes. The perl should evaluate to true if the file
-should be considered a binary.
-
-An example might be
-.nf
- magic: 6 : substr($H, 0, 6) eq 'GIF87a'
-.fi
-to test for a GIF ("-iskip .gif" is better, but this might be useful
-if you have images in files without the ".gif" extension).
-
-Since the startup file is checked from top to bottom, you can be a bit
-efficient:
-.nf
- magic: 6 : ($x6 = substr($H, 0, 6)) eq 'GIF87a'
- magic: 6 : $x6 eq 'GIF89a'
-.fi
-You could also write the same thing as
-.nf
- magic: 6 : (($x6 = substr($H, 0, 6)) eq 'GIF87a') || ## an old gif, or.. \e
- $x6 eq 'GIF89a' ## .. a new one.
-.fi
-since newlines may be escaped.
-
-The default internal startup file includes
-.nf
- magic: 32 : $H =~ m/[\ex00-\ex06\ex10-\ex1a\ex1c-\ex1f\ex80\exff]{2}/
-.fi
-which checks for certain non-printable characters, and catches a large
-number of binary files, including most system's executables, linkable
-objects, compressed, tarred, and otherwise folded, spindled, and mutilated
-files.
-
-Another example might be
-.nf
- ## an archive library
- magic: 17 : substr($H, 0, 17) eq "!<arch>\en__.SYMDEF"
-.fi
-
-.SH "RETURN VALUE"
-.I Search
-returns zero if lines (or files, if appropriate) were found,
-or if no work was requested (such as with
-.BR -help ).
-Returns 1 if no lines (or files) were found.
-Returns 2 on error.
-
-.SH TODO
-Things I'd like to add some day:
-.nf
- + show surrounding lines (context).
- + highlight matched portions of lines.
- + add '-and', which can go between regexes to override
- the default logical or of the regexes.
- + add something like
- -below GLOB
- which will examine a tree and only consider files that
- lie in a directory deeper than one named by the pattern.
- + add 'warning' and 'error' directives.
- + add 'help' directive.
-.fi
-.SH BUGS
-If -xdev and multiple -dir arguments are given, any file in any of the
-target filesystems are allowed. It would be better to allow each filesystem
-for each separate tree.
-
-Multiple -dir args might also cause some confusing effects. Doing
-.nf
- -dir some/dir -dir other
-.fi
-will search "some/dir" completely, then search "other" completely. This
-is good. However, something like
-.nf
- -dir some/dir -dir some/dir/more/specific
-.fi
-will search "some/dir" completely *except for* "some/dir/more/specific",
-after which it will return and be searched. Not really a bug, but just sort
-of odd.
-
-File times (for -newer, etc.) of symbolic links are for the file, not the
-link. This could cause some misunderstandings.
-
-Probably more. Please let me know.
-.SH AUTHOR
-Jeffrey Friedl, Omron Corp (jfriedl@omron.co.jp)
-.br
-http://www.wg.omron.co.jp/cgi-bin/j-e/jfriedl.html
-
-.SH "LATEST SOURCE"
-See http://www.wg.omron.co.jp/~jfriedl/perl/index.html
+++ /dev/null
-#
-BEGIN { warn "Running ".__FILE__."\n" };
-BEGIN
- {
- require "Config.pm";
- die "Config.pm:$@" if $@;
- Config::->import;
- }
-use File::Compare qw(compare);
-use File::Copy qw(copy);
-my $name = $0;
-$name =~ s#^(.*)\.PL$#../$1.SH#;
-my %opt;
-while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
- {
- $opt{$1}=$2;
- shift(@ARGV);
- }
-
-$opt{CONFIG_H} ||= 'config.h';
-
-warn "Writing $opt{CONFIG_H}\n";
-
-my $patchlevel = $opt{INST_VER};
-$patchlevel =~ s|^[\\/]||;
-$patchlevel =~ s|~VERSION~|$Config{version}|g;
-$patchlevel ||= $Config{version};
-$patchlevel = qq["$patchlevel"];
-
-open(SH,"<$name") || die "Cannot open $name:$!";
-while (<SH>)
- {
- last if /^sed/;
- }
-($term,$file,$pat) = /^sed\s+<<(\S+)\s+>(\S+)\s+(.*)$/;
-
-$file =~ s/^\$(\w+)$/$opt{$1}/g;
-
-my $str = "sub munge\n{\n";
-
-while ($pat =~ s/-e\s+'([^']*)'\s*//)
- {
- my $e = $1;
- $e =~ s/\\([\(\)])/$1/g;
- $e =~ s/\\(\d)/\$$1/g;
- $str .= "$e;\n";
- }
-$str .= "}\n";
-
-eval $str;
-
-die "$str:$@" if $@;
-
-open(H,">$file.new") || die "Cannot open $file.new:$!";
-#binmode H; # no CRs (which cause a spurious rebuild)
-while (<SH>)
- {
- last if /^$term$/o;
- s/\$([\w_]+)/Config($1)/eg;
- s/`([^\`]*)`/BackTick($1)/eg;
- munge();
- s/\\\$/\$/g;
- s#/[ *\*]*\*/#/**/#;
- if (/^\s*#define\s+(PRIVLIB|SITELIB|VENDORLIB)_EXP/)
- {
- $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "($patchlevel))\t/**/\n";
- }
- # incpush() handles archlibs, so disable them
- elsif (/^\s*#define\s+(ARCHLIB|SITEARCH|VENDORARCH)_EXP/)
- {
- $_ = "/*#define ". $1 . "_EXP \"\"\t/**/\n";
- }
- print H;
- }
-close(H);
-close(SH);
-
-
-chmod(0666,"$opt{CORE_DIR}/$opt{CONFIG_H}");
-copy("$file.new","$opt{CORE_DIR}/$opt{CONFIG_H}") || die "Cannot copy:$!";
-chmod(0444,"$opt{CORE_DIR}/$opt{CONFIG_H}");
-
-if (compare("$file.new",$file))
- {
- warn "$file has changed\n";
- chmod(0666,$file);
- unlink($file);
- rename("$file.new",$file);
- #chmod(0444,$file);
- exit(1);
- }
-else
- {
- unlink ("$file.new");
- exit(0);
- }
-
-sub Config
-{
- my $var = shift;
- my $val = $Config{$var};
- $val = 'undef' unless defined $val;
- $val =~ s/\\/\\\\/g;
- return $val;
-}
-
-sub BackTick
-{
- my $cmd = shift;
- if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/)
- {
- local ($data,$pat) = ($1,$2);
- $data =~ s/\s+/ /g;
- eval "\$data =~ $pat";
- return $data;
- }
- else
- {
- die "Cannot handle \`$cmd\`";
- }
- return $cmd;
-}
+++ /dev/null
-use FindExt;
-# take a semicolon separated path list and turn it into a quoted
-# list of paths that Text::Parsewords will grok
-sub mungepath {
- my $p = shift;
- # remove leading/trailing semis/spaces
- $p =~ s/^[ ;]+//;
- $p =~ s/[ ;]+$//;
- $p =~ s/'/"/g;
- my @p = map { $_ = "\"$_\"" if /\s/ and !/^".*"$/; $_ } split /;/, $p;
- 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;
- }
-}
-
-FindExt::scan_ext("../ext");
-
-my %opt;
-
-my $optref = loadopts();
-while (@{$optref} && $optref->[0] =~ /^([\w_]+)=(.*)$/) {
- $opt{$1}=$2;
- shift(@{$optref});
-}
-
-my @dynamic = FindExt::dynamic_ext();
-my @noxs = FindExt::nonxs_ext();
-my @known = sort(@dynamic,split(/\s+/,$opt{'staticext'}),@noxs);
-$opt{'known_extensions'} = join(' ',@known);
-
-@dynamic = grep(!/Thread/,@dynamic);
-@known = grep(!/Thread/,@dynamic);
-
-$opt{'dynamic_ext'} = join(' ',@dynamic);
-$opt{'nonxs_ext'} = join(' ',@noxs);
-
-$opt{'extensions'} = join(' ',@known);
-
-my $pl_h = '../patchlevel.h';
-
-if (-e $pl_h) {
- open PL, "<$pl_h" or die "Can't open $pl_h: $!";
- while (<PL>) {
- if (/^#\s*define\s+(PERL_\w+)\s+([\d.]+)/) {
- $opt{$1} = $2;
- }
- }
- close PL;
-}
-else {
- die "Can't find $pl_h: $!";
-}
-$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]
- unless $opt{'cf_email'};
-$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";
- }
- }
- print;
-}
-
+++ /dev/null
-/* dl_win32.xs
- *
- * Platform: Win32 (Windows NT/Windows 95)
- * Author: Wei-Yuen Tan (wyt@hip.com)
- * Created: A warm day in June, 1995
- *
- * Modified:
- * August 23rd 1995 - rewritten after losing everything when I
- * wiped off my NT partition (eek!)
- */
-
-/* Porting notes:
-
-I merely took Paul's dl_dlopen.xs, took out extraneous stuff and
-replaced the appropriate SunOS calls with the corresponding Win32
-calls.
-
-*/
-
-#define WIN32_LEAN_AND_MEAN
-#ifdef __GNUC__
-#define Win32_Winsock
-#endif
-#include <windows.h>
-#include <string.h>
-
-#define PERL_NO_GET_CONTEXT
-
-#include "EXTERN.h"
-#include "perl.h"
-#include "win32.h"
-
-#include "XSUB.h"
-
-typedef struct {
- SV * x_error_sv;
-} my_cxtx_t; /* this *must* be named my_cxtx_t */
-
-#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */
-#include "dlutils.c" /* SaveError() etc */
-
-#define dl_error_sv (dl_cxtx.x_error_sv)
-
-static char *
-OS_Error_String(pTHX)
-{
- dMY_CXT;
- DWORD err = GetLastError();
- STRLEN len;
- if (!dl_error_sv)
- dl_error_sv = newSVpvn("",0);
- PerlProc_GetOSError(dl_error_sv,err);
- return SvPV(dl_error_sv,len);
-}
-
-static void
-dl_private_init(pTHX)
-{
- (void)dl_generic_private_init(aTHX);
-}
-
-/*
- This function assumes the list staticlinkmodules
- will be formed from package names with '::' replaced
- with '/'. Thus Win32::OLE is in the list as Win32/OLE
-*/
-static int
-dl_static_linked(char *filename)
-{
- char **p;
- char* ptr;
- static char subStr[] = "/auto/";
- char szBuffer[MAX_PATH];
-
- /* change all the '\\' to '/' */
- strcpy(szBuffer, filename);
- for(ptr = szBuffer; ptr = strchr(ptr, '\\'); ++ptr)
- *ptr = '/';
-
- /* delete the file name */
- ptr = strrchr(szBuffer, '/');
- if(ptr != NULL)
- *ptr = '\0';
-
- /* remove leading lib path */
- ptr = strstr(szBuffer, subStr);
- if(ptr != NULL)
- ptr += sizeof(subStr)-1;
- else
- ptr = szBuffer;
-
- for (p = staticlinkmodules; *p;p++) {
- if (strstr(ptr, *p)) return 1;
- };
- return 0;
-}
-
-MODULE = DynaLoader PACKAGE = DynaLoader
-
-BOOT:
- (void)dl_private_init(aTHX);
-
-void *
-dl_load_file(filename,flags=0)
- char * filename
- int flags
- PREINIT:
- CODE:
- {
- DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
- if (dl_static_linked(filename) == 0) {
- RETVAL = PerlProc_DynaLoad(filename);
- }
- else
- RETVAL = (void*) XCEGetModuleHandleA(NULL);
- DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", RETVAL));
- ST(0) = sv_newmortal() ;
- if (RETVAL == NULL)
- SaveError(aTHX_ "load_file:%s",
- OS_Error_String(aTHX)) ;
- else
- sv_setiv( ST(0), (IV)RETVAL);
- }
-
-void *
-dl_find_symbol(libhandle, symbolname)
- void * libhandle
- char * symbolname
- CODE:
- DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
- libhandle, symbolname));
- RETVAL = (void*) XCEGetProcAddressA((HINSTANCE) libhandle, symbolname);
- DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref = %x\n", RETVAL));
- ST(0) = sv_newmortal() ;
- if (RETVAL == NULL)
- SaveError(aTHX_ "find_symbol:%s",
- OS_Error_String(aTHX)) ;
- else
- sv_setiv( ST(0), (IV)RETVAL);
-
-
-void
-dl_undef_symbols()
- PPCODE:
-
-
-
-# These functions should not need changing on any platform:
-
-void
-dl_install_xsub(perl_name, symref, filename="$Package")
- char * perl_name
- void * symref
- char * filename
- CODE:
- DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
- perl_name, symref));
- ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
- (void(*)(pTHX_ CV *))symref,
- filename)));
-
-
-char *
-dl_error()
- CODE:
- dMY_CXT;
- RETVAL = dl_last_error;
- OUTPUT:
- RETVAL
-
-# end.
+++ /dev/null
-/*
- * this is a dummy header file for Socket.xs
- */
-
+++ /dev/null
-/* sys/socket.h */
-
-/* djl */
-/* Provide UNIX compatibility */
-
-#ifndef _INC_SYS_SOCKET
-#define _INC_SYS_SOCKET
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-#ifndef _WINDOWS_
-#ifdef __GNUC__
-#define WIN32_LEAN_AND_MEAN
-#ifdef __GNUC__
-#define Win32_Winsock
-#endif
-#include <windows.h>
-#else
-#define _WINDOWS_
-
-#ifndef FAR
-#define FAR
-#endif
-
-#define PASCAL __stdcall
-#define WINAPI __stdcall
-
-#undef WORD
-typedef int BOOL;
-typedef unsigned short WORD;
-typedef void* HANDLE;
-typedef void* HWND;
-typedef int (FAR WINAPI *FARPROC)();
-
-typedef unsigned long DWORD;
-typedef void *PVOID;
-
-#define IN
-#define OUT
-
-#ifndef UNDER_CE
-typedef struct _OVERLAPPED {
- DWORD Internal;
- DWORD InternalHigh;
- DWORD Offset;
- DWORD OffsetHigh;
- HANDLE hEvent;
-} OVERLAPPED, *LPOVERLAPPED;
-#endif
-
-#endif
-#endif /* _WINDOWS_ */
-/* #ifndef __GNUC__ */
-#include <winsock.h>
-/* #endif */
-
-#define ENOTSOCK WSAENOTSOCK
-#undef HOST_NOT_FOUND
-
-#ifdef USE_SOCKETS_AS_HANDLES
-
-#ifndef PERL_FD_SETSIZE
-#define PERL_FD_SETSIZE 64
-#endif
-
-#define PERL_BITS_PER_BYTE 8
-#define PERL_NFDBITS (sizeof(Perl_fd_mask)*PERL_BITS_PER_BYTE)
-
-typedef int Perl_fd_mask;
-
-typedef struct Perl_fd_set {
- Perl_fd_mask bits[(PERL_FD_SETSIZE+PERL_NFDBITS-1)/PERL_NFDBITS];
-} Perl_fd_set;
-
-#define PERL_FD_CLR(n,p) \
- ((p)->bits[(n)/PERL_NFDBITS] &= ~((unsigned)1 << ((n)%PERL_NFDBITS)))
-
-#define PERL_FD_SET(n,p) \
- ((p)->bits[(n)/PERL_NFDBITS] |= ((unsigned)1 << ((n)%PERL_NFDBITS)))
-
-#define PERL_FD_ZERO(p) memset((char *)(p),0,sizeof(*(p)))
-
-#define PERL_FD_ISSET(n,p) \
- ((p)->bits[(n)/PERL_NFDBITS] & ((unsigned)1 << ((n)%PERL_NFDBITS)))
-
-#else /* USE_SOCKETS_AS_HANDLES */
-
-#define Perl_fd_set fd_set
-#define PERL_FD_SET(n,p) FD_SET(n,p)
-#define PERL_FD_CLR(n,p) FD_CLR(n,p)
-#define PERL_FD_ISSET(n,p) FD_ISSET(n,p)
-#define PERL_FD_ZERO(p) FD_ZERO(p)
-
-#endif /* USE_SOCKETS_AS_HANDLES */
-
-SOCKET win32_accept (SOCKET s, struct sockaddr *addr, int *addrlen);
-int win32_bind (SOCKET s, const struct sockaddr *addr, int namelen);
-int win32_closesocket (SOCKET s);
-int win32_connect (SOCKET s, const struct sockaddr *name, int namelen);
-int win32_ioctlsocket (SOCKET s, long cmd, u_long *argp);
-int win32_getpeername (SOCKET s, struct sockaddr *name, int * namelen);
-int win32_getsockname (SOCKET s, struct sockaddr *name, int * namelen);
-int win32_getsockopt (SOCKET s, int level, int optname, char * optval, int *optlen);
-u_long win32_htonl (u_long hostlong);
-u_short win32_htons (u_short hostshort);
-unsigned long win32_inet_addr (const char * cp);
-char * win32_inet_ntoa (struct in_addr in);
-int win32_listen (SOCKET s, int backlog);
-u_long win32_ntohl (u_long netlong);
-u_short win32_ntohs (u_short netshort);
-int win32_recv (SOCKET s, char * buf, int len, int flags);
-int win32_recvfrom (SOCKET s, char * buf, int len, int flags,
- struct sockaddr *from, int * fromlen);
-int win32_select (int nfds, Perl_fd_set *rfds, Perl_fd_set *wfds, Perl_fd_set *xfds,
- const struct timeval *timeout);
-int win32_send (SOCKET s, const char * buf, int len, int flags);
-int win32_sendto (SOCKET s, const char * buf, int len, int flags,
- const struct sockaddr *to, int tolen);
-int win32_setsockopt (SOCKET s, int level, int optname,
- const char * optval, int optlen);
-SOCKET win32_socket (int af, int type, int protocol);
-int win32_shutdown (SOCKET s, int how);
-
-/* Database function prototypes */
-
-struct hostent * win32_gethostbyaddr(const char * addr, int len, int type);
-struct hostent * win32_gethostbyname(const char * name);
-int win32_gethostname (char * name, int namelen);
-struct servent * win32_getservbyport(int port, const char * proto);
-struct servent * win32_getservbyname(const char * name, const char * proto);
-struct protoent * win32_getprotobynumber(int proto);
-struct protoent * win32_getprotobyname(const char * name);
-struct protoent *win32_getprotoent(void);
-struct servent *win32_getservent(void);
-void win32_sethostent(int stayopen);
-void win32_setnetent(int stayopen);
-struct netent * win32_getnetent(void);
-struct netent * win32_getnetbyname(char *name);
-struct netent * win32_getnetbyaddr(long net, int type);
-void win32_setprotoent(int stayopen);
-void win32_setservent(int stayopen);
-void win32_endhostent(void);
-void win32_endnetent(void);
-void win32_endprotoent(void);
-void win32_endservent(void);
-
-#ifndef WIN32SCK_IS_STDSCK
-
-/* direct to our version */
-
-#define htonl win32_htonl
-#define htons win32_htons
-#define ntohl win32_ntohl
-#define ntohs win32_ntohs
-#define inet_addr win32_inet_addr
-#define inet_ntoa win32_inet_ntoa
-
-#define socket win32_socket
-#define bind win32_bind
-#define listen win32_listen
-#define accept win32_accept
-#define connect win32_connect
-#define send win32_send
-#define sendto win32_sendto
-#define recv win32_recv
-#define recvfrom win32_recvfrom
-#define shutdown win32_shutdown
-#define closesocket win32_closesocket
-#define ioctlsocket win32_ioctlsocket
-#define setsockopt win32_setsockopt
-#define getsockopt win32_getsockopt
-#define getpeername win32_getpeername
-#define getsockname win32_getsockname
-#define gethostname win32_gethostname
-#define gethostbyname win32_gethostbyname
-#define gethostbyaddr win32_gethostbyaddr
-#define getprotobyname win32_getprotobyname
-#define getprotobynumber win32_getprotobynumber
-#define getservbyname win32_getservbyname
-#define getservbyport win32_getservbyport
-#define select win32_select
-#define endhostent win32_endhostent
-#define endnetent win32_endnetent
-#define endprotoent win32_endprotoent
-#define endservent win32_endservent
-#define getnetent win32_getnetent
-#define getnetbyname win32_getnetbyname
-#define getnetbyaddr win32_getnetbyaddr
-#define getprotoent win32_getprotoent
-#define getservent win32_getservent
-#define sethostent win32_sethostent
-#define setnetent win32_setnetent
-#define setprotoent win32_setprotoent
-#define setservent win32_setservent
-
-#ifdef USE_SOCKETS_AS_HANDLES
-#undef fd_set
-#undef FD_SET
-#undef FD_CLR
-#undef FD_ISSET
-#undef FD_ZERO
-#define fd_set Perl_fd_set
-#define FD_SET(n,p) PERL_FD_SET(n,p)
-#define FD_CLR(n,p) PERL_FD_CLR(n,p)
-#define FD_ISSET(n,p) PERL_FD_ISSET(n,p)
-#define FD_ZERO(p) PERL_FD_ZERO(p)
-#endif /* USE_SOCKETS_AS_HANDLES */
-
-#endif /* WIN32SCK_IS_STDSCK */
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* _INC_SYS_SOCKET */
+++ /dev/null
-open ICO, ">perl.ico" or die $!;
-while (<DATA>) {
- chomp;
- print ICO pack "H*", $_;
-}
-close ICO or die $!;
-
-# Create new hex data with
-# perl -wle 'binmode STDIN; $/ = \32; while (<>) {print unpack "H*", $_}' <perl.ico.orig
-# then place after __DATA__
-__DATA__
-000001000200101010000000000028010000260000002020100000000000e802
-00004e0100002800000010000000200000000100040000000000c00000000000
-0000000000000000000000000000000000000000800000800000008080008000
-00008000800080800000c0c0c000808080000000ff0000ff000000ffff00ff00
-0000ff00ff00ffff0000ffffff00000040000004000000000433334000000000
-003bb3000000000004b33b400000000044644644000000044ee44ee440000004
-eeeeeeee4000000eeeeeeeeee000000eeeeeeeeee000000eeeeeeeeee0000006
-eeeeefee60000000eeeeeeef000000000eeeeef0000000000066660000000000
-0000000000000000000000000000f00f0000f81f0000fc3f0000f81f0000f00f
-0000e0070000e0070000e0070000e0070000e0070000e0070000f00f0000f81f
-0000fc3f0000ffff0000ffff0000280000002000000040000000010004000000
-0000800200000000000000000000000000000000000000000000000080000080
-000000808000800000008000800080800000c0c0c000808080000000ff0000ff
-000000ffff00ff000000ff00ff00ffff0000ffffff0000000000044000004000
-00440000000000000000004444040404444000000000000000000004b3430343
-b400000000000000000000004bb333bb40000000000000000000000043bbbbb3
-4000000000000000000000004b3b3b3b400000000000000000000004bbb3b3bb
-b4000000000000000000004b444b3b444b40000000000000000004b46644b446
-64b400000000000000004b46e6e4b4e6e64b4000000000000004b46e6e64446e
-6e64b40000000000000446e6e6e646e6e6e644000000000000046e6e6e6e4eee
-ee6e6400000000000066e6e6eeee4eeeeeeee66000000000006e6e6eeeeeeeee
-eeeeee60000000000066e6eeeeeeeeeeeeeeee6000000000006e6eeeeeeeeeee
-eeeeee60000000000066eeeeeeeeeeeeeeeeee6000000000006e6eeeeeeeeeee
-feeeee60000000000066eeeeeeeeeeeefeeeef600000000000066eeeeeeeeeef
-feeee600000000000006eeeeeeeeefffeeeef6000000000000006eeeeeeeeeee
-eeef600000000000000006eeeeeeeeeeeef60000000000000000006eeeeeeeee
-ef60000000000000000000066eeeeeef66000000000000000000000006666666
-0000000000000000000000000000000000000000000000000000000000000000
-0000000000000000000000000000000000000000000000000000000000000000
-00000000000000000000000000000000000000000000ff8000ffffc001ffffe0
-03fffff007fffff007fffff007ffffe003ffffc001ffff8000ffff00007ffe00
-003ffe00003ffe00003ffc00001ffc00001ffc00001ffc00001ffc00001ffc00
-001ffc00001ffe00003ffe00003fff00007fff8000ffffc001ffffe003fffff8
-0fffffffffffffffffffffffffffffffffffffffffff
+++ /dev/null
-/* 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 UNDER_CE
-#define CHECK_HOST_INTERP
-#endif
-
-#ifndef ___PerlHost_H___
-#define ___PerlHost_H___
-
-#ifndef UNDER_CE
-#include <signal.h>
-#endif
-#include "iperlsys.h"
-#include "vmem.h"
-#include "vdir.h"
-
-START_EXTERN_C
-extern char * g_win32_get_privlib(const char *pl);
-extern char * g_win32_get_sitelib(const char *pl);
-extern char * g_win32_get_vendorlib(const char *pl);
-extern char * g_getlogin(void);
-END_EXTERN_C
-
-class CPerlHost
-{
-public:
- /* Constructors */
- 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 */
- /* Locks provided but should be unnecessary as this is private pool */
- 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 */
- /* Locks used to serialize access to the pool */
- inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
- inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
- inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
- inline void* MallocShared(size_t size)
- {
- void *result;
- GetLockShared();
- result = m_pVMemShared->Malloc(size);
- FreeLockShared();
- return result;
- };
- inline void* ReallocShared(void* ptr, size_t size)
- {
- void *result;
- GetLockShared();
- result = m_pVMemShared->Realloc(ptr, size);
- FreeLockShared();
- return result;
- };
- inline void FreeShared(void* ptr)
- {
- GetLockShared();
- m_pVMemShared->Free(ptr);
- FreeLockShared();
- };
- 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;
- };
-
-/* IPerlMemParse */
- /* Assume something else is using locks to mangaging serialize
- on a batch basis
- */
- inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
- inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
- inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
- 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;
- };
-
-/* 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;
- BOOL m_bTopLevel; // is this a toplevel host?
- static long num_hosts;
-public:
- inline int LastHost(void) { return num_hosts == 1L; };
- struct interpreter *host_perl;
-};
-
-long CPerlHost::num_hosts = 0L;
-
-extern "C" void win32_checkTLS(struct interpreter *host_perl);
-
-#define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
-#ifdef CHECK_HOST_INTERP
-inline CPerlHost* CheckInterp(CPerlHost *host)
-{
- win32_checkTLS(host->host_perl);
- return host;
-}
-#define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y))
-#else
-#define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y)
-#endif
-
-inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
-{
- return STRUCT2RAWPTR(piPerl, m_hostperlMem);
-}
-
-inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
-{
- return STRUCT2RAWPTR(piPerl, m_hostperlMemShared);
-}
-
-inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
-{
- return STRUCT2RAWPTR(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, const char *pl)
-{
- return g_win32_get_privlib(pl);
-}
-
-char*
-PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
-{
- return g_win32_get_sitelib(pl);
-}
-
-char*
-PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
-{
- return g_win32_get_vendorlib(pl);
-}
-
-void
-PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
-{
- win32_get_child_IO(ptr);
-}
-
-struct IPerlEnv perlEnv =
-{
- PerlEnvGetenv,
- PerlEnvPutenv,
- PerlEnvGetenv_len,
- PerlEnvUname,
- PerlEnvClearenv,
- PerlEnvGetChildenv,
- PerlEnvFreeChildenv,
- PerlEnvGetChilddir,
- PerlEnvFreeChilddir,
- PerlEnvOsId,
- PerlEnvLibPath,
- PerlEnvSiteLibPath,
- PerlEnvVendorLibPath,
- PerlEnvGetChildIO,
-};
-
-#undef IPERL2HOST
-#define IPERL2HOST(x) IPerlStdIO2Host(x)
-
-/* PerlStdIO */
-FILE*
-PerlStdIOStdin(struct IPerlStdIO* piPerl)
-{
- return win32_stdin();
-}
-
-FILE*
-PerlStdIOStdout(struct IPerlStdIO* piPerl)
-{
- return win32_stdout();
-}
-
-FILE*
-PerlStdIOStderr(struct IPerlStdIO* piPerl)
-{
- return win32_stderr();
-}
-
-FILE*
-PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
-{
- return win32_fopen(path, mode);
-}
-
-int
-PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
-{
- return win32_fclose((pf));
-}
-
-int
-PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
-{
- return win32_feof(pf);
-}
-
-int
-PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
-{
- return win32_ferror(pf);
-}
-
-void
-PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
-{
- win32_clearerr(pf);
-}
-
-int
-PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
-{
- return win32_getc(pf);
-}
-
-char*
-PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
-{
-#ifdef FILE_base
- FILE *f = pf;
- return FILE_base(f);
-#else
- return Nullch;
-#endif
-}
-
-int
-PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
-{
-#ifdef FILE_bufsiz
- FILE *f = pf;
- return FILE_bufsiz(f);
-#else
- return (-1);
-#endif
-}
-
-int
-PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
-{
-#ifdef USE_STDIO_PTR
- FILE *f = pf;
- return FILE_cnt(f);
-#else
- return (-1);
-#endif
-}
-
-char*
-PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
-{
-#ifdef USE_STDIO_PTR
- FILE *f = pf;
- return FILE_ptr(f);
-#else
- return Nullch;
-#endif
-}
-
-char*
-PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
-{
- return win32_fgets(s, n, pf);
-}
-
-int
-PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
-{
- return win32_fputc(c, pf);
-}
-
-int
-PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
-{
- return win32_fputs(s, pf);
-}
-
-int
-PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
-{
- return win32_fflush(pf);
-}
-
-int
-PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
-{
- return win32_ungetc(c, pf);
-}
-
-int
-PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
-{
- return win32_fileno(pf);
-}
-
-FILE*
-PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
-{
- return win32_fdopen(fd, mode);
-}
-
-FILE*
-PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
-{
- return win32_freopen(path, mode, (FILE*)pf);
-}
-
-SSize_t
-PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
-{
- return win32_fread(buffer, size, count, pf);
-}
-
-SSize_t
-PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
-{
- return win32_fwrite(buffer, size, count, pf);
-}
-
-void
-PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
-{
- win32_setbuf(pf, buffer);
-}
-
-int
-PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
-{
- return win32_setvbuf(pf, buffer, type, size);
-}
-
-void
-PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
-{
-#ifdef STDIO_CNT_LVALUE
- FILE *f = pf;
- FILE_cnt(f) = n;
-#endif
-}
-
-void
-PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
-{
-#ifdef STDIO_PTR_LVALUE
- FILE *f = pf;
- FILE_ptr(f) = ptr;
-#endif
-}
-
-void
-PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
-{
- win32_setvbuf(pf, NULL, _IOLBF, 0);
-}
-
-int
-PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
-{
- va_list(arglist);
- va_start(arglist, format);
- return win32_vfprintf(pf, format, arglist);
-}
-
-int
-PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
-{
- return win32_vfprintf(pf, format, arglist);
-}
-
-Off_t
-PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
-{
- return win32_ftell(pf);
-}
-
-int
-PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, Off_t offset, int origin)
-{
- return win32_fseek(pf, offset, origin);
-}
-
-void
-PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
-{
- win32_rewind(pf);
-}
-
-FILE*
-PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
-{
- return win32_tmpfile();
-}
-
-int
-PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
-{
- return win32_fgetpos(pf, p);
-}
-
-int
-PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
-{
- return win32_fsetpos(pf, p);
-}
-void
-PerlStdIOInit(struct IPerlStdIO* piPerl)
-{
-}
-
-void
-PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
-{
- Perl_init_os_extras();
-}
-
-int
-PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, intptr_t osfhandle, int flags)
-{
- return win32_open_osfhandle(osfhandle, flags);
-}
-
-intptr_t
-PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
-{
- return win32_get_osfhandle(filenum);
-}
-
-FILE*
-PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
-{
-#ifndef UNDER_CE
- FILE* pfdup;
- fpos_t pos;
- char mode[3];
- int fileno = win32_dup(win32_fileno(pf));
-
- /* open the file in the same mode */
-#ifdef __BORLANDC__
- if((pf)->flags & _F_READ) {
- mode[0] = 'r';
- mode[1] = 0;
- }
- else if((pf)->flags & _F_WRIT) {
- mode[0] = 'a';
- mode[1] = 0;
- }
- else if((pf)->flags & _F_RDWR) {
- mode[0] = 'r';
- mode[1] = '+';
- mode[2] = 0;
- }
-#else
- if((pf)->_flag & _IOREAD) {
- mode[0] = 'r';
- mode[1] = 0;
- }
- else if((pf)->_flag & _IOWRT) {
- mode[0] = 'a';
- mode[1] = 0;
- }
- else if((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 = win32_fdopen(fileno, mode);
-
- /* move the file pointer to the same position */
- if (!fgetpos(pf, &pos)) {
- fsetpos(pfdup, &pos);
- }
- return pfdup;
-#else
- return 0;
-#endif
-}
-
-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,
- PerlStdIOSetPtr,
- 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, Off_t size)
-{
- return win32_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, Stat_t *buffer)
-{
- return win32_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);
-}
-
-Off_t
-PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin)
-{
- return win32_lseek(handle, offset, origin);
-}
-
-int
-PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *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, Stat_t *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, const 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, const 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)
-{
- dTHX;
- 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)
-{
- return Perl_my_socketpair(domain, type, protocol, fds);
-}
-
-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)
-{
- dTHX;
- 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)
-{
- dTHX;
- PERL_FLUSHALL_FOR_CHILD;
- return win32_popen(command, mode);
-}
-
-PerlIO*
-PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
-{
- dTHX;
- PERL_FLUSHALL_FOR_CHILD;
- return win32_popenlist(mode, narg, args);
-}
-
-int
-PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
-{
- return win32_pclose(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 win32_signal(sig, subcode);
-}
-
-int
-PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
-{
- return win32_gettimeofday(t, z);
-}
-
-#ifdef USE_ITHREADS
-static THREAD_RET_TYPE
-win32_start_child(LPVOID arg)
-{
- PerlInterpreter *my_perl = (PerlInterpreter*)arg;
- GV *tmpgv;
- int status;
-#ifdef PERL_SYNC_FORK
- static long sync_fork_id = 0;
- long id = ++sync_fork_id;
-#endif
-
-
- PERL_SET_THX(my_perl);
- win32_checkTLS(my_perl);
-
- /* set $$ to pseudo id */
-#ifdef PERL_SYNC_FORK
- w32_pseudo_id = id;
-#else
- w32_pseudo_id = GetCurrentThreadId();
- if (IsWin95()) {
- int pid = (int)w32_pseudo_id;
- if (pid < 0)
- w32_pseudo_id = -pid;
- }
-#endif
- if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
- SV *sv = GvSV(tmpgv);
- SvREADONLY_off(sv);
- sv_setiv(sv, -(IV)w32_pseudo_id);
- SvREADONLY_on(sv);
- }
- hv_clear(PL_pidstatus);
-
- /* push a zero on the stack (we are the child) */
- {
- dSP;
- 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_EXIT;
- 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 */
- win32_checkTLS(my_perl);
- PL_main_root = Nullop;
- }
-
- win32_checkTLS(my_perl);
- /* close the std handles to avoid fd leaks */
- {
- do_close(PL_stdingv, FALSE);
- do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
- do_close(PL_stderrgv, FALSE);
- }
-
- /* destroy everything (waits for any pseudo-forked children) */
- win32_checkTLS(my_perl);
- perl_destruct(my_perl);
- win32_checkTLS(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)
-{
- dTHX;
-#ifdef USE_ITHREADS
- DWORD id;
- HANDLE handle;
- CPerlHost *h;
-
- if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
- errno = EAGAIN;
- return -1;
- }
- h = new CPerlHost(*(CPerlHost*)w32_internal_host);
- PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 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;
- h->host_perl = new_perl;
-# ifdef PERL_SYNC_FORK
- id = win32_start_child((LPVOID)new_perl);
- PERL_SET_THX(aTHX);
-# else
-# ifdef USE_RTL_THREAD_API
- handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
- (void*)new_perl, 0, (unsigned*)&id);
-# else
- handle = CreateThread(NULL, 0, win32_start_child,
- (LPVOID)new_perl, 0, &id);
-# endif
- PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
- if (!handle) {
- errno = EAGAIN;
- return -1;
- }
- if (IsWin95()) {
- int pid = (int)id;
- if (pid < 0)
- id = -pid;
- }
- 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);
-}
-
-int
-PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
-{
- return win32_spawnvp(mode, cmdname, argv);
-}
-
-int
-PerlProcLastHost(struct IPerlProc* piPerl)
-{
- dTHX;
- CPerlHost *h = (CPerlHost*)w32_internal_host;
- return h->LastHost();
-}
-
-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,
- PerlProcSpawnvp,
- PerlProcLastHost,
- PerlProcPopenList,
- PerlProcGetTimeOfDay
-};
-
-
-/*
- * CPerlHost
- */
-
-CPerlHost::CPerlHost(void)
-{
- /* Construct a host from scratch */
- InterlockedIncrement(&num_hosts);
- 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;
- m_bTopLevel = TRUE;
-
- 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)
-{
- InterlockedIncrement(&num_hosts);
- 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;
- m_bTopLevel = FALSE;
-
- 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)
-{
- /* Construct a host from another host */
- InterlockedIncrement(&num_hosts);
- 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;
- m_bTopLevel = FALSE;
-
- /* duplicate environment info */
- LPSTR lpPtr;
- DWORD dwIndex = 0;
- while(lpPtr = host.GetIndex(dwIndex))
- Add(lpPtr);
-}
-
-CPerlHost::~CPerlHost(void)
-{
- Reset();
- InterlockedDecrement(&num_hosts);
- 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)
-{
-#ifdef UNDER_CE
- if (!m_lppEnvList || !m_dwEnvCount)
- return NULL;
-#endif
- if (!lpStr)
- return NULL;
- 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)
-{
- dTHX;
- 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) {
- // must allocate things via host memory allocation functions
- // rather than perl's Renew() et al, as the perl interpreter
- // may either not be initialized enough when we allocate these,
- // or may already be dead when we go to free these
- *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
- strcpy(*lpPtr, lpStr);
- }
- else {
- m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
- if (m_lppEnvList) {
- m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
- if (m_lppEnvList[m_dwEnvCount] != NULL) {
- strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
- ++m_dwEnvCount;
- qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
- }
- }
- }
-}
-
-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)
-{
- dTHX;
- Safefree(lpStr);
-}
-
-char*
-CPerlHost::GetChildDir(void)
-{
- dTHX;
- int length;
- char* ptr;
- Newx(ptr, MAX_PATH+1, char);
- if(ptr) {
- m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
- length = strlen(ptr);
- if (length > 3) {
- if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
- ptr[length-1] = 0;
- }
- }
- return ptr;
-}
-
-void
-CPerlHost::FreeChildDir(char* pStr)
-{
- dTHX;
- Safefree(pStr);
-}
-
-LPSTR
-CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
-{
- dTHX;
- 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();
-
- Newx(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) {
- // 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;
- }
- }
- }
- }
-
- while(lpLocalEnv) {
- // still have environment overrides to add
- // so copy the strings into place if not an override
- char *ptr = strchr(lpLocalEnv, '=');
- if(ptr && ptr[1]) {
- strcpy(lpStr, lpLocalEnv);
- lpStr += strlen(lpLocalEnv) + 1;
- }
- lpLocalEnv = GetIndex(dwEnvIndex);
- }
-
- // add final NULL
- *lpStr = '\0';
- }
-
- // release the process environment strings
- FreeEnvironmentStrings(lpAllocPtr);
-
- return lpPtr;
-}
-
-void
-CPerlHost::Reset(void)
-{
- dTHX;
- if(m_lppEnvList != NULL) {
- for(DWORD index = 0; index < m_dwEnvCount; ++index) {
- Free(m_lppEnvList[index]);
- m_lppEnvList[index] = NULL;
- }
- }
- m_dwEnvCount = 0;
- Free(m_lppEnvList);
- m_lppEnvList = NULL;
-}
-
-void
-CPerlHost::Clearenv(void)
-{
- dTHX;
- 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);
- if (m_bTopLevel)
- (void)win32_putenv(lpStr);
- *lpPtr = ch;
- }
- lpStr += strlen(lpStr) + 1;
- }
-
- FreeEnvironmentStrings(lpEnvPtr);
-}
-
-
-char*
-CPerlHost::Getenv(const char *varname)
-{
- dTHX;
- if (!m_bTopLevel) {
- char *pEnv = Find(varname);
- if (pEnv && *pEnv)
- return pEnv;
- }
- return win32_getenv(varname);
-}
-
-int
-CPerlHost::Putenv(const char *envstring)
-{
- dTHX;
- Add(envstring);
- if (m_bTopLevel)
- return win32_putenv(envstring);
-
- return 0;
-}
-
-int
-CPerlHost::Chdir(const char *dirname)
-{
- dTHX;
- int ret;
- if (!dirname) {
- errno = ENOENT;
- return -1;
- }
- ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
- if(ret < 0) {
- errno = ENOENT;
- }
- return ret;
-}
-
-#endif /* ___PerlHost_H___ */
+++ /dev/null
-/* Time-stamp: <01/08/01 20:58:55 keuchel@w2k> */
-
-#include "EXTERN.h"
-#include "perl.h"
-
-#include "XSUB.h"
-
-#ifdef PERL_IMPLICIT_SYS
-#include "win32iop.h"
-#include <fcntl.h>
-#endif /* PERL_IMPLICIT_SYS */
-
-
-/* Register any extra external extensions */
-char *staticlinkmodules[] = {
- "DynaLoader",
- NULL,
-};
-
-EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
-
-static void
-xs_init(pTHX)
-{
- char *file = __FILE__;
- dXSUB_SYS;
- newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-}
-
-#ifdef PERL_IMPLICIT_SYS
-
-extern "C" void win32_checkTLS(PerlInterpreter *host_perl);
-void
-win32_checkTLS(PerlInterpreter *host_perl)
-{
- dTHX;
- if (host_perl != my_perl) {
- printf(" ... bad in win32_checkTLS\n");
- printf(" %08X ne %08X\n",host_perl,my_perl);
- int *nowhere = NULL;
- *nowhere = 0;
- abort();
- }
-}
-
-#ifdef UNDER_CE
-int GetLogicalDrives() {
- return 0; /* no logical drives on CE */
-}
-int GetLogicalDriveStrings(int size, char addr[]) {
- return 0; /* no logical drives on CE */
-}
-/* TBD */
-DWORD GetFullPathNameA(LPCSTR fn, DWORD blen, LPTSTR buf, LPSTR *pfile) {
- return 0;
-}
-/* TBD */
-DWORD GetFullPathNameW(CONST WCHAR *fn, DWORD blen, WCHAR * buf, WCHAR **pfile) {
- return 0;
-}
-/* TBD */
-DWORD SetCurrentDirectoryA(LPSTR pPath) {
- return 0;
-}
-/* TBD */
-DWORD SetCurrentDirectoryW(CONST WCHAR *pPath) {
- return 0;
-}
-int xcesetuid(uid_t id){return 0;}
-int xceseteuid(uid_t id){ return 0;}
-int xcegetuid() {return 0;}
-int xcegeteuid(){ return 0;}
-#endif
-
-#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,
- struct IPerlDirInfo* perlDirInfo,
- struct IPerlSockInfo* perlSockInfo,
- struct IPerlProcInfo* perlProcInfo)
-{
- if (perlMemInfo) {
- Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*);
- perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
- }
- 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) {
- Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*);
- perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*));
- }
- if (perlLIOInfo) {
- Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*);
- perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*));
- }
- if (perlDirInfo) {
- Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*);
- perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*));
- }
- if (perlSockInfo) {
- Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*);
- perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*));
- }
- if (perlProcInfo) {
- Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*);
- perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*));
- }
-}
-
-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)
-{
- PerlInterpreter *my_perl = NULL;
- 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) {
- w32_internal_host = pHost;
- }
- }
- return my_perl;
-}
-
-EXTERN_C PerlInterpreter*
-perl_alloc(void)
-{
- 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;
- }
- }
- pHost->host_perl = my_perl; /* FIXME this statement shouldn't be here */
- return my_perl;
-}
-
-EXTERN_C void
-win32_delete_internal_host(void *h)
-{
- CPerlHost *host = (CPerlHost*)h;
- delete host;
-}
-
-#endif /* PERL_IMPLICIT_SYS */
-
-EXTERN_C HANDLE w32_perldll_handle;
-
-EXTERN_C DllExport int
-RunPerl(int argc, char **argv, char **env)
-{
- int exitstatus;
- PerlInterpreter *my_perl, *new_perl = NULL;
-
-#ifndef __BORLANDC__
- /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
- * want to free() argv after main() returns. As luck would have it,
- * Borland's CRT does the right thing to argv[0] already. */
- char szModuleName[MAX_PATH];
- char *ptr;
-
- XCEGetModuleFileNameA(NULL, szModuleName, sizeof(szModuleName));
- (void)win32_longpath(szModuleName);
- argv[0] = szModuleName;
-#endif
-
-#ifdef PERL_GLOBAL_STRUCT
-#define PERLVAR(var,type) /**/
-#define PERLVARA(var,type) /**/
-#define PERLVARI(var,type,init) PL_Vars.var = init;
-#define PERLVARIC(var,type,init) PL_Vars.var = init;
-#include "perlvars.h"
-#undef PERLVAR
-#undef PERLVARA
-#undef PERLVARI
-#undef PERLVARIC
-#endif
-
- PERL_SYS_INIT(&argc,&argv);
-
- if (!(my_perl = perl_alloc()))
- return (1);
- perl_construct(my_perl);
- PL_perl_destruct_level = 0;
-
- exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
- if (!exitstatus) {
-#if defined(TOP_CLONE) && defined(USE_ITHREADS) /* XXXXXX testing */
- new_perl = perl_clone(my_perl, 1);
- exitstatus = perl_run(new_perl);
- PERL_SET_THX(my_perl);
-#else
- exitstatus = perl_run(my_perl);
-#endif
- }
-
- perl_destruct(my_perl);
- perl_free(my_perl);
-#ifdef USE_ITHREADS
- if (new_perl) {
- PERL_SET_THX(new_perl);
- perl_destruct(new_perl);
- perl_free(new_perl);
- }
-#endif
-
- PERL_SYS_TERM();
-
- return (exitstatus);
-}
-
-EXTERN_C void
-set_w32_module_name(void);
-
-#ifdef __MINGW32__
-EXTERN_C /* GCC in C++ mode mangles the name, otherwise */
-#endif
-BOOL APIENTRY
-DllMain(HANDLE hModule, /* DLL module handle */
- DWORD fdwReason, /* reason called */
- LPVOID lpvReserved) /* reserved */
-{
- switch (fdwReason) {
- /* The DLL is attaching to a process due to process
- * initialization or a call to LoadLibrary.
- */
- case DLL_PROCESS_ATTACH:
-/* #define DEFAULT_BINMODE */
-#ifdef DEFAULT_BINMODE
- setmode( fileno( stdin ), O_BINARY );
- setmode( fileno( stdout ), O_BINARY );
- setmode( fileno( stderr ), O_BINARY );
- _fmode = O_BINARY;
-#endif
-
-#ifndef UNDER_CE
- DisableThreadLibraryCalls((HMODULE)hModule);
-#endif
-
- w32_perldll_handle = hModule;
- set_w32_module_name();
- break;
-
- /* The DLL is detaching from a process due to
- * process termination or call to FreeLibrary.
- */
- case DLL_PROCESS_DETACH:
- break;
-
- /* The attached process creates a new thread. */
- case DLL_THREAD_ATTACH:
- break;
-
- /* The thread of the attached process terminates. */
- case DLL_THREAD_DETACH:
- break;
-
- default:
- break;
- }
- return TRUE;
-}
-
-
-#if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
-EXTERN_C PerlInterpreter *
-perl_clone_host(PerlInterpreter* proto_perl, UV flags) {
- dTHX;
- CPerlHost *h;
- h = new CPerlHost(*(CPerlHost*)PL_sys_intern.internal_host);
- proto_perl = perl_clone_using(proto_perl, flags,
- 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
- );
- proto_perl->Isys_intern.internal_host = h;
- h->host_perl = proto_perl;
- return proto_perl;
-
-}
-#endif
+++ /dev/null
-#include "EXTERN.h"
-#include "perl.h"
-
-#ifdef __GNUC__
-
-/* Mingw32 defaults to globing command line
- * This is inconsistent with other Win32 ports and
- * seems to cause trouble with passing -DXSVERSION=\"1.6\"
- * So we turn it off like this:
- */
-int _CRT_glob = 0;
-
-#endif
-
-int
-main(int argc, char **argv, char **env)
-{
- return RunPerl(argc, argv, env);
-}
-
-
+++ /dev/null
-use DirHandle;
-use AutoSplit;
-
-sub splitthis {
-my ($top,$base,$dest) = @_;
-my $d = new DirHandle $base;
-if (defined $d) {
- while (defined($_ = $d->read)) {
- next if $_ eq ".";
- next if $_ eq "..";
- my $entry = "$base\\$_";
- my $entrywithouttop = $entry;
- $entrywithouttop =~ s/^$top//;
- if (-d $entry) {splitthis ($top,$entry,$dest);}
- else {
- next unless ($entry=~/pm$/i);
- #print "Will run autosplit on $entry to $dest\n";
- autosplit($entry,$dest,0,1,1);
- };
- };
- };
-}
-
-splitthis $ARGV[0],$ARGV[0],$ARGV[1];
+++ /dev/null
-/* 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___
-
-/*
- * Allow one slot for each possible drive letter
- * and one additional slot for a UNC name
- */
-const int driveCount = ('Z'-'A')+1+1;
-
-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 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 const char *GetDirA(int index)
- {
- char *ptr = dirTableA[index];
- if (!ptr) {
- /* simulate the existance of this drive */
- ptr = szLocalBufferA;
- ptr[0] = 'A' + index;
- ptr[1] = ':';
- ptr[2] = '\\';
- ptr[3] = 0;
- }
- return ptr;
- };
- inline const WCHAR *GetDirW(int index)
- {
- WCHAR *ptr = dirTableW[index];
- if (!ptr) {
- /* simulate the existance of this drive */
- ptr = szLocalBufferW;
- ptr[0] = 'A' + index;
- ptr[1] = ':';
- ptr[2] = '\\';
- ptr[3] = 0;
- }
- return ptr;
- };
-
- inline int DriveIndex(char chr)
- {
- if (chr == '\\' || chr == '/')
- return ('Z'-'A')+1;
- 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 = (char*)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);
-}
-
-inline bool IsSpecialFileName(const char* pName)
-{
- /* specical file names are devices that the system can open
- * these include AUX, CON, NUL, PRN, COMx, LPTx, CLOCK$, CONIN$, CONOUT$
- * (x is a single digit, and names are case-insensitive)
- */
- char ch = (pName[0] & ~0x20);
- switch (ch)
- {
- case 'A': /* AUX */
- if (((pName[1] & ~0x20) == 'U')
- && ((pName[2] & ~0x20) == 'X')
- && !pName[3])
- return true;
- break;
- case 'C': /* CLOCK$, COMx, CON, CONIN$ CONOUT$ */
- ch = (pName[1] & ~0x20);
- switch (ch)
- {
- case 'L': /* CLOCK$ */
- if (((pName[2] & ~0x20) == 'O')
- && ((pName[3] & ~0x20) == 'C')
- && ((pName[4] & ~0x20) == 'K')
- && (pName[5] == '$')
- && !pName[6])
- return true;
- break;
- case 'O': /* COMx, CON, CONIN$ CONOUT$ */
- if ((pName[2] & ~0x20) == 'M') {
- if ((pName[3] >= '1') && (pName[3] <= '9')
- && !pName[4])
- return true;
- }
- else if ((pName[2] & ~0x20) == 'N') {
- if (!pName[3])
- return true;
- else if ((pName[3] & ~0x20) == 'I') {
- if (((pName[4] & ~0x20) == 'N')
- && (pName[5] == '$')
- && !pName[6])
- return true;
- }
- else if ((pName[3] & ~0x20) == 'O') {
- if (((pName[4] & ~0x20) == 'U')
- && ((pName[5] & ~0x20) == 'T')
- && (pName[6] == '$')
- && !pName[7])
- return true;
- }
- }
- break;
- }
- break;
- case 'L': /* LPTx */
- if (((pName[1] & ~0x20) == 'U')
- && ((pName[2] & ~0x20) == 'X')
- && (pName[3] >= '1') && (pName[3] <= '9')
- && !pName[4])
- return true;
- break;
- case 'N': /* NUL */
- if (((pName[1] & ~0x20) == 'U')
- && ((pName[2] & ~0x20) == 'L')
- && !pName[3])
- return true;
- break;
- case 'P': /* PRN */
- if (((pName[1] & ~0x20) == 'R')
- && ((pName[2] & ~0x20) == 'N')
- && !pName[3])
- return true;
- break;
- }
- return false;
-}
-
-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];
- int length = strlen(pInName);
-
- if (!length)
- return (char*)pInName;
-
- if (length > 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 */
- DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA);
- }
- 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 */
- DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA);
- }
- else {
- strcpy(szBuffer, GetDefaultDirA());
- if (IsPathSep(pInName[0])) {
- /* absolute path */
- strcpy(&szBuffer[2], pInName);
- DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA);
- }
- else {
- /* relative path */
- if (IsSpecialFileName(pInName)) {
- return (char*)pInName;
- }
- else {
- strcat(szBuffer, pInName);
- if (strlen(szBuffer) > MAX_PATH)
- szBuffer[MAX_PATH] = '\0';
-
- DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA);
- }
- }
- }
- }
-
- return szLocalBufferA;
-}
-
-int VDir::SetCurrentDirectoryA(char *lpBuffer)
-{
- char *pPtr;
- int length, nRet = -1;
-
- pPtr = MapPathA(lpBuffer);
- length = strlen(pPtr);
- if(length > 3 && IsPathSep(pPtr[length-1])) {
- /* don't remove the trailing slash from 'x:\' */
- pPtr[length-1] = '\0';
- }
-
- DWORD r = GetFileAttributesA(pPtr);
- if ((r != 0xffffffff) && (r & FILE_ATTRIBUTE_DIRECTORY))
- {
- char szBuffer[(MAX_PATH+1)*2];
- DoGetFullPathNameA(pPtr, sizeof(szBuffer), szBuffer);
- 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]) + 5; /* add 1 for trailing NULL and 4 for '=D:=' */
- }
- }
- return dwSize;
-}
-
-LPSTR VDir::BuildEnvironmentSpace(LPSTR lpStr)
-{ /* store the current directory environment strings as '=D:=d:\path' */
- int index, length;
- LPSTR lpDirStr;
- for (index = 0; index < driveCount; ++index) {
- lpDirStr = dirTableA[index];
- if (lpDirStr != NULL) {
- lpStr[0] = '=';
- lpStr[1] = lpDirStr[0];
- lpStr[2] = '\0';
- CharUpper(&lpStr[1]);
- lpStr[2] = ':';
- lpStr[3] = '=';
- strcpy(&lpStr[4], lpDirStr);
- length = strlen(lpDirStr);
- lpStr += length + 5; /* add 1 for trailing NULL and 4 for '=D:=' */
- if (length > 3 && IsPathSep(lpStr[-2])) {
- lpStr[-2] = '\0'; /* remove the trailing path separator */
- --lpStr;
- }
- }
- }
- 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);
-}
-
-inline bool IsSpecialFileName(const WCHAR* pName)
-{
- /* specical file names are devices that the system can open
- * these include AUX, CON, NUL, PRN, COMx, LPTx, CLOCK$, CONIN$, CONOUT$
- * (x is a single digit, and names are case-insensitive)
- */
- WCHAR ch = (pName[0] & ~0x20);
- switch (ch)
- {
- case 'A': /* AUX */
- if (((pName[1] & ~0x20) == 'U')
- && ((pName[2] & ~0x20) == 'X')
- && !pName[3])
- return true;
- break;
- case 'C': /* CLOCK$, COMx, CON, CONIN$ CONOUT$ */
- ch = (pName[1] & ~0x20);
- switch (ch)
- {
- case 'L': /* CLOCK$ */
- if (((pName[2] & ~0x20) == 'O')
- && ((pName[3] & ~0x20) == 'C')
- && ((pName[4] & ~0x20) == 'K')
- && (pName[5] == '$')
- && !pName[6])
- return true;
- break;
- case 'O': /* COMx, CON, CONIN$ CONOUT$ */
- if ((pName[2] & ~0x20) == 'M') {
- if ((pName[3] >= '1') && (pName[3] <= '9')
- && !pName[4])
- return true;
- }
- else if ((pName[2] & ~0x20) == 'N') {
- if (!pName[3])
- return true;
- else if ((pName[3] & ~0x20) == 'I') {
- if (((pName[4] & ~0x20) == 'N')
- && (pName[5] == '$')
- && !pName[6])
- return true;
- }
- else if ((pName[3] & ~0x20) == 'O') {
- if (((pName[4] & ~0x20) == 'U')
- && ((pName[5] & ~0x20) == 'T')
- && (pName[6] == '$')
- && !pName[7])
- return true;
- }
- }
- break;
- }
- break;
- case 'L': /* LPTx */
- if (((pName[1] & ~0x20) == 'U')
- && ((pName[2] & ~0x20) == 'X')
- && (pName[3] >= '1') && (pName[3] <= '9')
- && !pName[4])
- return true;
- break;
- case 'N': /* NUL */
- if (((pName[1] & ~0x20) == 'U')
- && ((pName[2] & ~0x20) == 'L')
- && !pName[3])
- return true;
- break;
- case 'P': /* PRN */
- if (((pName[1] & ~0x20) == 'R')
- && ((pName[2] & ~0x20) == 'N')
- && !pName[3])
- return true;
- break;
- }
- return false;
-}
-
-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];
- int length = wcslen(pInName);
-
- if (!length)
- return (WCHAR*)pInName;
-
- if (length > 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 */
- DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
- }
- 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 */
- DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
- }
- else {
- wcscpy(szBuffer, GetDefaultDirW());
- if (IsPathSep(pInName[0])) {
- /* absolute path */
- wcscpy(&szBuffer[2], pInName);
- DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
- }
- else {
- /* relative path */
- if (IsSpecialFileName(pInName)) {
- return (WCHAR*)pInName;
- }
- else {
- 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)
-{
- WCHAR *pPtr;
- int length, nRet = -1;
-
- pPtr = MapPathW(lpBuffer);
- length = wcslen(pPtr);
- if(length > 3 && IsPathSep(pPtr[length-1])) {
- /* don't remove the trailing slash from 'x:\' */
- pPtr[length-1] = '\0';
- }
-
- DWORD r = GetFileAttributesW(pPtr);
- if ((r != 0xffffffff) && (r & FILE_ATTRIBUTE_DIRECTORY))
- {
- WCHAR wBuffer[(MAX_PATH+1)*2];
- DoGetFullPathNameW(pPtr, (sizeof(wBuffer)/sizeof(WCHAR)), wBuffer);
- SetDefaultDirW(wBuffer, DriveIndex((char)wBuffer[0]));
- nRet = 0;
- }
-
- return nRet;
-}
-
-#endif /* ___VDir_H___ */
+++ /dev/null
-/* 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.
- *
- * Options:
- *
- * Defining _USE_MSVCRT_MEM_ALLOC will cause all memory allocations
- * to be forwarded to MSVCRT.DLL. Defining _USE_LINKED_LIST as well will
- * track all allocations in a doubly linked list, so that the host can
- * free all memory allocated when it goes away.
- * If _USE_MSVCRT_MEM_ALLOC is not defined then Knuth's boundary tag algorithm
- * is used; defining _USE_BUDDY_BLOCKS will use Knuth's algorithm R
- * (Buddy system reservation)
- *
- */
-
-#ifndef ___VMEM_H_INC___
-#define ___VMEM_H_INC___
-
-// #define _USE_MSVCRT_MEM_ALLOC
-#define _USE_LINKED_LIST
-
-// #define _USE_BUDDY_BLOCKS
-
-// #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(0)
-#define WALKHEAPTRACE() WalkHeap(1)
-
-#else
-
-#define ASSERT(f)
-#define MEMODS(x)
-#define MEMODSlx(x, y)
-#define WALKHEAP()
-#define WALKHEAPTRACE()
-
-#endif
-
-#ifdef _USE_MSVCRT_MEM_ALLOC
-
-#ifndef _USE_LINKED_LIST
-// #define _USE_LINKED_LIST
-#endif
-
-/*
- * Pass all memory requests throught to msvcrt.dll
- * optionaly track by using a doubly linked header
- */
-
-typedef void (*LPFREE)(void *block);
-typedef void* (*LPMALLOC)(size_t size);
-typedef void* (*LPREALLOC)(void *block, size_t size);
-#ifdef _USE_LINKED_LIST
-class VMem;
-typedef struct _MemoryBlockHeader* PMEMORY_BLOCK_HEADER;
-typedef struct _MemoryBlockHeader {
- PMEMORY_BLOCK_HEADER pNext;
- PMEMORY_BLOCK_HEADER pPrev;
- VMem *owner;
-} MEMORY_BLOCK_HEADER, *PMEMORY_BLOCK_HEADER;
-#endif
-
-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 TRUE;
- };
-
-protected:
-#ifdef _USE_LINKED_LIST
- void LinkBlock(PMEMORY_BLOCK_HEADER ptr)
- {
- PMEMORY_BLOCK_HEADER next = m_Dummy.pNext;
- m_Dummy.pNext = ptr;
- ptr->pPrev = &m_Dummy;
- ptr->pNext = next;
- ptr->owner = this;
- next->pPrev = ptr;
- }
- void UnlinkBlock(PMEMORY_BLOCK_HEADER ptr)
- {
- PMEMORY_BLOCK_HEADER next = ptr->pNext;
- PMEMORY_BLOCK_HEADER prev = ptr->pPrev;
- prev->pNext = next;
- next->pPrev = prev;
- }
-
- MEMORY_BLOCK_HEADER m_Dummy;
-#endif
-
- long m_lRefCount; // number of current users
- CRITICAL_SECTION m_cs; // access lock
- HINSTANCE m_hLib;
- LPFREE m_pfree;
- LPMALLOC m_pmalloc;
- LPREALLOC m_prealloc;
-};
-
-VMem::VMem()
-{
- m_lRefCount = 1;
- InitializeCriticalSection(&m_cs);
-#ifdef _USE_LINKED_LIST
- m_Dummy.pNext = m_Dummy.pPrev = &m_Dummy;
- m_Dummy.owner = this;
-#endif
- m_hLib = LoadLibrary("msvcrt.dll");
- if (m_hLib) {
- m_pfree = (LPFREE)GetProcAddress(m_hLib, "free");
- m_pmalloc = (LPMALLOC)GetProcAddress(m_hLib, "malloc");
- m_prealloc = (LPREALLOC)GetProcAddress(m_hLib, "realloc");
- }
-}
-
-VMem::~VMem(void)
-{
-#ifdef _USE_LINKED_LIST
- while (m_Dummy.pNext != &m_Dummy) {
- Free(m_Dummy.pNext+1);
- }
-#endif
- if (m_hLib)
- FreeLibrary(m_hLib);
- DeleteCriticalSection(&m_cs);
-}
-
-void* VMem::Malloc(size_t size)
-{
-#ifdef _USE_LINKED_LIST
- GetLock();
- PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)m_pmalloc(size+sizeof(MEMORY_BLOCK_HEADER));
- LinkBlock(ptr);
- FreeLock();
- return (ptr+1);
-#else
- return m_pmalloc(size);
-#endif
-}
-
-void* VMem::Realloc(void* pMem, size_t size)
-{
-#ifdef _USE_LINKED_LIST
- if (!pMem)
- return Malloc(size);
-
- if (!size) {
- Free(pMem);
- return NULL;
- }
-
- GetLock();
- PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)(((char*)pMem)-sizeof(MEMORY_BLOCK_HEADER));
- UnlinkBlock(ptr);
- ptr = (PMEMORY_BLOCK_HEADER)m_prealloc(ptr, size+sizeof(MEMORY_BLOCK_HEADER));
- LinkBlock(ptr);
- FreeLock();
-
- return (ptr+1);
-#else
- return m_prealloc(pMem, size);
-#endif
-}
-
-void VMem::Free(void* pMem)
-{
-#ifdef _USE_LINKED_LIST
- if (pMem) {
- PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)(((char*)pMem)-sizeof(MEMORY_BLOCK_HEADER));
- if (ptr->owner != this) {
- if (ptr->owner) {
-#if 1
- dTHX;
- int *nowhere = NULL;
- Perl_warn(aTHX_ "Free to wrong pool %p not %p",this,ptr->owner);
- *nowhere = 0;
-#else
- ptr->owner->Free(pMem);
-#endif
- }
- return;
- }
- GetLock();
- UnlinkBlock(ptr);
- ptr->owner = NULL;
- m_pfree(ptr);
- FreeLock();
- }
-#else
- m_pfree(pMem);
-#endif
-}
-
-void VMem::GetLock(void)
-{
- EnterCriticalSection(&m_cs);
-}
-
-void VMem::FreeLock(void)
-{
- LeaveCriticalSection(&m_cs);
-}
-
-int VMem::IsLocked(void)
-{
-#if 0
- /* XXX TryEnterCriticalSection() is not available in some versions
- * of Windows 95. Since this code is not used anywhere yet, we
- * skirt the issue for now. */
- BOOL bAccessed = TryEnterCriticalSection(&m_cs);
- if(bAccessed) {
- LeaveCriticalSection(&m_cs);
- }
- return !bAccessed;
-#else
- ASSERT(0); /* alarm bells for when somebody calls this */
- return 0;
-#endif
-}
-
-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;
-}
-
-#else /* _USE_MSVCRT_MEM_ALLOC */
-
-/*
- * 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 not
- * provided.
- *
- */
-
-const long lAllocStart = 0x00020000; /* start at 128K */
-const long minBlockSize = sizeof(void*)*2;
-const long sizeofTag = sizeof(long);
-const long blockOverhead = sizeofTag*2;
-const long minAllocSize = minBlockSize+blockOverhead;
-#ifdef _USE_BUDDY_BLOCKS
-const long lSmallBlockSize = 1024;
-const size_t nListEntries = ((lSmallBlockSize-minAllocSize)/sizeof(long));
-
-inline size_t CalcEntry(size_t size)
-{
- ASSERT((size&(sizeof(long)-1)) == 0);
- return ((size - minAllocSize) / sizeof(long));
-}
-#endif
-
-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))-(blockOverhead)))
-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;
-}
-#ifndef _USE_BUDDY_BLOCKS
-inline void AddToFreeList(PBLOCK block, PBLOCK pInList)
-{
- PBLOCK next = NEXT(pInList);
- NEXT(pInList) = block;
- SetLink(block, pInList, next);
- PREV(next) = block;
-}
-#endif
-
-/* 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 = 32; /* 64 was overkill */
-const long lAllocMax = 0x80000000; /* max size of allocation */
-
-#ifdef _USE_BUDDY_BLOCKS
-typedef struct _FreeListEntry
-{
- BYTE Dummy[minAllocSize]; // dummy free block
-} FREE_LIST_ENTRY, *PFREE_LIST_ENTRY;
-#endif
-
-#ifndef _USE_BUDDY_BLOCKS
-#define USE_BIGBLOCK_ALLOC
-#endif
-/*
- * performance tuning
- * Use VirtualAlloc() for blocks bigger than nMaxHeapAllocSize since
- * Windows 95/98/Me have heap managers that are designed for memory
- * blocks smaller than four megabytes.
- */
-
-#ifdef USE_BIGBLOCK_ALLOC
-const int nMaxHeapAllocSize = (1024*512); /* don't allocate anything larger than this from the heap */
-#endif
-
-typedef struct _HeapRec
-{
- PBLOCK base; /* base of heap area */
- ULONG len; /* size of heap area */
-#ifdef USE_BIGBLOCK_ALLOC
- BOOL bBigBlock; /* was allocate using VirtualAlloc */
-#endif
-} 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)
- {
-#ifdef _USE_BUDDY_BLOCKS
- return TRUE;
-#else
- return m_hHeap != NULL;
-#endif
- };
-
- void ReInit(void);
-
-protected:
- void Init(void);
- int Getmem(size_t size);
-
- int HeapAdd(void* ptr, size_t size
-#ifdef USE_BIGBLOCK_ALLOC
- , BOOL bBigBlock
-#endif
- );
-
- void* Expand(void* block, size_t size);
-
-#ifdef _USE_BUDDY_BLOCKS
- inline PBLOCK GetFreeListLink(int index)
- {
- if (index >= nListEntries)
- index = nListEntries-1;
- return &m_FreeList[index].Dummy[sizeofTag];
- }
- inline PBLOCK GetOverSizeFreeList(void)
- {
- return &m_FreeList[nListEntries-1].Dummy[sizeofTag];
- }
- inline PBLOCK GetEOLFreeList(void)
- {
- return &m_FreeList[nListEntries].Dummy[sizeofTag];
- }
-
- void AddToFreeList(PBLOCK block, size_t size)
- {
- PBLOCK pFreeList = GetFreeListLink(CalcEntry(size));
- PBLOCK next = NEXT(pFreeList);
- NEXT(pFreeList) = block;
- SetLink(block, pFreeList, next);
- PREV(next) = block;
- }
-#endif
- inline size_t CalcAllocSize(size_t size)
- {
- /*
- * 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.
- */
- return (size < minBlockSize) ? minAllocSize : (size_t)ROUND_UP(size) + blockOverhead;
- }
-
-#ifdef _USE_BUDDY_BLOCKS
- FREE_LIST_ENTRY m_FreeList[nListEntries+1]; // free list with dummy end of list entry as well
-#else
- 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
-#endif
- 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
-
-#ifdef _DEBUG_MEM
- void WalkHeap(int complete);
- void MemoryUsageMessage(char *str, long x, long y, int c);
- FILE* m_pLog;
-#endif
-};
-
-VMem::VMem()
-{
- m_lRefCount = 1;
-#ifndef _USE_BUDDY_BLOCKS
- BOOL bRet = (NULL != (m_hHeap = HeapCreate(HEAP_NO_SERIALIZE,
- lAllocStart, /* initial size of heap */
- 0))); /* no upper limit on size of heap */
- ASSERT(bRet);
-#endif
-
- InitializeCriticalSection(&m_cs);
-#ifdef _DEBUG_MEM
- m_pLog = 0;
-#endif
-
- Init();
-}
-
-VMem::~VMem(void)
-{
-#ifndef _USE_BUDDY_BLOCKS
- ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, NULL));
-#endif
- WALKHEAPTRACE();
-
- DeleteCriticalSection(&m_cs);
-#ifdef _USE_BUDDY_BLOCKS
- for(int index = 0; index < m_nHeaps; ++index) {
- VirtualFree(m_heaps[index].base, 0, MEM_RELEASE);
- }
-#else /* !_USE_BUDDY_BLOCKS */
-#ifdef USE_BIGBLOCK_ALLOC
- for(int index = 0; index < m_nHeaps; ++index) {
- if (m_heaps[index].bBigBlock) {
- VirtualFree(m_heaps[index].base, 0, MEM_RELEASE);
- }
- }
-#endif
- BOOL bRet = HeapDestroy(m_hHeap);
- ASSERT(bRet);
-#endif /* _USE_BUDDY_BLOCKS */
-}
-
-void VMem::ReInit(void)
-{
- for(int index = 0; index < m_nHeaps; ++index) {
-#ifdef _USE_BUDDY_BLOCKS
- VirtualFree(m_heaps[index].base, 0, MEM_RELEASE);
-#else
-#ifdef USE_BIGBLOCK_ALLOC
- if (m_heaps[index].bBigBlock) {
- VirtualFree(m_heaps[index].base, 0, MEM_RELEASE);
- }
- else
-#endif
- HeapFree(m_hHeap, HEAP_NO_SERIALIZE, m_heaps[index].base);
-#endif /* _USE_BUDDY_BLOCKS */
- }
-
- Init();
-}
-
-void VMem::Init(void)
-{
-#ifdef _USE_BUDDY_BLOCKS
- PBLOCK pFreeList;
- /*
- * Initialize the free list by placing a dummy zero-length block on it.
- * Set the end of list marker.
- * Set the number of non-contiguous heaps to zero.
- * Set the next allocation size.
- */
- for (int index = 0; index < nListEntries; ++index) {
- pFreeList = GetFreeListLink(index);
- SIZE(pFreeList) = PSIZE(pFreeList+minAllocSize) = 0;
- PREV(pFreeList) = NEXT(pFreeList) = pFreeList;
- }
- pFreeList = GetEOLFreeList();
- SIZE(pFreeList) = PSIZE(pFreeList+minAllocSize) = 0;
- PREV(pFreeList) = NEXT(pFreeList) = NULL;
- m_pRover = GetOverSizeFreeList();
-#else
- /*
- * 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[sizeofTag]);
- PSIZE(m_pFreeList+minAllocSize) = SIZE(m_pFreeList) = 0;
- PREV(m_pFreeList) = NEXT(m_pFreeList) = m_pFreeList;
-#endif
-
- m_nHeaps = 0;
- m_lAllocSize = lAllocStart;
-}
-
-void* VMem::Malloc(size_t size)
-{
- WALKHEAP();
-
- PBLOCK ptr;
- size_t lsize, rem;
- /*
- * Disallow negative or zero sizes.
- */
- size_t realsize = CalcAllocSize(size);
- if((int)realsize < minAllocSize || size == 0)
- return NULL;
-
-#ifdef _USE_BUDDY_BLOCKS
- /*
- * Check the free list of small blocks if this is free use it
- * Otherwise check the rover if it has no blocks then
- * Scan the free list entries use the first free block
- * split the block if needed, stop at end of list marker
- */
- {
- int index = CalcEntry(realsize);
- if (index < nListEntries-1) {
- ptr = GetFreeListLink(index);
- lsize = SIZE(ptr);
- if (lsize >= realsize) {
- rem = lsize - realsize;
- if(rem < minAllocSize) {
- /* 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;
- }
- SetTags(ptr, lsize | 1);
- return ptr;
- }
- ptr = m_pRover;
- lsize = SIZE(ptr);
- if (lsize >= realsize) {
- rem = lsize - realsize;
- if(rem < minAllocSize) {
- /* 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;
- }
- SetTags(ptr, lsize | 1);
- return ptr;
- }
- ptr = GetFreeListLink(index+1);
- while (NEXT(ptr)) {
- lsize = SIZE(ptr);
- if (lsize >= realsize) {
- size_t rem = lsize - realsize;
- if(rem < minAllocSize) {
- /* 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;
- }
- SetTags(ptr, lsize | 1);
- return ptr;
- }
- ptr += sizeof(FREE_LIST_ENTRY);
- }
- }
- }
-#endif
-
- /*
- * 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.
- */
- ptr = m_pRover; /* start searching at rover */
- int loops = 2; /* allow two times through the loop */
- for(;;) {
- 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. */
- 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;
-
- size_t realsize = CalcAllocSize(size);
- 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);
-#ifdef _USE_BUDDY_BLOCKS
- AddToFreeList(prev, rem);
-#else
- AddToFreeList(prev, m_pFreeList);
-#endif
- 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-blockOverhead);
- 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. */
-#ifndef _USE_BUDDY_BLOCKS
- int linked = FALSE;
-#endif
- size_t psize = PSIZE(ptr);
- if((psize&1) == 0) {
- ptr -= psize; /* point to previous block */
- size += psize; /* merge the sizes of the two blocks */
-#ifdef _USE_BUDDY_BLOCKS
- Unlink(ptr);
-#else
- linked = TRUE; /* it's already on the free list */
-#endif
- }
-
- /* 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. */
-#ifdef _USE_BUDDY_BLOCKS
- AddToFreeList(ptr, size);
-#else
- if(!linked) {
- AddToFreeList(ptr, m_pFreeList);
- }
-#endif
-}
-
-void VMem::GetLock(void)
-{
- EnterCriticalSection(&m_cs);
-}
-
-void VMem::FreeLock(void)
-{
- LeaveCriticalSection(&m_cs);
-}
-
-int VMem::IsLocked(void)
-{
-#if 0
- /* XXX TryEnterCriticalSection() is not available in some versions
- * of Windows 95. Since this code is not used anywhere yet, we
- * skirt the issue for now. */
- BOOL bAccessed = TryEnterCriticalSection(&m_cs);
- if(bAccessed) {
- LeaveCriticalSection(&m_cs);
- }
- return !bAccessed;
-#else
- ASSERT(0); /* alarm bells for when somebody calls this */
- return 0;
-#endif
-}
-
-
-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 */
-#ifdef USE_BIGBLOCK_ALLOC
- BOOL bBigBlock;
-#endif
- 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 <<= 2;
-
-#ifndef _USE_BUDDY_BLOCKS
- if(m_nHeaps != 0
-#ifdef USE_BIGBLOCK_ALLOC
- && !m_heaps[m_nHeaps-1].bBigBlock
-#endif
- ) {
- /* Expand the last allocated heap */
- ptr = HeapReAlloc(m_hHeap, HEAP_REALLOC_IN_PLACE_ONLY|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
-#ifdef USE_BIGBLOCK_ALLOC
- , FALSE
-#endif
- );
- return -1;
- }
- }
-#endif /* _USE_BUDDY_BLOCKS */
-
- /*
- * 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+(blockOverhead));
-
-Restart:
-#ifdef _USE_BUDDY_BLOCKS
- ptr = VirtualAlloc(NULL, size, MEM_COMMIT, PAGE_READWRITE);
-#else
-#ifdef USE_BIGBLOCK_ALLOC
- bBigBlock = FALSE;
- if (size >= nMaxHeapAllocSize) {
- bBigBlock = TRUE;
- ptr = VirtualAlloc(NULL, size, MEM_COMMIT, PAGE_READWRITE);
- }
- else
-#endif
- ptr = HeapAlloc(m_hHeap, HEAP_NO_SERIALIZE, size);
-#endif /* _USE_BUDDY_BLOCKS */
-
- if (!ptr) {
- /* try to allocate a smaller chunk */
- size >>= 1;
- if(size > requestSize)
- goto Restart;
- }
-
- if(ptr == 0) {
- MEMODSlx("HeapAlloc failed on size!!!", size);
- return 0;
- }
-
-#ifdef _USE_BUDDY_BLOCKS
- if (HeapAdd(ptr, size)) {
- VirtualFree(ptr, 0, MEM_RELEASE);
- return 0;
- }
-#else
-#ifdef USE_BIGBLOCK_ALLOC
- if (HeapAdd(ptr, size, bBigBlock)) {
- if (bBigBlock) {
- VirtualFree(ptr, 0, MEM_RELEASE);
- }
- }
-#else
- HeapAdd(ptr, size);
-#endif
-#endif /* _USE_BUDDY_BLOCKS */
- return -1;
-}
-
-int VMem::HeapAdd(void* p, size_t size
-#ifdef USE_BIGBLOCK_ALLOC
- , BOOL bBigBlock
-#endif
- )
-{ /* 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;
-
-#ifdef USE_BIGBLOCK_ALLOC
- if (!bBigBlock) {
-#endif
- /*
- * 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 dummy end-of-heap
- * area marker of the previous heap.
- */
- m_heaps[index].len += size;
- break;
- }
- }
-#ifdef USE_BIGBLOCK_ALLOC
- }
- else {
- index = m_nHeaps;
- }
-#endif
-
- if(index == m_nHeaps) {
- /* The new block is not contiguous, or is BigBlock. 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;
-#ifdef USE_BIGBLOCK_ALLOC
- m_heaps[m_nHeaps].bBigBlock = bBigBlock;
-#endif
- 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 -= blockOverhead;
- ptr += blockOverhead;
- 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)
-{
- /*
- * Disallow negative or zero sizes.
- */
- size_t realsize = CalcAllocSize(size);
- 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);
-#ifdef _USE_BUDDY_BLOCKS
- AddToFreeList(next, rem);
-#else
- AddToFreeList(next, m_pFreeList);
-#endif
- 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 ".\\MemLog.txt"
-
-void VMem::MemoryUsageMessage(char *str, long x, long y, int c)
-{
- char szBuffer[512];
- if(str) {
- if(!m_pLog)
- m_pLog = fopen(LOG_FILENAME, "w");
- sprintf(szBuffer, str, x, y, c);
- fputs(szBuffer, m_pLog);
- }
- else {
- if(m_pLog) {
- fflush(m_pLog);
- fclose(m_pLog);
- m_pLog = 0;
- }
- }
-}
-
-void VMem::WalkHeap(int complete)
-{
- if(complete) {
- MemoryUsageMessage(NULL, 0, 0, 0);
- size_t total = 0;
- for(int i = 0; i < m_nHeaps; ++i) {
- total += m_heaps[i].len;
- }
- MemoryUsageMessage("VMem heaps used %d. Total memory %08x\n", m_nHeaps, total, 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;
-#ifndef _USE_BUDDY_BLOCKS
-#ifdef USE_BIGBLOCK_ALLOC
- if (!m_heaps[m_nHeaps].bBigBlock)
-#endif
- ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, ptr));
-#endif
-
- /* set over reserved header block */
- size -= blockOverhead;
- ptr += blockOverhead;
- 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);
- MemoryUsageMessage("Memory Block %08x: Size %08x %c\n", (long)ptr, cursize, (SIZE(ptr)&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;
- }
- }
- MemoryUsageMessage(NULL, 0, 0, 0);
- }
-}
-#endif /* _DEBUG_MEM */
-
-#endif /* _USE_MSVCRT_MEM_ALLOC */
-
-#endif /* ___VMEM_H_INC___ */
+++ /dev/null
-/* Time-stamp: <01/08/01 20:59:54 keuchel@w2k> */
-
-/* WIN32.H
- *
- * (c) 1995 Microsoft Corporation. All rights reserved.
- * Developed by hip communications inc., http://info.hip.com/info/
- *
- * You may distribute under the terms of either the GNU General Public
- * License or the Artistic License, as specified in the README file.
- */
-
-#ifndef _INC_WIN32_PERL5
-#define _INC_WIN32_PERL5
-
-#ifndef _WIN32_WINNT
-# define _WIN32_WINNT 0x0400 /* needed for TryEnterCriticalSection() etc. */
-#endif
-
-#if defined(PERL_IMPLICIT_SYS)
-# define DYNAMIC_ENV_FETCH
-# define ENV_HV_NAME "___ENV_HV_NAME___"
-# define HAS_GETENV_LEN
-# define prime_env_iter()
-# define WIN32IO_IS_STDIO /* don't pull in custom stdio layer */
-# define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */
-# ifdef PERL_GLOBAL_STRUCT
-# error PERL_GLOBAL_STRUCT cannot be defined with PERL_IMPLICIT_SYS
-# endif
-# define win32_get_privlib PerlEnv_lib_path
-# define win32_get_sitelib PerlEnv_sitelib_path
-# define win32_get_vendorlib PerlEnv_vendorlib_path
-#endif
-
-#ifdef __GNUC__
-# ifndef __int64 /* some versions seem to #define it already */
-# define __int64 long long
-# endif
-# define Win32_Winsock
-#endif
-
-/* Define DllExport akin to perl's EXT,
- * If we are in the DLL or mimicing the DLL for Win95 work round
- * then Export the symbol,
- * otherwise import it.
- */
-
-/* now even GCC supports __declspec() */
-
-#if defined(PERLDLL) || defined(WIN95FIX)
-#define DllExport
-/*#define DllExport __declspec(dllexport)*/ /* noises with VC5+sp3 */
-#else
-#define DllExport __declspec(dllimport)
-#endif
-
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-
-#ifdef WIN32_LEAN_AND_MEAN /* C file is NOT a Perl5 original. */
-#define CONTEXT PERL_CONTEXT /* Avoid conflict of CONTEXT defs. */
-#endif /*WIN32_LEAN_AND_MEAN */
-
-#ifndef TLS_OUT_OF_INDEXES
-#define TLS_OUT_OF_INDEXES (DWORD)0xFFFFFFFF
-#endif
-
-#include <dirent.h>
-#ifndef UNDER_CE
-#include <io.h>
-#include <process.h>
-#include <direct.h>
-#include <fcntl.h>
-#endif
-#include <stdio.h>
-#include <stdlib.h>
-#ifndef EXT
-#include "EXTERN.h"
-#endif
-
-struct tms {
- long tms_utime;
- long tms_stime;
- long tms_cutime;
- long tms_cstime;
-};
-
-#ifndef SYS_NMLN
-#define SYS_NMLN 257
-#endif
-
-struct utsname {
- char sysname[SYS_NMLN];
- char nodename[SYS_NMLN];
- char release[SYS_NMLN];
- char version[SYS_NMLN];
- char machine[SYS_NMLN];
-};
-
-#ifndef START_EXTERN_C
-#undef EXTERN_C
-#ifdef __cplusplus
-# define START_EXTERN_C extern "C" {
-# define END_EXTERN_C }
-# define EXTERN_C extern "C"
-#else
-# define START_EXTERN_C
-# define END_EXTERN_C
-# define EXTERN_C
-#endif
-#endif
-
-#define STANDARD_C 1
-#define DOSISH 1 /* no escaping our roots */
-#define OP_BINARY O_BINARY /* mistake in in pp_sys.c? */
-
-/* Define USE_SOCKETS_AS_HANDLES to enable emulation of windows sockets as
- * real filehandles. XXX Should always be defined (the other version is untested) */
-
-#define USE_SOCKETS_AS_HANDLES
-
-/* read() and write() aren't transparent for socket handles */
-#define PERL_SOCK_SYSREAD_IS_RECV
-#define PERL_SOCK_SYSWRITE_IS_SEND
-
-#define PERL_NO_FORCE_LINK /* no need for PL_force_link_funcs */
-
-/* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls
- * to read the environment, bypassing the runtime's (usually broken)
- * facilities for accessing the same. See note in util.c/my_setenv(). */
-/*#define USE_WIN32_RTL_ENV */
-
-/* Define USE_FIXED_OSFHANDLE to fix MSVCRT's _open_osfhandle() on W95.
- It now uses some black magic to work seamlessly with the DLL CRT and
- works with MSVC++ 4.0+ or GCC/Mingw32
- -- BKS 1-24-2000 */
-#if (defined(_M_IX86) && _MSC_VER >= 1000) || defined(__MINGW32__)
-#define USE_FIXED_OSFHANDLE
-#endif
-
-#define ENV_IS_CASELESS
-
-#ifndef VER_PLATFORM_WIN32_WINDOWS /* VC-2.0 headers don't have this */
-#define VER_PLATFORM_WIN32_WINDOWS 1
-#endif
-
-#ifndef FILE_SHARE_DELETE /* VC-4.0 headers don't have this */
-#define FILE_SHARE_DELETE 0x00000004
-#endif
-
-/* access() mode bits */
-#ifndef R_OK
-# define R_OK 4
-# define W_OK 2
-# define X_OK 1
-# define F_OK 0
-#endif
-
-#define PERL_GET_CONTEXT_DEFINED
-
-/* Compiler-specific stuff. */
-
-#ifdef __BORLANDC__ /* Borland C++ */
-
-#define _access access
-#define _chdir chdir
-#define _getpid getpid
-#define wcsicmp _wcsicmp
-#include <sys/types.h>
-
-#ifndef DllMain
-#define DllMain DllEntryPoint
-#endif
-
-#pragma warn -ccc /* "condition is always true/false" */
-#pragma warn -rch /* "unreachable code" */
-#pragma warn -sig /* "conversion may lose significant digits" */
-#pragma warn -pia /* "possibly incorrect assignment" */
-#pragma warn -par /* "parameter 'foo' is never used" */
-#pragma warn -aus /* "'foo' is assigned a value that is never used" */
-#pragma warn -use /* "'foo' is declared but never used" */
-#pragma warn -csu /* "comparing signed and unsigned values" */
-#pragma warn -pro /* "call to function with no prototype" */
-#pragma warn -stu /* "undefined structure 'foo'" */
-
-/* Borland 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++ */
-
-#ifndef _MODE_T_DEFINED_
-typedef unsigned long mode_t;
-#define _MODE_T_DEFINED_
-#endif
-
-#pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761)
-
-/* Visual C thinks that a pointer to a member variable is 16 bytes in size. */
-#define PERL_MEMBER_PTR_SIZE 16
-
-#endif /* _MSC_VER */
-
-#ifdef __MINGW32__ /* Minimal Gnu-Win32 */
-
-typedef long uid_t;
-typedef long gid_t;
-#ifndef _environ
-#define _environ environ
-#endif
-#define flushall _flushall
-#define fcloseall _fcloseall
-
-#endif /* __MINGW32__ */
-
-#ifndef _O_NOINHERIT
-# define _O_NOINHERIT 0x0080
-# ifndef _NO_OLDNAMES
-# define O_NOINHERIT _O_NOINHERIT
-# endif
-#endif
-
-/* both GCC/Mingw32 and MSVC++ 4.0 are missing this, so we put it here */
-#ifndef CP_UTF8
-# define CP_UTF8 65001
-#endif
-
-/* compatibility stuff for other compilers goes here */
-
-#ifndef _INTPTR_T_DEFINED
-typedef int intptr_t;
-# define _INTPTR_T_DEFINED
-#endif
-
-#ifndef _UINTPTR_T_DEFINED
-typedef unsigned int uintptr_t;
-# define _UINTPTR_T_DEFINED
-#endif
-
-START_EXTERN_C
-
-#undef Stat
-#define Stat win32_stat
-
-#undef init_os_extras
-#define init_os_extras Perl_init_os_extras
-
-DllExport void Perl_win32_init(int *argcp, char ***argvp);
-DllExport void Perl_win32_term(void);
-DllExport void Perl_init_os_extras();
-DllExport void win32_str_os_error(void *sv, DWORD err);
-DllExport int RunPerl(int argc, char **argv, char **env);
-
-typedef struct {
- HANDLE childStdIn;
- HANDLE childStdOut;
- HANDLE childStdErr;
- /*
- * the following correspond to the fields of the same name
- * in the STARTUPINFO structure. Embedders can use these to
- * control the spawning process' look.
- * Example - to hide the window of the spawned process:
- * dwFlags = STARTF_USESHOWWINDOW;
- * wShowWindow = SW_HIDE;
- */
- DWORD dwFlags;
- DWORD dwX;
- DWORD dwY;
- DWORD dwXSize;
- DWORD dwYSize;
- DWORD dwXCountChars;
- DWORD dwYCountChars;
- DWORD dwFillAttribute;
- WORD wShowWindow;
-} child_IO_table;
-
-DllExport void win32_get_child_IO(child_IO_table* ptr);
-
-#ifndef USE_SOCKETS_AS_HANDLES
-extern FILE * my_fdopen(int, char *);
-#endif
-
-extern int my_fclose(FILE *);
-extern int do_aspawn(void *really, void **mark, void **sp);
-extern int do_spawn(char *cmd);
-extern int do_spawn_nowait(char *cmd);
-extern char * win32_get_privlib(const char *pl);
-extern char * win32_get_sitelib(const char *pl);
-extern char * win32_get_vendorlib(const char *pl);
-extern int IsWin95(void);
-extern int IsWinNT(void);
-extern void win32_argv2utf8(int argc, char** argv);
-
-#ifdef PERL_IMPLICIT_SYS
-extern void win32_delete_internal_host(void *h);
-#endif
-
-extern char * staticlinkmodules[];
-
-END_EXTERN_C
-
-/*
- * handle socket stuff, assuming socket is always available
- */
-
-#include <sys/socket.h>
-#include <netdb.h>
-
-#ifdef MYMALLOC
-#define EMBEDMYMALLOC /**/
-/* #define USE_PERL_SBRK /**/
-/* #define PERL_SBRK_VIA_MALLOC /**/
-#endif
-
-#if defined(PERLDLL) && !defined(PERL_CORE)
-#define PERL_CORE
-#endif
-
-#ifdef PERL_TEXTMODE_SCRIPTS
-# define PERL_SCRIPT_MODE "r"
-#else
-# define PERL_SCRIPT_MODE "rb"
-#endif
-
-#ifndef Sighandler_t
-typedef Signal_t (*Sighandler_t) (int);
-#define Sighandler_t Sighandler_t
-#endif
-
-/*
- * Now Win32 specific per-thread data stuff
- */
-
-struct thread_intern {
- /* XXX can probably use one buffer instead of several */
- char Wstrerror_buffer[512];
- struct servent Wservent;
- char Wgetlogin_buffer[128];
-# ifdef USE_SOCKETS_AS_HANDLES
- int Winit_socktype;
-# endif
-# ifdef HAVE_DES_FCRYPT
- char Wcrypt_buffer[30];
-# endif
-# ifdef USE_RTL_THREAD_API
- void * retv; /* slot for thread return value */
-# endif
- BOOL Wuse_showwindow;
- WORD Wshowwindow;
-};
-
-#define HAVE_INTERP_INTERN
-typedef struct {
- long num;
- DWORD pids[MAXIMUM_WAIT_OBJECTS];
- HANDLE handles[MAXIMUM_WAIT_OBJECTS];
-} child_tab;
-
-struct interp_intern {
- char * perlshell_tokens;
- char ** perlshell_vec;
- long perlshell_items;
- struct av * fdpid;
- child_tab * children;
-#ifdef USE_ITHREADS
- DWORD pseudo_id;
- child_tab * pseudo_children;
-#endif
- void * internal_host;
- struct thread_intern thr_intern;
- UINT timerid;
- unsigned poll_count;
- Sighandler_t sigtable[SIG_SIZE];
-};
-
-DllExport int win32_async_check(pTHX);
-
-#define WIN32_POLL_INTERVAL 32768
-#define PERL_ASYNC_CHECK() if (w32_do_async || PL_sig_pending) win32_async_check(aTHX)
-
-#define w32_perlshell_tokens (PL_sys_intern.perlshell_tokens)
-#define w32_perlshell_vec (PL_sys_intern.perlshell_vec)
-#define w32_perlshell_items (PL_sys_intern.perlshell_items)
-#define w32_fdpid (PL_sys_intern.fdpid)
-#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 (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)
-#define w32_timerid (PL_sys_intern.timerid)
-#define w32_sighandler (PL_sys_intern.sigtable)
-#define w32_poll_count (PL_sys_intern.poll_count)
-#define w32_do_async (w32_poll_count++ > WIN32_POLL_INTERVAL)
-#define w32_strerror_buffer (PL_sys_intern.thr_intern.Wstrerror_buffer)
-#define w32_getlogin_buffer (PL_sys_intern.thr_intern.Wgetlogin_buffer)
-#define w32_crypt_buffer (PL_sys_intern.thr_intern.Wcrypt_buffer)
-#define w32_servent (PL_sys_intern.thr_intern.Wservent)
-#define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype)
-#define w32_use_showwindow (PL_sys_intern.thr_intern.Wuse_showwindow)
-#define w32_showwindow (PL_sys_intern.thr_intern.Wshowwindow)
-
-#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
-
-#if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
-#ifdef PERL_CORE
-
-/* C doesn't like repeat struct definitions */
-#ifndef _CRTIMP
-#define _CRTIMP __declspec(dllimport)
-#endif
-
-/*
- * Control structure for lowio file handles
- */
-typedef struct {
- intptr_t osfhnd;/* underlying OS file HANDLE */
- char osfile; /* attributes of file (e.g., open in text mode?) */
- char pipech; /* one char buffer for handles opened on pipes */
- int lockinitflag;
- CRITICAL_SECTION lock;
-} ioinfo;
-
-
-/*
- * Array of arrays of control structures for lowio files.
- */
-EXTERN_C _CRTIMP ioinfo* __pioinfo[];
-
-/*
- * Definition of IOINFO_L2E, the log base 2 of the number of elements in each
- * array of ioinfo structs.
- */
-#define IOINFO_L2E 5
-
-/*
- * Definition of IOINFO_ARRAY_ELTS, the number of elements in ioinfo array
- */
-#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E)
-
-/*
- * Access macros for getting at an ioinfo struct and its fields from a
- * file handle
- */
-#define _pioinfo(i) (__pioinfo[(i) >> IOINFO_L2E] + ((i) & (IOINFO_ARRAY_ELTS - 1)))
-#define _osfhnd(i) (_pioinfo(i)->osfhnd)
-#define _osfile(i) (_pioinfo(i)->osfile)
-#define _pipech(i) (_pioinfo(i)->pipech)
-
-/* since we are not doing a dup2(), this works fine */
-#define _set_osfhnd(fh, osfh) (void)(_osfhnd(fh) = (intptr_t)osfh)
-#endif
-#endif
-
-/* IO.xs and POSIX.xs define PERLIO_NOT_STDIO to 1 */
-#if defined(PERL_EXT_IO) || defined(PERL_EXT_POSIX)
-#undef PERLIO_NOT_STDIO
-#endif
-#define PERLIO_NOT_STDIO 0
-
-#include "perlio.h"
-
-/*
- * This provides a layer of functions and macros to ensure extensions will
- * get to use the same RTL functions as the core.
- */
-#include "win32iop.h"
-
-#endif /* _INC_WIN32_PERL5 */
-
+++ /dev/null
-#include "EXTERN.h"
-#include "perl.h"
-
-#ifdef USE_DECLSPEC_THREAD
-__declspec(thread) void *PL_current_context = NULL;
-#endif
-
-void
-Perl_set_context(void *t)
-{
-#if defined(USE_ITHREADS)
-# ifdef USE_DECLSPEC_THREAD
- Perl_current_context = t;
-# else
- DWORD err = GetLastError();
- TlsSetValue(PL_thr_key,t);
- SetLastError(err);
-# endif
-#endif
-}
-
-void *
-Perl_get_context(void)
-{
-#if defined(USE_ITHREADS)
-# ifdef USE_DECLSPEC_THREAD
- return Perl_current_context;
-# else
- DWORD err = GetLastError();
- void *result = TlsGetValue(PL_thr_key);
- SetLastError(err);
- return result;
-# endif
-#else
- return NULL;
-#endif
-}
+++ /dev/null
-#ifndef _WIN32THREAD_H
-#define _WIN32THREAD_H
-
-#include "win32.h"
-
-typedef struct win32_cond { LONG waiters; HANDLE sem; } perl_cond;
-typedef DWORD perl_key;
-typedef HANDLE perl_os_thread;
-
-#ifndef DONT_USE_CRITICAL_SECTION
-
-/* Critical Sections used instead of mutexes: lightweight,
- * but can't be communicated to child processes, and can't get
- * HANDLE to it for use elsewhere.
- */
-typedef CRITICAL_SECTION perl_mutex;
-#define MUTEX_INIT(m) InitializeCriticalSection(m)
-#define MUTEX_LOCK(m) EnterCriticalSection(m)
-#define MUTEX_UNLOCK(m) LeaveCriticalSection(m)
-#define MUTEX_DESTROY(m) DeleteCriticalSection(m)
-
-#else
-
-typedef HANDLE perl_mutex;
-# define MUTEX_INIT(m) \
- STMT_START { \
- if ((*(m) = CreateMutex(NULL,FALSE,NULL)) == NULL) \
- Perl_croak_nocontext("panic: MUTEX_INIT"); \
- } STMT_END
-
-# define MUTEX_LOCK(m) \
- STMT_START { \
- if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED) \
- Perl_croak_nocontext("panic: MUTEX_LOCK"); \
- } STMT_END
-
-# define MUTEX_UNLOCK(m) \
- STMT_START { \
- if (ReleaseMutex(*(m)) == 0) \
- Perl_croak_nocontext("panic: MUTEX_UNLOCK"); \
- } STMT_END
-
-# define MUTEX_DESTROY(m) \
- STMT_START { \
- if (CloseHandle(*(m)) == 0) \
- Perl_croak_nocontext("panic: MUTEX_DESTROY"); \
- } STMT_END
-
-#endif
-
-/* These macros assume that the mutex associated with the condition
- * will always be held before COND_{SIGNAL,BROADCAST,WAIT,DESTROY},
- * so there's no separate mutex protecting access to (c)->waiters
- */
-#define COND_INIT(c) \
- STMT_START { \
- (c)->waiters = 0; \
- (c)->sem = CreateSemaphoreW(NULL,0,LONG_MAX,NULL); \
- if ((c)->sem == NULL) \
- Perl_croak_nocontext("panic: COND_INIT (%ld)",GetLastError()); \
- } STMT_END
-
-#define COND_SIGNAL(c) \
- STMT_START { \
- if ((c)->waiters > 0 && \
- ReleaseSemaphore((c)->sem,1,NULL) == 0) \
- Perl_croak_nocontext("panic: COND_SIGNAL (%ld)",GetLastError()); \
- } STMT_END
-
-#define COND_BROADCAST(c) \
- STMT_START { \
- if ((c)->waiters > 0 && \
- ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0) \
- Perl_croak_nocontext("panic: COND_BROADCAST (%ld)",GetLastError());\
- } STMT_END
-
-#define COND_WAIT(c, m) \
- STMT_START { \
- (c)->waiters++; \
- MUTEX_UNLOCK(m); \
- /* Note that there's no race here, since a \
- * COND_BROADCAST() on another thread will have seen the\
- * right number of waiters (i.e. including this one) */ \
- if (WaitForSingleObject((c)->sem,INFINITE)==WAIT_FAILED)\
- Perl_croak_nocontext("panic: COND_WAIT (%ld)",GetLastError()); \
- /* XXX there may be an inconsequential race here */ \
- MUTEX_LOCK(m); \
- (c)->waiters--; \
- } STMT_END
-
-#define COND_DESTROY(c) \
- STMT_START { \
- (c)->waiters = 0; \
- if (CloseHandle((c)->sem) == 0) \
- Perl_croak_nocontext("panic: COND_DESTROY (%ld)",GetLastError()); \
- } STMT_END
-
-#define DETACH(t) \
- STMT_START { \
- if (CloseHandle((t)->self) == 0) { \
- MUTEX_UNLOCK(&(t)->mutex); \
- Perl_croak_nocontext("panic: DETACH"); \
- } \
- } STMT_END
-
-
-#define THREAD_CREATE(t, f) Perl_thread_create(t, f)
-#define THREAD_POST_CREATE(t) NOOP
-
-/* XXX Docs mention that the RTL versions of thread creation routines
- * should be used, but that advice only seems applicable when the RTL
- * is not in a DLL. RTL DLLs in both Borland and VC seem to do all of
- * the init/deinit required upon DLL_THREAD_ATTACH/DETACH. So we seem
- * to be completely safe using straight Win32 API calls, rather than
- * the much braindamaged RTL calls.
- *
- * _beginthread() in the RTLs call CloseHandle() just after the thread
- * function returns, which means: 1) we have a race on our hands
- * 2) it is impossible to implement join() semantics.
- *
- * IOW, do *NOT* turn on USE_RTL_THREAD_API! It is here
- * for experimental purposes only. GSAR 98-01-02
- */
-#ifdef USE_RTL_THREAD_API
-# include <process.h>
-# if defined(__BORLANDC__)
- /* Borland RTL doesn't allow a return value from thread function! */
-# define THREAD_RET_TYPE void _USERENTRY
-# define THREAD_RET_CAST(p) ((void)(thr->i.retv = (void *)(p)))
-# elif defined (_MSC_VER)
-# define THREAD_RET_TYPE unsigned __stdcall
-# define THREAD_RET_CAST(p) ((unsigned)(p))
-# else
- /* CRTDLL.DLL doesn't allow a return value from thread function! */
-# define THREAD_RET_TYPE void __cdecl
-# define THREAD_RET_CAST(p) ((void)(thr->i.retv = (void *)(p)))
-# endif
-#else /* !USE_RTL_THREAD_API */
-# define THREAD_RET_TYPE DWORD WINAPI
-# define THREAD_RET_CAST(p) ((DWORD)(p))
-#endif /* !USE_RTL_THREAD_API */
-
-typedef THREAD_RET_TYPE thread_func_t(void *);
-
-
-START_EXTERN_C
-
-#if defined(PERLDLL) && defined(USE_DECLSPEC_THREAD) && (!defined(__BORLANDC__) || defined(_DLL))
-extern __declspec(thread) void *PL_current_context;
-#define PERL_SET_CONTEXT(t) (PL_current_context = t)
-#define PERL_GET_CONTEXT PL_current_context
-#else
-#define PERL_GET_CONTEXT Perl_get_context()
-#define PERL_SET_CONTEXT(t) Perl_set_context(t)
-#endif
-
-END_EXTERN_C
-
-#define INIT_THREADS NOOP
-#define ALLOC_THREAD_KEY \
- STMT_START { \
- if ((PL_thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES) { \
- PerlIO_printf(PerlIO_stderr(),"panic: TlsAlloc"); \
- exit(1); \
- } \
- } STMT_END
-
-#define FREE_THREAD_KEY \
- STMT_START { \
- TlsFree(PL_thr_key); \
- } STMT_END
-
-#define PTHREAD_ATFORK(prepare,parent,child) NOOP
-
-#if defined(USE_RTL_THREAD_API) && !defined(_MSC_VER)
-#define JOIN(t, avp) \
- STMT_START { \
- if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \
- || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \
- || (CloseHandle((t)->self) == 0)) \
- Perl_croak_nocontext("panic: JOIN"); \
- *avp = (AV *)((t)->i.retv); \
- } STMT_END
-#else /* !USE_RTL_THREAD_API || _MSC_VER */
-#define JOIN(t, avp) \
- STMT_START { \
- if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \
- || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \
- || (CloseHandle((t)->self) == 0)) \
- Perl_croak_nocontext("panic: JOIN"); \
- } STMT_END
-#endif /* !USE_RTL_THREAD_API || _MSC_VER */
-
-#define YIELD Sleep(0)
-
-#endif /* _WIN32THREAD_H */
-
projects / p5sagit/p5-mst-13.2.git / commitdiff