dslinux/user/perl/win32 FindExt.pm Makefile buildext.pl config.bc config.gc config.vc config.vc64 config_H.bc config_H.gc config_H.vc config_H.vc64 config_h.PL config_sh.PL distclean.bat dl_win32.xs fcrypt.c genmk95.pl makefile.mk makeico.pl mdelete.bat perlexe.rc perlglob.c perlhost.h perllib.c pod.mak runperl.c splittree.pl sync_ext.pl vdir.h vmem.h win32.c win32.h win32io.c win32iop.h win32sck.c win32thread.c win32thread.h

cayenne dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:02:24 CET 2006


Update of /cvsroot/dslinux/dslinux/user/perl/win32
In directory antilope:/tmp/cvs-serv17422/win32

Added Files:
	FindExt.pm Makefile buildext.pl config.bc config.gc config.vc 
	config.vc64 config_H.bc config_H.gc config_H.vc config_H.vc64 
	config_h.PL config_sh.PL distclean.bat dl_win32.xs fcrypt.c 
	genmk95.pl makefile.mk makeico.pl mdelete.bat perlexe.rc 
	perlglob.c perlhost.h perllib.c pod.mak runperl.c splittree.pl 
	sync_ext.pl vdir.h vmem.h win32.c win32.h win32io.c win32iop.h 
	win32sck.c win32thread.c win32thread.h 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: dl_win32.xs ---
/* dl_win32.xs
 * 
 * Platform:	Win32 (Windows NT/Windows 95)
 * Author:	Wei-Yuen Tan (wyt at hip.com)
 * Created:	A warm day in June, 1995
 *
 * Modified:
 *    August 23rd 1995 - rewritten after losing everything when I
 *                       wiped off my NT partition (eek!)
 */

/* Porting notes:

I merely took Paul's dl_dlopen.xs, took out extraneous stuff and
replaced the appropriate SunOS calls with the corresponding Win32
calls.

*/

#define WIN32_LEAN_AND_MEAN
#ifdef __GNUC__
#define Win32_Winsock
#endif
#include <windows.h>
#include <string.h>

#define PERL_NO_GET_CONTEXT

#include "EXTERN.h"
#include "perl.h"
#include "win32.h"

#include "XSUB.h"

typedef struct {
    SV *	x_error_sv;
} my_cxtx_t;		/* this *must* be named my_cxtx_t */

#define DL_CXT_EXTRA	/* ask for dl_cxtx to be defined in dlutils.c */
#include "dlutils.c"	/* SaveError() etc	*/

#define dl_error_sv	(dl_cxtx.x_error_sv)

static char *
OS_Error_String(pTHX)
{
    dMY_CXT;
    DWORD err = GetLastError();
    STRLEN len;
    if (!dl_error_sv)
	dl_error_sv = newSVpvn("",0);
    PerlProc_GetOSError(dl_error_sv,err);
    return SvPV(dl_error_sv,len);
}

static void
dl_private_init(pTHX)
{
    (void)dl_generic_private_init(aTHX);
}

/* 
    This function assumes the list staticlinkmodules
    will be formed from package names with '::' replaced
    with '/'. Thus Win32::OLE is in the list as Win32/OLE
*/
static int
dl_static_linked(char *filename)
{
    char **p;
    char *ptr, *hptr;
    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 (hptr = strstr(ptr, *p)) {
	    /* found substring, need more detailed check if module name match */
	    if (hptr==ptr) {
		return strcmp(ptr, *p)==0;
	    }
	    if (hptr[strlen(*p)] == 0)
		return hptr[-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*) GetModuleHandle(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);
  }

int
dl_unload_file(libref)
    void *	libref
  CODE:
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
    RETVAL = FreeLibrary(libref);
    if (!RETVAL)
        SaveError(aTHX_ "unload_file:%s", OS_Error_String(aTHX)) ;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
  OUTPUT:
    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*) GetProcAddress((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.

--- NEW FILE: fcrypt.c ---
/* fcrypt.c */
/* Copyright (C) 1993 Eric Young - see README for more details */
#include <stdio.h>

/* Eric Young.
 * This version of crypt has been developed from my MIT compatable
 * DES library.
 * The library is available at pub/DES at ftp.psy.uq.oz.au
 * eay at psych.psy.uq.oz.au
 */

typedef unsigned char des_cblock[8];

typedef struct des_ks_struct
	{
	union	{
		des_cblock _;
		/* make sure things are correct size on machines with
		 * 8 byte longs */
		unsigned long pad[2];
		} ks;
#define _	ks._
	} des_key_schedule[16];

#define DES_KEY_SZ 	(sizeof(des_cblock))
#define DES_ENCRYPT	1
#define DES_DECRYPT	0

#define ITERATIONS 16
#define HALF_ITERATIONS 8

#define c2l(c,l)	(l =((unsigned long)(*((c)++)))    , \
			 l|=((unsigned long)(*((c)++)))<< 8, \
			 l|=((unsigned long)(*((c)++)))<<16, \
			 l|=((unsigned long)(*((c)++)))<<24)

#define l2c(l,c)	(*((c)++)=(unsigned char)(((l)    )&0xff), \
			 *((c)++)=(unsigned char)(((l)>> 8)&0xff), \
			 *((c)++)=(unsigned char)(((l)>>16)&0xff), \
			 *((c)++)=(unsigned char)(((l)>>24)&0xff))

static unsigned long SPtrans[8][64]={
{ /* nibble 0 */
0x00820200, 0x00020000, 0x80800000, 0x80820200,
0x00800000, 0x80020200, 0x80020000, 0x80800000,
0x80020200, 0x00820200, 0x00820000, 0x80000200,
0x80800200, 0x00800000, 0x00000000, 0x80020000,
0x00020000, 0x80000000, 0x00800200, 0x00020200,
0x80820200, 0x00820000, 0x80000200, 0x00800200,
0x80000000, 0x00000200, 0x00020200, 0x80820000,
0x00000200, 0x80800200, 0x80820000, 0x00000000,
0x00000000, 0x80820200, 0x00800200, 0x80020000,
0x00820200, 0x00020000, 0x80000200, 0x00800200,
0x80820000, 0x00000200, 0x00020200, 0x80800000,
0x80020200, 0x80000000, 0x80800000, 0x00820000,
0x80820200, 0x00020200, 0x00820000, 0x80800200,
0x00800000, 0x80000200, 0x80020000, 0x00000000,
0x00020000, 0x00800000, 0x80800200, 0x00820200,
0x80000000, 0x80820000, 0x00000200, 0x80020200},
{ /* nibble 1 */
0x10042004, 0x00000000, 0x00042000, 0x10040000,
0x10000004, 0x00002004, 0x10002000, 0x00042000,
0x00002000, 0x10040004, 0x00000004, 0x10002000,
0x00040004, 0x10042000, 0x10040000, 0x00000004,
0x00040000, 0x10002004, 0x10040004, 0x00002000,
0x00042004, 0x10000000, 0x00000000, 0x00040004,
0x10002004, 0x00042004, 0x10042000, 0x10000004,
0x10000000, 0x00040000, 0x00002004, 0x10042004,
0x00040004, 0x10042000, 0x10002000, 0x00042004,
0x10042004, 0x00040004, 0x10000004, 0x00000000,
0x10000000, 0x00002004, 0x00040000, 0x10040004,
0x00002000, 0x10000000, 0x00042004, 0x10002004,
0x10042000, 0x00002000, 0x00000000, 0x10000004,
0x00000004, 0x10042004, 0x00042000, 0x10040000,
0x10040004, 0x00040000, 0x00002004, 0x10002000,
0x10002004, 0x00000004, 0x10040000, 0x00042000},
{ /* nibble 2 */
0x41000000, 0x01010040, 0x00000040, 0x41000040,
0x40010000, 0x01000000, 0x41000040, 0x00010040,
0x01000040, 0x00010000, 0x01010000, 0x40000000,
0x41010040, 0x40000040, 0x40000000, 0x41010000,
0x00000000, 0x40010000, 0x01010040, 0x00000040,
0x40000040, 0x41010040, 0x00010000, 0x41000000,
0x41010000, 0x01000040, 0x40010040, 0x01010000,
0x00010040, 0x00000000, 0x01000000, 0x40010040,
0x01010040, 0x00000040, 0x40000000, 0x00010000,
0x40000040, 0x40010000, 0x01010000, 0x41000040,
0x00000000, 0x01010040, 0x00010040, 0x41010000,
0x40010000, 0x01000000, 0x41010040, 0x40000000,
0x40010040, 0x41000000, 0x01000000, 0x41010040,
0x00010000, 0x01000040, 0x41000040, 0x00010040,
0x01000040, 0x00000000, 0x41010000, 0x40000040,
0x41000000, 0x40010040, 0x00000040, 0x01010000},
{ /* nibble 3 */
0x00100402, 0x04000400, 0x00000002, 0x04100402,
0x00000000, 0x04100000, 0x04000402, 0x00100002,
0x04100400, 0x04000002, 0x04000000, 0x00000402,
0x04000002, 0x00100402, 0x00100000, 0x04000000,
0x04100002, 0x00100400, 0x00000400, 0x00000002,
0x00100400, 0x04000402, 0x04100000, 0x00000400,
0x00000402, 0x00000000, 0x00100002, 0x04100400,
0x04000400, 0x04100002, 0x04100402, 0x00100000,
0x04100002, 0x00000402, 0x00100000, 0x04000002,
0x00100400, 0x04000400, 0x00000002, 0x04100000,
0x04000402, 0x00000000, 0x00000400, 0x00100002,
0x00000000, 0x04100002, 0x04100400, 0x00000400,
0x04000000, 0x04100402, 0x00100402, 0x00100000,
0x04100402, 0x00000002, 0x04000400, 0x00100402,
0x00100002, 0x00100400, 0x04100000, 0x04000402,
0x00000402, 0x04000000, 0x04000002, 0x04100400},
{ /* nibble 4 */
0x02000000, 0x00004000, 0x00000100, 0x02004108,
0x02004008, 0x02000100, 0x00004108, 0x02004000,
0x00004000, 0x00000008, 0x02000008, 0x00004100,
0x02000108, 0x02004008, 0x02004100, 0x00000000,
0x00004100, 0x02000000, 0x00004008, 0x00000108,
0x02000100, 0x00004108, 0x00000000, 0x02000008,
0x00000008, 0x02000108, 0x02004108, 0x00004008,
0x02004000, 0x00000100, 0x00000108, 0x02004100,
0x02004100, 0x02000108, 0x00004008, 0x02004000,
0x00004000, 0x00000008, 0x02000008, 0x02000100,
0x02000000, 0x00004100, 0x02004108, 0x00000000,
0x00004108, 0x02000000, 0x00000100, 0x00004008,
0x02000108, 0x00000100, 0x00000000, 0x02004108,
0x02004008, 0x02004100, 0x00000108, 0x00004000,
0x00004100, 0x02004008, 0x02000100, 0x00000108,
0x00000008, 0x00004108, 0x02004000, 0x02000008},
{ /* nibble 5 */
0x20000010, 0x00080010, 0x00000000, 0x20080800,
0x00080010, 0x00000800, 0x20000810, 0x00080000,
0x00000810, 0x20080810, 0x00080800, 0x20000000,
0x20000800, 0x20000010, 0x20080000, 0x00080810,
0x00080000, 0x20000810, 0x20080010, 0x00000000,
0x00000800, 0x00000010, 0x20080800, 0x20080010,
0x20080810, 0x20080000, 0x20000000, 0x00000810,
0x00000010, 0x00080800, 0x00080810, 0x20000800,
0x00000810, 0x20000000, 0x20000800, 0x00080810,
0x20080800, 0x00080010, 0x00000000, 0x20000800,
0x20000000, 0x00000800, 0x20080010, 0x00080000,
0x00080010, 0x20080810, 0x00080800, 0x00000010,
0x20080810, 0x00080800, 0x00080000, 0x20000810,
0x20000010, 0x20080000, 0x00080810, 0x00000000,
0x00000800, 0x20000010, 0x20000810, 0x20080800,
0x20080000, 0x00000810, 0x00000010, 0x20080010},
{ /* nibble 6 */
0x00001000, 0x00000080, 0x00400080, 0x00400001,
0x00401081, 0x00001001, 0x00001080, 0x00000000,
0x00400000, 0x00400081, 0x00000081, 0x00401000,
0x00000001, 0x00401080, 0x00401000, 0x00000081,
0x00400081, 0x00001000, 0x00001001, 0x00401081,
0x00000000, 0x00400080, 0x00400001, 0x00001080,
0x00401001, 0x00001081, 0x00401080, 0x00000001,
0x00001081, 0x00401001, 0x00000080, 0x00400000,
0x00001081, 0x00401000, 0x00401001, 0x00000081,
0x00001000, 0x00000080, 0x00400000, 0x00401001,
0x00400081, 0x00001081, 0x00001080, 0x00000000,
0x00000080, 0x00400001, 0x00000001, 0x00400080,
0x00000000, 0x00400081, 0x00400080, 0x00001080,
0x00000081, 0x00001000, 0x00401081, 0x00400000,
0x00401080, 0x00000001, 0x00001001, 0x00401081,
0x00400001, 0x00401080, 0x00401000, 0x00001001},
{ /* nibble 7 */
0x08200020, 0x08208000, 0x00008020, 0x00000000,
0x08008000, 0x00200020, 0x08200000, 0x08208020,
0x00000020, 0x08000000, 0x00208000, 0x00008020,
0x00208020, 0x08008020, 0x08000020, 0x08200000,
0x00008000, 0x00208020, 0x00200020, 0x08008000,
0x08208020, 0x08000020, 0x00000000, 0x00208000,
0x08000000, 0x00200000, 0x08008020, 0x08200020,
0x00200000, 0x00008000, 0x08208000, 0x00000020,
0x00200000, 0x00008000, 0x08000020, 0x08208020,
0x00008020, 0x08000000, 0x00000000, 0x00208000,
0x08200020, 0x08008020, 0x08008000, 0x00200020,
0x08208000, 0x00000020, 0x00200020, 0x08008000,
0x08208020, 0x00200000, 0x08200000, 0x08000020,
0x00208000, 0x00008020, 0x08008020, 0x08200000,
0x00000020, 0x08208000, 0x00208020, 0x00000000,
0x08000000, 0x08200020, 0x00008000, 0x00208020}
};
static unsigned long skb[8][64]={
{ /* for C bits (numbered as per FIPS 46) 1 2 3 4 5 6 */
0x00000000,0x00000010,0x20000000,0x20000010,
0x00010000,0x00010010,0x20010000,0x20010010,
0x00000800,0x00000810,0x20000800,0x20000810,
0x00010800,0x00010810,0x20010800,0x20010810,
0x00000020,0x00000030,0x20000020,0x20000030,
0x00010020,0x00010030,0x20010020,0x20010030,
0x00000820,0x00000830,0x20000820,0x20000830,
0x00010820,0x00010830,0x20010820,0x20010830,
0x00080000,0x00080010,0x20080000,0x20080010,
0x00090000,0x00090010,0x20090000,0x20090010,
0x00080800,0x00080810,0x20080800,0x20080810,
0x00090800,0x00090810,0x20090800,0x20090810,
0x00080020,0x00080030,0x20080020,0x20080030,
0x00090020,0x00090030,0x20090020,0x20090030,
0x00080820,0x00080830,0x20080820,0x20080830,
0x00090820,0x00090830,0x20090820,0x20090830},
{ /* for C bits (numbered as per FIPS 46) 7 8 10 11 12 13 */
0x00000000,0x02000000,0x00002000,0x02002000,
0x00200000,0x02200000,0x00202000,0x02202000,
0x00000004,0x02000004,0x00002004,0x02002004,
0x00200004,0x02200004,0x00202004,0x02202004,
0x00000400,0x02000400,0x00002400,0x02002400,
0x00200400,0x02200400,0x00202400,0x02202400,
0x00000404,0x02000404,0x00002404,0x02002404,
0x00200404,0x02200404,0x00202404,0x02202404,
0x10000000,0x12000000,0x10002000,0x12002000,
0x10200000,0x12200000,0x10202000,0x12202000,
0x10000004,0x12000004,0x10002004,0x12002004,
0x10200004,0x12200004,0x10202004,0x12202004,
0x10000400,0x12000400,0x10002400,0x12002400,
0x10200400,0x12200400,0x10202400,0x12202400,
0x10000404,0x12000404,0x10002404,0x12002404,
0x10200404,0x12200404,0x10202404,0x12202404},
{ /* for C bits (numbered as per FIPS 46) 14 15 16 17 19 20 */
0x00000000,0x00000001,0x00040000,0x00040001,
0x01000000,0x01000001,0x01040000,0x01040001,
0x00000002,0x00000003,0x00040002,0x00040003,
0x01000002,0x01000003,0x01040002,0x01040003,
0x00000200,0x00000201,0x00040200,0x00040201,
0x01000200,0x01000201,0x01040200,0x01040201,
0x00000202,0x00000203,0x00040202,0x00040203,
0x01000202,0x01000203,0x01040202,0x01040203,
0x08000000,0x08000001,0x08040000,0x08040001,
0x09000000,0x09000001,0x09040000,0x09040001,
0x08000002,0x08000003,0x08040002,0x08040003,
0x09000002,0x09000003,0x09040002,0x09040003,
0x08000200,0x08000201,0x08040200,0x08040201,
0x09000200,0x09000201,0x09040200,0x09040201,
0x08000202,0x08000203,0x08040202,0x08040203,
0x09000202,0x09000203,0x09040202,0x09040203},
{ /* for C bits (numbered as per FIPS 46) 21 23 24 26 27 28 */
0x00000000,0x00100000,0x00000100,0x00100100,
0x00000008,0x00100008,0x00000108,0x00100108,
0x00001000,0x00101000,0x00001100,0x00101100,
0x00001008,0x00101008,0x00001108,0x00101108,
0x04000000,0x04100000,0x04000100,0x04100100,
0x04000008,0x04100008,0x04000108,0x04100108,
0x04001000,0x04101000,0x04001100,0x04101100,
0x04001008,0x04101008,0x04001108,0x04101108,
0x00020000,0x00120000,0x00020100,0x00120100,
0x00020008,0x00120008,0x00020108,0x00120108,
0x00021000,0x00121000,0x00021100,0x00121100,
0x00021008,0x00121008,0x00021108,0x00121108,
0x04020000,0x04120000,0x04020100,0x04120100,
0x04020008,0x04120008,0x04020108,0x04120108,
0x04021000,0x04121000,0x04021100,0x04121100,
0x04021008,0x04121008,0x04021108,0x04121108},
{ /* for D bits (numbered as per FIPS 46) 1 2 3 4 5 6 */
0x00000000,0x10000000,0x00010000,0x10010000,
0x00000004,0x10000004,0x00010004,0x10010004,
0x20000000,0x30000000,0x20010000,0x30010000,
0x20000004,0x30000004,0x20010004,0x30010004,
0x00100000,0x10100000,0x00110000,0x10110000,
0x00100004,0x10100004,0x00110004,0x10110004,
0x20100000,0x30100000,0x20110000,0x30110000,
0x20100004,0x30100004,0x20110004,0x30110004,
0x00001000,0x10001000,0x00011000,0x10011000,
0x00001004,0x10001004,0x00011004,0x10011004,
0x20001000,0x30001000,0x20011000,0x30011000,
0x20001004,0x30001004,0x20011004,0x30011004,
0x00101000,0x10101000,0x00111000,0x10111000,
0x00101004,0x10101004,0x00111004,0x10111004,
0x20101000,0x30101000,0x20111000,0x30111000,
0x20101004,0x30101004,0x20111004,0x30111004},
{ /* for D bits (numbered as per FIPS 46) 8 9 11 12 13 14 */
0x00000000,0x08000000,0x00000008,0x08000008,
0x00000400,0x08000400,0x00000408,0x08000408,
0x00020000,0x08020000,0x00020008,0x08020008,
0x00020400,0x08020400,0x00020408,0x08020408,
0x00000001,0x08000001,0x00000009,0x08000009,
0x00000401,0x08000401,0x00000409,0x08000409,
0x00020001,0x08020001,0x00020009,0x08020009,
0x00020401,0x08020401,0x00020409,0x08020409,
0x02000000,0x0A000000,0x02000008,0x0A000008,
0x02000400,0x0A000400,0x02000408,0x0A000408,
0x02020000,0x0A020000,0x02020008,0x0A020008,
0x02020400,0x0A020400,0x02020408,0x0A020408,
0x02000001,0x0A000001,0x02000009,0x0A000009,
0x02000401,0x0A000401,0x02000409,0x0A000409,
0x02020001,0x0A020001,0x02020009,0x0A020009,
0x02020401,0x0A020401,0x02020409,0x0A020409},
{ /* for D bits (numbered as per FIPS 46) 16 17 18 19 20 21 */
0x00000000,0x00000100,0x00080000,0x00080100,
0x01000000,0x01000100,0x01080000,0x01080100,
0x00000010,0x00000110,0x00080010,0x00080110,
0x01000010,0x01000110,0x01080010,0x01080110,
0x00200000,0x00200100,0x00280000,0x00280100,
0x01200000,0x01200100,0x01280000,0x01280100,
0x00200010,0x00200110,0x00280010,0x00280110,
0x01200010,0x01200110,0x01280010,0x01280110,
0x00000200,0x00000300,0x00080200,0x00080300,
0x01000200,0x01000300,0x01080200,0x01080300,
0x00000210,0x00000310,0x00080210,0x00080310,
0x01000210,0x01000310,0x01080210,0x01080310,
0x00200200,0x00200300,0x00280200,0x00280300,
0x01200200,0x01200300,0x01280200,0x01280300,
0x00200210,0x00200310,0x00280210,0x00280310,
0x01200210,0x01200310,0x01280210,0x01280310},
{ /* for D bits (numbered as per FIPS 46) 22 23 24 25 27 28 */
0x00000000,0x04000000,0x00040000,0x04040000,
0x00000002,0x04000002,0x00040002,0x04040002,
0x00002000,0x04002000,0x00042000,0x04042000,
0x00002002,0x04002002,0x00042002,0x04042002,
0x00000020,0x04000020,0x00040020,0x04040020,
0x00000022,0x04000022,0x00040022,0x04040022,
0x00002020,0x04002020,0x00042020,0x04042020,
0x00002022,0x04002022,0x00042022,0x04042022,
0x00000800,0x04000800,0x00040800,0x04040800,
0x00000802,0x04000802,0x00040802,0x04040802,
0x00002800,0x04002800,0x00042800,0x04042800,
0x00002802,0x04002802,0x00042802,0x04042802,
0x00000820,0x04000820,0x00040820,0x04040820,
0x00000822,0x04000822,0x00040822,0x04040822,
0x00002820,0x04002820,0x00042820,0x04042820,
0x00002822,0x04002822,0x00042822,0x04042822}
};

