Artifact b37a10995a12981bea3bf7415d274fb62af43191884c516cc4d0474f8f3a1a72:
- Executable file
r38/lisp/csl/cslbase/cslmpi.c
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 26486) [annotate] [blame] [check-ins using] [more...]
/* cslmpi.c */ /* * Interfaces for mpi from CSL. The bulk of this code was written by * M O Seymour (1997-98) who has released it for inclusion as part of * this Lisp system. */ /* * This code may be used and modified, and redistributed in binary * or source form, subject to the "CCL Public License", which should * accompany it. This license is a variant on the BSD license, and thus * permits use of code derived from this in either open and commercial * projects: but it does require that updates to this code be made * available back to the originators of the package. * Before merging other code in with this or linking this code * with other packages or libraries please check that the license terms * of the other material are compatible with those of this. */ /* Signature: 17eb615f 09-Jun-2005 */ #include "headers.h" #ifdef USE_MPI #include "mpipack.c" #define check_fix(v) if (!is_fixnum(v)) return aerror1(fun_name, v) #define get_arg(v) v = va_arg(a,Lisp_Object) #define get_fix_arg(v) get_arg(v); check_fix(v); v=int_of_fixnum(v) /************************ Environmental functions *******************/ /* Returns process rank * (mpi_comm_rank comm) */ /* For now, I assume that comm will fit into a fixnum. * This appears to be the case with MPICH (values in the hundreds), * but assumptions like this should not be made. */ static Lisp_Object Lmpi_comm_rank(Lisp_Object nil, Lisp_Object comm) { int rank; static char fun_name[] = "mpi_comm_rank"; CSL_IGNORE(nil); check_fix(comm); MPI_Comm_rank(int_of_fixnum(comm),&rank); return onevalue(fixnum_of_int(rank)); } /* returns size of communicator * (mpi_comm_size comm) */ /* Same assumption about comm. */ static Lisp_Object Lmpi_comm_size(Lisp_Object nil, Lisp_Object comm) { int size; static char fun_name[] = "mpi_comm_size"; CSL_IGNORE(nil); check_fix(comm); MPI_Comm_size(int_of_fixnum(comm),&size); return onevalue(fixnum_of_int(size)); } /********************** Blocking point-to-point functions *************/ /* Standard blocking send * (mpi_send message dest tag comm) * returns nil. */ /* Same assumption about comm. */ static Lisp_Object MS_CDECL Lmpi_send(Lisp_Object nil, int nargs, ...) { static char fun_name[] = "mpi_send"; Lisp_Object message; int dest,tag,comm; va_list a; argcheck(nargs,4,fun_name); va_start(a,nargs); get_arg(message); get_fix_arg(dest); get_fix_arg(tag); get_fix_arg(comm); pack_object(message); MPI_Send(mpi_pack_buffer, mpi_pack_position, MPI_PACKED, dest, tag, comm); free(mpi_pack_buffer); return onevalue(nil); } /* Standard blocking receive * (mpi_recv source tag comm) * returns (message (source tag error)). */ static Lisp_Object MS_CDECL Lmpi_recv(Lisp_Object nil, int nargs, ...) { static char fun_name[] = "mpi_recv"; MPI_Status status; int source,tag,comm; Lisp_Object Lstatus; va_list a; CSL_IGNORE(nil); argcheck(nargs,3,fun_name); va_start(a,nargs); get_fix_arg(source); get_fix_arg(tag); get_fix_arg(comm); MPI_Probe(source, tag, comm, &status); MPI_Get_count(&status, MPI_PACKED, &mpi_pack_size); mpi_pack_buffer = (char*)malloc(mpi_pack_size); MPI_Recv(mpi_pack_buffer, mpi_pack_size, MPI_PACKED, source, tag, comm, &status); /* The only relevant status things are the 3 public fields, so I'll * stick them in a list and return them as the 2nd value */ push(unpack_object()); free(mpi_pack_buffer); Lstatus = list3(fixnum_of_int(status.MPI_SOURCE), fixnum_of_int(status.MPI_TAG), fixnum_of_int(status.MPI_ERROR)); return onevalue(list2(my_pop(),Lstatus)); } /* Standard blocking simultaneous send and receive * (mpi_sendrecv send_message dest send_tag source recv_tag comm) * returns (recv_message (source recv_tag error)) */ /* THERE IS A LIMIT OF 1024 BYTES FOR THE RECEIVE BUFFER (sorry.) * THIS WILL BE REMOVED ASAP. */ static Lisp_Object MS_CDECL Lmpi_sendrecv(Lisp_Object nil, int nargs, ...) { static char fun_name[] = "mpi_sendrecv"; MPI_Status status; Lisp_Object Lstatus; Lisp_Object s_mess; int s_tag, r_tag, dest, source, comm; char r_buffer[1024]; va_list a; CSL_IGNORE(nil); argcheck(nargs,6,fun_name); va_start(a,nargs); get_arg(s_mess); get_fix_arg(dest); get_fix_arg(s_tag); get_fix_arg(source); get_fix_arg(r_tag); get_fix_arg(comm); pack_object(s_mess); MPI_Sendrecv(mpi_pack_buffer, mpi_pack_position, MPI_PACKED, dest, s_tag, r_buffer, 1024, MPI_PACKED, source, r_tag, comm, &status); free(mpi_pack_buffer); mpi_pack_buffer = r_buffer; push(unpack_object()); Lstatus = list3(fixnum_of_int(status.MPI_SOURCE), fixnum_of_int(status.MPI_TAG), fixnum_of_int(status.MPI_ERROR)); return onevalue(list2(my_pop(),Lstatus)); } /************** Non-Blocking point-to-point functions ***********/ /* Standard non-blocking send post * (mpi_isend message dest tag comm) * returns request handle */ static Lisp_Object MS_CDECL Lmpi_isend(Lisp_Object nil, int nargs, ...) { static char fun_name[] = "mpi_isend"; Lisp_Object message, request; int dest, tag, comm; va_list a; CSL_IGNORE(nil); /* For now, we assume type MPI_Request to be 32 bits. */ request = Lmkvect32(nil,fixnum_of_int(2)); argcheck(nargs,4,fun_name); va_start(a,nargs); get_arg(message); get_fix_arg(dest); get_fix_arg(tag); get_fix_arg(comm); pack_object(message); MPI_Isend(mpi_pack_buffer, mpi_pack_position, MPI_PACKED, dest, tag, comm, (MPI_Request*)&elt(request,0)); elt(request,1) = (int)mpi_pack_buffer; return onevalue(request); } /* Standard non-blocking receive post * (mpi_irecv source tag comm) * returns request handle */ /* I actually cheat horribly by not posting the request at all (at least * not via MPI), but rather create my own "dummy" request structure. * Then, to complete the request, I MPI_(I)Probe for a matching message, * and receive it if it is there. * This is unsatisfactory since the operation is only non-blocking until the * first lump of the message arrives; for a long message, there may by * a lot of latency after this. */ struct dummy_request{ int source; int tag; int comm; }; static Lisp_Object MS_CDECL Lmpi_irecv(Lisp_Object nil, int nargs, ...) { static char fun_name[] = "mpi_irecv"; int source,tag,comm; Lisp_Object request; va_list a; char* buffer; CSL_IGNORE(nil); /* For now, we assume type MPI_Request to be 32 bits. */ request = Lmkvect32(nil,fixnum_of_int(2)); argcheck(nargs,3,fun_name); va_start(a,nargs); get_fix_arg(source); get_fix_arg(tag); get_fix_arg(comm); elt(request,1) = 0; /* There is no buffer yet */ elt(request,0) = (int)malloc(sizeof(struct dummy_request)); ((struct dummy_request*)elt(request,0))->source = source; ((struct dummy_request*)elt(request,0))->tag = tag; ((struct dummy_request*)elt(request,0))->comm = comm; return onevalue(request); } /* Wait to complete operation, and deallocate buffer. * (mpi_wait request) * for send, returns nil * for recv, returns (message (source tag error)) */ static Lisp_Object Lmpi_wait(Lisp_Object nil, Lisp_Object request) { MPI_Status status; Lisp_Object message, Lstatus; if ( !(is_vector(request) && type_of_header(vechdr(request)) == TYPE_VEC32 && length_of_header(vechdr(request)) == 3*CELL) ) return aerror1("mpi_wait",request); if ( elt(request,1)){ status.MPI_ERROR = MPI_UNDEFINED; mpi_pack_buffer = (void*)elt(request,1); MPI_Wait( (MPI_Request*)&elt(request,0), &status); if (status.MPI_ERROR == MPI_UNDEFINED){ /* i.e. send request */ free(mpi_pack_buffer); return onevalue(nil); } else { /* old-style receive */ push(unpack_object()); free(mpi_pack_buffer); Lstatus = list3(fixnum_of_int(status.MPI_SOURCE), fixnum_of_int(status.MPI_TAG), fixnum_of_int(status.MPI_ERROR)); return onevalue(list2(my_pop(),Lstatus)); } } else{ /* new-style receive */ int source = ((struct dummy_request*)elt(request,0))->source, tag = ((struct dummy_request*)elt(request,0))->tag, comm = ((struct dummy_request*)elt(request,0))->comm; MPI_Probe(source, tag, comm, &status); free((struct dummy_request*)elt(request,0)); MPI_Get_count(&status, MPI_PACKED, &mpi_pack_size); mpi_pack_buffer = (char*)malloc(mpi_pack_size); MPI_Recv(mpi_pack_buffer, mpi_pack_size, MPI_PACKED, source, tag, comm, &status); /* The only relevant status things are the 3 public fields, so I'll * stick them in a list and return them as the 2nd value */ push(unpack_object()); free(mpi_pack_buffer); Lstatus = list3(fixnum_of_int(status.MPI_SOURCE), fixnum_of_int(status.MPI_TAG), fixnum_of_int(status.MPI_ERROR)); return onevalue(list2(my_pop(),Lstatus)); } } /* Test for completion, deallocate buffer if so * (mpi_test request) * for send, returns flag * for recv, returns nil or (message (source tag error)) */ static Lisp_Object Lmpi_test(Lisp_Object nil, Lisp_Object request) { MPI_Status status; Lisp_Object message, Lstatus; int flag; if ( !(is_vector(request) && type_of_header(vechdr(request)) == TYPE_VEC32 && length_of_header(vechdr(request)) == 3*CELL) ) return aerror1("mpi_wait",request); if (elt(request,1)){ status.MPI_ERROR = MPI_UNDEFINED; mpi_pack_buffer = (void*)elt(request,1); MPI_Test( (MPI_Request*)&elt(request,0), &flag, &status); if (!flag) return onevalue(nil); if (status.MPI_ERROR == MPI_UNDEFINED){ /* send request */ free(mpi_pack_buffer); return onevalue(Lispify_predicate(YES)); } else{ /* old-style receive */ push(unpack_object()); free(mpi_pack_buffer); Lstatus = list3(fixnum_of_int(status.MPI_SOURCE), fixnum_of_int(status.MPI_TAG), fixnum_of_int(status.MPI_ERROR)); return onevalue(list2(my_pop(),Lstatus)); } } else { /* new-style receive */ int source = ((struct dummy_request*)elt(request,0))->source, tag = ((struct dummy_request*)elt(request,0))->tag, comm = ((struct dummy_request*)elt(request,0))->comm, flag; MPI_Iprobe(source, tag, comm, &flag, &status); if (!flag) return onevalue(nil); free((struct dummy_request*)elt(request,0)); MPI_Get_count(&status, MPI_PACKED, &mpi_pack_size); mpi_pack_buffer = (char*)malloc(mpi_pack_size); MPI_Recv(mpi_pack_buffer, mpi_pack_size, MPI_PACKED, source, tag, comm, &status); /* The only relevant status things are the 3 public fields, so I'll * stick them in a list and return them as the 2nd value */ push(unpack_object()); free(mpi_pack_buffer); Lstatus = list3(fixnum_of_int(status.MPI_SOURCE), fixnum_of_int(status.MPI_TAG), fixnum_of_int(status.MPI_ERROR)); return onevalue(list2(my_pop(),Lstatus)); } } /************** Probe functions *******************/ /* Non-blocking probe * (mpi_iprobe source tag comm) * returns (flag (source tag error)) */ static Lisp_Object MS_CDECL Lmpi_iprobe(Lisp_Object nil, int nargs, ...) { static char fun_name[] = "impi_probe"; MPI_Status status; int source, tag, comm, flag; Lisp_Object Lstatus; va_list a; CSL_IGNORE(nil); argcheck(nargs,3,fun_name); va_start(a,nargs); get_fix_arg(source); get_fix_arg(tag); get_fix_arg(comm); MPI_Iprobe(source, tag, comm, &flag, &status); Lstatus = list3(fixnum_of_int(status.MPI_SOURCE), fixnum_of_int(status.MPI_TAG), fixnum_of_int(status.MPI_ERROR)); return onevalue(list2(Lispify_predicate(flag), Lstatus)); } /* Blocking probe * (mpi_probe source tag comm) * returns (source tag error) */ static Lisp_Object MS_CDECL Lmpi_probe(Lisp_Object nil, int nargs, ...) { static char fun_name[] = "mpi_probe"; MPI_Status status; int source, tag, comm; Lisp_Object Lstatus; va_list a; CSL_IGNORE(nil); argcheck(nargs,3,fun_name); va_start(a,nargs); get_fix_arg(source); get_fix_arg(tag); get_fix_arg(comm); MPI_Probe(source, tag, comm, &status); Lstatus = list3(fixnum_of_int(status.MPI_SOURCE), fixnum_of_int(status.MPI_TAG), fixnum_of_int(status.MPI_ERROR)); return onevalue(Lstatus); } /************** Collective Communications *********/ /* Barrier; blocks until all processes have called * (mpi_barrier comm) * returns nil */ static Lisp_Object Lmpi_barrier(Lisp_Object nil, Lisp_Object comm) { int rank; static char fun_name[] = "mpi_barrier"; check_fix(comm); MPI_Barrier(int_of_fixnum(comm)); return onevalue(nil); } /* Broadcast; sends buffer of root to buffers of others. * (mpi_bcast message root comm) [message ignored if not root] * returns message */ static Lisp_Object MS_CDECL Lmpi_bcast(Lisp_Object nil, int nargs, ...) { static char fun_name[] = "mpi_bcast"; Lisp_Object message; int root,comm,rank; va_list a; CSL_IGNORE(nil); argcheck(nargs,3,fun_name); va_start(a,nargs); get_arg(message); get_fix_arg(root); get_fix_arg(comm); MPI_Comm_rank(comm,&rank); if (rank == root){ pack_object(message); MPI_Bcast(&mpi_pack_position, 1, MPI_LONG, root, comm); MPI_Bcast(mpi_pack_buffer, mpi_pack_position, MPI_PACKED, root, comm); free(mpi_pack_buffer); } else { MPI_Bcast(&mpi_pack_size, 1, MPI_LONG, root, comm); mpi_pack_buffer = (char*)malloc(mpi_pack_size); MPI_Bcast(mpi_pack_buffer, mpi_pack_size, MPI_PACKED, root, comm); message = unpack_object(); free(mpi_pack_buffer); } return onevalue(message); } /* Gather: root receives messages from others. * (mpi_gather message root comm) * returns vector of messages if root, else nil. */ static Lisp_Object MS_CDECL Lmpi_gather(Lisp_Object nil, int nargs, ...) { static char fun_name[] = "mpi_gather"; Lisp_Object message; int root,comm,rank; va_list a; CSL_IGNORE(nil); argcheck(nargs,3,fun_name); va_start(a,nargs); get_arg(message); get_fix_arg(root); get_fix_arg(comm); MPI_Comm_rank(comm,&rank); pack_object(message); if (rank == root){ int commsize, count; int *recvcounts, *displs; char *recvbuffer; MPI_Comm_size(comm,&commsize); recvcounts = (int*)calloc(commsize, sizeof(int)); displs = (int*)calloc(commsize+1, sizeof(int)); MPI_Gather(&mpi_pack_position, 1, MPI_LONG, recvcounts, 1, MPI_LONG, root, comm); displs[0] = 0; for (count = 0; count < commsize; ++count) displs[count+1] = displs[count] + recvcounts[count]; recvbuffer = (char*)malloc(displs[commsize]); MPI_Gatherv(mpi_pack_buffer, mpi_pack_position, MPI_PACKED, recvbuffer, recvcounts, displs, MPI_PACKED, root, comm); free(mpi_pack_buffer); message = Lmkvect(nil, fixnum_of_int(commsize-1)); for (count = 0; count < commsize; ++count){ mpi_pack_buffer = recvbuffer + displs[count]; mpi_pack_size = recvcounts[count]; elt(message, count) = unpack_object(); } free(recvbuffer); free(recvcounts); free(displs); } else { MPI_Gather(&mpi_pack_position, 1, MPI_LONG, 0, 0, MPI_LONG, root, comm); MPI_Gatherv(mpi_pack_buffer, mpi_pack_position, MPI_PACKED, 0,0,0,MPI_PACKED, root, comm); free(mpi_pack_buffer); message = nil; } return onevalue(message); } /* Scatter: inverse of gather. * (mpi_scatter vector_of_messages root comm) [messages ignored if not root] * returns message */ static Lisp_Object MS_CDECL Lmpi_scatter(Lisp_Object nil, int nargs, ...) { static char fun_name[] = "mpi_scatter"; Lisp_Object messages, message; int root, comm, rank; va_list a; CSL_IGNORE(nil); argcheck(nargs,3,fun_name); va_start(a,nargs); get_arg(messages); get_fix_arg(root); get_fix_arg(comm); MPI_Comm_rank(comm,&rank); if (rank == root){ int commsize, count, *sendcounts, *displs, recvcount; char* recvbuffer; MPI_Comm_size(comm,&commsize); sendcounts = (int*)calloc(commsize, sizeof(int)); displs = (int*)calloc(commsize+1, sizeof(int)); displs[0] = 0; /* Call private functions in mpi_packing for consecutive packs */ check_buffer = scatter_check_buffer; mpi_pack_offset = 0; mpi_pack_position = 0; mpi_pack_size = 0; mpi_buffer_bottom = 0; mpi_real_size = 0; for (count = 0; count < commsize; ++count){ pack_cell(elt(messages,count)); sendcounts[count] = mpi_pack_position; mpi_pack_size -= mpi_pack_position; mpi_pack_offset += mpi_pack_position; mpi_pack_buffer += mpi_pack_position; displs[count+1] = mpi_pack_offset; mpi_pack_position = 0; } check_buffer = default_check_buffer; MPI_Scatter(sendcounts, 1, MPI_LONG, &recvcount, 1, MPI_LONG, root, comm); recvbuffer = (char*)malloc(recvcount); MPI_Scatterv(mpi_buffer_bottom, sendcounts, displs, MPI_PACKED, recvbuffer, recvcount, MPI_PACKED, root, comm); free(recvbuffer); free(sendcounts); free(displs); free(mpi_buffer_bottom); message = elt(messages, root); } else { MPI_Scatter(0,0,MPI_LONG,&mpi_pack_size,1,MPI_LONG,root,comm); mpi_pack_buffer = (char*)malloc(mpi_pack_size); MPI_Scatterv(0,0,0,MPI_PACKED, mpi_pack_buffer,mpi_pack_size,MPI_PACKED,root,comm); message = unpack_object(); free(mpi_pack_buffer); } return onevalue(message); } /* Allgather: just like gather, only everyone gets the result. * (mpi_allgather message comm) * returns vector of messages */ static Lisp_Object Lmpi_allgather(Lisp_Object nil, Lisp_Object message, Lisp_Object comm) { static char fun_name[] = "mpi_gather"; int commsize, buffersize, count; int *recvcounts, *displs; char *recvbuffer; check_fix(comm); comm = int_of_fixnum(comm); CSL_IGNORE(nil); pack_object(message); MPI_Comm_size(comm,&commsize); recvcounts = (int*)calloc(commsize, sizeof(int)); displs = (int*)calloc(commsize+1, sizeof(int)); MPI_Allgather(&mpi_pack_position, 1, MPI_LONG, recvcounts, 1, MPI_LONG, comm); displs[0] = 0; for (count = 0; count < commsize; ++count) displs[count+1] = displs[count] + recvcounts[count]; recvbuffer = (char*)malloc(displs[commsize]); MPI_Allgatherv(mpi_pack_buffer, mpi_pack_position, MPI_PACKED, recvbuffer, recvcounts, displs, MPI_PACKED, comm); free(mpi_pack_buffer); free(recvcounts); free(displs); message = Lmkvect(nil, fixnum_of_int(commsize-1)); for (count = 0; count < commsize; ++count){ mpi_pack_buffer = recvbuffer + displs[count]; mpi_pack_size = recvcounts[count]; elt(message, count) = unpack_object(); } free(recvbuffer); return onevalue(message); } /* All to all scatter/gather. * (mpi_alltoall vector_of_messages comm) * returns vector of messages. */ static Lisp_Object Lmpi_alltoall(Lisp_Object nil, Lisp_Object smessages, Lisp_Object Lcomm) { static char fun_name[] = "mpi_alltoall"; Lisp_Object rmessages; int rank,comm, commsize, count; int *sendcounts, *recvcounts, *sdispls, *rdispls; char* recvbuffer; CSL_IGNORE(nil); check_fix(Lcomm); comm = int_of_fixnum(Lcomm); MPI_Comm_size(comm,&commsize); sendcounts = (int*)calloc(commsize, sizeof(int)); recvcounts = (int*)calloc(commsize, sizeof(int)); sdispls = (int*)calloc(commsize+1, sizeof(int)); rdispls = (int*)calloc(commsize+1, sizeof(int)); /* Call private functions in mpi_packing for consecutive packs */ check_buffer = scatter_check_buffer; mpi_pack_offset = 0; mpi_pack_position = 0; mpi_pack_size = 0; mpi_buffer_bottom = 0; mpi_real_size = 0; for (count = 0; count < commsize; ++count){ pack_cell(elt(smessages,count)); sendcounts[count] = mpi_pack_position; mpi_pack_size -= mpi_pack_position; mpi_pack_offset += mpi_pack_position; mpi_pack_buffer += mpi_pack_position; sdispls[count+1] = mpi_pack_offset; mpi_pack_position = 0; } check_buffer = default_check_buffer; MPI_Comm_rank(comm,&rank); MPI_Alltoall(sendcounts, 1, MPI_LONG, recvcounts, 1, MPI_LONG, comm); rdispls[0] = 0; for (count = 0; count < commsize; ++count) rdispls[count+1] = rdispls[count] + recvcounts[count]; recvbuffer = (char*)malloc(rdispls[commsize]); MPI_Alltoallv(mpi_buffer_bottom, sendcounts, sdispls, MPI_PACKED, recvbuffer, recvcounts, rdispls, MPI_PACKED, comm); free(mpi_buffer_bottom); free(sendcounts); free(sdispls); rmessages = Lmkvect(nil, fixnum_of_int(commsize-1)); for (count = 0; count < commsize; ++count){ mpi_pack_buffer = recvbuffer + rdispls[count]; mpi_pack_size = recvcounts[count]; elt(rmessages, count) = unpack_object(); } free(recvbuffer); free(recvcounts); free(rdispls); return onevalue(rmessages); } #else /* USE_MPI */ static Lisp_Object Lmpi_comm_rank(Lisp_Object nil, Lisp_Object comm) { CSL_IGNORE(nil); CSL_IGNORE(comm); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object Lmpi_comm_size(Lisp_Object nil, Lisp_Object comm) { CSL_IGNORE(nil); CSL_IGNORE(comm); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object MS_CDECL Lmpi_send(Lisp_Object nil, int nargs, ...) { CSL_IGNORE(nil); CSL_IGNORE(nargs); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object MS_CDECL Lmpi_recv(Lisp_Object nil, int nargs, ...) { CSL_IGNORE(nil); CSL_IGNORE(nargs); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object MS_CDECL Lmpi_sendrecv(Lisp_Object nil, int nargs, ...) { CSL_IGNORE(nil); CSL_IGNORE(nargs); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object MS_CDECL Lmpi_isend(Lisp_Object nil, int nargs, ...) { CSL_IGNORE(nil); CSL_IGNORE(nargs); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object MS_CDECL Lmpi_irecv(Lisp_Object nil, int nargs, ...) { CSL_IGNORE(nil); CSL_IGNORE(nargs); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object Lmpi_wait(Lisp_Object nil, Lisp_Object request) { CSL_IGNORE(nil); CSL_IGNORE(request); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object Lmpi_test(Lisp_Object nil, Lisp_Object request) { CSL_IGNORE(nil); CSL_IGNORE(request); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object MS_CDECL Lmpi_iprobe(Lisp_Object nil, int nargs, ...) { CSL_IGNORE(nil); CSL_IGNORE(nargs); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object MS_CDECL Lmpi_probe(Lisp_Object nil, int nargs, ...) { CSL_IGNORE(nil); CSL_IGNORE(nargs); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object Lmpi_barrier(Lisp_Object nil, Lisp_Object comm) { CSL_IGNORE(nil); CSL_IGNORE(comm); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object MS_CDECL Lmpi_bcast(Lisp_Object nil, int nargs, ...) { CSL_IGNORE(nil); CSL_IGNORE(nargs); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object MS_CDECL Lmpi_gather(Lisp_Object nil, int nargs, ...) { CSL_IGNORE(nil); CSL_IGNORE(nargs); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object MS_CDECL Lmpi_scatter(Lisp_Object nil, int nargs, ...) { CSL_IGNORE(nil); CSL_IGNORE(nargs); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object Lmpi_allgather(Lisp_Object nil, Lisp_Object message, Lisp_Object comm) { CSL_IGNORE(nil); CSL_IGNORE(message); CSL_IGNORE(comm); return aerror0("mpi support not built into this version of CSL"); } static Lisp_Object Lmpi_alltoall(Lisp_Object nil, Lisp_Object smessages, Lisp_Object Lcomm) { CSL_IGNORE(nil); CSL_IGNORE(smessages); CSL_IGNORE(Lcomm); return aerror0("mpi support not built into this version of CSL"); } #endif /* USE_MPI */ setup_type const mpi_setup[] = { {"mpi_comm_rank", Lmpi_comm_rank, too_many_1, wrong_no_1}, {"mpi_comm_size", Lmpi_comm_size, too_many_1, wrong_no_1}, {"mpi_send", wrong_no_0a, wrong_no_0b, Lmpi_send}, {"mpi_recv", wrong_no_0a, wrong_no_0b, Lmpi_recv}, {"mpi_sendrecv", wrong_no_0a, wrong_no_0b, Lmpi_sendrecv}, {"mpi_isend", wrong_no_0a, wrong_no_0b, Lmpi_isend}, {"mpi_irecv", wrong_no_0a, wrong_no_0b, Lmpi_irecv}, {"mpi_barrier", Lmpi_barrier, too_many_1, wrong_no_1}, {"mpi_wait", Lmpi_wait, too_many_1, wrong_no_1}, {"mpi_test", Lmpi_test, too_many_1, wrong_no_1}, {"mpi_probe", wrong_no_0a, wrong_no_0b, Lmpi_probe}, {"mpi_iprobe", wrong_no_0a, wrong_no_0b, Lmpi_iprobe}, {"mpi_bcast", wrong_no_0a, wrong_no_0b, Lmpi_bcast}, {"mpi_gather", wrong_no_0a, wrong_no_0b, Lmpi_gather}, {"mpi_allgather", wrong_no_0a, Lmpi_allgather, wrong_no_2}, {"mpi_scatter", wrong_no_0a, wrong_no_0b, Lmpi_scatter}, {"mpi_alltoall", wrong_no_0a, Lmpi_alltoall, wrong_no_2}, {NULL, 0, 0, 0} }; /* end of cslmpi.c */