~ chicken-core (chicken-5) 5e002ef8901c91dc3197ceae7f9882699d89b55f
commit 5e002ef8901c91dc3197ceae7f9882699d89b55f
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Dec 28 12:34:12 2010 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Tue Dec 28 12:34:12 2010 +0100
moved common time-related code into posix-common.scm
diff --git a/posix-common.scm b/posix-common.scm
index aec36d62..b4e4b3d2 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -50,6 +50,9 @@ static C_TLS struct stat C_statbuf;
# define S_IFSOCK 0140000
#endif
+#define C_strftime(v, f) \
+ (strftime(C_time_string, sizeof(C_time_string), C_c_string(f), C_tm_set(v)) ? C_time_string : NULL)
+
EOF
))
@@ -376,3 +379,51 @@ EOF
(##sys#check-exact um 'file-creation-mode)
(##core#inline "C_umask" um))
"(file-creation-mode mode)"))
+
+
+;;; Time related things:
+
+(define (check-time-vector loc tm)
+ (##sys#check-vector tm loc)
+ (when (fx< (##sys#size tm) 10)
+ (##sys#error loc "time vector too short" tm) ) )
+
+(define (seconds->local-time #!optional (secs (current-seconds)))
+ (##sys#check-number secs 'seconds->local-time)
+ (##sys#decode-seconds secs #f) )
+
+(define (seconds->utc-time #!optional (secs (current-seconds)))
+ (##sys#check-number secs 'seconds->utc-time)
+ (##sys#decode-seconds secs #t) )
+
+(define seconds->string
+ (let ([ctime (foreign-lambda c-string "C_ctime" integer)])
+ (lambda (#!optional (secs (current-seconds)))
+ (##sys#check-number secs 'seconds->string)
+ (let ([str (ctime secs)])
+ (if str
+ (##sys#substring str 0 (fx- (##sys#size str) 1))
+ (##sys#error 'seconds->string "cannot convert seconds to string" secs) ) ) ) ) )
+
+(define (local-time->seconds tm)
+ (check-time-vector 'local-time->seconds tm)
+ (let ((t (##core#inline_allocate ("C_a_mktime" 4) tm)))
+ (if (fp= -1.0 t)
+ (##sys#error 'local-time->seconds "cannot convert time vector to seconds" tm)
+ t)))
+
+(define time->string
+ (let ([asctime (foreign-lambda c-string "C_asctime" scheme-object)]
+ [strftime (foreign-lambda c-string "C_strftime" scheme-object scheme-object)])
+ (lambda (tm #!optional fmt)
+ (check-time-vector 'time->string tm)
+ (if fmt
+ (begin
+ (##sys#check-string fmt 'time->string)
+ (or (strftime tm (##sys#make-c-string fmt 'time->string))
+ (##sys#error 'time->string "time formatting overflows buffer" tm)) )
+ (let ([str (asctime tm)])
+ (if str
+ (##sys#substring str 0 (fx- (##sys#size str) 1))
+ (##sys#error 'time->string "cannot convert time vector to string" tm) ) ) ) ) ) )
+
diff --git a/posixunix.scm b/posixunix.scm
index a9fa2f8a..4019a0a0 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -433,9 +433,6 @@ extern char *strptime(const char *s, const char *format, struct tm *tm);
extern pid_t getpgid(pid_t pid);
#endif
-#define C_strftime(v, f) \
- (strftime(C_time_string, sizeof(C_time_string), C_c_string(f), C_tm_set(v)) ? C_time_string : NULL)
-
#define C_strptime(s, f, v) \
(strptime(C_c_string(s), C_c_string(f), &C_tm) ? C_tm_get(v) : C_SCHEME_FALSE)
@@ -1683,28 +1680,6 @@ EOF
;;; Time related things:
-(define (check-time-vector loc tm)
- (##sys#check-vector tm loc)
- (when (fx< (##sys#size tm) 10)
- (##sys#error loc "time vector too short" tm) ) )
-
-(define (seconds->local-time #!optional (secs (current-seconds)))
- (##sys#check-number secs 'seconds->local-time)
- (##sys#decode-seconds secs #f) )
-
-(define (seconds->utc-time #!optional (secs (current-seconds)))
- (##sys#check-number secs 'seconds->utc-time)
- (##sys#decode-seconds secs #t) )
-
-(define seconds->string
- (let ([ctime (foreign-lambda c-string "C_ctime" integer)])
- (lambda (#!optional (secs (current-seconds)))
- (##sys#check-number secs 'seconds->string)
- (let ([str (ctime secs)])
- (if str
- (##sys#substring str 0 (fx- (##sys#size str) 1))
- (##sys#error 'seconds->string "cannot convert seconds to string" secs) ) ) ) ) )
-
(define time->string
(let ([asctime (foreign-lambda c-string "C_asctime" scheme-object)]
[strftime (foreign-lambda c-string "C_strftime" scheme-object scheme-object)])
@@ -1727,13 +1702,6 @@ EOF
(##sys#check-string fmt 'string->time)
(strptime (##sys#make-c-string tim 'string->time) (##sys#make-c-string fmt) (make-vector 10 #f)) ) ) )
-(define (local-time->seconds tm)
- (check-time-vector 'local-time->seconds tm)
- (let ((t (##core#inline_allocate ("C_a_mktime" 4) tm)))
- (if (fp= -1.0 t)
- (##sys#error 'local-time->seconds "cannot convert time vector to seconds" tm)
- t)))
-
(define (utc-time->seconds tm)
(check-time-vector 'utc-time->seconds tm)
(let ((t (##core#inline_allocate ("C_a_timegm" 4) tm)))
@@ -1752,6 +1720,7 @@ EOF
"\n#endif\n"
"C_return(z);") )
+
;;; Other things:
(define _exit
diff --git a/posixwin.scm b/posixwin.scm
index 27013588..64ef6079 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -329,9 +329,6 @@ C_free_arg_string(char **where) {
static char C_time_string [TIME_STRING_MAXLENGTH + 1];
#undef TIME_STRING_MAXLENGTH
-#define C_strftime(v, f) \
- (strftime(C_time_string, sizeof(C_time_string), C_c_string(f), C_tm_set(v)) ? C_time_string : NULL)
-
/*
mapping from Win32 error codes to errno
*/
@@ -1448,54 +1445,12 @@ EOF
;;; Time related things:
-(define (check-time-vector loc tm)
- (##sys#check-vector tm loc)
- (when (fx< (##sys#size tm) 10)
- (##sys#error loc "time vector too short" tm) ) )
-
-(define (seconds->local-time #!optional (secs (current-seconds)))
- (##sys#check-number secs 'seconds->local-time)
- (##sys#decode-seconds secs #f) )
-
-(define (seconds->utc-time #!optional (secs (current-seconds)))
- (##sys#check-number secs 'seconds->utc-time)
- (##sys#decode-seconds secs #t) )
-
-(define seconds->string
- (let ([ctime (foreign-lambda c-string "C_ctime" integer)])
- (lambda (#!optional (secs (current-seconds)))
- (let ([str (ctime secs)])
- (if str
- (##sys#substring str 0 (fx- (##sys#size str) 1))
- (##sys#error 'seconds->string "cannot convert seconds to string" secs) ) ) ) ) )
-
-(define time->string
- (let ([asctime (foreign-lambda c-string "C_asctime" scheme-object)]
- [strftime (foreign-lambda c-string "C_strftime" scheme-object scheme-object)])
- (lambda (tm #!optional fmt)
- (check-time-vector 'time->string tm)
- (if fmt
- (begin
- (##sys#check-string fmt 'time->string)
- (or (strftime tm (##sys#make-c-string fmt 'time->string))
- (##sys#error 'time->string "time formatting overflows buffer" tm)) )
- (let ([str (asctime tm)])
- (if str
- (##sys#substring str 0 (fx- (##sys#size str) 1))
- (##sys#error 'time->string "cannot convert time vector to string" tm) ) ) ) ) ) )
-
-(define (local-time->seconds tm)
- (check-time-vector 'local-time->seconds tm)
- (let ((t (##core#inline_allocate ("C_a_mktime" 4) tm)))
- (if (fp= t -1.0)
- (##sys#error 'local-time->seconds "cannot convert time vector to seconds" tm)
- t)))
-
(define local-timezone-abbreviation
(foreign-lambda* c-string ()
"char *z = (_daylight ? _tzname[1] : _tzname[0]);\n"
"C_return(z);") )
+
;;; Other things:
(define _exit
Trap