(declare (usual-integrations))
(declare (integrate-external "stable/sim" "queue"))

;; In this communications model it takes MESSAGE-DELAY units of time for
;; a message to be transmitted.  For a message to be detected its start
;; must be clear of any overlaps with other messages.  If several (two
;; or more) messages have any overlap then the first is delivered as
;; 'COLLISION and the subsequent messages are lost.

;; If a `clean' message is transmitted during the execution of the
;; interrupt handler then it is lost.
;;

;; The comms slot is used on the receiver as follows. The scheme implicitly
;; assumes that all messages are exactly the same duration.  At
;; broadcast time, a delivery thunk is placed in the agenda to be executed 
;; message-delay units later.

;; At delivery time the status of primitive-message-event is inspected.  If it
;; is signaled, then the delivery thunk reschedules itself for delivery at a 
;; later time.  If primitive-message-event is not signaled, then the delivery
;; thunk removes the first element from the internal message queue and signals
;; primitive-message-event with it.

;; This communications model requires an agenda based scheduler
;; (e.g. simrun2)

(define message-delay 100)
(define delivery-poll-delay 10)

(define (%broadcast cont fuel store message)
  (let* ((my-id (store.index store))
	 (sim   (store.simulation store))
	 (neighbours (vector-ref (simulation.neighbours sim) my-id)))

    (define-integrable (add-message! rcv-comms-state msg)
      (queue/add! rcv-comms-state msg))

    (define-integrable (remove-message! rcv-comms-state)
      (queue/remove! rcv-comms-state))

    (define (delivery)
      ;; Use interrupt/1 as a reference/assignment cache
      (if (not (simulation.interrupt/1 sim))
	  (set-simulation.interrupt/1!
	   sim
	   (make-cache 'PRIMITIVE-MESSAGE-EVENT)))
      (let ((event-cache (simulation.interrupt/1 sim)))
	(define (transmission-ended index)
	  (let ((store
		 (processor.store
		  (vector-ref (simulation.processors sim) index))))
	    (let ((event (global-ref store event-cache))
		  (comms-state (vector-ref store store:comms)))
	      (define (try-to-dequeue)
		(if (event.signalled? event)
		    (simulation.enqueue+ sim delivery-poll-delay
					 try-to-dequeue)
		    (let ((msg (remove-message! comms-state)))
		      (notify-delivery sim my-id msg)
		      (event.signal! event msg))))
	      (try-to-dequeue))))
	
	(for-each-vector-element neighbours transmission-ended)))

    (notify-broadcast sim my-id message)

    (for-each-vector-element
     neighbours
     (lambda (index)
       (let ((store
	      (processor.store
	       (vector-ref (simulation.processors sim) index))))
	 (let ((comms-state (vector-ref store store:comms)))
	   (add-message! comms-state message)))))

    (simulation.enqueue+ sim message-delay delivery)
      
    (cont unspecific (- fuel 1) store)))

;;; See above for useful definition of initial-comms-slot-value
(define (initial-comms-slot-value index)
  index					; ignored
  (make-empty-queue 'messages))

(define (%channel-available? store)
  #t)

(define (notify-broadcast sim my-id message)
  sim ; ignored
  (pp `(broadcast ,my-id ,message)))

(define (notify-delivery sim my-id message)
  sim ; ignored
  (pp `(delivery ,my-id ,message)))