/* See ecb_encrypt.c for a pseudo description of these macros. */
#define PERM_OP(a,b,t,n,m) ((t)=((((a)>>(n))^(b))&(m)),\
	(b)^=(t),\
	(a)^=((t)<<(n)))

#define HPERM_OP(a,t,n,m) ((t)=((((a)<<(16-(n)))^(a))&(m)),\
	(a)=(a)^(t)^(t>>(16-(n))))\

static char shifts2[16]={0,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0};

static int body(
	unsigned long *out0,
	unsigned long *out1,
	des_key_schedule ks,
	unsigned long Eswap0,
	unsigned long Eswap1);

static int
des_set_key(des_cblock *key, des_key_schedule schedule)
	{
	register unsigned long c,d,t,s;
	register unsigned char *in;
	register unsigned long *k;
	register int i;

	k=(unsigned long *)schedule;
	in=(unsigned char *)key;

	c2l(in,c);
	c2l(in,d);

	/* I now do it in 47 simple operations :-)
	 * Thanks to John Fletcher (john_fletcher at lccmail.ocf.llnl.gov)
	 * for the inspiration. :-) */
	PERM_OP (d,c,t,4,0x0f0f0f0f);
	HPERM_OP(c,t,-2,0xcccc0000);
	HPERM_OP(d,t,-2,0xcccc0000);
	PERM_OP (d,c,t,1,0x55555555);
	PERM_OP (c,d,t,8,0x00ff00ff);
	PERM_OP (d,c,t,1,0x55555555);
	d=	(((d&0x000000ff)<<16)| (d&0x0000ff00)     |
		 ((d&0x00ff0000)>>16)|((c&0xf0000000)>>4));
	c&=0x0fffffff;

	for (i=0; i<ITERATIONS; i++)
		{
		if (shifts2[i])
			{ c=((c>>2)|(c<<26)); d=((d>>2)|(d<<26)); }
		else
			{ c=((c>>1)|(c<<27)); d=((d>>1)|(d<<27)); }
		c&=0x0fffffff;
		d&=0x0fffffff;
		/* could be a few less shifts but I am to lazy at this
		 * point in time to investigate */
		s=	skb[0][ (c    )&0x3f                ]|
			skb[1][((c>> 6)&0x03)|((c>> 7)&0x3c)]|
			skb[2][((c>>13)&0x0f)|((c>>14)&0x30)]|
			skb[3][((c>>20)&0x01)|((c>>21)&0x06) |
			                      ((c>>22)&0x38)];
		t=	skb[4][ (d    )&0x3f                ]|
			skb[5][((d>> 7)&0x03)|((d>> 8)&0x3c)]|
			skb[6][ (d>>15)&0x3f                ]|
			skb[7][((d>>21)&0x0f)|((d>>22)&0x30)];

		/* table contained 0213 4657 */
		*(k++)=((t<<16)|(s&0x0000ffff))&0xffffffff;
		s=     ((s>>16)|(t&0xffff0000));
		
		s=(s<<4)|(s>>28);
		*(k++)=s&0xffffffff;
		}
	return(0);
	}

/******************************************************************
 * modified stuff for crypt.
 ******************************************************************/

/* The changes to this macro may help or hinder, depending on the
 * compiler and the achitecture.  gcc2 always seems to do well :-). 
 * Inspired by Dana How <how at isl.stanford.edu>
 * DO NOT use the alternative version on machines with 8 byte longs.
 */
#ifdef ALT_ECB
#define D_ENCRYPT(L,R,S) \
	v=(R^(R>>16)); \
	u=(v&E0); \
	v=(v&E1); \
	u=((u^(u<<16))^R^s[S  ])<<2; \
	t=(v^(v<<16))^R^s[S+1]; \
	t=(t>>2)|(t<<30); \
	L^= \
	*(unsigned long *)(des_SP+0x0100+((t    )&0xfc))+ \
	*(unsigned long *)(des_SP+0x0300+((t>> 8)&0xfc))+ \
	*(unsigned long *)(des_SP+0x0500+((t>>16)&0xfc))+ \
	*(unsigned long *)(des_SP+0x0700+((t>>24)&0xfc))+ \
	*(unsigned long *)(des_SP+       ((u    )&0xfc))+ \
  	*(unsigned long *)(des_SP+0x0200+((u>> 8)&0xfc))+ \
  	*(unsigned long *)(des_SP+0x0400+((u>>16)&0xfc))+ \
 	*(unsigned long *)(des_SP+0x0600+((u>>24)&0xfc));
#else /* original version */
#define D_ENCRYPT(L,R,S)	\
	v=(R^(R>>16)); \
	u=(v&E0); \
	v=(v&E1); \
	u=(u^(u<<16))^R^s[S  ]; \
	t=(v^(v<<16))^R^s[S+1]; \
	t=(t>>4)|(t<<28); \
	L^=	SPtrans[1][(t    )&0x3f]| \
		SPtrans[3][(t>> 8)&0x3f]| \
		SPtrans[5][(t>>16)&0x3f]| \
		SPtrans[7][(t>>24)&0x3f]| \
		SPtrans[0][(u    )&0x3f]| \
		SPtrans[2][(u>> 8)&0x3f]| \
		SPtrans[4][(u>>16)&0x3f]| \
		SPtrans[6][(u>>24)&0x3f];
#endif

unsigned char con_salt[128]={
0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,
0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,
0x0A,0x0B,0x05,0x06,0x07,0x08,0x09,0x0A,
0x0B,0x0C,0x0D,0x0E,0x0F,0x10,0x11,0x12,
0x13,0x14,0x15,0x16,0x17,0x18,0x19,0x1A,
0x1B,0x1C,0x1D,0x1E,0x1F,0x20,0x21,0x22,
0x23,0x24,0x25,0x20,0x21,0x22,0x23,0x24,
0x25,0x26,0x27,0x28,0x29,0x2A,0x2B,0x2C,
0x2D,0x2E,0x2F,0x30,0x31,0x32,0x33,0x34,
0x35,0x36,0x37,0x38,0x39,0x3A,0x3B,0x3C,
0x3D,0x3E,0x3F,0x00,0x00,0x00,0x00,0x00,
};

unsigned char cov_2char[64]={
0x2E,0x2F,0x30,0x31,0x32,0x33,0x34,0x35,
0x36,0x37,0x38,0x39,0x41,0x42,0x43,0x44,
0x45,0x46,0x47,0x48,0x49,0x4A,0x4B,0x4C,
0x4D,0x4E,0x4F,0x50,0x51,0x52,0x53,0x54,
0x55,0x56,0x57,0x58,0x59,0x5A,0x61,0x62,
0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6A,
0x6B,0x6C,0x6D,0x6E,0x6F,0x70,0x71,0x72,
0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7A
};

char *
des_fcrypt(const char *buf, const char *salt, char *buff)
	{
	unsigned int i,j,x,y;
	unsigned long Eswap0,Eswap1;
	unsigned long out[2],ll;
	des_cblock key;
	des_key_schedule ks;
	unsigned char bb[9];
	unsigned char *b=bb;
	unsigned char c,u;

	/* eay 25/08/92
	 * If you call crypt("pwd","*") as often happens when you
	 * have * as the pwd field in /etc/passwd, the function
	 * returns *\0XXXXXXXXX
	 * The \0 makes the string look like * so the pwd "*" would
	 * crypt to "*".  This was found when replacing the crypt in
	 * our shared libraries.  People found that the disbled
	 * accounts effectivly had no passwd :-(. */
	x=buff[0]=((salt[0] == '\0')?(char)'A':salt[0]);
	Eswap0=con_salt[x];
	x=buff[1]=((salt[1] == '\0')?(char)'A':salt[1]);
	Eswap1=con_salt[x]<<4;

	for (i=0; i<8; i++)
		{
		c= *(buf++);
		if (!c) break;
		key[i]=(char)(c<<1);
		}
	for (; i<8; i++)
		key[i]=0;

	des_set_key((des_cblock *)(key),ks);
	body(&out[0],&out[1],ks,Eswap0,Eswap1);

	ll=out[0]; l2c(ll,b);
	ll=out[1]; l2c(ll,b);
	y=0;
	u=0x80;
	bb[8]=0;
	for (i=2; i<13; i++)
		{
		c=0;
		for (j=0; j<6; j++)
			{
			c<<=1;
			if (bb[y] & u) c|=1;
			u>>=1;
			if (!u)
				{
				y++;
				u=0x80;
				}
			}
		buff[i]=cov_2char[c];
		}
	buff[13]='\0';
	return buff;
	}

static int 
body(	unsigned long *out0,
	unsigned long *out1,
	des_key_schedule ks,
	unsigned long Eswap0,
	unsigned long Eswap1)
	{
	register unsigned long l,r,t,u,v;
#ifdef ALT_ECB
	register unsigned char *des_SP=(unsigned char *)SPtrans;
#endif
	register unsigned long *s;
	register int i,j;
	register unsigned long E0,E1;

	l=0;
	r=0;

	s=(unsigned long *)ks;
	E0=Eswap0;
	E1=Eswap1;

	for (j=0; j<25; j++)
		{
		for (i=0; i<(ITERATIONS*2); i+=4)
			{
			D_ENCRYPT(l,r,  i);	/*  1 */
			D_ENCRYPT(r,l,  i+2);	/*  2 */
			}
		t=l;
		l=r;
		r=t;
		}
	t=r;
	r=(l>>1)|(l<<31);
	l=(t>>1)|(t<<31);
	/* clear the top bits on machines with 8byte longs */
	l&=0xffffffff;
	r&=0xffffffff;

	PERM_OP(r,l,t, 1,0x55555555);
	PERM_OP(l,r,t, 8,0x00ff00ff);
	PERM_OP(r,l,t, 2,0x33333333);
	PERM_OP(l,r,t,16,0x0000ffff);
	PERM_OP(r,l,t, 4,0x0f0f0f0f);

	*out0=l;
	*out1=r;
	return(0);
	}


--- NEW FILE: config.vc ---
## Configured by: ~cf_email~
## Target system: WIN32 
Author=''
Date='$Date'
Header=''
Id='$Id'
Locker=''
Log='$Log'
Mcc='Mcc'
RCSfile='$RCSfile'
Revision='$Revision'
Source=''
State=''
_a='.lib'
_exe='.exe'
_o='.obj'
afs='false'
afsroot='/afs'
alignbytes='8'
[...989 lines suppressed...]
vendorscript=''
vendorscriptexp=''
version='~VERSION~'
version_patchlevel_string=''
versiononly='undef'
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
yacc='yacc'
yaccflags=''
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
PERL_VERSION='~PERL_VERSION~'
PERL_API_REVISION='~PERL_API_REVISION~'
PERL_API_SUBVERSION='~PERL_API_SUBVERSION~'
PERL_API_VERSION='~PERL_API_VERSION~'
PERL_PATCHLEVEL='~PERL_VERSION~'
PERL_CONFIG_SH='true'

--- NEW FILE: Makefile ---
#
# Makefile to build perl on Windows NT using Microsoft NMAKE.
# Supported compilers:
#	Visual C++ 2.0 through 7.0 (and possibly newer versions)
#	MS Platform SDK 64-bit compiler and tools **experimental**
#
# This is set up to build a perl.exe that runs off a shared library
# (perl58.dll).  Also makes individual DLLs for the XS extensions.
#

##
## Make sure you read README.win32 *before* you mess with anything here!
##

##
## Build configuration.  Edit the values below to suit your needs.
##

#
[...1290 lines suppressed...]

clean : Extensions_clean _clean

realclean : Extensions_realclean _clean

# Handy way to run perlbug -ok without having to install and run the
# installed perlbug. We don't re-run the tests here - we trust the user.
# Please *don't* use this unless all tests pass.
# If you want to report test failures, use "nmake nok" instead.
ok: utils
	$(PERLEXE) -I..\lib ..\utils\perlbug -ok -s "(UNINSTALLED)"

okfile: utils
	$(PERLEXE) -I..\lib ..\utils\perlbug -ok -s "(UNINSTALLED)" -F perl.ok

nok: utils
	$(PERLEXE) -I..\lib ..\utils\perlbug -nok -s "(UNINSTALLED)"

nokfile: utils
	$(PERLEXE) -I..\lib ..\utils\perlbug -nok -s "(UNINSTALLED)" -F perl.nok

--- NEW FILE: sync_ext.pl ---
=comment

Synchronize filename cases for extensions.

This script could be used to perform following renaming:
if there exist file, for example, "FiLeNaME.c" and
filename.obj then it renames "filename.obj" to "FiLeNaME.obj".
There is a problem when some compilers (e.g.Borland) generate
such .obj files and then "make" process will not treat them
as dependant and already maked files.

This script takes two arguments - first and second extensions to
synchronize filename cases with.

There may be specified following options:
  --verbose    <== say everything what is going on
  --recurse    <== recurse subdirectories
  --dummy      <== do not perform actual renaming
  --say-subdir
Every such option can be specified with an optional "no" prefix to negate it.

Typically, it is invoked as:
  perl sync_ext.pl c obj --verbose

=cut

use strict;

my ($ext1, $ext2) = map {quotemeta} grep {!/^--/} @ARGV;
my %opts = (
  #defaults
    'verbose' => 0,
    'recurse' => 1,
    'dummy' => 0,
    'say-subdir' => 0,
  #options itself
    (map {/^--([\-_\w]+)=(.*)$/} @ARGV),                            # --opt=smth
    (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),  # --opt --no-opt --noopt
  );

my $sp = '';
sub xx {
  opendir DIR, '.';
  my @t = readdir DIR;
  my @f = map {/^(.*)\.$ext1$/i} @t;
  my %f = map {lc($_)=>$_} map {/^(.*)\.$ext2$/i} @t;
  for (@f) {
    my $lc = lc($_);
    if (exists $f{$lc} and $f{$lc} ne $_) {
      print STDERR "$sp$f{$lc}.$ext2 <==> $_.$ext1\n" if $opts{verbose};
      if ($opts{dummy}) {
        print STDERR "ren $f{$lc}.$ext2 $_.$ext2\n";
      }
      else {
        system "ren $f{$lc}.$ext2 $_.$ext2";
      }
    }
  }
  if ($opts{recurse}) {
    for (grep {-d&&!/^\.\.?$/} @t) {
      print STDERR "$sp\\$_\n" if $opts{'say-subdir'};
      $sp .= ' ';
      chdir $_ or die;
      xx();
      chdir ".." or die;
      chop $sp;
    }
  }
}

xx();

--- NEW FILE: config_H.gc ---
/*
 * This file was produced by running the config_h.SH script, which
 * gets its values from undef, which is generally produced by
 * running Configure.
 *
 * Feel free to modify any of this as the need arises.  Note, however,
 * that running config_h.SH again will wipe out any changes you've made.
 * For a more permanent change edit undef and rerun config_h.SH.
 *
 * $Id: config_H.gc,v 1.2 2006-12-04 17:02:18 dslinux_cayenne Exp $
 */

/*
 * Package name      : perl5
 * Source directory  : 
 * Configuration time: Mon Mar 17 20:15:35 2003
 * Configured by     : gsar
 * Target system     : 
 */
[...4336 lines suppressed...]
 *	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

--- NEW FILE: config.gc ---
## Configured by: ~cf_email~
## Target system: WIN32 
Author=''
Date='$Date'
Header=''
Id='$Id'
Locker=''
Log='$Log'
Mcc='Mcc'
RCSfile='$RCSfile'
Revision='$Revision'
Source=''
State=''
_a='.a'
_exe='.exe'
_o='.o'
afs='false'
afsroot='/afs'
alignbytes='8'
[...989 lines suppressed...]
vendorscript=''
vendorscriptexp=''
version='~VERSION~'
version_patchlevel_string=''
versiononly='undef'
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
yacc='yacc'
yaccflags=''
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
PERL_VERSION='~PERL_VERSION~'
PERL_API_REVISION='~PERL_API_REVISION~'
PERL_API_SUBVERSION='~PERL_API_SUBVERSION~'
PERL_API_VERSION='~PERL_API_VERSION~'
PERL_PATCHLEVEL='~PERL_VERSION~'
PERL_CONFIG_SH='true'

--- NEW FILE: mdelete.bat ---
@echo off
rem ! This is a batch file to delete all the files on its
rem ! command line, to work around command.com's del command's
rem ! braindeadness
rem !
rem !    -- BKS, 11-11-2000

:nextfile
set file=%1
shift
if "%file%"=="" goto end
del %file%
goto nextfile
:end

@echo off
rem ! This is a batch file to delete all the files on its
rem ! command line, to work around command.com's del command's
rem ! braindeadness
rem !
rem !    -- BKS, 11-11-2000

:nextfile
set file=%1
shift
if "%file%"=="" goto end
del %file%
goto nextfile
:end

--- NEW FILE: makefile.mk ---
#
# Makefile to build perl on Windows NT using DMAKE.
# Supported compilers:
#	Visual C++ 2.0 through 7.0 (and possibly newer versions)
#	Borland C++ 5.02 or better
#	Mingw32 with gcc-2.95.2 or better
#	MS Platform SDK 64-bit compiler and tools **experimental**
#
# This is set up to build a perl.exe that runs off a shared library
# (perl58.dll).  Also makes individual DLLs for the XS extensions.
#

##
## Make sure you read README.win32 *before* you mess with anything here!
##

##
## Build configuration.  Edit the values below to suit your needs.
##
[...1471 lines suppressed...]

clean : Extensions_clean _clean

realclean : Extensions_realclean _clean

# Handy way to run perlbug -ok without having to install and run the
# installed perlbug. We don't re-run the tests here - we trust the user.
# Please *don't* use this unless all tests pass.
# If you want to report test failures, use "dmake nok" instead.
ok: utils
	$(PERLEXE) -I..\lib ..\utils\perlbug -ok -s "(UNINSTALLED)"

okfile: utils
	$(PERLEXE) -I..\lib ..\utils\perlbug -ok -s "(UNINSTALLED)" -F perl.ok

nok: utils
	$(PERLEXE) -I..\lib ..\utils\perlbug -nok -s "(UNINSTALLED)"

nokfile: utils
	$(PERLEXE) -I..\lib ..\utils\perlbug -nok -s "(UNINSTALLED)" -F perl.nok

--- NEW FILE: perlglob.c ---
/*
 * Globbing for NT.  Relies on the expansion done by the library
 * startup code. 
 */

#include <stdio.h>
#include <io.h>
#include <fcntl.h>
#include <string.h>
#include <windows.h>

int
main(int argc, char *argv[])
{
    int i;
    size_t len;
    char root[MAX_PATH];
    char *dummy;
    char volname[MAX_PATH];
    DWORD serial, maxname, flags;
    BOOL downcase = TRUE;

    /* check out the file system characteristics */
    if (GetFullPathName(".", MAX_PATH, root, &dummy)) {
        dummy = strchr(root,'\\'); 
	if (dummy)
	    *++dummy = '\0';
	if (GetVolumeInformation(root, volname, MAX_PATH, 
				 &serial, &maxname, &flags, 0, 0)) {
	    downcase = !(flags & FS_CASE_IS_PRESERVED);
	}
    }

    setmode(fileno(stdout), O_BINARY);
    for (i = 1; i < argc; i++) {
	len = strlen(argv[i]);
	if (downcase)
	    strlwr(argv[i]);
	if (i > 1) fwrite("\0", sizeof(char), 1, stdout);
	fwrite(argv[i], sizeof(char), len, stdout);
    }
    return 0;
}


--- NEW FILE: win32iop.h ---
#ifndef WIN32IOP_H
#define WIN32IOP_H

