diff options
| -rw-r--r-- | otherlibs/systhreads/Makefile.nt | 10 | ||||
| -rw-r--r-- | otherlibs/systhreads/win32.c | 12 | ||||
| -rw-r--r-- | otherlibs/win32unix/.depend | 3 | ||||
| -rw-r--r-- | otherlibs/win32unix/Makefile.nt | 33 | ||||
| -rw-r--r-- | otherlibs/win32unix/accept.c | 5 | ||||
| -rw-r--r-- | otherlibs/win32unix/bind.c | 6 | ||||
| -rw-r--r-- | otherlibs/win32unix/createprocess.c | 8 | ||||
| -rw-r--r-- | otherlibs/win32unix/cst2constr.c | 28 | ||||
| -rw-r--r-- | otherlibs/win32unix/mkdir.c | 4 | ||||
| -rw-r--r-- | otherlibs/win32unix/open.c | 2 | ||||
| -rw-r--r-- | otherlibs/win32unix/sendrecv.c | 2 | ||||
| -rw-r--r-- | otherlibs/win32unix/shutdown.c | 2 | ||||
| -rw-r--r-- | otherlibs/win32unix/sleep.c (renamed from otherlibs/win32unix/cst2constr.h) | 17 | ||||
| -rw-r--r-- | otherlibs/win32unix/socket.c | 2 | ||||
| -rw-r--r-- | otherlibs/win32unix/sockopt.c | 7 | ||||
| -rw-r--r-- | otherlibs/win32unix/system.c | 4 | ||||
| -rw-r--r-- | otherlibs/win32unix/unix.ml | 28 | ||||
| -rw-r--r-- | otherlibs/win32unix/unix.mli | 47 | ||||
| -rw-r--r-- | otherlibs/win32unix/unixsupport.c | 129 | ||||
| -rw-r--r-- | otherlibs/win32unix/unixsupport.h | 4 | ||||
| -rw-r--r-- | otherlibs/win32unix/windir.c | 6 |
21 files changed, 227 insertions, 132 deletions
diff --git a/otherlibs/systhreads/Makefile.nt b/otherlibs/systhreads/Makefile.nt index cc1534e68..8addb8c7e 100644 --- a/otherlibs/systhreads/Makefile.nt +++ b/otherlibs/systhreads/Makefile.nt @@ -2,10 +2,10 @@ include ../../config/Makefile.nt # Compilation options CC=$(BYTECC) -CFLAGS=-I..\..\byterun -O $(BYTECCCOMPOPTS) -CAMLC=..\..\boot\ocamlrun ..\..\boot\ocamlc -I ..\..\boot +CFLAGS=-I..\..\byterun $(BYTECCCOMPOPTS) +CAMLC=..\..\boot\ocamlrun ..\..\boot\ocamlc -I ..\..\boot -I ..\win32unix -C_OBJS=threadstubs.obj +C_OBJS=win32.obj CAML_OBJS=mutex.cmo condition.cmo threadIO.cmo threadPrintexc.cmo \ thread.cmo event.cmo threadUnix.cmo threadPrintf.cmo @@ -44,8 +44,8 @@ installopt: $(CAMLOPT) -c $(COMPFLAGS) $< depend: - gcc -MM $(CFLAGS) *.c > .depend - ../../tools/csldep *.mli *.ml >> .depend +# gcc -MM -I../../byterun *.c > .depend + ..\..\boot\ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend threadstubs.obj: threadstubs.c $(CC) $(CFLAGS) -c threadstubs.c diff --git a/otherlibs/systhreads/win32.c b/otherlibs/systhreads/win32.c index b97f0a166..9133f26eb 100644 --- a/otherlibs/systhreads/win32.c +++ b/otherlibs/systhreads/win32.c @@ -202,17 +202,19 @@ static void csl_thread_finalize(vfin) /* Allocate a new thread descriptor */ -static value csl_alloc_thread() +#define Max_thread_number 100 + +static csl_thread_t csl_alloc_thread() { - value th; + csl_thread_t th; Push_roots(root, 1); root[0] = - alloc_final(sizeof(struct(win32_thread_struct)) / sizeof(value), + alloc_final(sizeof(struct win32_thread_struct) / sizeof(value), csl_thread_finalize, 1, Max_thread_number); th = (csl_thread_t) alloc_shr(sizeof(struct csl_thread_struct) / sizeof(value), 0); - th->win32 = root[0]; + th->win32 = (struct win32_thread_struct *) root[0]; th->win32->wakeup_event = CreateEvent(NULL, FALSE, FALSE, NULL); th->ident = Val_long(thread_next_ident); thread_next_ident++; @@ -223,8 +225,6 @@ static value csl_alloc_thread() /* Initialize the thread machinery */ -#define Max_thread_number 1000 - value csl_thread_initialize(unit) /* ML */ value unit; { diff --git a/otherlibs/win32unix/.depend b/otherlibs/win32unix/.depend index e69de29bb..34d97d87e 100644 --- a/otherlibs/win32unix/.depend +++ b/otherlibs/win32unix/.depend @@ -0,0 +1,3 @@ +envir.o: envir.c +errmsg.o: errmsg.c +startup.o: startup.c diff --git a/otherlibs/win32unix/Makefile.nt b/otherlibs/win32unix/Makefile.nt index cf4cfa1cb..7439e6088 100644 --- a/otherlibs/win32unix/Makefile.nt +++ b/otherlibs/win32unix/Makefile.nt @@ -3,24 +3,24 @@ # Compilation options SYSTEM_INCLUDES=\msdev\include CC=$(BYTECC) -CFLAGS=-I $(SYSTEM_INCLUDES) -I..\..\byterun $(BYTECCCOMPOPTS) +CFLAGS=-I..\..\byterun -I..\unix $(BYTECCCOMPOPTS) CAMLC=..\..\boot\ocamlrun ..\..\boot\ocamlc -I ..\..\boot CAMLOPT=..\..\boot\ocamlrun ..\..\ocamlopt -I ..\..\stdlib # Files in this directory WIN_OBJS = accept.obj bind.obj close_on.obj connect.obj \ - createprocess.obj cst2constr.obj getpeername.obj getpid.obj \ + createprocess.obj getpeername.obj getpid.obj \ getsockname.obj listen.obj mkdir.obj open.obj pipe.obj sendrecv.obj \ - shutdown.obj socket.obj sockopt.obj startup.obj system.obj windir.obj \ - winwait.obj + shutdown.obj sleep.obj socket.obj sockopt.obj startup.obj system.obj \ + unixsupport.obj windir.obj winwait.obj # Files from the ..\unix directory -UNIX_FILES = access.c addrofstr.c chdir.c close.c cst2constr.c - cstringv.c dup.c dup2.c envir.c errmsg.c execv.c execve.c execvp.c - exit.c getcwd.c gethost.c gethostname.c getpeername.c getproto.c - getserv.c getsockname.c gmtime.c lseek.c read.c rename.c rmdir.c - sleep.c socketaddr.c stat.c strofaddr.c time.c times.c unixsupport.c - unlink.c utimes.c write.c +UNIX_FILES = access.c addrofstr.c chdir.c close.c cst2constr.c \ + cstringv.c dup.c dup2.c envir.c errmsg.c execv.c execve.c execvp.c \ + exit.c getcwd.c gethost.c gethostname.c getproto.c \ + getserv.c gmtime.c lseek.c read.c rename.c rmdir.c \ + socketaddr.c stat.c strofaddr.c time.c unlink.c utimes.c write.c + UNIX_OBJS = $(UNIX_FILES:.c=.obj) C_OBJS=$(WIN_OBJS) $(UNIX_OBJS) @@ -31,12 +31,16 @@ all: libunix.lib unix.cma allopt: -libunix.lib: copy_unix_files $(C_OBJS) +libunix.lib: copy_unix_files io.h $(C_OBJS) rm -f libthreads.lib $(MKLIB)libunix.lib $(C_OBJS) copy_unix_files: - cd ..\unix & xcopy /D $(UNIX_FILES) ..\win32unix + @- cd ..\unix & cp -p -u -v $(UNIX_FILES) ../win32unix +# This requires GNU cp + +io.h: $(SYSTEM_INCLUDES)\io.h + copy $(SYSTEM_INCLUDES)\io.h io.h unix.cma: $(CAML_OBJS) $(CAMLC) -a -linkall -o unix.cma $(CAML_OBJS) @@ -46,6 +50,7 @@ clean: realclean: rm -f $(UNIX_FILES) + rm -f io.h install: cp libthreads.lib $(LIBDIR)/libthreads.lib @@ -66,8 +71,8 @@ installopt: $(CAMLOPT) -c $(COMPFLAGS) $< depend: - gcc -MM $(CFLAGS) *.c > .depend - ../../tools/ocamldep *.mli *.ml >> .depend + gcc -MM -I../../byterun *.c > .depend + ..\..\boot\ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend unix.cmi: unix.mli unix.cmo: unix.cmi diff --git a/otherlibs/win32unix/accept.c b/otherlibs/win32unix/accept.c index 9d68b935f..21a07d710 100644 --- a/otherlibs/win32unix/accept.c +++ b/otherlibs/win32unix/accept.c @@ -34,10 +34,9 @@ value unix_accept(sock) /* ML */ (char *)&optionValue, sizeof(optionValue)); sock_addr_len = sizeof(sock_addr); - h = _get_osfhandle(Int_val(sock)); - if (h == -1) uerror("accept", Nothing); enter_blocking_section(); - s = accept(h, &sock_addr.s_gen, &sock_addr_len); + s = accept((SOCKET) _get_osfhandle(Int_val(sock)), + &sock_addr.s_gen, &sock_addr_len); leave_blocking_section(); if (s == INVALID_SOCKET) { _dosmaperr(WSAGetLastError()); diff --git a/otherlibs/win32unix/bind.c b/otherlibs/win32unix/bind.c index 166ab353b..e85a5c312 100644 --- a/otherlibs/win32unix/bind.c +++ b/otherlibs/win32unix/bind.c @@ -24,9 +24,3 @@ value unix_bind(socket, address) /* ML */ if (ret == -1) uerror("bind", Nothing); return Val_unit; } - -#else - -value unix_bind() { invalid_argument("bind not implemented"); } - -#endif diff --git a/otherlibs/win32unix/createprocess.c b/otherlibs/win32unix/createprocess.c index 2509ec5b4..c49b3da8f 100644 --- a/otherlibs/win32unix/createprocess.c +++ b/otherlibs/win32unix/createprocess.c @@ -30,10 +30,10 @@ value win_create_process_native(exe, cmdline, env, fd1, fd2, fd3) GetStartupInfo(&si); si.dwFlags |= STARTF_USESTDHANDLES; - if ((si.hStdInput = _get_osfhandle(Int_val(fd1))) == -1 || - (si.hStdOutput = _get_osfhandle(Int_val(fd2))) == -1 || - (si.hStdError = _get_osfhandle(Int_val(fd3))) == -1 || - ! CreateProcess(String_val(exe), String_val(cmdline), NULL, NULL, + si.hStdInput = (HANDLE) _get_osfhandle(Int_val(fd1)); + si.hStdOutput = (HANDLE) _get_osfhandle(Int_val(fd2)); + si.hStdError = (HANDLE) _get_osfhandle(Int_val(fd3)); + if (! CreateProcess(String_val(exe), String_val(cmdline), NULL, NULL, TRUE, 0, envp, NULL, &si, &pi)) { _dosmaperr(GetLastError()); uerror("create_process", exe); diff --git a/otherlibs/win32unix/cst2constr.c b/otherlibs/win32unix/cst2constr.c deleted file mode 100644 index 8ce4fb7d4..000000000 --- a/otherlibs/win32unix/cst2constr.c +++ /dev/null @@ -1,28 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* Automatique. Distributed only by permission. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include <mlvalues.h> -#include <fail.h> -#include "cst2constr.h" - -value cst_to_constr(n, tbl, size, deflt) - int n; - int * tbl; - int size; - int deflt; -{ - int i; - for (i = 0; i < size; i++) - if (n == tbl[i]) return Val_int(i); - return Val_int(deflt); -} diff --git a/otherlibs/win32unix/mkdir.c b/otherlibs/win32unix/mkdir.c index e35d1c13d..b6eb215d7 100644 --- a/otherlibs/win32unix/mkdir.c +++ b/otherlibs/win32unix/mkdir.c @@ -12,11 +12,11 @@ /* $Id$ */ #include <mlvalues.h> -#include "unixwin.h" +#include "unixsupport.h" value unix_mkdir(path, perm) /* ML */ value path, perm; { - if (_mkdir(String_val(path) == -1) uerror("mkdir", path); + if (_mkdir(String_val(path)) == -1) uerror("mkdir", path); return Val_unit; } diff --git a/otherlibs/win32unix/open.c b/otherlibs/win32unix/open.c index 98f622bd3..248e7018b 100644 --- a/otherlibs/win32unix/open.c +++ b/otherlibs/win32unix/open.c @@ -13,7 +13,7 @@ #include <mlvalues.h> #include <alloc.h> -#include "unixwin.h" +#include "unixsupport.h" #include <fcntl.h> static int open_flag_table[] = { diff --git a/otherlibs/win32unix/sendrecv.c b/otherlibs/win32unix/sendrecv.c index b84391c25..dffdea9bb 100644 --- a/otherlibs/win32unix/sendrecv.c +++ b/otherlibs/win32unix/sendrecv.c @@ -14,7 +14,7 @@ #include <mlvalues.h> #include <alloc.h> #include <memory.h> -#include "unixwin.h" +#include "unixsupport.h" #include "socketaddr.h" static int msg_flag_table[] = { diff --git a/otherlibs/win32unix/shutdown.c b/otherlibs/win32unix/shutdown.c index 112f9b8aa..914a54247 100644 --- a/otherlibs/win32unix/shutdown.c +++ b/otherlibs/win32unix/shutdown.c @@ -12,7 +12,7 @@ /* $Id$ */ #include <mlvalues.h> -#include "unixwin.h" +#include "unixsupport.h" #include <winsock.h> static int shutdown_command_table[] = { diff --git a/otherlibs/win32unix/cst2constr.h b/otherlibs/win32unix/sleep.c index a9fc39c7c..36a3549f7 100644 --- a/otherlibs/win32unix/cst2constr.h +++ b/otherlibs/win32unix/sleep.c @@ -11,8 +11,15 @@ /* $Id$ */ -#ifdef __STDC__ -value cst_to_constr(int, int *, int, int); -#else -value cst_to_constr(); -#endif +#include <mlvalues.h> +#include "unixsupport.h" +#include <windows.h> + +value unix_sleep(t) /* ML */ + value t; +{ + enter_blocking_section(); + Sleep(Int_val(t) * 1000); + leave_blocking_section(); + return Val_unit; +} diff --git a/otherlibs/win32unix/socket.c b/otherlibs/win32unix/socket.c index 087ab5d14..05b6a096c 100644 --- a/otherlibs/win32unix/socket.c +++ b/otherlibs/win32unix/socket.c @@ -12,7 +12,7 @@ /* $Id$ */ #include <mlvalues.h> -#include "unixwin.h" +#include "unixsupport.h" #include <sys/types.h> #include <winsock.h> diff --git a/otherlibs/win32unix/sockopt.c b/otherlibs/win32unix/sockopt.c index 1cda657ed..3986b8788 100644 --- a/otherlibs/win32unix/sockopt.c +++ b/otherlibs/win32unix/sockopt.c @@ -12,7 +12,7 @@ /* $Id$ */ #include <mlvalues.h> -#include "unixwin.h" +#include "unixsupport.h" #include <winsock.h> #include <sys/types.h> @@ -26,7 +26,7 @@ value unix_getsockopt(socket, option) int optval, optsize; optsize = sizeof(optval); if (getsockopt(_get_osfhandle(Int_val(socket)), SOL_SOCKET, - sockopt[Int_val(option)], &optval, &optsize) == -1) + sockopt[Int_val(option)], (char *) &optval, &optsize) == -1) uerror("getsockopt", Nothing); return Val_int(optval); } @@ -36,7 +36,8 @@ value unix_setsockopt(socket, option, status) { int optval = Int_val(status); if (setsockopt(_get_osfhandle(Int_val(socket)), SOL_SOCKET, - sockopt[Int_val(option)], &optval, sizeof(optval)) == -1) + sockopt[Int_val(option)], + (char *) &optval, sizeof(optval)) == -1) uerror("setsockopt", Nothing); return Val_unit; } diff --git a/otherlibs/win32unix/system.c b/otherlibs/win32unix/system.c index a02cdf55a..ecbc0e571 100644 --- a/otherlibs/win32unix/system.c +++ b/otherlibs/win32unix/system.c @@ -26,10 +26,10 @@ value win_system(cmd) enter_blocking_section(); _flushall(); - ret = system(String_val(c));; + ret = system(String_val(cmd));; leave_blocking_section(); if (ret == -1) uerror("system", Nothing); - st = alloc(1, 0); /* 0: Exited */ + st = alloc(1, 0); /* Tag 0: Exited */ Field(st, 0) = Val_int(ret); return st; } diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml index 5edbc5b26..b1a99c857 100644 --- a/otherlibs/win32unix/unix.ml +++ b/otherlibs/win32unix/unix.ml @@ -149,6 +149,8 @@ type open_flag = | O_CREAT | O_TRUNC | O_EXCL + | O_BINARY + | O_TEXT type file_perm = int @@ -233,14 +235,14 @@ type dir_entry = | Dir_read of string | Dir_toread -type dir_handle = { handle: int; mutable entry: dir_entry } +type dir_handle = { handle: int; mutable entry_read: dir_entry } external findfirst : string -> string * int = "win_findfirst" external findnext : int -> string= "win_findnext" let opendir dirname = try - let (first_entry, handle) = findfirst (nom^"\\*.*") in + let (first_entry, handle) = findfirst (dirname ^ "\\*.*") in { handle = handle; entry_read = Dir_read first_entry } with End_of_file -> { handle = 0; entry_read = Dir_empty } @@ -260,12 +262,6 @@ let closedir d = external pipe : unit -> file_descr * file_descr = "unix_pipe" -type process_times = - { tms_utime : float; - tms_stime : float; - tms_cutime : float; - tms_cstime : float } - type tm = { tm_sec : int; tm_min : int; @@ -280,9 +276,8 @@ type tm = external time : unit -> int = "unix_time" external gmtime : int -> tm = "unix_gmtime" external localtime : int -> tm = "unix_localtime" +external mktime : tm -> int * tm = "unix_mktime" external sleep : int -> unit = "unix_sleep" -external times : unit -> process_times = - "unix_times_bytecode" "unix_times_native" external utimes : string -> int -> int -> unit = "unix_utimes" let getlogin () = @@ -432,7 +427,7 @@ let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t) let open_proc cmd proc input output = let shell = try Sys.getenv "COMSPEC" - with Not_found -> raise(Unix_error(ENOEXEC, "open_proc", cmd) in + with Not_found -> raise(Unix_error(ENOEXEC, "open_proc", cmd)) in let pid = create_process shell [|shell; "/c"; cmd|] input output stderr in Hashtbl.add popen_processes proc pid @@ -440,14 +435,16 @@ let open_proc cmd proc input output = let open_process_in cmd = let (in_read, in_write) = pipe() in let inchan = in_channel_of_descr in_read in - open_proc cmd (Process_in inchan) stdin in_write [in_read]; + set_close_on_exec in_read; + open_proc cmd (Process_in inchan) stdin in_write; close in_write; inchan let open_process_out cmd = let (out_read, out_write) = pipe() in let outchan = out_channel_of_descr out_write in - open_proc cmd (Process_out outchan) out_read stdout [out_write]; + set_close_on_exec out_write; + open_proc cmd (Process_out outchan) out_read stdout; close out_read; outchan @@ -456,8 +453,9 @@ let open_process cmd = let (out_read, out_write) = pipe() in let inchan = in_channel_of_descr in_read in let outchan = out_channel_of_descr out_write in - open_proc cmd (Process(inchan, outchan)) - out_read in_write [in_read; out_write]; + set_close_on_exec in_read; + set_close_on_exec out_write; + open_proc cmd (Process(inchan, outchan)) out_read in_write; (inchan, outchan) let find_proc_id fun_name proc = diff --git a/otherlibs/win32unix/unix.mli b/otherlibs/win32unix/unix.mli index 10ccd0d0e..6a29d9586 100644 --- a/otherlibs/win32unix/unix.mli +++ b/otherlibs/win32unix/unix.mli @@ -142,9 +142,7 @@ external execve : string -> string array -> string array -> unit = "unix_execve" (* Same as [execv], except that the third argument provides the environment to the program executed. *) external execvp : string -> string array -> unit = "unix_execvp" -external execvpe : string -> string array -> string array -> unit = "unix_execvpe" - (* Same as [execv] and [execvp] respectively, except that - the program is searched in the path. *) + (* Same as [execv], except that the program is searched in the path. *) external waitpid : wait_flag list -> int -> int * process_status = "win_waitpid" @@ -294,11 +292,11 @@ external dup : file_descr -> file_descr = "unix_dup" external dup2 : file_descr -> file_descr -> unit = "unix_dup2" (* [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already opened. *) -external set_nonblock : file_descr -> unit = "unix_set_nonblock" -external clear_nonblock : file_descr -> unit = "unix_clear_nonblock" +val set_nonblock : file_descr -> unit +val clear_nonblock : file_descr -> unit (* No-ops *) -external set_close_on_exec : file_descr -> unit = "unix_set_close_on_exec" -external clear_close_on_exec : file_descr -> unit = "unix_clear_close_on_exec" +external set_close_on_exec : file_descr -> unit = "win_set_close_on_exec" +external clear_close_on_exec : file_descr -> unit = "win_clear_close_on_exec" (* Set or clear the ``close-on-exec'' flag on the given descriptor. A descriptor with the close-on-exec flag is automatically closed when the current process starts another program with @@ -321,13 +319,13 @@ type dir_handle (* The type of descriptors over opened directories. *) -external opendir : string -> dir_handle = "unix_opendir" +val opendir : string -> dir_handle (* Open a descriptor on a directory *) -external readdir : dir_handle -> string = "unix_readdir" +val readdir : dir_handle -> string (* Return the next entry in a directory. Raise [End_of_file] when the end of the directory has been reached. *) -external closedir : dir_handle -> unit = "unix_closedir" +val closedir : dir_handle -> unit (* Close a directory descriptor. *) @@ -385,14 +383,6 @@ val close_process: in_channel * out_channel -> process_status (*** Time functions *) -type process_times = - { tms_utime : float; (* User time for the process *) - tms_stime : float; (* System time for the process *) - tms_cutime : float; (* User time for the children processes *) - tms_cstime : float } (* System time for the children processes *) - - (* The execution times (CPU times) of a process. *) - type tm = { tm_sec : int; (* Seconds 0..59 *) tm_min : int; (* Minutes 0..59 *) @@ -422,9 +412,6 @@ external mktime : tm -> int * tm = "unix_mktime" recomputed from the other fields. *) external sleep : int -> unit = "unix_sleep" (* Stop execution for the given number of seconds. *) -external times : unit -> process_times = - "unix_times_bytecode" "unix_times_native" - (* Return the execution times of the process. *) external utimes : string -> int -> int -> unit = "unix_utimes" (* Set the last access time (second arg) and last modification time (third arg) for a file. Times are expressed in seconds from @@ -432,9 +419,9 @@ external utimes : string -> int -> int -> unit = "unix_utimes" (*** User id, group id *) -external getuid : unit -> int = "unix_getuid" +val getuid : unit -> int (* Return the user id of the user executing the process. *) -external getgid : unit -> int = "unix_getgid" +val getgid : unit -> int (* Return the group id of the user executing the process. *) type passwd_entry = @@ -454,18 +441,18 @@ type group_entry = gr_mem : string array } (* Structure of entries in the [groups] database. *) -external getlogin : unit -> string = "unix_getlogin" +val getlogin : unit -> string (* Return the login name of the user executing the process. *) -external getpwnam : string -> passwd_entry = "unix_getpwnam" +val getpwnam : string -> passwd_entry (* Find an entry in [passwd] with the given name, or raise [Not_found]. *) -external getgrnam : string -> group_entry = "unix_getgrnam" +val getgrnam : string -> group_entry (* Find an entry in [group] with the given name, or raise [Not_found]. *) -external getpwuid : int -> passwd_entry = "unix_getpwuid" +val getpwuid : int -> passwd_entry (* Find an entry in [passwd] with the given user id, or raise [Not_found]. *) -external getgrgid : int -> group_entry = "unix_getgrgid" +val getgrgid : int -> group_entry (* Find an entry in [group] with the given group id, or raise [Not_found]. *) @@ -519,10 +506,6 @@ external socket : socket_domain -> socket_type -> int -> file_descr (* Create a new socket in the given domain, and with the given kind. The third argument is the protocol type; 0 selects the default protocol for that kind of sockets. *) -external socketpair : - socket_domain -> socket_type -> int -> file_descr * file_descr - = "unix_socketpair" - (* Create a pair of unnamed sockets, connected together. *) external accept : file_descr -> file_descr * sockaddr = "unix_accept" (* Accept connections on the given socket. The returned descriptor is a socket connected to the client; the returned address is diff --git a/otherlibs/win32unix/unixsupport.c b/otherlibs/win32unix/unixsupport.c new file mode 100644 index 000000000..4ec1be343 --- /dev/null +++ b/otherlibs/win32unix/unixsupport.c @@ -0,0 +1,129 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <memory.h> +#include <fail.h> +#include "unixsupport.h" +#include "cst2constr.h" +#include <errno.h> +#include <winsock.h> + +/* Windows socket errors */ + +#define EWOULDBLOCK WSAEWOULDBLOCK +#define EINPROGRESS WSAEINPROGRESS +#define EALREADY WSAEALREADY +#define ENOTSOCK WSAENOTSOCK +#define EDESTADDRREQ WSAEDESTADDRREQ +#define EMSGSIZE WSAEMSGSIZE +#define EPROTOTYPE WSAEPROTOTYPE +#define ENOPROTOOPT WSAENOPROTOOPT +#define EPROTONOSUPPORT WSAEPROTONOSUPPORT +#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT +#define EOPNOTSUPP WSAEOPNOTSUPP +#define EPFNOSUPPORT WSAEPFNOSUPPORT +#define EAFNOSUPPORT WSAEAFNOSUPPORT +#define EADDRINUSE WSAEADDRINUSE +#define EADDRNOTAVAIL WSAEADDRNOTAVAIL +#define ENETDOWN WSAENETDOWN +#define ENETUNREACH WSAENETUNREACH +#define ENETRESET WSAENETRESET +#define ECONNABORTED WSAECONNABORTED +#define ECONNRESET WSAECONNRESET +#define ENOBUFS WSAENOBUFS +#define EISCONN WSAEISCONN +#define ENOTCONN WSAENOTCONN +#define ESHUTDOWN WSAESHUTDOWN +#define ETOOMANYREFS WSAETOOMANYREFS +#define ETIMEDOUT WSAETIMEDOUT +#define ECONNREFUSED WSAECONNREFUSED +#define ELOOP WSAELOOP +#define EHOSTDOWN WSAEHOSTDOWN +#define EHOSTUNREACH WSAEHOSTUNREACH +#define EPROCLIM WSAEPROCLIM +#define EUSERS WSAEUSERS +#define EDQUOT WSAEDQUOT +#define ESTALE WSAESTALE +#define EREMOTE WSAEREMOTE + +/* Errors not available under Win32 */ + +#define EACCESS (-1) + +int error_table[] = { + E2BIG, EACCESS, EAGAIN, EBADF, EBUSY, ECHILD, EDEADLK, EDOM, + EEXIST, EFAULT, EFBIG, EINTR, EINVAL, EIO, EISDIR, EMFILE, EMLINK, + ENAMETOOLONG, ENFILE, ENODEV, ENOENT, ENOEXEC, ENOLCK, ENOMEM, ENOSPC, + ENOSYS, ENOTDIR, ENOTEMPTY, ENOTTY, ENXIO, EPERM, EPIPE, ERANGE, + EROFS, ESPIPE, ESRCH, EXDEV, EWOULDBLOCK, EINPROGRESS, EALREADY, + ENOTSOCK, EDESTADDRREQ, EMSGSIZE, EPROTOTYPE, ENOPROTOOPT, + EPROTONOSUPPORT, ESOCKTNOSUPPORT, EOPNOTSUPP, EPFNOSUPPORT, + EAFNOSUPPORT, EADDRINUSE, EADDRNOTAVAIL, ENETDOWN, ENETUNREACH, + ENETRESET, ECONNABORTED, ECONNRESET, ENOBUFS, EISCONN, ENOTCONN, + ESHUTDOWN, ETOOMANYREFS, ETIMEDOUT, ECONNREFUSED, EHOSTDOWN, + EHOSTUNREACH, ELOOP /*, EUNKNOWNERR */ +}; + +static value unix_error_exn; + +value unix_register_error(exnval) + value exnval; +{ + unix_error_exn = Field(exnval, 0); + register_global_root(&unix_error_exn); + return Val_unit; +} + +void unix_error(errcode, cmdname, cmdarg) + int errcode; + char * cmdname; + value cmdarg; +{ + value res; + Push_roots(r, 2); +#define name r[0] +#define arg r[1] + arg = cmdarg == Nothing ? copy_string("") : cmdarg; + name = copy_string(cmdname); + res = alloc(4, 0); + Field(res, 0) = unix_error_exn; + Field(res, 1) = + cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), + sizeof(error_table)/sizeof(int)); + Field(res, 2) = name; + Field(res, 3) = arg; + Pop_roots(); + mlraise(res); +} + +void uerror(cmdname, cmdarg) + char * cmdname; + value cmdarg; +{ + unix_error(errno, cmdname, cmdarg); +} + +value unix_freeze_buffer(buf) + value buf; +{ + if (Is_young(buf)) { + Push_roots(r, 1); + r[0] = buf; + minor_collection(); + buf = r[0]; + Pop_roots(); + } + return buf; +} diff --git a/otherlibs/win32unix/unixsupport.h b/otherlibs/win32unix/unixsupport.h index 0fae79713..49a72ae51 100644 --- a/otherlibs/win32unix/unixsupport.h +++ b/otherlibs/win32unix/unixsupport.h @@ -12,7 +12,9 @@ /* $Id$ */ #include <stdlib.h> -#include <io.h> +/* Include io.h in current dir, which is a copy of the system's io.h, + not io.h from ../../byterun */ +#include "io.h" #include <direct.h> #include <process.h> diff --git a/otherlibs/win32unix/windir.c b/otherlibs/win32unix/windir.c index 532cd6643..08f70ed66 100644 --- a/otherlibs/win32unix/windir.c +++ b/otherlibs/win32unix/windir.c @@ -13,18 +13,20 @@ #include <mlvalues.h> #include <memory.h> -#include <windows.h> +#include <errno.h> #include <alloc.h> #include "unixsupport.h" value win_findfirst(name) /* ML */ value name; { - HANDLE h; + int h; value v; struct _finddata_t fileinfo; Push_roots(r,1); + #define valname r[0] + h = _findfirst(String_val(name),&fileinfo); if (h == -1) { if (errno == ENOENT) |