1 |
;;;; Copyright (c) Gene Cooperman, 1994-2002 |
;;;; Copyright (c) Gene Cooperman, 1994-2005 |
2 |
;;;; Rights to use this code for any purpose are freely granted, |
|
3 |
;;;; so long as this notice remains. No warranty is given for the |
;; This file is part of ParGCL. |
4 |
;;;; correctness or suitability of this code. |
;; |
5 |
|
;; ParGCL is free software; you can redistribute it and/or modify it under |
6 |
|
;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by |
7 |
|
;; the Free Software Foundation; either version 2, or (at your option) |
8 |
|
;; any later version. |
9 |
|
;; |
10 |
|
;; ParGCL is distributed in the hope that it will be useful, but WITHOUT |
11 |
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
12 |
|
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public |
13 |
|
;; License for more details. |
14 |
|
;; |
15 |
|
;; You should have received a copy of the GNU Library General Public License |
16 |
|
;; along with ParGCL; see the file COPYING. If not, write to the Free Software |
17 |
|
;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
18 |
|
|
19 |
;;;; A remote process is set up for each one specified in your procgroup file. |
;;;; A remote process is set up for each one specified in your procgroup file. |
20 |
;;;; Available commands: |
;;;; Available commands: |
52 |
`(the fixnum (rem (MPI-status-tag) next-datatype-tag))) |
`(the fixnum (rem (MPI-status-tag) next-datatype-tag))) |
53 |
(defmacro get-last-datatype () |
(defmacro get-last-datatype () |
54 |
"interprets tag to indicate type of message; |
"interprets tag to indicate type of message; |
55 |
0 = string-char; 1 = fixnum; 2 = float; (corresponds to MPI_type[] in C)" |
0 = character; 1 = fixnum; 2 = float; (corresponds to MPI_type[] in C)" |
56 |
`(values (the fixnum (truncate (MPI-status-tag) next-datatype-tag)))) |
`(values (the fixnum (truncate (MPI-status-tag) next-datatype-tag)))) |
57 |
(defmacro get-last-count () |
(defmacro get-last-count () |
58 |
"count of message last received or last probed" |
"count of message last received or last probed" |
64 |
(MPI-status-source)) |
(MPI-status-source)) |
65 |
|
|
66 |
;;This buffer is lengthened if longer messages are encountered. |
;;This buffer is lengthened if longer messages are encountered. |
67 |
(defvar *msg-buf* nil) |
(defvar *msg-buf* nil |
68 |
"Symbol has property list with element-type of vector as property, |
"Symbol has property list with element-type of vector as property, |
69 |
and vector as value. :fill-pointer, :adjustable, and :static all set to T. |
and vector as value. :fill-pointer, :adjustable, and :static all set to T. |
70 |
:static t is essential. A pointer to its body gets passed to MPI, |
:static t is essential. A pointer to its body gets passed to MPI, |
71 |
which can call malloc, calling GCL's GBC. So, the pointer must not move. |
which can call malloc, calling GCL's GBC. So, the pointer must not move. |
72 |
(adjust-array ... :static t) must repeat :static t; bug in GCL-2.1 & lower") |
(adjust-array ... :static t) must repeat :static t; bug in GCL-2.1 & lower") |
73 |
(setf (get '*msg-buf* 'string-char) |
(setf (get '*msg-buf* 'character) |
74 |
(make-array 256 :element-type 'string-char :fill-pointer t :adjustable t |
(make-array 256 :element-type 'character :fill-pointer t :adjustable t |
75 |
:static t)) |
:static t)) |
76 |
(defun free-msg-buffer (buf) |
(defun free-msg-buffer (buf) |
77 |
"end-user-callable: frees message buffer for reuse by slave-listener |
"end-user-callable: frees message buffer for reuse by slave-listener |
88 |
:adjustable t :static t)) |
:adjustable t :static t)) |
89 |
(setf (get '*msg-buf* 'float) buf)) |
(setf (get '*msg-buf* 'float) buf)) |
90 |
(#.(array-element-type |
(#.(array-element-type |
91 |
(make-array 2 :element-type 'string-char :fill-pointer t |
(make-array 2 :element-type 'character :fill-pointer t |
92 |
:adjustable t :static t)) |
:adjustable t :static t)) |
93 |
(setf (get '*msg-buf* 'string-char) buf)) |
(setf (get '*msg-buf* 'character) buf)) |
94 |
(otherwise (error "buffer with elements of unknown type"))) |
(otherwise (error "buffer with elements of unknown type"))) |
95 |
(error "buffer is not of type vector"))) |
(error "buffer is not of type vector"))) |
96 |
(defun send-message (message &optional (dest (if (= (mpi-comm-rank) 0) 1 0)) |
(defun send-message (message &optional (dest (if (= (mpi-comm-rank) 0) 1 0)) |
97 |
(tag 0) |
(tag 0) |
98 |
&aux (string-buf (get '*msg-buf* 'string-char))) |
&aux (string-buf (get '*msg-buf* 'character))) |
99 |
"Master side: Each send-message must have a later receive-message |
"Master side: Each send-message must have a later receive-message |
100 |
Slave side: Each send-message must have a previous receive-message |
Slave side: Each send-message must have a previous receive-message |
101 |
If message is already a string, we assume this is a print representation |
If message is already a string, we assume this is a print representation |
108 |
;;NIL ==> THIS CODE NOT YET STABLE. |
;;NIL ==> THIS CODE NOT YET STABLE. |
109 |
(if (and t (vectorp message)) ; (vector fixnum/float) to be sent directly |
(if (and t (vectorp message)) ; (vector fixnum/float) to be sent directly |
110 |
(let ((x (array-element-type message))) |
(let ((x (array-element-type message))) |
111 |
(cond ((eq x 'string-char) nil); skip subtypep computation (freq. case) |
(cond ((eq x 'character) nil); skip subtypep computation (freq. case) |
112 |
((subtypep x 'fixnum) (incf tag next-datatype-tag)) |
((subtypep x 'fixnum) (incf tag next-datatype-tag)) |
113 |
((subtypep x 'float) (incf tag #.(* 2 next-datatype-tag)))))) |
((subtypep x 'float) (incf tag #.(* 2 next-datatype-tag)))))) |
114 |
(unless (or (stringp message) ; string assumed to be print rep. |
(unless (or (stringp message) ; string assumed to be print rep. |
116 |
;;NIL ==> THIS CODE NOT YET STABLE. |
;;NIL ==> THIS CODE NOT YET STABLE. |
117 |
t |
t |
118 |
(let ((x (array-element-type message))) |
(let ((x (array-element-type message))) |
119 |
(and (not (eq x 'string-char)) ; skip subtypep computation |
(and (not (eq x 'character)) ; skip subtypep computation |
120 |
(or (subtypep x 'fixnum) |
(or (subtypep x 'fixnum) |
121 |
(subtypep x 'float)))))) |
(subtypep x 'float)))))) |
122 |
(setf (fill-pointer string-buf) 0) |
(setf (fill-pointer string-buf) 0) |
141 |
(let ((msg-len (* (length message) |
(let ((msg-len (* (length message) |
142 |
(rest (assoc (array-element-type message) |
(rest (assoc (array-element-type message) |
143 |
;; Most common sizeof, but could break on some CPU'' |
;; Most common sizeof, but could break on some CPU'' |
144 |
'((string-char . 1) (fixnum . 4) (float . 4))))))) |
'((character . 1) (fixnum . 4) (float . 4))))))) |
145 |
(declare (fixnum msg-len)) |
(declare (fixnum msg-len)) |
146 |
(if (> msg-len (length string-buf)) |
(if (> msg-len (length string-buf)) |
147 |
(adjust-array string-buf msg-len :static t)) |
(adjust-array string-buf msg-len :static t)) |
180 |
(unless (and (= type-enum (get-last-datatype)) (= count (get-last-count))) |
(unless (and (= type-enum (get-last-datatype)) (= count (get-last-count))) |
181 |
(error "receive-message: MPI-Recv didn't agree with MPI-Probe")) |
(error "receive-message: MPI-Recv didn't agree with MPI-Probe")) |
182 |
;; (format t "remote ~d: ~a~%" (MPI-Status-Source) buf) |
;; (format t "remote ~d: ~a~%" (MPI-Status-Source) buf) |
183 |
(if (eq type 'string-char) |
(if (eq type 'character) |
184 |
;; slave-listener keeps (get '*msg-buf* 'string-char) |
;; slave-listener keeps (get '*msg-buf* 'character) |
185 |
(values (read-from-string buf)) |
(values (read-from-string buf)) |
186 |
(progn (setf (get '*msg-buf* type) nil) ; user keeps (get '*msg-buf* type) |
(progn (setf (get '*msg-buf* type) nil) ; user keeps (get '*msg-buf* type) |
187 |
buf))) |
buf))) |
238 |
(unless (= (MPI-Comm-rank) 0) (error "Only master can flush messages.")) |
(unless (= (MPI-Comm-rank) 0) (error "Only master can flush messages.")) |
239 |
(loop |
(loop |
240 |
(if (not (MPI-Iprobe)) (return count)) |
(if (not (MPI-Iprobe)) (return count)) |
241 |
(MPI-Recv (get '*msg-buf* 'string-char) (MPI-Any-source)) |
(MPI-Recv (get '*msg-buf* 'character) (MPI-Any-source)) |
242 |
(incf count))) |
(incf count))) |
243 |
|
|
244 |
;;shadow bye with version to kill slaves |
;;shadow bye with version to kill slaves |
274 |
(setq si::*system-banner* (si::default-system-banner)) |
(setq si::*system-banner* (si::default-system-banner)) |
275 |
(if (= (MPI-comm-rank) 0) |
(if (= (MPI-comm-rank) 0) |
276 |
(progn (format t si::*system-banner*) |
(progn (format t si::*system-banner*) |
277 |
(format t "This is ParGCL, ~s.~%~%" si::pargcl-version-string))) |
(format t "~%This is ParGCL, ~a.~%" si::pargcl-version-string) |
278 |
|
(format t "See pargcl/doc/MANUAL and pargcl/examples ~ |
279 |
|
for usage tips.~%~%"))) |
280 |
|
|
281 |
;;;For debugging: |
;;;For debugging: |
282 |
;;; (let ((args nil)) |
;;; (let ((args nil)) |