/[gcl]/gcl/pargcl/src/slave-listener.lsp
ViewVC logotype

Diff of /gcl/pargcl/src/slave-listener.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by gene, Fri Oct 28 23:00:29 2005 UTC revision 1.2 by gene, Mon Oct 31 08:10:45 2005 UTC
# Line 1  Line 1 
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:
# Line 39  Line 52 
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"
# Line 51  Line 64 
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
# Line 75  Line 88 
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
# Line 95  Line 108 
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.
# Line 103  Line 116 
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)
# Line 128  Line 141 
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))
# Line 167  Line 180 
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)))
# Line 225  Line 238 
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
# Line 261  Line 274 
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))

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26