#ifndef START_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

#if defined(_MSC_VER) || defined(__MINGW32__)
#  include <sys/utime.h>
#else
#  include <utime.h>
#endif

/*
 * defines for flock emulation
 */
#define LOCK_SH 1
#define LOCK_EX 2
#define LOCK_NB 4
#define LOCK_UN 8

/*
 * Make this as close to original stdio as possible.
 */

/*
 * function prototypes for our own win32io layer
 */
START_EXTERN_C

DllExport  int * 	win32_errno(void);
DllExport  char *** 	win32_environ(void);
DllExport  FILE*	win32_stdin(void);
DllExport  FILE*	win32_stdout(void);
DllExport  FILE*	win32_stderr(void);
DllExport  int		win32_ferror(FILE *fp);
DllExport  int		win32_feof(FILE *fp);
DllExport  char*	win32_strerror(int e);

DllExport  int		win32_fprintf(FILE *pf, const char *format, ...);
DllExport  int		win32_printf(const char *format, ...);
DllExport  int		win32_vfprintf(FILE *pf, const char *format, va_list arg);
DllExport  int		win32_vprintf(const char *format, va_list arg);
DllExport  size_t	win32_fread(void *buf, size_t size, size_t count, FILE *pf);
DllExport  size_t	win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf);
DllExport  FILE*	win32_fopen(const char *path, const char *mode);
DllExport  FILE*	win32_fdopen(int fh, const char *mode);
DllExport  FILE*	win32_freopen(const char *path, const char *mode, FILE *pf);
DllExport  int		win32_fclose(FILE *pf);
DllExport  int		win32_fputs(const char *s,FILE *pf);
DllExport  int		win32_fputc(int c,FILE *pf);
DllExport  int		win32_ungetc(int c,FILE *pf);
DllExport  int		win32_getc(FILE *pf);
DllExport  int		win32_fileno(FILE *pf);
DllExport  void		win32_clearerr(FILE *pf);
DllExport  int		win32_fflush(FILE *pf);
DllExport  Off_t	win32_ftell(FILE *pf);
DllExport  int		win32_fseek(FILE *pf,Off_t offset,int origin);
DllExport  int		win32_fgetpos(FILE *pf,fpos_t *p);
DllExport  int		win32_fsetpos(FILE *pf,const fpos_t *p);
DllExport  void		win32_rewind(FILE *pf);
DllExport  int		win32_tmpfd(void);
DllExport  FILE*	win32_tmpfile(void);
DllExport  void		win32_abort(void);
DllExport  int  	win32_fstat(int fd,Stat_t *sbufptr);
DllExport  int  	win32_stat(const char *name,Stat_t *sbufptr);
DllExport  int		win32_pipe( int *phandles, unsigned int psize, int textmode );
DllExport  PerlIO*	win32_popen( const char *command, const char *mode );
DllExport  PerlIO*	win32_popenlist(const char *mode, IV narg, SV **args);
DllExport  int		win32_pclose( PerlIO *pf);
DllExport  int		win32_rename( const char *oname, const char *newname);
DllExport  int		win32_setmode( int fd, int mode);
DllExport  int		win32_chsize(int fd, Off_t size);
DllExport  Off_t	win32_lseek( int fd, Off_t offset, int origin);
DllExport  Off_t	win32_tell( int fd);
DllExport  int		win32_dup( int fd);
DllExport  int		win32_dup2(int h1, int h2);
DllExport  int		win32_open(const char *path, int oflag,...);
DllExport  int		win32_close(int fd);
DllExport  int		win32_eof(int fd);
DllExport  int		win32_read(int fd, void *buf, unsigned int cnt);
DllExport  int		win32_write(int fd, const void *buf, unsigned int cnt);
DllExport  int		win32_spawnvp(int mode, const char *cmdname,
			      const char *const *argv);
DllExport  int		win32_mkdir(const char *dir, int mode);
DllExport  int		win32_rmdir(const char *dir);
DllExport  int		win32_chdir(const char *dir);
DllExport  int		win32_flock(int fd, int oper);
DllExport  int		win32_execv(const char *cmdname, const char *const *argv);
DllExport  int		win32_execvp(const char *cmdname, const char *const *argv);
DllExport  void		win32_perror(const char *str);
DllExport  void		win32_setbuf(FILE *pf, char *buf);
DllExport  int		win32_setvbuf(FILE *pf, char *buf, int type, size_t size);
DllExport  int		win32_flushall(void);
DllExport  int		win32_fcloseall(void);
DllExport  char*	win32_fgets(char *s, int n, FILE *pf);
DllExport  char*	win32_gets(char *s);
DllExport  int		win32_fgetc(FILE *pf);
DllExport  int		win32_putc(int c, FILE *pf);
DllExport  int		win32_puts(const char *s);
DllExport  int		win32_getchar(void);
DllExport  int		win32_putchar(int c);
DllExport  void*	win32_malloc(size_t size);
DllExport  void*	win32_calloc(size_t numitems, size_t size);
DllExport  void*	win32_realloc(void *block, size_t size);
DllExport  void		win32_free(void *block);

DllExport  int		win32_open_osfhandle(intptr_t handle, int flags);
DllExport  intptr_t	win32_get_osfhandle(int fd);
DllExport  FILE*	win32_fdupopen(FILE *pf);

DllExport  DIR*		win32_opendir(char *filename);
DllExport  struct direct*	win32_readdir(DIR *dirp);
DllExport  long		win32_telldir(DIR *dirp);
DllExport  void		win32_seekdir(DIR *dirp, long loc);
DllExport  void		win32_rewinddir(DIR *dirp);
DllExport  int		win32_closedir(DIR *dirp);

DllExport  char*	win32_getenv(const char *name);
DllExport  int		win32_putenv(const char *name);

DllExport  unsigned 	win32_sleep(unsigned int);
DllExport  int		win32_times(struct tms *timebuf);
DllExport  unsigned 	win32_alarm(unsigned int sec);
DllExport  int		win32_stat(const char *path, Stat_t *buf);
DllExport  char*	win32_longpath(char *path);
DllExport  int		win32_ioctl(int i, unsigned int u, char *data);
DllExport  int          win32_link(const char *oldname, const char *newname);
DllExport  int		win32_unlink(const char *f);
DllExport  int		win32_utime(const char *f, struct utimbuf *t);
DllExport  int		win32_gettimeofday(struct timeval *tp, void *not_used);
DllExport  int		win32_uname(struct utsname *n);
DllExport  int		win32_wait(int *status);
DllExport  int		win32_waitpid(int pid, int *status, int flags);
DllExport  int		win32_kill(int pid, int sig);
DllExport  unsigned long	win32_os_id(void);
DllExport  void*	win32_dynaload(const char*filename);
DllExport  int		win32_access(const char *path, int mode);
DllExport  int		win32_chmod(const char *path, int mode);
DllExport  int		win32_getpid(void);

DllExport char *	win32_crypt(const char *txt, const char *salt);

DllExport void *	win32_get_childenv(void);
DllExport void		win32_free_childenv(void* d);
DllExport void		win32_clearenv(void);
DllExport char *	win32_get_childdir(void);
DllExport void		win32_free_childdir(char* d);
DllExport Sighandler_t	win32_signal(int sig, Sighandler_t subcode);


END_EXTERN_C

#undef alarm
#define alarm			win32_alarm

/*
 * the following six(6) is #define in stdio.h
 */
#ifndef WIN32IO_IS_STDIO
#undef errno
#undef environ
#undef stderr
#undef stdin
#undef stdout
#undef ferror
#undef feof
#undef fclose
#undef pipe
#undef pause
#undef sleep
#undef times
#undef ioctl
#undef unlink
#undef utime
#undef gettimeofday
#undef uname
#undef wait

#ifdef __BORLANDC__
#undef ungetc
#undef getc
#undef putc
#undef getchar
#undef putchar
#endif

#if defined(__MINGW32__) || defined(__BORLANDC__)
#undef fileno
#endif

#define stderr				win32_stderr()
#define stdout				win32_stdout()
#define	stdin				win32_stdin()
#define feof(f)				win32_feof(f)
#define ferror(f)			win32_ferror(f)
#define errno 				(*win32_errno())
#define environ				(*win32_environ())
#define strerror			win32_strerror

/*
 * redirect to our own version
 */
#undef fprintf
#define	fprintf			win32_fprintf
#define	vfprintf		win32_vfprintf
#define	printf			win32_printf
#define	vprintf			win32_vprintf
#define fread(buf,size,count,f)	win32_fread(buf,size,count,f)
#define fwrite(buf,size,count,f)	win32_fwrite(buf,size,count,f)
#define fopen			win32_fopen
#undef fdopen
#define fdopen			win32_fdopen
#define freopen			win32_freopen
#define	fclose(f)		win32_fclose(f)
#define fputs(s,f)		win32_fputs(s,f)
#define fputc(c,f)		win32_fputc(c,f)
#define ungetc(c,f)		win32_ungetc(c,f)
#undef getc
#define getc(f)			win32_getc(f)
#define fileno(f)		win32_fileno(f)
#define clearerr(f)		win32_clearerr(f)
#define fflush(f)		win32_fflush(f)
#define ftell(f)		win32_ftell(f)
#define fseek(f,o,w)		win32_fseek(f,o,w)
#define fgetpos(f,p)		win32_fgetpos(f,p)
#define fsetpos(f,p)		win32_fsetpos(f,p)
#define rewind(f)		win32_rewind(f)
#define tmpfile()		win32_tmpfile()
#define abort()			win32_abort()
#define fstat(fd,bufptr)   	win32_fstat(fd,bufptr)
#define stat(pth,bufptr)   	win32_stat(pth,bufptr)
#define longpath(pth)   	win32_longpath(pth)
#define rename(old,new)		win32_rename(old,new)
#define setmode(fd,mode)	win32_setmode(fd,mode)
#define chsize(fd,sz)		win32_chsize(fd,sz)
#define lseek(fd,offset,orig)	win32_lseek(fd,offset,orig)
#define tell(fd)		win32_tell(fd)
#define dup(fd)			win32_dup(fd)
#define dup2(fd1,fd2)		win32_dup2(fd1,fd2)
#define open			win32_open
#define close(fd)		win32_close(fd)
#define eof(fd)			win32_eof(fd)
#define read(fd,b,s)		win32_read(fd,b,s)
#define write(fd,b,s)		win32_write(fd,b,s)
#define _open_osfhandle		win32_open_osfhandle
#define _get_osfhandle		win32_get_osfhandle
#define spawnvp			win32_spawnvp
#define mkdir			win32_mkdir
#define rmdir			win32_rmdir
#define chdir			win32_chdir
#define flock(fd,o)		win32_flock(fd,o)
#define execv			win32_execv
#define execvp			win32_execvp
#define perror			win32_perror
#define setbuf			win32_setbuf
#define setvbuf			win32_setvbuf
#undef flushall
#define flushall		win32_flushall
#undef fcloseall
#define fcloseall		win32_fcloseall
#define fgets			win32_fgets
#define gets			win32_gets
#define fgetc			win32_fgetc
#undef putc
#define putc			win32_putc
#define puts			win32_puts
#undef getchar
#define getchar			win32_getchar
#undef putchar
#define putchar			win32_putchar
#define access(p,m)		win32_access(p,m)
#define chmod(p,m)		win32_chmod(p,m)


#if !defined(MYMALLOC) || !defined(PERL_CORE)
#undef malloc
#undef calloc
#undef realloc
#undef free
#define malloc			win32_malloc
#define calloc			win32_calloc
#define realloc			win32_realloc
#define free			win32_free
#endif

#define pipe(fd)		win32_pipe((fd), 512, O_BINARY)
#define pause()			win32_sleep((32767L << 16) + 32767)
#define sleep			win32_sleep
#define times			win32_times
#define ioctl			win32_ioctl
#define link			win32_link
#define unlink			win32_unlink
#define utime			win32_utime
#define gettimeofday		win32_gettimeofday
#define uname			win32_uname
#define wait			win32_wait
#define waitpid			win32_waitpid
#define kill			win32_kill

#define opendir			win32_opendir
#define readdir			win32_readdir
#define telldir			win32_telldir
#define seekdir			win32_seekdir
#define rewinddir		win32_rewinddir
#define closedir		win32_closedir
#define os_id			win32_os_id
#define getpid			win32_getpid

#undef crypt
#define crypt(t,s)		win32_crypt(t,s)

#undef get_childenv
#undef free_childenv
#undef clearenv
#undef get_childdir
#undef free_childdir
#define get_childenv()		win32_get_childenv()
#define free_childenv(d)	win32_free_childenv(d)
#define clearenv()		win32_clearenv()
#define get_childdir()		win32_get_childdir()
#define free_childdir(d)	win32_free_childdir(d)

#undef getenv
#define getenv win32_getenv
#undef putenv
#define putenv win32_putenv

#endif /* WIN32IO_IS_STDIO */
#endif /* WIN32IOP_H */

--- NEW FILE: perllib.c ---
/*
 * "The Road goes ever on and on, down from the door where it began."
 */
#define PERLIO_NOT_STDIO 0
#include "EXTERN.h"
#include "perl.h"

#include "XSUB.h"

#ifdef PERL_IMPLICIT_SYS
#include "win32iop.h"
#include <fcntl.h>
#endif /* PERL_IMPLICIT_SYS */


/* Register any extra external extensions */
char *staticlinkmodules[] = {
    "DynaLoader",
    /* other similar records will be included from "perllibst.h" */
#define STATIC1
#include "perllibst.h"
    NULL,
};

EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
/* other similar records will be included from "perllibst.h" */
#define STATIC2
#include "perllibst.h"

static void
xs_init(pTHX)
{
    char *file = __FILE__;
    dXSUB_SYS;
    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
    /* other similar records will be included from "perllibst.h" */
#define STATIC3
#include "perllibst.h"
}

#ifdef PERL_IMPLICIT_SYS

#include "perlhost.h"

void
win32_checkTLS(PerlInterpreter *host_perl)
{
    dTHX;
    if (host_perl != my_perl) {
	int *nowhere = NULL;
        *nowhere = 0; 
	abort();
    }
}

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;
	    pHost->host_perl  = my_perl;
	}
    }
    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;
	}
    }
    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];

    GetModuleFileName(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);

