Commit 74d74888 authored by Erick Gallesio's avatar Erick Gallesio

-- defined the STk_thread_abstime_to_reltime in the

common part. Used it for pthreads and lurc.
-- Corrected thread-sleep! (pthreads)
parent 5dfc3668
2006-04-26 Erick Gallesio <eg@essi.fr>
* src/thread-*: defined the STk_thread_abstime_to_reltime in the
common part. Used it for pthreads and lurc.
* src/thread-pthreads.c: Corrected thread-sleep!
2006-04-25 Erick Gallesio <eg@essi.fr>
* src/error.c: Code Factorization of STk_error and STk_make_error
* configure.in: Changed the MYCFLAGS to STKCFLAGS in configure
[4a2dc773744d]
2006-04-21 separdau <separdau@localhost>
* src/thread-pthreads.c:
......
;;;;
;;;; threads.stk -- Threads support
;;;; thread.stk -- Threads support
;;;;
;;;; Copyright © 2006 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 26-Jan-2006 22:56 (eg)
;;;; Last file update: 14-Apr-2006 20:00 (eg)
;;;; Last file update: 25-Apr-2006 19:10 (eg)
;;;;
(define (%thread-timeout->seconds timeout)
(cond
......
/*
This file was automatically generated on Tue Apr 25 15:35:53 2006 by make-C-boot
This is a dump of the image in file /home/separdau/src/stklos-0.73-hg/lib/boot.img3
This file was automatically generated on Wed Apr 26 12:39:58 2006 by make-C-boot
This is a dump of the image in file /mnt/users/eg/Projects/STklos/lib/boot.img3
***DO NOT EDIT BY HAND***
*/
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 2-Feb-2006 21:58 (eg)
* Last file update: 16-Apr-2006 10:51 (eg)
* Last file update: 26-Apr-2006 16:20 (eg)
*/
#include <lurc.h>
......@@ -149,7 +149,7 @@ static void lock_protected_grab(void *arg){
if (ml->tm != STk_false) {
ml->timedout = 1;
// get a new timeout
rel_tv = lthr_abs_time_to_rel_time(REAL_VAL(ml->tm));
rel_tv = STk_thread_abstime_to_reltime(REAL_VAL(ml->tm));
if(rel_tv.tv_sec != 0 || rel_tv.tv_usec != 0){
ml->sig_to = lurc_timeout_signal(NULL, rel_tv);
if(ml->sig_to == NULL)
......@@ -288,7 +288,7 @@ static void unlock_protected_drop(void *arg){
if (ml->cv != STk_false) {
if (ml->tm != STk_false) {
struct timeval rel_tv = lthr_abs_time_to_rel_time(REAL_VAL(ml->tm));
struct timeval rel_tv = STk_thread_abstime_to_reltime(REAL_VAL(ml->tm));
ml->timedout = 1;
ml->sig_to = lurc_timeout_signal(NULL, rel_tv);
if(ml->sig_to == NULL)
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 23-Jan-2006 12:14 (eg)
* Last file update: 16-Apr-2006 13:16 (eg)
* Last file update: 26-Apr-2006 16:18 (eg)
*/
#include <unistd.h>
#include "stklos.h"
......@@ -38,6 +38,31 @@ void STk_error_bad_thread(SCM obj)
STk_error("bad thread ~S", obj);
}
struct timeval STk_thread_abstime_to_reltime(double abs_secs)
{
struct timeval abs, cur, rel;
abs.tv_sec = (long) abs_secs; /* trim to the second */
abs.tv_usec = (long) ((abs_secs - abs.tv_sec) * 1000000);
/* now deduce the current time */
gettimeofday(&cur, NULL);
rel.tv_sec = abs.tv_sec - cur.tv_sec;
rel.tv_usec = abs.tv_usec - cur.tv_usec;
if (rel.tv_usec < 0) {
rel.tv_sec -= 1;
rel.tv_usec += 1000000;
}
/* is it negative ? */
if (rel.tv_sec < 0) {
rel.tv_sec = 0;
rel.tv_usec = 0;
}
return rel;
}
/* ====================================================================== */
DEFINE_PRIMITIVE("current-thread", current_thread, subr0, (void))
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 4-Feb-2006 11:03 (eg)
* Last file update: 4-Feb-2006 11:04 (eg)
* Last file update: 26-Apr-2006 16:02 (eg)
*/
#ifndef _STK_THREAD_H
#define _STK_THREAD_H
......@@ -68,6 +68,7 @@ extern SCM STk_cond_thread_terminated;
#endif /* ! THREADS_NONE */
struct timeval STk_thread_abstime_to_reltime(double abs_secs);
extern SCM STk_primordial_thread;
#endif /* ! _STK_THREAD_H */
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 23-Jan-2006 12:14 (eg)
* Last file update: 16-Apr-2006 13:16 (eg)
* Last file update: 26-Apr-2006 16:21 (eg)
*/
......@@ -197,23 +197,6 @@ DEFINE_PRIMITIVE("thread-terminate!", thread_terminate, subr1, (SCM thr))
return STk_void;
}
struct timeval
lthr_abs_time_to_rel_time(double abs_secs){
struct timeval abs_tv, cur_tv, rel_tv;
abs_tv.tv_sec = (long) abs_secs; // trim to the second
abs_tv.tv_usec = (long) ((abs_secs - abs_tv.tv_sec) * 1000000);
// now deduce the current time
gettimeofday(&cur_tv, NULL);
timersub(&abs_tv, &cur_tv, &rel_tv);
// is it negative ?
if(rel_tv.tv_sec < 0 || rel_tv.tv_usec < 0){
rel_tv.tv_sec = 0;
rel_tv.tv_usec = 0;
}
// we've got it
return rel_tv;
}
struct prot_wait_t {
lurc_signal_t sig;
SCM thr;
......@@ -250,7 +233,7 @@ DEFINE_PRIMITIVE("%thread-join!", thread_join, subr2, (SCM thr, SCM tm))
if (!THREADP(thr)) STk_error_bad_thread(thr);
if (REALP(tm))
rel_tv = lthr_abs_time_to_rel_time(REAL_VAL(tm));
rel_tv = STk_thread_abstime_to_reltime(REAL_VAL(tm));
else if (!BOOLEANP(tm))
STk_error("bad timeout ~S", tm);
......@@ -305,7 +288,7 @@ DEFINE_PRIMITIVE("%thread-sleep!", thread_sleep, subr1, (SCM tm))
struct timeval rel_tv;
if (REALP(tm))
rel_tv = lthr_abs_time_to_rel_time(REAL_VAL(tm));
rel_tv = STk_thread_abstime_to_reltime(REAL_VAL(tm));
else
STk_error("bad timeout ~S", tm);
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 4-Feb-2006 11:03 (eg)
* Last file update: 4-Feb-2006 11:04 (eg)
* Last file update: 26-Apr-2006 16:21 (eg)
*/
#ifndef _STK_THREAD_LURC_H
#define _STK_THREAD_LURC_H
......@@ -39,8 +39,6 @@ struct sys_thread_obj {
#define THREAD_TERM_SIG(p) (((struct thread_obj *) (p))->sys_thread.term_sig)
#define THREAD_DEATH_SIG(p) (((struct thread_obj *) (p))->sys_thread.death_sig)
extern struct timeval lthr_abs_time_to_rel_time(double abs_secs);
extern void STk_do_make_sys_thread(SCM thr);
extern void STk_sys_thread_start(SCM thr);
extern int STk_init_sys_threads(vm_thread_t *vm);
......
/*
* thread-pthread.c -- Threads support in STklos
* thread-pthreads.c -- Threads support in STklos
*
* Copyright 2006 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
*
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 23-Jan-2006 12:14 (eg)
* Last file update: 16-Apr-2006 13:11 (eg)
* Last file update: 26-Apr-2006 16:18 (eg)
*/
......@@ -193,14 +193,17 @@ DEFINE_PRIMITIVE("%thread-join!", thread_join, subr2, (SCM thr, SCM tm))
return res;
}
DEFINE_PRIMITIVE("%thread-sleep!", thread_sleep, subr1, (SCM tm))
{
if (REALP(tm)){
long n = (1000 * REAL_VAL(tm));
// call sleep
STk_sleep(MAKE_INT(n));
struct timeval tv = STk_thread_abstime_to_reltime(REAL_VAL(tm));
struct timespec ts;
/* convert a timeval (in s) to a timesepc (in ns) */
ts.tv_sec = (time_t) tv.tv_sec;
ts.tv_nsec = (long) tv.tv_usec * 1000;
nanosleep(&ts, NULL);
}else
STk_error("bad timeout ~S", tm);
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 16-Apr-2006 12:54 (eg)
;;;; Last file update: 17-Apr-2006 00:05 (eg)
;;;; Last file update: 24-Apr-2006 10:47 (eg)
;;;;
;;;; Most of theses tests were stolen in Gauche Scheme distribution
......@@ -56,23 +56,23 @@
t))))
;; calculate fibonacchi in awful way
(define (mt-fib n)
(let ((threads (make-vector n)))
(dotimes (i n)
(vector-set! threads
i
(make-thread
(case i
((0) (lambda () 1))
((1) (lambda () 2))
(else (lambda ()
(+ (thread-join! (vector-ref threads (- i 1)))
(thread-join! (vector-ref threads (- i 2))))))))))
(dotimes (i n)
(thread-start! (vector-ref threads (- n i 1))))
(thread-join! (vector-ref threads (- n 1)))))
(test "thread-join!" 14930352 (mt-fib 35))
(define (mt-fib n)
(let ((threads (make-vector n)))
(dotimes (i n)
(vector-set! threads
i
(make-thread
(case i
((0) (lambda () 1))
((1) (lambda () 2))
(else (lambda ()
(+ (thread-join! (vector-ref threads (- i 1)))
(thread-join! (vector-ref threads (- i 2))))))))))
(dotimes (i n)
(thread-start! (vector-ref threads (- n i 1))))
(thread-join! (vector-ref threads (- n 1)))))
'(test "thread-join!" 14930352 (mt-fib 35))
;;---------------------------------------------------------------------
(test-subsection "Thread and error")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment