Win32: Port/Stub-out libraries

- (scheme time): Win32 stub impl
 - (chibi filesystem): Win32 stubbing
 - (chibi process): ditto
 - (chibi time): ditto
 - SRFI-144: lgamma is not in C99 standard
 - SRFI-27: Win32 INSECURE rand

lib/chibi/filesystem.stub

@@ -2,19 +2,39 @@
 ;; Copyright (c) 2009-2013 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
-(c-system-include "sys/file.h")
 (c-system-include "sys/types.h")
-(c-system-include "unistd.h")
+
-(c-system-include "dirent.h")
+(cond-expand
+  ((not windows)
+   (c-system-include "sys/file.h")
+   (c-system-include "unistd.h")
+   (c-system-include "dirent.h")))
+
 (c-system-include "fcntl.h")
 
-(define-c-type DIR
+(cond-expand
+  (windows
+   (define-c-struct stat
+    predicate: stat?
+    (dev_t      st_dev      stat-dev)
+    (ino_t      st_ino      stat-ino)
+    (mode_t     st_mode     stat-mode)
+    (nlink_t    st_nlink    stat-nlinks)
+    (uid_t      st_uid      stat-uid)
+    (gid_t      st_gid      stat-gid)
+    (dev_t      st_rdev     stat-rdev)
+    (off_t      st_size     stat-size)
+    ;(blksize_t  st_blksize  stat-blksize)
+    ;(blkcnt_t   st_blocks   stat-blocks)
+    (time_t     st_atime    stat-atime)
+    (time_t     st_mtime    stat-mtime)
+    (time_t     st_ctime    stat-ctime)))
+  (else
+   (define-c-type DIR
     finalizer: closedir)
-
+   (define-c-struct dirent
-(define-c-struct dirent
     (string d_name dirent-name))
-
+   (define-c-struct stat
-(define-c-struct stat
     predicate: stat?
     (dev_t      st_dev      stat-dev)
     (ino_t      st_ino      stat-ino)
@@ -29,44 +49,56 @@
     (time_t     st_atime    stat-atime)
     (time_t     st_mtime    stat-mtime)
     (time_t     st_ctime    stat-ctime))
+   ))
 
-(define-c boolean S_ISREG (mode_t))
-(define-c boolean S_ISDIR (mode_t))
-(define-c boolean S_ISCHR (mode_t))
-(define-c boolean S_ISBLK (mode_t))
-(define-c boolean S_ISFIFO (mode_t))
-(define-c boolean S_ISLNK (mode_t))
-(define-c boolean S_ISSOCK (mode_t))
 
-;;(define-c-const int ("S_IFMT"))
+
-(define-c-const int (file/socket "S_IFSOCK"))
+
-(define-c-const int (file/link "S_IFLNK"))
+(cond-expand
-(define-c-const int (file/regular "S_IFREG"))
+  ((not windows)
-(define-c-const int (file/block "S_IFBLK"))
+   (define-c boolean S_ISREG (mode_t))
-(define-c-const int (file/directory "S_IFDIR"))
+   (define-c boolean S_ISDIR (mode_t))
-(define-c-const int (file/character "S_IFCHR"))
+   (define-c boolean S_ISCHR (mode_t))
-(define-c-const int (file/fifo "S_IFIFO"))
+   (define-c boolean S_ISBLK (mode_t))
-(define-c-const int (file/suid "S_ISUID"))
+   (define-c boolean S_ISFIFO (mode_t))
-(define-c-const int (file/sgid "S_ISGID"))
+   (define-c boolean S_ISLNK (mode_t))
-(define-c-const int (file/sticky "S_ISVTX"))
+   (define-c boolean S_ISSOCK (mode_t))))
-;;(define-c-const int ("S_IRWXU"))
+
-(define-c-const int (perm/user-read "S_IRUSR"))
+(cond-expand
-(define-c-const int (perm/user-write "S_IWUSR"))
+ ((not windows)
-(define-c-const int (perm/user-execute "S_IXUSR"))
+  ;;(define-c-const int ("S_IFMT"))
-;;(define-c-const int ("S_IRWXG"))
+  (define-c-const int (file/socket "S_IFSOCK"))
-(define-c-const int (perm/group-read "S_IRGRP"))
+  (define-c-const int (file/link "S_IFLNK"))
-(define-c-const int (perm/group-write "S_IWGRP"))
+  (define-c-const int (file/regular "S_IFREG"))
-(define-c-const int (perm/group-execute "S_IXGRP"))
+  (define-c-const int (file/block "S_IFBLK"))
-;;(define-c-const int ("S_IRWXO"))
+  (define-c-const int (file/directory "S_IFDIR"))
-(define-c-const int (perm/others-read "S_IROTH"))
+  (define-c-const int (file/character "S_IFCHR"))
-(define-c-const int (perm/others-write "S_IWOTH"))
+  (define-c-const int (file/fifo "S_IFIFO"))
-(define-c-const int (perm/others-execute "S_IXOTH"))
+  (define-c-const int (file/suid "S_ISUID"))
+  (define-c-const int (file/sgid "S_ISGID"))
+  (define-c-const int (file/sticky "S_ISVTX"))
+  ;;(define-c-const int ("S_IRWXU"))
+  (define-c-const int (perm/user-read "S_IRUSR"))
+  (define-c-const int (perm/user-write "S_IWUSR"))
+  (define-c-const int (perm/user-execute "S_IXUSR"))
+  ;;(define-c-const int ("S_IRWXG"))
+  (define-c-const int (perm/group-read "S_IRGRP"))
+  (define-c-const int (perm/group-write "S_IWGRP"))
+  (define-c-const int (perm/group-execute "S_IXGRP"))
+  ;;(define-c-const int ("S_IRWXO"))
+ (define-c-const int (perm/others-read "S_IROTH"))
+ (define-c-const int (perm/others-write "S_IWOTH"))
+ (define-c-const int (perm/others-execute "S_IXOTH"))))
 
 (define-c errno stat (string (result stat)))
 (define-c errno fstat (int (result stat)))
-(define-c errno (file-link-status "lstat") (string (result stat)))
+(cond-expand
+  ((not windows)
+   (define-c errno (file-link-status "lstat") (string (result stat)))))
 
-(define-c int readlink (string string int))
+(cond-expand
+  ((not windows)
+   (define-c int readlink (string string int))))
 
 ;; Creates a new input-port from the file descriptor \var{int}.
 
@@ -88,12 +120,16 @@
 ;;> Creates a hard link to the first arg from the second.
 ;;> Returns \scheme{#t} on success and \scheme{#f} on failure.
 
-(define-c errno (link-file "link") (string string))
+(cond-expand
+  ((not windows)
+   (define-c errno (link-file "link") (string string))))
 
 ;;> Creates a symbolic link to the first arg from the second.
 ;;> Returns \scheme{#t} on success and \scheme{#f} on failure.
 
-(define-c errno (symbolic-link-file "symlink") (string string))
+(cond-expand
+  ((not windows)
+   (define-c errno (symbolic-link-file "symlink") (string string))))
 
 ;;> Renames the first arg to the second.
 ;;> Returns \scheme{#t} on success and \scheme{#f} on failure.
@@ -112,7 +148,11 @@
 ;;> Creates a new directory with the given mode.
 ;;> Returns \scheme{#t} on success and \scheme{#f} on failure.
 
-(define-c errno (create-directory "mkdir") (string (default #o775 int)))
+(cond-expand
+  ((not windows)
+   (define-c errno (create-directory "mkdir") (string (default #o775 int))))
+  (else
+   (define-c errno (create-directory "mkdir") (string))))
 
 ;;> Deletes the directory named \var{string} from the filesystem.
 ;;> Does not attempt to delete recursively.
@@ -120,8 +160,10 @@
 
 (define-c errno (delete-directory "rmdir") (string))
 
-(define-c (free DIR) opendir (string))
+(cond-expand
-(define-c dirent readdir ((link (pointer DIR))))
+  ((not windows)
+   (define-c (free DIR) opendir (string))
+   (define-c dirent readdir ((link (pointer DIR))))))
 
 ;;> Duplicates the given file descriptor, returning he new value,
 ;; or -1 on failure.
@@ -146,25 +188,33 @@
 ;;> Returns a list of 2 new file descriptors, the input and
 ;;> output end of a new pipe, respectively.
 
-(define-c errno (open-pipe "pipe") ((result (array fileno 2))))
+(cond-expand
+  ((not windows)
+   (define-c errno (open-pipe "pipe") ((result (array fileno 2))))))
 
 ;;> Creates a new named pipe in the given path.
 ;;> Returns \scheme{#t} on success and \scheme{#f} on failure.
 
-(define-c errno (make-fifo "mkfifo") (string (default #o664 int)))
+(cond-expand
+  ((not windows)
+   (define-c errno (make-fifo "mkfifo") (string (default #o664 int)))))
 
-(define-c int (get-file-descriptor-flags "fcntl")
+(cond-expand
+  ((not windows)
+   (define-c int (get-file-descriptor-flags "fcntl")
     (port-or-fileno (value F_GETFD int)))
-(define-c errno (set-file-descriptor-flags! "fcntl")
+   (define-c errno (set-file-descriptor-flags! "fcntl")
-  (port-or-fileno (value F_SETFD int) long))
+    (port-or-fileno (value F_SETFD int) long))))
 
 ;;> Get and set the flags for the given file descriptor.
 ;;/
 
-(define-c int (get-file-descriptor-status "fcntl")
+(cond-expand
+  ((not windows)
+   (define-c int (get-file-descriptor-status "fcntl")
     (port-or-fileno (value F_GETFL int)))
-(define-c errno (set-file-descriptor-status! "fcntl")
+   (define-c errno (set-file-descriptor-status! "fcntl")
-  (port-or-fileno (value F_SETFL int) long))
+    (port-or-fileno (value F_SETFL int) long))))
 
 ;;> Get and set the status for the given file descriptor.
 ;;/
@@ -183,32 +233,39 @@
 (define-c-const int (open/exclusive "O_EXCL"))
 (define-c-const int (open/truncate "O_TRUNC"))
 (define-c-const int (open/append "O_APPEND"))
-(define-c-const int (open/non-block "O_NONBLOCK"))
+(cond-expand
+  ((not windows)
+   (define-c-const int (open/non-block "O_NONBLOCK"))))
 
 ;;> File opening modes.
 ;;/
 
 ;;> Truncate the file to the given size.
 
-(define-c int (file-truncate "ftruncate")
+(cond-expand
-  (port-or-fileno off_t))
+  ((not windows)
+   (define-c int (file-truncate "ftruncate")
+    (port-or-fileno off_t))))
 
 ;; Used for file-is-readable?, file-is-writable?, file-is-executable?.
-(define-c-const int (access/read "R_OK"))
+(cond-expand
-(define-c-const int (access/write "W_OK"))
+  ((not windows)
-(define-c-const int (access/execute "X_OK"))
+   (define-c-const int (access/read "R_OK"))
+   (define-c-const int (access/write "W_OK"))
+   (define-c-const int (access/execute "X_OK"))))
 (define-c int (file-access "access") (string int))
 
 ;;> Applies the specified locking operation using flock(2) to the port
 ;;> or file-descriptor.
 
-(define-c errno (file-lock "flock") (port-or-fileno int))
-
-(define-c-const int (lock/shared "LOCK_SH"))
-(define-c-const int (lock/exclusive "LOCK_EX"))
-(define-c-const int (lock/non-blocking "LOCK_NB"))
-(define-c-const int (lock/unlock "LOCK_UN"))
 
+(cond-expand
+  ((not windows)
+   (define-c errno (file-lock "flock") (port-or-fileno int))
+   (define-c-const int (lock/shared "LOCK_SH"))
+   (define-c-const int (lock/exclusive "LOCK_EX"))
+   (define-c-const int (lock/non-blocking "LOCK_NB"))
+   (define-c-const int (lock/unlock "LOCK_UN")))) 
 ;;> Locking operations.
 ;;/
 

lib/chibi/process.sld

@@ -19,5 +19,5 @@
           process->output+error process->output+error+status)
   (import (chibi) (chibi io) (chibi string) (chibi filesystem))
   (cond-expand (threads (import (srfi 18) (srfi 151))) (else #f))
-  (include-shared "process")
+  (cond-expand (windows) (else (include-shared "process")))
   (include "process.scm"))

lib/chibi/time.stub

@@ -1,6 +1,8 @@
 
 (cond-expand
  (plan9)
+ (windows
+  (c-system-include "sys/types.h"))
  (else
   (c-system-include "time.h")
   (c-system-include "sys/time.h")))

lib/scheme/time.c

@@ -5,7 +5,10 @@
 
 #include <chibi/eval.h>
 
-#ifndef PLAN9
+#ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#elif !defined(PLAN9)
 #include <sys/time.h>
 #else
 typedef long time_t;
@@ -81,7 +84,19 @@ sexp sexp_current_ntp_clock_values (sexp ctx, sexp self, sexp_sint_t n) {
 #endif  /* def SEXP_USE_NTP_GETTIME */
 
 sexp sexp_current_clock_second (sexp ctx, sexp self, sexp_sint_t n) {
-#ifndef PLAN9
+#ifdef _WIN32
+  ULONGLONG t;
+  SYSTEMTIME st;
+  FILETIME ft;
+  ULARGE_INTEGER uli;
+  GetLocalTime(&st);
+  (void) SystemTimeToFileTime(&st, &ft);
+  /* Convert Win32 FILETIME to UNIX time */
+  uli.LowPart = ft.dwLowDateTime;
+  uli.HighPart = ft.dwHighDateTime;
+  t = uli.QuadPart - (11644473600LL * 10 * 1000 * 1000);
+  return sexp_make_flonum(ctx, ((double)t / (10 * 1000 * 1000)));
+#elif !defined(PLAN9)
   struct timeval tv;
   struct timezone tz;
   if (gettimeofday(&tv, &tz))

lib/srfi/144/math.stub

@@ -146,7 +146,13 @@
 (define-c double remquo (double double (result int)))
 
 (define-c double (flgamma "tgamma") (double))
-(define-c double lgamma_r (double (result int)))
+(cond-expand
+  (windows
+   ;; FIXME: Implement this.
+   (c-declare "double lgamma_r(double x, int* sign) { *sign = 9999; __debugbreak(); }")
+    (define-c double lgamma_r (double (result int))))
+   (else
+    (define-c double lgamma_r (double (result int)))))
 
 (define-c double (flfirst-bessel "jn") (int double))
 (define-c double (flsecond-bessel "yn") (int double))

lib/srfi/27/rand.c

@@ -31,6 +31,16 @@ typedef struct random_data sexp_random_t;
 #define sexp_call_random(rs, dst) random_r(sexp_random_data(rs), &dst)
 #define sexp_seed_random(n, rs) srandom_r(n, sexp_random_data(rs))
 
+#elif defined(_WIN32)
+
+typedef unsigned int sexp_random_t;
+
+/* FIXME: MSVC CRT has rand_s() for "cryptographically secure" random number
+ *        for WinXP or later. */
+#define sexp_random_init(rs, seed) (void)0
+#define sexp_call_random(rs, dst) ((dst) = rand())
+#define sexp_seed_random(n, rs) srand(n)
+
 #else
 
 typedef unsigned int sexp_random_t;