EXTERN_C void
EndSockets(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
	DisableThreadLibraryCalls((HMODULE)hModule);
	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:
        /* As long as we use TerminateProcess()/TerminateThread() etc. for mimicing kill()
           anything here had better be harmless if:
            A. Not called at all.
            B. Called after memory allocation for Heap has been forcibly removed by OS.
            PerlIO_cleanup() was done here but fails (B).
         */     
	EndSockets();
#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
	if (PL_curinterp)
	    FREE_THREAD_KEY;
#endif
	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

--- NEW FILE: genmk95.pl ---
# genmk95.pl - uses miniperl to generate a makefile that command.com will
#              understand given one that cmd.exe will understand

# Author: Benjamin K. Stuhl
# Date: 10-16-1999

# how it works:
#    dmake supports an alternative form for its recipes, called "group
#    recipes", in which all elements of a recipe are run with only one shell.
#    This program converts the standard dmake makefile.mk to one using group
#    recipes. This is done so that lines using && or || (which command.com
#    doesn't understand) may be split into two lines that will still be run
#    with one shell.

my ($filein, $fileout) = @ARGV;

open my $in, $filein or die "Error opening input file: $!\n";
open my $out, "> $fileout" or die "Error opening output file: $!\n";

print $out <<_EOH_;
# *** Warning: this file is autogenerated from $filein by $0 ***
# *** Do not edit this file - edit $filein instead           ***

_HOME_DIR := \$(PWD)

_EOH_

my $inrec = 0;

while (<$in>)
{
 chomp;
 if (/^[^#.\t][^#=]*?:(?:[^=]|$)/)
 {
    if (! $inrec)
    {
       print $out "$_\n";
       while (/\\\s*$/)
       {
          chomp($_ = <$in>);
          print $out "$_\n";
       }
       print $out "@[\n";
       $inrec = 1;
       next;
    }
    else {
       if (!/^\t/) {
           seek ($out, -4, 2);      # no recipe, so back up and undo grouping
                                    # should be -3, but MS has its CR/LF thing...
           $inrec = 0;
       }
       print $out "$_\n";
       next;
    }
 }
 if ((/^\s*$/ || /^[^#.\t][^#=]*?:/) && $inrec)
 {
    print $out "]\n";
    print $out "$_\n";
    $inrec = 0;
    next;
 }
 if (/^(.*?)(&&|\|\|)(.*)$/)  # two commands separated by && or ||
 {
    my ($one, $sep, $two) = ($1, $2, $3);
    $one =~ s/^\t(?:-(?!-))?\@?(.*?)$/\t$1/;   # no -,@ in group recipes
LINE_CONT:
    if ($two =~ /\\\s*$/)
    {
       chomp ($two .= "\n" . scalar <$in>);
       goto LINE_CONT;
    }
    s/^\s*// for ($one, $two);
    print $out "\t$one\n\t$two\n" if ($sep eq "&&");
    print $out "\t$one\n\tif errorlevel 1 $two\n" if ($sep eq "||");
    print $out "\tcd \$(_HOME_DIR)\n";
    next;
 }
     # fall through - no need for special handling
 s/^\t(?:-(?!-))?\@?(.*?)$/\t$1/;      # no -,@ in group recipes
 print $out "$_\n";
}
print $out "]\n" if ($inrec);

close $in or warn "Error closing \$in: $!\n";
close $out or warn "Error closing \$out: $!\n";

--- NEW FILE: makeico.pl ---
binmode STDOUT;
while (<DATA>) {
  chomp;
  print pack "H*", $_;
}

# Create new hex data with
# perl -wle "binmode STDIN; $/ = \32; while (<>) {print unpack 'H*', $_}" <perl.ico.orig
# then place after __DATA__
__DATA__
0000010003001010100001000400280100003600000010100000010008006805
00005e010000101000000100200068040000c606000028000000100000002000
00000100040000000000c000000000000000000000000000000000000000ffff
ff007b000000007b00007b7b000000007b007b007b00007b7b00bdbdbd007b7b
7b00ff00000000ff0000ffff00000000ff00ff00ff0000ffff0000000000ffff
fffffffffffffffffffff7ff8fffffffffffff8fffffffffffffff7fffffffff
ffffff8fffffffffffffff8fffffffffffffff8f7ffffffffffffffff87fffff
fffffffffffffffff8fffffff8ffffffff8ffffffffffffffff8ffff7fffff8f
f8ff8ffffffffffffffff8ffffffffffffffffffffffffffffffffffffffffff
9e5cfbb77420fd9b7865fd9b2074fd5b7320fd5b6e20fd137573f0017072e003
6c65e0032077e4076e20e6076577c30f6720ff9f6520ffff6f6effff6e202800
0000100000002000000001000800000000004001000000000000000000000000
000000000000ffffff00fefefe00d6d6d600aaaaaa00fdfdfd00797979000000
00007a7a7a00fcfcfc004141410075757500848484001e1e1e00cbcbcb00b7b7
b70003030300888888000202020081818100f6f6f60020202000b6b6b6008a8a
8a00040404001a1a1a00e7e7e7000e0e0e00383838006b6b6b0018181800b2b2
b200c1c1c10015151600171717000b0b0b00010101001f1f1f000a0a0a007070
70009b9b9b00e9e9e80078787800111111002323230044444400e2e2e200a6a6
a600656565006a6a6a00b4b4b400afafaf00cfcfcf00080808006c6c6c008f8f
8f00b1b1b100bfbfbf00f1f1f100585858009a9a9a00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffff
ff00ffffff00060606060606060606060606060606060606060606060606060d
06063a060606060606060606060606061c060606060606060606060606060606
030606060606060606060606060606061c060606060606060606060606060606
1c060606060606060606060606060c14090605060606060606060c0c06060606
061406052706060606060606060606060606060c060606060606061b06060606
0606061c06060606060614060b06060606060c060606060606060606060b0606
06060b06060606060906060506060b06060c0606060606060606060606060605
0606060606060606060606060606060606060606060606060606060606060606
060606060606ffff9e5cfbb77420fd9b7865fd9b2074fd5b7320fd5b6e20fd13
7573f0017072e0036c65e0032077e4076e20e6076577c30f6720ff9f6520ffff
6f6effff6e202800000010000000200000000100200000000000400400000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000ff00000070000000010000004ebfbfbf400000000e000000005858
58a7000000650000000000000000000000000000000000000000000000000000
000000000030000000ff0000000100000001080808f76c6c6c93000000000000
0001000000ff0000000000000000000000000000000000000000000000000000
000000000003000000ff000000010000004b000000ffafafaf50000000000000
0001000000ff0000000100000000000000000000000000000000000000000000
000000000001000000ff00000001000000ff000000006a6a6a95000000010000
0001000000ff0000000100000000000000000000000000000000000000000000
000000000001000000ff00000001000000ff000000596565659a000000010000
0001000000ff0000000000000000000000000000000000000000000000000000
000000000017000000ff00000087111111ee232323dc444444bb000000017a7a
7a85000000ff0000001d000000000000000000000000000000010000003e1515
16ea171717e8020202fd0b0b0bf4010101fe000000ff020202fd1f1f1fe00a0a
0af57070708f9b9b9b6400000000000000000000000000000001000000ff0000
00ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff0000
00ff181818e70000004d00000000000000000000000000000001000000ff0e0e
0ef1383838c7000000ff000000ff000000ff000000ff000000ff000000ff0000
00ff6b6b6b940000000000000000000000000000000000000000000000ff2020
20df000000498a8a8a75040404fb000000ff000000ff000000ff000000ff1a1a
1ae5000000180000000000000000000000000000000000000048000000ff0303
03fc0000008a0000000188888877020202fd000000ff000000ff000000ff8181
817e0000000900000000000000000000000000000000414141be000000ff0000
00ff7575758a00000000000000008484847b000000ff000000ff1e1e1ee10000
0034000000000000000000000000000000000000000000000001000000290000
00550000000100000000000000000000000279797986000000ff000000850000
0003000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000ffff9e5cfbb77420fd9b7865fd9b2074fd5b
7320fd5b6e20fd137573f0017072e0036c65e0032077e4076e20e6076577c30f
6720ff9f6520ffff6f6effff6e20

--- NEW FILE: config_H.bc ---
/*
 * This file was produced by running the config_h.SH script, which
 * gets its values from undef, which is generally produced by
 * running Configure.
 *
 * Feel free to modify any of this as the need arises.  Note, however,
 * that running config_h.SH again will wipe out any changes you've made.
 * For a more permanent change edit undef and rerun config_h.SH.
 *
 * $Id: config_H.bc,v 1.2 2006-12-04 17:02:18 dslinux_cayenne Exp $
 */

/*
 * Package name      : perl5
 * Source directory  : 
 * Configuration time: Mon Mar 17 20:15:35 2003
 * Configured by     : gsar
 * Target system     : 
 */
[...4332 lines suppressed...]
 *	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

--- NEW FILE: win32.c ---
/* WIN32.C
 *
 * (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.
 *
 *    You may distribute under the terms of either the GNU General Public
 *    License or the Artistic License, as specified in the README file.
 */
#define PERLIO_NOT_STDIO 0
#define WIN32_LEAN_AND_MEAN
#define WIN32IO_IS_STDIO
#include <tchar.h>
#ifdef __GNUC__
#define Win32_Winsock
#endif
#include <windows.h>
/* GCC-2.95.2/Mingw32-1.1 forgot the WINAPI on CommandLineToArgvW() */
#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)	
[...5223 lines suppressed...]
}

void
win32_argv2utf8(int argc, char** argv)
{
    dTHX;
    char* psz;
    int length, wargc;
    LPWSTR* lpwStr = CommandLineToArgvW(GetCommandLineW(), &wargc);
    if (lpwStr && argc) {
	while (argc--) {
	    length = WideCharToMultiByte(CP_UTF8, 0, lpwStr[--wargc], -1, NULL, 0, NULL, NULL);
	    Newxz(psz, length, char);
	    WideCharToMultiByte(CP_UTF8, 0, lpwStr[wargc], -1, psz, length, NULL, NULL);
	    argv[argc] = psz;
	}
	call_atexit(win32_free_argvw, argv);
    }
    GlobalFree((HGLOBAL)lpwStr);
}

--- NEW FILE: win32.h ---
/* 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 HAS_GETENV_LEN
#  define prime_env_iter()
#  define WIN32IO_IS_STDIO		/* don't pull in custom stdio layer */
#  define WIN32SCK_IS_STDSCK		/* don't pull in custom wsock layer */
#  ifdef PERL_GLOBAL_STRUCT
#    error PERL_GLOBAL_STRUCT cannot be defined with PERL_IMPLICIT_SYS
#  endif
#  define win32_get_privlib PerlEnv_lib_path
#  define win32_get_sitelib PerlEnv_sitelib_path
#  define win32_get_vendorlib PerlEnv_vendorlib_path
#endif

#ifdef __GNUC__
#  ifndef __int64		/* some versions seem to #define it already */
#    define __int64 long long
#  endif
#  define Win32_Winsock
#ifdef __cplusplus
/* Mingw32 gcc -xc++ objects to __attribute((unused)) at least */
#undef  PERL_UNUSED_DECL
#define PERL_UNUSED_DECL
#endif
#endif


/* Define DllExport akin to perl's EXT,
 * If we are in the DLL or mimicing the DLL for Win95 work round
 * then Export the symbol,
 * otherwise import it.
 */

/* now even GCC supports __declspec() */

#if defined(PERLDLL) || defined(WIN95FIX)
#define DllExport
/*#define DllExport __declspec(dllexport)*/	/* noises with VC5+sp3 */
#else
#define DllExport __declspec(dllimport)
#endif

#define  WIN32_LEAN_AND_MEAN
#include <windows.h>

#ifdef   WIN32_LEAN_AND_MEAN		/* C file is NOT a Perl5 original. */
#define  CONTEXT	PERL_CONTEXT	/* Avoid conflict of CONTEXT defs. */
#endif /*WIN32_LEAN_AND_MEAN */

#ifndef TLS_OUT_OF_INDEXES
#define TLS_OUT_OF_INDEXES (DWORD)0xFFFFFFFF
#endif

#include <dirent.h>
#include <io.h>
#include <process.h>
#include <stdio.h>
#include <direct.h>
#include <stdlib.h>
#include <stddef.h>
#include <fcntl.h>
#ifndef EXT
#include "EXTERN.h"
#endif

struct tms {
	long	tms_utime;
	long	tms_stime;
	long	tms_cutime;
	long	tms_cstime;
};

#ifndef SYS_NMLN
#define SYS_NMLN	257
#endif

struct utsname {
    char sysname[SYS_NMLN];
    char nodename[SYS_NMLN];
    char release[SYS_NMLN];
    char version[SYS_NMLN];
    char machine[SYS_NMLN];
};

#ifndef START_EXTERN_C
#undef EXTERN_C
#ifdef __cplusplus
#  define START_EXTERN_C extern "C" {
#  define END_EXTERN_C }
#  define EXTERN_C extern "C"
#else
#  define START_EXTERN_C
#  define END_EXTERN_C
#  define EXTERN_C
#endif
#endif

#define  STANDARD_C	1
#define  DOSISH		1		/* no escaping our roots */
#define  OP_BINARY	O_BINARY	/* mistake in in pp_sys.c? */

/* Define USE_SOCKETS_AS_HANDLES to enable emulation of windows sockets as
 * real filehandles. XXX Should always be defined (the other version is untested) */
#define USE_SOCKETS_AS_HANDLES

/* read() and write() aren't transparent for socket handles */
#define PERL_SOCK_SYSREAD_IS_RECV
#define PERL_SOCK_SYSWRITE_IS_SEND

#define PERL_NO_FORCE_LINK		/* no need for PL_force_link_funcs */

/* Define USE_FIXED_OSFHANDLE to fix MSVCRT's _open_osfhandle() on W95.
   It now uses some black magic to work seamlessly with the DLL CRT and
   works with MSVC++ 4.0+ or GCC/Mingw32
	-- BKS 1-24-2000 */
#if (defined(_M_IX86) && _MSC_VER >= 1000) || defined(__MINGW32__)
#define USE_FIXED_OSFHANDLE
#endif

/* Define PERL_WIN32_SOCK_DLOAD to have Perl dynamically load the winsock
   DLL when needed. Don't use if your compiler supports delayloading (ie, VC++ 6.0)
	-- BKS 5-29-2000 */
#if !(defined(_M_IX86) && _MSC_VER >= 1200)
#define PERL_WIN32_SOCK_DLOAD
#endif
#define ENV_IS_CASELESS

#define PIPESOCK_MODE	"b"		/* pipes, sockets default to binmode */

#ifndef VER_PLATFORM_WIN32_WINDOWS	/* VC-2.0 headers don't have this */
#define VER_PLATFORM_WIN32_WINDOWS	1
#endif

#ifndef FILE_SHARE_DELETE		/* VC-4.0 headers don't have this */
#define FILE_SHARE_DELETE		0x00000004
#endif

/* access() mode bits */
#ifndef R_OK
#  define	R_OK	4
#  define	W_OK	2
#  define	X_OK	1
#  define	F_OK	0
#endif

/* for waitpid() */
#ifndef WNOHANG
#  define WNOHANG	1
#endif

#define PERL_GET_CONTEXT_DEFINED

/* Compiler-specific stuff. */

#ifdef __BORLANDC__		/* Borland C++ */

#if (__BORLANDC__ <= 0x520)
#define _access access
#define _chdir chdir
#endif

#define _getpid getpid
#define wcsicmp _wcsicmp
#include <sys/types.h>

#ifndef DllMain
#define DllMain DllEntryPoint
#endif

#pragma warn -ccc	/* "condition is always true/false" */
#pragma warn -rch	/* "unreachable code" */
#pragma warn -sig	/* "conversion may lose significant digits" */
#pragma warn -pia	/* "possibly incorrect assignment" */
#pragma warn -par	/* "parameter 'foo' is never used" */
#pragma warn -aus	/* "'foo' is assigned a value that is never used" */
#pragma warn -use	/* "'foo' is declared but never used" */
#pragma warn -csu	/* "comparing signed and unsigned values" */

/* Borland C thinks that a pointer to a member variable is 12 bytes in size. */
#define PERL_MEMBER_PTR_SIZE	12

#define isnan		_isnan

#endif

#ifdef _MSC_VER			/* Microsoft Visual C++ */

typedef 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

#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
#define isnan		_isnan	/* ...same libraries as MSVC */

#ifndef _O_NOINHERIT
#  define _O_NOINHERIT	0x0080
#  ifndef _NO_OLDNAMES
#    define O_NOINHERIT	_O_NOINHERIT
#  endif
#endif

/* <stdint.h>, pulled in by <io.h> as of mingw-runtime-3.3, typedef's
 * (u)intptr_t but doesn't set the _(U)INTPTR_T_DEFINED defines */
#ifdef _STDINT_H
#  ifndef _INTPTR_T_DEFINED
#    define _INTPTR_T_DEFINED
#  endif
#  ifndef _UINTPTR_T_DEFINED
#    define _UINTPTR_T_DEFINED
#  endif
#endif

#endif /* __MINGW32__ */

/* both GCC/Mingw32 and MSVC++ 4.0 are missing this, so we put it here */
#ifndef CP_UTF8
#  define CP_UTF8	65001
#endif

/* compatibility stuff for other compilers goes here */

#ifndef _INTPTR_T_DEFINED
typedef int		intptr_t;
#  define _INTPTR_T_DEFINED
#endif

#ifndef _UINTPTR_T_DEFINED
typedef unsigned int	uintptr_t;
#  define _UINTPTR_T_DEFINED
#endif

START_EXTERN_C

/* For UNIX compatibility. */

extern  uid_t	getuid(void);
extern  gid_t	getgid(void);
extern  uid_t	geteuid(void);
extern  gid_t	getegid(void);
extern  int	setuid(uid_t uid);
extern  int	setgid(gid_t gid);
extern  int	kill(int pid, int sig);
#ifndef USE_PERL_SBRK
extern  void	*sbrk(ptrdiff_t need);
#  define HAS_SBRK_PROTO
#endif
extern	char *	getlogin(void);
extern	int	chown(const char *p, uid_t o, gid_t g);
extern  int	mkstemp(const char *path);

#undef	 Stat
#define  Stat		win32_stat

#undef   init_os_extras
#define  init_os_extras Perl_init_os_extras

DllExport void		Perl_win32_init(int *argcp, char ***argvp);
DllExport void		Perl_win32_term(void);
DllExport void		Perl_init_os_extras(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);

#ifndef USE_SOCKETS_AS_HANDLES
extern FILE *		my_fdopen(int, char *);
#endif
extern int		my_fclose(FILE *);
extern int		my_fstat(int fd, Stat_t *sbufptr);
extern char *		win32_get_privlib(const char *pl);
extern char *		win32_get_sitelib(const char *pl);
extern char *		win32_get_vendorlib(const char *pl);
extern int		IsWin95(void);
extern int		IsWinNT(void);
extern void		win32_argv2utf8(int argc, char** argv);

#ifdef PERL_IMPLICIT_SYS
extern void		win32_delete_internal_host(void *h);
#endif

extern char *		staticlinkmodules[];

END_EXTERN_C

typedef  char *		caddr_t;	/* In malloc.c (core address). */

/*
 * handle socket stuff, assuming socket is always available
 */
#include <sys/socket.h>
#include <netdb.h>

#ifdef MYMALLOC
#define EMBEDMYMALLOC	/**/
/* #define USE_PERL_SBRK	/**/
/* #define PERL_SBRK_VIA_MALLOC	/**/
#endif

#if defined(PERLDLL) && !defined(PERL_CORE)
#define PERL_CORE
#endif

#ifdef PERL_TEXTMODE_SCRIPTS
#  define PERL_SCRIPT_MODE		"r"
#else
#  define PERL_SCRIPT_MODE		"rb"
#endif

/*
 * 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;
};

#ifdef USE_5005THREADS
#  ifndef USE_DECLSPEC_THREAD
#    define HAVE_THREAD_INTERN
#  endif /* !USE_DECLSPEC_THREAD */
#endif /* USE_5005THREADS */

#define HAVE_INTERP_INTERN
typedef struct {
    long	num;
    DWORD	pids[MAXIMUM_WAIT_OBJECTS];
    HANDLE	handles[MAXIMUM_WAIT_OBJECTS];
} child_tab;

#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;
#endif
    void *	internal_host;
#ifndef USE_5005THREADS
    struct thread_intern	thr_intern;
#endif
    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)
#ifdef USE_5005THREADS
#  define w32_strerror_buffer	(thr->i.Wstrerror_buffer)
#  define w32_getlogin_buffer	(thr->i.Wgetlogin_buffer)
#  define w32_crypt_buffer	(thr->i.Wcrypt_buffer)
#  define w32_servent		(thr->i.Wservent)
#  define w32_init_socktype	(thr->i.Winit_socktype)
#  define w32_use_showwindow	(thr->i.Wuse_showwindow)
#  define w32_showwindow	(thr->i.Wshowwindow)
#else
#  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)
#endif /* USE_5005THREADS */

/* UNICODE<>ANSI translation helpers */
/* Use CP_ACP when mode is ANSI */
/* Use CP_UTF8 when mode is UTF8 */

#define A2WHELPER_LEN(lpa, alen, lpw, nBytes)\
    (lpw[0] = 0, MultiByteToWideChar((IN_BYTES) ? CP_ACP : CP_UTF8, 0, \
				    lpa, alen, lpw, (nBytes/sizeof(WCHAR))))
#define A2WHELPER(lpa, lpw, nBytes)	A2WHELPER_LEN(lpa, -1, lpw, nBytes)

#define W2AHELPER_LEN(lpw, wlen, lpa, nChars)\
    (lpa[0] = '\0', WideCharToMultiByte((IN_BYTES) ? CP_ACP : CP_UTF8, 0, \
				       lpw, wlen, (LPSTR)lpa, nChars,NULL,NULL))
#define W2AHELPER(lpw, lpa, nChars)	W2AHELPER_LEN(lpw, -1, lpa, nChars)

#define USING_WIDE() (0)

#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()

#endif /* _INC_WIN32_PERL5 */


--- NEW FILE: vmem.h ---
/* 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)
 *
 */
[...1209 lines suppressed...]
			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___ */

--- NEW FILE: config.vc64 ---
## Configured by: ~cf_email~
## Target system: WIN32 
Author=''
Date='$Date'
Header=''
Id='$Id'
Locker=''
Log='$Log'
Mcc='Mcc'
RCSfile='$RCSfile'
Revision='$Revision'
Source=''
State=''
_a='.lib'
_exe='.exe'
_o='.obj'
afs='false'
afsroot='/afs'
alignbytes='8'
[...989 lines suppressed...]
vendorscript=''
vendorscriptexp=''
version='~VERSION~'
version_patchlevel_string=''
versiononly='undef'
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
yacc='yacc'
yaccflags=''
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
PERL_VERSION='~PERL_VERSION~'
PERL_API_REVISION='~PERL_API_REVISION~'
PERL_API_SUBVERSION='~PERL_API_SUBVERSION~'
PERL_API_VERSION='~PERL_API_VERSION~'
PERL_PATCHLEVEL='~PERL_VERSION~'
PERL_CONFIG_SH='true'

--- NEW FILE: buildext.pl ---
=head1 NAME

buildext.pl - build extensions

=head1 SYNOPSIS

    buildext.pl make [-make_opts] dep directory [target] [--static|--dynamic] !ext1 !ext2

E.g.

    buildext.pl nmake -nologo perldll.def ..\ext

    buildext.pl nmake -nologo perldll.def ..\ext clean

    buildext.pl dmake perldll.def ..\ext

    buildext.pl dmake perldll.def ..\ext clean

Will skip building extensions which are marked with an '!' char.
Mostly because they still not ported to specified platform.

If '--static' specified, only static extensions will be built.
If '--dynamic' specified, only dynamic extensions will be built.

--create-perllibst-h
    creates perllibst.h file for inclusion from perllib.c
--list-static-libs:
    prints libraries for static linking and exits

=cut

use Cwd;
use FindExt;
use Config;

# @ARGV with '!' at first position are exclusions
my %excl = map {$_=>1} map {/^!(.*)$/} @ARGV;
@ARGV = grep {!/^!/} @ARGV;

# --static/--dynamic
my %opts = map {$_=>1} map {/^--([\w\-]+)$/} @ARGV;
@ARGV = grep {!/^--([\w\-]+)$/} @ARGV;
my ($static,$dynamic) = ((exists $opts{static}?1:0),(exists $opts{dynamic}?1:0));
if ("$static,$dynamic" eq "0,0") {
  ($static,$dynamic) = (1,1);
}
if ($opts{'list-static-libs'} || $opts{'create-perllibst-h'}) {
  my @statics = split /\s+/, $Config{static_ext};
  if ($opts{'create-perllibst-h'}) {
    open my $fh, ">perllibst.h";
    my @statics1 = map {local $_=$_;s/\//__/g;$_} @statics;
    my @statics2 = map {local $_=$_;s/\//::/g;$_} @statics;
    print $fh "/*DO NOT EDIT\n  this file is included from perllib.c to init static extensions */\n";
    print $fh "#ifdef STATIC1\n",(map {"    \"$_\",\n"} @statics),"#undef STATIC1\n#endif\n";
    print $fh "#ifdef STATIC2\n",(map {"    EXTERN_C void boot_$_ (pTHX_ CV* cv);\n"} @statics1),"#undef STATIC2\n#endif\n";
    print $fh "#ifdef STATIC3\n",(map {"    newXS(\"$statics2[$_]::bootstrap\", boot_$statics1[$_], file);\n"} 0 .. $#statics),"#undef STATIC3\n#endif\n";
  }
  else {
    my %extralibs;
    for (@statics) {
      open my $fh, "<..\\lib\\auto\\$_\\extralibs.ld" or die "can't open <..\\lib\\auto\\$_\\extralibs.ld: $!";
      $extralibs{$_}++ for grep {/\S/} split /\s+/, join '', <$fh>;
    }
    print map {s|/|\\|g;m|([^\\]+)$|;"..\\lib\\auto\\$_\\$1$Config{_a} "} @statics;
    print map {"$_ "} sort keys %extralibs;
  }
  exit;
}

my $here = getcwd();
my $perl = $^X;
$here =~ s,/,\\,g;
if ($perl =~ m#^\.\.#)
 {
  $perl = "$here\\$perl";
 }
(my $topdir = $perl) =~ s/\\[^\\]+$//;
# miniperl needs to find perlglob and pl2bat
$ENV{PATH} = "$topdir;$topdir\\win32\\bin;$ENV{PATH}";
#print "PATH=$ENV{PATH}\n";
my $pl2bat = "$topdir\\win32\\bin\\pl2bat";
unless (-f "$pl2bat.bat") {
    my @args = ($perl, ("$pl2bat.pl") x 2);
    print "@args\n";
    system(@args) unless defined $::Cross::platform;
}
my $make = shift;
$make .= " ".shift while $ARGV[0]=~/^-/;
my $dep  = shift;
my $dmod = -M $dep;
my $dir  = shift;
chdir($dir) || die "Cannot cd to $dir\n";
my $targ  = shift;
(my $ext = getcwd()) =~ s,/,\\,g;
my $code;
FindExt::scan_ext($ext);
FindExt::set_static_extensions(split ' ', $Config{static_ext}) if $ext ne "ext";

my @ext;
push @ext, FindExt::static_ext() if $static;
push @ext, FindExt::dynamic_ext(), FindExt::nonxs_ext() if $dynamic;

foreach $dir (sort @ext)
 {
  if (exists $excl{$dir}) {
    warn "Skipping extension $ext\\$dir, not ported to current platform";
    next;
  }
  if (chdir("$ext\\$dir"))
   {
    my $mmod = -M 'Makefile';
    if (!(-f 'Makefile') || $mmod > $dmod)
     {
      print "\nRunning Makefile.PL in $dir\n";
      my @perl = ($perl, "-I$here\\..\\lib", 'Makefile.PL',
                  'INSTALLDIRS=perl', 'PERL_CORE=1',
		  (FindExt::is_static($dir)
                   ? ('LINKTYPE=static') : ()), # if ext is static
		);
      if (defined $::Cross::platform) {
	@perl = (@perl[0,1],"-MCross=$::Cross::platform", at perl[2..$#perl]);
      }
      print join(' ', @perl), "\n";
      $code = system(@perl);
      warn "$code from $dir\'s Makefile.PL" if $code;
      $mmod = -M 'Makefile';
      if ($mmod > $dmod)
       {
        warn "Makefile $mmod > $dmod ($dep)\n";
       }
     }  
    if ($targ)
     {
      print "Making $targ in $dir\n$make $targ\n";
      $code = system("$make $targ");
      die "Unsuccessful make($dir): code=$code" if $code!=0;
     }
    else
     {
      print "Making $dir\n$make\n";
      $code = system($make);
      die "Unsuccessful make($dir): code=$code" if $code!=0;
     }
    chdir($here) || die "Cannot cd to $here:$!";
   }
  else
   {
    warn "Cannot cd to $ext\\$dir:$!";
   }
 }


--- NEW FILE: config_H.vc ---
/*
 * This file was produced by running the config_h.SH script, which
 * gets its values from undef, which is generally produced by
 * running Configure.
 *
 * Feel free to modify any of this as the need arises.  Note, however,
 * that running config_h.SH again will wipe out any changes you've made.
 * For a more permanent change edit undef and rerun config_h.SH.
 *
 * $Id: config_H.vc,v 1.2 2006-12-04 17:02:18 dslinux_cayenne Exp $
 */

/*
 * Package name      : perl5
 * Source directory  : 
 * Configuration time: Wed Mar 19 16:24:01 2003
 * Configured by     : gsar
 * Target system     : 
 */
[...4332 lines suppressed...]
 *	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

--- NEW FILE: config.bc ---
## Configured by: ~cf_email~
## Target system: WIN32 
Author=''
Date='$Date'
Header=''
Id='$Id'
Locker=''
Log='$Log'
Mcc='Mcc'
RCSfile='$RCSfile'
Revision='$Revision'
Source=''
State=''
_a='.lib'
_exe='.exe'
_o='.obj'
afs='false'
afsroot='/afs'
alignbytes='8'
[...989 lines suppressed...]
vendorscript=''
vendorscriptexp=''
version='~VERSION~'
version_patchlevel_string=''
versiononly='undef'
vi=''
voidflags='15'
xlibpth='/usr/lib/386 /lib/386'
yacc='yacc'
yaccflags=''
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
PERL_VERSION='~PERL_VERSION~'
PERL_API_REVISION='~PERL_API_REVISION~'
PERL_API_SUBVERSION='~PERL_API_SUBVERSION~'
PERL_API_VERSION='~PERL_API_VERSION~'
PERL_PATCHLEVEL='~PERL_VERSION~'
PERL_CONFIG_SH='true'

--- NEW FILE: perlhost.h ---
/* perlhost.h
 *
 * (c) 1999 Microsoft Corporation. All rights reserved.
 * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
 *
 *    You may distribute under the terms of either the GNU General Public
 *    License or the Artistic License, as specified in the README file.
 */

#define CHECK_HOST_INTERP

#ifndef ___PerlHost_H___
#define ___PerlHost_H___

#include <signal.h>
#include "iperlsys.h"
#include "vmem.h"
#include "vdir.h"

[...2389 lines suppressed...]
    dTHX;
    int ret;
    if (!dirname) {
	errno = ENOENT;
	return -1;
    }
    if (USING_WIDE()) {
	WCHAR wBuffer[MAX_PATH];
	A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
	ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
    }
    else
	ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
    if(ret < 0) {
	errno = ENOENT;
    }
    return ret;
}

#endif /* ___PerlHost_H___ */

--- NEW FILE: config_sh.PL ---
use FindExt;
# take a semicolon separated path list and turn it into a quoted
# list of paths that Text::Parsewords will grok
sub mungepath {
    my $p = shift;
    # remove leading/trailing semis/spaces
    $p =~ s/^[ ;]+//;
    $p =~ s/[ ;]+$//;
    $p =~ s/'/"/g;
    my @p = map { $_ = "\"$_\"" if /\s/ and !/^".*"$/; $_ } split /;/, $p;
    return join(' ', @p);
}

# generate an array of option strings from command-line args
# or an option file
#    -- added by BKS, 10-17-1999 to fix command-line overflow problems
sub loadopts {
    if ($ARGV[0] =~ /--cfgsh-option-file/) {
	shift @ARGV;
	my $optfile = shift @ARGV;
	local (*F);
	open OPTF, $optfile or die "Can't open $optfile: $!\n";
	my @opts;
	chomp(my $line = <OPTF>);
	my @vars = split(/\t+~\t+/, $line);
	for (@vars) {
	    push(@opts, $_) unless (/^\s*$/);
	}
	close OPTF;
	return \@opts;
    }
    else {
	return \@ARGV;
    }
}

my %opt;

my $optref = loadopts();
while (@{$optref} && $optref->[0] =~ /^([\w_]+)=(.*)$/) {
    $opt{$1}=$2;
    shift(@{$optref});
}

FindExt::scan_ext("../ext");
FindExt::set_static_extensions(split ' ', $opt{'static_ext'});

my @dynamic_ext = FindExt::dynamic_ext();
my @extensions  = FindExt::extensions();
if (!$opt{'use5005threads'} || $opt{'use5005threads'} eq 'undef')
 {
  @dynamic_ext = grep(!/Thread/, at dynamic_ext);
  @extensions  = grep(!/Thread/, at extensions);
 }
$opt{'nonxs_ext'}        = join(' ',FindExt::nonxs_ext()) || ' ';
$opt{'static_ext'}       = join(' ',FindExt::static_ext()) || ' ';
$opt{'dynamic_ext'}      = join(' ', at dynamic_ext) || ' ';
$opt{'extensions'}       = join(' ', at extensions) || ' ';
$opt{'known_extensions'} = join(' ',FindExt::known_extensions()) || ' ';

my $pl_h = '../patchlevel.h';

if (-e $pl_h) {
    open PL, "<$pl_h" or die "Can't open $pl_h: $!";
    while (<PL>) {
	if (/^#\s*define\s+(PERL_\w+)\s+([\d.]+)/) {
	    $opt{$1} = $2;
	}
    }
    close PL;
}
else {
    die "Can't find $pl_h: $!";
}
$opt{VERSION} = "$opt{PERL_REVISION}.$opt{PERL_VERSION}.$opt{PERL_SUBVERSION}";
$opt{INST_VER} =~ s|~VERSION~|$opt{VERSION}|g;
$opt{'version_patchlevel_string'} = "version $opt{PERL_VERSION} subversion $opt{PERL_SUBVERSION}";
$opt{'version_patchlevel_string'} .= " patchlevel $opt{PERL_PATCHLEVEL}" if exists $opt{PERL_PATCHLEVEL};

$opt{'osvers'} = join '.', (Win32::GetOSVersion())[1,2];

if (exists $opt{cc}) {
    # cl and bcc32 version detection borrowed from Test::Smoke's configsmoke.pl
    if ($opt{cc} eq 'cl') {
        my $output = `cl --version 2>&1`;
        $opt{ccversion} = $output =~ /^.*Version\s+([\d.]+)/ ? $1 : '?';
    }
    elsif ($opt{cc} eq 'bcc32') {
        my $output = `bcc32 --version 2>&1`;
        $opt{ccversion} = $output =~ /([\d.]+)/ ? $1 : '?';
    }
    elsif ($opt{cc} eq 'gcc') {
        chomp($opt{gccversion} = `gcc -dumpversion`);
    }
}

$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};

# some functions are not available on Win9x
if (defined(&Win32::IsWin95) && Win32::IsWin95()) {
    $opt{d_flock} = 'undef';
    $opt{d_link} = 'undef';
}

if ($opt{uselargefiles} ne 'define') {
    $opt{lseeksize} = 4;
    $opt{lseektype} = 'off_t';
}

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;
}

--- NEW FILE: pod.mak ---
CONVERTERS = pod2html pod2latex pod2man pod2text checkpods \
		pod2usage podchecker podselect

HTMLROOT = /	# Change this to fix cross-references in HTML
POD2HTML = pod2html \
	    --htmlroot=$(HTMLROOT) \
	    --podroot=.. --podpath=pod:lib:ext:vms \
	    --libpods=perlfunc:perlguts:perlvar:perlrun:perlop

all: $(CONVERTERS) html

converters: $(CONVERTERS)

PERL = ..\miniperl.exe
REALPERL = ..\perl.exe

POD = \
	perl.pod	\
	perl5004delta.pod	\
	perl5005delta.pod	\
	perl561delta.pod	\
	perl56delta.pod	\
	perl570delta.pod	\
	perl571delta.pod	\
	perl572delta.pod	\
	perl573delta.pod	\
	perl581delta.pod	\
	perl582delta.pod	\
	perl583delta.pod	\
	perl584delta.pod	\
	perl585delta.pod	\
	perl586delta.pod	\
	perl587delta.pod	\
	perl588delta.pod	\
	perl58delta.pod	\
	perlapi.pod	\
	perlapio.pod	\
	perlartistic.pod	\
	perlbook.pod	\
	perlboot.pod	\
	perlbot.pod	\
	perlcall.pod	\
	perlcheat.pod	\
	perlclib.pod	\
	perlcompile.pod	\
	perldata.pod	\
	perldbmfilter.pod	\
	perldebguts.pod	\
	perldebtut.pod	\
	perldebug.pod	\
	perldelta.pod	\
	perldiag.pod	\
	perldoc.pod	\
	perldsc.pod	\
	perlebcdic.pod	\
	perlembed.pod	\
	perlfaq.pod	\
	perlfaq1.pod	\
	perlfaq2.pod	\
	perlfaq3.pod	\
	perlfaq4.pod	\
	perlfaq5.pod	\
	perlfaq6.pod	\
	perlfaq7.pod	\
	perlfaq8.pod	\
	perlfaq9.pod	\
	perlfilter.pod	\
	perlfork.pod	\
	perlform.pod	\
	perlfunc.pod	\
	perlglossary.pod	\
	perlgpl.pod	\
	perlguts.pod	\
	perlhack.pod	\
	perlhist.pod	\
	perlintern.pod	\
	perlintro.pod	\
	perliol.pod	\
	perlipc.pod	\
	perllexwarn.pod	\
	perllocale.pod	\
	perllol.pod	\
	perlmod.pod	\
	perlmodinstall.pod	\
	perlmodlib.pod	\
	perlmodstyle.pod	\
	perlnewmod.pod	\
	perlnumber.pod	\
	perlobj.pod	\
	perlop.pod	\
	perlopentut.pod	\
	perlothrtut.pod	\
	perlpacktut.pod	\
	perlpod.pod	\
	perlpodspec.pod	\
	perlport.pod	\
	perlre.pod	\
	perlref.pod	\
	perlreftut.pod	\
	perlrequick.pod	\
	perlreref.pod	\
	perlretut.pod	\
	perlrun.pod	\
	perlsec.pod	\
	perlstyle.pod	\
	perlsub.pod	\
	perlsyn.pod	\
	perlthrtut.pod	\
	perltie.pod	\
	perltoc.pod	\
	perltodo.pod	\
	perltooc.pod	\
	perltoot.pod	\
	perltrap.pod	\
	perlunicode.pod	\
	perluniintro.pod	\
	perlutil.pod	\
	perlvar.pod	\
	perlxs.pod	\
	perlxstut.pod	

MAN = \
	perl.man	\
	perl5004delta.man	\
	perl5005delta.man	\
	perl561delta.man	\
	perl56delta.man	\
	perl570delta.man	\
	perl571delta.man	\
	perl572delta.man	\
	perl573delta.man	\
	perl581delta.man	\
	perl582delta.man	\
	perl583delta.man	\
	perl584delta.man	\
	perl585delta.man	\
	perl586delta.man	\
	perl587delta.man	\
	perl588delta.man	\
	perl58delta.man	\
	perlapi.man	\
	perlapio.man	\
	perlartistic.man	\
	perlbook.man	\
	perlboot.man	\
	perlbot.man	\
	perlcall.man	\
	perlcheat.man	\
	perlclib.man	\
	perlcompile.man	\
	perldata.man	\
	perldbmfilter.man	\
	perldebguts.man	\
	perldebtut.man	\
	perldebug.man	\
	perldelta.man	\
	perldiag.man	\
	perldoc.man	\
	perldsc.man	\
	perlebcdic.man	\
	perlembed.man	\
	perlfaq.man	\
	perlfaq1.man	\
	perlfaq2.man	\
	perlfaq3.man	\
	perlfaq4.man	\
	perlfaq5.man	\
	perlfaq6.man	\
	perlfaq7.man	\
	perlfaq8.man	\
	perlfaq9.man	\
	perlfilter.man	\
	perlfork.man	\
	perlform.man	\
	perlfunc.man	\
	perlglossary.man	\
	perlgpl.man	\
	perlguts.man	\
	perlhack.man	\
	perlhist.man	\
	perlintern.man	\
	perlintro.man	\
	perliol.man	\
	perlipc.man	\
	perllexwarn.man	\
	perllocale.man	\
	perllol.man	\
	perlmod.man	\
	perlmodinstall.man	\
	perlmodlib.man	\
	perlmodstyle.man	\
	perlnewmod.man	\
	perlnumber.man	\
	perlobj.man	\
	perlop.man	\
	perlopentut.man	\
	perlothrtut.man	\
	perlpacktut.man	\
	perlpod.man	\
	perlpodspec.man	\
	perlport.man	\
	perlre.man	\
	perlref.man	\
	perlreftut.man	\
	perlrequick.man	\
	perlreref.man	\
	perlretut.man	\
	perlrun.man	\
	perlsec.man	\
	perlstyle.man	\
	perlsub.man	\
	perlsyn.man	\
	perlthrtut.man	\
	perltie.man	\
	perltoc.man	\
	perltodo.man	\
	perltooc.man	\
	perltoot.man	\
	perltrap.man	\
	perlunicode.man	\
	perluniintro.man	\
	perlutil.man	\
	perlvar.man	\
	perlxs.man	\
	perlxstut.man	

HTML = \
	perl.html	\
	perl5004delta.html	\
	perl5005delta.html	\
	perl561delta.html	\
	perl56delta.html	\
	perl570delta.html	\
	perl571delta.html	\
	perl572delta.html	\
	perl573delta.html	\
	perl581delta.html	\
	perl582delta.html	\
	perl583delta.html	\
	perl584delta.html	\
	perl585delta.html	\
	perl586delta.html	\
	perl587delta.html	\
	perl588delta.html	\
	perl58delta.html	\
	perlapi.html	\
	perlapio.html	\
	perlartistic.html	\
	perlbook.html	\
	perlboot.html	\
	perlbot.html	\
	perlcall.html	\
	perlcheat.html	\
	perlclib.html	\
	perlcompile.html	\
	perldata.html	\
	perldbmfilter.html	\
	perldebguts.html	\
	perldebtut.html	\
	perldebug.html	\
	perldelta.html	\
	perldiag.html	\
	perldoc.html	\
	perldsc.html	\
	perlebcdic.html	\
	perlembed.html	\
	perlfaq.html	\
	perlfaq1.html	\
	perlfaq2.html	\
	perlfaq3.html	\
	perlfaq4.html	\
	perlfaq5.html	\
	perlfaq6.html	\
	perlfaq7.html	\
	perlfaq8.html	\
	perlfaq9.html	\
	perlfilter.html	\
	perlfork.html	\
	perlform.html	\
	perlfunc.html	\
	perlglossary.html	\
	perlgpl.html	\
	perlguts.html	\
	perlhack.html	\
	perlhist.html	\
	perlintern.html	\
	perlintro.html	\
	perliol.html	\
	perlipc.html	\
	perllexwarn.html	\
	perllocale.html	\
	perllol.html	\
	perlmod.html	\
	perlmodinstall.html	\
	perlmodlib.html	\
	perlmodstyle.html	\
	perlnewmod.html	\
	perlnumber.html	\
	perlobj.html	\
	perlop.html	\
	perlopentut.html	\
	perlothrtut.html	\
	perlpacktut.html	\
	perlpod.html	\
	perlpodspec.html	\
	perlport.html	\
	perlre.html	\
	perlref.html	\
	perlreftut.html	\
	perlrequick.html	\
	perlreref.html	\
	perlretut.html	\
	perlrun.html	\
	perlsec.html	\
	perlstyle.html	\
	perlsub.html	\
	perlsyn.html	\
	perlthrtut.html	\
	perltie.html	\
	perltodo.html	\
	perltooc.html	\
	perltoot.html	\
	perltrap.html	\
	perlunicode.html	\
	perluniintro.html	\
	perlutil.html	\
	perlvar.html	\
	perlxs.html	\
	perlxstut.html	
# not perltoc.html

TEX = \
	perl.tex	\
	perl5004delta.tex	\
	perl5005delta.tex	\
	perl561delta.tex	\
	perl56delta.tex	\
	perl570delta.tex	\
	perl571delta.tex	\
	perl572delta.tex	\
	perl573delta.tex	\
	perl581delta.tex	\
	perl582delta.tex	\
	perl583delta.tex	\
	perl584delta.tex	\
	perl585delta.tex	\
	perl586delta.tex	\
	perl587delta.tex	\
	perl588delta.tex	\
	perl58delta.tex	\
	perlapi.tex	\
	perlapio.tex	\
	perlartistic.tex	\
	perlbook.tex	\
	perlboot.tex	\
	perlbot.tex	\
	perlcall.tex	\
	perlcheat.tex	\
	perlclib.tex	\
	perlcompile.tex	\
	perldata.tex	\
	perldbmfilter.tex	\
	perldebguts.tex	\
	perldebtut.tex	\
	perldebug.tex	\
	perldelta.tex	\
	perldiag.tex	\
	perldoc.tex	\
	perldsc.tex	\
	perlebcdic.tex	\
	perlembed.tex	\
	perlfaq.tex	\
	perlfaq1.tex	\
	perlfaq2.tex	\
	perlfaq3.tex	\
	perlfaq4.tex	\
	perlfaq5.tex	\
	perlfaq6.tex	\
	perlfaq7.tex	\
	perlfaq8.tex	\
	perlfaq9.tex	\
	perlfilter.tex	\
	perlfork.tex	\
	perlform.tex	\
	perlfunc.tex	\
	perlglossary.tex	\
	perlgpl.tex	\
	perlguts.tex	\
	perlhack.tex	\
	perlhist.tex	\
	perlintern.tex	\
	perlintro.tex	\
	perliol.tex	\
	perlipc.tex	\
	perllexwarn.tex	\
	perllocale.tex	\
	perllol.tex	\
	perlmod.tex	\
	perlmodinstall.tex	\
	perlmodlib.tex	\
	perlmodstyle.tex	\
	perlnewmod.tex	\
	perlnumber.tex	\
	perlobj.tex	\
	perlop.tex	\
	perlopentut.tex	\
	perlothrtut.tex	\
	perlpacktut.tex	\
	perlpod.tex	\
	perlpodspec.tex	\
	perlport.tex	\
	perlre.tex	\
	perlref.tex	\
	perlreftut.tex	\
	perlrequick.tex	\
	perlreref.tex	\
	perlretut.tex	\
	perlrun.tex	\
	perlsec.tex	\
	perlstyle.tex	\
	perlsub.tex	\
	perlsyn.tex	\
	perlthrtut.tex	\
	perltie.tex	\
	perltoc.tex	\
	perltodo.tex	\
	perltooc.tex	\
	perltoot.tex	\
	perltrap.tex	\
	perlunicode.tex	\
	perluniintro.tex	\
	perlutil.tex	\
	perlvar.tex	\
	perlxs.tex	\
	perlxstut.tex	

man:	pod2man $(MAN)

html:	pod2html $(HTML)

tex:	pod2latex $(TEX)

toc:
	$(PERL) -I../lib buildtoc >perltoc.pod

.SUFFIXES: .pm .pod

.SUFFIXES: .man

.pm.man:
	$(PERL) -I../lib pod2man $*.pm >$*.man

.pod.man:
	$(PERL) -I../lib pod2man $*.pod >$*.man

.SUFFIXES: .html

.pm.html:
	$(PERL) -I../lib $(POD2HTML) --infile=$*.pm --outfile=$*.html

.pod.html:
	$(PERL) -I../lib $(POD2HTML) --infile=$*.pod --outfile=$*.html

.SUFFIXES: .tex

.pm.tex:
	$(PERL) -I../lib pod2latex $*.pm

.pod.tex:
	$(PERL) -I../lib pod2latex $*.pod

clean:
	rm -f $(MAN)
	rm -f $(HTML)
	rm -f $(TEX)
	rm -f pod2html-*cache
	rm -f *.aux *.log *.exe

realclean:	clean
	rm -f $(CONVERTERS)

distclean:	realclean

check:	checkpods
	@echo "checking..."; \
	$(PERL) -I../lib checkpods $(POD)

# Dependencies.
pod2latex:	pod2latex.PL ../lib/Config.pm
	$(PERL) -I../lib pod2latex.PL

pod2html:	pod2html.PL ../lib/Config.pm
	$(PERL) -I ../lib pod2html.PL

pod2man:	pod2man.PL ../lib/Config.pm
	$(PERL) -I ../lib pod2man.PL

pod2text:	pod2text.PL ../lib/Config.pm
	$(PERL) -I ../lib pod2text.PL

checkpods:	checkpods.PL ../lib/Config.pm
	$(PERL) -I ../lib checkpods.PL

pod2usage:	pod2usage.PL ../lib/Config.pm
	$(PERL) -I ../lib pod2usage.PL

podchecker:	podchecker.PL ../lib/Config.pm
	$(PERL) -I ../lib podchecker.PL

podselect:	podselect.PL ../lib/Config.pm
	$(PERL) -I ../lib podselect.PL

compile: all
	$(REALPERL) -I../lib ../utils/perlcc pod2latex -o pod2latex.exe -v 10 -log ../compilelog
	$(REALPERL) -I../lib ../utils/perlcc pod2man -o pod2man.exe -v 10 -log ../compilelog
	$(REALPERL) -I../lib ../utils/perlcc pod2text -o pod2text.exe -v 10 -log ../compilelog
	$(REALPERL) -I../lib ../utils/perlcc checkpods -o checkpods.exe -v 10 -log ../compilelog

--- NEW FILE: vdir.h ---
/* 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 = GetEnvironmentStrings();
	    char* ptr = szBuffer;
	    for (index = 0; index < driveCount; ++index) {
		if (driveBits & (1<<index)) {
		    ptr += SetDirA(ptr, index) + 1;
		    FromEnvA(pEnv, index);
		}
	    }
	    FreeEnvironmentStrings(pEnv);
	}
	SetDefaultA(".");
	bManageDirectory = nSave;
    }
}

int VDir::SetDirA(char const *pPath, int index)
{
    char chr, *ptr;
    int length = 0;
    WCHAR wBuffer[MAX_PATH+1];
    if (index < driveCount && pPath != NULL) {
	length = strlen(pPath);
	pMem->Free(dirTableA[index]);
	ptr = dirTableA[index] = (char*)pMem->Malloc(length+2);
	if (ptr != NULL) {
	    strcpy(ptr, pPath);
	    ptr += length-1;
	    chr = *ptr++;
	    if (chr != '\\' && chr != '/') {
		*ptr++ = '\\';
		*ptr = '\0';
	    }
	    MultiByteToWideChar(CP_ACP, 0, dirTableA[index], -1,
		    wBuffer, (sizeof(wBuffer)/sizeof(WCHAR)));
	    length = wcslen(wBuffer);
	    pMem->Free(dirTableW[index]);
	    dirTableW[index] = (WCHAR*)pMem->Malloc((length+1)*2);
	    if (dirTableW[index] != NULL) {
		wcscpy(dirTableW[index], wBuffer);
	    }
	}
    }

    if(bManageDirectory)
	::SetCurrentDirectoryA(pPath);

    return length;
}

void VDir::FromEnvA(char *pEnv, int index)
{   /* gets the directory for index from the environment variable. */
    while (*pEnv != '\0') {
	if ((pEnv[0] == '=') && (DriveIndex(pEnv[1]) == index)) {
	    SetDirA(&pEnv[4], index);
	    break;
	}
	else
	    pEnv += strlen(pEnv)+1;
    }
}

void VDir::SetDefaultA(char const *pDefault)
{
    char szBuffer[MAX_PATH+1];
    char *pPtr;

    if (GetFullPathNameA(pDefault, sizeof(szBuffer), szBuffer, &pPtr)) {
        if (*pDefault != '.' && pPtr != NULL)
	    *pPtr = '\0';

	SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0]));
    }
}

int VDir::SetDirW(WCHAR const *pPath, int index)
{
    WCHAR chr, *ptr;
    char szBuffer[MAX_PATH+1];
    int length = 0;
    if (index < driveCount && pPath != NULL) {
	length = wcslen(pPath);
	pMem->Free(dirTableW[index]);
	ptr = dirTableW[index] = (WCHAR*)pMem->Malloc((length+2)*2);
	if (ptr != NULL) {
	    wcscpy(ptr, pPath);
	    ptr += length-1;
	    chr = *ptr++;
	    if (chr != '\\' && chr != '/') {
		*ptr++ = '\\';
		*ptr = '\0';
	    }
	    WideCharToMultiByte(CP_ACP, 0, dirTableW[index], -1, szBuffer, sizeof(szBuffer), NULL, NULL);
	    length = strlen(szBuffer);
	    pMem->Free(dirTableA[index]);
	    dirTableA[index] = (char*)pMem->Malloc(length+1);
	    if (dirTableA[index] != NULL) {
		strcpy(dirTableA[index], szBuffer);
	    }
	}
    }

    if(bManageDirectory)
	::SetCurrentDirectoryW(pPath);

    return length;
}

void VDir::SetDefaultW(WCHAR const *pDefault)
{
    WCHAR szBuffer[MAX_PATH+1];
    WCHAR *pPtr;

    if (GetFullPathNameW(pDefault, (sizeof(szBuffer)/sizeof(WCHAR)), szBuffer, &pPtr)) {
        if (*pDefault != '.' && pPtr != NULL)
	    *pPtr = '\0';

	SetDefaultDirW(szBuffer, DriveIndex((char)szBuffer[0]));
    }
}

inline BOOL IsPathSep(char ch)
{
    return (ch == '\\' || ch == '/');
}

inline void DoGetFullPathNameA(char* lpBuffer, DWORD dwSize, char* Dest)
{
    char *pPtr;

    /*
     * On WinNT GetFullPathName does not fail, (or at least always
     * succeeds when the drive is valid) WinNT does set *Dest to Nullch
     * On Win98 GetFullPathName will set last error if it fails, but
     * does not touch *Dest
     */
    *Dest = '\0';
    GetFullPathNameA(lpBuffer, dwSize, Dest, &pPtr);
}

inline bool IsSpecialFileName(const char* pName)
{
    /* specical file names are devices that the system can open
     * these include AUX, CON, NUL, PRN, COMx, LPTx, CLOCK$, CONIN$, CONOUT$
     * (x is a single digit, and names are case-insensitive)
     */
    char ch = (pName[0] & ~0x20);
    switch (ch)
    {
	case 'A': /* AUX */
	    if (((pName[1] & ~0x20) == 'U')
		&& ((pName[2] & ~0x20) == 'X')
		&& !pName[3])
		    return true;
	    break;
	case 'C': /* CLOCK$, COMx,  CON, CONIN$ CONOUT$ */
	    ch = (pName[1] & ~0x20);
	    switch (ch)
	    {
		case 'L': /* CLOCK$ */
		    if (((pName[2] & ~0x20) == 'O')
			&& ((pName[3] & ~0x20) == 'C')
			&& ((pName[4] & ~0x20) == 'K')
			&& (pName[5] == '$')
			&& !pName[6])
			    return true;
		    break;
		case 'O': /* COMx,  CON, CONIN$ CONOUT$ */
		    if ((pName[2] & ~0x20) == 'M') {
			if ((pName[3] >= '1') && (pName[3] <= '9')
			    && !pName[4])
			    return true;
		    }
		    else if ((pName[2] & ~0x20) == 'N') {
			if (!pName[3])
			    return true;
			else if ((pName[3] & ~0x20) == 'I') {
			    if (((pName[4] & ~0x20) == 'N')
				&& (pName[5] == '$')
				&& !pName[6])
			    return true;
			}
			else if ((pName[3] & ~0x20) == 'O') {
			    if (((pName[4] & ~0x20) == 'U')
				&& ((pName[5] & ~0x20) == 'T')
				&& (pName[6] == '$')
				&& !pName[7])
			    return true;
			}
		    }
		    break;
	    }
	    break;
	case 'L': /* LPTx */
	    if (((pName[1] & ~0x20) == 'U')
		&& ((pName[2] & ~0x20) == 'X')
		&& (pName[3] >= '1') && (pName[3] <= '9')
		&& !pName[4])
		    return true;
	    break;
	case 'N': /* NUL */
	    if (((pName[1] & ~0x20) == 'U')
		&& ((pName[2] & ~0x20) == 'L')
		&& !pName[3])
		    return true;
	    break;
	case 'P': /* PRN */
	    if (((pName[1] & ~0x20) == 'R')
		&& ((pName[2] & ~0x20) == 'N')
		&& !pName[3])
		    return true;
	    break;
    }
    return false;
}

char *VDir::MapPathA(const char *pInName)
{   /*
     * possiblities -- relative path or absolute path with or without drive letter
     * OR UNC name
     */
    char szBuffer[(MAX_PATH+1)*2];
    char szlBuf[MAX_PATH+1];
    int length = strlen(pInName);

    if (!length)
	return (char*)pInName;

    if (length > MAX_PATH) {
	strncpy(szlBuf, pInName, MAX_PATH);
	if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) {   
	    /* absolute path - reduce length by 2 for drive specifier */
	    szlBuf[MAX_PATH-2] = '\0';
	}
	else
	    szlBuf[MAX_PATH] = '\0';
	pInName = szlBuf;
    }
    /* strlen(pInName) is now <= MAX_PATH */

    if (pInName[1] == ':') {
	/* has drive letter */
	if (IsPathSep(pInName[2])) {
	    /* absolute with drive letter */
	    DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA);
	}
	else {
	    /* relative path with drive letter */
	    strcpy(szBuffer, GetDirA(DriveIndex(*pInName)));
	    strcat(szBuffer, &pInName[2]);
	    if(strlen(szBuffer) > MAX_PATH)
		szBuffer[MAX_PATH] = '\0';

	    DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA);
	}
    }
    else {
	/* no drive letter */
	if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
	    /* UNC name */
	    DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA);
	}
	else {
	    strcpy(szBuffer, GetDefaultDirA());
	    if (IsPathSep(pInName[0])) {
		/* absolute path */
		strcpy(&szBuffer[2], pInName);
		DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA);
	    }
	    else {
		/* relative path */
		if (IsSpecialFileName(pInName)) {
		    return (char*)pInName;
		}
		else {
		    strcat(szBuffer, pInName);
		    if (strlen(szBuffer) > MAX_PATH)
			szBuffer[MAX_PATH] = '\0';

		    DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA);
		}
	    }
	}
    }

    return szLocalBufferA;
}

