;;; -*- Mode: Lisp; Syntax: Common-lisp; Package: MU; Base: 10.; -*-

;;; ****************** CHANGE LOG ******************
;;; 
;;; 3/16/87 CARLF:  Created.
;;; 
;;; 3/16/87 CARLF:  Changed defmacro multiple-pvar-send.  
;;; Added (*all (*set ,notify-pvar-symbol nil!!)).
;;; 
;;; 3/24/87 Mike:  Changed defmacro multiple-pvar-send so that corresponding sources
;;; and dest must have lengths that are "=", not "<=" (the former case was very
;;; dangerous.)  Also changed the associated error message.
;;; 
;;; 9/25/87 WEG:  Converted to Release 7.  Changed the package to mu.
;;;
;;; 88DEC29 PAO:  Converted to CM-5.0
;;;
;;; 92MAR09 PAO:  Ported to Lucid.
;;;
;;; *************** END OF CHANGE LOG ***************

;;;;  WARNING WARNING WARNING

;;;;  This is user contributed software.  Neither its author nor Thinking Machines Corp.
;;;;  makes any warranties or promises as to its usefulness or correctness, nor make
;;;;  any promises with regard to support and/or bug fixes.  You are on your own!!
;;;;  
;;;;  WARNING WARNING WARNING

;;;; Author:  JP Massar.

;;;; WARNING!  This function does not behave the same way when used
;;;; in the simulator as when used on the hardware when you specify
;;;; a combiner of :max, :min or :add.  This is because the simulator
;;;; does not bundle all the pvars up into one pvar and then do the
;;;; send, but merely does each send.  It's not really clear how to
;;;; fix this in general.


;;;; In any case, the purpose of this macro is to efficiently move
;;;; a set of source pvars into a set of destination pvars (i.e.,
;;;; the same functionality as *PSET, but with multiple pvars).
;;;; It does this by using PARIS CM:MOVE instructions to bundle
;;;; all the bits into one big pvar and then do exactly 1 *PSET,
;;;; instead of having to do many of them.


;;;; [I think the intent of the following sentence is "I suggest you do not..."
;;;;    -- PAO 88DEC29]
;;;; I do not suggest you use general pvars, nor do I suggest
;;;; you use the combiners :max, :min or :add unless you know
;;;; exactly what you are doing.

;;;; Example:

