The Lambda Lab
/
projects
/
sam.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
bf8a20a
)
Debugging scheduler.
author
Tim Vaughan
<plugd@thelambdalab.xyz>
Mon, 26 Apr 2021 13:26:54 +0000
(15:26 +0200)
committer
Tim Vaughan
<plugd@thelambdalab.xyz>
Mon, 26 Apr 2021 13:26:54 +0000
(15:26 +0200)
fifo.scm
patch
|
blob
|
history
sam.scm
patch
|
blob
|
history
diff --git
a/fifo.scm
b/fifo.scm
index
ab5eda0
..
14b24f1
100644
(file)
--- a/
fifo.scm
+++ b/
fifo.scm
@@
-2,6
+2,7
@@
(make-fifo
fifo-push
fifo-pop
(make-fifo
fifo-push
fifo-pop
+ fifo-empty?
fifo->list)
(import scheme
fifo->list)
(import scheme
@@
-38,6
+39,7
@@
(set! head '())
(set-cell-next! tail '()))
(cell-val old-tail)))
(set! head '())
(set-cell-next! tail '()))
(cell-val old-tail)))
+ ((empty?) (null? head))
((->list)
(let loop ((this-cell head))
(if (null? this-cell)
((->list)
(let loop ((this-cell head))
(if (null? this-cell)
@@
-51,5
+53,8
@@
(define (fifo-pop fifo)
(fifo 'pop))
(define (fifo-pop fifo)
(fifo 'pop))
+ (define (fifo-empty? fifo)
+ (fifo 'empty?))
+
(define (fifo->list fifo)
(fifo '->list)))
(define (fifo->list fifo)
(fifo '->list)))
diff --git
a/sam.scm
b/sam.scm
index
5c5ec88
..
82f3d7f
100644
(file)
--- a/
sam.scm
+++ b/
sam.scm
@@
-7,7
+7,7
@@
(chicken string)
matchable
srfi-18 ; threads
(chicken string)
matchable
srfi-18 ; threads
- srfi-69 ; hashtable
+ srfi-69 ; hash
-
table
udp
fifo)
udp
fifo)
@@
-24,6
+24,8
@@
(define (address-id address) (car address))
(define (address-machine address) (cdr address))
(define (address-id address) (car address))
(define (address-machine address) (cdr address))
+(define (make-address id machine)
+ (cons id machine))
(define (address-local? address)
(equal? (address-machine address)
(define (address-local? address)
(equal? (address-machine address)
@@
-33,8
+35,8
@@
(define (make-actor beh)
(let* ((id next-actor-id))
(define (make-actor beh)
(let* ((id next-actor-id))
- (hash-table-
put!
id beh)
- (
con
s id this-machine)))
+ (hash-table-
set! actor-table
id beh)
+ (
make-addres
s id this-machine)))
(define (deliver-message address . message)
(let ((id (address-id address)))
(define (deliver-message address . message)
(let ((id (address-id address)))
@@
-44,7
+46,7
@@
(match (apply (hash-table-ref actor-table id) (cons address message))
('done (hash-table-delete! actor-table actor))
('sleep 'do-nothing)
(match (apply (hash-table-ref actor-table id) (cons address message))
('done (hash-table-delete! actor-table actor))
('sleep 'do-nothing)
- (new-beh (hash-table-
put!
actor new-beh)))))))
+ (new-beh (hash-table-
set! actor-table
actor new-beh)))))))
;; Scheduler
;; Scheduler
@@
-77,10
+79,11
@@
(define (next-local-message)
(let ((res #f))
(define (next-local-message)
(let ((res #f))
- (mutex-lock! message-available-mutex)
+ (mutex-lock! message-available-mutex
#f #f
)
(mutex-lock! local-queue-mutex)
(set! res (fifo-pop local-queue))
(mutex-lock! local-queue-mutex)
(set! res (fifo-pop local-queue))
- (mutex-unlock! message-available-mutex)
+ (if (not (fifo-empty? local-queue))
+ (mutex-unlock! message-available-mutex))
(mutex-unlock! local-queue-mutex)
res))
(mutex-unlock! local-queue-mutex)
res))
@@
-91,6
+94,17
@@
(apply deliver-message next-addressed-message)
(loop (next-local-message))))))
(apply deliver-message next-addressed-message)
(loop (next-local-message))))))
+
+;; Testing
+
(thread-start! scheduler-thread)
(thread-start! scheduler-thread)
+(define println
+ (make-actor (lambda (self . message)
+ (apply print message)
+ 'sleep)))
+
+(print println)
+(send-message println "Hello, world!")
+
(thread-join! scheduler-thread)
(thread-join! scheduler-thread)