;;;; -*- Scheme -*-
;;
;; td example for HLSIM
;;
;; David DeRoure Sep 14 1997
;; dder@martigny.ai.mit.edu
;;
;; This file should be compiled with (cps "td1") then 
;; (cbf "td1").  It uses definitions in club5d.scm.  
;; See td1s.scm for the simulation setup.  See the HLSIM 
;; documentation for further details.
;;
;; Each processor has a color between 0 and 6, which is initially set to
;; zero or chosen at random.  The processor repeatedly broadcasts its id 
;; and state, while maintaining a table of its neighbors and their states.  
;; Should a neighbor have the same state and a higher id then the current
;; processor changes state to a free color (NB this assumes that communication
;; is symmetrical).   The period between broadcasts is random to reduce 
;; repeated collisions. 

(declare (usual-integrations))

;; Every processor has an id (not the processor number, as that would
;; be cheating)

(define processor-id (random 1000000))

;; Each processor has a state from 0 to 6
;; If we start at state 0 we can see the algorithm working.
;; If we start at state (random 7) it settles down more quickly.

(define state 0) ; (random 7)

;; Each processor maintains a table of neighbors and their states.

(define neighbors (make-table))

;; The transmit loop runs while transmit? is true.  It is set to false 
;; by the receive loop when this processor has finished.

(define transmit? #T)

;; This variable is used to identify isolated processors.  If it
;; is still true after neighbor-timeout, the processor is assumed
;; to be isolated.

(define no-messages-received? #T)

(define collisions 0)

(define primitive-message-event (make-event))

;; The update-table procedure processes a new message and
;; returns the state for this processor. 

(define (receive-loop)
  (select
    (global-timeout (set! transmit? #F))
    (primitive-message-event
     => (lambda (message)
          (event.clear! primitive-message-event)
	  (set! no-messages-received? #F)
          (if (eq? message 'collision)
	      (begin (set! collisions (1+ collisions))
		     (color-me "white")
		     (wait (make-timeout-event 100))
		     (color-me state))
	      (begin (set! state 
			   (update-table neighbors message processor-id state))
		     (color-me state)))
	  (receive-loop)))
    (neighbor-timeout
     (event.clear! neighbor-timeout)
     (if no-messages-received?
	 (begin (color-me "black")
		(set! transmit? #F))))))

(define (transmit-loop)
  (wait (make-timeout-event (* 100 (1+ (random 20)))))
  (broadcast (make-message processor-id state))
  (if transmit? (transmit-loop)))
  
;; Run the loops

(define global-timeout (make-timeout-event 100000))
(define neighbor-timeout (make-timeout-event 5000))

(color-me state)

(parallel (transmit-loop) (receive-loop))

;; end of td1.scm