Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

MAJ portage Win32 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1698 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 1997-09-02 16:01:39 +00:00
parent 4c8f23357d
commit 88054d9a98
13 changed files with 111 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Makefile.nt
View File

@ -26,6 +26,7 @@ PARSING=parsing\linenum.cmo parsing\location.cmo parsing\longident.cmo \
TYPING=typing\ident.cmo typing\path.cmo \
typing\primitive.cmo typing\types.cmo \
typing\btype.cmo \
typing\subst.cmo typing\predef.cmo \
typing\datarepr.cmo typing\env.cmo \
typing\typedtree.cmo \
@ -63,6 +64,7 @@ DRIVER=driver\errors.cmo driver\compile.cmo driver\main.cmo
OPTDRIVER=driver\opterrors.cmo driver\optcompile.cmo driver\optmain.cmo
TOPLEVEL=driver\errors.cmo driver\compile.cmo \
toplevel\genprintval.cmo \
toplevel\printval.cmo toplevel\toploop.cmo \
toplevel\trace.cmo toplevel\topdirs.cmo
@ -78,7 +80,7 @@ OPTOBJS=$(OPTUTILS) $(PARSING) $(TYPING) $(COMP) $(ASMCOMP) $(OPTDRIVER)
EXPUNGEOBJS=utils\misc.cmo utils\tbl.cmo \
utils\config.cmo utils\clflags.cmo \
typing\ident.cmo typing\predef.cmo \
typing\ident.cmo typing\types.cmo typing\btype.cmo typing\predef.cmo \
bytecomp\runtimedef.cmo bytecomp\symtable.cmo \
toplevel\expunge.cmo
@ -340,7 +342,7 @@ beforedepend:: bytecomp\runtimedef.ml
# Choose the right machine-dependent files
asmcomp\arch.ml: asmcomp\$(ARCH)\arch.ml
cp $(ARCH)\arch.ml asmcomp\arch.ml
cp asmcomp\$(ARCH)\arch.ml asmcomp\arch.ml
partialclean::
rm -f asmcomp\arch.ml
@ -348,7 +350,7 @@ partialclean::
beforedepend:: asmcomp\arch.ml
asmcomp\proc.ml: asmcomp\$(ARCH)\proc_nt.ml
cp $(ARCH)\proc_nt.ml asmcomp\proc.ml
cp asmcomp\$(ARCH)\proc_nt.ml asmcomp\proc.ml
partialclean::
rm -f asmcomp\proc.ml
@ -356,7 +358,7 @@ partialclean::
beforedepend:: asmcomp\proc.ml
asmcomp\selection.ml: asmcomp\$(ARCH)\selection.ml
cp $(ARCH)\selection.ml asmcomp\selection.ml
cp asmcomp\$(ARCH)\selection.ml asmcomp\selection.ml
partialclean::
rm -f asmcomp\selection.ml
@ -364,7 +366,7 @@ partialclean::
beforedepend:: asmcomp\selection.ml
asmcomp\reload.ml: asmcomp\$(ARCH)\reload.ml
cp $(ARCH)\reload.ml asmcomp\reload.ml
cp asmcomp\$(ARCH)\reload.ml asmcomp\reload.ml
partialclean::
rm -f asmcomp\reload.ml
@ -372,7 +374,7 @@ partialclean::
beforedepend:: asmcomp\reload.ml
asmcomp\scheduling.ml: asmcomp\$(ARCH)\scheduling.ml
cp $(ARCH)\scheduling.ml asmcomp\scheduling.ml
cp asmcomp\$(ARCH)\scheduling.ml asmcomp\scheduling.ml
partialclean::
rm -f asmcomp\scheduling.ml

2
asmcomp/i386/emit_nt.mlp
View File

@ -770,7 +770,7 @@ let begin_assembly() =
let lbl_begin = Compilenv.current_unit_name() ^ "_data_begin" in
add_def_symbol lbl_begin;
` PUBLIC {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin} LABEL DWORD\n`
`{emit_symbol lbl_begin} LABEL DWORD\n`;
` .CODE\n`;
let lbl_begin = Compilenv.current_unit_name() ^ "_code_begin" in
add_def_symbol lbl_begin;

2
byterun/Makefile.nt
View File

@ -1,6 +1,6 @@
!include ..\config\Makefile.nt
CC=$(BYTECC)
CC=$(BYTECC) /Zi
CFLAGS=$(BYTECCCOMPOPTS)
OBJS=interp.obj misc.obj stacks.obj fix_code.obj startup.obj main.obj \