int VDir::SetCurrentDirectoryA(char *lpBuffer)
{
    char *pPtr;
    int length, nRet = -1;

    pPtr = MapPathA(lpBuffer);
    length = strlen(pPtr);
    if(length > 3 && IsPathSep(pPtr[length-1])) {
	/* don't remove the trailing slash from 'x:\'  */
	pPtr[length-1] = '\0';
    }

    DWORD r = GetFileAttributesA(pPtr);
    if ((r != 0xffffffff) && (r & FILE_ATTRIBUTE_DIRECTORY))
    {
	char szBuffer[(MAX_PATH+1)*2];
	DoGetFullPathNameA(pPtr, sizeof(szBuffer), szBuffer);
	SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0]));
	nRet = 0;
    }

    return nRet;
}

DWORD VDir::CalculateEnvironmentSpace(void)
{   /* the current directory environment strings are stored as '=D:=d:\path' */
    int index;
    DWORD dwSize = 0;
    for (index = 0; index < driveCount; ++index) {
	if (dirTableA[index] != NULL) {
	    dwSize += strlen(dirTableA[index]) + 5;  /* add 1 for trailing NULL and 4 for '=D:=' */
	}
    }
    return dwSize;
}

LPSTR VDir::BuildEnvironmentSpace(LPSTR lpStr)
{   /* store the current directory environment strings as '=D:=d:\path' */
    int index, length;
    LPSTR lpDirStr;
    for (index = 0; index < driveCount; ++index) {
	lpDirStr = dirTableA[index];
	if (lpDirStr != NULL) {
	    lpStr[0] = '=';
	    lpStr[1] = lpDirStr[0];
	    lpStr[2] = '\0';
	    CharUpper(&lpStr[1]);
	    lpStr[2] = ':';
	    lpStr[3] = '=';
	    strcpy(&lpStr[4], lpDirStr);
	    length = strlen(lpDirStr);
	    lpStr += length + 5; /* add 1 for trailing NULL and 4 for '=D:=' */
	    if (length > 3 && IsPathSep(lpStr[-2])) {
		lpStr[-2] = '\0';   /* remove the trailing path separator */
		--lpStr;
	    }
	}
    }
    return lpStr;
}