;;;; (*proclaim '(type (float-pvar 23 8) srcfoo destfoo))
;;;; (*defvar srcfoo (!! 1.0))
;;;; (*defvar destfoo (!! 0.0))

;;;; (*proclaim '(type (field-pvar 8) srcbar destbar))
;;;; (*defvar srcbar (!! 4))
;;;; (*defvar destbar (!! 0))

;;;; (multiple-pvar-send :no-collisions (destfoo destbar) (srcfoo srcbar) (self-address!!))

;;;; Now destfoo contains 1.0 everywhere and destbar contains 4 everywhere.

(in-package :mu)

(defvar *issue-warning-about-suspicious-combiner* t)

(defmacro multiple-pvar-send
	  (combiner
	   (dest1 &rest other-dests)
	   (src1 &rest other-srcs)
	   address-pvar
	   &key (notify-pvar nil) (collision-mode :collisions-allowed)
	  )

  (when (and *issue-warning-about-suspicious-combiner*
	     (not (member combiner
			  '(:default :logior :logand :overwrite :no-collisions)))
	    )
    (warn "When doing multiple sends, the combiner you are using may not be doing
what you think, and may even cause an error.  All the pvars are bundled up into
one long pvar and the send is done, so that the combiner works on this long
pvar, not on each individual pvar.  You can turn this warning off by setting
*issue-warning-about-suspicious-combiner* to nil."))

  #+*LISP-SIMULATOR

  (let ((dests (cons dest1 other-dests))
	(srcs (cons src1 other-srcs))
	(address-symbol (gensym "MPS-"))
	(collision-mode-symbol (gensym))
       )

    (progn
      
      (assert (every #'symbolp dests))
      (assert (symbolp notify-pvar))
      
      `(*let ((,address-symbol ,address-pvar)
	      (,collision-mode-symbol ,collision-mode)
	     )
	 
	 ,@(mapcar
	     #'(lambda (dest src)
		 `(*pset
		    ,combiner ,src ,dest ,address-symbol
		    :notify-pvar ,notify-pvar
		    :collision-mode ,collision-mode-symbol
		   ))
	     dests
	     srcs
	    ))))

  #+*LISP-HARDWARE

  (let ((address-symbol (gensym "MPS-ADDR-"))
	(dest-list-symbol (gensym "MPS-DESTS-"))
	(src-list-symbol (gensym "MPS-SRCS-"))
	(pvar-length-sum-symbol (gensym "MPS-PLENGTH-"))
	(notify-pvar-symbol (gensym "MPS-NOTIFY-"))
	(big-field-pvar-symbol (gensym "MPS-BIG-"))
	(big-field-pvar-location-symbol (gensym "MPS-BIGL-"))
	(dests (cons dest1 other-dests))
	(srcs (cons src1 other-srcs))
       )

    (assert (every #'symbolp dests))
    (assert (symbolp notify-pvar))

    `(*let ((,address-symbol ,address-pvar))

       ;; evaluate the symbols to get a list of actual pvar structures for
       ;; both destinations and sources

       (let ((,dest-list-symbol (list ,@dests))
	     (,src-list-symbol (list ,@srcs))
	     (,pvar-length-sum-symbol 0)
	    )

	 ;; figure out the total number of bits we have to send.

	 (assert
	   (every
	     #'(lambda (src dest)
		 (incf ,pvar-length-sum-symbol (pvar-length src))
		 (= (pvar-length src) (pvar-length dest))
		 )
	     ,src-list-symbol
	     ,dest-list-symbol
	     )
	   ()
	   "Sorry, MULTIPLE-PVAR-SEND assumes identical lengths on corresponding sources and dests.  (Possible source of your trouble:  Some general pvars might have changed lengths behind your back).")

	 (*let ((,notify-pvar-symbol nil!!))
	   (declare (type boolean-pvar ,notify-pvar-symbol))
	   ;; Set ,notify-pvar-symbol to nil even in processors which are not selected.
	   (*all (*set ,notify-pvar-symbol nil!!))

	   ;; allocate some space big enough to hold all the data we want to send.

	   (let* ((,big-field-pvar-symbol
		    (allocate!!
		      (!! 0)
		      nil
		      (list 'type (list 'field-pvar ,pvar-length-sum-symbol))))
		  (,big-field-pvar-location-symbol
		   (pvar-location ,big-field-pvar-symbol))
	       )

	     ;; shove in the data,
	     ;; first source pvar going into the least significant bits.

	     (dolist (j ,src-list-symbol)
	       ( CM:u-move-1L
		 ,big-field-pvar-location-symbol (pvar-location j) (pvar-length j))
	       (incf ,big-field-pvar-location-symbol (pvar-length j))
	      )

	     (*pset
	       ,combiner
	       ,big-field-pvar-symbol
	       ,big-field-pvar-symbol
	       ,address-symbol
	       :notify-pvar ,notify-pvar-symbol
	       :collision-mode ,collision-mode
	      )
	     
	     ;; switch the selected set to those processors which received a
	     ;; message and unpack the message into destinations.
	     ;; if the user provided a notify pvar set that properly.

	     (*all
	       (when ,notify-pvar (*set ,notify-pvar nil!!))
	       (*when ,notify-pvar-symbol
		 (when ,notify-pvar (*set ,notify-pvar t!!))
		 (dolist (j (nreverse ,dest-list-symbol))
		   (decf ,big-field-pvar-location-symbol (pvar-length j))
		   (CM:u-move-1L
		     (pvar-location j)
		     ,big-field-pvar-location-symbol
		     (pvar-length j)
		    ))))

	     (*deallocate ,big-field-pvar-symbol)

	    ))))))


;I added semicolons here because COMMENT is undefined. --carlf
;(comment
;(multiple-pvar-send :max (a b c) ((!! 0) (!! 2) x) (self-address!!) :notify-pvar foo :collision-mode :many-collisions)
;)