scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

port to new FFI

This commit is contained in:
mainzelm 2001-01-01 16:45:32 +00:00
parent f0ffc6acaf
commit d75baf1985
12 changed files with 102 additions and 248 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
scsh/aix/time_dep1.c
View File

@ -12,27 +12,13 @@
#include "scheme48.h" #include "scheme48.h"
#include "../time1.h" #include "../time1.h"
/* Sux because it's dependent on 32-bitness. */ s48_value time_plus_ticks()
#define hi8(i) (((i)>>24) & 0xff)
#define lo24(i) ((i) & 0xffffff)
#define comp8_24(hi, lo) (((hi)<<24) + (lo))
s48_value time_plus_ticks(int *hi_secs, int *lo_secs,
int *hi_ticks, int *lo_ticks)
{ {
struct timeval t; struct timeval t;
struct timezone tz; struct timezone tz;
if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno); if( gettimeofday(&t, &tz) ) s48_raise_os_error (errno);
{ long int secs = t.tv_sec; return s48_cons (s48_enter_integer (t.tv_sec),
long int ticks = t.tv_usec; s48_cons (s48_enter_integer (t.tv_usec), S48_NULL));
}
*hi_secs = hi8(secs);
*lo_secs = lo24(secs);
*hi_ticks = hi8(ticks);
*lo_ticks = lo24(ticks);
}
return S48_FALSE;
}

24
scsh/cygwin32/time_dep1.c
View File

@ -12,27 +12,13 @@
#include "scheme48.h" #include "scheme48.h"
#include "../time1.h" #include "../time1.h"
/* Sux because it's dependent on 32-bitness. */ s48_value time_plus_ticks()
#define hi8(i) (((i)>>24) & 0xff)
#define lo24(i) ((i) & 0xffffff)
#define comp8_24(hi, lo) (((hi)<<24) + (lo))
s48_value time_plus_ticks(int *hi_secs, int *lo_secs,
int *hi_ticks, int *lo_ticks)
{ {
struct timeval t; struct timeval t;
struct timezone tz; struct timezone tz;
if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno); if( gettimeofday(&t, &tz) ) s48_raise_os_error (errno);
{ long int secs = t.tv_sec; return s48_cons (s48_enter_integer (t.tv_sec),
long int ticks = t.tv_usec; s48_cons (s48_enter_integer (t.tv_usec), S48_NULL));
}
*hi_secs = hi8(secs);
*lo_secs = lo24(secs);
*hi_ticks = hi8(ticks);
*lo_ticks = lo24(ticks);
}
return S48_FALSE;
}

24
scsh/hpux/time_dep1.c
View File

@ -12,27 +12,13 @@
#include "scheme48.h" #include "scheme48.h"
#include "../time1.h" #include "../time1.h"
/* Sux because it's dependent on 32-bitness. */ s48_value time_plus_ticks()
#define hi8(i) (((i)>>24) & 0xff)
#define lo24(i) ((i) & 0xffffff)
#define comp8_24(hi, lo) (((hi)<<24) + (lo))
s48_value time_plus_ticks(int *hi_secs, int *lo_secs,
int *hi_ticks, int *lo_ticks)
{ {
struct timeval t; struct timeval t;
struct timezone tz; struct timezone tz;
if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno); if( gettimeofday(&t, &tz) ) s48_raise_os_error (errno);
{ long int secs = t.tv_sec; return s48_cons (s48_enter_integer (t.tv_sec),
long int ticks = t.tv_usec; s48_cons (s48_enter_integer (t.tv_usec), S48_NULL));
}
*hi_secs = hi8(secs);
*lo_secs = lo24(secs);
*hi_ticks = hi8(ticks);
*lo_ticks = lo24(ticks);
}
return S48_FALSE;
}

24
scsh/irix/time_dep1.c
View File

@ -12,27 +12,13 @@
#include "scheme48.h" #include "scheme48.h"
#include "../time1.h" #include "../time1.h"
/* Sux because it's dependent on 32-bitness. */ s48_value time_plus_ticks()
#define hi8(i) (((i)>>24) & 0xff)
#define lo24(i) ((i) & 0xffffff)
#define comp8_24(hi, lo) (((hi)<<24) + (lo))
s48_value time_plus_ticks(int *hi_secs, int *lo_secs,
int *hi_ticks, int *lo_ticks)
{ {
struct timeval t; struct timeval t;
struct timezone tz; struct timezone tz;
if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno); if( gettimeofday(&t, &tz) ) s48_raise_os_error (errno);
{ long int secs = t.tv_sec; return s48_cons (s48_enter_integer (t.tv_sec),
long int ticks = t.tv_usec; s48_cons (s48_enter_integer (t.tv_usec), S48_NULL));
}
*hi_secs = hi8(secs);
*lo_secs = lo24(secs);
*hi_ticks = hi8(ticks);
*lo_ticks = lo24(ticks);
}
return S48_FALSE;
}

