From: Stephane Glondu Date: Thu, 4 Dec 2008 16:04:23 +0000 (+0100) Subject: Imported Upstream version 3.11.0 X-Git-Tag: archive/raspbian/4.08.1-4+rpi1~3^2~63^2~28 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=d7ffe3cdc258d8660027f93000a6b9ce438af5fd;p=ocaml.git Imported Upstream version 3.11.0 --- diff --git a/Changes b/Changes index 85ea1217..4176ceb6 100644 --- a/Changes +++ b/Changes @@ -99,6 +99,9 @@ Tools: - ocamlmklib no longer supports the -implib option. - ocamlnat: an experimental native toplevel (not built by default). +Camlp4: +* programs linked with camlp4lib.cma now also need dynlink.cma. + Bug fixes: - Major GC and heap compaction: fixed bug involving lazy values and out-of-heap pointers. @@ -2384,4 +2387,4 @@ Caml Special Light 1.06: * First public release. -$Id: Changes,v 1.183.2.7 2008/11/18 10:24:31 doligez Exp $ +$Id: Changes,v 1.183.2.8 2008/12/03 16:16:30 doligez Exp $ diff --git a/README b/README index bda82a15..aa54cbea 100644 --- a/README +++ b/README @@ -78,8 +78,8 @@ CONTENTS: COPYRIGHT: All files marked "Copyright INRIA" in this distribution are copyright -1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 -Institut National de Recherche en Informatique et en Automatique +1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +2007, 2008 Institut National de Recherche en Informatique et en Automatique (INRIA) and distributed under the conditions stated in file LICENSE. INSTALLATION: @@ -135,4 +135,4 @@ You can also contact the implementors directly at caml@inria.fr. ---- -$Id: README,v 1.44 2006/09/20 11:14:30 doligez Exp $ +$Id: README,v 1.44.14.1 2008/12/02 17:11:22 xleroy Exp $ diff --git a/VERSION b/VERSION index 8e10f978..8444af03 100644 --- a/VERSION +++ b/VERSION @@ -1,6 +1,6 @@ -3.11.0+rc1 +3.11.0 # The version string is the first line of this file. # It must be in the format described in stdlib/sys.mli -# $Id: VERSION,v 1.26.2.6 2008/11/24 16:30:40 doligez Exp $ +# $Id: VERSION,v 1.26.2.7 2008/12/03 16:16:30 doligez Exp $ diff --git a/boot/ocamlc b/boot/ocamlc index eb8e6485..8002783b 100755 Binary files a/boot/ocamlc and b/boot/ocamlc differ diff --git a/boot/ocamldep b/boot/ocamldep index 66696d9f..0ff6b501 100755 Binary files a/boot/ocamldep and b/boot/ocamldep differ diff --git a/boot/ocamllex b/boot/ocamllex index bafc89c2..f2775309 100755 Binary files a/boot/ocamllex and b/boot/ocamllex differ diff --git a/byterun/Makefile.nt b/byterun/Makefile.nt index f4729c17..7691e23e 100644 --- a/byterun/Makefile.nt +++ b/byterun/Makefile.nt @@ -11,7 +11,7 @@ # # ######################################################################### -# $Id: Makefile.nt,v 1.48 2008/07/29 08:31:41 xleroy Exp $ +# $Id: Makefile.nt,v 1.48.2.1 2008/11/26 13:26:53 xleroy Exp $ include Makefile.common @@ -22,10 +22,10 @@ OBJS=$(COMMONOBJS:.o=.$(O)) win32.$(O) main.$(O) DOBJS=$(OBJS:.$(O)=.$(DBGO)) instrtrace.$(DBGO) ocamlrun$(EXE): libcamlrun.$(A) prims.$(O) - $(MKEXE) -o ocamlrun$(EXE) prims.$(O) $(call SYSLIB,ws2_32) libcamlrun.$(A) + $(MKEXE) -o ocamlrun$(EXE) prims.$(O) $(call SYSLIB,ws2_32) $(EXTRALIBS) libcamlrun.$(A) ocamlrund$(EXE): libcamlrund.$(A) prims.$(O) main.$(O) - $(MKEXE) -o ocamlrun$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) $(call SYSLIB,ws2_32) libcamlrund.$(A) + $(MKEXE) -o ocamlrun$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) $(call SYSLIB,ws2_32) $(EXTRALIBS) libcamlrund.$(A) libcamlrun.$(A): $(OBJS) $(call MKLIB,libcamlrun.$(A),$(OBJS)) diff --git a/byterun/unix.c b/byterun/unix.c index 5cc18d0d..457f88c3 100644 --- a/byterun/unix.c +++ b/byterun/unix.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: unix.c,v 1.35 2008/04/22 12:40:14 frisch Exp $ */ +/* $Id: unix.c,v 1.35.2.1 2008/12/03 12:39:44 xleroy Exp $ */ /* Unix-specific stuff */ @@ -190,7 +190,7 @@ void * caml_dlsym(void * handle, char * name) void * caml_globalsym(char * name) { - return flexdll_dlsym(flexdll_dlopen(NULL,0,1), name); + return flexdll_dlsym(flexdll_dlopen(NULL,0), name); } char * caml_dlerror(void) diff --git a/camlp4/Camlp4Bin.ml b/camlp4/Camlp4Bin.ml index 5e9ff0fd..5a029b94 100644 --- a/camlp4/Camlp4Bin.ml +++ b/camlp4/Camlp4Bin.ml @@ -176,7 +176,7 @@ Options: .ml Parse this implementation file .mli Parse this interface file .%s Load this module inside the Camlp4 core@." -(if DynLoader.is_native then "cmx " else "(cmo|cma)") +(if DynLoader.is_native then "cmxs " else "(cmo|cma)") ; Options.print_usage_list ini_sl; (* loop (ini_sl @ ext_sl) where rec loop = @@ -268,11 +268,11 @@ value initial_spec_list = "Don't parse quotations, allowing to use, e.g. \"<:>\" as token."); ("-loaded-modules", Arg.Set print_loaded_modules, "Print the list of loaded modules."); ("-parser", Arg.String (rewrite_and_load "Parsers"), - " Load the parser Camlp4Parsers/.cmo"); + " Load the parser Camlp4Parsers/.cm(o|a|xs)"); ("-printer", Arg.String (rewrite_and_load "Printers"), - " Load the printer Camlp4Printers/.cmo"); + " Load the printer Camlp4Printers/.cm(o|a|xs)"); ("-filter", Arg.String (rewrite_and_load "Filters"), - " Load the filter Camlp4Filters/.cmo"); + " Load the filter Camlp4Filters/.cm(o|a|xs)"); ("-ignore", Arg.String ignore, "ignore the next argument"); ("--", Arg.Unit ignore, "Deprecated, does nothing") ]; diff --git a/emacs/caml-font.el b/emacs/caml-font.el index 2914fdfd..e796abdc 100644 --- a/emacs/caml-font.el +++ b/emacs/caml-font.el @@ -80,11 +80,12 @@ (cond (in-string 'font-lock-string-face) (in-comment - (goto-char start) - (cond - ((looking-at "(\\*\\*/\\*\\*)") 'caml-font-stop-face) - ((looking-at "(\\*\\*[^*]") 'caml-font-doccomment-face) - (t 'font-lock-comment-face)))))) + (save-excursion + (goto-char start) + (cond + ((looking-at "(\\*\\*/\\*\\*)") 'caml-font-stop-face) + ((looking-at "(\\*\\*[^*]") 'caml-font-doccomment-face) + (t 'font-lock-comment-face))))))) ;; font-lock commands are similar for caml-mode and inferior-caml-mode diff --git a/emacs/caml.el b/emacs/caml.el index 1f3c8f3a..1f6d86bc 100644 --- a/emacs/caml.el +++ b/emacs/caml.el @@ -10,7 +10,7 @@ ;(* *) ;(***********************************************************************) -;(* $Id: caml.el,v 1.44.2.1 2008/10/29 12:30:57 doligez Exp $ *) +;(* $Id: caml.el,v 1.44.2.2 2008/12/03 16:16:43 doligez Exp $ *) ;;; caml.el --- O'Caml code editing commands for Emacs @@ -411,10 +411,10 @@ have caml-electric-indent on, which see.") ; backslash is an escape sequence (modify-syntax-entry ?\\ "\\" caml-mode-syntax-table) ; ( is first character of comment start - (modify-syntax-entry ?\( "()1" caml-mode-syntax-table) + (modify-syntax-entry ?\( "()1n" caml-mode-syntax-table) ; * is second character of comment start, ; and first character of comment end - (modify-syntax-entry ?* ". 23" caml-mode-syntax-table) + (modify-syntax-entry ?* ". 23n" caml-mode-syntax-table) ; ) is last character of comment end (modify-syntax-entry ?\) ")(4" caml-mode-syntax-table) ; backquote was a string-like delimiter (for character literals) diff --git a/otherlibs/labltk/browser/Makefile.nt b/otherlibs/labltk/browser/Makefile.nt index df1e92ac..7b59f4a4 100644 --- a/otherlibs/labltk/browser/Makefile.nt +++ b/otherlibs/labltk/browser/Makefile.nt @@ -2,7 +2,7 @@ OTHERSLIB=-I $(OTHERS)/win32unix -I $(OTHERS)/str -I $(OTHERS)/systhreads CCFLAGS=-I../../../byterun $(TK_DEFS) -include Makefile.shared +include ../support/Makefile.common ifeq ($(CCOMPTYPE),cc) WINDOWS_APP=-ccopt "-link -Wl,--subsystem,windows" @@ -13,5 +13,7 @@ endif XTRAOBJ=winmain.$(O) XTRALIBS=threads.cma -custom $(WINDOWS_APP) +include Makefile.shared + dummy.mli: cp dummyWin.mli dummy.mli diff --git a/otherlibs/win32unix/select.c b/otherlibs/win32unix/select.c index d3926204..e919d359 100644 --- a/otherlibs/win32unix/select.c +++ b/otherlibs/win32unix/select.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: select.c,v 1.14.2.1 2008/10/29 13:38:56 xleroy Exp $ */ +/* $Id: select.c,v 1.14.2.2 2008/11/26 13:27:21 xleroy Exp $ */ #include #include @@ -70,7 +70,9 @@ void handle_set_add (LPSELECTHANDLESET hds, HANDLE hdl) hds->nLast++; } - DBUG_PRINT("Adding handle %x to set %x", hdl, hds); +#ifdef DBUG + dbug_print("Adding handle %x to set %x", hdl, hds); +#endif } BOOL handle_set_mem (LPSELECTHANDLESET hds, HANDLE hdl) @@ -220,7 +222,9 @@ void select_data_free (LPSELECTDATA lpSelectData) { DWORD i; - DBUG_PRINT("Freeing data of %x", lpSelectData); +#ifdef DBUG + dbug_print("Freeing data of %x", lpSelectData); +#endif /* Free APC related data, if they exists */ if (lpSelectData->lpWorker != NULL) @@ -292,7 +296,9 @@ LPSELECTDATA select_data_job_search (LPSELECTDATA *lppSelectData, SELECTTYPE ETy res = NULL; /* Search for job */ - DBUG_PRINT("Searching an available job for type %d", EType); +#ifdef DBUG + dbug_print("Searching an available job for type %d", EType); +#endif res = *lppSelectData; while ( res != NULL @@ -308,7 +314,9 @@ LPSELECTDATA select_data_job_search (LPSELECTDATA *lppSelectData, SELECTTYPE ETy /* No matching job found, create one */ if (res == NULL) { - DBUG_PRINT("No job for type %d found, create one", EType); +#ifdef DBUG + dbug_print("No job for type %d found, create one", EType); +#endif res = select_data_new(*lppSelectData, EType); *lppSelectData = res; } @@ -329,7 +337,9 @@ void read_console_poll(HANDLE hStop, void *_data) LPSELECTDATA lpSelectData; LPSELECTQUERY lpQuery; - DBUG_PRINT("Waiting for data on console"); +#ifdef DBUG + dbug_print("Waiting for data on console"); +#endif record; waitRes = 0; @@ -402,7 +412,9 @@ void read_pipe_poll (HANDLE hStop, void *_data) n = 0; lpSelectData = (LPSELECTDATA)_data; - DBUG_PRINT("Checking data pipe"); +#ifdef DBUG + dbug_print("Checking data pipe"); +#endif while (lpSelectData->EState == SELECT_STATE_NONE) { for (i = 0; i < lpSelectData->nQueriesCount; i++) @@ -440,7 +452,9 @@ void read_pipe_poll (HANDLE hStop, void *_data) } } } - DBUG_PRINT("Finish checking data on pipe"); +#ifdef DBUG + dbug_print("Finish checking data on pipe"); +#endif } /* Add a function to monitor pipe input */ @@ -454,7 +468,9 @@ LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HA worker can handle many pipe. We begin to try to find a worker that is polling pipe, but for which there is under the limit of pipe per worker. */ - DBUG_PRINT("Searching an available worker handling pipe"); +#ifdef DBUG + dbug_print("Searching an available worker handling pipe"); +#endif res = select_data_job_search(&hd, SELECT_TYPE_PIPE_READ); /* Add a new pipe to poll */ @@ -526,7 +542,9 @@ void socket_poll (HANDLE hStop, void *_data) iterQuery = &(lpSelectData->aQueries[i]); if (WaitForSingleObject(aEvents[i], 0) == WAIT_OBJECT_0) { - DBUG_PRINT("Socket %d has pending events", (i - 1)); +#ifdef DBUG + dbug_print("Socket %d has pending events", (i - 1)); +#endif if (iterQuery != NULL) { select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrig); @@ -556,14 +574,20 @@ LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDL need one worker to use it. Try to find if there is already a worker handling this kind of request. */ - DBUG_PRINT("Scanning list of worker to find one that already handle socket"); +#ifdef DBUG + dbug_print("Scanning list of worker to find one that already handle socket"); +#endif res = select_data_job_search(&hd, SELECT_TYPE_SOCKET); /* Add a new socket to poll */ res->funcWorker = socket_poll; - DBUG_PRINT("Add socket %x to worker", hFileDescr); +#ifdef DBUG + dbug_print("Add socket %x to worker", hFileDescr); +#endif select_data_query_add(res, EMode, hFileDescr, lpOrig); - DBUG_PRINT("Socket %x added", hFileDescr); +#ifdef DBUG + dbug_print("Socket %x added", hFileDescr); +#endif return hd; } @@ -654,9 +678,13 @@ LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode, sa_len = sizeof(sa); alreadyAdded = FALSE; - DBUG_PRINT("Begin dispatching handle %x", hFileDescr); +#ifdef DBUG + dbug_print("Begin dispatching handle %x", hFileDescr); +#endif - DBUG_PRINT("Waiting for %d on handle %x", EMode, hFileDescr); +#ifdef DBUG + dbug_print("Waiting for %d on handle %x", EMode, hFileDescr); +#endif /* There is only 2 way to have except mode: transmission of OOB data through a socket TCP/IP and through a strange interaction with a TTY. @@ -665,7 +693,9 @@ LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode, switch(get_handle_type(fd)) { case SELECT_HANDLE_DISK: - DBUG_PRINT("Handle %x is a disk handle", hFileDescr); +#ifdef DBUG + dbug_print("Handle %x is a disk handle", hFileDescr); +#endif /* Disk is always ready in read/write operation */ if (EMode == SELECT_MODE_READ || EMode == SELECT_MODE_WRITE) { @@ -674,7 +704,9 @@ LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode, break; case SELECT_HANDLE_CONSOLE: - DBUG_PRINT("Handle %x is a console handle", hFileDescr); +#ifdef DBUG + dbug_print("Handle %x is a console handle", hFileDescr); +#endif /* Console is always ready in write operation, need to check for read. */ if (EMode == SELECT_MODE_READ) { @@ -687,28 +719,38 @@ LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode, break; case SELECT_HANDLE_PIPE: - DBUG_PRINT("Handle %x is a pipe handle", hFileDescr); +#ifdef DBUG + dbug_print("Handle %x is a pipe handle", hFileDescr); +#endif /* Console is always ready in write operation, need to check for read. */ if (EMode == SELECT_MODE_READ) { - DBUG_PRINT("Need to check availability of data on pipe"); +#ifdef DBUG + dbug_print("Need to check availability of data on pipe"); +#endif res = read_pipe_poll_add(res, EMode, hFileDescr, lpOrig); } else if (EMode == SELECT_MODE_WRITE) { - DBUG_PRINT("No need to check availability of data on pipe, write operation always possible"); +#ifdef DBUG + dbug_print("No need to check availability of data on pipe, write operation always possible"); +#endif res = static_poll_add(res, EMode, hFileDescr, lpOrig); }; break; case SELECT_HANDLE_SOCKET: - DBUG_PRINT("Handle %x is a socket handle", hFileDescr); +#ifdef DBUG + dbug_print("Handle %x is a socket handle", hFileDescr); +#endif if (getsockname((SOCKET)hFileDescr, &sa, &sa_len) == SOCKET_ERROR) { if (WSAGetLastError() == WSAEINVAL) { /* Socket is not bound */ - DBUG_PRINT("Socket is not connected"); +#ifdef DBUG + dbug_print("Socket is not connected"); +#endif if (EMode == SELECT_MODE_WRITE || EMode == SELECT_MODE_READ) { res = static_poll_add(res, EMode, hFileDescr, lpOrig); @@ -723,12 +765,16 @@ LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode, break; default: - DBUG_PRINT("Handle %x is unknown", hFileDescr); +#ifdef DBUG + dbug_print("Handle %x is unknown", hFileDescr); +#endif caml_failwith("Unknown handle"); break; }; - DBUG_PRINT("Finish dispatching handle %x", hFileDescr); +#ifdef DBUG + dbug_print("Finish dispatching handle %x", hFileDescr); +#endif CAMLreturnT(LPSELECTDATA, res); } @@ -791,7 +837,9 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value CAMLlocal5 (read_list, write_list, except_list, res, l); CAMLlocal1 (fd); - DBUG_PRINT("in select"); +#ifdef DBUG + dbug_print("in select"); +#endif nEventsCount = 0; nEventsMax = 0; @@ -821,7 +869,9 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value if (Double_val(timeout) >= 0.0) { milliseconds = 1000 * Double_val(timeout); - DBUG_PRINT("Will wait %d ms", milliseconds); +#ifdef DBUG + dbug_print("Will wait %d ms", milliseconds); +#endif } else { @@ -830,7 +880,9 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value /* Create list of select data, based on the different list of fd to watch */ - DBUG_PRINT("Dispatch read fd"); +#ifdef DBUG + dbug_print("Dispatch read fd"); +#endif handle_set_init(&hds, hdsData, hdsMax); for (l = readfds; l != Val_int(0); l = Field(l, 1)) { @@ -842,12 +894,16 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value } else { - DBUG_PRINT("Discarding handle %x which is already monitor for read", Handle_val(fd)); +#ifdef DBUG + dbug_print("Discarding handle %x which is already monitor for read", Handle_val(fd)); +#endif } } handle_set_reset(&hds); - DBUG_PRINT("Dispatch write fd"); +#ifdef DBUG + dbug_print("Dispatch write fd"); +#endif handle_set_init(&hds, hdsData, hdsMax); for (l = writefds; l != Val_int(0); l = Field(l, 1)) { @@ -859,12 +915,16 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value } else { - DBUG_PRINT("Discarding handle %x which is already monitor for write", Handle_val(fd)); +#ifdef DBUG + dbug_print("Discarding handle %x which is already monitor for write", Handle_val(fd)); +#endif } } handle_set_reset(&hds); - DBUG_PRINT("Dispatch exceptional fd"); +#ifdef DBUG + dbug_print("Dispatch exceptional fd"); +#endif handle_set_init(&hds, hdsData, hdsMax); for (l = exceptfds; l != Val_int(0); l = Field(l, 1)) { @@ -876,13 +936,17 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value } else { - DBUG_PRINT("Discarding handle %x which is already monitor for exceptional", Handle_val(fd)); +#ifdef DBUG + dbug_print("Discarding handle %x which is already monitor for exceptional", Handle_val(fd)); +#endif } } handle_set_reset(&hds); /* Building the list of handle to wait for */ - DBUG_PRINT("Building events done array"); +#ifdef DBUG + dbug_print("Building events done array"); +#endif nEventsMax = list_length((LPLIST)lpSelectData); nEventsCount = 0; if (!HeapLock(GetProcessHeap())) @@ -913,14 +977,18 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value worker_job_submit( iterSelectData->funcWorker, (void *)iterSelectData); - DBUG_PRINT("Job submitted to worker %x", iterSelectData->lpWorker); +#ifdef DBUG + dbug_print("Job submitted to worker %x", iterSelectData->lpWorker); +#endif lpEventsDone[nEventsCount] = worker_job_event_done(iterSelectData->lpWorker); nEventsCount++; }; iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData); }; - DBUG_PRINT("Need to watch %d workers", nEventsCount); +#ifdef DBUG + dbug_print("Need to watch %d workers", nEventsCount); +#endif /* Processing select itself */ enter_blocking_section(); @@ -930,7 +998,9 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value /* Waiting for event */ if (err == 0 && !hasStaticData) { - DBUG_PRINT("Waiting for one select worker to be done"); +#ifdef DBUG + dbug_print("Waiting for one select worker to be done"); +#endif switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds)) { case WAIT_FAILED: @@ -938,17 +1008,23 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value break; case WAIT_TIMEOUT: - DBUG_PRINT("Select timeout"); +#ifdef DBUG + dbug_print("Select timeout"); +#endif break; default: - DBUG_PRINT("One worker is done"); +#ifdef DBUG + dbug_print("One worker is done"); +#endif break; }; } /* Ordering stop to every worker */ - DBUG_PRINT("Sending stop signal to every select workers"); +#ifdef DBUG + dbug_print("Sending stop signal to every select workers"); +#endif iterSelectData = lpSelectData; while (iterSelectData != NULL) { @@ -959,7 +1035,9 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData); }; - DBUG_PRINT("Waiting for every select worker to be done"); +#ifdef DBUG + dbug_print("Waiting for every select worker to be done"); +#endif switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE)) { case WAIT_FAILED: @@ -967,7 +1045,9 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value break; default: - DBUG_PRINT("Every worker is done"); +#ifdef DBUG + dbug_print("Every worker is done"); +#endif break; } } @@ -978,11 +1058,15 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value } leave_blocking_section(); - DBUG_PRINT("Error status: %d (0 is ok)", err); +#ifdef DBUG + dbug_print("Error status: %d (0 is ok)", err); +#endif /* Build results */ if (err == 0) { - DBUG_PRINT("Building result"); +#ifdef DBUG + dbug_print("Building result"); +#endif read_list = Val_unit; write_list = Val_unit; except_list = Val_unit; @@ -1021,7 +1105,9 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value } /* Free resources */ - DBUG_PRINT("Free selectdata resources"); +#ifdef DBUG + dbug_print("Free selectdata resources"); +#endif iterSelectData = lpSelectData; while (iterSelectData != NULL) { @@ -1032,7 +1118,9 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value lpSelectData = NULL; /* Free allocated events/handle set array */ - DBUG_PRINT("Free local allocated resources"); +#ifdef DBUG + dbug_print("Free local allocated resources"); +#endif if (!HeapLock(GetProcessHeap())) { win32_maperr(GetLastError()); @@ -1042,20 +1130,26 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value HeapFree(GetProcessHeap(), 0, hdsData); HeapUnlock(GetProcessHeap()); - DBUG_PRINT("Raise error if required"); +#ifdef DBUG + dbug_print("Raise error if required"); +#endif if (err != 0) { win32_maperr(err); uerror("select", Nothing); } - DBUG_PRINT("Build final result"); +#ifdef DBUG + dbug_print("Build final result"); +#endif res = alloc_small(3, 0); Store_field(res, 0, read_list); Store_field(res, 1, write_list); Store_field(res, 2, except_list); - DBUG_PRINT("out select"); +#ifdef DBUG + dbug_print("out select"); +#endif CAMLreturn(res); } diff --git a/otherlibs/win32unix/windbug.c b/otherlibs/win32unix/windbug.c index b6cba54d..8f022cc9 100644 --- a/otherlibs/win32unix/windbug.c +++ b/otherlibs/win32unix/windbug.c @@ -11,11 +11,16 @@ /* */ /***********************************************************************/ -/* $Id: windbug.c,v 1.2 2008/07/31 12:09:18 xleroy Exp $ */ +/* $Id: windbug.c,v 1.2.2.2 2008/11/26 13:41:01 xleroy Exp $ */ #include +#include +#include +#include "windbug.h" -int dbug = 0; +#ifdef DBUG + +static int dbug = 0; void dbug_init (void) { @@ -30,3 +35,17 @@ int dbug_test (void) { return dbug; } + +void dbug_print(const char * fmt, ...) +{ + va_list ap; + if (dbug) { + va_start(ap, fmt); + vfprintf(stderr, fmt, ap); + fprintf(stderr, "\n"); + fflush(stderr); + va_end(ap); + } +} + +#endif diff --git a/otherlibs/win32unix/windbug.h b/otherlibs/win32unix/windbug.h index 4c65aa51..58066c73 100644 --- a/otherlibs/win32unix/windbug.h +++ b/otherlibs/win32unix/windbug.h @@ -11,27 +11,12 @@ /* */ /***********************************************************************/ -/* $Id: windbug.h,v 1.2 2008/07/31 12:09:18 xleroy Exp $ */ +/* $Id: windbug.h,v 1.2.2.1 2008/11/26 13:27:21 xleroy Exp $ */ /*#define DBUG*/ #ifdef DBUG -#include -#include - -#define DBUG_PRINT(fmt, ...) \ - do \ - { \ - if (dbug_test()) \ - { \ - fprintf(stderr, "DBUG (pid:%d, tid: %d): ", GetCurrentProcessId(), GetCurrentThreadId()); \ - fprintf(stderr, fmt, __VA_ARGS__); \ - fprintf(stderr, "\n"); \ - fflush(stderr); \ - }; \ - } while(0) - /* Initialize and cleanup dbug variable */ void dbug_init (void); void dbug_cleanup (void); @@ -39,11 +24,13 @@ void dbug_cleanup (void); /* Test if we are in dbug mode */ int dbug_test (void); +/* Print if we are in dbug mode */ +void dbug_print (const char * fmt, ...); + #define DBUG_INIT dbug_init() #define DBUG_CLEANUP dbug_cleanup() #else -#define DBUG_PRINT(fmt, ...) #define DBUG_INIT #define DBUG_CLEANUP #endif diff --git a/otherlibs/win32unix/winworker.c b/otherlibs/win32unix/winworker.c index 695f4251..5c5909e6 100644 --- a/otherlibs/win32unix/winworker.c +++ b/otherlibs/win32unix/winworker.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -/* $Id: winworker.c,v 1.2 2008/07/31 12:09:18 xleroy Exp $ */ +/* $Id: winworker.c,v 1.2.2.2 2008/11/26 13:41:01 xleroy Exp $ */ #include "winworker.h" #include "winlist.h" @@ -57,7 +57,9 @@ DWORD WINAPI worker_wait (LPVOID _data) lpWorker = (LPWORKER )_data; bExit = FALSE; - DBUG_PRINT("Worker %x starting", lpWorker); +#ifdef DBUG + dbug_print("Worker %x starting", lpWorker); +#endif while ( !bExit && SignalObjectAndWait( @@ -66,7 +68,9 @@ DWORD WINAPI worker_wait (LPVOID _data) INFINITE, TRUE) == WAIT_OBJECT_0) { - DBUG_PRINT("Worker %x running", lpWorker); +#ifdef DBUG + dbug_print("Worker %x running", lpWorker); +#endif switch (lpWorker->ECommand) { case WORKER_CMD_NONE: @@ -86,7 +90,9 @@ DWORD WINAPI worker_wait (LPVOID _data) break; } }; - DBUG_PRINT("Worker %x exiting", lpWorker); +#ifdef DBUG + dbug_print("Worker %x exiting", lpWorker); +#endif return 0; } @@ -124,14 +130,18 @@ LPWORKER worker_new (void) void worker_free (LPWORKER lpWorker) { /* Wait for termination of the worker */ - DBUG_PRINT("Shutting down worker %x", lpWorker); +#ifdef DBUG + dbug_print("Shutting down worker %x", lpWorker); +#endif WaitForSingleObject(lpWorker->hWorkerReady, INFINITE); lpWorker->ECommand = WORKER_CMD_STOP; SetEvent(lpWorker->hCommandReady); WaitForSingleObject(lpWorker->hThread, INFINITE); /* Free resources */ - DBUG_PRINT("Freeing resources of worker %x", lpWorker); +#ifdef DBUG + dbug_print("Freeing resources of worker %x", lpWorker); +#endif if (lpWorker->hThread != INVALID_HANDLE_VALUE) { CloseHandle(lpWorker->hThread); @@ -193,10 +203,12 @@ LPWORKER worker_pop (void) } nWorkersCurrent++; nWorkersMax = (nWorkersCurrent > nWorkersMax ? nWorkersCurrent : nWorkersMax); - DBUG_PRINT("Workers running current/runnning max/waiting: %d/%d/%d", +#ifdef DBUG + dbug_print("Workers running current/runnning max/waiting: %d/%d/%d", nWorkersCurrent, nWorkersMax, list_length((LPLIST)lpWorkers)); +#endif ReleaseMutex(hWorkersMutex); if (lpWorkerFree == NULL) @@ -224,24 +236,34 @@ void worker_push(LPWORKER lpWorker) bFreeWorker = TRUE; WaitForSingleObject(hWorkersMutex, INFINITE); - DBUG_PRINT("Testing if we are under the maximum number of running workers"); +#ifdef DBUG + dbug_print("Testing if we are under the maximum number of running workers"); +#endif if (list_length((LPLIST)lpWorkers) < THREAD_WORKERS_MAX) { - DBUG_PRINT("Saving this worker for future use"); - DBUG_PRINT("Next: %x", ((LPLIST)lpWorker)->lpNext); +#ifdef DBUG + dbug_print("Saving this worker for future use"); +#endif +#ifdef DBUG + dbug_print("Next: %x", ((LPLIST)lpWorker)->lpNext); +#endif lpWorkers = (LPWORKER)list_concat((LPLIST)lpWorker, (LPLIST)lpWorkers); bFreeWorker = FALSE; }; nWorkersCurrent--; - DBUG_PRINT("Workers running current/runnning max/waiting: %d/%d/%d", +#ifdef DBUG + dbug_print("Workers running current/runnning max/waiting: %d/%d/%d", nWorkersCurrent, nWorkersMax, list_length((LPLIST)lpWorkers)); +#endif ReleaseMutex(hWorkersMutex); if (bFreeWorker) { - DBUG_PRINT("Freeing worker %x", lpWorker); +#ifdef DBUG + dbug_print("Freeing worker %x", lpWorker); +#endif worker_free(lpWorker); } } @@ -253,7 +275,9 @@ void worker_init (void) /* Init a shared variable. The only way to ensure that no other worker will be at the same point is to use a critical section. */ - DBUG_PRINT("Allocating mutex for workers"); +#ifdef DBUG + dbug_print("Allocating mutex for workers"); +#endif if (hWorkersMutex == INVALID_HANDLE_VALUE) { hWorkersMutex = CreateMutex(NULL, FALSE, NULL); @@ -276,13 +300,17 @@ void worker_cleanup(void) if (hWorkersMutex != INVALID_HANDLE_VALUE) { WaitForSingleObject(hWorkersMutex, INFINITE); - DBUG_PRINT("Freeing global resource of workers"); +#ifdef DBUG + dbug_print("Freeing global resource of workers"); +#endif /* Empty the queue of worker worker */ while (lpWorkers != NULL) { ReleaseMutex(hWorkersMutex); lpWorker = worker_pop(); - DBUG_PRINT("Freeing worker %x", lpWorker); +#ifdef DBUG + dbug_print("Freeing worker %x", lpWorker); +#endif WaitForSingleObject(hWorkersMutex, INFINITE); worker_free(lpWorker); }; @@ -298,18 +326,24 @@ LPWORKER worker_job_submit (WORKERFUNC f, void *user_data) { LPWORKER lpWorker = worker_pop(); - DBUG_PRINT("Waiting for worker to be ready"); +#ifdef DBUG + dbug_print("Waiting for worker to be ready"); +#endif enter_blocking_section(); WaitForSingleObject(lpWorker->hWorkerReady, INFINITE); ResetEvent(lpWorker->hWorkerReady); leave_blocking_section(); - DBUG_PRINT("Worker is ready"); +#ifdef DBUG + dbug_print("Worker is ready"); +#endif lpWorker->hJobFunc = f; lpWorker->lpJobUserData = user_data; lpWorker->ECommand = WORKER_CMD_EXEC; - DBUG_PRINT("Call worker (func: %x, worker: %x)", f, lpWorker); +#ifdef DBUG + dbug_print("Call worker (func: %x, worker: %x)", f, lpWorker); +#endif SetEvent(lpWorker->hCommandReady); return (LPWORKER)lpWorker; @@ -322,14 +356,20 @@ HANDLE worker_job_event_done (LPWORKER lpWorker) void worker_job_stop (LPWORKER lpWorker) { - DBUG_PRINT("Sending stop signal to worker %x", lpWorker); +#ifdef DBUG + dbug_print("Sending stop signal to worker %x", lpWorker); +#endif SetEvent(lpWorker->hJobStop); - DBUG_PRINT("Signal sent to worker %x", lpWorker); +#ifdef DBUG + dbug_print("Signal sent to worker %x", lpWorker); +#endif } void worker_job_finish (LPWORKER lpWorker) { - DBUG_PRINT("Finishing call of worker %x", lpWorker); +#ifdef DBUG + dbug_print("Finishing call of worker %x", lpWorker); +#endif enter_blocking_section(); WaitForSingleObject(lpWorker->hJobDone, INFINITE); leave_blocking_section();