replaced most of the hi8/lo24-stuff by enter/extract_integer from the new FFI
This commit is contained in:
parent
03d8bfa284
commit
768fc0b2f3
|
@ -12,10 +12,6 @@
|
|||
#include <time.h>
|
||||
#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 ) {
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -147,11 +147,11 @@ 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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
@ -128,12 +128,12 @@
|
|||
(desc tz-secs) ; #f or int
|
||||
(bool summer?))
|
||||
desc ; errno, -1, or #f
|
||||
fixnum ; hi secs
|
||||
fixnum) ; lo secs
|
||||
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
|
||||
|
@ -184,7 +183,7 @@
|
|||
(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)))
|
||||
|
|
37
scsh/time1.c
37
scsh/time1.c
|
@ -4,6 +4,8 @@
|
|||
|
||||
/* 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
|
||||
|
@ -49,6 +51,8 @@
|
|||
#include "cstuff.h"
|
||||
#include "time1.h" /* Make sure the .h interface agrees with the code. */
|
||||
|
||||
#include <stdio.h> // 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,14 +124,13 @@ 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;
|
||||
|
||||
if( S48_FIXNUM_P(zone) ) { /* Offset from GMT in secs. */
|
||||
|
@ -139,6 +144,7 @@ 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. */
|
||||
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
@ -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,
|
||||
|
|
Loading…
Reference in New Issue