24
scsh/linux/time_dep1.c
View File

@ -12,27 +12,13 @@
#include "scheme48.h" #include "scheme48.h"
#include "../time1.h" #include "../time1.h"
/* Sux because it's dependent on 32-bitness. */ s48_value time_plus_ticks()
#define hi8(i) (((i)>>24) & 0xff)
#define lo24(i) ((i) & 0xffffff)
#define comp8_24(hi, lo) (((hi)<<24) + (lo))
s48_value time_plus_ticks(int *hi_secs, int *lo_secs,
int *hi_ticks, int *lo_ticks)
{ {
struct timeval t; struct timeval t;
struct timezone tz; struct timezone tz;
if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno); if( gettimeofday(&t, &tz) ) s48_raise_os_error (errno);
{ long int secs = t.tv_sec; return s48_cons (s48_enter_integer (t.tv_sec),
long int ticks = t.tv_usec; s48_cons (s48_enter_integer (t.tv_usec), S48_NULL));
}
*hi_secs = hi8(secs);
*lo_secs = lo24(secs);
*hi_ticks = hi8(ticks);
*lo_ticks = lo24(ticks);
}
return S48_FALSE;
}

24
scsh/next/time_dep1.c
View File

@ -12,27 +12,13 @@
#include "scheme48.h" #include "scheme48.h"
#include "../time1.h" #include "../time1.h"
/* Sux because it's dependent on 32-bitness. */ s48_value time_plus_ticks()
#define hi8(i) (((i)>>24) & 0xff)
#define lo24(i) ((i) & 0xffffff)
#define comp8_24(hi, lo) (((hi)<<24) + (lo))
s48_value time_plus_ticks(int *hi_secs, int *lo_secs,
int *hi_ticks, int *lo_ticks)
{ {
struct timeval t; struct timeval t;
struct timezone tz; struct timezone tz;
if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno); if( gettimeofday(&t, &tz) ) s48_raise_os_error (errno);
{ long int secs = t.tv_sec; return s48_cons (s48_enter_integer (t.tv_sec),
long int ticks = t.tv_usec; s48_cons (s48_enter_integer (t.tv_usec), S48_NULL));
}
*hi_secs = hi8(secs);
*lo_secs = lo24(secs);
*hi_ticks = hi8(ticks);
*lo_ticks = lo24(ticks);
}
return S48_FALSE;
}

24
scsh/solaris/time_dep1.c
View File

@ -12,27 +12,13 @@
#include "scheme48.h" #include "scheme48.h"
#include "../time1.h" #include "../time1.h"
/* Sux because it's dependent on 32-bitness. */ s48_value time_plus_ticks()
#define hi8(i) (((i)>>24) & 0xff)
#define lo24(i) ((i) & 0xffffff)
#define comp8_24(hi, lo) (((hi)<<24) + (lo))
s48_value time_plus_ticks(int *hi_secs, int *lo_secs,
int *hi_ticks, int *lo_ticks)
{ {
struct timeval t; struct timeval t;
struct timezone tz; struct timezone tz;
if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno); if( gettimeofday(&t, &tz) ) s48_raise_os_error (errno);
{ long int secs = t.tv_sec; return s48_cons (s48_enter_integer (t.tv_sec),
long int ticks = t.tv_usec; s48_cons (s48_enter_integer (t.tv_usec), S48_NULL));
}
*hi_secs = hi8(secs);
*lo_secs = lo24(secs);
*hi_ticks = hi8(ticks);
*lo_ticks = lo24(ticks);
}
return S48_FALSE;
}

24
scsh/sunos/time_dep1.c
View File

@ -12,27 +12,13 @@
#include "scheme48.h" #include "scheme48.h"
#include "../time1.h" #include "../time1.h"
/* Sux because it's dependent on 32-bitness. */ s48_value time_plus_ticks()
#define hi8(i) (((i)>>24) & 0xff)
#define lo24(i) ((i) & 0xffffff)
#define comp8_24(hi, lo) (((hi)<<24) + (lo))
s48_value time_plus_ticks(int *hi_secs, int *lo_secs,
int *hi_ticks, int *lo_ticks)
{ {
struct timeval t; struct timeval t;
struct timezone tz; struct timezone tz;
if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno); if( gettimeofday(&t, &tz) ) s48_raise_os_error (errno);
{ long int secs = t.tv_sec; return s48_cons (s48_enter_integer (t.tv_sec),
long int ticks = t.tv_usec; s48_cons (s48_enter_integer (t.tv_usec), S48_NULL));
}
*hi_secs = hi8(secs);
*lo_secs = lo24(secs);
*hi_ticks = hi8(ticks);
*lo_ticks = lo24(ticks);
}
return S48_FALSE;
}

