~ chicken-core (chicken-5) d946386d2bdbf1b93ebb1b2a83c83bd26cc6cf84
commit d946386d2bdbf1b93ebb1b2a83c83bd26cc6cf84
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Feb 15 09:48:29 2010 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Feb 15 09:48:29 2010 +0100
applied srfi-18 patch by Joerg Wittenberger
diff --git a/chicken.h b/chicken.h
index 2f9d3273..830ab88e 100644
--- a/chicken.h
+++ b/chicken.h
@@ -2141,9 +2141,9 @@ C_path_to_executable()
pid = C_getpid();
C_sprintf(linkname, "/proc/%i/exe", pid);
- ret = C_readlink(linkname, buffer, MAX_PATH - 1);
+ ret = C_readlink(linkname, buffer, sizeof(buffer) - 1);
- if(ret == -1 || ret >= MAX_PATH - 1)
+ if(ret == -1 || ret >= sizeof(buffer) - 1)
return NULL;
for(--ret; ret > 0 && buffer[ ret ] != '/'; --ret);
@@ -2151,27 +2151,19 @@ C_path_to_executable()
buffer[ ret ] = '\0';
return buffer;
# elif defined(_WIN32) && !defined(__CYGWIN__)
- int i;
- int n = GetModuleFileName(NULL, buffer, MAX_PATH - 1);
+ int n = GetModuleFileName(NULL, buffer, sizeof(buffer) - 1);
- if(n == 0 || n >= MAX_PATH - 1)
+ if(n == 0 || n >= sizeof(buffer) - 1)
return NULL;
- for(i = n - 1; i >= 0 && buffer[ i ] != '\\'; --i);
-
- buffer[ i ] = '\0';
+ buffer[ n ] = '\0';
return buffer;
# elif defined(C_MACOSX) && defined(C_GUI)
CFBundleRef bundle = CFBundleGetMainBundle();
CFURLRef url = CFBundleCopyExecutableURL(bundle);
- int i;
- if(CFURLGetFileSystemRepresentation(url, true, buffer, MAX_PATH)) {
- for(i = C_strlen(buffer); i >= 0 && buffer[ i ] != '/') --i;
-
- buffer[ i ] = '\0';
+ if(CFURLGetFileSystemRepresentation(url, true, buffer, sizeof(buffer)))
return buffer;
- }
else return NULL;
# elif defined(__unix__) || defined(C_XXXBSD)
int i, j, k, l;
@@ -2194,7 +2186,7 @@ C_path_to_executable()
}
else {
/* try current dir */
- if(C_getcwd(buffer, MAX_PATH - 1) == NULL)
+ if(C_getcwd(buffer, sizeof(buffer) - 1) == NULL)
return NULL;
j = C_strlen(buffer);
@@ -2227,7 +2219,7 @@ C_path_to_executable()
if(C_access(buffer, F_OK)) {
dname = C_strdup(buffer);
- l = C_readlink(dname, buffer, MAX_PATH - 1);
+ l = C_readlink(dname, buffer, C_sizeof(buffer) - 1);
if(l == -1) {
/* not a symlink (we ignore other errors here */
diff --git a/srfi-18.scm b/srfi-18.scm
index f7c3324a..85f1eef4 100644
--- a/srfi-18.scm
+++ b/srfi-18.scm
@@ -58,6 +58,9 @@
(syntax-rules ()
((_ . _) #f)))
+#;(define-syntax dbg
+ (syntax-rules ()
+ ((_ x ...) (print x ...))))
;;; Helper routines:
@@ -339,6 +342,7 @@ EOF
(begin
(##sys#setislot mutex 5 #t)
(##sys#setslot t 8 (cons mutex (##sys#slot t 8)))
+ (##sys#setslot t 11 mutex)
(##sys#setslot mutex 2 t) ) ) ) )
(check)
(return #t) ]
@@ -351,12 +355,14 @@ EOF
(unless (##sys#slot ct 13) ; not unblocked by timeout
(##sys#remove-from-timeout-list ct))
(##sys#setslot ct 8 (cons mutex (##sys#slot ct 8)))
+ (##sys#setslot ct 11 #f)
(##sys#setslot mutex 2 thread)
(return #f) ))
(##sys#thread-block-for-timeout! ct limit)
(switch) ]
[else
(##sys#setslot ct 3 'sleeping)
+ (##sys#setslot ct 11 mutex)
(##sys#setslot ct 1 (lambda () (return #t)))
(switch) ] ) ) ) ) ) ) )
@@ -366,30 +372,34 @@ EOF
(let ([ct ##sys#current-thread]
[cvar (and (pair? cvar-and-to) (car cvar-and-to))]
[timeout (and (fx> (length cvar-and-to) 1) (cadr cvar-and-to))] )
- (dbg ct ": unlocking " mutex)
- (when cvar (##sys#check-structure cvar 'condition-variable 'mutex-unlock!))
+ (dbg ct ": unlocking " (mutex-name mutex))
+ (when cvar
+ (##sys#check-structure cvar 'condition-variable 'mutex-unlock!))
(##sys#call-with-current-continuation
(lambda (return)
(let ([waiting (##sys#slot mutex 3)]
- [limit (and timeout (##sys#compute-time-limit timeout))]
- [result #t] )
+ [limit (and timeout (##sys#compute-time-limit timeout))] )
(##sys#setislot mutex 4 #f)
(##sys#setislot mutex 5 #f)
(##sys#setslot ct 8 (##sys#delq mutex (##sys#slot ct 8)))
- (##sys#setslot ct 1 (lambda () (return result)))
(when cvar
(##sys#setslot cvar 2 (##sys#append (##sys#slot cvar 2) (##sys#list ct)))
- (cond [limit
+ (##sys#setslot ct 11 cvar)
+ (cond (limit
(##sys#setslot
ct 1
(lambda ()
(##sys#setslot cvar 2 (##sys#delq ct (##sys#slot cvar 2)))
- (unless (##sys#slot ct 13) ; not unblocked by timeout
- (##sys#remove-from-timeout-list ct))
- (return #f) ) )
- (##sys#thread-block-for-timeout! ct limit) ]
- [else
- (##sys#setslot ct 3 'sleeping)] ) )
+ (##sys#setslot ct 11 #f)
+ (if (##sys#slot ct 13) ; unblocked by timeout
+ (return #f)
+ (begin
+ (##sys#remove-from-timeout-list ct)
+ (return #t))) ) )
+ (##sys#thread-block-for-timeout! ct limit) )
+ (else
+ (##sys#setslot ct 1 (lambda () (return #t)))
+ (##sys#setslot ct 3 'sleeping)) ) )
(unless (null? waiting)
(let* ([wt (##sys#slot waiting 0)]
[wts (##sys#slot wt 3)] )
@@ -398,9 +408,11 @@ EOF
(when (or (eq? wts 'blocked) (eq? wts 'sleeping))
(##sys#setslot mutex 2 wt)
(##sys#setslot wt 8 (cons mutex (##sys#slot wt 8)))
+ (##sys#setslot wt 11 #f)
(when (eq? wts 'sleeping) (##sys#add-to-ready-queue wt) ) ) ) )
- (##sys#schedule) ) ) ) ) ) )
-
+ (if (eq? (##sys#slot ct 3) 'running)
+ (return #t)
+ (##sys#schedule)) ) ) ) ) ))
;;; Condition variables:
@@ -453,14 +465,22 @@ EOF
(define (thread-signal! thread exn)
(##sys#check-structure thread 'thread 'thread-signal!)
+ (dbg "signal " thread exn)
(if (eq? thread ##sys#current-thread)
(##sys#signal exn)
- (let ([old (##sys#slot thread 1)])
+ (let ([old (##sys#slot thread 1)]
+ [blocked (##sys#slot thread 11)])
+ (cond
+ ((##sys#structure? blocked 'condition-variable)
+ (##sys#setslot blocked 2 (##sys#delq thread (##sys#slot blocked 2))))
+ ((##sys#structure? blocked 'mutex)
+ (##sys#setslot blocked 3 (##sys#delq thread (##sys#slot blocked 3)))))
(##sys#setslot
thread 1
(lambda ()
(##sys#signal exn)
(old) ) )
+ (##sys#setislot thread 3 blocked)
(##sys#thread-unblock! thread) ) ) )
Trap