Changeset 10913 in project


Ignore:
Timestamp:
05/22/08 04:43:07 (12 years ago)
Author:
Ivan Raikov
Message:

Added a binding for MPI:spawn.

Location:
release/3/mpi/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/3/mpi/trunk/collcomm.scm

    r7322 r10913  
    18771877        (myself (MPI:comm-rank comm)))
    18781878    (if (= myself root)
    1879         (MPI_gather_int send (make-f64vector nprocs 0) root comm)
    1880         (MPI_gather_int send (void) root comm))))
     1879        (MPI_gather_flonum send (make-f64vector nprocs 0) root comm)
     1880        (MPI_gather_flonum send (void) root comm))))
    18811881
    18821882
  • release/3/mpi/trunk/init.scm

    r7267 r10913  
    7272<#
    7373
    74 (define MPI_init
    75     (foreign-primitive scheme-object ((scheme-object arguments))
     74(define MPI_spawn
     75  (foreign-primitive nonnull-c-pointer ((c-string command) (scheme-object arguments) (integer maxprocs)
     76                                        (scheme-object locations) (integer root) (scheme-object comm)
     77                                        (s32vector errcodes))
    7678#<<EOF
    77   int argc, i, argvsz, slen;
    78   char ** argv; char *s;
    79   MPI_Errhandler hdlr;
    80   C_word x, tail;
     79  int locc, argc, i, argvsz, slen, locvsz;
     80  char ** argv; char *s, *skey, *sval, **locv;
     81  MPI_Errhandler hdlr;
     82  MPI_Info info;
     83  MPI_Comm intercomm;
     84  C_word x, tail, key, val;
     85  C_word result;
    8186
    8287  C_i_check_list (arguments);
     
    113118
    114119       argv[i] = NULL;
     120
     121
     122       MPI_Info_create(&info);
     123
     124       C_i_check_list (locations);
     125       if (C_i_listp (locations))
     126       {
     127          locc = C_num_to_int(C_i_length(locations));
     128          locvsz = ((2*locc) + 1) * sizeof(char *);
     129          locv = malloc(locvsz);
     130
     131          if ((locc > 0) && (locv != NULL))
     132          {
     133            tail = locations;
     134            for (i = 0; i < locc; i++)
     135            {
     136               x = C_u_i_car (tail);
     137               tail = C_u_i_cdr (tail);
     138               C_i_check_pair (x);
     139               key = C_u_i_car (x);
     140               val = C_u_i_cadr (x);
     141               skey = NULL;
     142               sval = NULL;
     143               C_i_check_string (key);
     144               slen = C_num_to_int(C_i_string_length (key));
     145               if (( skey = malloc (slen+1)) != NULL)
     146               {
     147                  memcpy (skey, C_c_string (key), slen);
     148                  skey[slen] = 0;
     149               }
     150               C_i_check_string (val);
     151               slen = C_num_to_int(C_i_string_length (val));
     152               if (( sval = malloc (slen+1)) != NULL)
     153               {
     154                  memcpy (sval, C_c_string (val), slen);
     155                  sval[slen] = 0;
     156               }
     157               if ((skey != NULL) && (sval != NULL))
     158               {
     159                  MPI_Info_set(info, skey, sval);
     160                  locv[i] = skey;
     161                  locv[i+1] = sval;
     162
     163               }
     164
     165            }
     166            locv[i] = NULL;
     167          }
     168       }
     169
     170       MPI_Comm_spawn(command, argv, maxprocs, info, root, Comm_val(comm),
     171                      &intercomm, errcodes);
     172
     173       MPI_Info_free (&info);
     174
     175       for (i = 0; i < locc; i++)
     176       { 
     177          skey = locv[i];
     178          sval = locv[i+1];
     179          if (skey != NULL)
     180          {
     181             free (skey);
     182          }
     183          if (sval != NULL)
     184          {
     185             free (sval);
     186          }
     187       }
     188       memset (locv, (int)NULL, locvsz);
     189       free (locv);
     190
     191       for (i = 0; i < argc; i++)
     192       { 
     193          s = argv[i];
     194          if (s != NULL)
     195          {
     196             free (s);
     197          }
     198       }
     199       memset (argv, (int)NULL, argvsz);
     200       free (argv);
     201     }
     202  }
     203
     204  result = (C_word)intercomm;
     205  C_return (result);
     206EOF
     207))
     208
     209(define (MPI:spawn command arguments maxprocs locations root comm)
     210  (and (integer? maxprocs) (positive? maxprocs)
     211       (let  ((errcodes (make-s32vector maxprocs 0))
     212              (locations (map (lambda (p) (list (->string (car p)) (->string (cadr p)))) locations)))
     213         (let  ((intercomm (MPI_spawn command arguments maxprocs locations root comm errcodes)))
     214           (list intercomm errcodes)))))
     215   
     216
     217
     218(define MPI_init
     219    (foreign-primitive scheme-object ((scheme-object arguments))
     220#<<EOF
     221  int argc, i, argvsz, slen;
     222  char ** argv; char *s;
     223  MPI_Errhandler hdlr;
     224  C_word x, tail;
     225
     226  C_i_check_list (arguments);
     227  if (C_i_listp (arguments))
     228  {
     229     argc = C_num_to_int(C_i_length(arguments));
     230     argvsz = (argc + 1) * sizeof(char *);
     231     if ((argv = malloc(argvsz)) != NULL)
     232     {
     233       if (argc > 0)
     234       {
     235         tail = arguments;
     236         for (i = 0; i < argc; i++)
     237         {
     238           x = C_u_i_car (tail);
     239           tail = C_u_i_cdr (tail);
     240           C_i_check_string (x);
     241           slen = C_num_to_int(C_i_string_length (x));
     242           if (( s = malloc (slen+1)) != NULL)
     243           {
     244              memcpy (s, C_c_string (x), slen);
     245              s[slen] = 0;
     246              argv[i] = s;
     247           } else
     248           {
     249             argv[i] = NULL;
     250           }
     251           
     252        }
     253       } else
     254       {
     255         i = 0;
     256       }
     257
     258       argv[i] = NULL;
    115259       
    116260       MPI_Init(&argc, &argv);
  • release/3/mpi/trunk/mpi.scm

    r7283 r10913  
    160160                 MPI:group-range-excl
    161161                 MPI:init
     162                 MPI:spawn
    162163                 MPI:finalize
    163164                 MPI:wtime
  • release/3/mpi/trunk/mpi.setup

    r7322 r10913  
    4040
    4141  ; Assoc list with properties for your extension:
    42   `((version 1.3)
     42  `((version 1.4)
    4343    (documentation "mpi.html")
    4444    ,@(if has-exports? `((exports "mpi.exports")) (list)) ))
Note: See TracChangeset for help on using the changeset viewer.