From 735719d9d655705ab4ba001d4fc7e0c0b0ce1442 Mon Sep 17 00:00:00 2001 From: okuoku Date: Sat, 9 Sep 2017 17:54:55 +0900 Subject: [PATCH] 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 | 219 ++++++++++++++++++++++++-------------- lib/chibi/process.sld | 2 +- lib/chibi/time.stub | 2 + lib/scheme/time.c | 19 +++- lib/srfi/144/math.stub | 8 +- lib/srfi/27/rand.c | 10 ++ 6 files changed, 175 insertions(+), 85 deletions(-) diff --git a/lib/chibi/filesystem.stub b/lib/chibi/filesystem.stub index 22730cd7..a82af25e 100644 --- a/lib/chibi/filesystem.stub +++ b/lib/chibi/filesystem.stub @@ -2,71 +2,103 @@ ;; 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 - finalizer: closedir) +(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 + (string d_name dirent-name)) + (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)) + )) -(define-c-struct dirent - (string d_name dirent-name)) -(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)) -(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")) -(define-c-const int (file/regular "S_IFREG")) -(define-c-const int (file/block "S_IFBLK")) -(define-c-const int (file/directory "S_IFDIR")) -(define-c-const int (file/character "S_IFCHR")) -(define-c-const int (file/fifo "S_IFIFO")) -(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")) +(cond-expand + ((not windows) + (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)))) + +(cond-expand + ((not windows) + ;;(define-c-const int ("S_IFMT")) + (define-c-const int (file/socket "S_IFSOCK")) + (define-c-const int (file/link "S_IFLNK")) + (define-c-const int (file/regular "S_IFREG")) + (define-c-const int (file/block "S_IFBLK")) + (define-c-const int (file/directory "S_IFDIR")) + (define-c-const int (file/character "S_IFCHR")) + (define-c-const int (file/fifo "S_IFIFO")) + (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)) -(define-c dirent readdir ((link (pointer DIR)))) +(cond-expand + ((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") - (port-or-fileno (value F_GETFD int))) -(define-c errno (set-file-descriptor-flags! "fcntl") - (port-or-fileno (value F_SETFD int) long)) +(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") + (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") - (port-or-fileno (value F_GETFL int))) -(define-c errno (set-file-descriptor-status! "fcntl") - (port-or-fileno (value F_SETFL int) long)) +(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") + (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") - (port-or-fileno off_t)) +(cond-expand + ((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")) -(define-c-const int (access/write "W_OK")) -(define-c-const int (access/execute "X_OK")) +(cond-expand + ((not windows) + (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. ;;/ diff --git a/lib/chibi/process.sld b/lib/chibi/process.sld index c06af5b9..143aa98b 100644 --- a/lib/chibi/process.sld +++ b/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")) diff --git a/lib/chibi/time.stub b/lib/chibi/time.stub index cf2a6d1c..d917671b 100644 --- a/lib/chibi/time.stub +++ b/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"))) diff --git a/lib/scheme/time.c b/lib/scheme/time.c index 3987e5b7..959c84bc 100644 --- a/lib/scheme/time.c +++ b/lib/scheme/time.c @@ -5,7 +5,10 @@ #include -#ifndef PLAN9 +#ifdef _WIN32 +#define WIN32_LEAN_AND_MEAN +#include +#elif !defined(PLAN9) #include #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)) diff --git a/lib/srfi/144/math.stub b/lib/srfi/144/math.stub index c3430fb5..34429226 100644 --- a/lib/srfi/144/math.stub +++ b/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)) diff --git a/lib/srfi/27/rand.c b/lib/srfi/27/rand.c index a3c816ec..2c907c23 100644 --- a/lib/srfi/27/rand.c +++ b/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;