Changeset 7984 in project


Ignore:
Timestamp:
01/29/08 01:04:28 (11 years ago)
Author:
kon
Message:

Added optional format (strftime) to time->string. Added string->time (strptime); no Windows though.

Location:
chicken/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/posixunix.scm

    r7983 r7984  
    208208# define C_setenv(x, y)     C_fix(setenv((char *)C_data_pointer(x), (char *)C_data_pointer(y), 1))
    209209#else
    210 static C_word C_fcall C_setenv(C_word x, C_word y);
    211 C_word C_fcall C_setenv(C_word x, C_word y) {
     210static C_word C_fcall C_setenv(C_word x, C_word y) {
    212211  char *sx = C_data_pointer(x),
    213212       *sy = C_data_pointer(y);
     
    322321/* Seen here: http://lists.samba.org/archive/samba-technical/2002-November/025571.html */
    323322
    324 time_t timegm(struct tm *t)
     323static time_t timegm(struct tm *t)
    325324{
    326325  time_t tl, tb;
     
    351350#endif
    352351
    353 #define C_tm_set_07(v) \
     352#define C_tm_set_08(v) \
    354353        (memset(&C_tm, 0, sizeof(struct tm)), \
    355354        C_tm.tm_sec = C_unfix(C_block_item(v, 0)), \
     
    360359        C_tm.tm_year = C_unfix(C_block_item(v, 5)), \
    361360        C_tm.tm_wday = C_unfix(C_block_item(v, 6)), \
    362         C_tm.tm_yday = C_unfix(C_block_item(v, 7)))
    363 
    364 #define C_tm_set_8(v) \
    365         (C_tm.tm_isdst = (C_block_item(v, 8) != C_SCHEME_FALSE))
    366 
    367 #define C_tm_get_07(v) \
     361        C_tm.tm_yday = C_unfix(C_block_item(v, 7)), \
     362        C_tm.tm_isdst = (C_block_item(v, 8) != C_SCHEME_FALSE))
     363
     364#define C_tm_set_9(v) \
     365        (C_tm.tm_gmtoff = C_unfix(C_block_item(v, 9)))
     366
     367#define C_tm_get_08(v) \
    368368        (C_set_block_item(v, 0, C_fix(C_tm.tm_sec)), \
    369369        C_set_block_item(v, 1, C_fix(C_tm.tm_min)), \
     
    373373        C_set_block_item(v, 5, C_fix(C_tm.tm_year)), \
    374374        C_set_block_item(v, 6, C_fix(C_tm.tm_wday)), \
    375         C_set_block_item(v, 7, C_fix(C_tm.tm_yday)))
    376 
    377 #define C_tm_get_8(v) \
    378         (C_set_block_item(v, 8, (C_tm.tm_isdst ? C_SCHEME_TRUE : C_SCHEME_FALSE)))
     375        C_set_block_item(v, 7, C_fix(C_tm.tm_yday)), \
     376        C_set_block_item(v, 8, (C_tm.tm_isdst ? C_SCHEME_TRUE : C_SCHEME_FALSE)))
     377
     378#define C_tm_get_9(v) \
     379        (C_set_block_item(v, 9, C_fix(C_tm.tm_gmtoff)))
    379380
    380381#if !defined(C_GNU_ENV) || defined(__CYGWIN__) || defined(__uClinux__)
    381 # define C_tm_set(v) (C_tm_set_07(v), C_tm_set_8(v))
    382 # define C_tm_get(v) (C_tm_get_07(v), C_tm_get_8(v))
     382# define C_tm_set(v) (C_tm_set_08(v), &C_tm)
     383# define C_tm_get(v) (C_tm_get_08(v), v)
    383384#else
    384 # define C_tm_set(v) (C_tm_set_07(v))
    385 # define C_tm_get(v) (C_tm_get_07(v))
     385# define C_tm_set(v) (C_tm_set_08(v), C_tm_set_9(v), &C_tm)
     386# define C_tm_get(v) (C_tm_get_08(v), C_tm_get_9(v), v)
    386387#endif
    387388
    388 #define C_asctime(v)    (C_tm_set(v), asctime(&C_tm))
    389 #define C_mktime(v)     (C_tm_set(v), (C_temporary_flonum = mktime(&C_tm)) != -1)
    390 #define C_timegm(v)     (C_tm_set(v), (C_temporary_flonum = timegm(&C_tm)) != -1)
     389#define C_asctime(v)    (asctime(C_tm_set(v)))
     390#define C_mktime(v)     ((C_temporary_flonum = mktime(C_tm_set(v))) != -1)
     391#define C_timegm(v)     ((C_temporary_flonum = timegm(C_tm_set(v))) != -1)
     392
     393#define TIME_STRING_MAXLENGTH 255
     394static char C_time_string [TIME_STRING_MAXLENGTH + 1];
     395#undef TIME_STRING_MAXLENGTH
     396
     397#define C_strftime(v, f) \
     398        (strftime(C_time_string, sizeof(C_time_string), C_c_string(f), C_tm_set(v)) ? C_time_string : NULL)
     399
     400#define C_strptime(s, f, v) \
     401        (strptime(C_c_string(s), C_c_string(f), &C_tm) ? C_tm_get(v) : C_SCHEME_FALSE)
    391402
    392403static gid_t *C_groups = NULL;
     
    17791790    (lambda (secs)
    17801791      (let ([str (ctime secs)])
    1781         (unless str (##sys#error 'seconds->string "cannot convert seconds to string" secs))
    1782         (##sys#substring str 0 (fx- (##sys#size str) 1))))))
     1792        (if str
     1793            (##sys#substring str 0 (fx- (##sys#size str) 1))
     1794            (##sys#error 'seconds->string "cannot convert seconds to string" secs) ) ) ) ) )
    17831795
    17841796(define time->string
    1785   (let ([asctime (foreign-lambda c-string "C_asctime" scheme-object)])
    1786     (lambda (tm)
     1797  (let ([asctime (foreign-lambda c-string "C_asctime" scheme-object)]
     1798        [strftime (foreign-lambda c-string "C_strftime" scheme-object scheme-object)])
     1799    (lambda (tm #!optional fmt)
    17871800      (##sys#check-vector tm 'time->string)
    17881801      (when (fx< (##sys#size tm) 10) (##sys#error 'time->string "time vector too short" tm))
    1789       (let ([str (asctime tm)])
    1790         (unless str (##sys#error 'time->string "cannot convert time vector to string" tm))
    1791         (##sys#substring str 0 (fx- (##sys#size str) 1))))))
     1802      (if fmt
     1803          (begin
     1804            (##sys#check-string fmt 'time->string)
     1805            (or (strftime tm fmt)
     1806                (##sys#error 'time->string "time formatting overflows buffer" tm)) )
     1807          (let ([str (asctime tm)])
     1808            (if str
     1809                (##sys#substring str 0 (fx- (##sys#size str) 1))
     1810                (##sys#error 'time->string "cannot convert time vector to string" tm) ) ) ) ) ) )
     1811
     1812(define string->time
     1813  (let ([strptime (foreign-lambda scheme-object "C_strptime" scheme-object scheme-object scheme-object)])
     1814    (lambda (tim #!optional (fmt "%a %b %e %H:%M:%S %Z %Y"))
     1815      (##sys#check-string tim 'string->time)
     1816      (##sys#check-string fmt 'string->time)
     1817      (strptime tim fmt (make-vector 10 #f)) ) ) )
    17921818
    17931819(define (local-time->seconds tm)
  • chicken/trunk/posixwin.scm

    r7864 r7984  
    333333#define C_ctime(n)          (C_secs = (n), ctime(&C_secs))
    334334
    335 #define C_asctime(v)        (memset(&C_tm, 0, sizeof(struct tm)), C_tm.tm_sec = C_unfix(C_block_item(v, 0)), C_tm.tm_min = C_unfix(C_block_item(v, 1)), C_tm.tm_hour = C_unfix(C_block_item(v, 2)), C_tm.tm_mday = C_unfix(C_block_item(v, 3)), C_tm.tm_mon = C_unfix(C_block_item(v, 4)), C_tm.tm_year = C_unfix(C_block_item(v, 5)), C_tm.tm_wday = C_unfix(C_block_item(v, 6)), C_tm.tm_yday = C_unfix(C_block_item(v, 7)), C_tm.tm_isdst = (C_block_item(v, 8) != C_SCHEME_FALSE), asctime(&C_tm) )
    336 #define C_mktime(v)         (memset(&C_tm, 0, sizeof(struct tm)), C_tm.tm_sec = C_unfix(C_block_item(v, 0)), C_tm.tm_min = C_unfix(C_block_item(v, 1)), C_tm.tm_hour = C_unfix(C_block_item(v, 2)), C_tm.tm_mday = C_unfix(C_block_item(v, 3)), C_tm.tm_mon = C_unfix(C_block_item(v, 4)), C_tm.tm_year = C_unfix(C_block_item(v, 5)), C_tm.tm_wday = C_unfix(C_block_item(v, 6)), C_tm.tm_yday = C_unfix(C_block_item(v, 7)), C_tm.tm_isdst = (C_block_item(v, 8) != C_SCHEME_FALSE), (C_temporary_flonum = mktime(&C_tm)) != -1)
     335#define C_tm_set_08(v) \
     336        (memset(&C_tm, 0, sizeof(struct tm)), \
     337        C_tm.tm_sec = C_unfix(C_block_item(v, 0)), \
     338        C_tm.tm_min = C_unfix(C_block_item(v, 1)), \
     339        C_tm.tm_hour = C_unfix(C_block_item(v, 2)), \
     340        C_tm.tm_mday = C_unfix(C_block_item(v, 3)), \
     341        C_tm.tm_mon = C_unfix(C_block_item(v, 4)), \
     342        C_tm.tm_year = C_unfix(C_block_item(v, 5)), \
     343        C_tm.tm_wday = C_unfix(C_block_item(v, 6)), \
     344        C_tm.tm_yday = C_unfix(C_block_item(v, 7)), \
     345        C_tm.tm_isdst = (C_block_item(v, 8) != C_SCHEME_FALSE))
     346
     347#define C_tm_set(v) (C_tm_set_08(v), &C_tm)
     348
     349#define C_asctime(v)    (asctime(C_tm_set(v)))
     350#define C_mktime(v)     ((C_temporary_flonum = mktime(C_tm_set(v))) != -1)
     351
     352#define TIME_STRING_MAXLENGTH 255
     353static char C_time_string [TIME_STRING_MAXLENGTH + 1];
     354#undef TIME_STRING_MAXLENGTH
     355
     356#define C_strftime(v, f) \
     357        (strftime(C_time_string, sizeof(C_time_string), C_c_string(f), C_tm_set(v)) ? C_time_string : NULL)
    337358
    338359/*
     
    15751596    (lambda (secs)
    15761597      (let ([str (ctime secs)])
    1577         (unless str (##sys#error 'seconds->string "cannot convert seconds to string" secs))
    1578         (##sys#substring str 0 (fx- (##sys#size str) 1))))))
     1598        (if str
     1599            (##sys#substring str 0 (fx- (##sys#size str) 1))
     1600            (##sys#error 'seconds->string "cannot convert seconds to string" secs) ) ) ) ) )
    15791601
    15801602(define time->string
    1581   (let ([asctime (foreign-lambda c-string "C_asctime" scheme-object)])
    1582     (lambda (tm)
     1603  (let ([asctime (foreign-lambda c-string "C_asctime" scheme-object)]
     1604        [strftime (foreign-lambda c-string "C_strftime" scheme-object scheme-object)])
     1605    (lambda (tm #!optional fmt)
    15831606      (##sys#check-vector tm 'time->string)
    15841607      (when (fx< (##sys#size tm) 10) (##sys#error 'time->string "time vector too short" tm))
    1585       (let ([str (asctime tm)])
    1586         (unless str (##sys#error 'time->string "cannot time vector to string" tm))
    1587         (##sys#substring str 0 (fx- (##sys#size str) 1))))))
     1608      (if fmt
     1609          (begin
     1610            (##sys#check-string fmt 'time->string)
     1611            (or (strftime tm fmt)
     1612                (##sys#error 'time->string "time formatting overflows buffer" tm)) )
     1613          (let ([str (asctime tm)])
     1614            (if str
     1615                (##sys#substring str 0 (fx- (##sys#size str) 1))
     1616                (##sys#error 'time->string "cannot convert time vector to string" tm) ) ) ) ) ) )
    15881617
    15891618(define (local-time->seconds tm)
     
    19812010(define-unimplemented user-information)
    19822011(define-unimplemented utc-time->seconds)
     2012(define-unimplemented string->time)
    19832013
    19842014(define errno/wouldblock 0)
Note: See TracChangeset for help on using the changeset viewer.