Source code in the txr programming language

;;; Define some typedefs for clear correspondence with Win32
(typedef HANDLE cptr)
(typedef LPSECURITY_ATTRIBUTES cptr)
(typedef WINERR (enum WINERR ERROR_SUCCESS
                             (ERROR_ALREADY_EXISTS 183))) 
(typedef BOOL (enum BOOL FALSE TRUE))
(typedef LPCWSTR wstr)

;;; More familiar spelling for null pointer.
(defvarl NULL cptr-null)

;;; Define access to foreign functions.
(with-dyn-lib "kernel32.dll"
  (deffi CreateMutex "CreateMutexW" HANDLE (LPSECURITY_ATTRIBUTES BOOL LPCWSTR))
  (deffi CloseHandle "CloseHandle" BOOL (HANDLE))
  (deffi GetLastError "GetLastError" WINERR ()))

;;; Now, the single-instance program:
(defvar m (CreateMutex NULL 'TRUE "ApplicationName"))

(unless (eq (GetLastError) 'ERROR_ALREADY_EXISTS)
  ;; mutual exclusion here
  )
 
(CloseHandle m)