Full support for C interface to MPI.

cl-mpi.asd

@@ -31,6 +31,9 @@ mandatory function arguments."
      ;; Create a small library to portably access the MPI runtime.
      (:mpi-wrapper-file "wrap")
 
+     ;; Low-level bindings.
+     (:file "low-level")
+
      ;; MPI related utilities.
      (:file "utilities")
 
@@ -40,4 +43,5 @@ mandatory function arguments."
      (:file "contexts")
      (:file "environment")
      (:file "point-to-point")
-     (:file "one-sided")))))
+     (:file "one-sided")
+     (:file "file")))))

mpi/collective.lisp

@@ -26,45 +26,6 @@ THE SOFTWARE.
 
 (in-package :cl-mpi)
 
-(defmpifun "MPI_Allgather" (*sendbuf sendcount sendtype *recvbuf recvcount recvtype comm))
-(defmpifun "MPI_Allgatherv" (*sendbuf sendcount sendtype *recvbuf recvcounts displs recvtype comm))
-(defmpifun "MPI_Allreduce" (*sendbuf *recvbuf count datatype op comm))
-(defmpifun "MPI_Alltoall" (*sendbuf *recvbuf count datatype op comm))
-(defmpifun "MPI_Alltoallv" (*sendbuf sendcounts sdispls sendtype *recvbuf recvcounts rdispls recvtype comm))
-(defmpifun "MPI_Alltoallw" (*sendbuf sendcounts sdispls sendtypes *recvbuf recvcounts rdispls recvtypes comm) :introduced "2.0")
-(defmpifun "MPI_Barrier" (comm))
-(defmpifun "MPI_Bcast" (*buf count datatype root comm))
-(defmpifun "MPI_Exscan" (*sendbuf *recvbuf count datatype op comm) :introduced "2.0")
-(defmpifun "MPI_Gather" (*sendbuf sendcount sendtype *recvbuf recvcount recvtype root comm))
-(defmpifun "MPI_Gatherv" (*sendbuf sendcount sendtype *recvbuf recvcounts displs recvtype root comm))
-(defmpifun "MPI_Iallgather" (*sendbuf sendcount sendtype *recvbuf recvcount recvtype comm *request) :introduced "3.0")
-(defmpifun "MPI_Iallgatherv" (*sendbuf sendcount sendtype *recvbuf recvcounts displs recvtype comm *request) :introduced "3.0")
-(defmpifun "MPI_Iallreduce" (*sendbuf *recvbuf count datatype op comm *request) :introduced "3.0")
-(defmpifun "MPI_Ialltoall" (*sendbuf sendcount sendtype *recvbuf recvcount recvtype comm *request) :introduced "3.0")
-(defmpifun "MPI_Ialltoallv" (*sendbuf sendcounts sdispls sendtype *recvbuf recvcounts rdispls recvtype comm *request) :introduced "3.0")
-(defmpifun "MPI_Ialltoallw" (*sendbuf sendcounts sdispls sendtypes *recvbuf recvcounts rdispls recvtypes comm *request) :introduced "3.0")
-(defmpifun "MPI_Ibarrier" (comm *request) :introduced "3.0")
-(defmpifun "MPI_Ibcast" (*buf count datatype root comm *request) :introduced "3.0")
-(defmpifun "MPI_Iexscan" (*sendbuf *recvbuf count datatype op comm *request) :introduced "3.0")
-(defmpifun "MPI_Igather" (*sendbuf sendcount sendtype *recvbuf recvcount recvtype root comm *request) :introduced "3.0")
-(defmpifun "MPI_Igatherv" (*sendbuf sendcount sendtype *recvbuf recvcounts displs recvtype root comm *request) :introduced "3.0")
-(defmpifun "MPI_Ireduce" (*sendbuf *recvbuf count datatype op root comm *request) :introduced "3.0")
-(defmpifun "MPI_Ireduce_scatter" (*sendbuf *recvbuf recvcounts datatype op comm *request) :introduced "3.0")
-(defmpifun "MPI_Ireduce_scatter_block" (*sendbuf *recvbuf recvcount datatype op comm *request) :introduced "3.0")
-(defmpifun "MPI_Iscan" (*sendbuf *recvbuf count datatype op comm *request) :introduced "3.0")
-(defmpifun "MPI_Iscatter" (*sendbuf sendcount sendtype *recvbuf recvcount recvtype root comm *request) :introduced "3.0")
-(defmpifun "MPI_Iscatterv" (*sendbuf sendcounts displs sendtype *recvbuf recvcount recvtype root comm *request) :introduced "3.0")
-(defmpifun "MPI_Op_commutative" (op *commute))
-(defmpifun "MPI_Op_create" (fun commute *op))
-(defmpifun "MPI_Op_free" (*op))
-(defmpifun "MPI_Reduce" (*sendbuf *recvbuf count datatype op root comm))
-(defmpifun "MPI_Reduce_local" (*inbuf *inoutbuf count datatype op))
-(defmpifun "MPI_Reduce_scatter" (*sendbuf *recvbuf recvcounts datatype op comm))
-(defmpifun "MPI_Reduce_scatter_block" (*sendbuf *recvbuf recvcount datatype op comm) :introduced "2.2")
-(defmpifun "MPI_Scan" (*sendbuf *recvbuf count datatype op comm))
-(defmpifun "MPI_Scatter" (*sendbuf sendcount sendtype *recvbuf recvcount recvtype root comm))
-(defmpifun "MPI_Scatterv" (*sendbuf sendcounts displs sendtype *recvbuf recvcount recvtype root comm))
-
 (defun mpi-allgather (send-array recv-array &key (comm *standard-communicator*)
                                               send-start send-end
                                               recv-start recv-end)

mpi/contexts.lisp

@@ -25,67 +25,6 @@ THE SOFTWARE.
 
 (in-package :cl-mpi)
 
-;; (defmpifun "MPI_COMM_DUP_FN")
-;; (defmpifun "MPI_COMM_NULL_COPY_FN")
-;; (defmpifun "MPI_COMM_NULL_DELETE_FN")
-(defmpifun "MPI_Comm_compare" (comm1 comm2 *result))
-(defmpifun "MPI_Comm_create" (comm group *newcomm))
-(defmpifun "MPI_Comm_create_group" (comm group tag *newcomm) :introduced "3.0")
-;; (defmpifun "MPI_Comm_create_keyval")
-;; (defmpifun "MPI_Comm_delete_attr")
-(defmpifun "MPI_Comm_dup" (comm *newcomm))
-;; (defmpifun "MPI_Comm_dup_with_info")
-(defmpifun "MPI_Comm_free" (*comm))
-;; (defmpifun "MPI_Comm_free_keyval")
-;; (defmpifun "MPI_Comm_get_attr")
-;; (defmpifun "MPI_Comm_get_info")
-;; (defmpifun "MPI_Comm_get_name")
-(defmpifun "MPI_Comm_group" (comm *group))
-(defmpifun "MPI_Comm_idup" (comm *newcomm *request) :introduced "3.0")
-(defmpifun "MPI_Comm_rank" (comm *rank))
-(defmpifun "MPI_Comm_remote_group" (comm *group))
-(defmpifun "MPI_Comm_remote_size" (comm *size))
-;; (defmpifun "MPI_Comm_set_attr")
-;; (defmpifun "MPI_Comm_set_info")
-;; (defmpifun "MPI_Comm_set_name")
-(defmpifun "MPI_Comm_size" (comm *size))
-(defmpifun "MPI_Comm_split" (comm color key *newcomm))
-;; (defmpifun "MPI_Comm_split_type")
-(defmpifun "MPI_Comm_test_inter" (comm *flag))
-(defmpifun "MPI_Group_compare" (group1 group2 *result))
-(defmpifun "MPI_Group_difference" (group1 group2 *newgroup))
-(defmpifun "MPI_Group_excl" (group count ranges *newgroup))
-(defmpifun "MPI_Group_free" (*group))
-(defmpifun "MPI_Group_incl" (group count ranges *newgroup))
-(defmpifun "MPI_Group_intersection" (group1 group2 *newgroup))
-(defmpifun "MPI_Group_range_excl" (group count ranges *newgroup))
-(defmpifun "MPI_Group_range_incl" (group count ranges *newgroup))
-(defmpifun "MPI_Group_rank" (group *rank))
-(defmpifun "MPI_Group_size" (group *size))
-(defmpifun "MPI_Group_translate_ranks" (group1 count ranks1 group2 ranks2))
-(defmpifun "MPI_Group_union" (group1 group2 *newgroup))
-;; (defmpifun "MPI_Intercomm_create")
-;; (defmpifun "MPI_Intercomm_merge")
-;; (defmpifun "MPI_TYPE_DUP_FN")
-;; (defmpifun "MPI_TYPE_NULL_COPY_FN")
-;; (defmpifun "MPI_TYPE_NULL_DELETE_FN")
-;; (defmpifun "MPI_Type_create_keyval")
-;; (defmpifun "MPI_Type_free_keyval")
-;; (defmpifun "MPI_Type_get_attr")
-;; (defmpifun "MPI_Type_get_name")
-;; (defmpifun "MPI_Type_set_attr")
-;; (defmpifun "MPI_Type_set_name")
-;; (defmpifun "MPI_WIN_DUP_FN")
-;; (defmpifun "MPI_WIN_NULL_COPY_FN")
-;; (defmpifun "MPI_WIN_NULL_DELETE_FN")
-;; (defmpifun "MPI_Win_create_keyval")
-;; (defmpifun "MPI_Win_delete_attr")
-;; (defmpifun "MPI_Win_free_attr")
-;; (defmpifun "MPI_Win_get_attr")
-;; (defmpifun "MPI_Win_get_name")
-;; (defmpifun "MPI_Win_set_attr")
-;; (defmpifun "MPI_Win_set_name")
-
 (defun mpi-comm-group (&optional (comm *standard-communicator*))
   (declare (type mpi-comm comm))
   (with-foreign-results ((newgroup 'mpi-group))

mpi/datatypes.lisp

@@ -25,38 +25,6 @@ THE SOFTWARE.
 
 (in-package :cl-mpi)
 
-;; (defmpifun "MPI_Get_address")
-;; (defmpifun "MPI_Get_elements")
-;; (defmpifun "MPI_Get_elements_x")
-(defmpifun "MPI_Pack" (*inbuf incount datatype *outbuf outsize *position comm))
-;; (defmpifun "MPI_Pack_external")
-;; (defmpifun "MPI_Pack_external_size")
-(defmpifun "MPI_Pack_size" (incount datatype comm *size))
-;; (defmpifun "MPI_Type_commit" (*datatype))
-;; (defmpifun "MPI_Type_contiguous" (count oldtype *newtype))
-;; (defmpifun "MPI_Type_create_darray")
-;; (defmpifun "MPI_Type_create_hindexed")
-;; (defmpifun "MPI_Type_create_hindexed_block")
-;; (defmpifun "MPI_Type_create_hvector")
-;; (defmpifun "MPI_Type_create_indexed_block")
-;; (defmpifun "MPI_Type_create_resized")
-;; (defmpifun "MPI_Type_create_struct")
-;; (defmpifun "MPI_Type_create_subarray")
-;; (defmpifun "MPI_Type_dup" (oldtype *newtype))
-;; (defmpifun "MPI_Type_free" (*datatype))
-;; (defmpifun "MPI_Type_get_contents")
-;; (defmpifun "MPI_Type_get_envelope")
-;; (defmpifun "MPI_Txpe_get_extent")
-;; (defmpifun "MPI_Type_get_extent_x")
-;; (defmpifun "MPI_Type_get_true_extent")
-;; (defmpifun "MPI_Type_get_true_extent_x")
-;; (defmpifun "MPI_Type_indexed")
-(defmpifun "MPI_Type_size" (datatype *size))
-;; (defmpifun "MPI_Type_size_x" (datatype *size))
-;; (defmpifun "MPI_Type_vector")
-(defmpifun "MPI_Unpack" (*inbuf insize *position *outbuf outcount datatype comm))
-;; (defmpifun "MPI_Unpack_external")
-
 (declaim (ftype (function (mpi-datatype) int) mpi-type-size))
 (defun mpi-type-size (datatype)
   (with-foreign-results ((size :int))

mpi/environment.lisp

@@ -26,53 +26,27 @@ THE SOFTWARE.
 
 (in-package :cl-mpi)
 
-(defcfun "MPI_Wtime" :double
-  "Returns a (double) floating-point number of seconds, representing elapsed
+(progn
+  (setf (fdefinition 'mpi-wtime) (function %mpi-wtime))
+  (setf (documentation 'mpi-wtime 'function)
+        "Returns a (double) floating-point number of seconds, representing elapsed
 wall-clock time since some time in the past.
 
 The 'time in the past' is guaranteed not to change during the life of the
 process.  The user is responsible for converting large numbers of seconds to
 other units if they are preferred.  This function is portable (it returns
 seconds, not 'ticks'), it allows high-resolution, and carries no unnecessary
 baggage.  The times returned are local to the node that called them. There is
-no requirement that different nodes return 'the same time.'")
+no requirement that different nodes return 'the same time.'"))
 
-(defcfun "MPI_Wtick" :double
-  "Returns the resolution of MPI-WTIME in seconds. That is, it returns, as a
+(progn
+  (setf (fdefinition 'mpi-wtick) (function %mpi-wtick))
+  (setf (documentation 'mpi-wtick 'function)
+        "Returns the resolution of MPI-WTIME in seconds. That is, it returns, as a
 double precision value, the number of seconds between successive clock
 ticks. For example, if the clock is implemented by the hardware as a counter
 that is incremented every millisecond, the value returned by MPI-WTICK should
-be 0.001")
-
-(defmpifun "MPI_Abort" (comm errorcode))
-;; (defmpifun "MPI_Add_error_class")
-;; (defmpifun "MPI_Add_error_code")
-;; (defmpifun "MPI_Add_error_string")
-(defmpifun "MPI_Alloc_mem" (count ptr *buf))
-(defmpifun "MPI_Comm_call_errhandler" (comm errorcode))
-;; (defmpifun "MPI_Comm_create_errhandler")
-;; (defmpifun "MPI_Comm_get_errhandler")
-(defmpifun "MPI_Comm_set_errhandler" (comm errhandler))
-;; (defmpifun "MPI_Errhandler_free")
-;; (defmpifun "MPI_Error_class")
-(defmpifun "MPI_Error_string" (errorcode string *size))
-;; (defmpifun "MPI_File_call_errhandler")
-;; (defmpifun "MPI_File_create_errhandler")
-;; (defmpifun "MPI_File_get_errhandler")
-;; (defmpifun "MPI_File_set_errhandler")
-(defmpifun "MPI_Finalize" ())
-(defmpifun "MPI_Finalized" (*flag))
-(defmpifun "MPI_Free_mem" (ptr))
-;; (defmpifun "MPI_Get_library_version")
-(defmpifun "MPI_Get_processor_name" (string *size))
-;; (defmpifun "MPI_Get_version")
-(defmpifun "MPI_Init" (argc argv))
-(defmpifun "MPI_Init_thread" (argc argv (required mpi-thread-options) (provided :pointer)))
-(defmpifun "MPI_Initialized" (*flag))
-;; (defmpifun "MPI_Win_call_errhandler")
-;; (defmpifun "MPI_Win_create_errhandler")
-;; (defmpifun "MPI_Win_get_errhandler")
-;; (defmpifun "MPI_Win_set_errhandler")
+be 0.001"))
 
 (defun mpi-init (&key (thread-support nil thread-support-p))
   "Initialize MPI. If supplied, the keyword parameter THREAD-SUPPORT
@@ -97,12 +71,12 @@ required level of thread support."
     (initialize-mpi-constants)
     (if (not thread-support-p)
         (%mpi-init (null-pointer) (null-pointer))
-        (let ((required
-                (cffi:foreign-enum-value 'mpi-thread-options thread-support))
-              (provided
-                (with-foreign-results ((provided :int))
-                  (%mpi-init-thread (null-pointer) (null-pointer)
-                                    thread-support provided))))
+        (let* ((required
+                 (cffi:foreign-enum-value 'mpi-thread-options thread-support))
+               (provided
+                 (with-foreign-results ((provided :int))
+                   (%mpi-init-thread (null-pointer) (null-pointer)
+                                     required provided))))
           (when (> required provided)
             (error "The required level of thread support is ~W,~@
                     but this MPI implementation can only provide ~W."
@@ -135,7 +109,7 @@ MPI-FINALIZE."
   (with-foreign-results ((flag :boolean))
     (%mpi-finalized flag)))
 
-(defun mpi-abort(&key (comm *standard-communicator*) (errcode -1))
+(defun mpi-abort (&key (comm *standard-communicator*) (errcode -1))
   "This routine makes a 'best attempt' to abort all tasks in the group of
 comm. This function does not require that the invoking environment take any
 action with the error code. However, a Unix or POSIX environment should handle

mpi/file.lisp

@@ -0,0 +1,83 @@
+#| -*- Mode: Lisp; indent-tabs-mode: nil -*-
+
+MPI file functions
+
+Copyright (C) 2019  Juan M. Bello-Rivas <[email protected]>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
+|#
+
+(in-package :cl-mpi)
+
+(defun mpi-file-open (filename amode &key (info +mpi-info-null+)
+                                       (comm *standard-communicator*))
+  "Open file named FILENAME with file access mode AMODE passing information
+object via INFO and using the communicator COMM.
+
+Returns a MPI-FILE handle to the open file."
+  (declare (type string filename)
+           (type fixnum amode)
+           (type mpi-info info)
+           (type mpi-comm comm))
+  (with-foreign-string (name filename)
+    (mpi::with-foreign-results ((file-handle 'mpi::mpi-file))
+      (%mpi-file-open comm name amode info file-handle))))
+
+(defun mpi-file-close (file-handle)
+  "Close file associated with FILE-HANDLE."
+  (declare (type mpi-file file-handle))
+  (with-foreign-object (fh 'mpi-file)
+    (setf (mem-ref fh 'mpi-file) file-handle)
+    (%mpi-file-close fh)))
+
+(defmacro with-open-mpi-file ((file-handle filename amode &key (info '+mpi-info-null+)
+                                                            (comm '*standard-communicator*))
+                              &body body)
+  `(let ((,file-handle (mpi-file-open ,filename ,amode :info ,info :comm ,comm)))
+     (unwind-protect
+          (progn ,@body)
+       (mpi-file-close ,file-handle))))
+
+(defun mpi-file-read (file-handle array &key start end)
+  (declare (type mpi-file file-handle)
+           (type simple-array array)
+           (type index start end))
+  (multiple-value-bind (ptr type count)
+      (static-vector-mpi-data array start end)
+    (with-foreign-object (status '(:struct mpi-status))
+      (%mpi-file-read file-handle ptr count type status)
+      (with-foreign-results ((count 'mpi-count))
+        (%mpi-get-count status +mpi-int+ count)))))
+
+(defun mpi-file-write (file-handle array &key start end)
+  (declare (type mpi-file file-handle)
+           (type simple-array array)
+           (type index start end))
+  (multiple-value-bind (ptr type count)
+      (static-vector-mpi-data array start end)
+    (with-foreign-object (status '(:struct mpi-status))
+      (%mpi-file-write file-handle ptr count type status)
+      (with-foreign-results ((count 'mpi-count))
+        (%mpi-get-count status +mpi-int+ count)))))
+
+(defun mpi-file-seek (file-handle offset whence)
+  "Non-collectively update individual file pointer of FILE-HANDLE according
+to WHENCE using OFFSET."
+  (declare (type mpi-file file-handle))
+  (%mpi-file-seek file-handle offset whence))