2
byterun/signals.c
View File

@ -160,7 +160,7 @@ int posix_signals[] = {
value install_signal_handler(value signal_number, value action) /* ML */
{
int sig;
void (*act)();
void (*act)(int signo);
#ifdef POSIX_SIGNALS
struct sigaction sigact;
#endif

1
byterun/terminfo.c
View File

@ -78,7 +78,6 @@ value terminfo_getstr(value capa)
}
value terminfo_getnum(value capa)
value capa;
{
raise_not_found();
return Val_unit;

8
otherlibs/systhreads/Makefile.nt
View File

@ -1,8 +1,6 @@
include ../../config/Makefile.nt
# Compilation options
CC=$(BYTECC)
CFLAGS=-I..\..\byterun $(BYTECCCOMPOPTS)
CAMLC=..\..\boot\ocamlrun ..\..\boot\ocamlc -I ..\..\stdlib -I ..\win32unix
CAMLOPT=..\..\boot\ocamlrun ..\..\ocamlopt -I ..\..\stdlib -I ..\win32unix
CPPFLAGS=/DWIN32
@ -14,16 +12,16 @@ THREAD_OBJS=thread.cmo condition.cmo event.cmo threadUnix.cmo
GENFILES=thread.ml
all: libthreads.lib threads.cma stdlib.cma
all: libthreads.lib threads.cma
allopt: libthreadsnat.a threads.cmxa
allopt: libthreadsnat.lib threads.cmxa
libthreads.lib: $(BYTECODE_C_OBJS)
rm -f libthreads.lib
$(MKLIB)libthreads.lib $(BYTECODE_C_OBJS)
win32_b.obj: win32.c
$(BYTECC) -O -I..\..\byterun $(BYTECCCOMPOPTS) -c win32.c
$(BYTECC) -O -I..\..\byterun $(BYTECCCOMPOPTS) /Zi -c win32.c
mv win32.obj win32_b.obj
libthreadsnat.lib: $(NATIVECODE_C_OBJS)

18
otherlibs/systhreads/Tests/Makefile.nt
View File

@ -4,16 +4,26 @@ PROGS=test1.byt test2.byt test3.byt test4.byt test5.byt test6.byt \
!include ../../../config/Makefile.nt
CAMLC=..\..\..\boot\ocamlrun ..\..\..\ocamlc -I .. -I ..\..\win32unix -I ..\..\..\stdlib -ccopt /Zi
CAMLOPT=..\..\..\boot\ocamlrun ..\..\..\ocamlopt -I .. -I ..\..\win32unix -I ..\..\..\stdlib
all: $(PROGS)
allopt: $(PROGS:.byt=.out)
clean:
rm -f *.cm* *.byt
rm -f *.cm* *.byt *.out
rm -f $(PROGS:.byt=.ml)
.SUFFIXES: .ml .byt
.SUFFIXES: .ml .byt .out
{..\..\threads\Tests}.ml{}.byt:
cp ../../threads/Tests/$*.ml $*.ml
ocamlc -custom -o $*.byt -I .. -I ../../win32unix unix.cma threads.cma $*.ml ..\libthreads.lib ..\..\win32unix\libunix.lib wsock32.lib
$(CAMLC) -custom -o $*.byt unix.cma threads.cma $*.ml ..\libthreads.lib ..\..\win32unix\libunix.lib wsock32.lib
$(PROGS): ../threads.cma ../libthreads.lib ../stdlib.cma
{..\..\threads\Tests}.ml{}.out:
cp ../../threads/Tests/$*.ml $*.ml
$(CAMLOPT) -o $*.out unix.cmxa threads.cmxa $*.ml ..\libthreadsnat.lib ..\..\win32unix\libunix.lib wsock32.lib
$(PROGS): ../threads.cma ../libthreads.lib
$(PROGS:.byt=.out): ../threads.cmxa ../libthreadsnat.lib

2
otherlibs/systhreads/thread.mlp
View File

@ -67,7 +67,7 @@ let wait_write fd = ()
#ifdef WIN32
let wait_timed_read fd delay = true
let wait_timed_write fd delay = true
let select rd wr ex delay = invalid_argument "Thread.select: not implemented"
let select rd wr ex delay = invalid_arg "Thread.select: not implemented"
#else
let wait_timed_read fd d =
match Unix.select [fd] [] [] d with ([], _, _) -> false | (_, _, _) -> true

51
otherlibs/systhreads/win32.c
View File

@ -79,7 +79,7 @@ typedef struct caml_thread_struct * caml_thread_t;
/* The descriptor for the currently executing thread (thread-specific) */
static __declspec( thread ) HANDLE caml_thread_t curr_thread = NULL;
static __declspec( thread ) caml_thread_t curr_thread = NULL;
/* The global mutex used to ensure that at most one thread is running
Caml code */
@ -186,14 +186,13 @@ static void caml_io_mutex_free(struct channel * chan)
HANDLE mutex = chan->mutex;
if (mutex != NULL) {
CloseHandle(mutex);
stat_free((char *) mutex);
}
}
static void caml_io_mutex_lock(struct channel * chan)
{
if (chan->mutex == NULL) {
HANDLE mutex = CreateMutex(NULL, TRUE, NULL);
HANDLE mutex = CreateMutex(NULL, FALSE, NULL);
if (mutex == NULL) caml_wthread_error("Thread.iolock");
chan->mutex = (void *) mutex;
}
@ -254,18 +253,15 @@ static void caml_thread_finalize(value vthread)
value caml_thread_initialize(value unit) /* ML */
{
pthread_t tick_pthread;
pthread_attr_t attr;
value vthread = Val_unit;
value descr;
HANDLE tick_thread;
unsigned long tick_id;
Begin_root (vthread);
/* Initialize the main mutex */
/* Initialize the main mutex and acquire it */
caml_mutex = CreateMutex(NULL, TRUE, NULL);
if (caml_mutex == NULL) caml_wthread_error("Thread.init");
WaitForSingleObject(caml_mutex, INFINITE);
/* Create a finalized value to hold thread handle */
vthread = alloc_final(2, caml_thread_finalize, 1, 1000);
((struct caml_thread_handle *)vthread)->handle = NULL;
@ -273,7 +269,7 @@ value caml_thread_initialize(value unit) /* ML */
descr = alloc_tuple(3);
Ident(descr) = Val_long(thread_next_ident);
Start_closure(descr) = Val_unit;
Vhandle(descr) = vthread;
Threadhandle(descr) = (struct caml_thread_handle *) vthread;
thread_next_ident++;
/* Create an info block for the current thread */
curr_thread =
@ -315,6 +311,9 @@ static void caml_thread_start(caml_thread_t th)
{
value clos;
/* Initialize the per-thread variables */
curr_thread = th;
last_channel_locked = NULL;
/* Acquire the global mutex and set up the stack variables */
leave_blocking_section();
/* Callback the closure */
@ -329,7 +328,6 @@ static void caml_thread_start(caml_thread_t th)
value caml_thread_new(value clos) /* ML */
{
pthread_attr_t attr;
caml_thread_t th;
value vthread = Val_unit;
value descr;
@ -343,7 +341,7 @@ value caml_thread_new(value clos) /* ML */
descr = alloc_tuple(3);
Ident(descr) = Val_long(thread_next_ident);
Start_closure(descr) = clos;
Vhandle(descr) = vthread;
Threadhandle(descr) = (struct caml_thread_handle *) vthread;
thread_next_ident++;
/* Create an info block for the current thread */
th = (caml_thread_t) stat_alloc(sizeof(struct caml_thread_struct));
@ -428,8 +426,6 @@ value caml_thread_kill(value target) /* ML */
{
caml_thread_t th;
if (target == curr_thread->descr)
raise_sys_error("Thread.kill: cannot kill self");
if (TerminateThread(Threadhandle(target)->handle, 1) == 0)
caml_wthread_error("Thread.kill");
for (th = curr_thread; th->descr != target; th = th->next) /*nothing*/;
@ -501,7 +497,7 @@ value caml_thread_delay(value val) /* ML */
struct caml_condvar {
void (*final_fun)(); /* Finalization function */
unsigned long count; /* Number of waiting threads */
HANDLE event; /* Auto-reset event on which threads are waiting */
HANDLE sem; /* Semaphore on which threads are waiting */
};
#define Condition_val(v) ((struct caml_condvar *)(v))
@ -509,7 +505,7 @@ struct caml_condvar {
static void caml_condition_finalize(value cond)
{
CloseHandle(Condition_val(cond)->event);
CloseHandle(Condition_val(cond)->sem);
}
value caml_condition_new(value unit) /* ML */
@ -517,8 +513,8 @@ value caml_condition_new(value unit) /* ML */
value cond;
cond = alloc_final(sizeof(struct caml_condvar) / sizeof(value),
caml_condition_finalize, 1, Max_condition_number);
Condition_val(cond)->event = CreateEvent(NULL, FALSE, FALSE, NULL);
if (Condition_val(cond)->event == NULL)
Condition_val(cond)->sem = CreateSemaphore(NULL, 0, 0x7FFFFFFF, NULL);
if (Condition_val(cond)->sem == NULL)
caml_wthread_error("Condition.create");
Condition_val(cond)->count = 0;
return cond;
@ -528,14 +524,14 @@ value caml_condition_wait(value cond, value mut) /* ML */
{
int retcode1, retcode2;
HANDLE m = Mutex_val(mut);
HANDLE e = Condition_val(cond)->event;
HANDLE s = Condition_val(cond)->sem;
Condition_val(cond)->count ++;
enter_blocking_section();
/* Release mutex */
ReleaseMutex(m);
/* Wait for event to be toggled */
retcode1 = WaitForSingleObject(e, INFINITE);
/* Wait for semaphore to be non-null, and decrement it */
retcode1 = WaitForSingleObject(s, INFINITE);
/* Re-acquire mutex */
retcode2 = WaitForSingleObject(m, INFINITE);
leave_blocking_section();
@ -546,13 +542,13 @@ value caml_condition_wait(value cond, value mut) /* ML */
value caml_condition_signal(value cond) /* ML */
{
HANDLE e = Condition_val(cond)->event;
HANDLE s = Condition_val(cond)->sem;
if (Condition_val(cond)->count > 0) {
Condition_val(cond)->count --;
enter_blocking_section();
/* Toggle event once, waking up one waiter */
SetEvent(e);
/* Increment semaphore by 1, waking up one waiter */
ReleaseSemaphore(s, 1, NULL);
leave_blocking_section();
}
return Val_unit;
@ -560,14 +556,14 @@ value caml_condition_signal(value cond) /* ML */
value caml_condition_broadcast(value cond) /* ML */
{
HANDLE e = Condition_val(cond)->event;
HANDLE s = Condition_val(cond)->sem;
unsigned long c = Condition_val(cond)->count;
if (c > 0) {
Condition_val(cond)->count = 0;
enter_blocking_section();
/* Toggle event c times, waking up all waiters */
for (/*nothing*/; c > 0; c--) SetEvent(e);
/* Increment semaphore by c, waking up all waiters */
ReleaseSemaphore(s, c, NULL);
leave_blocking_section();
}
return Val_unit;
@ -577,6 +573,7 @@ value caml_condition_broadcast(value cond) /* ML */
static void caml_wthread_error(char * msg)
{
_dosmaperr(GetLastError());
sys_error(msg, NO_ARG);
char errmsg[1024];
sprintf(errmsg, "%s: error code %x\n", msg, GetLastError());
raise_sys_error(copy_string(errmsg));
}

2
otherlibs/win32unix/createprocess.c
View File

@ -41,7 +41,7 @@ value win_create_process_native(cmd, cmdline, env, fd1, fd2, fd3)
if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
TRUE, 0, envp, NULL, &si, &pi)) {
_dosmaperr(GetLastError());
uerror("create_process", exefile);
uerror("create_process", cmd);
}
return Val_int(pi.hProcess);
}

75
otherlibs/win32unix/sendrecv.c
View File

@ -21,69 +21,84 @@ static int msg_flag_table[] = {
MSG_OOB, MSG_DONTROUTE, MSG_PEEK
};
value unix_recv(sock, buff, ofs, len, flags) /* ML */
value sock, buff, ofs, len, flags;
value unix_recv(value sock, value buff, value ofs, value len, value flags)
{
int ret;
buff = unix_freeze_buffer(buff);
enter_blocking_section();
ret = recv((SOCKET) _get_osfhandle(Int_val(sock)),
&Byte(buff, Long_val(ofs)), Int_val(len),
convert_flag_list(flags, msg_flag_table));
leave_blocking_section();
if (ret == -1) uerror("recv", Nothing);
long numbytes;
char iobuf[UNIX_BUFFER_SIZE];
Begin_root (buff);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
enter_blocking_section();
ret = recv((SOCKET) _get_osfhandle(Int_val(sock)), iobuf, (int) numbytes,
convert_flag_list(flags, msg_flag_table));
leave_blocking_section();
if (ret == -1) uerror("recv", Nothing);
bcopy(iobuf, &Byte(buff, Long_val(ofs)), ret);
End_roots();
return Val_int(ret);
}
value unix_recvfrom(sock, buff, ofs, len, flags) /* ML */
value sock, buff, ofs, len, flags;
value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) /* ML */
{
int retcode;
int ret;
long numbytes;
char iobuf[UNIX_BUFFER_SIZE];
value res;
value adr = Val_unit;
Begin_root (adr);
buff = unix_freeze_buffer(buff); /* XXX Xavier regarde ca */
Begin_roots2 (buff, adr);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
sock_addr_len = sizeof(sock_addr);
enter_blocking_section();
retcode = recvfrom((SOCKET) _get_osfhandle(Int_val(sock)),
&Byte(buff, Long_val(ofs)), Int_val(len),
convert_flag_list(flags, msg_flag_table),
&sock_addr.s_gen, &sock_addr_len);
ret = recvfrom((SOCKET) _get_osfhandle(Int_val(sock)),
iobuf, (int) numbytes,
convert_flag_list(flags, msg_flag_table),
&sock_addr.s_gen, &sock_addr_len);
leave_blocking_section();
if (retcode == -1) uerror("recvfrom", Nothing);
if (ret == -1) uerror("recvfrom", Nothing);
bcopy(iobuf, &Byte(buff, Long_val(ofs)), ret);
adr = alloc_sockaddr();
res = alloc_tuple(2);
Field(res, 0) = Val_int(retcode);
Field(res, 0) = Val_int(ret);
Field(res, 1) = adr;
End_roots();
return res;
}
value unix_send(sock, buff, ofs, len, flags) /* ML */
value sock, buff, ofs, len, flags;
value unix_send(value sock, value buff, value ofs, value len, value flags) /* ML */
{
int ret;
buff = unix_freeze_buffer(buff);
long numbytes;
char iobuf[UNIX_BUFFER_SIZE];
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
bcopy(&Byte(buff, Long_val(ofs)), iobuf, numbytes);
enter_blocking_section();
ret = send((SOCKET) _get_osfhandle(Int_val(sock)),
&Byte(buff, Long_val(ofs)), Int_val(len),
ret = send((SOCKET) _get_osfhandle(Int_val(sock)), iobuf, (int) numbytes,
convert_flag_list(flags, msg_flag_table));
leave_blocking_section();
if (ret == -1) uerror("send", Nothing);
return Val_int(ret);
}
value unix_sendto_native(sock, buff, ofs, len, flags, dest)
value sock, buff, ofs, len, flags, dest;
value unix_sendto_native(value sock, value buff, value ofs, value len, value flags, value dest)
{
int ret;
long numbytes;
char iobuf[UNIX_BUFFER_SIZE];
get_sockaddr(dest);
buff = unix_freeze_buffer(buff);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
bcopy(&Byte(buff, Long_val(ofs)), iobuf, numbytes);
enter_blocking_section();
ret = sendto((SOCKET) _get_osfhandle(Int_val(sock)),
&Byte(buff, Long_val(ofs)),
Int_val(len), convert_flag_list(flags, msg_flag_table),
iobuf, (int) numbytes,
convert_flag_list(flags, msg_flag_table),
&sock_addr.s_gen, sock_addr_len);
leave_blocking_section();
if (ret == -1) uerror("sendto", Nothing);

13
otherlibs/win32unix/socketaddr.h
View File

@ -15,15 +15,16 @@
#include <sys/types.h>
#include <winsock.h>
union {
union sock_addr_union {
struct sockaddr s_gen;
struct sockaddr_in s_inet;
} sock_addr;
};
int sock_addr_len;
extern union sock_addr_union sock_addr;
extern int sock_addr_len;
void get_sockaddr P((value));
value alloc_sockaddr P((void));
value alloc_inet_addr P((unsigned int));
void get_sockaddr (value);
value alloc_sockaddr (void);
value alloc_inet_addr (unsigned int);
#define GET_INET_ADDR(v) (*((uint32 *) (v)))

8
otherlibs/win32unix/unixsupport.h
View File

@ -20,6 +20,8 @@
#define Nothing ((value) 0)
extern void unix_error P((int errcode, char * cmdname, value arg));
extern void uerror P((char * cmdname, value arg));
extern value unix_freeze_buffer P((value));
extern void unix_error (int errcode, char * cmdname, value arg);
extern void uerror (char * cmdname, value arg);
extern value unix_freeze_buffer (value);
#define UNIX_BUFFER_SIZE 16384