inline BOOL IsPathSep(WCHAR ch)
{
    return (ch == '\\' || ch == '/');
}

inline void DoGetFullPathNameW(WCHAR* lpBuffer, DWORD dwSize, WCHAR* Dest)
{
    WCHAR *pPtr;

    /*
     * On WinNT GetFullPathName does not fail, (or at least always
     * succeeds when the drive is valid) WinNT does set *Dest to Nullch
     * On Win98 GetFullPathName will set last error if it fails, but
     * does not touch *Dest
     */
    *Dest = '\0';
    GetFullPathNameW(lpBuffer, dwSize, Dest, &pPtr);
}

inline bool IsSpecialFileName(const WCHAR* pName)
{
    /* specical file names are devices that the system can open
     * these include AUX, CON, NUL, PRN, COMx, LPTx, CLOCK$, CONIN$, CONOUT$
     * (x is a single digit, and names are case-insensitive)
     */
    WCHAR ch = (pName[0] & ~0x20);
    switch (ch)
    {
	case 'A': /* AUX */
	    if (((pName[1] & ~0x20) == 'U')
		&& ((pName[2] & ~0x20) == 'X')
		&& !pName[3])
		    return true;
	    break;
	case 'C': /* CLOCK$, COMx,  CON, CONIN$ CONOUT$ */
	    ch = (pName[1] & ~0x20);
	    switch (ch)
	    {
		case 'L': /* CLOCK$ */
		    if (((pName[2] & ~0x20) == 'O')
			&& ((pName[3] & ~0x20) == 'C')
			&& ((pName[4] & ~0x20) == 'K')
			&& (pName[5] == '$')
			&& !pName[6])
			    return true;
		    break;
		case 'O': /* COMx,  CON, CONIN$ CONOUT$ */
		    if ((pName[2] & ~0x20) == 'M') {
			if ((pName[3] >= '1') && (pName[3] <= '9')
			    && !pName[4])
			    return true;
		    }
		    else if ((pName[2] & ~0x20) == 'N') {
			if (!pName[3])
			    return true;
			else if ((pName[3] & ~0x20) == 'I') {
			    if (((pName[4] & ~0x20) == 'N')
				&& (pName[5] == '$')
				&& !pName[6])
			    return true;
			}
			else if ((pName[3] & ~0x20) == 'O') {
			    if (((pName[4] & ~0x20) == 'U')
				&& ((pName[5] & ~0x20) == 'T')
				&& (pName[6] == '$')
				&& !pName[7])
			    return true;
			}
		    }
		    break;
	    }
	    break;
	case 'L': /* LPTx */
	    if (((pName[1] & ~0x20) == 'U')
		&& ((pName[2] & ~0x20) == 'X')
		&& (pName[3] >= '1') && (pName[3] <= '9')
		&& !pName[4])
		    return true;
	    break;
	case 'N': /* NUL */
	    if (((pName[1] & ~0x20) == 'U')
		&& ((pName[2] & ~0x20) == 'L')
		&& !pName[3])
		    return true;
	    break;
	case 'P': /* PRN */
	    if (((pName[1] & ~0x20) == 'R')
		&& ((pName[2] & ~0x20) == 'N')
		&& !pName[3])
		    return true;
	    break;
    }
    return false;
}

WCHAR* VDir::MapPathW(const WCHAR *pInName)
{   /*
     * possiblities -- relative path or absolute path with or without drive letter
     * OR UNC name
     */
    WCHAR szBuffer[(MAX_PATH+1)*2];
    WCHAR szlBuf[MAX_PATH+1];
    int length = wcslen(pInName);

    if (!length)
	return (WCHAR*)pInName;

    if (length > MAX_PATH) {
	wcsncpy(szlBuf, pInName, MAX_PATH);
	if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) {   
	    /* absolute path - reduce length by 2 for drive specifier */
	    szlBuf[MAX_PATH-2] = '\0';
	}
	else
	    szlBuf[MAX_PATH] = '\0';
	pInName = szlBuf;
    }
    /* strlen(pInName) is now <= MAX_PATH */

    if (pInName[1] == ':') {
	/* has drive letter */
	if (IsPathSep(pInName[2])) {
	    /* absolute with drive letter */
	    DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
	}
	else {
	    /* relative path with drive letter */
	    wcscpy(szBuffer, GetDirW(DriveIndex((char)*pInName)));
	    wcscat(szBuffer, &pInName[2]);
	    if(wcslen(szBuffer) > MAX_PATH)
		szBuffer[MAX_PATH] = '\0';

	    DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
	}
    }
    else {
	/* no drive letter */
	if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
	    /* UNC name */
	    DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
	}
	else {
	    wcscpy(szBuffer, GetDefaultDirW());
	    if (IsPathSep(pInName[0])) {
		/* absolute path */
		wcscpy(&szBuffer[2], pInName);
		DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
	    }
	    else {
		/* relative path */
		if (IsSpecialFileName(pInName)) {
		    return (WCHAR*)pInName;
		}
		else {
		    wcscat(szBuffer, pInName);
		    if (wcslen(szBuffer) > MAX_PATH)
			szBuffer[MAX_PATH] = '\0';

		    DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
		}
	    }
	}
    }
    return szLocalBufferW;
}

int VDir::SetCurrentDirectoryW(WCHAR *lpBuffer)
{
    WCHAR *pPtr;
    int length, nRet = -1;

    pPtr = MapPathW(lpBuffer);
    length = wcslen(pPtr);
    if(length > 3 && IsPathSep(pPtr[length-1])) {
	/* don't remove the trailing slash from 'x:\'  */
	pPtr[length-1] = '\0';
    }

    DWORD r = GetFileAttributesW(pPtr);
    if ((r != 0xffffffff) && (r & FILE_ATTRIBUTE_DIRECTORY))
    {
	WCHAR wBuffer[(MAX_PATH+1)*2];
	DoGetFullPathNameW(pPtr, (sizeof(wBuffer)/sizeof(WCHAR)), wBuffer);
	SetDefaultDirW(wBuffer, DriveIndex((char)wBuffer[0]));
	nRet = 0;
    }

    return nRet;
}

#endif	/* ___VDir_H___ */

--- NEW FILE: FindExt.pm ---
package FindExt;

our $VERSION = '1.01';

use strict;
use warnings;

my $no = join('|',qw(GDBM_File ODBM_File NDBM_File DB_File
		     Syslog SysV Langinfo));
$no = qr/^(?:$no)$/i;

my %ext;
my $ext;
my %static;

sub getcwd {
    $ENV{'PWD'} = Win32::GetCwd();
    $ENV{'PWD'} =~ s:\\:/:g ;
    return $ENV{'PWD'};
}

sub set_static_extensions
{
    # adjust results of scan_ext, and also save
    # statics in case scan_ext hasn't been called yet.
    %static = ();
    for (@_) {
        $static{$_} = 1;
        $ext{$_} = 'static' if $ext{$_} && $ext{$_} eq 'dynamic';
    }
}

sub scan_ext
{
 my $here = getcwd();
 my $dir  = shift;
 chdir($dir) || die "Cannot cd to $dir\n";
 ($ext = getcwd()) =~ s,/,\\,g;
 find_ext('');
 chdir($here) || die "Cannot cd to $here\n";
 my @ext = extensions();
}

sub dynamic_ext
{
 return sort grep $ext{$_} eq 'dynamic',keys %ext;
}

sub static_ext
{
 return sort grep $ext{$_} eq 'static',keys %ext;
}

sub nonxs_ext
{
 return sort grep $ext{$_} eq 'nonxs',keys %ext;
}

sub extensions
{
 return sort grep $ext{$_} ne 'known',keys %ext;
}

sub known_extensions
{
 # faithfully copy Configure in not including nonxs extensions for the nonce
 return sort grep $ext{$_} ne 'nonxs',keys %ext;
}

sub is_static
{
 return $ext{$_[0]} eq 'static'
}

# Function to recursively find available extensions, ignoring DynaLoader
# NOTE: recursion limit of 10 to prevent runaway in case of symlink madness
sub find_ext
{
    opendir my $dh, '.';
    my @items = grep { !/^\.\.?$/ } readdir $dh;
    closedir $dh;
    for my $xxx (@items) {
        if ($xxx ne "DynaLoader") {
            if (-f "$xxx/$xxx.xs") {
                $ext{"$_[0]$xxx"} = $static{"$_[0]$xxx"} ? 'static' : 'dynamic';
            } elsif (-f "$xxx/Makefile.PL") {
                $ext{"$_[0]$xxx"} = 'nonxs';
            } else {
                if (-d $xxx && @_ < 10) {
                    chdir $xxx;
                    find_ext("$_[0]$xxx/", @_);
                    chdir "..";
                }
            }
            $ext{"$_[0]$xxx"} = 'known' if $ext{"$_[0]$xxx"} && $xxx =~ $no;
        }
    }

# Special case:  Add in threads/shared since it is not picked up by the
# recursive find above (and adding in general recursive finding breaks
# SDBM_File/sdbm).  A.D.  10/25/2001.

    if (!$_[0] && -d "threads/shared") {
        $ext{"threads/shared"} = 'dynamic';
    }
}

