| Anonymous | Login | Signup for a new account | 2013-05-25 01:05 CEST |  |
| Main | My View | View Issues | Change Log | Roadmap |
| View Issue Details [ Jump to Notes ] | [ Issue History ] [ Print ] | ||||||||||
| ID | Project | Category | View Status | Date Submitted | Last Update | ||||||
| 0004034 | OCaml | OCaml general | public | 2006-05-29 17:00 | 2011-12-16 11:56 | ||||||
| Reporter | Christoph Bauer | ||||||||||
| Assigned To | |||||||||||
| Priority | normal | Severity | feature | Reproducibility | always | ||||||
| Status | acknowledged | Resolution | open | ||||||||
| Platform | OS | OS Version | |||||||||
| Product Version | 3.09.2 | ||||||||||
| Target Version | Fixed in Version | ||||||||||
| Summary | 0004034: Unix.getpid returns wrong result | ||||||||||
| Description | Unix.getpid returns a wrong (non-existing) processid. To reproduce: ocaml unix.cma # Unix.getpid ();; A working implementation of getpid.c could be #include <mlvalues.h> #include "unixsupport.h" CAMLprim value unix_getpid(value unit) { return Val_int( getpid() ); } | ||||||||||
| Tags | No tags attached. | ||||||||||
| Attached Files |  ocaml-3.09.2-getpid.patch [^] (5,342 bytes) 2006-08-03 12:32 [Show Content] [Hide Content]diff --exclude='*.o' --exclude='*~' -cr /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/createprocess.c ./createprocess.c
*** /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/createprocess.c Fri Dec 7 14:40:43 2001
--- ./createprocess.c Thu Aug 3 12:03:10 2006
***************
*** 60,68 ****
uerror("create_process", cmd);
}
CloseHandle(pi.hThread);
! /* Return the process handle as pseudo-PID
! (this is consistent with the wait() emulation in the MSVC C library */
! return Val_int(pi.hProcess);
}
CAMLprim value win_create_process(value * argv, int argn)
--- 60,67 ----
uerror("create_process", cmd);
}
CloseHandle(pi.hThread);
! CloseHandle(pi.hProcess);
! return Val_int(pi.dwProcessId);
}
CAMLprim value win_create_process(value * argv, int argn)
Files /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/dllunix.dll and ./dllunix.dll differ
diff --exclude='*.o' --exclude='*~' -cr /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/getpid.c ./getpid.c
*** /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/getpid.c Fri Dec 7 14:40:44 2001
--- ./getpid.c Thu Aug 3 10:40:04 2006
***************
*** 15,24 ****
#include <mlvalues.h>
#include "unixsupport.h"
!
! extern value val_process_id;
CAMLprim value unix_getpid(value unit)
{
! return val_process_id;
}
--- 15,23 ----
#include <mlvalues.h>
#include "unixsupport.h"
! #include <process.h>
CAMLprim value unix_getpid(value unit)
{
! return Val_int(_getpid());
}
Files /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/libunix.a and ./libunix.a differ
diff --exclude='*.o' --exclude='*~' -cr /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/startup.c ./startup.c
*** /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/startup.c Mon Jan 6 15:52:57 2003
--- ./startup.c Thu Aug 3 10:35:11 2006
***************
*** 17,24 ****
#include <mlvalues.h>
#include "unixsupport.h"
- value val_process_id;
-
CAMLprim value win_startup(unit)
value unit;
{
--- 17,22 ----
***************
*** 27,36 ****
HANDLE h;
(void) WSAStartup(MAKEWORD(2, 0), &wsaData);
- DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
- GetCurrentProcess(), &h, 0, TRUE,
- DUPLICATE_SAME_ACCESS);
- val_process_id = Val_int(h);
return Val_unit;
}
--- 25,30 ----
Files /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/unix.a and ./unix.a differ
Only in /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/: unix.cmxa
diff --exclude='*.o' --exclude='*~' -cr /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/winwait.c ./winwait.c
*** /d/bauer/ocaml-mingw/ocaml-3.09.2/otherlibs/win32unix/winwait.c Thu Sep 22 16:21:50 2005
--- ./winwait.c Thu Aug 3 12:22:10 2006
***************
*** 20,26 ****
#include "unixsupport.h"
#include <sys/types.h>
! static value alloc_process_status(HANDLE pid, int status)
{
value res, st;
--- 20,26 ----
#include "unixsupport.h"
#include <sys/types.h>
! static value alloc_process_status(pid_t pid, int status)
{
value res, st;
***************
*** 28,34 ****
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
! Field(res, 0) = Val_long((intnat) pid);
Field(res, 1) = st;
End_roots();
return res;
--- 28,34 ----
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
! Field(res, 0) = Val_int(pid);
Field(res, 1) = st;
End_roots();
return res;
***************
*** 38,62 ****
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
! CAMLprim value win_waitpid(value vflags, value vpid_req)
{
int flags;
DWORD status;
! HANDLE pid_req = (HANDLE) Long_val(vpid_req);
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
if (WaitForSingleObject(pid_req, INFINITE) == WAIT_FAILED) {
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
}
if (! GetExitCodeProcess(pid_req, &status)) {
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
if (status == STILL_ACTIVE)
! return alloc_process_status((HANDLE) 0, 0);
else
! return alloc_process_status(pid_req, status);
}
--- 38,75 ----
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
! CAMLprim value win_waitpid(value vflags, value vpid)
{
int flags;
DWORD status;
! pid_t pid = Int_val( vpid );
! HANDLE pid_req;
!
! pid_req = OpenProcess( PROCESS_ALL_ACCESS, FALSE, pid );
! if( pid_req == NULL ) {
! win32_maperr(GetLastError());
! uerror("waitpid", Nothing);
! }
!
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
if (WaitForSingleObject(pid_req, INFINITE) == WAIT_FAILED) {
+ CloseHandle(pid_req);
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
}
if (! GetExitCodeProcess(pid_req, &status)) {
+ CloseHandle(pid_req);
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
+
+ CloseHandle(pid_req);
+
if (status == STILL_ACTIVE)
! return alloc_process_status(0, 0);
else
! return alloc_process_status(pid, status);
}
getpid-patch2.diff [^] (9,615 bytes) 2007-02-01 18:29 [Show Content] [Hide Content]diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/Makefile.nt win32unix/Makefile.nt
--- win32unix.orig/Makefile.nt 2007-02-01 18:17:02.583371900 +0100
+++ win32unix/Makefile.nt 2007-02-01 17:14:25.062831700 +0100
@@ -27,7 +27,7 @@ WIN_FILES = accept.c bind.c channels.c c
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
getpeername.c getpid.c getsockname.c gettimeofday.c \
link.c listen.c lockf.c lseek.c nonblock.c \
- mkdir.c open.c pipe.c read.c rename.c \
+ mkdir.c open.c pidtable.c pipe.c read.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
system.c unixsupport.c windir.c winwait.c write.c
@@ -62,7 +62,7 @@ dllunix.dll: $(DOBJS)
libunix.$(A): $(SOBJS)
$(call MKLIB,libunix.$(A),$(SOBJS))
-$(DOBJS) $(SOBJS): unixsupport.h
+$(DOBJS) $(SOBJS): unixsupport.h pidtable.h
unix.cma: $(CAML_OBJS)
$(CAMLC) -a -linkall -o unix.cma $(CAML_OBJS) \
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/createprocess.c win32unix/createprocess.c
--- win32unix.orig/createprocess.c 2007-02-01 18:17:02.520977100 +0100
+++ win32unix/createprocess.c 2007-02-01 17:18:42.446460700 +0100
@@ -17,13 +17,15 @@
#include <mlvalues.h>
#include <osdeps.h>
#include "unixsupport.h"
+#include "pidtable.h"
static int win_has_console(void);
value win_create_process_native(value cmd, value cmdline, value env,
value fd1, value fd2, value fd3)
{
- PROCESS_INFORMATION pi;
+ PROCESS_INFORMATION * pi =
+ (PROCESS_INFORMATION*) malloc( sizeof(PROCESS_INFORMATION) );
STARTUPINFO si;
char * exefile, * envp;
int flags;
@@ -55,14 +57,14 @@ value win_create_process_native(value cm
}
/* Create the process */
if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
- TRUE, flags, envp, NULL, &si, &pi)) {
+ TRUE, flags, envp, NULL, &si, pi)) {
win32_maperr(GetLastError());
uerror("create_process", cmd);
}
- CloseHandle(pi.hThread);
- /* Return the process handle as pseudo-PID
- (this is consistent with the wait() emulation in the MSVC C library */
- return Val_int(pi.hProcess);
+ /* CloseHandle(pi.hThread);
+ CloseHandle(pi.hProcess); */
+ caml_pid_table_insert( pi );
+ return Val_int(pi->dwProcessId);
}
CAMLprim value win_create_process(value * argv, int argn)
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/getpid.c win32unix/getpid.c
--- win32unix.orig/getpid.c 2007-02-01 18:17:02.536575800 +0100
+++ win32unix/getpid.c 2007-02-01 17:01:31.076459100 +0100
@@ -15,10 +15,9 @@
#include <mlvalues.h>
#include "unixsupport.h"
-
-extern value val_process_id;
+#include <process.h>
CAMLprim value unix_getpid(value unit)
{
- return val_process_id;
+ return Val_int(_getpid());
}
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/pidtable.c win32unix/pidtable.c
--- win32unix.orig/pidtable.c 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.c 2007-02-01 18:15:34.154341600 +0100
@@ -0,0 +1,78 @@
+/********************************************************************
+ Objective Caml
+ This file is contributed by Christoph bauer
+*/
+
+
+#include "pidtable.h"
+#include "unixsupport.h"
+#include <process.h>
+
+#define PID_TABLE_INITIAL_SIZE 16
+PROCESS_INFORMATION ** caml_pid_table = NULL;
+int pid_table_size = 0;
+int pid_table_used = 0;
+
+static
+void resize_pid_table( int delta ) {
+ pid_table_used += delta;
+ if( pid_table_used > PID_TABLE_INITIAL_SIZE &&
+ pid_table_used < pid_table_size / 4 ) {
+ pid_table_size /= 2;
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ } else if ( pid_table_used >= pid_table_size ) {
+ pid_table_size = pid_table_size > 0 ? 2 * pid_table_size : PID_TABLE_INITIAL_SIZE;
+ /* assert( pid_table_size >= pid_table_used ); */
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ }
+}
+
+static
+int pid_table_index( int pid, int min, int max ) {
+ if( min >= max ) return min;
+ else {
+ int m = (min+max)/2;
+ if( m >= pid_table_used-1 ) return (pid_table_used-1);
+ if( caml_pid_table[m]->dwProcessId == pid ) return m;
+ else if( caml_pid_table[m]->dwProcessId < pid )
+ return pid_table_index( pid, m+1, max );
+ else
+ return pid_table_index( pid, min, m-1 );
+ }
+}
+
+void caml_pid_table_insert(PROCESS_INFORMATION * pi) {
+ int i;
+ resize_pid_table( 1 );
+ i = pid_table_index( pi->dwProcessId, 0, pid_table_used );
+ fflush(stdout);
+ if( i < pid_table_used )
+ memmove( &caml_pid_table[i + 1], &caml_pid_table[i],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table));
+ caml_pid_table[i] = pi;
+}
+
+PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+ if( i >= pid_table_used ||
+ caml_pid_table[i]->dwProcessId != pid ) return NULL;
+ else return caml_pid_table[i];
+}
+
+void caml_pid_table_remove( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+y if( i < pid_table_used &&
+ caml_pid_table[i]->dwProcessId == pid ) {
+ CloseHandle(caml_pid_table[i]->hProcess);
+ CloseHandle(caml_pid_table[i]->hThread);
+ free( caml_pid_table[i] );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i], &caml_pid_table[i+1],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table) );
+ resize_pid_table( -1 );
+ }
+}
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/pidtable.h win32unix/pidtable.h
--- win32unix.orig/pidtable.h 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.h 2007-02-01 17:23:31.168654400 +0100
@@ -0,0 +1,10 @@
+/* Support for PIDs under Windows
+ 2007 Christoph Bauer
+ */
+
+#include "unixsupport.h"
+#include <process.h>
+
+extern PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid );
+extern void caml_pid_table_remove( pid_t pid );
+void caml_pid_table_insert(PROCESS_INFORMATION * pi);
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/startup.c win32unix/startup.c
--- win32unix.orig/startup.c 2007-02-01 18:17:02.676964100 +0100
+++ win32unix/startup.c 2006-10-20 16:29:03.054744300 +0200
@@ -17,8 +17,6 @@
#include <mlvalues.h>
#include "unixsupport.h"
-value val_process_id;
-
CAMLprim value win_startup(unit)
value unit;
{
@@ -27,10 +25,6 @@ CAMLprim value win_startup(unit)
HANDLE h;
(void) WSAStartup(MAKEWORD(2, 0), &wsaData);
- DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
- GetCurrentProcess(), &h, 0, TRUE,
- DUPLICATE_SAME_ACCESS);
- val_process_id = Val_int(h);
return Val_unit;
}
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/unixsupport.h win32unix/unixsupport.h
--- win32unix.orig/unixsupport.h 2007-02-01 18:17:02.708161500 +0100
+++ win32unix/unixsupport.h 2007-02-01 17:23:05.935409900 +0100
@@ -13,6 +13,9 @@
/* $Id: unixsupport.h,v 1.16 2005/09/22 14:21:50 xleroy Exp $ */
+#ifndef CAML_UNIX_SUPPORT_H
+#define CAML_UNIX_SUPPORT_H
+
#define WIN32_LEAN_AND_MEAN
#include <wtypes.h>
#include <winbase.h>
@@ -52,3 +55,4 @@ extern void uerror (char * cmdname, valu
extern value unix_freeze_buffer (value);
#define UNIX_BUFFER_SIZE 16384
+#endif
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/winwait.c win32unix/winwait.c
--- win32unix.orig/winwait.c 2007-02-01 18:17:02.723760200 +0100
+++ win32unix/winwait.c 2007-02-01 17:28:24.179709500 +0100
@@ -18,9 +18,11 @@
#include <alloc.h>
#include <memory.h>
#include "unixsupport.h"
+#include "pidtable.h"
#include <sys/types.h>
+#include <errno.h>
-static value alloc_process_status(HANDLE pid, int status)
+static value alloc_process_status(pid_t pid, int status)
{
value res, st;
@@ -28,7 +30,7 @@ static value alloc_process_status(HANDLE
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
- Field(res, 0) = Val_long((intnat) pid);
+ Field(res, 0) = Val_int(pid);
Field(res, 1) = st;
End_roots();
return res;
@@ -38,25 +40,37 @@ enum { CAML_WNOHANG = 1, CAML_WUNTRACED
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
-CAMLprim value win_waitpid(value vflags, value vpid_req)
+CAMLprim value win_waitpid(value vflags, value vpid)
{
int flags;
DWORD status;
- HANDLE pid_req = (HANDLE) Long_val(vpid_req);
+ pid_t pid = Int_val( vpid );
+
+ PROCESS_INFORMATION * pi = caml_pid_table_lookup( pid );
+
+ if( pi == NULL ) {
+ unix_error(EINVAL, "waitpid", Nothing );
+ }
+
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
- if (WaitForSingleObject(pid_req, INFINITE) == WAIT_FAILED) {
+ if (WaitForSingleObject(pi->hProcess, INFINITE) == WAIT_FAILED) {
+ caml_pid_table_remove( pi->dwProcessId );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
}
- if (! GetExitCodeProcess(pid_req, &status)) {
+ if (! GetExitCodeProcess(pi->hProcess, &status)) {
+ caml_pid_table_remove( pi->dwProcessId );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
+
if (status == STILL_ACTIVE)
- return alloc_process_status((HANDLE) 0, 0);
- else
- return alloc_process_status(pid_req, status);
+ return alloc_process_status(0, 0);
+ else {
+ caml_pid_table_remove( pi->dwProcessId );
+ return alloc_process_status(pid, status);
+ }
}
getpid-patch2b.diff [^] (9,595 bytes) 2007-02-02 11:06 [Show Content] [Hide Content]diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/Makefile.nt win32unix/Makefile.nt
--- win32unix.orig/Makefile.nt 2007-02-01 18:17:02.583371900 +0100
+++ win32unix/Makefile.nt 2007-02-01 17:14:25.062831700 +0100
@@ -27,7 +27,7 @@ WIN_FILES = accept.c bind.c channels.c c
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
getpeername.c getpid.c getsockname.c gettimeofday.c \
link.c listen.c lockf.c lseek.c nonblock.c \
- mkdir.c open.c pipe.c read.c rename.c \
+ mkdir.c open.c pidtable.c pipe.c read.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
system.c unixsupport.c windir.c winwait.c write.c
@@ -62,7 +62,7 @@ dllunix.dll: $(DOBJS)
libunix.$(A): $(SOBJS)
$(call MKLIB,libunix.$(A),$(SOBJS))
-$(DOBJS) $(SOBJS): unixsupport.h
+$(DOBJS) $(SOBJS): unixsupport.h pidtable.h
unix.cma: $(CAML_OBJS)
$(CAMLC) -a -linkall -o unix.cma $(CAML_OBJS) \
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/createprocess.c win32unix/createprocess.c
--- win32unix.orig/createprocess.c 2007-02-01 18:17:02.520977100 +0100
+++ win32unix/createprocess.c 2007-02-01 17:18:42.446460700 +0100
@@ -17,13 +17,15 @@
#include <mlvalues.h>
#include <osdeps.h>
#include "unixsupport.h"
+#include "pidtable.h"
static int win_has_console(void);
value win_create_process_native(value cmd, value cmdline, value env,
value fd1, value fd2, value fd3)
{
- PROCESS_INFORMATION pi;
+ PROCESS_INFORMATION * pi =
+ (PROCESS_INFORMATION*) malloc( sizeof(PROCESS_INFORMATION) );
STARTUPINFO si;
char * exefile, * envp;
int flags;
@@ -55,14 +57,14 @@ value win_create_process_native(value cm
}
/* Create the process */
if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
- TRUE, flags, envp, NULL, &si, &pi)) {
+ TRUE, flags, envp, NULL, &si, pi)) {
win32_maperr(GetLastError());
uerror("create_process", cmd);
}
- CloseHandle(pi.hThread);
- /* Return the process handle as pseudo-PID
- (this is consistent with the wait() emulation in the MSVC C library */
- return Val_int(pi.hProcess);
+ /* CloseHandle(pi.hThread);
+ CloseHandle(pi.hProcess); */
+ caml_pid_table_insert( pi );
+ return Val_int(pi->dwProcessId);
}
CAMLprim value win_create_process(value * argv, int argn)
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/getpid.c win32unix/getpid.c
--- win32unix.orig/getpid.c 2007-02-01 18:17:02.536575800 +0100
+++ win32unix/getpid.c 2007-02-01 17:01:31.076459100 +0100
@@ -15,10 +15,9 @@
#include <mlvalues.h>
#include "unixsupport.h"
-
-extern value val_process_id;
+#include <process.h>
CAMLprim value unix_getpid(value unit)
{
- return val_process_id;
+ return Val_int(_getpid());
}
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/pidtable.c win32unix/pidtable.c
--- win32unix.orig/pidtable.c 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.c 2007-02-02 11:02:18.535478000 +0100
@@ -0,0 +1,77 @@
+/********************************************************************
+ Objective Caml
+ This file is contributed by Christoph bauer
+*/
+
+
+#include "pidtable.h"
+#include "unixsupport.h"
+#include <process.h>
+
+#define PID_TABLE_INITIAL_SIZE 16
+PROCESS_INFORMATION ** caml_pid_table = NULL;
+int pid_table_size = 0;
+int pid_table_used = 0;
+
+static
+void resize_pid_table( int delta ) {
+ pid_table_used += delta;
+ if( pid_table_used > PID_TABLE_INITIAL_SIZE &&
+ pid_table_used < pid_table_size / 4 ) {
+ pid_table_size /= 2;
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ } else if ( pid_table_used >= pid_table_size ) {
+ pid_table_size = pid_table_size > 0 ? 2 * pid_table_size : PID_TABLE_INITIAL_SIZE;
+ /* assert( pid_table_size >= pid_table_used ); */
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ }
+}
+
+static
+int pid_table_index( int pid, int min, int max ) {
+ if( min >= max ) return min;
+ else {
+ int m = (min+max)/2;
+ if( m >= pid_table_used-1 ) return (pid_table_used-1);
+ if( caml_pid_table[m]->dwProcessId == pid ) return m;
+ else if( caml_pid_table[m]->dwProcessId < pid )
+ return pid_table_index( pid, m+1, max );
+ else
+ return pid_table_index( pid, min, m-1 );
+ }
+}
+
+void caml_pid_table_insert(PROCESS_INFORMATION * pi) {
+ int i;
+ resize_pid_table( 1 );
+ i = pid_table_index( pi->dwProcessId, 0, pid_table_used );
+ if( i < pid_table_used )
+ memmove( &caml_pid_table[i + 1], &caml_pid_table[i],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table));
+ caml_pid_table[i] = pi;
+}
+
+PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+ if( i >= pid_table_used ||
+ caml_pid_table[i]->dwProcessId != pid ) return NULL;
+ else return caml_pid_table[i];
+}
+
+void caml_pid_table_remove( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+ if( i < pid_table_used &&
+ caml_pid_table[i]->dwProcessId == pid ) {
+ CloseHandle(caml_pid_table[i]->hProcess);
+ CloseHandle(caml_pid_table[i]->hThread);
+ free( caml_pid_table[i] );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i], &caml_pid_table[i+1],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table) );
+ resize_pid_table( -1 );
+ }
+}
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/pidtable.h win32unix/pidtable.h
--- win32unix.orig/pidtable.h 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.h 2007-02-01 17:23:31.168654400 +0100
@@ -0,0 +1,10 @@
+/* Support for PIDs under Windows
+ 2007 Christoph Bauer
+ */
+
+#include "unixsupport.h"
+#include <process.h>
+
+extern PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid );
+extern void caml_pid_table_remove( pid_t pid );
+void caml_pid_table_insert(PROCESS_INFORMATION * pi);
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/startup.c win32unix/startup.c
--- win32unix.orig/startup.c 2007-02-01 18:17:02.676964100 +0100
+++ win32unix/startup.c 2006-10-20 16:29:03.054744300 +0200
@@ -17,8 +17,6 @@
#include <mlvalues.h>
#include "unixsupport.h"
-value val_process_id;
-
CAMLprim value win_startup(unit)
value unit;
{
@@ -27,10 +25,6 @@ CAMLprim value win_startup(unit)
HANDLE h;
(void) WSAStartup(MAKEWORD(2, 0), &wsaData);
- DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
- GetCurrentProcess(), &h, 0, TRUE,
- DUPLICATE_SAME_ACCESS);
- val_process_id = Val_int(h);
return Val_unit;
}
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/unixsupport.h win32unix/unixsupport.h
--- win32unix.orig/unixsupport.h 2007-02-01 18:17:02.708161500 +0100
+++ win32unix/unixsupport.h 2007-02-01 17:23:05.935409900 +0100
@@ -13,6 +13,9 @@
/* $Id: unixsupport.h,v 1.16 2005/09/22 14:21:50 xleroy Exp $ */
+#ifndef CAML_UNIX_SUPPORT_H
+#define CAML_UNIX_SUPPORT_H
+
#define WIN32_LEAN_AND_MEAN
#include <wtypes.h>
#include <winbase.h>
@@ -52,3 +55,4 @@ extern void uerror (char * cmdname, valu
extern value unix_freeze_buffer (value);
#define UNIX_BUFFER_SIZE 16384
+#endif
diff --exclude='*.o' --exclude='*~' -urpwN win32unix.orig/winwait.c win32unix/winwait.c
--- win32unix.orig/winwait.c 2007-02-01 18:17:02.723760200 +0100
+++ win32unix/winwait.c 2007-02-01 17:28:24.179709500 +0100
@@ -18,9 +18,11 @@
#include <alloc.h>
#include <memory.h>
#include "unixsupport.h"
+#include "pidtable.h"
#include <sys/types.h>
+#include <errno.h>
-static value alloc_process_status(HANDLE pid, int status)
+static value alloc_process_status(pid_t pid, int status)
{
value res, st;
@@ -28,7 +30,7 @@ static value alloc_process_status(HANDLE
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
- Field(res, 0) = Val_long((intnat) pid);
+ Field(res, 0) = Val_int(pid);
Field(res, 1) = st;
End_roots();
return res;
@@ -38,25 +40,37 @@ enum { CAML_WNOHANG = 1, CAML_WUNTRACED
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
-CAMLprim value win_waitpid(value vflags, value vpid_req)
+CAMLprim value win_waitpid(value vflags, value vpid)
{
int flags;
DWORD status;
- HANDLE pid_req = (HANDLE) Long_val(vpid_req);
+ pid_t pid = Int_val( vpid );
+
+ PROCESS_INFORMATION * pi = caml_pid_table_lookup( pid );
+
+ if( pi == NULL ) {
+ unix_error(EINVAL, "waitpid", Nothing );
+ }
+
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
- if (WaitForSingleObject(pid_req, INFINITE) == WAIT_FAILED) {
+ if (WaitForSingleObject(pi->hProcess, INFINITE) == WAIT_FAILED) {
+ caml_pid_table_remove( pi->dwProcessId );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
}
- if (! GetExitCodeProcess(pid_req, &status)) {
+ if (! GetExitCodeProcess(pi->hProcess, &status)) {
+ caml_pid_table_remove( pi->dwProcessId );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
+
if (status == STILL_ACTIVE)
- return alloc_process_status((HANDLE) 0, 0);
- else
- return alloc_process_status(pid_req, status);
+ return alloc_process_status(0, 0);
+ else {
+ caml_pid_table_remove( pi->dwProcessId );
+ return alloc_process_status(pid, status);
+ }
}
getpid-patch2c.diff [^] (12,069 bytes) 2007-03-16 13:45 [Show Content] [Hide Content]diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/Makefile.nt win32unix/Makefile.nt
--- win32unix.orig/Makefile.nt 2007-02-01 18:17:02.583371900 +0100
+++ win32unix/Makefile.nt 2007-02-01 17:14:25.062831700 +0100
@@ -27,7 +27,7 @@ WIN_FILES = accept.c bind.c channels.c c
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
getpeername.c getpid.c getsockname.c gettimeofday.c \
link.c listen.c lockf.c lseek.c nonblock.c \
- mkdir.c open.c pipe.c read.c rename.c \
+ mkdir.c open.c pidtable.c pipe.c read.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
system.c unixsupport.c windir.c winwait.c write.c
@@ -62,7 +62,7 @@ dllunix.dll: $(DOBJS)
libunix.$(A): $(SOBJS)
$(call MKLIB,libunix.$(A),$(SOBJS))
-$(DOBJS) $(SOBJS): unixsupport.h
+$(DOBJS) $(SOBJS): unixsupport.h pidtable.h
unix.cma: $(CAML_OBJS)
$(CAMLC) -a -linkall -o unix.cma $(CAML_OBJS) \
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/createprocess.c win32unix/createprocess.c
--- win32unix.orig/createprocess.c 2007-02-01 18:17:02.520977100 +0100
+++ win32unix/createprocess.c 2007-02-01 17:18:42.446460700 +0100
@@ -17,13 +17,15 @@
#include <mlvalues.h>
#include <osdeps.h>
#include "unixsupport.h"
+#include "pidtable.h"
static int win_has_console(void);
value win_create_process_native(value cmd, value cmdline, value env,
value fd1, value fd2, value fd3)
{
- PROCESS_INFORMATION pi;
+ PROCESS_INFORMATION * pi =
+ (PROCESS_INFORMATION*) malloc( sizeof(PROCESS_INFORMATION) );
STARTUPINFO si;
char * exefile, * envp;
int flags;
@@ -55,14 +57,14 @@ value win_create_process_native(value cm
}
/* Create the process */
if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
- TRUE, flags, envp, NULL, &si, &pi)) {
+ TRUE, flags, envp, NULL, &si, pi)) {
win32_maperr(GetLastError());
uerror("create_process", cmd);
}
- CloseHandle(pi.hThread);
- /* Return the process handle as pseudo-PID
- (this is consistent with the wait() emulation in the MSVC C library */
- return Val_int(pi.hProcess);
+ /* CloseHandle(pi.hThread);
+ CloseHandle(pi.hProcess); */
+ caml_pid_table_insert( pi );
+ return Val_int(pi->dwProcessId);
}
CAMLprim value win_create_process(value * argv, int argn)
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/getpid.c win32unix/getpid.c
--- win32unix.orig/getpid.c 2007-02-01 18:17:02.536575800 +0100
+++ win32unix/getpid.c 2007-02-01 17:01:31.076459100 +0100
@@ -15,10 +15,9 @@
#include <mlvalues.h>
#include "unixsupport.h"
-
-extern value val_process_id;
+#include <process.h>
CAMLprim value unix_getpid(value unit)
{
- return val_process_id;
+ return Val_int(_getpid());
}
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/pidtable.c win32unix/pidtable.c
--- win32unix.orig/pidtable.c 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.c 2007-03-16 13:14:52.826058800 +0100
@@ -0,0 +1,106 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/* This file is contributed by Christoph Bauer (2007) */
+/* */
+/***********************************************************************/
+
+
+
+#include "pidtable.h"
+#include "unixsupport.h"
+#include <process.h>
+
+#ifdef PIDTABLE_DEBUG
+#include <stdio.h>
+#endif
+
+#define PID_TABLE_INITIAL_SIZE 16
+
+PROCESS_INFORMATION ** caml_pid_table = NULL;
+
+static int pid_table_size = 0;
+static int pid_table_used = 0;
+
+static
+void resize_pid_table( int delta ) {
+ pid_table_used += delta;
+ if( pid_table_used > PID_TABLE_INITIAL_SIZE &&
+ pid_table_used < pid_table_size / 4 ) {
+ pid_table_size /= 2;
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ } else if ( pid_table_used >= pid_table_size ) {
+ pid_table_size = pid_table_size > 0 ? 2 * pid_table_size : PID_TABLE_INITIAL_SIZE;
+ /* delta is 1 or -1, therefore pid_table_size > pid_table_used holds */
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ }
+}
+
+static
+int pid_table_index( int pid, int min, int max ) {
+#ifdef PIDTABLE_DEBUG
+ printf( "pid=%d, min=%d, max=%d, used=%d\n", pid, min, max, pid_table_used);
+#endif
+ if( min >= max ) return min;
+ else {
+ int m = (min+max)/2;
+ if( m >= pid_table_used-1 ) return (pid_table_used-1);
+ if( caml_pid_table[m]->dwProcessId == pid ) return m;
+ else if( caml_pid_table[m]->dwProcessId < pid )
+ return pid_table_index( pid, min, m-1 );
+ else
+ return pid_table_index( pid, m+1, max );
+
+ }
+}
+
+void caml_pid_table_insert(PROCESS_INFORMATION * pi) {
+ int i;
+ resize_pid_table( 1 );
+ i = pid_table_index( pi->dwProcessId, 0, pid_table_used );
+ if( i < pid_table_used )
+ memmove( &caml_pid_table[i + 1], &caml_pid_table[i],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table));
+ caml_pid_table[i] = pi;
+#ifdef PIDTABLE_DEBUG
+ printf( "insert at %d\n", i);
+ for( i = 0; i < pid_table_used; ++i )
+ printf( "pidtable[%d]=%d\n", i, caml_pid_table[i]->dwProcessId );
+#endif
+}
+
+PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+#ifdef PIDTABLE_DEBUG
+ printf("lookup %d at %d\n", pid, i );
+#endif
+ if( i >= pid_table_used ||
+ caml_pid_table[i]->dwProcessId != pid ) return NULL;
+ else return caml_pid_table[i];
+}
+
+void caml_pid_table_remove( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+ if( i < pid_table_used &&
+ caml_pid_table[i]->dwProcessId == pid ) {
+ CloseHandle(caml_pid_table[i]->hProcess);
+ CloseHandle(caml_pid_table[i]->hThread);
+ free( caml_pid_table[i] );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i], &caml_pid_table[i+1],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table) );
+ resize_pid_table( -1 );
+ }
+}
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/pidtable.h win32unix/pidtable.h
--- win32unix.orig/pidtable.h 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.h 2007-03-16 12:51:16.936093000 +0100
@@ -0,0 +1,21 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/* This file is contributed by Christoph Bauer (2007) */
+/* */
+/***********************************************************************/
+
+#include "unixsupport.h"
+#include <process.h>
+
+extern PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid );
+extern void caml_pid_table_remove( pid_t pid );
+void caml_pid_table_insert(PROCESS_INFORMATION * pi);
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/startup.c win32unix/startup.c
--- win32unix.orig/startup.c 2007-02-01 18:17:02.676964100 +0100
+++ win32unix/startup.c 2006-10-20 16:29:03.054744300 +0200
@@ -17,8 +17,6 @@
#include <mlvalues.h>
#include "unixsupport.h"
-value val_process_id;
-
CAMLprim value win_startup(unit)
value unit;
{
@@ -27,10 +25,6 @@ CAMLprim value win_startup(unit)
HANDLE h;
(void) WSAStartup(MAKEWORD(2, 0), &wsaData);
- DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
- GetCurrentProcess(), &h, 0, TRUE,
- DUPLICATE_SAME_ACCESS);
- val_process_id = Val_int(h);
return Val_unit;
}
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/unixsupport.h win32unix/unixsupport.h
--- win32unix.orig/unixsupport.h 2007-02-01 18:17:02.708161500 +0100
+++ win32unix/unixsupport.h 2007-02-01 17:23:05.935409900 +0100
@@ -13,6 +13,9 @@
/* $Id: unixsupport.h,v 1.16 2005/09/22 14:21:50 xleroy Exp $ */
+#ifndef CAML_UNIX_SUPPORT_H
+#define CAML_UNIX_SUPPORT_H
+
#define WIN32_LEAN_AND_MEAN
#include <wtypes.h>
#include <winbase.h>
@@ -52,3 +55,4 @@ extern void uerror (char * cmdname, valu
extern value unix_freeze_buffer (value);
#define UNIX_BUFFER_SIZE 16384
+#endif
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/winwait.c win32unix/winwait.c
--- win32unix.orig/winwait.c 2007-02-01 18:17:02.723760200 +0100
+++ win32unix/winwait.c 2007-02-01 17:28:24.179709500 +0100
@@ -18,9 +18,11 @@
#include <alloc.h>
#include <memory.h>
#include "unixsupport.h"
+#include "pidtable.h"
#include <sys/types.h>
+#include <errno.h>
-static value alloc_process_status(HANDLE pid, int status)
+static value alloc_process_status(pid_t pid, int status)
{
value res, st;
@@ -28,7 +30,7 @@ static value alloc_process_status(HANDLE
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
- Field(res, 0) = Val_long((intnat) pid);
+ Field(res, 0) = Val_int(pid);
Field(res, 1) = st;
End_roots();
return res;
@@ -38,25 +40,37 @@ enum { CAML_WNOHANG = 1, CAML_WUNTRACED
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
-CAMLprim value win_waitpid(value vflags, value vpid_req)
+CAMLprim value win_waitpid(value vflags, value vpid)
{
int flags;
DWORD status;
- HANDLE pid_req = (HANDLE) Long_val(vpid_req);
+ pid_t pid = Int_val( vpid );
+
+ PROCESS_INFORMATION * pi = caml_pid_table_lookup( pid );
+
+ if( pi == NULL ) {
+ unix_error(EINVAL, "waitpid", Nothing );
+ }
+
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
- if (WaitForSingleObject(pid_req, INFINITE) == WAIT_FAILED) {
+ if (WaitForSingleObject(pi->hProcess, INFINITE) == WAIT_FAILED) {
+ caml_pid_table_remove( pi->dwProcessId );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
}
- if (! GetExitCodeProcess(pid_req, &status)) {
+ if (! GetExitCodeProcess(pi->hProcess, &status)) {
+ caml_pid_table_remove( pi->dwProcessId );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
+
if (status == STILL_ACTIVE)
- return alloc_process_status((HANDLE) 0, 0);
- else
- return alloc_process_status(pid_req, status);
+ return alloc_process_status(0, 0);
+ else {
+ caml_pid_table_remove( pi->dwProcessId );
+ return alloc_process_status(pid, status);
+ }
}
getpid-patch2d.diff [^] (12,137 bytes) 2007-03-16 16:56 [Show Content] [Hide Content]diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/Makefile.nt win32unix/Makefile.nt
--- win32unix.orig/Makefile.nt 2007-02-01 18:17:02.583371900 +0100
+++ win32unix/Makefile.nt 2007-02-01 17:14:25.062831700 +0100
@@ -27,7 +27,7 @@ WIN_FILES = accept.c bind.c channels.c c
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
getpeername.c getpid.c getsockname.c gettimeofday.c \
link.c listen.c lockf.c lseek.c nonblock.c \
- mkdir.c open.c pipe.c read.c rename.c \
+ mkdir.c open.c pidtable.c pipe.c read.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
system.c unixsupport.c windir.c winwait.c write.c
@@ -62,7 +62,7 @@ dllunix.dll: $(DOBJS)
libunix.$(A): $(SOBJS)
$(call MKLIB,libunix.$(A),$(SOBJS))
-$(DOBJS) $(SOBJS): unixsupport.h
+$(DOBJS) $(SOBJS): unixsupport.h pidtable.h
unix.cma: $(CAML_OBJS)
$(CAMLC) -a -linkall -o unix.cma $(CAML_OBJS) \
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/createprocess.c win32unix/createprocess.c
--- win32unix.orig/createprocess.c 2007-02-01 18:17:02.520977100 +0100
+++ win32unix/createprocess.c 2007-02-01 17:18:42.446460700 +0100
@@ -17,13 +17,15 @@
#include <mlvalues.h>
#include <osdeps.h>
#include "unixsupport.h"
+#include "pidtable.h"
static int win_has_console(void);
value win_create_process_native(value cmd, value cmdline, value env,
value fd1, value fd2, value fd3)
{
- PROCESS_INFORMATION pi;
+ PROCESS_INFORMATION * pi =
+ (PROCESS_INFORMATION*) malloc( sizeof(PROCESS_INFORMATION) );
STARTUPINFO si;
char * exefile, * envp;
int flags;
@@ -55,14 +57,14 @@ value win_create_process_native(value cm
}
/* Create the process */
if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
- TRUE, flags, envp, NULL, &si, &pi)) {
+ TRUE, flags, envp, NULL, &si, pi)) {
win32_maperr(GetLastError());
uerror("create_process", cmd);
}
- CloseHandle(pi.hThread);
- /* Return the process handle as pseudo-PID
- (this is consistent with the wait() emulation in the MSVC C library */
- return Val_int(pi.hProcess);
+ /* CloseHandle(pi.hThread);
+ CloseHandle(pi.hProcess); */
+ caml_pid_table_insert( pi );
+ return Val_int(pi->dwProcessId);
}
CAMLprim value win_create_process(value * argv, int argn)
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/getpid.c win32unix/getpid.c
--- win32unix.orig/getpid.c 2007-02-01 18:17:02.536575800 +0100
+++ win32unix/getpid.c 2007-02-01 17:01:31.076459100 +0100
@@ -15,10 +15,9 @@
#include <mlvalues.h>
#include "unixsupport.h"
-
-extern value val_process_id;
+#include <process.h>
CAMLprim value unix_getpid(value unit)
{
- return val_process_id;
+ return Val_int(_getpid());
}
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/pidtable.c win32unix/pidtable.c
--- win32unix.orig/pidtable.c 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.c 2007-03-16 15:25:39.747846900 +0100
@@ -0,0 +1,109 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/* This file is contributed by Christoph Bauer (2007) */
+/* */
+/***********************************************************************/
+
+
+
+#include "pidtable.h"
+#include "unixsupport.h"
+#include <process.h>
+#include <stdint.h>
+
+#define PIDTABLE_DEBUG 0
+
+#ifdef PIDTABLE_DEBUG
+#include <stdio.h>
+#endif
+
+#define PID_TABLE_INITIAL_SIZE 16
+
+PROCESS_INFORMATION ** caml_pid_table = NULL;
+
+static int pid_table_size = 0;
+static int pid_table_used = 0;
+
+static
+void resize_pid_table( int delta ) {
+ pid_table_used += delta;
+ if( pid_table_used > PID_TABLE_INITIAL_SIZE &&
+ pid_table_used < pid_table_size / 4 ) {
+ pid_table_size /= 2;
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ } else if ( pid_table_used >= pid_table_size ) {
+ pid_table_size = pid_table_size > 0 ? 2 * pid_table_size : PID_TABLE_INITIAL_SIZE;
+ /* delta is 1 or -1, therefore pid_table_size > pid_table_used holds */
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ }
+}
+
+static
+int pid_table_index( int pid, int min, int max ) {
+#ifdef PIDTABLE_DEBUG
+ printf( "pid=%d, min=%d, max=%d, used=%d\n", pid, min, max, pid_table_used);
+#endif
+ if( min >= max ) return max;
+ else {
+ int m = (min+max)/2;
+ if( caml_pid_table[m]->dwProcessId == pid ) return m;
+ else if( caml_pid_table[m]->dwProcessId > pid )
+ return pid_table_index( pid, min, m-1 );
+ else
+ return pid_table_index( pid, m+1, max );
+
+ }
+}
+
+void caml_pid_table_insert(PROCESS_INFORMATION * pi) {
+ int i;
+ i = pid_table_index( pi->dwProcessId, 0, pid_table_used-1 );
+ if( i < 0 || caml_pid_table[i]->dwProcessId < pi->dwProcessId ) i++;
+ resize_pid_table( 1 );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i + 1], &caml_pid_table[i],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table));
+ caml_pid_table[i] = pi;
+#ifdef PIDTABLE_DEBUG
+ printf( "insert at %d\n", i);
+ for( i = 0; i < pid_table_used; ++i )
+ printf( "pidtable[%d]=%d\n", i, caml_pid_table[i]->dwProcessId );
+#endif
+}
+
+PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+#ifdef PIDTABLE_DEBUG
+ printf("lookup %d at %d\n", pid, i );
+#endif
+ if( i >= pid_table_used ||
+ caml_pid_table[i]->dwProcessId != pid ) return NULL;
+ else return caml_pid_table[i];
+}
+
+void caml_pid_table_remove( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+ if( i < pid_table_used &&
+ caml_pid_table[i]->dwProcessId == pid ) {
+ CloseHandle(caml_pid_table[i]->hProcess);
+ CloseHandle(caml_pid_table[i]->hThread);
+ free( caml_pid_table[i] );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i], &caml_pid_table[i+1],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table) );
+ resize_pid_table( -1 );
+ }
+}
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/pidtable.h win32unix/pidtable.h
--- win32unix.orig/pidtable.h 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.h 2007-03-16 12:51:16.936093000 +0100
@@ -0,0 +1,21 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/* This file is contributed by Christoph Bauer (2007) */
+/* */
+/***********************************************************************/
+
+#include "unixsupport.h"
+#include <process.h>
+
+extern PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid );
+extern void caml_pid_table_remove( pid_t pid );
+void caml_pid_table_insert(PROCESS_INFORMATION * pi);
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/startup.c win32unix/startup.c
--- win32unix.orig/startup.c 2007-02-01 18:17:02.676964100 +0100
+++ win32unix/startup.c 2006-10-20 16:29:03.054744300 +0200
@@ -17,8 +17,6 @@
#include <mlvalues.h>
#include "unixsupport.h"
-value val_process_id;
-
CAMLprim value win_startup(unit)
value unit;
{
@@ -27,10 +25,6 @@ CAMLprim value win_startup(unit)
HANDLE h;
(void) WSAStartup(MAKEWORD(2, 0), &wsaData);
- DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
- GetCurrentProcess(), &h, 0, TRUE,
- DUPLICATE_SAME_ACCESS);
- val_process_id = Val_int(h);
return Val_unit;
}
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/unixsupport.h win32unix/unixsupport.h
--- win32unix.orig/unixsupport.h 2007-02-01 18:17:02.708161500 +0100
+++ win32unix/unixsupport.h 2007-02-01 17:23:05.935409900 +0100
@@ -13,6 +13,9 @@
/* $Id: unixsupport.h,v 1.16 2005/09/22 14:21:50 xleroy Exp $ */
+#ifndef CAML_UNIX_SUPPORT_H
+#define CAML_UNIX_SUPPORT_H
+
#define WIN32_LEAN_AND_MEAN
#include <wtypes.h>
#include <winbase.h>
@@ -52,3 +55,4 @@ extern void uerror (char * cmdname, valu
extern value unix_freeze_buffer (value);
#define UNIX_BUFFER_SIZE 16384
+#endif
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/winwait.c win32unix/winwait.c
--- win32unix.orig/winwait.c 2007-02-01 18:17:02.723760200 +0100
+++ win32unix/winwait.c 2007-02-01 17:28:24.179709500 +0100
@@ -18,9 +18,11 @@
#include <alloc.h>
#include <memory.h>
#include "unixsupport.h"
+#include "pidtable.h"
#include <sys/types.h>
+#include <errno.h>
-static value alloc_process_status(HANDLE pid, int status)
+static value alloc_process_status(pid_t pid, int status)
{
value res, st;
@@ -28,7 +30,7 @@ static value alloc_process_status(HANDLE
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
- Field(res, 0) = Val_long((intnat) pid);
+ Field(res, 0) = Val_int(pid);
Field(res, 1) = st;
End_roots();
return res;
@@ -38,25 +40,37 @@ enum { CAML_WNOHANG = 1, CAML_WUNTRACED
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
-CAMLprim value win_waitpid(value vflags, value vpid_req)
+CAMLprim value win_waitpid(value vflags, value vpid)
{
int flags;
DWORD status;
- HANDLE pid_req = (HANDLE) Long_val(vpid_req);
+ pid_t pid = Int_val( vpid );
+
+ PROCESS_INFORMATION * pi = caml_pid_table_lookup( pid );
+
+ if( pi == NULL ) {
+ unix_error(EINVAL, "waitpid", Nothing );
+ }
+
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
- if (WaitForSingleObject(pid_req, INFINITE) == WAIT_FAILED) {
+ if (WaitForSingleObject(pi->hProcess, INFINITE) == WAIT_FAILED) {
+ caml_pid_table_remove( pi->dwProcessId );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
}
- if (! GetExitCodeProcess(pid_req, &status)) {
+ if (! GetExitCodeProcess(pi->hProcess, &status)) {
+ caml_pid_table_remove( pi->dwProcessId );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
+
if (status == STILL_ACTIVE)
- return alloc_process_status((HANDLE) 0, 0);
- else
- return alloc_process_status(pid_req, status);
+ return alloc_process_status(0, 0);
+ else {
+ caml_pid_table_remove( pi->dwProcessId );
+ return alloc_process_status(pid, status);
+ }
}
getpid-patch2e.diff [^] (12,166 bytes) 2007-04-24 11:29 [Show Content] [Hide Content]diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/Makefile.nt win32unix/Makefile.nt
--- win32unix.orig/Makefile.nt 2007-02-01 18:17:02.583371900 +0100
+++ win32unix/Makefile.nt 2007-02-01 17:14:25.062831700 +0100
@@ -27,7 +27,7 @@ WIN_FILES = accept.c bind.c channels.c c
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
getpeername.c getpid.c getsockname.c gettimeofday.c \
link.c listen.c lockf.c lseek.c nonblock.c \
- mkdir.c open.c pipe.c read.c rename.c \
+ mkdir.c open.c pidtable.c pipe.c read.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
system.c unixsupport.c windir.c winwait.c write.c
@@ -62,7 +62,7 @@ dllunix.dll: $(DOBJS)
libunix.$(A): $(SOBJS)
$(call MKLIB,libunix.$(A),$(SOBJS))
-$(DOBJS) $(SOBJS): unixsupport.h
+$(DOBJS) $(SOBJS): unixsupport.h pidtable.h
unix.cma: $(CAML_OBJS)
$(CAMLC) -a -linkall -o unix.cma $(CAML_OBJS) \
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/createprocess.c win32unix/createprocess.c
--- win32unix.orig/createprocess.c 2007-02-01 18:17:02.520977100 +0100
+++ win32unix/createprocess.c 2007-02-01 17:18:42.446460700 +0100
@@ -17,13 +17,15 @@
#include <mlvalues.h>
#include <osdeps.h>
#include "unixsupport.h"
+#include "pidtable.h"
static int win_has_console(void);
value win_create_process_native(value cmd, value cmdline, value env,
value fd1, value fd2, value fd3)
{
- PROCESS_INFORMATION pi;
+ PROCESS_INFORMATION * pi =
+ (PROCESS_INFORMATION*) malloc( sizeof(PROCESS_INFORMATION) );
STARTUPINFO si;
char * exefile, * envp;
int flags;
@@ -55,14 +57,14 @@ value win_create_process_native(value cm
}
/* Create the process */
if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
- TRUE, flags, envp, NULL, &si, &pi)) {
+ TRUE, flags, envp, NULL, &si, pi)) {
win32_maperr(GetLastError());
uerror("create_process", cmd);
}
- CloseHandle(pi.hThread);
- /* Return the process handle as pseudo-PID
- (this is consistent with the wait() emulation in the MSVC C library */
- return Val_int(pi.hProcess);
+ /* CloseHandle(pi.hThread);
+ CloseHandle(pi.hProcess); */
+ caml_pid_table_insert( pi );
+ return Val_int(pi->dwProcessId);
}
CAMLprim value win_create_process(value * argv, int argn)
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/getpid.c win32unix/getpid.c
--- win32unix.orig/getpid.c 2007-02-01 18:17:02.536575800 +0100
+++ win32unix/getpid.c 2007-02-01 17:01:31.076459100 +0100
@@ -15,10 +15,9 @@
#include <mlvalues.h>
#include "unixsupport.h"
-
-extern value val_process_id;
+#include <process.h>
CAMLprim value unix_getpid(value unit)
{
- return val_process_id;
+ return Val_int(_getpid());
}
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/pidtable.c win32unix/pidtable.c
--- win32unix.orig/pidtable.c 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.c 2007-04-24 11:12:51.061593400 +0200
@@ -0,0 +1,110 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/* This file is contributed by Christoph Bauer (2007) */
+/* */
+/***********************************************************************/
+
+
+
+#include "pidtable.h"
+#include "unixsupport.h"
+#include <process.h>
+#include <stdint.h>
+
+/* #define PIDTABLE_DEBUG 1 */
+#undef PIDTABLE_DEBUG
+
+#ifdef PIDTABLE_DEBUG
+#include <stdio.h>
+#endif
+
+#define PID_TABLE_INITIAL_SIZE 16
+
+PROCESS_INFORMATION ** caml_pid_table = NULL;
+
+static int pid_table_size = 0;
+static int pid_table_used = 0;
+
+static
+void resize_pid_table( int delta ) {
+ pid_table_used += delta;
+ if( pid_table_used > PID_TABLE_INITIAL_SIZE &&
+ pid_table_used < pid_table_size / 4 ) {
+ pid_table_size /= 2;
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ } else if ( pid_table_used >= pid_table_size ) {
+ pid_table_size = pid_table_size > 0 ? 2 * pid_table_size : PID_TABLE_INITIAL_SIZE;
+ /* delta is 1 or -1, therefore pid_table_size > pid_table_used holds */
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ }
+}
+
+static
+int pid_table_index( int pid, int min, int max ) {
+#ifdef PIDTABLE_DEBUG
+ printf( "pid=%d, min=%d, max=%d, used=%d\n", pid, min, max, pid_table_used);
+#endif
+ if( min >= max ) return max;
+ else {
+ int m = (min+max)/2;
+ if( caml_pid_table[m]->dwProcessId == pid ) return m;
+ else if( caml_pid_table[m]->dwProcessId > pid )
+ return pid_table_index( pid, min, m-1 );
+ else
+ return pid_table_index( pid, m+1, max );
+
+ }
+}
+
+void caml_pid_table_insert(PROCESS_INFORMATION * pi) {
+ int i;
+ i = pid_table_index( pi->dwProcessId, 0, pid_table_used-1 );
+ if( i < 0 || caml_pid_table[i]->dwProcessId < pi->dwProcessId ) i++;
+ resize_pid_table( 1 );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i + 1], &caml_pid_table[i],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table));
+ caml_pid_table[i] = pi;
+#ifdef PIDTABLE_DEBUG
+ printf( "insert at %d\n", i);
+ for( i = 0; i < pid_table_used; ++i )
+ printf( "pidtable[%d]=%d\n", i, caml_pid_table[i]->dwProcessId );
+#endif
+}
+
+PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+#ifdef PIDTABLE_DEBUG
+ printf("lookup %d at %d\n", pid, i );
+#endif
+ if( i >= pid_table_used ||
+ caml_pid_table[i]->dwProcessId != pid ) return NULL;
+ else return caml_pid_table[i];
+}
+
+void caml_pid_table_remove( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+ if( i < pid_table_used &&
+ caml_pid_table[i]->dwProcessId == pid ) {
+ CloseHandle(caml_pid_table[i]->hProcess);
+ CloseHandle(caml_pid_table[i]->hThread);
+ free( caml_pid_table[i] );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i], &caml_pid_table[i+1],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table) );
+ resize_pid_table( -1 );
+ }
+}
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/pidtable.h win32unix/pidtable.h
--- win32unix.orig/pidtable.h 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.h 2007-03-16 12:51:16.936093000 +0100
@@ -0,0 +1,21 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/* This file is contributed by Christoph Bauer (2007) */
+/* */
+/***********************************************************************/
+
+#include "unixsupport.h"
+#include <process.h>
+
+extern PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid );
+extern void caml_pid_table_remove( pid_t pid );
+void caml_pid_table_insert(PROCESS_INFORMATION * pi);
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/startup.c win32unix/startup.c
--- win32unix.orig/startup.c 2007-02-01 18:17:02.676964100 +0100
+++ win32unix/startup.c 2006-10-20 16:29:03.054744300 +0200
@@ -17,8 +17,6 @@
#include <mlvalues.h>
#include "unixsupport.h"
-value val_process_id;
-
CAMLprim value win_startup(unit)
value unit;
{
@@ -27,10 +25,6 @@ CAMLprim value win_startup(unit)
HANDLE h;
(void) WSAStartup(MAKEWORD(2, 0), &wsaData);
- DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
- GetCurrentProcess(), &h, 0, TRUE,
- DUPLICATE_SAME_ACCESS);
- val_process_id = Val_int(h);
return Val_unit;
}
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/unixsupport.h win32unix/unixsupport.h
--- win32unix.orig/unixsupport.h 2007-02-01 18:17:02.708161500 +0100
+++ win32unix/unixsupport.h 2007-02-01 17:23:05.935409900 +0100
@@ -13,6 +13,9 @@
/* $Id: unixsupport.h,v 1.16 2005/09/22 14:21:50 xleroy Exp $ */
+#ifndef CAML_UNIX_SUPPORT_H
+#define CAML_UNIX_SUPPORT_H
+
#define WIN32_LEAN_AND_MEAN
#include <wtypes.h>
#include <winbase.h>
@@ -52,3 +55,4 @@ extern void uerror (char * cmdname, valu
extern value unix_freeze_buffer (value);
#define UNIX_BUFFER_SIZE 16384
+#endif
diff --exclude='*.o' --exclude='*~' --exclude='.*' -urpwN win32unix.orig/winwait.c win32unix/winwait.c
--- win32unix.orig/winwait.c 2007-02-01 18:17:02.723760200 +0100
+++ win32unix/winwait.c 2007-02-01 17:28:24.179709500 +0100
@@ -18,9 +18,11 @@
#include <alloc.h>
#include <memory.h>
#include "unixsupport.h"
+#include "pidtable.h"
#include <sys/types.h>
+#include <errno.h>
-static value alloc_process_status(HANDLE pid, int status)
+static value alloc_process_status(pid_t pid, int status)
{
value res, st;
@@ -28,7 +30,7 @@ static value alloc_process_status(HANDLE
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
- Field(res, 0) = Val_long((intnat) pid);
+ Field(res, 0) = Val_int(pid);
Field(res, 1) = st;
End_roots();
return res;
@@ -38,25 +40,37 @@ enum { CAML_WNOHANG = 1, CAML_WUNTRACED
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
-CAMLprim value win_waitpid(value vflags, value vpid_req)
+CAMLprim value win_waitpid(value vflags, value vpid)
{
int flags;
DWORD status;
- HANDLE pid_req = (HANDLE) Long_val(vpid_req);
+ pid_t pid = Int_val( vpid );
+
+ PROCESS_INFORMATION * pi = caml_pid_table_lookup( pid );
+
+ if( pi == NULL ) {
+ unix_error(EINVAL, "waitpid", Nothing );
+ }
+
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
- if (WaitForSingleObject(pid_req, INFINITE) == WAIT_FAILED) {
+ if (WaitForSingleObject(pi->hProcess, INFINITE) == WAIT_FAILED) {
+ caml_pid_table_remove( pi->dwProcessId );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
}
- if (! GetExitCodeProcess(pid_req, &status)) {
+ if (! GetExitCodeProcess(pi->hProcess, &status)) {
+ caml_pid_table_remove( pi->dwProcessId );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
+
if (status == STILL_ACTIVE)
- return alloc_process_status((HANDLE) 0, 0);
- else
- return alloc_process_status(pid_req, status);
+ return alloc_process_status(0, 0);
+ else {
+ caml_pid_table_remove( pi->dwProcessId );
+ return alloc_process_status(pid, status);
+ }
}
getpid-patch2f.diff [^] (13,034 bytes) 2008-01-22 17:33 [Show Content] [Hide Content]diff --exclude='*.o' --exclude='*~' --exclude='.*' --exclude='*.rej' --exclude='*.orig' -urpwN win32unix.orig/Makefile.nt win32unix/Makefile.nt
--- win32unix.orig/Makefile.nt 2008-01-22 12:58:12.547373200 +0100
+++ win32unix/Makefile.nt 2008-01-21 10:09:35.140045600 +0100
@@ -27,7 +27,7 @@ WIN_FILES = accept.c bind.c channels.c c
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
getpeername.c getpid.c getsockname.c gettimeofday.c \
link.c listen.c lockf.c lseek.c nonblock.c \
- mkdir.c open.c pipe.c read.c rename.c \
+ mkdir.c open.c pidtable.c pipe.c read.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
system.c unixsupport.c windir.c winwait.c write.c
@@ -62,7 +62,7 @@ dllunix.dll: $(DOBJS)
libunix.$(A): $(SOBJS)
$(call MKLIB,libunix.$(A),$(SOBJS))
-$(DOBJS) $(SOBJS): unixsupport.h
+$(DOBJS) $(SOBJS): unixsupport.h pidtable.h
unix.cma: $(CAML_OBJS)
$(CAMLC) -a -linkall -o unix.cma $(CAML_OBJS) \
diff --exclude='*.o' --exclude='*~' --exclude='.*' --exclude='*.rej' --exclude='*.orig' -urpwN win32unix.orig/createprocess.c win32unix/createprocess.c
--- win32unix.orig/createprocess.c 2008-01-22 12:58:12.344265100 +0100
+++ win32unix/createprocess.c 2008-01-21 10:11:21.245319600 +0100
@@ -17,13 +17,15 @@
#include <mlvalues.h>
#include <osdeps.h>
#include "unixsupport.h"
+#include "pidtable.h"
static int win_has_console(void);
value win_create_process_native(value cmd, value cmdline, value env,
value fd1, value fd2, value fd3)
{
- PROCESS_INFORMATION pi;
+ PROCESS_INFORMATION * pi =
+ (PROCESS_INFORMATION*) malloc( sizeof(PROCESS_INFORMATION) );
STARTUPINFO si;
char * exefile, * envp;
int flags;
@@ -55,14 +57,12 @@ value win_create_process_native(value cm
}
/* Create the process */
if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
- TRUE, flags, envp, NULL, &si, &pi)) {
+ TRUE, flags, envp, NULL, &si, pi)) {
win32_maperr(GetLastError());
uerror("create_process", cmd);
}
- CloseHandle(pi.hThread);
- /* Return the process handle as pseudo-PID
- (this is consistent with the wait() emulation in the MSVC C library */
- return Val_long(pi.hProcess);
+ caml_pid_table_insert( pi );
+ return Val_long(pi->dwProcessId);
}
CAMLprim value win_create_process(value * argv, int argn)
diff --exclude='*.o' --exclude='*~' --exclude='.*' --exclude='*.rej' --exclude='*.orig' -urpwN win32unix.orig/getpid.c win32unix/getpid.c
--- win32unix.orig/getpid.c 2008-01-22 12:58:12.438007300 +0100
+++ win32unix/getpid.c 2008-01-21 10:09:35.171241600 +0100
@@ -15,10 +15,9 @@
#include <mlvalues.h>
#include "unixsupport.h"
-
-extern value val_process_id;
+#include <process.h>
CAMLprim value unix_getpid(value unit)
{
- return val_process_id;
+ return Val_int(_getpid());
}
diff --exclude='*.o' --exclude='*~' --exclude='.*' --exclude='*.rej' --exclude='*.orig' -urpwN win32unix.orig/pidtable.c win32unix/pidtable.c
--- win32unix.orig/pidtable.c 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.c 2008-01-22 17:24:04.613352900 +0100
@@ -0,0 +1,115 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/* This file is contributed by Christoph Bauer (2007) */
+/* */
+/***********************************************************************/
+
+
+
+#include "pidtable.h"
+#include "unixsupport.h"
+#include <process.h>
+#include <stdint.h>
+
+/* #define PIDTABLE_DEBUG 1 */
+#undef PIDTABLE_DEBUG
+
+#ifdef PIDTABLE_DEBUG
+#include <stdio.h>
+#endif
+
+#define PID_TABLE_INITIAL_SIZE 16
+
+PROCESS_INFORMATION ** caml_pid_table = NULL;
+
+static int pid_table_size = 0;
+static int pid_table_used = 0;
+
+static
+void resize_pid_table( int delta ) {
+ pid_table_used += delta;
+ if( pid_table_used > PID_TABLE_INITIAL_SIZE &&
+ pid_table_used < pid_table_size / 4 ) {
+ pid_table_size /= 2;
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ } else if ( pid_table_used >= pid_table_size ) {
+ pid_table_size = pid_table_size > 0 ? 2 * pid_table_size : PID_TABLE_INITIAL_SIZE;
+ /* delta is 1 or -1, therefore pid_table_size > pid_table_used holds */
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ }
+}
+
+static
+int pid_table_index( int pid, int min, int max ) {
+#ifdef PIDTABLE_DEBUG
+ printf( "pid=%d, min=%d, max=%d, used=%d\n", pid, min, max, pid_table_used);
+#endif
+ if( min >= max ) return max;
+ else {
+ int m = (min+max)/2;
+ if( caml_pid_table[m]->dwProcessId == pid ) return m;
+ else if( caml_pid_table[m]->dwProcessId > pid )
+ return pid_table_index( pid, min, m-1 );
+ else
+ return pid_table_index( pid, m+1, max );
+
+ }
+}
+
+void caml_pid_table_insert(PROCESS_INFORMATION * pi) {
+ int i;
+ i = pid_table_index( pi->dwProcessId, 0, pid_table_used-1 );
+ if( i < 0 || caml_pid_table[i]->dwProcessId < pi->dwProcessId ) i++;
+ resize_pid_table( 1 );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i + 1], &caml_pid_table[i],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table));
+ caml_pid_table[i] = pi;
+#ifdef PIDTABLE_DEBUG
+ printf( "insert at %d\n", i);
+ for( i = 0; i < pid_table_used; ++i )
+ printf( "pidtable[%d]=%d\n", i, caml_pid_table[i]->dwProcessId );
+#endif
+}
+
+PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+#ifdef PIDTABLE_DEBUG
+ printf("lookup %d at %d\n", pid, i );
+#endif
+ if( i >= pid_table_used ||
+ caml_pid_table[i]->dwProcessId != pid ) return NULL;
+ else return caml_pid_table[i];
+}
+
+void caml_pid_table_remove( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+
+#ifdef PIDTABLE_DEBUG
+ printf("remove %d at %d\n", pid, i );
+#endif
+
+ if( i < pid_table_used &&
+ caml_pid_table[i]->dwProcessId == pid ) {
+ CloseHandle(caml_pid_table[i]->hProcess);
+ CloseHandle(caml_pid_table[i]->hThread);
+ free( caml_pid_table[i] );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i], &caml_pid_table[i+1],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table) );
+ resize_pid_table( -1 );
+ }
+}
diff --exclude='*.o' --exclude='*~' --exclude='.*' --exclude='*.rej' --exclude='*.orig' -urpwN win32unix.orig/pidtable.h win32unix/pidtable.h
--- win32unix.orig/pidtable.h 1970-01-01 01:00:00.000000000 +0100
+++ win32unix/pidtable.h 2008-01-21 10:09:35.202437600 +0100
@@ -0,0 +1,21 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/* This file is contributed by Christoph Bauer (2007) */
+/* */
+/***********************************************************************/
+
+#include "unixsupport.h"
+#include <process.h>
+
+extern PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid );
+extern void caml_pid_table_remove( pid_t pid );
+void caml_pid_table_insert(PROCESS_INFORMATION * pi);
diff --exclude='*.o' --exclude='*~' --exclude='.*' --exclude='*.rej' --exclude='*.orig' -urpwN win32unix.orig/startup.c win32unix/startup.c
--- win32unix.orig/startup.c 2008-01-22 12:58:12.719233900 +0100
+++ win32unix/startup.c 2008-01-21 10:09:35.202437600 +0100
@@ -17,8 +17,6 @@
#include <mlvalues.h>
#include "unixsupport.h"
-value val_process_id;
-
CAMLprim value win_startup(unit)
value unit;
{
@@ -27,10 +25,6 @@ CAMLprim value win_startup(unit)
HANDLE h;
(void) WSAStartup(MAKEWORD(2, 0), &wsaData);
- DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
- GetCurrentProcess(), &h, 0, TRUE,
- DUPLICATE_SAME_ACCESS);
- val_process_id = Val_int(h);
return Val_unit;
}
diff --exclude='*.o' --exclude='*~' --exclude='.*' --exclude='*.rej' --exclude='*.orig' -urpwN win32unix.orig/unixsupport.h win32unix/unixsupport.h
--- win32unix.orig/unixsupport.h 2008-01-22 12:58:12.812976100 +0100
+++ win32unix/unixsupport.h 2008-01-21 10:09:35.202437600 +0100
@@ -13,6 +13,9 @@
/* $Id: unixsupport.h,v 1.19 2007/02/07 14:45:46 doligez Exp $ */
+#ifndef CAML_UNIX_SUPPORT_H
+#define CAML_UNIX_SUPPORT_H
+
#define WIN32_LEAN_AND_MEAN
#include <wtypes.h>
#include <winbase.h>
@@ -51,3 +54,4 @@ extern void uerror (char * cmdname, valu
extern value unix_freeze_buffer (value);
#define UNIX_BUFFER_SIZE 16384
+#endif
diff --exclude='*.o' --exclude='*~' --exclude='.*' --exclude='*.rej' --exclude='*.orig' -urpwN win32unix.orig/winwait.c win32unix/winwait.c
--- win32unix.orig/winwait.c 2008-01-22 14:39:14.240097600 +0100
+++ win32unix/winwait.c 2008-01-22 17:22:23.916250000 +0100
@@ -18,10 +18,12 @@
#include <alloc.h>
#include <memory.h>
#include "unixsupport.h"
+#include "pidtable.h"
+#include <signals.h>
#include <sys/types.h>
-#include <signal.h>
+#include <errno.h>
-static value alloc_process_status(HANDLE pid, int status)
+static value alloc_process_status(pid_t pid, int status)
{
value res, st;
@@ -29,7 +31,7 @@ static value alloc_process_status(HANDLE
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
- Field(res, 0) = Val_long((intnat) pid);
+ Field(res, 0) = Val_int(pid);
Field(res, 1) = st;
End_roots();
return res;
@@ -39,32 +41,40 @@ enum { CAML_WNOHANG = 1, CAML_WUNTRACED
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
-CAMLprim value win_waitpid(value vflags, value vpid_req)
+CAMLprim value win_waitpid(value vflags, value vpid)
{
int flags;
DWORD status, retcode;
- HANDLE pid_req = (HANDLE) Long_val(vpid_req);
+ pid_t pid = Int_val( vpid );
DWORD err = 0;
+ PROCESS_INFORMATION * pi = caml_pid_table_lookup( pid );
+
+ if( pi == NULL ) {
+ unix_error(EINVAL, "waitpid", Nothing );
+ }
+
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
- enter_blocking_section();
- retcode = WaitForSingleObject(pid_req, INFINITE);
+ caml_enter_blocking_section();
+ retcode = WaitForSingleObject(pi->hProcess, INFINITE);
if (retcode == WAIT_FAILED) err = GetLastError();
- leave_blocking_section();
+ caml_leave_blocking_section();
if (err) {
+ caml_pid_table_remove( pid );
win32_maperr(err);
uerror("waitpid", Nothing);
}
}
- if (! GetExitCodeProcess(pid_req, &status)) {
+ if (! GetExitCodeProcess(pi->hProcess, &status)) {
+ caml_pid_table_remove( pid );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
if (status == STILL_ACTIVE)
- return alloc_process_status((HANDLE) 0, 0);
+ return alloc_process_status(0, 0);
else {
- CloseHandle(pid_req);
- return alloc_process_status(pid_req, status);
+ caml_pid_table_remove( pid );
+ return alloc_process_status(pid, status);
}
}
getpid-3.11.0+beta1.patch [^] (20,574 bytes) 2008-11-12 10:33 [Show Content] [Hide Content]diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/Makefile.nt ocaml-3.11.0+beta1/otherlibs/win32unix/Makefile.nt
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/Makefile.nt 2008-07-29 10:31:41.000000000 +0200
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/Makefile.nt 2008-11-12 10:28:13.800338000 +0100
@@ -18,7 +18,7 @@ WIN_FILES = accept.c bind.c channels.c c
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
getpeername.c getpid.c getsockname.c gettimeofday.c \
link.c listen.c lockf.c lseek.c nonblock.c \
- mkdir.c open.c pipe.c read.c rename.c \
+ mkdir.c open.c pidtable.c pipe.c read.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
system.c unixsupport.c windir.c winwait.c write.c \
@@ -43,7 +43,7 @@ LINKOPTS=-cclib $(WSOCKLIB)
LDOPTS=-ldopt $(WSOCKLIB)
EXTRACAMLFLAGS=-nolabels
EXTRACFLAGS=-I../unix
-HEADERS=unixsupport.h
+HEADERS=unixsupport.h pidtable.h
include ../Makefile.nt
diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/Makefile.nt.orig ocaml-3.11.0+beta1/otherlibs/win32unix/Makefile.nt.orig
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/Makefile.nt.orig 1970-01-01 01:00:00.000000000 +0100
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/Makefile.nt.orig 2008-07-29 10:31:41.000000000 +0200
@@ -0,0 +1,61 @@
+#########################################################################
+# #
+# Objective Caml #
+# #
+# Xavier Leroy, projet Cristal, INRIA Rocquencourt #
+# #
+# Copyright 1999 Institut National de Recherche en Informatique et #
+# en Automatique. All rights reserved. This file is distributed #
+# under the terms of the GNU Library General Public License, with #
+# the special exception on linking described in file ../../LICENSE. #
+# #
+#########################################################################
+
+# $Id: Makefile.nt,v 1.37 2008/07/29 08:31:41 xleroy Exp $
+
+# Files in this directory
+WIN_FILES = accept.c bind.c channels.c close.c \
+ close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
+ getpeername.c getpid.c getsockname.c gettimeofday.c \
+ link.c listen.c lockf.c lseek.c nonblock.c \
+ mkdir.c open.c pipe.c read.c rename.c \
+ select.c sendrecv.c \
+ shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
+ system.c unixsupport.c windir.c winwait.c write.c \
+ winlist.c winworker.c windbug.c
+
+# Files from the ../unix directory
+UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \
+ cstringv.c envir.c execv.c execve.c execvp.c \
+ exit.c getcwd.c gethost.c gethostname.c getproto.c \
+ getserv.c gmtime.c putenv.c rmdir.c \
+ socketaddr.c strofaddr.c time.c unlink.c utimes.c
+
+UNIX_CAML_FILES = unix.mli unixLabels.mli unixLabels.ml
+
+ALL_FILES=$(WIN_FILES) $(UNIX_FILES)
+WSOCKLIB=$(call SYSLIB,ws2_32)
+
+LIBNAME=unix
+COBJS=$(ALL_FILES:.c=.$(O))
+CAMLOBJS=unix.cmo unixLabels.cmo
+LINKOPTS=-cclib $(WSOCKLIB)
+LDOPTS=-ldopt $(WSOCKLIB)
+EXTRACAMLFLAGS=-nolabels
+EXTRACFLAGS=-I../unix
+HEADERS=unixsupport.h
+
+
+include ../Makefile.nt
+
+clean::
+ rm -f $(UNIX_FILES) $(UNIX_CAML_FILES)
+
+$(UNIX_FILES) $(UNIX_CAML_FILES): %: ../unix/%
+ cp ../unix/$* $*
+
+depend:
+
+$(COBJS): unixsupport.h
+
+include .depend
diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/createprocess.c ocaml-3.11.0+beta1/otherlibs/win32unix/createprocess.c
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/createprocess.c 2008-01-11 17:13:16.000000000 +0100
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/createprocess.c 2008-11-12 10:26:48.410585200 +0100
@@ -17,13 +17,15 @@
#include <mlvalues.h>
#include <osdeps.h>
#include "unixsupport.h"
+#include "pidtable.h"
static int win_has_console(void);
value win_create_process_native(value cmd, value cmdline, value env,
value fd1, value fd2, value fd3)
{
- PROCESS_INFORMATION pi;
+ PROCESS_INFORMATION * pi =
+ (PROCESS_INFORMATION*) malloc( sizeof(PROCESS_INFORMATION) );
STARTUPINFO si;
char * exefile, * envp;
int flags;
@@ -55,14 +57,12 @@ value win_create_process_native(value cm
}
/* Create the process */
if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
- TRUE, flags, envp, NULL, &si, &pi)) {
+ TRUE, flags, envp, NULL, &si, pi)) {
win32_maperr(GetLastError());
uerror("create_process", cmd);
}
- CloseHandle(pi.hThread);
- /* Return the process handle as pseudo-PID
- (this is consistent with the wait() emulation in the MSVC C library */
- return Val_long(pi.hProcess);
+ caml_pid_table_insert( pi );
+ return Val_long(pi->dwProcessId);
}
CAMLprim value win_create_process(value * argv, int argn)
diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/getpid.c ocaml-3.11.0+beta1/otherlibs/win32unix/getpid.c
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/getpid.c 2001-12-07 14:40:44.000000000 +0100
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/getpid.c 2008-11-12 10:26:48.410585200 +0100
@@ -15,10 +15,9 @@
#include <mlvalues.h>
#include "unixsupport.h"
-
-extern value val_process_id;
+#include <process.h>
CAMLprim value unix_getpid(value unit)
{
- return val_process_id;
+ return Val_int(_getpid());
}
diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/pidtable.c ocaml-3.11.0+beta1/otherlibs/win32unix/pidtable.c
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/pidtable.c 1970-01-01 01:00:00.000000000 +0100
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/pidtable.c 2008-11-12 10:26:48.426212900 +0100
@@ -0,0 +1,115 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/* This file is contributed by Christoph Bauer (2007) */
+/* */
+/***********************************************************************/
+
+
+
+#include "pidtable.h"
+#include "unixsupport.h"
+#include <process.h>
+#include <stdint.h>
+
+/* #define PIDTABLE_DEBUG 1 */
+#undef PIDTABLE_DEBUG
+
+#ifdef PIDTABLE_DEBUG
+#include <stdio.h>
+#endif
+
+#define PID_TABLE_INITIAL_SIZE 16
+
+PROCESS_INFORMATION ** caml_pid_table = NULL;
+
+static int pid_table_size = 0;
+static int pid_table_used = 0;
+
+static
+void resize_pid_table( int delta ) {
+ pid_table_used += delta;
+ if( pid_table_used > PID_TABLE_INITIAL_SIZE &&
+ pid_table_used < pid_table_size / 4 ) {
+ pid_table_size /= 2;
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ } else if ( pid_table_used >= pid_table_size ) {
+ pid_table_size = pid_table_size > 0 ? 2 * pid_table_size : PID_TABLE_INITIAL_SIZE;
+ /* delta is 1 or -1, therefore pid_table_size > pid_table_used holds */
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ }
+}
+
+static
+int pid_table_index( int pid, int min, int max ) {
+#ifdef PIDTABLE_DEBUG
+ printf( "pid=%d, min=%d, max=%d, used=%d\n", pid, min, max, pid_table_used);
+#endif
+ if( min >= max ) return max;
+ else {
+ int m = (min+max)/2;
+ if( caml_pid_table[m]->dwProcessId == pid ) return m;
+ else if( caml_pid_table[m]->dwProcessId > pid )
+ return pid_table_index( pid, min, m-1 );
+ else
+ return pid_table_index( pid, m+1, max );
+
+ }
+}
+
+void caml_pid_table_insert(PROCESS_INFORMATION * pi) {
+ int i;
+ i = pid_table_index( pi->dwProcessId, 0, pid_table_used-1 );
+ if( i < 0 || caml_pid_table[i]->dwProcessId < pi->dwProcessId ) i++;
+ resize_pid_table( 1 );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i + 1], &caml_pid_table[i],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table));
+ caml_pid_table[i] = pi;
+#ifdef PIDTABLE_DEBUG
+ printf( "insert at %d\n", i);
+ for( i = 0; i < pid_table_used; ++i )
+ printf( "pidtable[%d]=%d\n", i, caml_pid_table[i]->dwProcessId );
+#endif
+}
+
+PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+#ifdef PIDTABLE_DEBUG
+ printf("lookup %d at %d\n", pid, i );
+#endif
+ if( i >= pid_table_used ||
+ caml_pid_table[i]->dwProcessId != pid ) return NULL;
+ else return caml_pid_table[i];
+}
+
+void caml_pid_table_remove( pid_t pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+
+#ifdef PIDTABLE_DEBUG
+ printf("remove %d at %d\n", pid, i );
+#endif
+
+ if( i < pid_table_used &&
+ caml_pid_table[i]->dwProcessId == pid ) {
+ CloseHandle(caml_pid_table[i]->hProcess);
+ CloseHandle(caml_pid_table[i]->hThread);
+ free( caml_pid_table[i] );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i], &caml_pid_table[i+1],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table) );
+ resize_pid_table( -1 );
+ }
+}
diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/pidtable.h ocaml-3.11.0+beta1/otherlibs/win32unix/pidtable.h
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/pidtable.h 1970-01-01 01:00:00.000000000 +0100
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/pidtable.h 2008-11-12 10:26:48.426212900 +0100
@@ -0,0 +1,21 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/* This file is contributed by Christoph Bauer (2007) */
+/* */
+/***********************************************************************/
+
+#include "unixsupport.h"
+#include <process.h>
+
+extern PROCESS_INFORMATION * caml_pid_table_lookup( pid_t pid );
+extern void caml_pid_table_remove( pid_t pid );
+void caml_pid_table_insert(PROCESS_INFORMATION * pi);
diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/startup.c ocaml-3.11.0+beta1/otherlibs/win32unix/startup.c
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/startup.c 2008-07-29 10:31:41.000000000 +0200
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/startup.c 2008-11-12 10:26:48.441840600 +0100
@@ -19,8 +19,6 @@
#include "winworker.h"
#include "windbug.h"
-value val_process_id;
-
CAMLprim value win_startup(unit)
value unit;
{
@@ -31,10 +29,6 @@ CAMLprim value win_startup(unit)
DBUG_INIT;
(void) WSAStartup(MAKEWORD(2, 0), &wsaData);
- DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
- GetCurrentProcess(), &h, 0, TRUE,
- DUPLICATE_SAME_ACCESS);
- val_process_id = Val_int(h);
worker_init();
diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/startup.c.orig ocaml-3.11.0+beta1/otherlibs/win32unix/startup.c.orig
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/startup.c.orig 1970-01-01 01:00:00.000000000 +0100
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/startup.c.orig 2008-07-29 10:31:41.000000000 +0200
@@ -0,0 +1,54 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/***********************************************************************/
+
+#include <stdio.h>
+#include <fcntl.h>
+#include <stdlib.h>
+#include <mlvalues.h>
+#include "unixsupport.h"
+#include "winworker.h"
+#include "windbug.h"
+
+value val_process_id;
+
+CAMLprim value win_startup(unit)
+ value unit;
+{
+ WSADATA wsaData;
+ int i;
+ HANDLE h;
+
+ DBUG_INIT;
+
+ (void) WSAStartup(MAKEWORD(2, 0), &wsaData);
+ DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
+ GetCurrentProcess(), &h, 0, TRUE,
+ DUPLICATE_SAME_ACCESS);
+ val_process_id = Val_int(h);
+
+ worker_init();
+
+ return Val_unit;
+}
+
+CAMLprim value win_cleanup(unit)
+ value unit;
+{
+ worker_cleanup();
+
+ (void) WSACleanup();
+
+ DBUG_CLEANUP;
+
+ return Val_unit;
+}
diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/unixsupport.h ocaml-3.11.0+beta1/otherlibs/win32unix/unixsupport.h
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/unixsupport.h 2007-02-07 15:45:46.000000000 +0100
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/unixsupport.h 2008-11-12 10:26:48.457468300 +0100
@@ -13,6 +13,9 @@
/* $Id: unixsupport.h,v 1.19 2007/02/07 14:45:46 doligez Exp $ */
+#ifndef CAML_UNIX_SUPPORT_H
+#define CAML_UNIX_SUPPORT_H
+
#define WIN32_LEAN_AND_MEAN
#include <wtypes.h>
#include <winbase.h>
@@ -51,3 +54,4 @@ extern void uerror (char * cmdname, valu
extern value unix_freeze_buffer (value);
#define UNIX_BUFFER_SIZE 16384
+#endif
diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/winwait.c ocaml-3.11.0+beta1/otherlibs/win32unix/winwait.c
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/winwait.c 2008-01-11 17:13:16.000000000 +0100
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/winwait.c 2008-11-12 10:28:30.959552600 +0100
@@ -20,6 +20,8 @@
#include "unixsupport.h"
#include <sys/types.h>
#include <signals.h>
+#include "pidtable.h"
+ #include <errno.h>
static value alloc_process_status(HANDLE pid, int status)
{
@@ -29,7 +31,7 @@ static value alloc_process_status(HANDLE
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
- Field(res, 0) = Val_long((intnat) pid);
+ Field(res, 0) = Val_int(pid);
Field(res, 1) = st;
End_roots();
return res;
@@ -39,32 +41,40 @@ enum { CAML_WNOHANG = 1, CAML_WUNTRACED
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
-CAMLprim value win_waitpid(value vflags, value vpid_req)
+CAMLprim value win_waitpid(value vflags, value vpid)
{
int flags;
DWORD status, retcode;
- HANDLE pid_req = (HANDLE) Long_val(vpid_req);
+ pid_t pid = Int_val( vpid );
DWORD err = 0;
+ PROCESS_INFORMATION * pi = caml_pid_table_lookup( pid );
+
+ if( pi == NULL ) {
+ unix_error(EINVAL, "waitpid", Nothing );
+ }
+
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
- enter_blocking_section();
- retcode = WaitForSingleObject(pid_req, INFINITE);
+ caml_enter_blocking_section();
+ retcode = WaitForSingleObject(pi->hProcess, INFINITE);
if (retcode == WAIT_FAILED) err = GetLastError();
- leave_blocking_section();
+ caml_leave_blocking_section();
if (err) {
+ caml_pid_table_remove( pid );
win32_maperr(err);
uerror("waitpid", Nothing);
}
}
- if (! GetExitCodeProcess(pid_req, &status)) {
+ if (! GetExitCodeProcess(pi->hProcess, &status)) {
+ caml_pid_table_remove( pid );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
if (status == STILL_ACTIVE)
- return alloc_process_status((HANDLE) 0, 0);
+ return alloc_process_status(0, 0);
else {
- CloseHandle(pid_req);
- return alloc_process_status(pid_req, status);
+ caml_pid_table_remove( pid );
+ return alloc_process_status(pid, status);
}
}
diff -urpwN ocaml-3.11.0+beta1.orig/otherlibs/win32unix/winwait.c.orig ocaml-3.11.0+beta1/otherlibs/win32unix/winwait.c.orig
--- ocaml-3.11.0+beta1.orig/otherlibs/win32unix/winwait.c.orig 1970-01-01 01:00:00.000000000 +0100
+++ ocaml-3.11.0+beta1/otherlibs/win32unix/winwait.c.orig 2008-01-11 17:13:16.000000000 +0100
@@ -0,0 +1,70 @@
+/***********************************************************************/
+/* */
+/* Objective Caml */
+/* */
+/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 1996 Institut National de Recherche en Informatique et */
+/* en Automatique. All rights reserved. This file is distributed */
+/* under the terms of the GNU Library General Public License, with */
+/* the special exception on linking described in file ../../LICENSE. */
+/* */
+/***********************************************************************/
+
+/* $Id: winwait.c,v 1.20 2008/01/11 16:13:16 doligez Exp $ */
+
+#include <windows.h>
+#include <mlvalues.h>
+#include <alloc.h>
+#include <memory.h>
+#include "unixsupport.h"
+#include <sys/types.h>
+#include <signals.h>
+
+static value alloc_process_status(HANDLE pid, int status)
+{
+ value res, st;
+
+ st = alloc(1, 0);
+ Field(st, 0) = Val_int(status);
+ Begin_root (st);
+ res = alloc_small(2, 0);
+ Field(res, 0) = Val_long((intnat) pid);
+ Field(res, 1) = st;
+ End_roots();
+ return res;
+}
+
+enum { CAML_WNOHANG = 1, CAML_WUNTRACED = 2 };
+
+static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
+
+CAMLprim value win_waitpid(value vflags, value vpid_req)
+{
+ int flags;
+ DWORD status, retcode;
+ HANDLE pid_req = (HANDLE) Long_val(vpid_req);
+ DWORD err = 0;
+
+ flags = convert_flag_list(vflags, wait_flag_table);
+ if ((flags & CAML_WNOHANG) == 0) {
+ enter_blocking_section();
+ retcode = WaitForSingleObject(pid_req, INFINITE);
+ if (retcode == WAIT_FAILED) err = GetLastError();
+ leave_blocking_section();
+ if (err) {
+ win32_maperr(err);
+ uerror("waitpid", Nothing);
+ }
+ }
+ if (! GetExitCodeProcess(pid_req, &status)) {
+ win32_maperr(GetLastError());
+ uerror("waitpid", Nothing);
+ }
+ if (status == STILL_ACTIVE)
+ return alloc_process_status((HANDLE) 0, 0);
+ else {
+ CloseHandle(pid_req);
+ return alloc_process_status(pid_req, status);
+ }
+}
ocaml-getpid-3.12.1.patch [^] (14,867 bytes) 2011-12-16 11:54 [Show Content] [Hide Content]diff -cNrB -x '*~' ocaml-3.12.1.orig/otherlibs/win32unix/Makefile.nt ocaml-3.12.1/otherlibs/win32unix/Makefile.nt
*** ocaml-3.12.1.orig/otherlibs/win32unix/Makefile.nt 2010-05-20 11:40:41.000000000 +0200
--- ocaml-3.12.1/otherlibs/win32unix/Makefile.nt 2011-12-14 10:47:47.509190500 +0100
***************
*** 18,24 ****
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
getpeername.c getpid.c getsockname.c gettimeofday.c \
link.c listen.c lockf.c lseek.c nonblock.c \
! mkdir.c open.c pipe.c read.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
system.c unixsupport.c windir.c winwait.c write.c \
--- 18,24 ----
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c \
getpeername.c getpid.c getsockname.c gettimeofday.c \
link.c listen.c lockf.c lseek.c nonblock.c \
! mkdir.c open.c pidtable.c pipe.c read.c rename.c \
select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
system.c unixsupport.c windir.c winwait.c write.c \
***************
*** 43,49 ****
LDOPTS=-ldopt $(WSOCKLIB)
EXTRACAMLFLAGS=-nolabels
EXTRACFLAGS=-I../unix
! HEADERS=unixsupport.h socketaddr.h
include ../Makefile.nt
--- 43,49 ----
LDOPTS=-ldopt $(WSOCKLIB)
EXTRACAMLFLAGS=-nolabels
EXTRACFLAGS=-I../unix
! HEADERS=unixsupport.h socketaddr.h pidtable.h
include ../Makefile.nt
diff -cNrB -x '*~' ocaml-3.12.1.orig/otherlibs/win32unix/createprocess.c ocaml-3.12.1/otherlibs/win32unix/createprocess.c
*** ocaml-3.12.1.orig/otherlibs/win32unix/createprocess.c 2009-07-20 13:51:50.000000000 +0200
--- ocaml-3.12.1/otherlibs/win32unix/createprocess.c 2011-12-14 10:46:09.231395100 +0100
***************
*** 17,29 ****
#include <mlvalues.h>
#include <osdeps.h>
#include "unixsupport.h"
static int win_has_console(void);
value win_create_process_native(value cmd, value cmdline, value env,
value fd1, value fd2, value fd3)
{
! PROCESS_INFORMATION pi;
STARTUPINFO si;
char * exefile, * envp;
int flags;
--- 17,31 ----
#include <mlvalues.h>
#include <osdeps.h>
#include "unixsupport.h"
+ #include "pidtable.h"
static int win_has_console(void);
value win_create_process_native(value cmd, value cmdline, value env,
value fd1, value fd2, value fd3)
{
! PROCESS_INFORMATION * pi =
! (PROCESS_INFORMATION*) malloc( sizeof(PROCESS_INFORMATION) );
STARTUPINFO si;
char * exefile, * envp;
int flags;
***************
*** 54,67 ****
}
/* Create the process */
if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
! TRUE, flags, envp, NULL, &si, &pi)) {
win32_maperr(GetLastError());
uerror("create_process", cmd);
}
! CloseHandle(pi.hThread);
! /* Return the process handle as pseudo-PID
! (this is consistent with the wait() emulation in the MSVC C library */
! return Val_long(pi.hProcess);
}
CAMLprim value win_create_process(value * argv, int argn)
--- 56,67 ----
}
/* Create the process */
if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
! TRUE, flags, envp, NULL, &si, pi)) {
win32_maperr(GetLastError());
uerror("create_process", cmd);
}
! caml_pid_table_insert( pi );
! return Val_long(pi->dwProcessId);
}
CAMLprim value win_create_process(value * argv, int argn)
diff -cNrB -x '*~' ocaml-3.12.1.orig/otherlibs/win32unix/getpid.c ocaml-3.12.1/otherlibs/win32unix/getpid.c
*** ocaml-3.12.1.orig/otherlibs/win32unix/getpid.c 2001-12-07 14:41:02.000000000 +0100
--- ocaml-3.12.1/otherlibs/win32unix/getpid.c 2011-12-14 10:46:09.247901700 +0100
***************
*** 15,24 ****
#include <mlvalues.h>
#include "unixsupport.h"
!
! extern value val_process_id;
CAMLprim value unix_getpid(value unit)
{
! return val_process_id;
}
--- 15,23 ----
#include <mlvalues.h>
#include "unixsupport.h"
! #include <process.h>
CAMLprim value unix_getpid(value unit)
{
! return Val_int(_getpid());
}
diff -cNrB -x '*~' ocaml-3.12.1.orig/otherlibs/win32unix/pidtable.c ocaml-3.12.1/otherlibs/win32unix/pidtable.c
*** ocaml-3.12.1.orig/otherlibs/win32unix/pidtable.c 1970-01-01 01:00:00.000000000 +0100
--- ocaml-3.12.1/otherlibs/win32unix/pidtable.c 2011-12-15 17:31:17.529400100 +0100
***************
*** 0 ****
--- 1,116 ----
+ /***********************************************************************/
+ /* */
+ /* Objective Caml */
+ /* */
+ /* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+ /* */
+ /* Copyright 1996 Institut National de Recherche en Informatique et */
+ /* en Automatique. All rights reserved. This file is distributed */
+ /* under the terms of the GNU Library General Public License, with */
+ /* the special exception on linking described in file ../../LICENSE. */
+ /* */
+ /* This file is contributed by Christoph Bauer (2007) */
+ /* */
+ /***********************************************************************/
+
+
+ #include <mlvalues.h>
+ #include <alloc.h>
+ #include "unixsupport.h"
+ #include "pidtable.h"
+ #include <process.h>
+ #include <stdint.h>
+
+ /* #define PIDTABLE_DEBUG 1 */
+ #undef PIDTABLE_DEBUG
+
+ #ifdef PIDTABLE_DEBUG
+ #include <stdio.h>
+ #endif
+
+ #define PID_TABLE_INITIAL_SIZE 16
+
+ PROCESS_INFORMATION ** caml_pid_table = NULL;
+
+ static int pid_table_size = 0;
+ static int pid_table_used = 0;
+
+ static
+ void resize_pid_table( int delta ) {
+ pid_table_used += delta;
+ if( pid_table_used > PID_TABLE_INITIAL_SIZE &&
+ pid_table_used < pid_table_size / 4 ) {
+ pid_table_size /= 2;
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ } else if ( pid_table_used >= pid_table_size ) {
+ pid_table_size = pid_table_size > 0 ? 2 * pid_table_size : PID_TABLE_INITIAL_SIZE;
+ /* delta is 1 or -1, therefore pid_table_size > pid_table_used holds */
+ caml_pid_table =
+ (PROCESS_INFORMATION**) realloc( caml_pid_table,
+ pid_table_size*sizeof(*caml_pid_table));
+ }
+ }
+
+ static
+ int pid_table_index( int pid, int min, int max ) {
+ #ifdef PIDTABLE_DEBUG
+ printf( "pid=%d, min=%d, max=%d, used=%d\n", pid, min, max, pid_table_used);
+ #endif
+ if( min >= max ) return max;
+ else {
+ int m = (min+max)/2;
+ if( caml_pid_table[m]->dwProcessId == pid ) return m;
+ else if( caml_pid_table[m]->dwProcessId > pid )
+ return pid_table_index( pid, min, m-1 );
+ else
+ return pid_table_index( pid, m+1, max );
+
+ }
+ }
+
+ void caml_pid_table_insert(PROCESS_INFORMATION * pi) {
+ int i;
+ i = pid_table_index( pi->dwProcessId, 0, pid_table_used-1 );
+ if( i < 0 || caml_pid_table[i]->dwProcessId < pi->dwProcessId ) i++;
+ resize_pid_table( 1 );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i + 1], &caml_pid_table[i],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table));
+ caml_pid_table[i] = pi;
+ #ifdef PIDTABLE_DEBUG
+ printf( "insert at %d\n", i);
+ for( i = 0; i < pid_table_used; ++i )
+ printf( "pidtable[%d]=%d\n", i, caml_pid_table[i]->dwProcessId );
+ #endif
+ }
+
+ PROCESS_INFORMATION * caml_pid_table_lookup( DWORD pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+ #ifdef PIDTABLE_DEBUG
+ printf("lookup %d at %d\n", pid, i );
+ #endif
+ if( i >= pid_table_used ||
+ caml_pid_table[i]->dwProcessId != pid ) return NULL;
+ else return caml_pid_table[i];
+ }
+
+ void caml_pid_table_remove( DWORD pid ) {
+ int i = pid_table_index( pid, 0, pid_table_used-1 );
+
+ #ifdef PIDTABLE_DEBUG
+ printf("remove %d at %d\n", pid, i );
+ #endif
+
+ if( i < pid_table_used &&
+ caml_pid_table[i]->dwProcessId == pid ) {
+ CloseHandle(caml_pid_table[i]->hProcess);
+ CloseHandle(caml_pid_table[i]->hThread);
+ free( caml_pid_table[i] );
+ if( i < pid_table_used - 1 )
+ memmove( &caml_pid_table[i], &caml_pid_table[i+1],
+ (pid_table_used-i-1) * sizeof(*caml_pid_table) );
+ resize_pid_table( -1 );
+ }
+ }
diff -cNrB -x '*~' ocaml-3.12.1.orig/otherlibs/win32unix/pidtable.h ocaml-3.12.1/otherlibs/win32unix/pidtable.h
*** ocaml-3.12.1.orig/otherlibs/win32unix/pidtable.h 1970-01-01 01:00:00.000000000 +0100
--- ocaml-3.12.1/otherlibs/win32unix/pidtable.h 2011-12-15 16:33:10.240447500 +0100
***************
*** 0 ****
--- 1,24 ----
+ /***********************************************************************/
+ /* */
+ /* Objective Caml */
+ /* */
+ /* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+ /* */
+ /* Copyright 1996 Institut National de Recherche en Informatique et */
+ /* en Automatique. All rights reserved. This file is distributed */
+ /* under the terms of the GNU Library General Public License, with */
+ /* the special exception on linking described in file ../../LICENSE. */
+ /* */
+ /* This file is contributed by Christoph Bauer (2007-2011) */
+ /* */
+ /***********************************************************************/
+
+
+ #ifndef CAML_PIDTABLE_H
+ #define CAML_PIDTABLE_H
+
+ extern PROCESS_INFORMATION * caml_pid_table_lookup( DWORD pid );
+ extern void caml_pid_table_remove( DWORD pid );
+ void caml_pid_table_insert(PROCESS_INFORMATION * pi);
+
+ #endif
diff -cNrB -x '*~' ocaml-3.12.1.orig/otherlibs/win32unix/startup.c ocaml-3.12.1/otherlibs/win32unix/startup.c
*** ocaml-3.12.1.orig/otherlibs/win32unix/startup.c 2010-05-25 15:01:06.000000000 +0200
--- ocaml-3.12.1/otherlibs/win32unix/startup.c 2011-12-14 10:46:09.282415500 +0100
***************
*** 19,26 ****
#include "winworker.h"
#include "windbug.h"
- value val_process_id;
-
CAMLprim value win_startup(unit)
value unit;
{
--- 19,24 ----
***************
*** 29,38 ****
HANDLE h;
(void) WSAStartup(MAKEWORD(2, 0), &wsaData);
- DuplicateHandle(GetCurrentProcess(), GetCurrentProcess(),
- GetCurrentProcess(), &h, 0, TRUE,
- DUPLICATE_SAME_ACCESS);
- val_process_id = Val_int(h);
worker_init();
--- 27,32 ----
diff -cNrB -x '*~' ocaml-3.12.1.orig/otherlibs/win32unix/unixsupport.h ocaml-3.12.1/otherlibs/win32unix/unixsupport.h
*** ocaml-3.12.1.orig/otherlibs/win32unix/unixsupport.h 2010-05-25 15:01:06.000000000 +0200
--- ocaml-3.12.1/otherlibs/win32unix/unixsupport.h 2011-12-14 10:46:14.657564700 +0100
***************
*** 13,18 ****
--- 13,21 ----
/* $Id: unixsupport.h 10467 2010-05-25 13:01:06Z xleroy $ */
+ #ifndef CAML_UNIX_SUPPORT_H
+ #define CAML_UNIX_SUPPORT_H
+
#define WIN32_LEAN_AND_MEAN
#include <wtypes.h>
#include <winbase.h>
***************
*** 60,62 ****
--- 63,66 ----
#define FLAGS_FD_IS_BLOCKING (1<<0)
#define UNIX_BUFFER_SIZE 16384
+ #endif
diff -cNrB -x '*~' ocaml-3.12.1.orig/otherlibs/win32unix/winwait.c ocaml-3.12.1/otherlibs/win32unix/winwait.c
*** ocaml-3.12.1.orig/otherlibs/win32unix/winwait.c 2008-01-11 17:13:18.000000000 +0100
--- ocaml-3.12.1/otherlibs/win32unix/winwait.c 2011-12-14 13:51:39.445507700 +0100
***************
*** 20,25 ****
--- 20,27 ----
#include "unixsupport.h"
#include <sys/types.h>
#include <signals.h>
+ #include "pidtable.h"
+ #include <errno.h>
static value alloc_process_status(HANDLE pid, int status)
{
***************
*** 29,35 ****
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
! Field(res, 0) = Val_long((intnat) pid);
Field(res, 1) = st;
End_roots();
return res;
--- 31,37 ----
Field(st, 0) = Val_int(status);
Begin_root (st);
res = alloc_small(2, 0);
! Field(res, 0) = Val_int(pid);
Field(res, 1) = st;
End_roots();
return res;
***************
*** 39,70 ****
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
! CAMLprim value win_waitpid(value vflags, value vpid_req)
{
int flags;
DWORD status, retcode;
! HANDLE pid_req = (HANDLE) Long_val(vpid_req);
DWORD err = 0;
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
! enter_blocking_section();
! retcode = WaitForSingleObject(pid_req, INFINITE);
if (retcode == WAIT_FAILED) err = GetLastError();
! leave_blocking_section();
if (err) {
win32_maperr(err);
uerror("waitpid", Nothing);
}
}
! if (! GetExitCodeProcess(pid_req, &status)) {
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
if (status == STILL_ACTIVE)
! return alloc_process_status((HANDLE) 0, 0);
else {
! CloseHandle(pid_req);
! return alloc_process_status(pid_req, status);
}
}
--- 41,80 ----
static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
! CAMLprim value win_waitpid(value vflags, value vpid)
{
int flags;
DWORD status, retcode;
! DWORD pid = Int_val( vpid );
DWORD err = 0;
+ PROCESS_INFORMATION * pi = caml_pid_table_lookup( pid );
+
+ if( pi == NULL ) {
+ unix_error(EINVAL, "waitpid", Nothing );
+ }
+
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
! caml_enter_blocking_section();
! retcode = WaitForSingleObject(pi->hProcess, INFINITE);
if (retcode == WAIT_FAILED) err = GetLastError();
! caml_leave_blocking_section();
if (err) {
+ caml_pid_table_remove( pid );
win32_maperr(err);
uerror("waitpid", Nothing);
}
}
! if (! GetExitCodeProcess(pi->hProcess, &status)) {
! caml_pid_table_remove( pid );
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
if (status == STILL_ACTIVE)
! return alloc_process_status(0, 0);
else {
! caml_pid_table_remove( pid );
! return alloc_process_status(pid, status);
}
}
| ||||||||||
 Relationships |
|
 Relationships |
|
Notes |
|
|
(0003649) Christoph Bauer (reporter) 2006-05-29 17:01 |
Important note: the platform is windows (mingw-version in my case). |
|
(0003660) xleroy (administrator) 2006-06-08 17:10 |
There are no strict equivalent to Unix's process IDs in the Win32 API, so in what sense is the returned PID "wrong"?? Caml uses process handles as closest equivalents of process IDs for the Unix.create_process* and Unix.waitpid and Unix.getpid functions. Returning anything else from Unix.getpid or Unix.create_process* would break Unix.waitpid. |
|
(0003663) Christoph Bauer (reporter) 2006-06-09 13:59 |
There is a function GetCurrentProcessID. The task manager shows a column with a pid. This pid could be used by an external program to kill a process or even to run cygwins gdb with the option --pid=... winwait.c could make use of OpenProcess, which takes the pid and returns the handle. |
|
(0003666) xleroy (administrator) 2006-06-10 11:11 |
I keep that as a feature wish. |
|
(0003725) Christoph Bauer (reporter) 2006-08-03 12:39 |
I attached an patch that seems to work: o Unix.getpid() returns a pid like the taskmanager o create_process + winwait works correct (at least in my test) o there is no open process handle. My tests are done with the mingw version. I found the API description on MSDN. In the original implementation closes never the hProcess-Handle from the PROCESS_INFORMATION struct pi. MSDN states this should be done. My patch closes this handle directly after create_process, so this problems is solved, too. |
|
(0003726) Christoph Bauer (reporter) 2006-08-03 12:42 |
Please apply the patch in the directory `ocaml-3.09.2/otherlibs/win32unix'. |
|
(0003895) Christoph Bauer (reporter) 2007-01-22 10:24 |
I tested the patch now a long time and had never a problem with it. This entry could be counted as bug because of the process handle leak under windows... |
|
(0003909) xleroy (administrator) 2007-01-30 14:19 |
I tried the patch but runs into errors returned by OpenProcess. I believe the problem is this: if Unix.waitpid is called for a process that has already terminated, its processID is invalid (Windows doesn't keep the process around if its handles are closed) and there is no way to recover its handle and therefore its exit code. Try for instance the following example: let ic = Unix.open_process_in "dir c:\\" in begin try while true do print_string (input_line ic); print_newline() done with End_of_file -> () end; ignore (Unix.close_process_in ic) Don't you get an error on close_process_in? |
|
(0003910) Christoph Bauer (reporter) 2007-02-01 12:21 |
I guess you are right. With your example I get the error sometimes. So a Unix.sleep and now I get the error more reliably: let ic = Unix.open_process_in "dir c:\\" in begin try while true do print_string (input_line ic); print_newline() done with End_of_file -> () end; Unix.sleep 1; ignore (Unix.close_process_in ic);; There are two possible solutions. The simple one: GetLastError() returns ERROR_INVALID_PARAMETER. This could be catched and a zero exit code could be returned. The main drawback is that the return code nonsense. (Another drawback for my approach is that windows theoretical could reuse the given pid.) The second solution could be a internal table that stores for each pid the process information. Then the job of waitpid would be to free the internal handle. The table could be realized as a simple list or a simple hash table. I try to implement the second approach. |
|
(0003912) Christoph Bauer (reporter) 2007-02-01 18:31 |
The new patch implements a pid table of PROCESS_INFORMATION. (binary search, dynamic storage allocation). The code for table management is in two new files pidtable.h and pidtable.c. |
|
(0003978) Christoph Bauer (reporter) 2007-03-16 12:48 |
There's a stupid bug in patch 2b. I'll prepare a new one. |
|
(0004435) Christoph Bauer (reporter) 2008-01-22 17:34 |
The patch 2e was quite good. 2f is a patch against 3.10.1. |
|
(0006322) Christoph Bauer (reporter) 2011-12-16 11:56 |
patch against 3.12.1. compiles with msvc. |
|
Notes |
|
Issue History |
|||
| Date Modified | Username | Field | Change |
| 2006-05-29 17:00 | Christoph Bauer | New Issue | |
| 2006-05-29 17:01 | Christoph Bauer | Note Added: 0003649 | |
| 2006-06-08 17:10 | xleroy | Note Added: 0003660 | |
| 2006-06-09 13:59 | Christoph Bauer | Note Added: 0003663 | |
| 2006-06-10 11:11 | xleroy | Note Added: 0003666 | |
| 2006-06-10 11:11 | xleroy | Severity | minor => feature |
| 2006-06-10 11:11 | xleroy | Status | new => acknowledged |
| 2006-08-03 12:32 | Christoph Bauer | File Added: ocaml-3.09.2-getpid.patch | |
| 2006-08-03 12:39 | Christoph Bauer | Note Added: 0003725 | |
| 2006-08-03 12:42 | Christoph Bauer | Note Added: 0003726 | |
| 2007-01-22 10:24 | Christoph Bauer | Note Added: 0003895 | |
| 2007-01-30 14:19 | xleroy | Note Added: 0003909 | |
| 2007-02-01 12:21 | Christoph Bauer | Note Added: 0003910 | |
| 2007-02-01 18:29 | Christoph Bauer | File Added: getpid-patch2.diff | |
| 2007-02-01 18:31 | Christoph Bauer | Note Added: 0003912 | |
| 2007-02-02 11:06 | Christoph Bauer | File Added: getpid-patch2b.diff | |
| 2007-03-16 12:48 | Christoph Bauer | Note Added: 0003978 | |
| 2007-03-16 13:45 | Christoph Bauer | File Added: getpid-patch2c.diff | |
| 2007-03-16 16:56 | Christoph Bauer | File Added: getpid-patch2d.diff | |
| 2007-04-24 11:29 | Christoph Bauer | File Added: getpid-patch2e.diff | |
| 2008-01-22 17:33 | Christoph Bauer | File Added: getpid-patch2f.diff | |
| 2008-01-22 17:34 | Christoph Bauer | Note Added: 0004435 | |
| 2008-11-12 10:33 | Christoph Bauer | File Added: getpid-3.11.0+beta1.patch | |
| 2011-12-16 11:54 | Christoph Bauer | File Added: ocaml-getpid-3.12.1.patch | |
| 2011-12-16 11:56 | Christoph Bauer | Note Added: 0006322 | |
|
Issue History |
| Copyright © 2000 - 2011 MantisBT Group |
 |