From: Yves Orton Date: Mon, 1 May 2006 19:02:09 +0000 (+0200) Subject: Re: Merge WinCE into Win32 directory and remove the the WinCE directory X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f4257e4d90c288c896435eca90d56255a0334871;p=p5sagit%2Fp5-mst-13.2.git Re: Merge WinCE into Win32 directory and remove the the WinCE directory Message-ID: <9b18b3110605011002m56c0db99n169ae677efb6d059@mail.gmail.com> Plus adjustements to MANIFEST. Also, perlmain.c seemed to be missing from the patch. p4raw-id: //depot/perl@28061 --- diff --git a/MANIFEST b/MANIFEST index 7d34252..fb6d310 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3621,91 +3621,73 @@ vos/vos.c VOS emulations for missing POSIX functions 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 diff --git a/wince/Makefile.ce b/win32/Makefile.ce similarity index 95% rename from wince/Makefile.ce rename to win32/Makefile.ce index 1becaaf..9fe5d32 100644 --- a/wince/Makefile.ce +++ b/win32/Makefile.ce @@ -12,7 +12,7 @@ INST_TOP=$(INSTALL_ROOT) 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 @@ -42,10 +42,10 @@ RCOPY = xcopy $(YES) /f /r /i /e /d 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 @@ -266,7 +266,7 @@ OSVERSION = WCE300 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 @@ -285,7 +285,7 @@ OSVERSION = WCE300 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 @@ -306,7 +306,7 @@ OSVERSION = WCE300 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 @@ -325,7 +325,7 @@ OSVERSION = WCE300 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 @@ -456,7 +456,7 @@ LINK32 = link 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 @@ -476,9 +476,9 @@ CELIBS = -nodefaultlib \ 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) @@ -491,9 +491,9 @@ CFLAGS = -nologo -Gf -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) \ 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 @@ -505,7 +505,7 @@ o = .obj # # Rules -# +# .SUFFIXES : .c $(o) .dll .lib .exe .rc .res @@ -518,7 +518,7 @@ o = .obj $(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.. $< @@ -606,7 +606,7 @@ EXTRACORE_SRC = $(EXTRACORE_SRC) ..\perlio.c .\win32io.c WIN32_SRC = \ .\wince.c \ .\wincesck.c \ - .\win32thread.c + .\win32thread.c !IF "$(CRYPT_SRC)" != "" WIN32_SRC = $(WIN32_SRC) .\$(CRYPT_SRC) @@ -732,28 +732,28 @@ all: hostminiperl $(MINIMOD) $(CONFIGPM) $(UNIDATAFILES) $(PERLEXE) Extensions $(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) @@ -761,12 +761,12 @@ $(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 @@ -780,11 +780,11 @@ NOT_COMPILE_EXT = $(NOT_COMPILE_EXT) !XS/Typemap 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 #---------------------------------------------------------------------------------- @@ -792,7 +792,7 @@ Extensions_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 @@ -859,7 +859,7 @@ XDLLOBJS = $(XDLLOBJS) $(DLLDIR)\fcrypt.obj $(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 @@ -871,6 +871,7 @@ $(DLLDIR)\perllib$(o) : perllib.c .\perlhost.h .\vdir.h .\vmem.h !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 @@ -951,15 +952,13 @@ zip: $(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)" diff --git a/wince/cecopy-lib.pl b/win32/cecopy-lib.pl similarity index 100% rename from wince/cecopy-lib.pl rename to win32/cecopy-lib.pl diff --git a/wince/comp.pl b/win32/comp.pl similarity index 100% rename from wince/comp.pl rename to win32/comp.pl diff --git a/wince/compile-all.bat b/win32/compile-all.bat similarity index 97% rename from wince/compile-all.bat rename to win32/compile-all.bat index c85f5e9..c546bb2 100644 --- a/wince/compile-all.bat +++ b/win32/compile-all.bat @@ -1,62 +1,62 @@ -@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 - +@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 + diff --git a/wince/compile.bat b/win32/compile.bat similarity index 100% rename from wince/compile.bat rename to win32/compile.bat diff --git a/wince/config.ce b/win32/config.ce similarity index 100% rename from wince/config.ce rename to win32/config.ce diff --git a/wince/config_H.ce b/win32/config_H.ce similarity index 99% copy from wince/config_H.ce copy to win32/config_H.ce index 9936f76..fa2b0a8 100644 --- a/wince/config_H.ce +++ b/win32/config_H.ce @@ -12,10 +12,10 @@ /* * 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_ @@ -179,7 +179,7 @@ #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. */ @@ -711,7 +711,7 @@ /*#define I_MEMORY /**/ /* I_NET_ERRNO: - * This symbol, if defined, indicates that exists and + * This symbol, if defined, indicates that exists and * should be included. */ /*#define I_NET_ERRNO /**/ @@ -1010,11 +1010,11 @@ * 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) @@ -1056,7 +1056,7 @@ /* 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. */ @@ -1785,7 +1785,7 @@ #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. */ @@ -1832,7 +1832,7 @@ /*#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 /**/ @@ -1894,7 +1894,7 @@ * 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. */ @@ -1907,7 +1907,7 @@ * 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. */ @@ -2041,7 +2041,7 @@ /*#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. */ @@ -2449,9 +2449,9 @@ */ /*#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 /**/ @@ -2479,8 +2479,8 @@ */ /*#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: @@ -2738,8 +2738,8 @@ * 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 to get any + * It can be int, ushort, gid_t, etc... + * It may be necessary to include to get any * typedef'ed information. This is only required if you have * getgroups() or setgroups().. */ @@ -3069,7 +3069,7 @@ #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 * to get any typedef'ed information. @@ -3388,7 +3388,7 @@ /* 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 * /**/ @@ -3416,10 +3416,10 @@ * 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, @@ -3526,7 +3526,7 @@ * 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. @@ -3655,11 +3655,11 @@ * 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: diff --git a/win32/include/sys/socket.h b/win32/include/sys/socket.h index e13e872..a3c53b0 100644 --- a/win32/include/sys/socket.h +++ b/win32/include/sys/socket.h @@ -10,54 +10,22 @@ extern "C" { #endif -#ifndef _WINCE - #define WIN32_LEAN_AND_MEAN #ifdef __GNUC__ # define Win32_Winsock #endif #include -#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 +# else # include #endif +#endif #include "win32.h" diff --git a/wince/makedist.pl b/win32/makedist.pl similarity index 99% rename from wince/makedist.pl rename to win32/makedist.pl index 7216834..1332d23 100644 --- a/wince/makedist.pl +++ b/win32/makedist.pl @@ -10,7 +10,7 @@ my %opts = ( '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 @@ -220,7 +220,7 @@ sub bootstrap { 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; diff --git a/wince/perl.rc b/win32/perl.rc similarity index 100% rename from wince/perl.rc rename to win32/perl.rc diff --git a/wince/perlmain.c b/win32/perlmain.c similarity index 100% rename from wince/perlmain.c rename to win32/perlmain.c diff --git a/wince/registry.bat b/win32/registry.bat old mode 100755 new mode 100644 similarity index 100% rename from wince/registry.bat rename to win32/registry.bat diff --git a/win32/win32-d.h b/win32/win32-d.h new file mode 100644 index 0000000..6aeca30 --- /dev/null +++ b/win32/win32-d.h @@ -0,0 +1,623 @@ +--- 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 + + #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 +-#ifndef UNDER_CE + #include + #include +-#include +-#include +-#endif + #include ++#include + #include ++#include ++#include + #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 + + #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 + ++/* , pulled in by 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 + #include + + #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 */ + diff --git a/win32/win32.h b/win32/win32.h index 5390df5..259728f 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -200,9 +200,12 @@ struct utsname { #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. */ @@ -387,6 +390,9 @@ struct thread_intern { 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 @@ -465,6 +471,7 @@ DllExport int win32_async_check(pTHX); #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) diff --git a/wince/win32io.c b/win32/win32ceio.c similarity index 99% rename from wince/win32io.c rename to win32/win32ceio.c index 857f25b..e0b75b5 100644 --- a/wince/win32io.c +++ b/win32/win32ceio.c @@ -290,9 +290,9 @@ PerlIOWin32_close(pTHX_ PerlIO *f) 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; diff --git a/wince/win32iop.h b/win32/win32iop-o.h similarity index 99% rename from wince/win32iop.h rename to win32/win32iop-o.h index 2b2703c..47c0de9 100644 --- a/wince/win32iop.h +++ b/win32/win32iop-o.h @@ -9,8 +9,8 @@ # 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 diff --git a/win32/win32thread.h b/win32/win32thread.h index 8c02fa1..c6f9309 100644 --- a/win32/win32thread.h +++ b/win32/win32thread.h @@ -55,7 +55,7 @@ typedef HANDLE perl_mutex; #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 diff --git a/wince/wince.c b/win32/wince.c similarity index 93% rename from wince/wince.c rename to win32/wince.c index 02b2781..52d9507 100644 --- a/wince/wince.c +++ b/win32/wince.c @@ -11,7 +11,7 @@ #include #include -#define PERLIO_NOT_STDIO 0 +#define PERLIO_NOT_STDIO 0 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO) #define PerlIO FILE @@ -91,7 +91,7 @@ END_EXTERN_C static DWORD w32_platform = (DWORD)-1; -int +int IsWin95(void) { return (win32_os_id() == VER_PLATFORM_WIN32_WINDOWS); @@ -1046,7 +1046,7 @@ win32_uname(struct utsname *name) /* Timing related stuff */ int -do_raise(pTHX_ int sig) +do_raise(pTHX_ int sig) { if (sig < SIG_SIZE) { Sighandler_t handler = w32_sighandler[sig]; @@ -1082,8 +1082,8 @@ void 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); } @@ -1195,7 +1195,7 @@ static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time) { dTHX; KillTimer(NULL,timerid); - timerid=0; + timerid=0; sighandler(14); } @@ -1208,28 +1208,28 @@ win32_sleep(unsigned int t) 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 * * 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; @@ -1307,7 +1307,7 @@ win32_feof(FILE *fp) } /* - * 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. */ @@ -2236,7 +2236,7 @@ sbrk(int need) 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) @@ -2250,7 +2250,7 @@ sbrk(int need) 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 @@ -2510,7 +2510,7 @@ XS(w32_CopyFile) { 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))); } @@ -2530,7 +2530,7 @@ XS(w32_MessageBox) unsigned int flags = MB_OK; txt = SvPV_nolen(ST(0)); - + if (items < 1 || items > 2) Perl_croak(aTHX_ "usage: Win32::MessageBox($txt, [$flags])"); @@ -2589,11 +2589,11 @@ XS(w32_ShellEx) 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; @@ -2698,7 +2698,7 @@ win32_wait(int *status) int wce_reopen_stdout(char *fname) -{ +{ if(xcefreopen(fname, "w", stdout) == NULL) return -1; @@ -2726,7 +2726,7 @@ getcwd(char *buf, size_t size) return xcegetcwd(buf, size); } -int +int isnan(double d) { return _isnan(d); @@ -2750,118 +2750,7 @@ win32_popenlist(const char *mode, IV narg, SV **args) 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 */ } /* @@ -2871,41 +2760,7 @@ cleanup: 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 diff --git a/wince/wince.h b/win32/wince.h similarity index 92% rename from wince/wince.h rename to win32/wince.h index f4264dd..2a97668 100644 --- a/wince/wince.h +++ b/win32/wince.h @@ -30,7 +30,7 @@ #endif #endif -START_EXTERN_C +START_EXTERN_C #ifndef _IOFBF #define _IOFBF 0x0000 @@ -66,16 +66,6 @@ XCE_EXPORT void XCEShowMessageA(const char *fmt, ...); #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 @@ -151,6 +141,6 @@ XCE_EXPORT BOOL XCEFreeEnvironmentStrings(LPCSTR buf); void wce_hitreturn(); -END_EXTERN_C +END_EXTERN_C #endif diff --git a/wince/wincesck.c b/win32/wincesck.c similarity index 94% rename from wince/wincesck.c rename to win32/wincesck.c index 09f5dfb..8f2a90b 100644 --- a/wince/wincesck.c +++ b/win32/wincesck.c @@ -2,7 +2,7 @@ /* 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. * @@ -65,12 +65,6 @@ XCE_EXPORT struct protoent *xcegetprotobynumber(int number); } \ } STMT_END -#define EndSockets() \ - STMT_START { \ - if (wsock_started) \ - WSACleanup(); \ - } STMT_END - #define SOCKET_TEST(x, y) \ STMT_START { \ StartSockets(); \ @@ -86,8 +80,15 @@ static struct servent* win32_savecopyservent(struct servent*d, 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; @@ -213,7 +214,7 @@ win32_recv(SOCKET s, char *buf, int len, int flags) } 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(); @@ -221,7 +222,7 @@ win32_recvfrom(SOCKET s, char *buf, int len, int flags, } 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(); @@ -246,13 +247,13 @@ win32_sendto(SOCKET s, const char *buf, int len, int flags, } 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) { @@ -315,7 +316,7 @@ win32_getprotobynumber(int num) struct servent * win32_getservbyname(const char *name, const char *proto) { - dTHX; + dTHX; struct servent *r; SOCKET_TEST(r = getservbyname(name, proto), NULL); @@ -328,7 +329,7 @@ win32_getservbyname(const char *name, const char *proto) struct servent * win32_getservbyport(int port, const char *proto) { - dTHX; + dTHX; struct servent *r; SOCKET_TEST(r = getservbyport(port, proto), NULL); @@ -380,7 +381,7 @@ win32_inet_addr(const char FAR *cp) */ void -win32_endhostent() +win32_endhostent() { dTHX; Perl_croak_nocontext("endhostent not implemented!\n"); @@ -409,7 +410,7 @@ win32_endservent() struct netent * -win32_getnetent(void) +win32_getnetent(void) { dTHX; Perl_croak_nocontext("getnetent not implemented!\n"); @@ -417,7 +418,7 @@ win32_getnetent(void) } struct netent * -win32_getnetbyname(char *name) +win32_getnetbyname(char *name) { dTHX; Perl_croak_nocontext("getnetbyname not implemented!\n"); @@ -425,7 +426,7 @@ win32_getnetbyname(char *name) } struct netent * -win32_getnetbyaddr(long net, int type) +win32_getnetbyaddr(long net, int type) { dTHX; Perl_croak_nocontext("getnetbyaddr not implemented!\n"); @@ -433,7 +434,7 @@ win32_getnetbyaddr(long net, int type) } struct protoent * -win32_getprotoent(void) +win32_getprotoent(void) { dTHX; Perl_croak_nocontext("getprotoent not implemented!\n"); @@ -441,7 +442,7 @@ win32_getprotoent(void) } struct servent * -win32_getservent(void) +win32_getservent(void) { dTHX; Perl_croak_nocontext("getservent not implemented!\n"); @@ -494,6 +495,6 @@ win32_savecopyservent(struct servent*d, struct servent*s, const char *proto) d->s_proto = (char *)proto; else d->s_proto = "tcp"; - + return d; } diff --git a/wince/config_H.ce b/win32/xconfig.h similarity index 98% rename from wince/config_H.ce rename to win32/xconfig.h index 9936f76..bea5c9a 100644 --- a/wince/config_H.ce +++ b/win32/xconfig.h @@ -12,10 +12,10 @@ /* * 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_ @@ -179,7 +179,7 @@ #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. */ @@ -711,7 +711,7 @@ /*#define I_MEMORY /**/ /* I_NET_ERRNO: - * This symbol, if defined, indicates that exists and + * This symbol, if defined, indicates that exists and * should be included. */ /*#define I_NET_ERRNO /**/ @@ -893,19 +893,6 @@ */ /*#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. */ @@ -918,6 +905,19 @@ #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 @@ -982,8 +982,13 @@ * 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 @@ -1010,11 +1015,11 @@ * 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) @@ -1056,7 +1061,7 @@ /* 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. */ @@ -1111,6 +1116,12 @@ */ #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. @@ -1124,6 +1135,45 @@ /*#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. @@ -1163,6 +1213,12 @@ */ /*#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. @@ -1175,6 +1231,18 @@ */ /*#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. @@ -1199,6 +1267,19 @@ #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. @@ -1212,6 +1293,20 @@ /*#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 @@ -1220,6 +1315,26 @@ */ /*#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. @@ -1266,18 +1381,57 @@ */ /*#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. @@ -1303,6 +1457,25 @@ */ /*#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. @@ -1341,6 +1514,14 @@ */ #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. @@ -1391,6 +1572,24 @@ */ /*#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 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. */ @@ -1567,6 +1766,45 @@ #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 includes * prototypes for gethostent(), gethostbyname(), and @@ -1624,6 +1862,45 @@ */ /*#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 includes * prototypes for getnetent(), getnetbyname(), and @@ -1667,6 +1944,45 @@ #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 includes * prototypes for getprotoent(), getprotobyname(), and @@ -1733,6 +2049,45 @@ */ /*#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 includes * prototypes for getservent(), getservbyname(), and @@ -1785,7 +2140,7 @@ #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. */ @@ -1824,6 +2179,12 @@ #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 needs to be included, but sometimes @@ -1832,7 +2193,7 @@ /*#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 /**/ @@ -1876,6 +2237,12 @@ */ #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. @@ -1894,7 +2261,7 @@ * 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. */ @@ -1907,7 +2274,7 @@ * 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. */ @@ -2019,6 +2386,13 @@ */ /*#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 + * and therefore I_LANGINFO. + */ +/*#define HAS_NL_LANGINFO /**/ + /* HAS_OFF64_T: * This symbol will be defined if the C compiler supports off64_t. */ @@ -2030,6 +2404,20 @@ */ /*#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 @@ -2040,8 +2428,21 @@ */ /*#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. */ @@ -2072,6 +2473,19 @@ /*#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. @@ -2130,6 +2544,12 @@ */ /*#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. @@ -2174,18 +2594,57 @@ */ /*#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. @@ -2210,6 +2669,19 @@ */ /*#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. @@ -2235,6 +2707,19 @@ */ /*#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. @@ -2254,12 +2739,33 @@ */ /*#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 @@ -2295,7 +2801,34 @@ * 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 @@ -2350,6 +2883,14 @@ */ /*#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. @@ -2382,6 +2923,22 @@ /*#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. @@ -2449,9 +3006,9 @@ */ /*#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 /**/ @@ -2479,8 +3036,8 @@ */ /*#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: @@ -2515,6 +3072,24 @@ /*#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. @@ -2551,6 +3126,15 @@ */ /*#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 @@ -2590,6 +3174,27 @@ /*#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. @@ -2631,6 +3236,14 @@ */ /*#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. @@ -2738,8 +3351,8 @@ * 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 to get any + * It can be int, ushort, gid_t, etc... + * It may be necessary to include to get any * typedef'ed information. This is only required if you have * getgroups() or setgroups().. */ @@ -2747,6 +3360,12 @@ #define Groups_t gid_t /* Type for 2nd arg to [sg]etgroups() */ #endif +/* I_CRYPT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_CRYPT /**/ + /* DB_Prefix_t: * This symbol contains the type of the prefix structure element * in the header file. In older versions of DB, it was @@ -2777,6 +3396,12 @@ #define DB_VERSION_MINOR_CFG undef /**/ #define DB_VERSION_PATCH_CFG undef /**/ +/* I_FP: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_FP /**/ + /* I_FP_CLASS: * This symbol, if defined, indicates that exists and * should be included. @@ -2806,6 +3431,12 @@ */ /*#define I_INTTYPES /**/ +/* I_LANGINFO: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_LANGINFO /**/ + /* I_LIBUTIL: * This symbol, if defined, indicates that exists and * should be included. @@ -2824,6 +3455,12 @@ */ /*#define I_MNTENT /**/ +/* I_NDBM: + * This symbol, if defined, indicates that exists and should + * be included. + */ +/*#define I_NDBM /**/ + /* I_NETDB: * This symbol, if defined, indicates that exists and * should be included. @@ -2997,6 +3634,17 @@ */ /*#define I_USTAT /**/ +/* I_STDARG: + * This symbol, if defined, indicates that exists and should + * be included. + */ +/* I_VARARGS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#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 @@ -3004,7 +3652,7 @@ * 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 @@ -3031,7 +3679,7 @@ /*#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. @@ -3044,10 +3692,16 @@ /* Off_t_size: * This symbol holds the number of bytes used by the Off_t. */ -#define Off_t long /* type */ +#define Off_t off_t /* type */ #define LSEEKSIZE 4 /* size */ #define Off_t_size 4 /* 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. @@ -3069,7 +3723,7 @@ #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 * to get any typedef'ed information. @@ -3266,7 +3920,7 @@ #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 @@ -3343,6 +3997,24 @@ #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 @@ -3388,11 +4060,20 @@ /* 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 @@ -3416,10 +4097,10 @@ * 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, @@ -3526,7 +4207,7 @@ * 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. @@ -3577,6 +4258,15 @@ /*#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. @@ -3655,11 +4345,11 @@ * 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: @@ -3706,666 +4396,4 @@ #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 exists and should - * be included. - */ -/*#define I_NDBM /**/ - -/* I_STDARG: - * This symbol, if defined, indicates that exists and should - * be included. - */ -/* I_VARARGS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#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 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 - * 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 exists and - * should be included. - */ -/*#define I_CRYPT /**/ - -/* I_FP: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_FP /**/ - -/* I_LANGINFO: - * This symbol, if defined, indicates that 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 diff --git a/wince/bin/exetype.pl b/wince/bin/exetype.pl deleted file mode 100644 index 27e3b94..0000000 --- a/wince/bin/exetype.pl +++ /dev/null @@ -1,108 +0,0 @@ -#!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 - -=cut diff --git a/wince/bin/perlglob.pl b/wince/bin/perlglob.pl deleted file mode 100644 index 17843c8..0000000 --- a/wince/bin/perlglob.pl +++ /dev/null @@ -1,53 +0,0 @@ -#!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. - -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 for details of overriding -builtins. - -=head1 AUTHOR - -Gurusamy Sarathy - -=head1 SEE ALSO - -perl - -File::DosGlob - -=cut - diff --git a/wince/bin/pl2bat.pl b/wince/bin/pl2bat.pl deleted file mode 100644 index d70a316..0000000 --- a/wince/bin/pl2bat.pl +++ /dev/null @@ -1,412 +0,0 @@ - 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 = <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 = ; - 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 B<-h> - -B [B<-w>] S<[B<-a> I]> S<[B<-s> I]> [files] - -B [B<-w>] S<[B<-n> I]> S<[B<-o> I]> S<[B<-s> I]> [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 -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. - -=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 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 [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. - -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 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 under Windows NT, if F is not -in your B, 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. When using -F 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 implements this by -doing C 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, 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 file handle. - -One approach is: - - . #!perl - . while( ) { - . last if /^__END__$/; - . [...] - . } - . __END__ - . lines of data - . to be processed - . __END__ - . :endofperl - -The dots in the first column are only there to prevent F to interpret -the C<:endofperl> line in this documentation. Otherwise F 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 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 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 -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 shell -under Windows NT. 4DOS/NT users will want to put a C -line in their initialization file, or execute C 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 - -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 - -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 - -Arguments to invoke perl with in generated batch file. Specifying -B<-a> prevents the batch file from checking the C environment -variable to determine which operating system it is being run from. - -=item B<-s> I - -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. - -=item B<-w> - -If no line matching C 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]. With the B<-w> -option, C<" -w"> is added after the value of C<$Config{startperl}>. -If a line matching C 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, -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 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. - -=head1 SEE ALSO - -perl, perlwin32, runperl.bat - -=cut - diff --git a/wince/bin/runperl.pl b/wince/bin/runperl.pl deleted file mode 100644 index 95b33f9..0000000 --- a/wince/bin/runperl.pl +++ /dev/null @@ -1,67 +0,0 @@ -#!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 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: 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, 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. 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 - diff --git a/wince/bin/search.pl b/wince/bin/search.pl deleted file mode 100644 index ad74001..0000000 --- a/wince/bin/search.pl +++ /dev/null @@ -1,1866 +0,0 @@ -#!/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 ) -## 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 < # 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 (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 < $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 = ; - 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; $ = 0; } ## turn off warnings for when we run EXPR's - - unless (open(RC, "$file")) { - $use_default=1; - $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) : ))) { - $ln = ++$line_num; ## note starting line num. - $_ .= , $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() { - 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 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 - } - - 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 () { - 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 | xargs egrep -.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 "" would be done only when -"-xfoo" had been specified, while a line beginning with "" 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 - -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 - - 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 - option: -dir ~/ -Effectively make the default directory your home directory (instead of the -current directory). Using -dir or -xhere will undo this. -.TP - 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 - - option: -name .tex - 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 - option: -nnice -sort -i -vvv -Combine a few user-friendly options into one '-xfluff' option. -.TP - 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 - - option: -xflag1 -xflag2 - option: ...whatever... - option: ...whatever... - -.fi -will allow '-xboth' to be the same as '-xflag1 -xflag2' (or '-xflag1,flag2' -for that matter). However, if you put the "" 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 "!\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 diff --git a/wince/config_h.PL b/wince/config_h.PL deleted file mode 100644 index 9a23252..0000000 --- a/wince/config_h.PL +++ /dev/null @@ -1,122 +0,0 @@ -# -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 () - { - 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 () - { - 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; -} diff --git a/wince/config_sh.PL b/wince/config_sh.PL deleted file mode 100644 index 3314832..0000000 --- a/wince/config_sh.PL +++ /dev/null @@ -1,100 +0,0 @@ -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 = ); - 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 () { - 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; -} - diff --git a/wince/dl_win32.xs b/wince/dl_win32.xs deleted file mode 100644 index 64dc731..0000000 --- a/wince/dl_win32.xs +++ /dev/null @@ -1,171 +0,0 @@ -/* 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 -#include - -#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. diff --git a/wince/include/arpa/inet.h b/wince/include/arpa/inet.h deleted file mode 100644 index 0303df0..0000000 --- a/wince/include/arpa/inet.h +++ /dev/null @@ -1,4 +0,0 @@ -/* - * this is a dummy header file for Socket.xs - */ - diff --git a/wince/include/sys/socket.h b/wince/include/sys/socket.h deleted file mode 100644 index fbc6e09..0000000 --- a/wince/include/sys/socket.h +++ /dev/null @@ -1,217 +0,0 @@ -/* 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 -#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 -/* #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 */ diff --git a/wince/makeico.pl b/wince/makeico.pl deleted file mode 100644 index 7b1d533..0000000 --- a/wince/makeico.pl +++ /dev/null @@ -1,45 +0,0 @@ -open ICO, ">perl.ico" or die $!; -while () { - chomp; - print ICO pack "H*", $_; -} -close ICO or die $!; - -# Create new hex data with -# perl -wle 'binmode STDIN; $/ = \32; while (<>) {print unpack "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___ */ diff --git a/wince/perllib.c b/wince/perllib.c deleted file mode 100644 index 0b00246..0000000 --- a/wince/perllib.c +++ /dev/null @@ -1,326 +0,0 @@ -/* 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 -#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 diff --git a/wince/runperl.c b/wince/runperl.c deleted file mode 100644 index 85fd831..0000000 --- a/wince/runperl.c +++ /dev/null @@ -1,21 +0,0 @@ -#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); -} - - diff --git a/wince/splittree.pl b/wince/splittree.pl deleted file mode 100644 index 3c76daa..0000000 --- a/wince/splittree.pl +++ /dev/null @@ -1,24 +0,0 @@ -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]; diff --git a/wince/vdir.h b/wince/vdir.h deleted file mode 100644 index 10119ea..0000000 --- a/wince/vdir.h +++ /dev/null @@ -1,691 +0,0 @@ -/* 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<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___ */ diff --git a/wince/vmem.h b/wince/vmem.h deleted file mode 100644 index 1fd421c..0000000 --- a/wince/vmem.h +++ /dev/null @@ -1,1248 +0,0 @@ -/* 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___ */ diff --git a/wince/win32.h b/wince/win32.h deleted file mode 100644 index 6ff870f..0000000 --- a/wince/win32.h +++ /dev/null @@ -1,486 +0,0 @@ -/* 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 - -#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 -#ifndef UNDER_CE -#include -#include -#include -#include -#endif -#include -#include -#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 - -#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 -#include - -#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 */ - diff --git a/wince/win32thread.c b/wince/win32thread.c deleted file mode 100644 index 1f327d6..0000000 --- a/wince/win32thread.c +++ /dev/null @@ -1,37 +0,0 @@ -#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 -} diff --git a/wince/win32thread.h b/wince/win32thread.h deleted file mode 100644 index f7f2cf1..0000000 --- a/wince/win32thread.h +++ /dev/null @@ -1,197 +0,0 @@ -#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 -# 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 */ -