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 |
(in-package "MPI") |
(in-package "MPI") |
20 |
|
|
41 |
;;;This file MUST be compiled, and loaded compiled, or C fnc's not found |
;;;This file MUST be compiled, and loaded compiled, or C fnc's not found |
42 |
;;;Unfortunately, AKCL already has integrated another MPI package: |
;;;Unfortunately, AKCL already has integrated another MPI package: |
43 |
;;; Multiple Precision Integers, while here, MPI = Message Passing Interface |
;;; Multiple Precision Integers, while here, MPI = Message Passing Interface |
44 |
|
;;; In GCL 2.7.0, this seems to be replaced by gmp (GNU Multiple Prec), anyway. |
45 |
;;; Hopefully this presents no conflict or confusion, since at the |
;;; Hopefully this presents no conflict or confusion, since at the |
46 |
;;; the user level, MPI is always Message Passing Interface |
;;; the user level, MPI is always Message Passing Interface |
47 |
;;;BUG: MPI and LISP compete for same signals (interrupt, etc.) |
;;;BUG: MPI and LISP compete for same signals (interrupt, etc.) |
66 |
(return (- i 2))))) |
(return (- i 2))))) |
67 |
(eval-when (compile) |
(eval-when (compile) |
68 |
(defmacro make-fill-string (len) |
(defmacro make-fill-string (len) |
69 |
`(make-array ,len :element-type 'string-char :fill-pointer t :static t)) |
`(make-array ,len :element-type 'character :fill-pointer t :static t)) |
70 |
) |
) |
71 |
|
|
72 |
;;;character macro: $ ... ==> "..." |
;;;character macro: $ ... ==> "..." |
197 |
$ static MPI_Datatype MPI_type[3]; |
$ static MPI_Datatype MPI_type[3]; |
198 |
$ static void MPI_Init_Datatype() |
$ static void MPI_Init_Datatype() |
199 |
$ { /* must be set only after running MPI_Init; MPI_CHAR is var, not const */ |
$ { /* must be set only after running MPI_Init; MPI_CHAR is var, not const */ |
200 |
$ MPI_type[0] = MPI_CHAR /* STRING-CHAR */; |
$ MPI_type[0] = MPI_CHAR /* CHARACTER */; |
201 |
$ MPI_type[1] = MPI_INT /* FIXNUM */; |
$ MPI_type[1] = MPI_INT /* FIXNUM */; |
202 |
$/* printf("debugging: %d %d %d\n", MPI_type[0], MPI_CHAR, MPI_INT); */ |
$/* printf("debugging: %d %d %d\n", MPI_type[0], MPI_CHAR, MPI_INT); */ |
203 |
$ MPI_type[2] = MPI_FLOAT /* */;} |
$ MPI_type[2] = MPI_FLOAT /* */;} |
204 |
) |
) |
205 |
(defconstant STRING-CHAR 0) |
(defconstant CHARACTER 0) |
206 |
(defconstant FIXNUM 1) |
(defconstant FIXNUM 1) |
207 |
(defconstant FLOAT 2) |
(defconstant FLOAT 2) |
208 |
|
;;; Was called string-char in GCL 2.6.0, but character in GCL 2.7.0 |
209 |
(defconstant *type-lisp-to-mpi* |
(defconstant *type-lisp-to-mpi* |
210 |
`((string-char . ,STRING-CHAR) (fixnum . ,FIXNUM) (float . ,FLOAT))) |
`((character . ,CHARACTER) (string-char . ,CHARACTER) |
211 |
|
(fixnum . ,FIXNUM) (float . ,FLOAT))) |
212 |
(Clines |
(Clines |
213 |
$ static int MPI_Any_Source () { return MPI_ANY_SOURCE; } |
$ static int MPI_Any_Source () { return MPI_ANY_SOURCE; } |
214 |
$ static int MPI_Any_Tag () { return MPI_ANY_TAG; } |
$ static int MPI_Any_Tag () { return MPI_ANY_TAG; } |
281 |
(if (symbolp datatype) |
(if (symbolp datatype) |
282 |
(setq datatype |
(setq datatype |
283 |
(case datatype |
(case datatype |
284 |
(string-char 0) |
(character 0) |
285 |
(fixnum 1) |
(fixnum 1) |
286 |
(float 2) |
(float 2) |
287 |
(otherwise (error "unsupported datatype for MPI-Get-count")))))) |
(otherwise (error "unsupported datatype for MPI-Get-count")))))) |
367 |
&aux (datatype (array-element-type msg)) (len (length msg))) |
&aux (datatype (array-element-type msg)) (len (length msg))) |
368 |
(setq datatype (or (cdr (assoc datatype *type-lisp-to-mpi*)) |
(setq datatype (or (cdr (assoc datatype *type-lisp-to-mpi*)) |
369 |
(error "msg is array of bad elt. type: ~a" datatype))) |
(error "msg is array of bad elt. type: ~a" datatype))) |
370 |
|
(if (>= dest (MPI-World-size)) |
371 |
|
(error "destination ~a is larger than maximum rank of processes" dest)) |
372 |
|
(if (< dest 0) |
373 |
|
(error "destination ~a is negative" dest)) |
374 |
(if (not (staticp msg)) |
(if (not (staticp msg)) |
375 |
(error "MPI-Send: msg buffer not static array"))) |
(error "MPI-Send: msg buffer not static array"))) |
376 |
(MPI-Send-glue msg len datatype dest tag) |
(MPI-Send-glue msg len datatype dest tag) |
378 |
(object buf) (int count) (int datatype) (int dest) (int tag)) |
(object buf) (int count) (int datatype) (int dest) (int tag)) |
379 |
("/* printf(\"debugging: datatype: %x %x\\n\", MPI_CHAR, MPI_type[0]) */" |
("/* printf(\"debugging: datatype: %x %x\\n\", MPI_CHAR, MPI_type[0]) */" |
380 |
"return MPI_Send(buf->st.st_self, count, MPI_type[datatype], dest, tag, MPI_COMM_WORLD)") |
"return MPI_Send(buf->st.st_self, count, MPI_type[datatype], dest, tag, MPI_COMM_WORLD)") |
381 |
"args: msg (string or (array fixnum)), dest (fixnum rank), tag (fixnum); |
"args: msg (string or (array fixnum) or (array float)), dest (fixnum rank), |
382 |
tag argument is optional; |
tag (fixnum); [ tag argument is optional ] |
383 |
msg MUST be static array. See (make-array ... static t); |
msg MUST be static array. See (make-array ... :static t); |
384 |
side-effects status variable; (apropos \"MPI-Status\") for more info; |
side-effects status variable; (apropos \"MPI-Status\") for more info; |
385 |
data in all of array is sent to receiver, but if it has |
data in all of array is sent to receiver, but if it has |
386 |
a fill-pointer, only the data up to the fill-pointer is sent.") |
a fill-pointer, only the data up to the fill-pointer is sent.") |
399 |
See examples/example-mpi.lsp")) |
See examples/example-mpi.lsp")) |
400 |
(setq datatype (array-element-type buf)) |
(setq datatype (array-element-type buf)) |
401 |
(setq count (array-dimension buf 0)) |
(setq count (array-dimension buf 0)) |
402 |
|
(if (>= source (MPI-World-size)) |
403 |
|
(error "source ~a is larger than maximum rank of processes" |
404 |
|
source)) |
405 |
|
(if (< source 0) |
406 |
|
(error "source ~a is negative" source)) |
407 |
(setq datatype (or (cdr (assoc datatype *type-lisp-to-mpi*)) |
(setq datatype (or (cdr (assoc datatype *type-lisp-to-mpi*)) |
408 |
(error "buf is array of bad elt. type: ~a~% ~ |
(error "buf is array of bad elt. type: ~a~% ~ |
409 |
See *type-lisp-to-mpi* for list of acceptable types" datatype)))) |
See *type-lisp-to-mpi* for list of acceptable types" datatype)))) |
420 |
" (buf->v.v_fillp)=count;}" |
" (buf->v.v_fillp)=count;}" |
421 |
"settimer()" |
"settimer()" |
422 |
"return(buf)") |
"return(buf)") |
423 |
"args: buf (array string-char/fixnum), source (fixnum rank), |
"args: buf (array character/fixnum/float), source (fixnum rank), |
424 |
<opt: tag(fixnum)>; |
<opt: tag(fixnum)>; |
425 |
all arguments optional; |
all arguments optional; |
426 |
side-effects status variable; (apropos \"MPI-Status\") for more info; |
side-effects status variable; (apropos \"MPI-Status\") for more info; |
510 |
|
|
511 |
;;;;; THIS MUST BE LAST |
;;;;; THIS MUST BE LAST |
512 |
(do-symbols (var "MPI") (if (fboundp var) (export var "MPI"))) |
(do-symbols (var "MPI") (if (fboundp var) (export var "MPI"))) |
|
;;These shouldn't be in LISP package. But make_special was putting them there. |
|
513 |
(dolist (x '(LISP::mpi-tag-ub LISP::mpi-host LISP::mpi-io)) (export x "LISP")) |
(dolist (x '(LISP::mpi-tag-ub LISP::mpi-host LISP::mpi-io)) (export x "LISP")) |
514 |
(pushnew 'MPI *features*) |
(pushnew :MPI *features*) |
515 |
|
;;These shouldn't be in LISP package. But make_special was putting them there. |
516 |
(eval-when (compile eval) (setq *readtable* %old-readtable%)) |
(eval-when (compile eval) (setq *readtable* %old-readtable%)) |