;; Macro definitions used for SAM behaviour definition
;;
-(module sam-macros
- (make-beh define-beh)
+(module sam-macros *
(import scheme
(chicken base)
(define-syntax define-beh
(syntax-rules ()
((_ name rest ...)
- (define name (make-beh rest ...))))))
+ (define name (make-beh rest ...)))))
+
+ (define-syntax make-actor-with-beh
+ (syntax-rules ()
+ ((_ rest ...)
+ (make-actor
+ (make-beh rest ...)))))
+
+ (define-syntax define-actor-with-beh
+ (syntax-rules ()
+ ((_ name rest ...)
+ (define name
+ (make-actor-with-beh rest ...))))))
+
(lambda ()
(if trace (apply log-msg args)))))
+(define (->stringrep arg)
+ (with-output-to-string
+ (lambda ()
+ (write arg))))
+
;; Behaviours
;; (See also macros defined in sam-macros.scm.)
(define (deliver-message address . message)
(let ((id (address-id address)))
- (log-trace "DELIVERING to " id ": " message)
+ (log-trace "DELIVERING to " id ": " (->stringrep message))
(let loop ((beh (hash-table-ref/default actor-table id #f)))
(if beh
(condition-case
(else
(log-msg "Warning: behaviour of actor " id " returned invalid value.")))
(o (exn)
- (log-msg "Warning: actor " id " crashed evaluating message " message)
+ (log-msg "Warning: actor " id " crashed evaluating message " (->stringrep message))
(print-error-message o)))
- (log-msg "Warning: DISCARDING message to unknown actor " id ": " message)))))
+ (log-msg "Warning: DISCARDING message to unknown actor " id ": " (->stringrep message))))))
;; Scheduler
(define local-queue (make-fifo))
(define (send-message address . message)
- (log-trace "SENDING to " address ": " message)
+ (log-trace "SENDING to " address ": " (->stringrep message))
(apply (if (address-local? address)
send-local-message
send-network-message)
;; System initialization
-(define system-beh
- (make-beh (self)
- (('shutdown) =>
- (log-msg "System actor received shutdown message.")
- (exit 0)
- 'done)
-
- (('print strings ...) =>
- (apply print strings)
- 'sleep)
-
- (('read reader) =>
- (mutex-lock! reader-queue-mutex)
- (fifo-push reader-queue reader)
- (mutex-unlock! reader-available-mutex)
- (mutex-unlock! reader-queue-mutex)
- 'sleep)))
+(define-beh system-beh
+ (self)
+ (('shutdown) =>
+ (log-msg "System actor received shutdown message.")
+ (exit 0)
+ 'done)
+
+ (('print strings ...) =>
+ (apply print strings)
+ 'sleep)
+
+ (('read reader) =>
+ (mutex-lock! reader-queue-mutex)
+ (fifo-push reader-queue reader)
+ (mutex-unlock! reader-available-mutex)
+ (mutex-unlock! reader-queue-mutex)
+ 'sleep))
(define (boot-sam)
(start-console)