mpi.lisp (6248B)
1 (defpackage :mpi 2 (:use :common-lisp :sb-alien :serial) 3 (:export :mpi-comm 4 :mpi-datatype 5 :mpi-request 6 :mpi-status 7 :*mpi-comm-world* 8 :*mpi-byte* 9 :*mpi-status-ignore* 10 :+mpi-any-source+ 11 :alien-mpi-init 12 :alien-mpi-finalize 13 :alien-mpi-comm-size 14 :alien-mpi-comm-rank 15 :alien-mpi-get-processor-name 16 :alien-mpi-send 17 :alien-mpi-ssend 18 :alien-mpi-issend 19 :alien-mpi-wait 20 :alien-mpi-recv 21 :alien-mpi-probe 22 :alien-mpi-get-count 23 :mpi-init 24 :mpi-finalize 25 :mpi-comm-size 26 :mpi-comm-rank 27 :mpi-get-processor-name 28 :mpi-send-object 29 :mpi-issend-object 30 :mpi-wait 31 :mpi-receive-object 32 :mpi-wtime)) 33 34 (in-package :mpi) 35 36 #+openmpi 37 (progn 38 (define-alien-type nil (struct ompi-communicator-t)) 39 (define-alien-type nil (struct ompi-datatype-t)) 40 (define-alien-type nil (struct ompi-request-t)) 41 (define-alien-type nil (struct ompi-status-t 42 (mpi-source int) 43 (mpi-tag int) 44 (mpi-error int) 45 (-count int) 46 (-cancelled int))) 47 48 (define-alien-type mpi-comm (* (struct ompi-communicator-t))) 49 (define-alien-type mpi-datatype (* (struct ompi-datatype-t))) 50 (define-alien-type mpi-request (* (struct ompi-request-t))) 51 (define-alien-type mpi-status (struct ompi-status-t)) 52 53 (define-alien-variable "ompi_mpi_comm_world" (struct ompi-communicator-t)) 54 (define-alien-variable "ompi_mpi_byte" (struct ompi-datatype-t)) 55 56 (defparameter *mpi-comm-world* (addr ompi-mpi-comm-world)) 57 (defparameter *mpi-byte* (addr ompi-mpi-byte)) 58 (defparameter *mpi-status-ignore* (sb-sys:int-sap 0)) 59 (defconstant +mpi-any-source+ -1)) 60 61 #+mpich 62 (progn 63 (define-alien-type mpi-comm int) 64 (define-alien-type mpi-datatype int) 65 (define-alien-type mpi-request int) 66 (define-alien-type mpi-status (struct mpi-status 67 (count int) 68 (cancelled int) 69 (mpi-source int) 70 (mpi-tag int) 71 (mpi-error int))) 72 73 (defparameter *mpi-comm-world* #x44000000) 74 (defparameter *mpi-byte* #x4c00010d) 75 (defparameter *mpi-status-ignore* (sb-sys:int-sap 1)) 76 (defconstant +mpi-any-source+ -2)) 77 78 (declaim (inline alien-mpi-init)) 79 (define-alien-routine ("MPI_Init" alien-mpi-init) int 80 (argc (* int)) 81 (argv (* (array c-string)))) 82 83 (declaim (inline alien-mpi-finalize)) 84 (define-alien-routine ("MPI_Finalize" alien-mpi-finalize) int) 85 86 (declaim (inline alien-mpi-comm-size)) 87 (define-alien-routine ("MPI_Comm_size" alien-mpi-comm-size) int 88 (comm mpi-comm) 89 (size (* int))) 90 91 (declaim (inline alien-mpi-comm-rank)) 92 (define-alien-routine ("MPI_Comm_rank" alien-mpi-comm-rank) int 93 (comm mpi-comm) 94 (rank (* int))) 95 96 (defconstant +mpi-max-processor-name+ 256) 97 98 (declaim (inline alien-mpi-get-processor-name)) 99 (define-alien-routine ("MPI_Get_processor_name" alien-mpi-get-processor-name) int 100 (name (* char)) 101 (resultlen (* int))) 102 103 (declaim (inline alien-mpi-send)) 104 (define-alien-routine ("MPI_Send" alien-mpi-send) int 105 (buf (* t)) 106 (count int) 107 (datatype mpi-datatype) 108 (dest int) 109 (tag int) 110 (comm mpi-comm)) 111 112 (declaim (inline alien-mpi-ssend)) 113 (define-alien-routine ("MPI_Ssend" alien-mpi-ssend) int 114 (buf (* t)) 115 (count int) 116 (datatype mpi-datatype) 117 (dest int) 118 (tag int) 119 (comm mpi-comm)) 120 121 (declaim (inline alien-mpi-issend)) 122 (define-alien-routine ("MPI_Issend" alien-mpi-issend) int 123 (buf (* t)) 124 (count int) 125 (datatype mpi-datatype) 126 (dest int) 127 (tag int) 128 (comm mpi-comm) 129 (request (* mpi-request))) 130 131 (declaim (inline alien-mpi-wait)) 132 (define-alien-routine ("MPI_Wait" alien-mpi-wait) int 133 (request (* mpi-request)) 134 (status (* mpi-status))) 135 136 (declaim (inline alien-mpi-recv)) 137 (define-alien-routine ("MPI_Recv" alien-mpi-recv) int 138 (buf (* t)) 139 (count int) 140 (datatype mpi-datatype) 141 (source int) 142 (tag int) 143 (comm mpi-comm) 144 (status (* mpi-status))) 145 146 (declaim (inline alien-mpi-probe)) 147 (define-alien-routine ("MPI_Probe" alien-mpi-probe) int 148 (source int) 149 (tag int) 150 (comm mpi-comm) 151 (status (* mpi-status))) 152 153 (declaim (inline alien-mpi-get-count)) 154 (define-alien-routine ("MPI_Get_count" alien-mpi-get-count) int 155 (status (* mpi-status)) 156 (datatype mpi-datatype) 157 (count (* int))) 158 159 (declaim (inline alien-mpi-wtime)) 160 (define-alien-routine ("MPI_Wtime" alien-mpi-wtime) double) 161 162 (defun mpi-init () 163 (alien-mpi-init nil nil)) 164 165 (defun mpi-finalize () 166 (alien-mpi-finalize)) 167 168 (defun mpi-comm-size (comm) 169 (with-alien ((size int)) 170 (alien-mpi-comm-size comm (addr size)) 171 size)) 172 173 (defun mpi-comm-rank (comm) 174 (with-alien ((rank int)) 175 (alien-mpi-comm-rank comm (addr rank)) 176 rank)) 177 178 (defun mpi-get-processor-name () 179 (with-alien ((name (* char) (make-alien char +mpi-max-processor-name+)) 180 (resultlen int)) 181 (prog2 182 (alien-mpi-get-processor-name name (addr resultlen)) 183 (cast name c-string) 184 (free-alien name)))) 185 186 (defun mpi-send-object (object dest) 187 (let ((buf (serialize object))) 188 (sb-sys:with-pinned-objects 189 ((sb-ext:array-storage-vector buf)) 190 (alien-mpi-send 191 (sap-alien 192 (sb-sys:vector-sap (sb-ext:array-storage-vector buf)) 193 (* char)) 194 (length buf) 195 *mpi-byte* 196 dest 197 0 198 *mpi-comm-world*)))) 199 200 ;; external without-gcing 201 202 (defun mpi-issend-object (object dest) 203 (let ((buf (serialize object)) 204 (request (make-alien mpi-request))) 205 (alien-mpi-issend 206 (sap-alien 207 (sb-sys:vector-sap (sb-ext:array-storage-vector buf)) 208 (* char)) 209 (length buf) 210 *mpi-byte* 211 dest 212 0 213 *mpi-comm-world* 214 request) 215 request)) 216 217 (defun mpi-wait (request) 218 (alien-mpi-wait 219 request 220 *mpi-status-ignore*) 221 (free-alien request)) 222 223 (defun mpi-receive-object (source) 224 (with-alien ((status mpi-status) 225 (count int)) 226 (alien-mpi-probe source 0 *mpi-comm-world* (addr status)) 227 (alien-mpi-get-count (addr status) *mpi-byte* (addr count)) 228 (let ((buf (make-array count :element-type '(unsigned-byte 8)))) 229 (sb-sys:with-pinned-objects 230 ((sb-ext:array-storage-vector buf)) 231 (alien-mpi-recv 232 (sap-alien 233 (sb-sys:vector-sap (sb-ext:array-storage-vector buf)) 234 (* char)) 235 count 236 *mpi-byte* 237 (slot status 'mpi-source) 238 (slot status 'mpi-tag) 239 *mpi-comm-world* 240 *mpi-status-ignore*)) 241 (values (deserialize buf) (slot status 'mpi-source))))) 242 243 (defun mpi-wtime () 244 (alien-mpi-wtime))