1;

--- NEW FILE: config_h.PL ---
#
BEGIN { warn "Running ".__FILE__."\n" };
BEGIN 
 {
  require "../lib/Config.pm";
  die "../Config.pm:$@" if $@;
  Config::->import;
 }
use File::Compare qw(compare);
use File::Copy qw(copy);
my $name = $0;
$name =~ s#^(.*)\.PL$#../$1.SH#;
my %opt;
while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
 {
  $opt{$1}=$2;
  shift(@ARGV);
 }

$opt{CONFIG_H} ||= 'config.h';

warn "Writing $opt{CONFIG_H}\n";

my $patchlevel = $opt{INST_VER};
$patchlevel =~ s|^[\\/]||;
$patchlevel =~ s|~VERSION~|$Config{version}|g;
$patchlevel ||= $Config{version};
$patchlevel = qq["$patchlevel"];

open(SH,"<$name") || die "Cannot open $name:$!";
while (<SH>)
 {
  last if /^sed/;
 }
($term,$file,$pat) = /^sed\s+<<(\S+)\s+>(\S+)\s+(.*)$/;

$file =~ s/^\$(\w+)$/$opt{$1}/g;

my $str = "sub munge\n{\n";

while ($pat =~ s/-e\s+'([^']*)'\s*//)
 {
  my $e = $1;
  $e =~ s/\\([\(\)])/$1/g;
  $e =~ s/\\(\d)/\$$1/g; 
  $str .= "$e;\n";
 }
$str .= "}\n";

eval $str;

die "$str:$@" if $@;

open(H,">$file.new") || die "Cannot open $file.new:$!";
#binmode H;		# no CRs (which cause a spurious rebuild)
while (<SH>)
 {
  last if /^$term$/o;
  s/\$([\w_]+)/Config($1)/eg;
  s/`([^\`]*)`/BackTick($1)/eg;
  munge();
  s/\\\$/\$/g;
  s#/[ *\*]*\*/#/**/#;
  if (/^\s*#define\s+(PRIVLIB|SITELIB|VENDORLIB)_EXP/)
   {
     $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "($patchlevel))\t/**/\n";
   }
  # incpush() handles archlibs, so disable them
  elsif (/^\s*#define\s+(ARCHLIB|SITEARCH|VENDORARCH)_EXP/)
   {
     $_ = "/*#define ". $1 . "_EXP \"\"\t/**/\n";
   }
  print H;
 }
close(H);
close(SH);


chmod(0666,"../lib/CORE/config.h");
copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!";
chmod(0444,"../lib/CORE/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;
}

--- NEW FILE: distclean.bat ---
@perl -w -Sx %0 %*
@goto end_of_perl
#!perl -w
BEGIN { push(@INC,'lib') }
use strict;
use File::Find;
use ExtUtils::Manifest qw(maniread);
my $files = maniread();
my %files;
foreach (keys %$files)
 {
  $files{lc($_)} = $files->{$_};
 } 

my @dead;
find(sub { 
 return if -d $_;
 my $name = $File::Find::name;
 $name =~ s#^\./##;
 unless (exists $files{lc($name)})
  {
   # print "new $name\n";
   push(@dead,$name);
  } 
},'.');

foreach my $file (@dead)
 {
  chmod(0666,$file) unless -w $file;
  unlink($file) || warn "Cannot delete $file:$!";
 }

__END__
:end_of_perl
del perl.exe
del perl*.dll
--- NEW FILE: splittree.pl ---
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];

--- NEW FILE: runperl.c ---
#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);
}



--- NEW FILE: config_H.vc64 ---
/*
 * This file was produced by running the config_h.SH script, which
 * gets its values from undef, which is generally produced by
 * running Configure.
 *
 * Feel free to modify any of this as the need arises.  Note, however,
 * that running config_h.SH again will wipe out any changes you've made.
 * For a more permanent change edit undef and rerun config_h.SH.
 *
 * $Id: config_H.vc64,v 1.1 2006-12-04 17:02:18 dslinux_cayenne Exp $
 */

/*
 * Package name      : perl5
 * Source directory  : 
 * Configuration time: Wed Mar 19 16:24:01 2003
 * Configured by     : gsar
 * Target system     : 
 */
[...4332 lines suppressed...]
 *	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

--- NEW FILE: win32io.c ---
#define PERL_NO_GET_CONTEXT
#define WIN32_LEAN_AND_MEAN
#define WIN32IO_IS_STDIO
#include <tchar.h>
#ifdef __GNUC__
#define Win32_Winsock
#endif
#include <windows.h>

#include <sys/stat.h>
#include "EXTERN.h"
#include "perl.h"

#ifdef PERLIO_LAYERS

#include "perliol.h"

#define NO_XSLOCKS
#include "XSUB.h"


/* Bottom-most level for Win32 case */

typedef struct
{
 struct _PerlIO base;       /* The generic part */
 HANDLE		h;          /* OS level handle */
 IV		refcnt;     /* REFCNT for the "fd" this represents */
 int		fd;         /* UNIX like file descriptor - index into fdtable */
} PerlIOWin32;

PerlIOWin32 *fdtable[256];
IV max_open_fd = -1;

IV
PerlIOWin32_popped(pTHX_ PerlIO *f)
{
 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
 if (--s->refcnt > 0)
  {
   *f = PerlIOBase(f)->next;
   return 1;
  }
 fdtable[s->fd] = NULL;
 return 0;
}

IV
PerlIOWin32_fileno(pTHX_ PerlIO *f)
{
 return PerlIOSelf(f,PerlIOWin32)->fd;
}

IV
PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
{
 IV code = PerlIOBase_pushed(aTHX_ f,mode,arg,tab);
 if (*PerlIONext(f))
  {
   PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
   s->fd     = PerlIO_fileno(PerlIONext(f));
  }
 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
 return code;
}

PerlIO *
PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
{
 const char *tmode = mode;
 HANDLE h = INVALID_HANDLE_VALUE;
 if (f)
  {
   /* Close if already open */
   if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
    (*PerlIOBase(f)->tab->Close)(aTHX_ f);
  }
 if (narg > 0)
  {
   char *path = SvPV_nolen(*args);
   DWORD  access = 0;
   DWORD  share  = 0;
   DWORD  create = -1;
   DWORD  attr   = FILE_ATTRIBUTE_NORMAL;
   if (*mode == '#')
    {
     /* sysopen - imode is UNIX-like O_RDONLY etc.
        - do_open has converted that back to string form in mode as well
        - perm is UNIX like permissions
      */
     mode++;
    }
   else
    {
     /* Normal open - decode mode string */
    }
   switch(*mode)
    {
     case 'r':
      access  = GENERIC_READ;
      create  = OPEN_EXISTING;
      if (*++mode == '+')
       {
        access |= GENERIC_WRITE;
        create  = OPEN_ALWAYS;
        mode++;
       }
      break;

     case 'w':
      access  = GENERIC_WRITE;
      create  = TRUNCATE_EXISTING;
      if (*++mode == '+')
       {
        access |= GENERIC_READ;
        mode++;
       }
      break;

     case 'a':
      access = GENERIC_WRITE;
      create  = OPEN_ALWAYS;
      if (*++mode == '+')
       {
        access |= GENERIC_READ;
        mode++;
       }
      break;
    }
   if (*mode == 'b')
    {
     mode++;
    }
   else if (*mode == 't')
    {
     mode++;
    }
   if (*mode || create == -1)
    {
     SETERRNO(EINVAL,LIB$_INVARG);
     return NULL;
    }
   if (!(access & GENERIC_WRITE))
    share = FILE_SHARE_READ;
   h = CreateFile(path,access,share,NULL,create,attr,NULL);
   if (h == INVALID_HANDLE_VALUE)
    {
     if (create == TRUNCATE_EXISTING)
      h = CreateFile(path,access,share,NULL,(create = OPEN_ALWAYS),attr,NULL);
    }
  }
 else
  {
   /* fd open */
   h = INVALID_HANDLE_VALUE;
   if (fd >= 0 && fd <= max_open_fd)
    {
     PerlIOWin32 *s = fdtable[fd];
     if (s)
      {
       s->refcnt++;
       if (!f)
        f = PerlIO_allocate(aTHX);
       *f = &s->base;
       return f;
      }
    }
   if (*mode == 'I')
    {
     mode++;
     switch(fd)
      {
       case 0:
        h = GetStdHandle(STD_INPUT_HANDLE);
        break;
       case 1:
        h = GetStdHandle(STD_OUTPUT_HANDLE);
        break;
       case 2:
        h = GetStdHandle(STD_ERROR_HANDLE);
        break;
      }
    }
  }
 if (h != INVALID_HANDLE_VALUE)
  fd = win32_open_osfhandle((intptr_t) h, PerlIOUnix_oflags(tmode));
 if (fd >= 0)
  {
   PerlIOWin32 *s;
   if (!f)
    f = PerlIO_allocate(aTHX);
   s = PerlIOSelf(PerlIO_push(aTHX_ f,self,tmode,PerlIOArg),PerlIOWin32);
   s->h      = h;
   s->fd     = fd;
   s->refcnt = 1;
   if (fd >= 0)
    {
     fdtable[fd] = s;
     if (fd > max_open_fd)
      max_open_fd = fd;
    }
   return f;
  }
 if (f)
  {
   /* FIXME: pop layers ??? */
  }
 return NULL;
}

SSize_t
PerlIOWin32_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
 DWORD len;
 if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
  return 0;
 if (ReadFile(s->h,vbuf,count,&len,NULL))
  {
   return len;
  }
 else
  {
   if (GetLastError() != NO_ERROR)
    {
     PerlIOBase(f)->flags |= PERLIO_F_ERROR;
     return -1;
    }
   else
    {
     if (count != 0)
      PerlIOBase(f)->flags |= PERLIO_F_EOF;
     return 0;
    }
  }
}

SSize_t
PerlIOWin32_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
 DWORD len;
 if (WriteFile(s->h,vbuf,count,&len,NULL))
  {
   return len;
  }
 else
  {
   PerlIOBase(f)->flags |= PERLIO_F_ERROR;
   return -1;
  }
}

IV
PerlIOWin32_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
{
 static const DWORD where[3] = { FILE_BEGIN, FILE_CURRENT, FILE_END };
 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
 DWORD high = (sizeof(offset) > sizeof(DWORD)) ? (DWORD)(offset >> 32) : 0;
 DWORD low  = (DWORD) offset;
 DWORD res  = SetFilePointer(s->h,(LONG)low,(LONG *)&high,where[whence]);
 if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
  {
   return 0;
  }
 else
  {
   return -1;
  }
}

Off_t
PerlIOWin32_tell(pTHX_ PerlIO *f)
{
 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
 DWORD high = 0;
 DWORD res  = SetFilePointer(s->h,0,(LONG *)&high,FILE_CURRENT);
 if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
  {
   return ((Off_t) high << 32) | res;
  }
 return (Off_t) -1;
}

IV
PerlIOWin32_close(pTHX_ PerlIO *f)
{
 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
 if (s->refcnt == 1)
  {
   IV code = 0;	
#if 0
   /* This does not do pipes etc. correctly */	
   if (!CloseHandle(s->h))
    {
     s->h = INVALID_HANDLE_VALUE;
     return -1;
    }
#else
    PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
    return win32_close(s->fd);
#endif
  }
 return 0;
}

PerlIO *
PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags)
{
 PerlIOWin32 *os = PerlIOSelf(f,PerlIOWin32);
 HANDLE proc = GetCurrentProcess();
 HANDLE new;
 if (DuplicateHandle(proc, os->h, proc, &new, 0, FALSE,  DUPLICATE_SAME_ACCESS))
  {
   char mode[8];
   int fd = win32_open_osfhandle((intptr_t) new, PerlIOUnix_oflags(PerlIO_modestr(o,mode)));
   if (fd >= 0)
    {
     f = PerlIOBase_dup(aTHX_ f, o, params, flags);
     if (f)
      {
       PerlIOWin32 *fs = PerlIOSelf(f,PerlIOWin32);
       fs->h  = new;
       fs->fd = fd;
       fs->refcnt = 1;
       fdtable[fd] = fs;
       if (fd > max_open_fd)
        max_open_fd = fd;
      }
     else
      {
       win32_close(fd);
      }
    }
   else
    {
     CloseHandle(new);
    }
  }
 return f;
}

PerlIO_funcs PerlIO_win32 = {
 sizeof(PerlIO_funcs),
 "win32",
 sizeof(PerlIOWin32),
 PERLIO_K_RAW,
 PerlIOWin32_pushed,
 PerlIOWin32_popped,
 PerlIOWin32_open,
 PerlIOBase_binmode,
 NULL,                 /* getarg */
 PerlIOWin32_fileno,
 PerlIOWin32_dup,
 PerlIOWin32_read,
 PerlIOBase_unread,
 PerlIOWin32_write,
 PerlIOWin32_seek,
 PerlIOWin32_tell,
 PerlIOWin32_close,
 PerlIOBase_noop_ok,   /* flush */
 PerlIOBase_noop_fail, /* fill */
 PerlIOBase_eof,
 PerlIOBase_error,
 PerlIOBase_clearerr,
 PerlIOBase_setlinebuf,
 NULL, /* get_base */
 NULL, /* get_bufsiz */
 NULL, /* get_ptr */
 NULL, /* get_cnt */
 NULL, /* set_ptrcnt */
};

#endif


--- NEW FILE: win32sck.c ---
/* win32sck.c
 *
 * (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.
 *
 *    You may distribute under the terms of either the GNU General Public
 *    License or the Artistic License, as specified in the README file.
 */

#define WIN32IO_IS_STDIO
#define WIN32SCK_IS_STDSCK
#define WIN32_LEAN_AND_MEAN
#define PERLIO_NOT_STDIO 0
#ifdef __GNUC__
#define Win32_Winsock
#endif
#include <windows.h>
#include <ws2spi.h>

#include "EXTERN.h"
#include "perl.h"

#include "Win32iop.h"
#include <sys/socket.h>
#include <fcntl.h>
#include <sys/stat.h>
#include <assert.h>
#include <io.h>

/* thanks to Beverly Brown	(beverly at datacube.com) */
#ifdef USE_SOCKETS_AS_HANDLES
#	define OPEN_SOCKET(x)	win32_open_osfhandle(x,O_RDWR|O_BINARY)
#	define TO_SOCKET(x)	_get_osfhandle(x)
#else
#	define OPEN_SOCKET(x)	(x)
#	define TO_SOCKET(x)	(x)
#endif	/* USE_SOCKETS_AS_HANDLES */

#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
#define StartSockets() \
    STMT_START {					\
	if (!wsock_started)				\
	    start_sockets();				\
	set_socktype();                                 \
    } STMT_END
#else
#define StartSockets() \
    STMT_START {					\
	if (!wsock_started) {				\
	    start_sockets();				\
	    set_socktype();				\
	}						\
    } STMT_END
#endif

#define SOCKET_TEST(x, y) \
    STMT_START {					\
	StartSockets();					\
	if((x) == (y))					\
	    errno = WSAGetLastError();			\
    } STMT_END

#define SOCKET_TEST_ERROR(x) SOCKET_TEST(x, SOCKET_ERROR)

static struct servent* win32_savecopyservent(struct servent*d,
                                             struct servent*s,
                                             const char *proto);

static int wsock_started = 0;

EXTERN_C void
EndSockets(void)
{
    if (wsock_started)
	WSACleanup();
}

void
start_sockets(void) 
{
    dTHX;
    unsigned short version;
    WSADATA retdata;
    int ret;

    /*
     * initalize the winsock interface and insure that it is
     * cleaned up at exit.
     */
    version = 0x2;
    if(ret = WSAStartup(version, &retdata))
	Perl_croak_nocontext("Unable to locate winsock library!\n");
    if(retdata.wVersion != version)
	Perl_croak_nocontext("Could not find version 2.0 of winsock dll\n");

    /* atexit((void (*)(void)) EndSockets); */
    wsock_started = 1;
}

void
set_socktype(void)
{
#ifdef USE_SOCKETS_AS_HANDLES
#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
    dTHX;
    if (!w32_init_socktype) {
	w32_init_socktype = 1;
    }
#endif
#endif	/* USE_SOCKETS_AS_HANDLES */
}


#ifndef USE_SOCKETS_AS_HANDLES
#undef fdopen
FILE *
my_fdopen(int fd, char *mode)
{
    FILE *fp;
    char sockbuf[256];
    int optlen = sizeof(sockbuf);
    int retval;

    if (!wsock_started)
	return(fdopen(fd, mode));

    retval = getsockopt((SOCKET)fd, SOL_SOCKET, SO_TYPE, sockbuf, &optlen);
    if(retval == SOCKET_ERROR && WSAGetLastError() == WSAENOTSOCK) {
	return(fdopen(fd, mode));
    }

    /*
     * If we get here, then fd is actually a socket.
     */
    Newxz(fp, 1, FILE);	/* XXX leak, good thing this code isn't used */
    if(fp == NULL) {
	errno = ENOMEM;
	return NULL;
    }

    fp->_file = fd;
    if(*mode == 'r')
	fp->_flag = _IOREAD;
    else
	fp->_flag = _IOWRT;
   
    return fp;
}
#endif	/* USE_SOCKETS_AS_HANDLES */


u_long
win32_htonl(u_long hostlong)
{
    StartSockets();
    return htonl(hostlong);
}

u_short
win32_htons(u_short hostshort)
{
    StartSockets();
    return htons(hostshort);
}

u_long
win32_ntohl(u_long netlong)
{
    StartSockets();
    return ntohl(netlong);
}

u_short
win32_ntohs(u_short netshort)
{
    StartSockets();
    return ntohs(netshort);
}



SOCKET
win32_accept(SOCKET s, struct sockaddr *addr, int *addrlen)
{
    SOCKET r;

    SOCKET_TEST((r = accept(TO_SOCKET(s), addr, addrlen)), INVALID_SOCKET);
    return OPEN_SOCKET(r);
}

int
win32_bind(SOCKET s, const struct sockaddr *addr, int addrlen)
{
    int r;

    SOCKET_TEST_ERROR(r = bind(TO_SOCKET(s), addr, addrlen));
    return r;
}

int
win32_connect(SOCKET s, const struct sockaddr *addr, int addrlen)
{
    int r;

    SOCKET_TEST_ERROR(r = connect(TO_SOCKET(s), addr, addrlen));
    return r;
}


int
win32_getpeername(SOCKET s, struct sockaddr *addr, int *addrlen)
{
    int r;

    SOCKET_TEST_ERROR(r = getpeername(TO_SOCKET(s), addr, addrlen));
    return r;
}

int
win32_getsockname(SOCKET s, struct sockaddr *addr, int *addrlen)
{
    int r;

    SOCKET_TEST_ERROR(r = getsockname(TO_SOCKET(s), addr, addrlen));
    return r;
}

int
win32_getsockopt(SOCKET s, int level, int optname, char *optval, int *optlen)
{
    int r;

    SOCKET_TEST_ERROR(r = getsockopt(TO_SOCKET(s), level, optname, optval, optlen));
    return r;
}

int
win32_ioctlsocket(SOCKET s, long cmd, u_long *argp)
{
    int r;

    SOCKET_TEST_ERROR(r = ioctlsocket(TO_SOCKET(s), cmd, argp));
    return r;
}

int
win32_listen(SOCKET s, int backlog)
{
    int r;

    SOCKET_TEST_ERROR(r = listen(TO_SOCKET(s), backlog));
    return r;
}

int
win32_recv(SOCKET s, char *buf, int len, int flags)
{
    int r;

    SOCKET_TEST_ERROR(r = recv(TO_SOCKET(s), buf, len, flags));
    return r;
}

int
win32_recvfrom(SOCKET s, char *buf, int len, int flags, struct sockaddr *from, int *fromlen)
{
    int r;
    int frombufsize = *fromlen;

    SOCKET_TEST_ERROR(r = recvfrom(TO_SOCKET(s), buf, len, flags, from, fromlen));
    /* Winsock's recvfrom() only returns a valid 'from' when the socket
     * is connectionless.  Perl expects a valid 'from' for all types
     * of sockets, so go the extra mile.
     */
    if (r != SOCKET_ERROR && frombufsize == *fromlen)
	(void)win32_getpeername(s, from, fromlen);
    return r;
}