73
scsh/time.scm
View File

@ -95,64 +95,39 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; TICKS/SEC is defined in OS-dependent code. ; TICKS/SEC is defined in OS-dependent code.
;;; JMG: not yet converted to the new FFI since it is OS-dependent ; C fun is OS-dependent
(define-foreign %time+ticks/errno (time_plus_ticks) ; C fun is OS-dependent ; TODO: all C files are identical, so move it to time1.c
desc ; errno or #f ; returns (list secs ticks)
fixnum ; hi secs (define-stubless-foreign %time+ticks () "time_plus_ticks")
fixnum ; lo secs
fixnum ; hi ticks
fixnum) ; lo ticks
(define (time+ticks) (define (time+ticks)
(receive (err hi-secs lo-secs hi-ticks lo-ticks) (%time+ticks/errno) (apply values (%time+ticks)))
(if err (errno-error err time+ticks)
(values (compose-8/24 hi-secs lo-secs)
(compose-8/24 hi-ticks lo-ticks)))))
(define (time+ticks->time secs ticks) (define (time+ticks->time secs ticks)
(+ secs (/ ticks (ticks/sec)))) (+ secs (/ ticks (ticks/sec))))
(define-foreign %time/errno (scheme_time) (define-stubless-foreign %time () "scheme_time")
desc ; errno or #f
time_t) ; secs
(define-foreign %date->time/error (date2time (fixnum sec)
(fixnum min)
(fixnum hour)
(fixnum month-day)
(fixnum month)
(fixnum year)
(desc tz-name) ; #f or string
(desc tz-secs) ; #f or int
(bool summer?))
desc ; errno, -1, or #f
time_t) ; secs
(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] (define (time . args) ; optional arg [date]
(let lp () (if (pair? args)
(receive (err secs) (if (null? (cdr args))
(if (pair? args) (let ((date (check-arg date? (car args) time)))
(if (null? (cdr args)) (%date->time (date:seconds date)
(let ((date (check-arg date? (car args) time))) (date:minute date)
(%date->time/error (date:seconds date) (date:hour date)
(date:minute date) (date:month-day date)
(date:hour date) (date:month date)
(date:month-day date) (date:year date)
(date:month date) (date:tz-name date) ; #f or string
(date:year date) (date:tz-secs date) ; #f or int
(date:tz-name date) ; #f or string (date:summer? date)))
(date:tz-secs date) ; #f or int (error "Too many arguments to TIME procedure" args))
(date:summer? date))) (%time))) ; Fast path for (time).
(error "Too many arguments to TIME procedure" args))
(%time/errno)) ; Fast path for (time).
(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.
;;; Date ;;; Date

46
scsh/time1.c
View File

@ -109,15 +109,14 @@ static void revert_env(char **old_env)
s48_value scheme_time(time_t *secs) s48_value scheme_time()
{ {
time_t t; time_t t;
errno = 0; errno = 0;
t = time(NULL); t = time(NULL);
if( t == -1 && errno ) return s48_enter_fixnum(errno); if( t == -1 && errno ) s48_raise_os_error (errno);
*secs = t; return s48_enter_integer (t);
return S48_FALSE; }
}
/* Zone: /* Zone:
** #f Local time ** #f Local time
@ -212,18 +211,22 @@ s48_value time2date(time_t t, s48_value zone,
** Who designed this interface? ** Who designed this interface?
*/ */
s48_value date2time(int sec, int min, int hour, s48_value date2time(s48_value sec, s48_value min, s48_value hour,
int mday, int month, int year, s48_value mday, s48_value month, s48_value year,
s48_value tz_name, s48_value tz_secs, s48_value tz_name, s48_value tz_secs,
int summer, s48_value summer)
time_t *secs)
{ {
time_t t; time_t t;
struct tm d; struct tm d;
d.tm_sec = sec; d.tm_min = min; d.tm_hour = hour; d.tm_sec = s48_extract_fixnum (sec);
d.tm_mday = mday; d.tm_mon = month; d.tm_year = year; d.tm_min = s48_extract_fixnum (min);
d.tm_wday = 0; d.tm_yday = 0; d.tm_isdst = summer; d.tm_hour = s48_extract_fixnum (hour);
d.tm_mday = s48_extract_fixnum (mday);
d.tm_mon = s48_extract_fixnum (month);
d.tm_year = s48_extract_fixnum (year);
d.tm_wday = 0; d.tm_yday = 0;
d.tm_isdst = (summer == S48_FALSE) ? 0 : 1;
if( S48_FIXNUM_P(tz_secs) ) { /* Offset from GMT in seconds. */ if( S48_FIXNUM_P(tz_secs) ) { /* Offset from GMT in seconds. */
char **oldenv = environ; /* Set TZ to UTC */ char **oldenv = environ; /* Set TZ to UTC */
@ -233,7 +236,9 @@ s48_value date2time(int sec, int min, int hour,
errno = 0; errno = 0;
t = mktime(&d); t = mktime(&d);
/* t == -1 => you probably have an error. */ /* t == -1 => you probably have an error. */
if( t == -1 ) return s48_enter_fixnum(errno ? errno : -1); if ((t == -1) && (errno != 0))
// Sorry, we only have a version with 5 arguments...
s48_raise_os_error_5 (errno, sec, min, hour, mday, month);
t -= s48_extract_fixnum(tz_secs); t -= s48_extract_fixnum(tz_secs);
environ = oldenv; environ = oldenv;
} }
@ -245,7 +250,8 @@ s48_value date2time(int sec, int min, int hour,
tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */ tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */
errno = 0; errno = 0;
t = mktime(&d); t = mktime(&d);
if( t == -1 ) return s48_enter_fixnum(errno ? errno : -1); if ((t == -1) && (errno != 0))
s48_raise_os_error_5 (errno, sec, min, hour, mday, month);
revert_env(oldenv); revert_env(oldenv);
} }
@ -253,13 +259,13 @@ s48_value date2time(int sec, int min, int hour,
tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */ tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */
errno = 0; errno = 0;
t = mktime(&d); t = mktime(&d);
if( t == -1) return s48_enter_fixnum(errno ? errno : -1); if ((t == -1) && (errno != 0))
} s48_raise_os_error_5 (errno, sec, min, hour, mday, month);
*secs = t;
return S48_FALSE;
} }
return s48_enter_integer(t);
}
/* WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING /* WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING
** **

15
scsh/time1.h
View File

@ -1,10 +1,9 @@
#include <sys/types.h> #include <sys/types.h>
#include <time.h> #include <time.h>
extern s48_value scheme_time(time_t *secs); s48_value scheme_time();
extern s48_value time_plus_ticks(int *hi_secs, int *lo_secs, s48_value time_plus_ticks();
int *hi_ticks, int *lo_ticks);
extern s48_value time2date(time_t t, s48_value zone, extern s48_value time2date(time_t t, s48_value zone,
int *sec, int *min, int *hour, int *sec, int *min, int *hour,
@ -13,11 +12,11 @@ extern s48_value time2date(time_t t, s48_value zone,
int *summer, int *summer,
int *wday, int *yday); int *wday, int *yday);
extern s48_value date2time(int sec, int min, int hour, s48_value date2time(s48_value sec, s48_value min, s48_value hour,
int mday, int month, int year, s48_value mday, s48_value month, s48_value year,
s48_value tz_name, s48_value tz_secs, s48_value tz_name, s48_value tz_secs,
int summer, s48_value summer);
time_t *secs);
extern s48_value format_date(const char *fmt, int sec, int min, int hour, extern s48_value format_date(const char *fmt, int sec, int min, int hour,
int mday, int month, int year, int mday, int month, int year,

24
scsh/ultrix/time_dep1.c
View File

@ -12,27 +12,13 @@
#include "scheme48.h" #include "scheme48.h"
#include "../time1.h" #include "../time1.h"
/* Sux because it's dependent on 32-bitness. */ s48_value time_plus_ticks()
#define hi8(i) (((i)>>24) & 0xff)
#define lo24(i) ((i) & 0xffffff)
#define comp8_24(hi, lo) (((hi)<<24) + (lo))
s48_value time_plus_ticks(int *hi_secs, int *lo_secs,
int *hi_ticks, int *lo_ticks)
{ {
struct timeval t; struct timeval t;
struct timezone tz; struct timezone tz;
if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno); if( gettimeofday(&t, &tz) ) s48_raise_os_error (errno);
{ long int secs = t.tv_sec; return s48_cons (s48_enter_integer (t.tv_sec),
long int ticks = t.tv_usec; s48_cons (s48_enter_integer (t.tv_usec), S48_NULL));
}
*hi_secs = hi8(secs);
*lo_secs = lo24(secs);
*hi_ticks = hi8(ticks);
*lo_ticks = lo24(ticks);
}
return S48_FALSE;
}