3 make-actor-with-address
16 (define trace-enabled #f) ;used for debugging
18 (define (enable-trace)
19 (set! trace-enabled #t))
21 (define (disable-trace)
22 (set! trace-enabled #f))
29 (define actor-table (make-hash-table))
31 (define (make-actor-with-address address behaviour)
33 (print "Making actor with address " address))
34 (hash-table-set! actor-table address behaviour)
37 (define next-actor-address 1)
39 (define (make-actor behaviour)
40 (make-actor-with-address next-actor-address behaviour)
41 (let ((address next-actor-address))
42 (set! next-actor-address (+ next-actor-address 1))
50 (define (dispatch-message address message)
52 (print "Dispatching message " message " to " address))
53 (let ((behaviour (hash-table-ref/default actor-table address '())))
55 (print "Warning: discarded message " message " to unknown actor " address)
56 (let ((value (apply behaviour (cons address message))))
61 (print "Deleting actor " address))
62 (hash-table-delete! actor-table address))
65 (print "Updating behaviour of " address))
66 (hash-table-set! actor-table address value)))))))
70 ;;; FIFO queue implementation
74 (define (cell val prev next)
77 (define cell-prev cadr)
78 (define cell-next caddr)
79 (define (set-cell-prev! cell prev-cell)
80 (set-car! (cdr cell) prev-cell))
81 (define (set-cell-next! cell next-cell)
82 (set-car! (cddr cell) next-cell))
88 ((empty?) (null? head))
89 ((push) (if (not (= (length args) 1))
90 (error "Wrong number of arguments to push.")
91 (if (not (null? head))
92 (let ((old-head head))
93 (set! head (cell (car args) '() old-head))
94 (set-cell-prev! old-head head))
97 (set! head (cell (car args) '() '()))
99 ((pop) (if (not (= (length args) 0))
100 (error "Wrong number of arguments to pop.")
102 (error "FIFO empty.")
103 (let ((old-tail tail))
104 (set! tail (cell-prev old-tail))
107 (set-cell-next! tail '()))
108 (cell-val old-tail)))))))))
110 (define (fifo-push fifo x)
113 (define (fifo-pop fifo)
116 (define (fifo-empty? fifo)
124 (define message-queue (make-fifo))
126 (define (next-addressed-msg)
127 (if (fifo-empty? message-queue)
129 (fifo-pop message-queue)))
131 (define (send-message actor . message)
133 (print "Queued message " message " to " actor))
134 (fifo-push message-queue (cons actor message)))
136 (define (process-next-message)
137 (let ((addressed-msg (next-addressed-msg)))
138 (if (null? addressed-msg)
140 (let ((address (car addressed-msg))
141 (message (cdr addressed-msg)))
142 (dispatch-message address message)))))
145 (unless (null? (process-next-message))
148 (define (send-and-run actor . message)
149 (apply send-message (cons actor message))
153 (set! message-queue (make-fifo))
154 (set! actor-table (make-hash-table))))