/* select contributed by Vincent R. Slyngstad (vrs at ibeam.intel.com) */
int
win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, const struct timeval* timeout)
{
    int r;
#ifdef USE_SOCKETS_AS_HANDLES
    Perl_fd_set dummy;
    int i, fd, save_errno = errno;
    FD_SET nrd, nwr, nex, *prd, *pwr, *pex;

    /* winsock seems incapable of dealing with all three null fd_sets,
     * so do the (millisecond) sleep as a special case
     */
    if (!(rd || wr || ex)) {
	if (timeout)
	    Sleep(timeout->tv_sec  * 1000 +
		  timeout->tv_usec / 1000);	/* do the best we can */
	else
	    Sleep(UINT_MAX);
	return 0;
    }
    StartSockets();
    PERL_FD_ZERO(&dummy);
    if (!rd)
	rd = &dummy, prd = NULL;
    else
	prd = &nrd;
    if (!wr)
	wr = &dummy, pwr = NULL;
    else
	pwr = &nwr;
    if (!ex)
	ex = &dummy, pex = NULL;
    else
	pex = &nex;

    FD_ZERO(&nrd);
    FD_ZERO(&nwr);
    FD_ZERO(&nex);
    for (i = 0; i < nfds; i++) {
	fd = TO_SOCKET(i);
	if (PERL_FD_ISSET(i,rd))
	    FD_SET((unsigned)fd, &nrd);
	if (PERL_FD_ISSET(i,wr))
	    FD_SET((unsigned)fd, &nwr);
	if (PERL_FD_ISSET(i,ex))
	    FD_SET((unsigned)fd, &nex);
    }

    errno = save_errno;
    SOCKET_TEST_ERROR(r = select(nfds, prd, pwr, pex, timeout));
    save_errno = errno;

    for (i = 0; i < nfds; i++) {
	fd = TO_SOCKET(i);
	if (PERL_FD_ISSET(i,rd) && !FD_ISSET(fd, &nrd))
	    PERL_FD_CLR(i,rd);
	if (PERL_FD_ISSET(i,wr) && !FD_ISSET(fd, &nwr))
	    PERL_FD_CLR(i,wr);
	if (PERL_FD_ISSET(i,ex) && !FD_ISSET(fd, &nex))
	    PERL_FD_CLR(i,ex);
    }
    errno = save_errno;
#else
    SOCKET_TEST_ERROR(r = select(nfds, rd, wr, ex, timeout));
#endif
    return r;
}

int
win32_send(SOCKET s, const char *buf, int len, int flags)
{
    int r;

    SOCKET_TEST_ERROR(r = send(TO_SOCKET(s), buf, len, flags));
    return r;
}

int
win32_sendto(SOCKET s, const char *buf, int len, int flags,
	     const struct sockaddr *to, int tolen)
{
    int r;

    SOCKET_TEST_ERROR(r = sendto(TO_SOCKET(s), buf, len, flags, to, tolen));
    return r;
}

int
win32_setsockopt(SOCKET s, int level, int optname, const char *optval, int optlen)
{
    int r;

    SOCKET_TEST_ERROR(r = setsockopt(TO_SOCKET(s), level, optname, optval, optlen));
    return r;
}
    
int
win32_shutdown(SOCKET s, int how)
{
    int r;

    SOCKET_TEST_ERROR(r = shutdown(TO_SOCKET(s), how));
    return r;
}

int
win32_closesocket(SOCKET s)
{
    int r;

    SOCKET_TEST_ERROR(r = closesocket(TO_SOCKET(s)));
    return r;
}

#ifdef USE_SOCKETS_AS_HANDLES
#define WIN32_OPEN_SOCKET(af, type, protocol) open_ifs_socket(af, type, protocol)

void
convert_proto_info_w2a(WSAPROTOCOL_INFOW *in, WSAPROTOCOL_INFOA *out)
{
    Copy(in, out, 1, WSAPROTOCOL_INFOA);
    wcstombs(out->szProtocol, in->szProtocol, sizeof(out->szProtocol));
}

SOCKET
open_ifs_socket(int af, int type, int protocol)
{
    dTHX;
    char *s;
    unsigned long proto_buffers_len = 0;
    int error_code;
    SOCKET out = INVALID_SOCKET;

    if ((s = PerlEnv_getenv("PERL_ALLOW_NON_IFS_LSP")) && atoi(s))
        return WSASocket(af, type, protocol, NULL, 0, 0);

    if (WSCEnumProtocols(NULL, NULL, &proto_buffers_len, &error_code) == SOCKET_ERROR
        && error_code == WSAENOBUFS)
    {
	WSAPROTOCOL_INFOW *proto_buffers;
        int protocols_available = 0;       
 
        Newx(proto_buffers, proto_buffers_len / sizeof(WSAPROTOCOL_INFOW),
            WSAPROTOCOL_INFOW);

        if ((protocols_available = WSCEnumProtocols(NULL, proto_buffers, 
            &proto_buffers_len, &error_code)) != SOCKET_ERROR)
        {
            int i;
            for (i = 0; i < protocols_available; i++)
            {
                WSAPROTOCOL_INFOA proto_info;

                if ((af != AF_UNSPEC && af != proto_buffers[i].iAddressFamily)
                    || (type != proto_buffers[i].iSocketType)
                    || (protocol != 0 && proto_buffers[i].iProtocol != 0 &&
                        protocol != proto_buffers[i].iProtocol))
                    continue;

                if ((proto_buffers[i].dwServiceFlags1 & XP1_IFS_HANDLES) == 0)
                    continue;

                convert_proto_info_w2a(&(proto_buffers[i]), &proto_info);

                out = WSASocket(af, type, protocol, &proto_info, 0, 0);
                break;
            }
        }

        Safefree(proto_buffers);
    }

    return out;
}

#else
#define WIN32_OPEN_SOCKET(af, type, protocol) socket(af, type, protocol)
#endif

SOCKET
win32_socket(int af, int type, int protocol)
{
    SOCKET s;

#ifndef USE_SOCKETS_AS_HANDLES
    SOCKET_TEST(s = socket(af, type, protocol), INVALID_SOCKET);
#else
    StartSockets();

    if((s = WIN32_OPEN_SOCKET(af, type, protocol)) == INVALID_SOCKET)
	errno = WSAGetLastError();
    else
	s = OPEN_SOCKET(s);
#endif	/* USE_SOCKETS_AS_HANDLES */

    return s;
}

/*
 * close RTL fd while respecting sockets
 * added as temporary measure until PerlIO has real
 * Win32 native layer
 *   -- BKS, 11-11-2000
*/

int my_close(int fd)
{
    int osf;
    if (!wsock_started)		/* No WinSock? */
	return(close(fd));	/* Then not a socket. */
    osf = TO_SOCKET(fd);/* Get it now before it's gone! */
    if (osf != -1) {
	int err;
	err = closesocket(osf);
	if (err == 0) {
#if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
            _set_osfhnd(fd, INVALID_HANDLE_VALUE);
#endif
	    (void)close(fd);	/* handle already closed, ignore error */
	    return 0;
	}
	else if (err == SOCKET_ERROR) {
	    err = WSAGetLastError();
	    if (err != WSAENOTSOCK) {
		(void)close(fd);
		errno = err;
		return EOF;
	    }
	}
    }
    return close(fd);
}

#undef fclose
int
my_fclose (FILE *pf)
{
    int osf;
    if (!wsock_started)		/* No WinSock? */
	return(fclose(pf));	/* Then not a socket. */
    osf = TO_SOCKET(win32_fileno(pf));/* Get it now before it's gone! */
    if (osf != -1) {
	int err;
	win32_fflush(pf);
	err = closesocket(osf);
	if (err == 0) {
#if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
            _set_osfhnd(win32_fileno(pf), INVALID_HANDLE_VALUE);
#endif
	    (void)fclose(pf);	/* handle already closed, ignore error */
	    return 0;
	}
	else if (err == SOCKET_ERROR) {
	    err = WSAGetLastError();
	    if (err != WSAENOTSOCK) {
		(void)fclose(pf);
		errno = err;
		return EOF;
	    }
	}
    }
    return fclose(pf);
}

#undef fstat
int
my_fstat(int fd, Stat_t *sbufptr)
{
    /* This fixes a bug in fstat() on Windows 9x.  fstat() uses the
     * GetFileType() win32 syscall, which will fail on Windows 9x.
     * So if we recognize a socket on Windows 9x, we return the
     * same results as on Windows NT/2000.
     * XXX this should be extended further to set S_IFSOCK on
     * sbufptr->st_mode.
     */
    int osf;
    if (!wsock_started || IsWinNT()) {
#if defined(WIN64) || defined(USE_LARGE_FILES)
#if defined(__BORLANDC__) /* buk */
	return win32_fstat(fd, sbufptr );
#else
	return _fstati64(fd, sbufptr);
#endif
#else
	return fstat(fd, sbufptr);
#endif
    }

    osf = TO_SOCKET(fd);
    if (osf != -1) {
	char sockbuf[256];
	int optlen = sizeof(sockbuf);
	int retval;

	retval = getsockopt((SOCKET)osf, SOL_SOCKET, SO_TYPE, sockbuf, &optlen);
	if (retval != SOCKET_ERROR || WSAGetLastError() != WSAENOTSOCK) {
#if defined(__BORLANDC__)&&(__BORLANDC__<=0x520)
	    sbufptr->st_mode = S_IFIFO;
#else
	    sbufptr->st_mode = _S_IFIFO;
#endif
	    sbufptr->st_rdev = sbufptr->st_dev = (dev_t)fd;
	    sbufptr->st_nlink = 1;
	    sbufptr->st_uid = sbufptr->st_gid = sbufptr->st_ino = 0;
	    sbufptr->st_atime = sbufptr->st_mtime = sbufptr->st_ctime = 0;
	    sbufptr->st_size = (Off_t)0;
	    return 0;
	}
    }
#if defined(WIN64) || defined(USE_LARGE_FILES)
#if defined(__BORLANDC__) /* buk */
    return win32_fstat(fd, sbufptr );
#else
    return _fstati64(fd, sbufptr);
#endif
#else
    return fstat(fd, sbufptr);
#endif
}

struct hostent *
win32_gethostbyaddr(const char *addr, int len, int type)
{
    struct hostent *r;

    SOCKET_TEST(r = gethostbyaddr(addr, len, type), NULL);
    return r;
}

struct hostent *
win32_gethostbyname(const char *name)
{
    struct hostent *r;

    SOCKET_TEST(r = gethostbyname(name), NULL);
    return r;
}

int
win32_gethostname(char *name, int len)
{
    int r;

    SOCKET_TEST_ERROR(r = gethostname(name, len));
    return r;
}

struct protoent *
win32_getprotobyname(const char *name)
{
    struct protoent *r;

    SOCKET_TEST(r = getprotobyname(name), NULL);
    return r;
}

struct protoent *
win32_getprotobynumber(int num)
{
    struct protoent *r;

    SOCKET_TEST(r = getprotobynumber(num), NULL);
    return r;
}

struct servent *
win32_getservbyname(const char *name, const char *proto)
{
    dTHX;    
    struct servent *r;

    SOCKET_TEST(r = getservbyname(name, proto), NULL);
    if (r) {
	r = win32_savecopyservent(&w32_servent, r, proto);
    }
    return r;
}

struct servent *
win32_getservbyport(int port, const char *proto)
{
    dTHX; 
    struct servent *r;

    SOCKET_TEST(r = getservbyport(port, proto), NULL);
    if (r) {
	r = win32_savecopyservent(&w32_servent, r, proto);
    }
    return r;
}

int
win32_ioctl(int i, unsigned int u, char *data)
{
    dTHX;
    u_long argp = (u_long)data;
    int retval;

    if (!wsock_started) {
	Perl_croak_nocontext("ioctl implemented only on sockets");
	/* NOTREACHED */
    }

    retval = ioctlsocket(TO_SOCKET(i), (long)u, &argp);
    if (retval == SOCKET_ERROR) {
	if (WSAGetLastError() == WSAENOTSOCK) {
	    Perl_croak_nocontext("ioctl implemented only on sockets");
	    /* NOTREACHED */
	}
	errno = WSAGetLastError();
    }
    return retval;
}

char FAR *
win32_inet_ntoa(struct in_addr in)
{
    StartSockets();
    return inet_ntoa(in);
}

unsigned long
win32_inet_addr(const char FAR *cp)
{
    StartSockets();
    return inet_addr(cp);
}

/*
 * Networking stubs
 */

void
win32_endhostent() 
{
    dTHX;
    Perl_croak_nocontext("endhostent not implemented!\n");
}

void
win32_endnetent()
{
    dTHX;
    Perl_croak_nocontext("endnetent not implemented!\n");
}

void
win32_endprotoent()
{
    dTHX;
    Perl_croak_nocontext("endprotoent not implemented!\n");
}

void
win32_endservent()
{
    dTHX;
    Perl_croak_nocontext("endservent not implemented!\n");
}


struct netent *
win32_getnetent(void) 
{
    dTHX;
    Perl_croak_nocontext("getnetent not implemented!\n");
    return (struct netent *) NULL;
}

struct netent *
win32_getnetbyname(char *name) 
{
    dTHX;
    Perl_croak_nocontext("getnetbyname not implemented!\n");
    return (struct netent *)NULL;
}

struct netent *
win32_getnetbyaddr(long net, int type) 
{
    dTHX;
    Perl_croak_nocontext("getnetbyaddr not implemented!\n");
    return (struct netent *)NULL;
}

struct protoent *
win32_getprotoent(void) 
{
    dTHX;
    Perl_croak_nocontext("getprotoent not implemented!\n");
    return (struct protoent *) NULL;
}

struct servent *
win32_getservent(void) 
{
    dTHX;
    Perl_croak_nocontext("getservent not implemented!\n");
    return (struct servent *) NULL;
}

void
win32_sethostent(int stayopen)
{
    dTHX;
    Perl_croak_nocontext("sethostent not implemented!\n");
}


void
win32_setnetent(int stayopen)
{
    dTHX;
    Perl_croak_nocontext("setnetent not implemented!\n");
}


void
win32_setprotoent(int stayopen)
{
    dTHX;
    Perl_croak_nocontext("setprotoent not implemented!\n");
}


void
win32_setservent(int stayopen)
{
    dTHX;
    Perl_croak_nocontext("setservent not implemented!\n");
}

static struct servent*
win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
{
    d->s_name = s->s_name;
    d->s_aliases = s->s_aliases;
    d->s_port = s->s_port;
#ifndef __BORLANDC__	/* Buggy on Win95 and WinNT-with-Borland-WSOCK */
    if (!IsWin95() && s->s_proto && strlen(s->s_proto))
	d->s_proto = s->s_proto;
    else
#endif
    if (proto && strlen(proto))
	d->s_proto = (char *)proto;
    else
	d->s_proto = "tcp";
   
    return d;
}



--- NEW FILE: win32thread.h ---
#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 = CreateSemaphore(NULL,0,LONG_MAX,NULL);	\
	if ((c)->sem == NULL)					\
	    Perl_croak_nocontext("panic: COND_INIT (%ld)",GetLastError());	\
    } STMT_END

#define COND_SIGNAL(c) \
    STMT_START {						\
	if ((c)->waiters > 0 &&					\
	    ReleaseSemaphore((c)->sem,1,NULL) == 0)		\
	    Perl_croak_nocontext("panic: COND_SIGNAL (%ld)",GetLastError());	\
    } STMT_END

#define COND_BROADCAST(c) \
    STMT_START {						\
	if ((c)->waiters > 0 &&					\
	    ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0)	\
	    Perl_croak_nocontext("panic: COND_BROADCAST (%ld)",GetLastError());\
    } STMT_END

#define COND_WAIT(c, m) \
    STMT_START {						\
	(c)->waiters++;						\
	MUTEX_UNLOCK(m);					\
	/* Note that there's no race here, since a		\
	 * COND_BROADCAST() on another thread will have seen the\
	 * right number of waiters (i.e. including this one) */	\
	if (WaitForSingleObject((c)->sem,INFINITE)==WAIT_FAILED)\
	    Perl_croak_nocontext("panic: COND_WAIT (%ld)",GetLastError());	\
	/* XXX there may be an inconsequential race here */	\
	MUTEX_LOCK(m);						\
	(c)->waiters--;						\
    } STMT_END

#define COND_DESTROY(c) \
    STMT_START {						\
	(c)->waiters = 0;					\
	if (CloseHandle((c)->sem) == 0)				\
	    Perl_croak_nocontext("panic: COND_DESTROY (%ld)",GetLastError());	\
    } STMT_END

#define DETACH(t) \
    STMT_START {						\
	if (CloseHandle((t)->self) == 0) {			\
	    MUTEX_UNLOCK(&(t)->mutex);				\
	    Perl_croak_nocontext("panic: DETACH");		\
	}							\
    } STMT_END


#define THREAD_CREATE(t, f)	Perl_thread_create(t, f)
#define THREAD_POST_CREATE(t)	NOOP

/* XXX Docs mention that the RTL versions of thread creation routines
 * should be used, but that advice only seems applicable when the RTL
 * is not in a DLL.  RTL DLLs in both Borland and VC seem to do all of
 * the init/deinit required upon DLL_THREAD_ATTACH/DETACH.  So we seem
 * to be completely safe using straight Win32 API calls, rather than
 * the much braindamaged RTL calls.
 *
 * _beginthread() in the RTLs call CloseHandle() just after the thread
 * function returns, which means: 1) we have a race on our hands
 * 2) it is impossible to implement join() semantics.
 *
 * IOW, do *NOT* turn on USE_RTL_THREAD_API!  It is here
 * for experimental purposes only. GSAR 98-01-02
 */
#ifdef USE_RTL_THREAD_API
#  include <process.h>
#  if defined(__BORLANDC__)
     /* Borland RTL doesn't allow a return value from thread function! */
#    define THREAD_RET_TYPE	void _USERENTRY
#    define THREAD_RET_CAST(p)	((void)(thr->i.retv = (void *)(p)))
#  elif defined (_MSC_VER)
#    define THREAD_RET_TYPE	unsigned __stdcall
#    define THREAD_RET_CAST(p)	((unsigned)(p))
#  else
     /* CRTDLL.DLL doesn't allow a return value from thread function! */
#    define THREAD_RET_TYPE	void __cdecl
#    define THREAD_RET_CAST(p)	((void)(thr->i.retv = (void *)(p)))
#  endif
#else	/* !USE_RTL_THREAD_API */
#  define THREAD_RET_TYPE	DWORD WINAPI
#  define THREAD_RET_CAST(p)	((DWORD)(p))
#endif	/* !USE_RTL_THREAD_API */

typedef THREAD_RET_TYPE thread_func_t(void *);


START_EXTERN_C

#if defined(PERLDLL) && defined(USE_DECLSPEC_THREAD) && (!defined(__BORLANDC__) || defined(_DLL))
extern __declspec(thread) void *PL_current_context;
#define PERL_SET_CONTEXT(t)   		(PL_current_context = t)
#define PERL_GET_CONTEXT		PL_current_context
#else
#define PERL_GET_CONTEXT		Perl_get_context()
#define PERL_SET_CONTEXT(t)		Perl_set_context(t)
#endif

#if defined(USE_5005THREADS)
struct perl_thread;
int Perl_thread_create (struct perl_thread *thr, thread_func_t *fn);
void Perl_set_thread_self (struct perl_thread *thr);
void Perl_init_thread_intern (struct perl_thread *t);

#define SET_THREAD_SELF(thr) Perl_set_thread_self(thr)

#endif /* USE_5005THREADS */

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 */


--- NEW FILE: win32thread.c ---
#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_5005THREADS) || 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_5005THREADS) || 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
}

#ifdef USE_5005THREADS
void
Perl_init_thread_intern(struct perl_thread *athr)
{
#ifndef USE_DECLSPEC_THREAD

 /* 
  * Initialize port-specific per-thread data in thr->i
  * as only things we have there are just static areas for
  * return values we don't _need_ to do anything but 
  * this is good practice:
  */
 memset(&athr->i,0,sizeof(athr->i));

#endif
}

void
Perl_set_thread_self(struct perl_thread *thr)
{
    /* Set thr->self.  GetCurrentThread() retrurns a pseudo handle, need
       this to convert it into a handle another thread can use.
     */
    DuplicateHandle(GetCurrentProcess(),
		    GetCurrentThread(),
		    GetCurrentProcess(),
		    &thr->self,
		    0,
		    FALSE,
		    DUPLICATE_SAME_ACCESS);
}

int
Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
{
    DWORD junk;
    unsigned long th;

    DEBUG_S(PerlIO_printf(Perl_debug_log,
			  "%p: create OS thread\n", thr));
#ifdef USE_RTL_THREAD_API
    /* See comment about USE_RTL_THREAD_API in win32thread.h */
#if defined(__BORLANDC__)
    th = _beginthreadNT(fn,				/* start address */
			0,				/* stack size */
			(void *)thr,			/* parameters */
			(void *)NULL,			/* security attrib */
			0,				/* creation flags */
			(unsigned long *)&junk);	/* tid */
    if (th == (unsigned long)-1)
	th = 0;
#elif defined(_MSC_VER_)
    th = _beginthreadex((void *)NULL,			/* security attrib */
			0,				/* stack size */
			fn,				/* start address */
			(void*)thr,			/* parameters */
			0,				/* creation flags */
			(unsigned *)&junk);		/* tid */
#else /* compilers using CRTDLL.DLL only have _beginthread() */
    th = _beginthread(fn,				/* start address */
		      0,				/* stack size */
		      (void*)thr);			/* parameters */
    if (th == (unsigned long)-1)
	th = 0;
#endif
    thr->self = (HANDLE)th;
#else	/* !USE_RTL_THREAD_API */
    thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk);
#endif	/* !USE_RTL_THREAD_API */
    DEBUG_S(PerlIO_printf(Perl_debug_log,
			  "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk));
    return thr->self ? 0 : -1;
}
#endif


--- NEW FILE: perlexe.rc ---
PERLEXE	    ICON    perlexe.ico




More information about the dslinux-commit mailing list