[MLton-commit] r5273

Vesa Karvonen vesak at mlton.org
Tue Feb 20 09:01:06 PST 2007


Tweaked Makefile to work on multiple platforms (make check runs even on
32-bit Linux).

Moved notable extensions to a separate signature for clarity.

Specified (but not yet implemented) a number of extensions.

----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/windows/unstable/Makefile
U   mltonlib/trunk/com/ssh/windows/unstable/detail/ffi/windows.h
U   mltonlib/trunk/com/ssh/windows/unstable/detail/lib/windows.c
U   mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml
U   mltonlib/trunk/com/ssh/windows/unstable/lib.mlb
U   mltonlib/trunk/com/ssh/windows/unstable/public/export.sml
A   mltonlib/trunk/com/ssh/windows/unstable/public/windows-ex.sig
U   mltonlib/trunk/com/ssh/windows/unstable/public/windows.sig

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/windows/unstable/Makefile
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/Makefile	2007-02-20 13:29:46 UTC (rev 5272)
+++ mltonlib/trunk/com/ssh/windows/unstable/Makefile	2007-02-20 17:01:01 UTC (rev 5273)
@@ -3,6 +3,8 @@
 # This code is released under the MLton license, a BSD-style license.
 # See the LICENSE file or http://mlton.org/License for details.
 
+##########################################################################
+
 target-arch := $(shell mlton -show path-map | awk '/^TARGET_ARCH/ {print $$2}')
 target-os   := $(shell mlton -show path-map | awk '/^TARGET_OS/ {print $$2}')
 target-id   := $(target-arch)-$(target-os)
@@ -10,8 +12,12 @@
 bin-dir := .bin/$(target-id)
 gen-dir := generated/$(target-id)
 
