Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv8821/scsh
Modified Files:
time.scm time1.c time1.h
Removed Files:
time.c
Log Message:
Decigged time.
Index: time.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/time.scm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -r1.7 -r1.8
*** time.scm 2001/01/01 16:45:32 1.7
--- time.scm 2001/09/07 12:36:30 1.8
***************
*** 11,19 ****
;;; - If tz-secs not defined, filled in from tz-name.
- (foreign-init-name "time")
-
- (foreign-source "#include \"time1.h\"" ; Import the time1.h interface.
- "")
-
;;; A TIME is an instant in the history of the universe; it is location
;;; independent, barring relativistic effects. It is measured as the
--- 11,14 ----
***************
*** 99,103 ****
; TODO: all C files are identical, so move it to time1.c
; returns (list secs ticks)
! (define-stubless-foreign %time+ticks () "time_plus_ticks")
(define (time+ticks)
--- 94,99 ----
; TODO: all C files are identical, so move it to time1.c
; returns (list secs ticks)
! (define-stubless-foreign %time+ticks/eintr () "time_plus_ticks")
! (define-retrying-syscall %time+ticks %time+ticks/eintr)
(define (time+ticks)
***************
*** 107,116 ****
(+ secs (/ ticks (ticks/sec))))
! (define-stubless-foreign %time () "scheme_time")
! (define-stubless-foreign %date->time (sec min hour month-day month year
! tz-name ; #f or string
! tz-secs ; #f or int
! summer?) "date2time")
(define (time . args) ; optional arg [date]
--- 103,115 ----
(+ secs (/ ticks (ticks/sec))))
! (define-stubless-foreign %time/eintr () "scheme_time")
! (define-retrying-syscall %time %time/eintr)
! (define-stubless-foreign %date->time/eintr
! (sec min hour month-day month year
! tz-name ; #f or string
! tz-secs ; #f or int
! summer?) "date2time")
! (define-retrying-syscall %date->time %date->time/eintr)
(define (time . args) ; optional arg [date]
***************
*** 133,152 ****
;;; Date
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (define-foreign %time->date (time2date (time_t time-hi)
! (desc zone))
! desc ; errno or #f
! fixnum ; seconds
! fixnum ; minute
! fixnum ; hour
! fixnum ; month-day
! fixnum ; month
! fixnum ; year
! string ; tz-name (#f if we need to make it from tz-secs)
! fixnum ; tz-secs
! bool ; summer?
! fixnum ; week-day
! fixnum) ; year-day
-
(define (date . args) ; Optional args [time zone]
(let ((time (if (pair? args)
--- 132,138 ----
;;; Date
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (define-stubless-foreign %time->date/eintr (time zone) "time2date")
! (define-retrying-syscall %time->date %time->date/eintr)
(define (date . args) ; Optional args [time zone]
(let ((time (if (pair? args)
***************
*** 156,170 ****
(and (pair? args) (:optional (cdr args) #f))
date)))
! (let lp ()
! (receive (err seconds minute hour month-day month
! year tz-name tz-secs summer? week-day year-day)
! (%time->date time zone)
! (cond ((not err)
! (make-%date seconds minute hour month-day month
! year
! (format-time-zone (or tz-name "UTC") tz-secs)
! tz-secs summer? week-day year-day))
! ((= errno/intr err) (lp))
! (errno-error err date time zone))))))
--- 142,153 ----
(and (pair? args) (:optional (cdr args) #f))
date)))
! (apply
! (lambda (seconds minute hour month-day month
! year tz-name tz-secs summer? week-day year-day)
! (make-%date seconds minute hour month-day month
! year
! (format-time-zone (or tz-name "UTC") tz-secs)
! tz-secs summer? week-day year-day))
! (%time->date time zone))))
***************
*** 177,211 ****
(define (format-date fmt date)
(check-arg date? date format-date)
! (receive (err result)
! (%format-date/errno fmt
! (date:seconds date)
! (date:minute date)
! (date:hour date)
! (date:month-day date)
! (date:month date)
! (date:year date)
! (if (string? (date:tz-name date))
! (date:tz-name date)
! (deintegerize-time-zone (date:tz-secs date)))
! (date:summer? date)
! (date:week-day date)
! (date:year-day date))
! (cond ((not err) result)
! ((= errno/intr err) (format-date fmt date))
! (else (errno-error err format-date fmt date)))))
!
! (define-foreign %format-date/errno (format_date (string fmt)
! (fixnum seconds)
! (fixnum minute)
! (fixnum hour)
! (fixnum month-day)
! (fixnum month)
! (fixnum year)
! (desc tz-name)
! (bool summer?)
! (fixnum week-day)
! (fixnum year-day))
! desc ; false or errno
! string)
--- 160,185 ----
(define (format-date fmt date)
(check-arg date? date format-date)
! (let ((result
! (%format-date fmt
! (date:seconds date)
! (date:minute date)
! (date:hour date)
! (date:month-day date)
! (date:month date)
! (date:year date)
! (if (string? (date:tz-name date))
! (date:tz-name date)
! (deintegerize-time-zone (date:tz-secs date)))
! (date:summer? date)
! (date:week-day date)
! (date:year-day date))))
! (cond ((not result) (error "~ without argument in format-date" fmt))
! (else result))))
!
! (define-stubless-foreign %format-date/eintr
! (fmt seconds minute hour month-day month year tz-name summer? week-day
! year-day)
! "format_date")
! (define-retrying-syscall %format-date %format-date/eintr)
Index: time1.c
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/time1.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -r1.5 -r1.6
*** time1.c 2001/07/11 13:08:52 1.5
--- time1.c 2001/09/07 12:36:30 1.6
***************
*** 3,12 ****
*/
! /* WARNING: THIS FILE HAS CODE THAT DEPENDS ON 32-BIT ARCHITECTURES.
! ** This code is so marked.
! ** JMG: should have disappeard since cig now supports time_t via
! ** s48_{enter,extract}_integer which is mapped to a bignum by need
! **
! ** The source code is also conditionalised by three #ifdef feature macros:
** HAVE_TZNAME
** The char *tzname[2] global variable is POSIX. Everyone provides
--- 3,7 ----
*/
! /* The source code is conditionalised by three #ifdef feature macros:
** HAVE_TZNAME
** The char *tzname[2] global variable is POSIX. Everyone provides
***************
*** 119,122 ****
--- 114,130 ----
}
+ // should be part of the FFI interface
+ s48_value s48_list_11 (s48_value e1, s48_value e2, s48_value e3,
+ s48_value e4, s48_value e5, s48_value e6,
+ s48_value e7, s48_value e8, s48_value e9,
+ s48_value e10, s48_value e11)
+ {
+ return
+ s48_cons (e1, s48_cons (e2, s48_cons (e3, s48_cons (e4, s48_cons
+ (e5, s48_cons (e6, s48_cons (e7, s48_cons (e8, s48_cons (e9,
+ s48_cons (e10, s48_cons (e11, S48_NULL)))))))))));
+ }
+
+
/* Zone:
** #f Local time
***************
*** 124,150 ****
** string Time zone understood by OS.
*/
! s48_value time2date(time_t t, s48_value zone,
! int *sec, int *min, int *hour,
int *mday, int *month, int *year,
const char **tz_name, int *tz_secs,
int *summer,
int *wday, int *yday)
{
! struct tm d;
!
! if( S48_FIXNUM_P(zone) ) { /* Offset from GMT in
secs. */
! int offset = s48_extract_fixnum(zone);
! t += s48_extract_fixnum(zone);
d = *gmtime(&t);
! *tz_name = NULL;
! *tz_secs = offset;
}
else {
char *newenv[2], **oldenv = NULL;
! if( S48_STRING_P(zone) ) { /* Time zone */
! oldenv = make_newenv(zone, newenv); /* Install new TZ. */
! if( !oldenv ) return s48_enter_fixnum(errno); /* Error installing. */
d = *localtime(&t); /* Do it. */
}
--- 132,162 ----
** string Time zone understood by OS.
*/
! s48_value time2date(s48_value sch_t, s48_value sch_zone)
! /* int *sec, int *min, int *hour,
int *mday, int *month, int *year,
const char **tz_name, int *tz_secs,
int *summer,
int *wday, int *yday)
+ */
{
! struct tm d;
! time_t t = s48_extract_integer(sch_t);
! s48_value sch_tz_name = S48_UNSPECIFIC;
! s48_value sch_tz_secs = S48_UNSPECIFIC;
!
! if( S48_FIXNUM_P(sch_zone) ) { /* Offset from GMT in secs. */
! int offset = s48_extract_fixnum(sch_zone);
! t += s48_extract_fixnum(sch_zone);
d = *gmtime(&t);
! sch_tz_name = s48_enter_string("");
! sch_tz_secs = s48_enter_fixnum (offset);
}
else {
char *newenv[2], **oldenv = NULL;
! if( S48_STRING_P(sch_zone) ) { /* Time zone */
! oldenv = make_newenv(sch_zone, newenv); /* Install new TZ. */
! if( !oldenv ) s48_raise_os_error_2(errno, sch_t, sch_zone);
d = *localtime(&t); /* Do it. */
}
***************
*** 169,184 ****
#endif
char *newzone = Malloc(char, 1+strlen(zone));
! *tz_name = newzone;
! if( newzone ) strcpy(newzone, zone);
else error = errno;
if( oldenv ) revert_env(oldenv); /* Revert TZ & env. */
! if( !newzone ) return s48_enter_fixnum(error);
}
/* Calculate the time-zone offset in seconds from UTC. */
#ifdef HAVE_GMTOFF
! *tz_secs = d.tm_gmtoff;
#else
--- 181,198 ----
#endif
char *newzone = Malloc(char, 1+strlen(zone));
! if( newzone ){
! strcpy(newzone, zone);
! sch_tz_name = s48_enter_string (newzone);
! }
else error = errno;
if( oldenv ) revert_env(oldenv); /* Revert TZ & env. */
! if( !newzone ) s48_raise_os_error_2(error, sch_t, sch_zone);
}
/* Calculate the time-zone offset in seconds from UTC. */
#ifdef HAVE_GMTOFF
! sch_tz_secs = s48_enter_fixnum (d.tm_gmtoff);
#else
***************
*** 186,190 ****
environ=utc_env; /* time temporarily. */
tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */
! *tz_secs = mktime(&d) - t;
environ=oldenv;
--- 200,204 ----
environ=utc_env; /* time temporarily. */
tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */
! sch_tz_secs = s48_enter_fixnum (mktime(&d) - t);
environ=oldenv;
***************
*** 192,203 ****
#endif
}
!
! *sec = d.tm_sec; *min = d.tm_min; *hour = d.tm_hour;
! *mday = d.tm_mday; *month = d.tm_mon; *year = d.tm_year;
! *wday = d.tm_wday; *yday = d.tm_yday; *summer = d.tm_isdst;
! return S48_FALSE;
}
-
/* Oops
** There's a fundamental problem with the Posix mktime() function used below
--- 206,222 ----
#endif
}
! return s48_list_11 (s48_enter_fixnum (d.tm_sec),
! s48_enter_fixnum (d.tm_min),
! s48_enter_fixnum (d.tm_hour),
! s48_enter_fixnum (d.tm_mday),
! s48_enter_fixnum (d.tm_mon),
! s48_enter_fixnum (d.tm_year),
! sch_tz_name,
! sch_tz_secs,
! d.tm_isdst ? S48_TRUE : S48_FALSE,
! s48_enter_fixnum (d.tm_wday),
! s48_enter_fixnum (d.tm_yday));
}
/* Oops
** There's a fundamental problem with the Posix mktime() function used below
***************
*** 301,311 ****
** Why me? Why Unix?
*/
! s48_value format_date(const char *fmt, int sec, int min, int hour,
! int mday, int month, int year,
! s48_value tz, int summer,
! int week_day, int year_day,
! const char **ans)
{
struct tm d;
int fmt_len = strlen(fmt);
char *fmt2 = Malloc(char, 2+2*fmt_len); /* 1 extra for prefixed "x"
char.*/
--- 320,331 ----
** Why me? Why Unix?
*/
! s48_value format_date(s48_value sch_fmt, s48_value sch_sec, s48_value sch_min,
! s48_value sch_hour, s48_value sch_mday,
! s48_value sch_month, s48_value sch_year,
! s48_value tz, s48_value sch_summer,
! s48_value sch_week_day, s48_value sch_year_day)
{
struct tm d;
+ char *fmt = s48_extract_string(sch_fmt);
int fmt_len = strlen(fmt);
char *fmt2 = Malloc(char, 2+2*fmt_len); /* 1 extra for prefixed "x"
char.*/
***************
*** 316,326 ****
char *newenv[2], **oldenv = NULL;
int result_len;
!
! *ans = NULL; /* In case we error out. */
! if( !fmt2 ) return s48_enter_fixnum(errno);
! d.tm_sec = sec; d.tm_min = min; d.tm_hour = hour;
! d.tm_mday = mday; d.tm_mon = month; d.tm_year = year;
! d.tm_wday = week_day; d.tm_yday = year_day; d.tm_isdst = summer;
/* Copy fmt -> fmt2, converting ~ escape codes to % escape codes.
--- 336,352 ----
char *newenv[2], **oldenv = NULL;
int result_len;
! s48_value sch_ans = S48_UNSPECIFIC;
!
! if( !fmt2 ) s48_raise_os_error_1(errno, sch_fmt);
! d.tm_sec = s48_extract_fixnum(sch_sec);
! d.tm_min = s48_extract_fixnum(sch_min);
! d.tm_hour = s48_extract_fixnum(sch_hour);
! d.tm_mday = s48_extract_fixnum(sch_mday);
! d.tm_mon = s48_extract_fixnum(sch_month);
! d.tm_year = s48_extract_fixnum(sch_year);
! d.tm_wday = s48_extract_fixnum(sch_week_day);
! d.tm_yday = s48_extract_fixnum(sch_year_day);
! d.tm_isdst = (S48_EQ_P (sch_summer, S48_FALSE)) ? 0 : 1;
/* Copy fmt -> fmt2, converting ~ escape codes to % escape codes.
***************
*** 339,343 ****
if( ! c ) {
Free(fmt2);
! return S48_TRUE; /* % has to be followed by something. */
}
else if( c == '~' ) {
--- 365,369 ----
if( ! c ) {
Free(fmt2);
! return S48_FALSE; /* % has to be followed by something. */
}
else if( c == '~' ) {
***************
*** 384,388 ****
int err = errno;
Free(fmt);
! return s48_enter_fixnum(err);
}
}
--- 410,414 ----
int err = errno;
Free(fmt);
! s48_raise_os_error_1(errno, sch_fmt);
}
}
***************
*** 400,407 ****
target[result_len-1] = '\0'; /* Flush the trailing "x". */
#endif
! *ans = target;
Free(fmt2);
if( oldenv ) revert_env(oldenv);
! return S48_FALSE;
lose:
--- 426,433 ----
target[result_len-1] = '\0'; /* Flush the trailing "x". */
#endif
! sch_ans = s48_enter_string(target);
Free(fmt2);
if( oldenv ) revert_env(oldenv);
! return sch_ans;
lose:
***************
*** 410,414 ****
if( oldenv ) revert_env(oldenv); /* Clean up */
Free(fmt2);
! return s48_enter_fixnum(err);
}
}
--- 436,440 ----
if( oldenv ) revert_env(oldenv); /* Clean up */
Free(fmt2);
! s48_raise_os_error_1(err, sch_fmt);
}
}
***************
*** 439,440 ****
--- 465,475 ----
** localtime() & gmtime() don't error.
*/
+
+ void s48_init_time(void)
+ {
+ S48_EXPORT_FUNCTION(time_plus_ticks);
+ S48_EXPORT_FUNCTION(scheme_time);
+ S48_EXPORT_FUNCTION(date2time);
+ S48_EXPORT_FUNCTION(time2date);
+ S48_EXPORT_FUNCTION(format_date);
+ }
Index: time1.h
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/time1.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -r1.5 -r1.6
*** time1.h 2001/01/01 16:45:32 1.5
--- time1.h 2001/09/07 12:36:30 1.6
***************
*** 6,15 ****
s48_value time_plus_ticks();
! extern s48_value time2date(time_t t, s48_value zone,
! int *sec, int *min, int *hour,
! int *mday, int *month, int *year,
! const char **tz_name, int *tz_secs,
! int *summer,
! int *wday, int *yday);
s48_value date2time(s48_value sec, s48_value min, s48_value hour,
--- 6,10 ----
s48_value time_plus_ticks();
! extern s48_value time2date(s48_value t, s48_value zone);
s48_value date2time(s48_value sec, s48_value min, s48_value hour,
***************
*** 19,25 ****
! extern s48_value format_date(const char *fmt, int sec, int min, int hour,
! int mday, int month, int year,
! s48_value tz, int summer,
! int week_day, int year_day,
! const char **ans);
--- 14,21 ----
! extern s48_value format_date(s48_value fmt, s48_value sch_sec,
! s48_value sch_min, s48_value sch_hour,
! s48_value sch_mday, s48_value sch_month,
! s48_value sch_year,
! s48_value tz, s48_value sch_summer,
! s48_value sch_week_day, s48_value sch_year_day);
--- time.c DELETED ---
|