diff options
Diffstat (limited to 'win32')
| -rw-r--r-- | win32/Makefile | 32 | ||||
| -rw-r--r-- | win32/config.bc | 8 | ||||
| -rw-r--r-- | win32/config.vc | 6 | ||||
| -rw-r--r-- | win32/config_H.bc | 2 | ||||
| -rw-r--r-- | win32/config_H.vc | 2 | ||||
| -rw-r--r-- | win32/makedef.pl | 60 | ||||
| -rw-r--r-- | win32/makefile.mk | 32 | ||||
| -rw-r--r-- | win32/win32.c | 84 | ||||
| -rw-r--r-- | win32/win32.h | 30 | ||||
| -rw-r--r-- | win32/win32io.c | 24 | ||||
| -rw-r--r-- | win32/win32io.h | 10 | ||||
| -rw-r--r-- | win32/win32iop.h | 24 | ||||
| -rw-r--r-- | win32/win32sck.c | 7 | ||||
| -rw-r--r-- | win32/win32thread.c | 31 | ||||
| -rw-r--r-- | win32/win32thread.h | 94 |
15 files changed, 331 insertions, 115 deletions
diff --git a/win32/Makefile b/win32/Makefile index 19dce90ab9..3e26dfc38f 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -11,6 +11,8 @@ # newly built perl. INST_DRV=c: INST_TOP=$(INST_DRV)\perl +BUILDOPT=-DUSE_THREADS -TP +CORECCOPT= # # uncomment next line if you are using Visual C++ 2.x @@ -49,8 +51,8 @@ RUNTIME = -MD !ENDIF INCLUDES = -I.\include -I. -I.. #PCHFLAGS = -Fp"$(INTDIR)/modules.pch" -YX -DEFINES = -DWIN32 -D_CONSOLE -DUSE_THREADS -D_WIN32_WINNT=0x400 -LOCDEFS = -DPERLDLL +DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) +LOCDEFS = -DPERLDLL $(CORECCOPT) SUBSYS = console !IF "$(RUNTIME)" == "-MD" @@ -84,7 +86,7 @@ LIBFILES = oldnames.lib kernel32.lib user32.lib gdi32.lib \ version.lib odbc32.lib odbccp32.lib CFLAGS = -nologo -W3 $(INCLUDES) $(DEFINES) $(LOCDEFS) $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:I386 +LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:$(PROCESSOR_ARCHITECTURE) OBJOUT_FLAG = -Fo #################### do not edit below this line ####################### @@ -196,11 +198,13 @@ CORE_OBJ= ..\av.obj \ WIN32_C = perllib.c \ win32.c \ win32io.c \ - win32sck.c + win32sck.c \ + win32thread.c WIN32_OBJ = win32.obj \ win32io.obj \ - win32sck.obj + win32sck.obj \ + win32thread.obj PERL95_OBJ = perl95.obj \ win32mt.obj \ @@ -269,7 +273,7 @@ DYNALOADMODULES= \ $(OPCODE_DLL) \ $(SDBM_FILE_DLL)\ $(IO_DLL) \ - $(ATTRS_DLL) \ + $(ATTRS_DLL) \ $(THREAD_DLL) POD2HTML=$(PODDIR)\pod2html @@ -300,9 +304,10 @@ perlglob.obj : perlglob.c config.w32 : $(CFGSH_TMPL) copy $(CFGSH_TMPL) config.w32 -.\config.h : $(CFGSH_TMPL) +.\config.h : $(CFGH_TMPL) -del /f config.h copy $(CFGH_TMPL) config.h + ..\config.sh : config.w32 $(MINIPERL) config_sh.PL $(MINIPERL) -I..\lib config_sh.PL "INST_DRV=$(INST_DRV)" \ @@ -330,7 +335,7 @@ $(CORE_OBJ) : $(CORE_H) $(DLL_OBJ) : $(CORE_H) perldll.def : $(MINIPERL) $(CONFIGPM) - $(MINIPERL) -w makedef.pl $(CCTYPE) > perldll.def + $(MINIPERL) -w makedef.pl $(DEFINES) $(CCTYPE) > perldll.def $(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) $(LINK32) -dll -def:perldll.def -out:$@ @<< @@ -357,8 +362,8 @@ $(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain.obj del perl.exe copy splittree.pl .. $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" - attrib -r ..\t\*.* - copy test ..\t +# attrib -r ..\t\*.* +# copy test ..\t perl95.c : runperl.c copy runperl.c perl95.c @@ -391,19 +396,20 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs -$(THREAD_DLL): $(PERLEXE) $(THREAD).xs +$(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl $(MAKE) cd ..\..\win32 -$(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs +$(THREAD_DLL): $(PERLEXE) $(THREAD).xs cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl $(MAKE) cd ..\..\win32 -$(IO_DLL): $(PERLEXE) $(IO).xs + +$(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl $(MAKE) diff --git a/win32/config.bc b/win32/config.bc index ad76309e5d..3933c2789c 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -59,7 +59,7 @@ byteorder='1234' c='' castflags='0' cat='type' -cccdlflags='' +cccdlflags=' ' ccdlflags=' ' cf_by='garyng' cf_email='71564.1743@compuserve.com' @@ -83,7 +83,7 @@ cryptlib='' csh='undef' d_Gconvert='gcvt((x),(n),(b))' d_access='define' -d_alarm='undef' +d_alarm='define' d_archlib='define' d_attribut='undef' d_bcmp='undef' @@ -362,7 +362,7 @@ ksh='' large='' ld='tlink32' lddlflags='-Tpd' -ldflags='' +ldflags='~LINK_FLAGS~' less='less' lib_ext='.lib' libc='cw32mti.lib' @@ -430,7 +430,7 @@ prefixexp='~INST_DRV~' privlib='~INST_TOP~\lib' prototype='define' randbits='15' -ranlib='' +ranlib='rem' rd_nodata='-1' rm='del' rmail='' diff --git a/win32/config.vc b/win32/config.vc index 7cc91dabd3..2bce3b230e 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -59,7 +59,7 @@ byteorder='1234' c='' castflags='0' cat='type' -cccdlflags='' +cccdlflags=' ' ccdlflags=' ' cf_by='garyng' cf_email='71564.1743@compuserve.com' @@ -430,7 +430,7 @@ prefixexp='~INST_DRV~' privlib='~INST_TOP~\lib' prototype='define' randbits='15' -ranlib='' +ranlib='rem' rd_nodata='-1' rm='del' rmail='' @@ -463,7 +463,7 @@ spitshell='' split='' ssizetype='int' startperl='#perl' -stdchar='unsigned char' +stdchar='char' stdio_base='((fp)->_base)' stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)' stdio_cnt='((fp)->_cnt)' diff --git a/win32/config_H.bc b/win32/config_H.bc index 61fb5a3241..460b58577c 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -113,7 +113,7 @@ * This symbol, if defined, indicates that the alarm routine is * available. */ -/*#define HAS_ALARM /**/ +#define HAS_ALARM /**/ /* HASATTRIBUTE: * This symbol indicates the C compiler can check for function attributes, diff --git a/win32/config_H.vc b/win32/config_H.vc index 76f19f1d87..4634072a4e 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -1400,7 +1400,7 @@ * This symbol is defined to be the type of char used in stdio.h. * It has the values "unsigned char" or "char". */ -#define STDCHAR unsigned char /**/ +#define STDCHAR char /**/ /* Uid_t: * This symbol holds the type used to declare user ids in the kernel. diff --git a/win32/makedef.pl b/win32/makedef.pl index 2ef1bb5dd0..8bc7a8a46a 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -14,15 +14,18 @@ # that does not present in the WIN32 port but there is no easy # way to find them so I just put a exception list here +while (@ARGV && $ARGV[0] =~ /^-/) + { + my $flag = shift; + $define{$1} = 1 if ($flag =~ /^-D(\w+)$/); + } + +warn join(' ',keys %define)."\n"; + my $CCTYPE = shift || "MSVC"; $skip_sym=<<'!END!OF!SKIP!'; -Perl_SvIV -Perl_SvNV -Perl_SvTRUE -Perl_SvUV Perl_block_type -Perl_sv_pvn Perl_additem Perl_cast_ulong Perl_check_uni @@ -63,6 +66,7 @@ Perl_force_next Perl_force_word Perl_hv_stashpv Perl_intuit_more +Perl_init_thread_intern Perl_know_next Perl_modkids Perl_mstats @@ -83,6 +87,7 @@ Perl_pp_interp Perl_pp_map Perl_pp_nswitch Perl_q +Perl_rcsid Perl_reall_srchlen Perl_regdump Perl_regfold @@ -138,6 +143,48 @@ Perl_cshname Perl_opsave !END!OF!SKIP! +unless ($define{'USE_THREADS'}) + { + $skip_sym .= <<'!END!OF!SKIP!'; +Perl_condpair_magic +Perl_thr_key +Perl_sv_mutex +Perl_malloc_mutex +Perl_eval_mutex +Perl_eval_cond +Perl_eval_owner +Perl_threads_mutex +Perl_nthreads_cond +Perl_unlock_condpair +Perl_vtbl_mutex +Perl_magic_mutexfree +Perl_sv_iv +Perl_sv_nv +Perl_sv_true +Perl_sv_uv +Perl_sv_pvn +Perl_newRV_noinc +!END!OF!SKIP! + } + +if ($define{'USE_THISPTR'} || $define{'USE_THREADS'}) + { + open(THREAD,"<../thread.sym") || die "Cannot open thread.sym:$!"; + while (<THREAD>) + { + next if (!/^[A-Za-z]/); + next if (/_amg[ \t]*$/); + $skip_sym .= "Perl_".$_; + } + close(THREAD); + $skip_sym .= "Perl_op\n"; + } + +unless ($define{'USE_THREADS'}) + { + $skip_sym .= "Perl_thread_create\n"; + } + # All symbols have a Perl_ prefix because that's what embed.h # sticks in front of them. @@ -183,6 +230,8 @@ while (<DATA>) { next if (/^#/); $symbol = $_; next if ($skip_sym =~ m/^$symbol/m); + $symbol = "Perl_".$symbol if ($define{'USE_THISPTR'} + && $symbol =~ /^perl/); emit_symbol($symbol); } @@ -228,6 +277,7 @@ perl_require_pv perl_eval_pv perl_eval_sv boot_DynaLoader +Perl_thread_create win32_errno win32_environ win32_stdin diff --git a/win32/makefile.mk b/win32/makefile.mk index 6a482ba320..655efb7395 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -10,7 +10,10 @@ # Set these to wherever you want "nmake install" to put your # newly built perl. INST_DRV=c: -INST_TOP=$(INST_DRV)\perl +INST_TOP=$(INST_DRV)\perl\perl5004.5X +BUILDOPT=-DUSE_THREADS + +# -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include # # uncomment one if you are using Visual C++ 2.x or Borland @@ -25,14 +28,14 @@ CCTYPE=BORLAND # # set the install locations of the compiler include/libraries #CCHOME = f:\msdev\vc -CCHOME = D:\bc5 +CCHOME = C:\bc5 CCINCDIR = $(CCHOME)\include CCLIBDIR = $(CCHOME)\lib # # set this to point to cmd.exe (only needed if you use some # alternate shell that doesn't grok cmd.exe style commands) -SHELL = g:\winnt\system32\cmd.exe +#SHELL = g:\winnt\system32\cmd.exe # # set this to your email address (perl will guess a value from @@ -60,7 +63,7 @@ IMPLIB = implib RUNTIME = -D_RTLDLL INCLUDES = -I.\include -I. -I.. -I$(CCINCDIR) #PCHFLAGS = -H -H$(INTDIR)\bcmoduls.pch -DEFINES = -DWIN32 -DUSE_THREADS -D_WIN32_WINNT=0x400 +DEFINES = -DWIN32 $(BUILDOPT) LOCDEFS = -DPERLDLL SUBSYS = console LIBC = cw32mti.lib @@ -72,7 +75,7 @@ WINIOMAYBE = OPTIMIZE = -v $(RUNTIME) LINK_DBG = -v .ELSE -OPTIMIZE = -O $(RUNTIME) +OPTIMIZE = -5 -O2 $(RUNTIME) LINK_DBG = .ENDIF @@ -93,7 +96,7 @@ RUNTIME = -MD .ENDIF INCLUDES = -I.\include -I. -I.. #PCHFLAGS = -Fp$(INTDIR)\vcmoduls.pch -YX -DEFINES = -DWIN32 -D_CONSOLE -DUSE_THREADS -D_WIN32_WINNT=0x400 +DEFINES = -DWIN32 $(BUILDOPT) -D_CONSOLE -D_WIN32_WINNT=0x400 LOCDEFS = -DPERLDLL SUBSYS = console @@ -263,11 +266,13 @@ CORE_OBJ= ..\av.obj \ WIN32_C = perllib.c \ win32.c \ win32io.c \ - win32sck.c + win32sck.c \ + win32thread.c WIN32_OBJ = win32.obj \ win32io.obj \ - win32sck.obj + win32sck.obj \ + win32thread.obj PERL95_OBJ = perl95.obj \ win32mt.obj \ @@ -374,7 +379,7 @@ perlglob.obj : perlglob.c config.w32 : $(CFGSH_TMPL) copy $(CFGSH_TMPL) config.w32 -.\config.h : $(CFGSH_TMPL) +.\config.h : $(CFGH_TMPL) -del /f config.h copy $(CFGH_TMPL) config.h @@ -383,6 +388,7 @@ config.w32 : $(CFGSH_TMPL) "INST_TOP=$(INST_TOP)" "cc=$(CC)" "ccflags=$(OPTIMIZE) $(DEFINES)" \ "cf_email=$(EMAIL)" "libs=$(LIBFILES:f)" "incpath=$(CCINCDIR)" \ "libpth=$(strip $(CCLIBDIR) $(LIBFILES:d))" "libc=$(LIBC)" \ + "LINK_FLAGS=$(LINK_FLAGS)" \ config.w32 > ..\config.sh $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl @@ -409,8 +415,8 @@ $(WIN32_OBJ) : $(CORE_H) $(CORE_OBJ) : $(CORE_H) $(DLL_OBJ) : $(CORE_H) -perldll.def : $(MINIPERL) $(CONFIGPM) - $(MINIPERL) -w makedef.pl $(CCTYPE) > perldll.def +perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym makedef.pl + $(MINIPERL) -w makedef.pl $(DEFINES) $(CCTYPE) > perldll.def $(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) .IF "$(CCTYPE)" == "BORLAND" @@ -455,8 +461,8 @@ $(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain.obj .ENDIF copy splittree.pl .. $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" - attrib -r ..\t\*.* - copy test ..\t +# attrib -r ..\t\*.* +# copy test ..\t .IF "$(CCTYPE)" != "BORLAND" diff --git a/win32/win32.c b/win32/win32.c index 7cbfae8a83..e10bf2b463 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -361,7 +361,7 @@ GetShell(void) } int -do_aspawn(void* really, void** mark, void** arglast) +do_aspawn(void* really, void ** mark, void ** arglast) { char **argv; char *strPtr; @@ -524,7 +524,7 @@ opendir(char *filename) /* char *dummy;*/ /* check to see if filename is a directory */ - if (win32_stat(filename, &sbuf) < 0 || sbuf.st_mode & S_IFDIR == 0) { + if (win32_stat(filename, &sbuf) < 0 || (sbuf.st_mode & S_IFDIR) == 0) { return NULL; } @@ -833,26 +833,78 @@ win32_getenv(const char *name) #endif +static long +FileTimeToClock(PFILETIME ft) +{ + __int64 qw = ft->dwHighDateTime; + qw <<= 32; + qw |= ft->dwLowDateTime; + qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */ + return (long) qw; +} + #undef times int mytimes(struct tms *timebuf) { - clock_t t = clock(); - timebuf->tms_utime = t; - timebuf->tms_stime = 0; - timebuf->tms_cutime = 0; - timebuf->tms_cstime = 0; - + FILETIME user; + FILETIME kernel; + FILETIME dummy; + if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, + &kernel,&user)) { + timebuf->tms_utime = FileTimeToClock(&user); + timebuf->tms_stime = FileTimeToClock(&kernel); + timebuf->tms_cutime = 0; + timebuf->tms_cstime = 0; + + } else { + /* That failed - e.g. Win95 fallback to clock() */ + clock_t t = clock(); + timebuf->tms_utime = t; + timebuf->tms_stime = 0; + timebuf->tms_cutime = 0; + timebuf->tms_cstime = 0; + } return 0; } +static UINT timerid = 0; + + +static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time) +{ + KillTimer(NULL,timerid); + timerid=0; + sighandler(14); +} + #undef alarm unsigned int myalarm(unsigned int sec) { - /* we warn the usuage of alarm function */ - if (sec != 0) - WARN("dummy function alarm called, program might not function as expected\n"); + /* + * the 'obvious' implentation is SetTimer() with a callback + * which does whatever receiving SIGALRM would do + * we cannot use SIGALRM even via raise() as it is not + * one of the supported codes in <signal.h> + * + * Snag is unless something is looking at the message queue + * nothing happens :-( + */ + if (sec) + { + timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc); + if (!timerid) + croak("Cannot set timer"); + } + else + { + if (timerid) + { + KillTimer(NULL,timerid); + timerid=0; + } + } return 0; } @@ -987,7 +1039,7 @@ win32_fopen(const char *filename, const char *mode) DllExport FILE * win32_fdopen( int handle, const char *mode) { - return pIOSubSystem->pfnfdopen(handle, mode); + return pIOSubSystem->pfnfdopen(handle, (char *) mode); } DllExport FILE * @@ -1205,13 +1257,13 @@ win32_chdir(const char *dir) DllExport int win32_spawnvp(int mode, const char *cmdname, const char *const *argv) { - return pIOSubSystem->pfnspawnvp(mode, cmdname, argv); + return pIOSubSystem->pfnspawnvp(mode, cmdname, (char * const *) argv); } DllExport int win32_execvp(const char *cmdname, const char *const *argv) { - return pIOSubSystem->pfnexecvp(cmdname, argv); + return pIOSubSystem->pfnexecvp(cmdname, (char *const *)argv); } DllExport void @@ -1637,3 +1689,7 @@ Perl_win32_init(int *argcp, char ***argvp) _control87(MCW_EM, MCW_EM); #endif } + + + + diff --git a/win32/win32.h b/win32/win32.h index dc069ba366..525ef0f6cc 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -52,6 +52,10 @@ typedef long gid_t; #endif +#ifdef __cplusplus +extern "C" { +#endif + extern uid_t getuid(void); extern gid_t getgid(void); extern uid_t geteuid(void); @@ -61,6 +65,11 @@ extern int setgid(gid_t gid); extern int kill(int pid, int sig); +#ifdef __cplusplus +} +#endif + + extern char *staticlinkmodules[]; /* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls @@ -79,10 +88,16 @@ extern char *staticlinkmodules[]; EXT char *win32_getenv(const char *name); #endif +#ifdef __cplusplus +extern "C" { +#endif + + EXT void Perl_win32_init(int *argcp, char ***argvp); #define USE_SOCKETS_AS_HANDLES #ifndef USE_SOCKETS_AS_HANDLES + extern FILE *myfdopen(int, char *); #undef fdopen @@ -119,11 +134,15 @@ char *win32PerlLibPath(void); char *win32SiteLibPath(void); int mytimes(struct tms *timebuf); unsigned int myalarm(unsigned int sec); -int do_aspawn(void* really, void** mark, void** arglast); +int do_aspawn(void* really, void ** mark, void ** arglast); int do_spawn(char *cmd); char do_exec(char *cmd); void init_os_extras(void); +#ifdef __cplusplus +} +#endif + typedef char * caddr_t; /* In malloc.c (core address). */ /* @@ -144,9 +163,18 @@ typedef char * caddr_t; /* In malloc.c (core address). */ #pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761) #endif +#ifdef __cplusplus +extern "C" { +#endif + int IsWin95(void); int IsWinNT(void); +#ifdef __cplusplus +} +#endif + + #ifndef VER_PLATFORM_WIN32_WINDOWS /* VC-2.0 headers dont have this */ #define VER_PLATFORM_WIN32_WINDOWS 1 #endif diff --git a/win32/win32io.c b/win32/win32io.c index eeb684620b..0e2e649059 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -1,13 +1,11 @@ -#ifdef __cplusplus -extern "C" { -#endif #define WIN32_LEAN_AND_MEAN +#include <stdio.h> +extern int my_fclose(FILE *pf); +#include "EXTERN.h" #define WIN32IO_IS_STDIO -#define EXT #include <windows.h> -#include <stdio.h> #include <stdlib.h> #include <io.h> #include <sys/stat.h> @@ -17,6 +15,16 @@ extern "C" { #include <errno.h> #include <process.h> #include <direct.h> + + +#ifdef __cplusplus +#define START_EXTERN_C extern "C" { +#define END_EXTERN_C } +#else +#define START_EXTERN_C +#define END_EXTERN_C +#endif + #include "win32iop.h" /* @@ -238,7 +246,6 @@ my_flock(int fd, int oper) #undef LK_ERR #undef LK_LEN -EXT int my_fclose(FILE *pf); #ifdef PERLDLL __declspec(dllexport) @@ -321,7 +328,6 @@ WIN32_IOSUBSYSTEM win32stdio = { }; -#ifdef __cplusplus -} -#endif + + diff --git a/win32/win32io.h b/win32/win32io.h index ba4080c152..0e849cf783 100644 --- a/win32/win32io.h +++ b/win32/win32io.h @@ -3,6 +3,9 @@ #ifdef __BORLANDC__ #include <stdarg.h> +#define MSconst +#else +#define MSconst const #endif typedef struct { @@ -20,7 +23,7 @@ int (*pfnvprintf)(const char *format, va_list arg); size_t (*pfnfread)(void *buf, size_t size, size_t count, FILE *pf); size_t (*pfnfwrite)(const void *buf, size_t size, size_t count, FILE *pf); FILE* (*pfnfopen)(const char *path, const char *mode); -FILE* (*pfnfdopen)(int fh, const char *mode); +FILE* (*pfnfdopen)(int fh, MSconst char *mode); FILE* (*pfnfreopen)(const char *path, const char *mode, FILE *pf); int (*pfnfclose)(FILE *pf); int (*pfnfputs)(const char *s,FILE *pf); @@ -55,12 +58,12 @@ int (*pfnwrite)(int fd, const void *buf, unsigned int cnt); int (*pfnopenmode)(int mode); int (*pfn_open_osfhandle)(long handle, int flags); long (*pfn_get_osfhandle)(int fd); -int (*pfnspawnvp)(int mode, const char *cmdname, const char *const *argv); +int (*pfnspawnvp)(int mode, const char *cmdname, MSconst char * const *argv); int (*pfnmkdir)(const char *path); int (*pfnrmdir)(const char *path); int (*pfnchdir)(const char *path); int (*pfnflock)(int fd, int oper); -int (*pfnexecvp)(const char *cmdname, const char *const *argv); +int (*pfnexecvp)(const char *cmdname, MSconst char *const *argv); void (*pfnperror)(const char *str); void (*pfnsetbuf)(FILE *pf, char *buf); int (*pfnsetvbuf)(FILE *pf, char *buf, int type, size_t size); @@ -85,3 +88,4 @@ int signature_end; typedef WIN32_IOSUBSYSTEM *PWIN32_IOSUBSYSTEM; #endif /* WIN32IO_H */ + diff --git a/win32/win32iop.h b/win32/win32iop.h index 4606563d0e..52acce1a9b 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -1,6 +1,15 @@ #ifndef WIN32IOP_H #define WIN32IOP_H +/* + * defines for flock emulation + */ +#define LOCK_SH 1 +#define LOCK_EX 2 +#define LOCK_NB 4 +#define LOCK_UN 8 + +#include <win32io.h> /* pull in the io sub system structure */ /* * Make this as close to original stdio as possible. @@ -9,6 +18,8 @@ /* * function prototypes for our own win32io layer */ +START_EXTERN_C + EXT int * win32_errno(void); EXT char *** win32_environ(void); EXT FILE* win32_stdin(void); @@ -81,25 +92,20 @@ EXT void* win32_calloc(size_t numitems, size_t size); EXT void* win32_realloc(void *block, size_t size); EXT void win32_free(void *block); + + /* * these two are win32 specific but still io related */ int stolen_open_osfhandle(long handle, int flags); long stolen_get_osfhandle(int fd); -/* - * defines for flock emulation - */ -#define LOCK_SH 1 -#define LOCK_EX 2 -#define LOCK_NB 4 -#define LOCK_UN 8 - -#include <win32io.h> /* pull in the io sub system structure */ EXT PWIN32_IOSUBSYSTEM SetIOSubSystem(void *piosubsystem); EXT PWIN32_IOSUBSYSTEM GetIOSubSystem(void); +END_EXTERN_C + /* * the following six(6) is #define in stdio.h */ diff --git a/win32/win32sck.c b/win32/win32sck.c index 3653fc8b88..b4ad4f4cfb 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -702,7 +702,14 @@ win32_setservent(int stayopen) #define WIN32IO_IS_STDIO #include <io.h> + +#ifdef __cplusplus +extern "C" { +#endif #include "win32iop.h" +#ifdef __cplusplus +} +#endif static struct servent* win32_savecopyservent(struct servent*d, struct servent*s, const char *proto) diff --git a/win32/win32thread.c b/win32/win32thread.c index 9f63d178f4..dfa9a0c733 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -1,10 +1,26 @@ #include "EXTERN.h" #include "perl.h" -#include "win32/win32thread.h" + +void +Perl_alloc_thread_key(void) +{ +#ifdef USE_THREADS + static int key_allocated = 0; + if (!key_allocated) { + if ((thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES) + croak("panic: TlsAlloc"); + key_allocated = 1; + } +#endif +} void init_thread_intern(struct thread *thr) { +#ifdef USE_THREADS + /* GetCurrentThread() retrurns a pseudo handle, need + this to convert it into a handle another thread can use + */ DuplicateHandle(GetCurrentProcess(), GetCurrentThread(), GetCurrentProcess(), @@ -12,19 +28,22 @@ init_thread_intern(struct thread *thr) 0, FALSE, DUPLICATE_SAME_ACCESS); - if ((thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES) - croak("panic: TlsAlloc"); - if (TlsSetValue(thr_key, (LPVOID) thr) != TRUE) - croak("panic: TlsSetValue"); +#endif } +#ifdef USE_THREADS int -thread_create(struct thread *thr, THREAD_RET_TYPE (*fn)(void *)) +Perl_thread_create(struct thread *thr, thread_func_t *fn) { DWORD junk; MUTEX_LOCK(&thr->mutex); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "%p: create OS thread\n", thr)); thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk)); MUTEX_UNLOCK(&thr->mutex); return thr->self ? 0 : -1; } +#endif diff --git a/win32/win32thread.h b/win32/win32thread.h index ab0dbc598f..75aa25b632 100644 --- a/win32/win32thread.h +++ b/win32/win32thread.h @@ -1,6 +1,6 @@ -/*typedef CRITICAL_SECTION perl_mutex;*/ -typedef HANDLE perl_mutex; -typedef HANDLE perl_cond; +#ifndef _WIN32THREAD_H +#define _WIN32THREAD_H +typedef struct win32_cond { LONG waiters; HANDLE sem; } perl_cond; typedef DWORD perl_key; typedef HANDLE perl_thread; @@ -8,12 +8,15 @@ typedef HANDLE perl_thread; * but can't be communicated to child processes, and can't get * HANDLE to it for use elsewhere */ -/* + +#ifndef DONT_USE_CRITICAL_SECTION +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 { \ @@ -36,38 +39,51 @@ typedef HANDLE perl_thread; croak("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 { \ - if ((*(c) = CreateEvent(NULL,TRUE,FALSE,NULL)) == NULL) \ - croak("panic: COND_INIT"); \ + STMT_START { \ + (c)->waiters = 0; \ + (c)->sem = CreateSemaphore(NULL,0,LONG_MAX,NULL); \ + if ((c)->sem == NULL) \ + croak("panic: COND_INIT (%ld)",GetLastError()); \ } STMT_END + #define COND_SIGNAL(c) \ - STMT_START { \ - if (PulseEvent(*(c)) == 0) \ - croak("panic: COND_SIGNAL (%ld)",GetLastError()); \ + STMT_START { \ + if (ReleaseSemaphore((c)->sem,1,NULL) == 0) \ + croak("panic: COND_SIGNAL (%ld)",GetLastError()); \ } STMT_END + #define COND_BROADCAST(c) \ - STMT_START { \ - if (PulseEvent(*(c)) == 0) \ - croak("panic: COND_BROADCAST"); \ + STMT_START { \ + if ((c)->waiters > 0 && \ + ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0) \ + croak("panic: COND_BROADCAST (%ld)",GetLastError());\ } STMT_END -/* #define COND_WAIT(c, m) \ - STMT_START { \ - if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED) \ - croak("panic: COND_WAIT"); \ - } STMT_END -*/ + #define COND_WAIT(c, m) \ - STMT_START { \ - if (SignalObjectAndWait(*(m),*(c),INFINITE,FALSE) == WAIT_FAILED)\ - croak("panic: COND_WAIT"); \ - else \ - MUTEX_LOCK(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)\ + croak("panic: COND_WAIT (%ld)",GetLastError()); \ + MUTEX_LOCK(m); \ + (c)->waiters--; \ } STMT_END + #define COND_DESTROY(c) \ - STMT_START { \ - if (CloseHandle(*(c)) == 0) \ - croak("panic: COND_DESTROY"); \ + STMT_START { \ + (c)->waiters = 0; \ + if (CloseHandle((c)->sem) == 0) \ + croak("panic: COND_DESTROY (%ld)",GetLastError()); \ } STMT_END #define DETACH(t) \ @@ -79,8 +95,22 @@ typedef HANDLE perl_thread; } STMT_END #define THR ((struct thread *) TlsGetValue(thr_key)) +#define THREAD_CREATE(t, f) Perl_thread_create(t, f) +#define THREAD_POST_CREATE(t) NOOP +#define THREAD_RET_TYPE DWORD WINAPI +#define THREAD_RET_CAST(p) ((DWORD)(p)) -#define HAVE_THREAD_INTERN +typedef THREAD_RET_TYPE thread_func_t(void *); + +START_EXTERN_C +void Perl_alloc_thread_key _((void)); +int Perl_thread_create _((struct thread *thr, thread_func_t *fn)); +void Perl_init_thread_intern _((struct thread *thr)); +END_EXTERN_C + +#define INIT_THREADS NOOP +#define ALLOC_THREAD_KEY Perl_alloc_thread_key() +#define INIT_THREAD_INTERN(thr) Perl_init_thread_intern(thr) #define JOIN(t, avp) \ STMT_START { \ @@ -95,8 +125,6 @@ typedef HANDLE perl_thread; croak("panic: TlsSetValue"); \ } STMT_END -#define THREAD_CREATE(t, f) thread_create(t, f) -#define THREAD_POST_CREATE(t) NOOP -#define THREAD_RET_TYPE DWORD WINAPI -#define THREAD_RET_CAST(p) ((DWORD)(p)) #define YIELD Sleep(0) + +#endif /* _WIN32THREAD_H */ |