The Lambda Lab
/
projects
/
sam.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Behaviours are now tagged lists.
[sam.git]
/
sam.scm
diff --git
a/sam.scm
b/sam.scm
index
a8ea67b
..
fbe800e
100644
(file)
--- a/
sam.scm
+++ b/
sam.scm
@@
-51,15
+51,19
@@
;; (See also macros defined in sam-macros.scm.)
(define (beh-proc beh)
;; (See also macros defined in sam-macros.scm.)
(define (beh-proc beh)
- (car beh))
+ (ca
d
r beh))
(define (beh-parent beh)
(define (beh-parent beh)
- (cdr beh))
+ (c
ad
dr beh))
(define root-beh
(make-beh : #f (self)
(('ping recipient) =>
(define root-beh
(make-beh : #f (self)
(('ping recipient) =>
- (send-message recipient 'pong)
- 'sleep)))
+ (send-message recipient 'pong))))
+
+(define (beh? x)
+ (and (pair? x)
+ (not (null? x))
+ (eq? (car x) 'beh)))
;; Actors
;; Actors
@@
-111,13
+115,12
@@
(condition-case
(match (apply (beh-proc beh) (cons address message))
('done (hash-table-delete! actor-table id))
(condition-case
(match (apply (beh-proc beh) (cons address message))
('done (hash-table-delete! actor-table id))
- ('sleep 'do-nothing)
('pass
(log-trace "Passing to parent behaviour...")
(loop (beh-parent beh)))
('pass
(log-trace "Passing to parent behaviour...")
(loop (beh-parent beh)))
- ((?
procedure
? new-beh) (hash-table-set! actor-table id new-beh))
+ ((?
beh
? new-beh) (hash-table-set! actor-table id new-beh))
(else
(else
- (log-msg "Warning: behaviour of actor " id " returned invalid value.")))
+ 'do-nothing)) ; sleep is now the default
(o (exn)
(log-msg "Warning: actor " id " crashed evaluating message " (->stringrep message))
(print-error-message o)))
(o (exn)
(log-msg "Warning: actor " id " crashed evaluating message " (->stringrep message))
(print-error-message o)))
@@
-224,21
+227,20
@@
(define-beh system-beh
(self)
(define-beh system-beh
(self)
+
(('shutdown) =>
(log-msg "System actor received shutdown message.")
(exit 0)
'done)
(('print strings ...) =>
(('shutdown) =>
(log-msg "System actor received shutdown message.")
(exit 0)
'done)
(('print strings ...) =>
- (apply print strings)
- 'sleep)
+ (apply print strings))
(('read reader) =>
(mutex-lock! reader-queue-mutex)
(fifo-push reader-queue reader)
(mutex-unlock! reader-available-mutex)
(('read reader) =>
(mutex-lock! reader-queue-mutex)
(fifo-push reader-queue reader)
(mutex-unlock! reader-available-mutex)
- (mutex-unlock! reader-queue-mutex)
- 'sleep))
+ (mutex-unlock! reader-queue-mutex)))
(define (boot-sam)
(start-console)
(define (boot-sam)
(start-console)