+mlb-path-map := $(gen-dir)/mlb-path-map
+
 ffi-h-files := $(wildcard detail/ffi/*.h)
 
+nlffi-mlb := $(gen-dir)/nlffi/lib.mlb
+
 lib-dir := detail/lib
 lib-c-files := $(wildcard detail/lib/*.c)
 lib-o-files := $(patsubst $(lib-dir)/%.c,$(bin-dir)/%.o,$(lib-c-files))
@@ -19,31 +25,41 @@
 
 lib-file := libwin-$(target-id).lib
 
+def-use-file := lib.$(target-id).du
+
+##########################################################################
+
 .PHONY : all clean help check
 
 help :
 	@echo "Targets:"
 	@echo "    all      Builds the static link library and NLFFI files"
+	@echo "    check    Type check the SML code (does not check C code)"
 	@echo "    clean    Removes generated files"
 	@echo "    help     Prints this message"
-	@echo "    check    Type check the SML code"
 
-mlb-path-map : Makefile
-	echo 'MLTON_LIB $(shell cd ../../../.. && pwd)' > $@
-	echo 'SML_COMPILER mlton' >> $@
+all : $(lib-file) $(nlffi-mlb)
 
-all : $(lib-file) $(gen-dir)/nlffi/lib.mlb
-
 clean :
-	rm -rf $(bin-dir) $(gen-dir)/nlffi $(lib-file) mlb-path-map
+	rm -rf $(bin-dir) $(gen-dir) $(lib-file) $(def-use-file)
 
-check : $(gen-dir)/nlffi/lib.mlb mlb-path-map
-	mlton -stop tc -mlb-path-map mlb-path-map lib.mlb
+check : $(nlffi-mlb) $(mlb-path-map)
+	mlton -stop tc                      \
+	      -mlb-path-map $(mlb-path-map) \
+	      -prefer-abs-paths true        \
+	      -show-def-use $(def-use-file) \
+	      lib.mlb
 
+##########################################################################
+
+$(mlb-path-map) : Makefile
+	echo 'MLTON_LIB $(shell cd ../../../.. && pwd)' > $@
+	echo 'SML_COMPILER mlton' >> $@
+
 $(lib-file) : $(lib-o-files)
 	ar cr $@ $^
 
-$(gen-dir)/nlffi/lib.mlb : $(ffi-h-files)
+$(nlffi-mlb) : $(ffi-h-files)
 	mkdir -p $(@D)
 	mlnlffigen -dir $(@D)       \
 	           -mlbfile $(@F)   \
@@ -59,3 +75,5 @@
 	    -c        \
 	    -o $@     \
 	    $<
+
+##########################################################################

Modified: mltonlib/trunk/com/ssh/windows/unstable/detail/ffi/windows.h
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/detail/ffi/windows.h	2007-02-20 13:29:46 UTC (rev 5272)
+++ mltonlib/trunk/com/ssh/windows/unstable/detail/ffi/windows.h	2007-02-20 17:01:01 UTC (rev 5273)
@@ -27,13 +27,18 @@
 
 /************************************************************************/
 
+WIN_TYPEDEF(LPVOID, void *);
+
+WIN_TYPEDEF(BOOL, int);
 WIN_TYPEDEF(BYTE, unsigned char);
 WIN_TYPEDEF(WORD, unsigned short);
 WIN_TYPEDEF(DWORD, unsigned long);
 WIN_TYPEDEF(LONG, long);
+WIN_TYPEDEF(LONGLONG, long long);
 
 WIN_TYPEDEF(LPBYTE, BYTE *);
 WIN_TYPEDEF(LPDWORD, DWORD *);
+WIN_TYPEDEF(LPLONG, LONG *);
 
 WIN_TYPEDEF(LPCTSTR, const char *);
 WIN_TYPEDEF(LPTSTR, char *);
@@ -135,6 +140,61 @@
 
 /************************************************************************/
 
+WIN_TYPEDEF(HANDLE, void *);
+
+WIN_FUNCTION(CloseHandle, BOOL, 1, (HANDLE));
+
+/************************************************************************/
+
+WIN_CONST(WAIT_OBJECT_0, DWORD);
+WIN_CONST(WAIT_ABANDONED_0, DWORD);
+WIN_CONST(WAIT_IO_COMPLETION, DWORD);
+WIN_CONST(WAIT_TIMEOUT, DWORD);
+WIN_CONST(WAIT_FAILED, DWORD);
+
+WIN_FUNCTION(WaitForMultipleObjectsEx, DWORD, 5,
+             (DWORD, const HANDLE *, BOOL, DWORD, BOOL));
+WIN_FUNCTION(WaitForMultipleObjects, DWORD, 4,
+             (DWORD, const HANDLE *, BOOL, DWORD));
+
+/************************************************************************/
+
+WIN_FUNCTION(CreateSemaphore, HANDLE, 4,
+             (LPSECURITY_ATTRIBUTES, LONG, LONG, LPCTSTR));
+WIN_FUNCTION(ReleaseSemaphore, BOOL, 3, (HANDLE, LONG, LPLONG));
+
+/************************************************************************/
+
+WIN_FUNCTION(CreateMutex, HANDLE, 3, (LPSECURITY_ATTRIBUTES, BOOL, LPCTSTR));
+WIN_FUNCTION(ReleaseMutex, BOOL, 1, (HANDLE));
+
+/************************************************************************/
+
+WIN_FUNCTION(CreateWaitableTimer, HANDLE, 3,
+             (LPSECURITY_ATTRIBUTES, BOOL, LPCTSTR));
+WIN_FUNCTION(CancelWaitableTimer, BOOL, 1, (HANDLE));
+
+BOOL win_SetWaitableTimer(HANDLE, LONGLONG, LONG, BOOL);
+
+/************************************************************************/
+
+WIN_CONST(FILE_NOTIFY_CHANGE_ATTRIBUTES, DWORD);
+WIN_CONST(FILE_NOTIFY_CHANGE_DIR_NAME, DWORD);
+WIN_CONST(FILE_NOTIFY_CHANGE_FILE_NAME, DWORD);
+WIN_CONST(FILE_NOTIFY_CHANGE_LAST_WRITE, DWORD);
+WIN_CONST(FILE_NOTIFY_CHANGE_SECURITY, DWORD);
+WIN_CONST(FILE_NOTIFY_CHANGE_SIZE, DWORD);
+
+WIN_FUNCTION(FindFirstChangeNotification, HANDLE, 3, (LPCTSTR, BOOL, DWORD));
+WIN_FUNCTION(FindCloseChangeNotification, BOOL, 1, (HANDLE));
+WIN_FUNCTION(FindNextChangeNotification, BOOL, 1, (HANDLE));
+
+/************************************************************************/
+
+WIN_FUNCTION(GetCurrentProcessId, DWORD, 0, (void));
+
+/************************************************************************/
+
 LPTSTR win_FormatErrorLocalAlloc(DWORD error);
 
 #endif

Modified: mltonlib/trunk/com/ssh/windows/unstable/detail/lib/windows.c
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/detail/lib/windows.c	2007-02-20 13:29:46 UTC (rev 5272)
+++ mltonlib/trunk/com/ssh/windows/unstable/detail/lib/windows.c	2007-02-20 17:01:01 UTC (rev 5273)
@@ -91,8 +91,19 @@
 
 /************************************************************************/
 
-LPTSTR win_FormatErrorLocalAlloc(DWORD error)
+BOOL
+win_SetWaitableTimer(HANDLE handle, LONGLONG dueTime, LONG period, BOOL resume)
 {
+  LARGE_INTEGER liDueTime;
+  liDueTime.QuadPart = dueTime;
+  return SetWaitableTimer(handle, &liDueTime, period, NULL, NULL, resume);
+}
+
+/************************************************************************/
+
+LPTSTR
+win_FormatErrorLocalAlloc(DWORD error)
+{
   LPTSTR msg = NULL;
   FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER |
                 FORMAT_MESSAGE_FROM_SYSTEM |

Modified: mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml	2007-02-20 13:29:46 UTC (rev 5272)
+++ mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml	2007-02-20 17:01:01 UTC (rev 5273)
@@ -7,7 +7,7 @@
 (* XXX make pretty printing of args in error messages a compile time option *)
 
 (* Implementation of Windows utilities. *)
-structure Windows :> WINDOWS = struct
+structure Windows :> WINDOWS_EX = struct
    local
       open Type Prettier
    in
@@ -303,12 +303,10 @@
    end
 
    structure Module = struct
-      type hmodule = C.voidptr
+      type t = C.voidptr
 
-      val null = C.Ptr.null'
-
       fun getFileName m = let
-         val m' = getOpt (m, null)
+         val m' = getOpt (m, C.Ptr.null')
       in
          onError0ElseTruncatedSize
             (fn () => F"Module.getFileName"[A (opt ptr) m])
@@ -325,4 +323,63 @@
                     (fn () => F"Path.getShortName"[A str p])
                     (fn (b, s) => F_win_GetShortPathName.f' (p', b, s)))
    end
