From 768fc0b2f3c6d1c1cfa3c90b9aa8521ef2368414 Mon Sep 17 00:00:00 2001 From: marting Date: Tue, 28 Sep 1999 23:48:36 +0000 Subject: [PATCH] replaced most of the hi8/lo24-stuff by enter/extract_integer from the new FFI --- scsh/sleep1.c | 7 +------ scsh/syscalls.scm | 17 +++++++-------- scsh/syscalls1.c | 8 +++---- scsh/syscalls1.h | 2 +- scsh/time.scm | 27 +++++++++++------------- scsh/time1.c | 53 +++++++++++++++++++++++++++-------------------- scsh/time1.h | 6 +++--- 7 files changed, 59 insertions(+), 61 deletions(-) diff --git a/scsh/sleep1.c b/scsh/sleep1.c index 3315386..2e21bf3 100644 --- a/scsh/sleep1.c +++ b/scsh/sleep1.c @@ -12,10 +12,6 @@ #include #include "../c/scheme48.h" -/* Sux because it's dependent on 32-bitness. */ -#define hi8(i) (((i)>>24) & 0xff) -#define lo24(i) ((i) & 0xffffff) -#define comp8_24(hi, lo) (((hi)<<24) + (lo)) /* Sleep until time hisecs/losecs (return #t), ** or until interrupted (return #f). @@ -28,9 +24,8 @@ ** and is pretty straightforward. */ -s48_value sleep_until(int hisecs, int losecs) +s48_value sleep_until(time_t when) { - time_t when = comp8_24(hisecs, losecs); time_t now = time(0); int delta = when - now; if( delta > 0 ) { diff --git a/scsh/syscalls.scm b/scsh/syscalls.scm index 6868227..9a7a983 100644 --- a/scsh/syscalls.scm +++ b/scsh/syscalls.scm @@ -399,8 +399,8 @@ (define-foreign %utime/errno (scm_utime (string path) - (integer ac_hi) (integer ac_lo) - (integer m_hi) (integer m_lo)) + (time_t ac) + (time_t m)) (to-scheme integer errno_or_false)) (define-foreign %utime-now/errno (scm_utime_now (string path)) @@ -416,8 +416,8 @@ (error "Too many arguments to set-file-times/errno" (cons path maybe-times)) (real->exact-integer (cadr maybe-times))))) - (%utime/errno path (hi8 access-time) (lo24 access-time) - (hi8 mod-time) (lo24 mod-time))) + (%utime/errno path access-time + mod-time )) (%utime-now/errno path))) (define-errno-syscall (set-file-times . args) set-file-times/errno) @@ -1016,13 +1016,12 @@ (define (sleep-until when) (let* ((when (floor when)) ; Painful to do real->int in Scheme. - (when (if (exact? when) when (inexact->exact when))) - (h (hi8 when)) (l (lo24 when))) + (when (if (exact? when) when (inexact->exact when)))) (let lp () - (or (%sleep-until h l) (lp))))) + (or (%sleep-until when) (lp))))) -(define-foreign %sleep-until (sleep_until (fixnum hi) - (fixnum lo)) +;;; JMG: I don't know whether time_t or long is correct... +(define-foreign %sleep-until (sleep_until (time_t secs)) desc) (define-foreign %gethostname (scm_gethostname) diff --git a/scsh/syscalls1.c b/scsh/syscalls1.c index 8d47a58..de9637e 100644 --- a/scsh/syscalls1.c +++ b/scsh/syscalls1.c @@ -147,13 +147,13 @@ char const *scm_readlink(const char *path) ** Complicated by need to pass real 32-bit quantities. */ -int scm_utime(char const *path, int ac_hi, int ac_lo, int mod_hi, int mod_lo) +int scm_utime(char const *path, time_t ac, time_t mod) { struct utimbuf t; - t.actime = comp8_24(ac_hi, ac_lo); - t.modtime = comp8_24(mod_hi, mod_lo); + t.actime = ac; + t.modtime = mod; return utime(path, &t); - } +} int scm_utime_now(char const *path) {return utime(path, 0);} diff --git a/scsh/syscalls1.h b/scsh/syscalls1.h index 87893c6..405d972 100644 --- a/scsh/syscalls1.h +++ b/scsh/syscalls1.h @@ -8,7 +8,7 @@ int scheme_pipe(int *r, int *w); char const *scm_readlink(const char *path); -int scm_utime(char const *path, int ac_hi, int ac_lo, int mod_hi, int mod_lo); +int scm_utime(char const *path, time_t ac, time_t mod); int scm_utime_now(char const *path); diff --git a/scsh/time.scm b/scsh/time.scm index 5c16b23..e85d427 100644 --- a/scsh/time.scm +++ b/scsh/time.scm @@ -95,7 +95,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; TICKS/SEC is defined in OS-dependent code. - +;;; JMG: not yet converted to the new FFI since it is OS-dependent (define-foreign %time+ticks/errno (time_plus_ticks) ; C fun is OS-dependent desc ; errno or #f fixnum ; hi secs @@ -114,8 +114,8 @@ (define-foreign %time/errno (scheme_time) desc ; errno or #f - fixnum ; hi secs - fixnum) ; lo secs + time_t) ; secs + (define-foreign %date->time/error (date2time (fixnum sec) @@ -127,13 +127,13 @@ (desc tz-name) ; #f or string (desc tz-secs) ; #f or int (bool summer?)) - desc ; errno, -1, or #f - fixnum ; hi secs - fixnum) ; lo secs + desc ; errno, -1, or #f + time_t) ; secs + (define (time . args) ; optional arg [date] (let lp () - (receive (err hi-secs lo-secs) + (receive (err secs) (if (pair? args) (if (null? (cdr args)) (let ((date (check-arg date? (car args) time))) @@ -149,7 +149,7 @@ (error "Too many arguments to TIME procedure" args)) (%time/errno)) ; Fast path for (time). - (cond ((not err) (compose-8/24 hi-secs lo-secs)) ; Win. + (cond ((not err) secs) ; Win. ((= errno/intr err) (lp)) ; Retry. ((= -1 err) (error "Error converting date to time." args)) ; Lose. (else (apply errno-error err time args)))))) ; Lose. @@ -157,8 +157,7 @@ ;;; Date ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-foreign %time->date (time2date (fixnum time-hi) - (fixnum time-lo) +(define-foreign %time->date (time2date (time_t time-hi) (desc zone)) desc ; errno or #f fixnum ; seconds @@ -181,10 +180,10 @@ (zone (check-arg time-zone? (and (pair? args) (:optional (cdr args) #f)) date))) - (let lp () + (let lp () (receive (err seconds minute hour month-day month year tz-name tz-secs summer? week-day year-day) - (%time->date (hi8 time) (lo24 time) zone) + (%time->date time zone) (cond ((not err) (make-%date seconds minute hour month-day month year @@ -261,10 +260,8 @@ ; (if err (errno-error err time-zone summer? tz) ; zone)))))) -;;; 8/24 bit signed integer splitting and recombination. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (hi8 n) (bitwise-and (arithmetic-shift n -24) #xff)) -(define (lo24 n) (bitwise-and n #xffffff)) + (define (compose-8/24 hi-8 lo-24) (let ((val (+ (arithmetic-shift hi-8 24) lo-24))) diff --git a/scsh/time1.c b/scsh/time1.c index a61ee47..bbf293d 100644 --- a/scsh/time1.c +++ b/scsh/time1.c @@ -3,7 +3,9 @@ */ /* WARNING: THIS FILE HAS CODE THAT DEPENDS ON 32-BIT ARCHITECTURES. -** This code is so marked. +** 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 @@ -49,6 +51,8 @@ #include "cstuff.h" #include "time1.h" /* Make sure the .h interface agrees with the code. */ +#include // JMG debug + extern char **environ; /* To work in the UTC time zone, do "environ = utc_env;". */ @@ -74,11 +78,16 @@ static char **make_newenv(s48_value zone, char *newenv[2]) int zonelen = S48_STRING_LENGTH(zone); char **oldenv = environ, *tz = Malloc(char, 4+zonelen); - s48_value temp; + + char * extracted_zone = s48_extract_string(zone); + + // s48_value temp; if( !tz ) return NULL; strcpy(tz, "TZ="); - temp = S48_UNSAFE_STRING_REF(zone,0); //JMG - strncpy(tz+3, &temp, zonelen); + + // temp = S48_STRING_REF(zone,0); //JMG + // strncpy(tz+3, &temp, zonelen); + strncpy(tz+3, extracted_zone, zonelen); tz[zonelen+3] = '\0'; newenv[0] = tz; newenv[1] = NULL; @@ -97,19 +106,16 @@ static void revert_env(char **old_env) /*****************************************************************************/ -/* Sux because it's dependent on 32-bitness. */ -#define hi8(i) (((i)>>24) & 0xff) -#define lo24(i) ((i) & 0xffffff) -#define comp8_24(hi, lo) (((hi)<<24) + (lo)) -s48_value scheme_time(int *hi_secs, int *lo_secs) + + +s48_value scheme_time(time_t *secs) { time_t t; errno = 0; t = time(NULL); if( t == -1 && errno ) return s48_enter_fixnum(errno); - *hi_secs = hi8(t); - *lo_secs = lo24(t); + *secs = t; return S48_FALSE; } @@ -118,15 +124,14 @@ s48_value scheme_time(int *hi_secs, int *lo_secs) ** int Offset from GMT in seconds. ** string Time zone understood by OS. */ -s48_value time2date(int hi_secs, int lo_secs, s48_value zone, +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) { - time_t t = comp8_24(hi_secs, lo_secs); - struct tm d; + struct tm d; if( S48_FIXNUM_P(zone) ) { /* Offset from GMT in secs. */ int offset = s48_extract_fixnum(zone); @@ -139,12 +144,13 @@ s48_value time2date(int hi_secs, int lo_secs, s48_value zone, 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. */ - } + + oldenv = make_newenv(zone, newenv); /* Install new TZ. */ + if( !oldenv ) return s48_enter_fixnum(errno); /* Error installing. */ + d = *localtime(&t); /* Do it. */ + } else /* Local time */ - d = *localtime(&t); + d = *localtime(&t); /* This little chunk of code copies the calculated time zone into ** a malloc'd buffer and assigns it to *tz_name. It's a little @@ -167,7 +173,7 @@ s48_value time2date(int hi_secs, int lo_secs, s48_value zone, if( newzone ) strcpy(newzone, zone); else error = errno; - if( oldenv ) revert_env(oldenv); /* Revert TZ & env. */ + if( oldenv ) revert_env(oldenv); /* Revert TZ & env. */ if( !newzone ) return s48_enter_fixnum(error); } @@ -175,12 +181,14 @@ s48_value time2date(int hi_secs, int lo_secs, s48_value zone, /* Calculate the time-zone offset in seconds from UTC. */ #ifdef HAVE_GMTOFF *tz_secs = d.tm_gmtoff; + #else { char **oldenv = environ; /* Set TZ to UTC */ environ=utc_env; /* time temporarily. */ tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */ *tz_secs = mktime(&d) - t; environ=oldenv; + } #endif } @@ -208,7 +216,7 @@ s48_value date2time(int sec, int min, int hour, int mday, int month, int year, s48_value tz_name, s48_value tz_secs, int summer, - int *hi_secs, int *lo_secs) + time_t *secs) { time_t t; struct tm d; @@ -248,8 +256,7 @@ s48_value date2time(int sec, int min, int hour, if( t == -1) return s48_enter_fixnum(errno ? errno : -1); } - *hi_secs = hi8(t); - *lo_secs = lo24(t); + *secs = t; return S48_FALSE; } diff --git a/scsh/time1.h b/scsh/time1.h index a3338ea..9b5ab5b 100644 --- a/scsh/time1.h +++ b/scsh/time1.h @@ -1,9 +1,9 @@ -extern s48_value scheme_time(int *hi_secs, int *lo_secs); +extern s48_value scheme_time(time_t *secs); extern s48_value time_plus_ticks(int *hi_secs, int *lo_secs, int *hi_ticks, int *lo_ticks); -extern s48_value time2date(int hi_secs, int lo_secs, s48_value zone, +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, @@ -14,7 +14,7 @@ extern s48_value date2time(int sec, int min, int hour, int mday, int month, int year, s48_value tz_name, s48_value tz_secs, int summer, - int *hi_secs, int *lo_secs); + time_t *secs); extern s48_value format_date(const char *fmt, int sec, int min, int hour, int mday, int month, int year,