+
+   structure Wait = struct
+      type t = C.voidptr
+
+      type 'a waitable = Unit.t
+
+      datatype 'a result
+        = ABANDONED of 'a
+        | OBJECT of 'a
+        | TIMEOUT
+
+      val prepare = undefined
+
+      val any = undefined
+      val all = undefined
+   end
+
+   structure Semaphore = struct
+      type t = C.voidptr
+      val create = undefined
+      val close = undefined
+      val release = undefined
+      val toWait = undefined
+   end
+
+   structure Mutex = struct
+      type t = C.voidptr
+      val create = undefined
+      val close = undefined
+      val toWait = undefined
+   end
+
+   structure Timer = struct
+      type t = C.voidptr
+      val create = undefined
+      val close = undefined
+      val set = undefined
+      val cancel = undefined
+      val toWait = undefined
+   end
+
+   structure FileChange = struct
+      structure Filter = struct
+         open BitFlags
+         fun `x = SysWord.fromWord (C.Get.ulong' (x ()))
+         val attributes = `G_win_FILE_NOTIFY_CHANGE_ATTRIBUTES.obj'
+         val dirName    = `G_win_FILE_NOTIFY_CHANGE_DIR_NAME.obj'
+         val fileName   = `G_win_FILE_NOTIFY_CHANGE_FILE_NAME.obj'
+         val lastWrite  = `G_win_FILE_NOTIFY_CHANGE_LAST_WRITE.obj'
+         val security   = `G_win_FILE_NOTIFY_CHANGE_SECURITY.obj'
+         val size       = `G_win_FILE_NOTIFY_CHANGE_SIZE.obj'
+      end
+
+      type t = C.voidptr
+      val first = undefined
+      val next = undefined
+      val close = undefined
+      val toWait = undefined
+   end
 end

Modified: mltonlib/trunk/com/ssh/windows/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/lib.mlb	2007-02-20 13:29:46 UTC (rev 5272)
+++ mltonlib/trunk/com/ssh/windows/unstable/lib.mlb	2007-02-20 17:01:01 UTC (rev 5273)
@@ -22,6 +22,7 @@
    in
       local
          public/windows.sig
+         public/windows-ex.sig
          detail/windows.sml
       in
          public/export.sml

Modified: mltonlib/trunk/com/ssh/windows/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/public/export.sml	2007-02-20 13:29:46 UTC (rev 5272)
+++ mltonlib/trunk/com/ssh/windows/unstable/public/export.sml	2007-02-20 17:01:01 UTC (rev 5273)
@@ -6,8 +6,9 @@
 
 (** == Exported signatures == *)
 
-signature WINDOWS = WINDOWS
+signature WINDOWS    = WINDOWS
+signature WINDOWS_EX = WINDOWS_EX
 
 (** == Exported structures == *)
 
-structure Windows : WINDOWS = Windows
+structure Windows : WINDOWS_EX = Windows

Added: mltonlib/trunk/com/ssh/windows/unstable/public/windows-ex.sig
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/public/windows-ex.sig	2007-02-20 13:29:46 UTC (rev 5272)
+++ mltonlib/trunk/com/ssh/windows/unstable/public/windows-ex.sig	2007-02-20 17:01:01 UTC (rev 5273)
@@ -0,0 +1,90 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(**
+ * This signature specifies some notable extensions to the {WINDOWS} signature.
+ *)
+signature WINDOWS_EX = sig
+   include WINDOWS
+
+   structure EventLog : sig
+      structure Type : sig
+         include BIT_FLAGS
+         val auditFailure : flags
+         val auditSuccess : flags
+         val error : flags
+         val information : flags
+         val warning : flags
+      end
+   end
+
+   structure Module : sig
+      eqtype t
+      val getFileName : t Option.t -> String.t
+   end
+
+   structure Path : sig
+      val getShortName : String.t UnOp.t
+   end
+
+   structure Wait : sig
+      type t
+
+      type 'a waitable
+
+      datatype 'a result
+        = ABANDONED of 'a
+        | OBJECT of 'a
+        | TIMEOUT
+
+      val prepare : (t * 'a) List.t -> 'a waitable
+
+      val any : 'a waitable * Real.t -> 'a result
+      val all : 'a waitable * Real.t -> 'a result
+   end
+
+   structure Semaphore : sig
+      type t
+      val create : {init : Int32.t, max : Int32.t, name : String.t Option.t} -> t
+      val close : t Effect.t
+      val release : t * Int32.t -> Int32.t
+      val toWait : t -> Wait.t
+   end
+
+   structure Mutex : sig
+      type t
+      val create : {name : String.t Option.t, own : Bool.t} -> t
+      val close : t Effect.t
+      val toWait : t -> Wait.t
+   end
+
+   structure Timer : sig
+      type t
+      val create : {manual : Bool.t, name : String.t Option.t} -> t
+      val close : t Effect.t
+      val set : {timer : t, due : Int64.t, period : Int32.t} Effect.t
+      val cancel : t Effect.t
+      val toWait : t -> Wait.t
+   end
+
+   structure FileChange : sig
+      structure Filter : sig
+         include BIT_FLAGS
+         val fileName : flags
+         val dirName : flags
+         val attributes : flags
+         val size : flags
+         val lastWrite : flags
+         val security : flags
+      end
+
+      type t
+      val first : String.t * Bool.t * Filter.flags -> t
+      val next : t Effect.t
+      val close : t Effect.t
+      val toWait : t -> Wait.t
+   end
+end


Property changes on: mltonlib/trunk/com/ssh/windows/unstable/public/windows-ex.sig
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/windows/unstable/public/windows.sig
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/public/windows.sig	2007-02-20 13:29:46 UTC (rev 5272)
+++ mltonlib/trunk/com/ssh/windows/unstable/public/windows.sig	2007-02-20 17:01:01 UTC (rev 5273)
@@ -7,9 +7,9 @@
 (**
  * Signature for Windows utilities.
  *
- * Parts of this signature follow the SML Basis Library specification:
- *
- *   http://mlton.org/basis/windows.html .
+ * Aside from a few minor extensions, this signature specifies a subset of
+ * the [http://mlton.org/basis/windows.html Windows structure] in the
+ * Standard ML Basis Library.
  *)
 signature WINDOWS = sig
    structure Key : sig
@@ -59,24 +59,4 @@
       val queryValueEx : hkey * String.t -> value Option.t
       val setValueEx : (hkey * String.t * value) Effect.t
    end
-
-   structure EventLog : sig
-      structure Type : sig
-         include BIT_FLAGS
-         val auditFailure : flags
-         val auditSuccess : flags
-         val error : flags
-         val information : flags
-         val warning : flags
-      end
-   end
-
-   structure Module : sig
-      type hmodule
-      val getFileName : hmodule Option.t -> String.t
-   end
-
-   structure Path : sig
-      val getShortName : String.t UnOp.t
-   end
 end




More information about the MLton-commit mailing list