src/external/thread_mpi/src/tmpi_init.c

   1 /*
   2    This source code file is part of thread_mpi.
   3    Written by Sander Pronk, Erik Lindahl, and possibly others.
   4
   5    Copyright (c) 2009, Sander Pronk, Erik Lindahl.
   6    All rights reserved.
   7
   8    Redistribution and use in source and binary forms, with or without
   9    modification, are permitted provided that the following conditions are met:
  10    1) Redistributions of source code must retain the above copyright
  11    notice, this list of conditions and the following disclaimer.
  12    2) Redistributions in binary form must reproduce the above copyright
  13    notice, this list of conditions and the following disclaimer in the
  14    documentation and/or other materials provided with the distribution.
  15    3) Neither the name of the copyright holders nor the
  16    names of its contributors may be used to endorse or promote products
  17    derived from this software without specific prior written permission.
  18
  19    THIS SOFTWARE IS PROVIDED BY US ''AS IS'' AND ANY
  20    EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  21    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  22    DISCLAIMED. IN NO EVENT SHALL WE BE LIABLE FOR ANY
  23    DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  24    (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  25    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  26    ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  27    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  28    SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  29
  30    If you want to redistribute modifications, please consider that
  31    scientific software is very special. Version control is crucial -
  32    bugs must be traceable. We will be happy to consider code for
  33    inclusion in the official distribution, but derived work should not
  34    be called official thread_mpi. Details are found in the README & COPYING
  35    files.
  36  */
  37
  38
  39 #ifdef HAVE_TMPI_CONFIG_H
  40 #include "tmpi_config.h"
  41 #endif
  42
  43 #ifdef HAVE_CONFIG_H
  44 #include "config.h"
  45 #endif
  46
  47 #ifdef HAVE_UNISTD_H
  48 #include <unistd.h>
  49 #endif
  50
  51 #include <errno.h>
  52 #include <stdlib.h>
  53 #include <stdio.h>
  54 #include <string.h>
  55 #if !(defined( _WIN32 ) || defined( _WIN64 ) )
  56 #include <sys/time.h>
  57
  58 #endif
  59
  60
  61 #include "impl.h"
  62
  63 #ifdef TMPI_TRACE
  64 #include <stdarg.h>
  65 #endif
  66
  67
  68
  69
  70
  71
  72 /* there are a few global variables that maintain information about the
  73    running threads. Some are defined by the MPI standard: */
  74 /* TMPI_COMM_WORLD is in tmpi_malloc.c due to technical reasons */
  75 tMPI_Group TMPI_GROUP_EMPTY = NULL;
  76
  77
  78 /* the threads themselves (tmpi_comm only contains lists of pointers to this
  79       structure */
  80 struct tmpi_thread *threads  = NULL;
  81 int                 Nthreads = 0;
  82
  83 /* thread info */
  84 tMPI_Thread_key_t id_key; /* the key to get the thread id */
  85
  86
  87
  88 /* whether MPI has finalized (we need this to distinguish pre-inited from
  89        post-finalized states */
  90 static tmpi_bool tmpi_finalized = FALSE;
  91
  92 /* misc. global information about MPI */
  93 struct tmpi_global *tmpi_global = NULL;
  94
  95
  96
  97
  98
  99
 100 /* start N threads with argc, argv (used by tMPI_Init)*/
 101 int tMPI_Start_threads(tmpi_bool main_returns, int N,
 102                        tMPI_Affinity_strategy aff_strategy,
 103                        int *argc, char ***argv,
 104                        void (*start_fn)(void*), void *start_arg,
 105                        int (*start_fn_main)(int, char**));
 106
 107 /* starter function for threads; takes a void pointer to a
 108       struct tmpi_starter_, which calls main() if tmpi_start_.fn == NULL */
 109 static void* tMPI_Thread_starter(void *arg);
 110
 111 /* allocate and initialize the data associated with a thread structure */
 112 static int tMPI_Thread_init(struct tmpi_thread *th);
 113 /* deallocate the data associated with a thread structure */
 114 static void tMPI_Thread_destroy(struct tmpi_thread *th);
 115
 116
 117
 118
 119 #ifdef TMPI_TRACE
 120 void tMPI_Trace_print(const char *fmt, ...)
 121 {
 122     va_list                    argp;
 123     struct tmpi_thread       * th  = NULL;
 124     static tMPI_Thread_mutex_t mtx = TMPI_THREAD_MUTEX_INITIALIZER;
 125
 126     /* don't check for errors during trace */
 127     tMPI_Thread_mutex_lock(&mtx);
 128     if (threads)
 129     {
 130         th = tMPI_Get_current();
 131         printf("THREAD %02d: ", (int)(th-threads));
 132     }
 133     else
 134     {
 135         printf("THREAD main: ");
 136     }
 137     va_start(argp, fmt);
 138     vprintf(fmt, argp);
 139     printf("\n");
 140     fflush(stdout);
 141     va_end(argp);
 142     tMPI_Thread_mutex_unlock(&mtx);
 143 }
 144 #endif
 145
 146
 147 tmpi_bool tMPI_Is_master(void)
 148 {
 149     /* if there are no other threads, we're the main thread */
 150     if ( (!TMPI_COMM_WORLD) || TMPI_COMM_WORLD->grp.N == 0)
 151     {
 152         return TRUE;
 153     }
 154
 155     /* otherwise we know this through thread specific data: */
 156     /* whether the thread pointer points to the head of the threads array */
 157     return (tmpi_bool)(tMPI_Get_current() == threads);
 158 }
 159
 160 tMPI_Comm tMPI_Get_comm_self(void)
 161 {
 162     struct tmpi_thread* th = tMPI_Get_current();
 163     return th->self_comm;
 164 }
 165
 166
 167 int tMPI_Get_N(int *argc, char ***argv, const char *optname, int *nthreads)
 168 {
 169     int i;
 170     int ret = TMPI_SUCCESS;
 171
 172     *nthreads = 0;
 173     if (!optname)
 174     {
 175         i = 0;
 176     }
 177     else
 178     {
 179         for (i = 1; i < *argc; i++)
 180         {
 181             if (strcmp(optname, (*argv)[i]) == 0)
 182             {
 183                 break;
 184             }
 185         }
 186     }
 187     if (i+1 < (*argc))
 188     {
 189         /* the number of processes is an argument */
 190         char *end;
 191         *nthreads = strtol((*argv)[i+1], &end, 10);
 192         if (!end || (*end != 0) )
 193         {
 194             *nthreads = 0;
 195             ret       = TMPI_FAILURE;
 196         }
 197     }
 198     if (*nthreads < 1)
 199     {
 200         int nth = tMPI_Thread_get_hw_number();
 201
 202         if (nth < 1)
 203         {
 204             nth = 1;      /* make sure it's at least 1 */
 205         }
 206         *nthreads = nth;
 207     }
 208
 209     return ret;
 210 }
 211
 212 static int tMPI_Thread_init(struct tmpi_thread *th)
 213 {
 214     int ret;
 215     int N_envelopes      = (Nthreads+1)*N_EV_ALLOC;
 216     int N_send_envelopes = N_EV_ALLOC;
 217     int N_reqs           = (Nthreads+1)*N_EV_ALLOC;
 218     int i;
 219
 220     /* we set our thread id, as a thread-specific piece of global data. */
 221     ret = tMPI_Thread_setspecific(id_key, th);
 222     if (ret != 0)
 223     {
 224         return ret;
 225     }
 226
 227     /* allocate comm.self */
 228     ret = tMPI_Comm_alloc( &(th->self_comm), TMPI_COMM_WORLD, 1);
 229     if (ret != TMPI_SUCCESS)
 230     {
 231         return ret;
 232     }
 233     th->self_comm->grp.peers[0] = th;
 234
 235     /* allocate envelopes */
 236     ret = tMPI_Free_env_list_init( &(th->envelopes), N_envelopes );
 237     if (ret != TMPI_SUCCESS)
 238     {
 239         return ret;
 240     }
 241     /* recv list */
 242     ret = tMPI_Recv_env_list_init( &(th->evr));
 243     if (ret != TMPI_SUCCESS)
 244     {
 245         return ret;
 246     }
 247     /* send lists */
 248     th->evs = (struct send_envelope_list*)tMPI_Malloc(
 249                 sizeof(struct send_envelope_list)*Nthreads);
 250     if (th->evs == NULL)
 251     {
 252         return TMPI_ERR_NO_MEM;
 253     }
 254     for (i = 0; i < Nthreads; i++)
 255     {
 256         ret = tMPI_Send_env_list_init( &(th->evs[i]), N_send_envelopes);
 257         if (ret != TMPI_SUCCESS)
 258         {
 259             return ret;
 260         }
 261     }
 262
 263     tMPI_Atomic_set( &(th->ev_outgoing_received), 0);
 264
 265     tMPI_Event_init( &(th->p2p_event) );
 266
 267     /* allocate requests */
 268     ret = tMPI_Req_list_init(&(th->rql), N_reqs);
 269     if (ret != TMPI_SUCCESS)
 270     {
 271         return ret;
 272     }
 273
 274
 275 #ifdef USE_COLLECTIVE_COPY_BUFFER
 276     /* allcate copy_buffer list */
 277     ret = tMPI_Copy_buffer_list_init(&(th->cbl_multi),
 278                                      (Nthreads+1)*(N_COLL_ENV+1),
 279                                      Nthreads*COPY_BUFFER_SIZE);
 280     if (ret != TMPI_SUCCESS)
 281     {
 282         return ret;
 283     }
 284 #endif
 285
 286 #ifdef TMPI_PROFILE
 287     ret = tMPI_Profile_init(&(th->profile));
 288     if (ret != TMPI_SUCCESS)
 289     {
 290         return ret;
 291     }
 292 #endif
 293     /* now wait for all other threads to come on line, before we
 294        start the MPI program */
 295     ret = tMPI_Thread_barrier_wait( &(tmpi_global->barrier) );
 296     if (ret != 0)
 297     {
 298         return ret;;
 299     }
 300     return ret;
 301 }
 302
 303
 304 static void tMPI_Thread_destroy(struct tmpi_thread *th)
 305 {
 306     int i;
 307
 308     tMPI_Recv_env_list_destroy( &(th->evr));
 309     for (i = 0; i < Nthreads; i++)
 310     {
 311         tMPI_Send_env_list_destroy( &(th->evs[i]));
 312     }
 313     free(th->evs);
 314     tMPI_Free_env_list_destroy( &(th->envelopes) );
 315     tMPI_Event_destroy( &(th->p2p_event) );
 316     tMPI_Req_list_destroy( &(th->rql) );
 317
 318 #ifdef USE_COLLECTIVE_COPY_BUFFER
 319     tMPI_Copy_buffer_list_destroy(&(th->cbl_multi));
 320 #endif
 321
 322     for (i = 0; i < th->argc; i++)
 323     {
 324         free(th->argv[i]);
 325     }
 326 }
 327
 328 static int tMPI_Global_init(struct tmpi_global *g, int Nthreads)
 329 {
 330     int ret;
 331
 332     g->usertypes        = NULL;
 333     g->N_usertypes      = 0;
 334     g->Nalloc_usertypes = 0;
 335     ret                 = tMPI_Thread_mutex_init(&(g->timer_mutex));
 336     if (ret != 0)
 337     {
 338         return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO);
 339     }
 340     tMPI_Spinlock_init(&(g->datatype_lock));
 341
 342     ret = tMPI_Thread_barrier_init( &(g->barrier), Nthreads);
 343     if (ret != 0)
 344     {
 345         return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO);
 346     }
 347
 348     ret = tMPI_Thread_mutex_init(&(g->comm_link_lock));
 349     if (ret != 0)
 350     {
 351         return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO);
 352     }
 353
 354
 355 #if !(defined( _WIN32 ) || defined( _WIN64 ) )
 356     /* the time at initialization. */
 357     gettimeofday( &(g->timer_init), NULL);
 358 #else
 359     /* the time at initialization. */
 360     g->timer_init = GetTickCount();
 361 #endif
 362     return TMPI_SUCCESS;
 363 }
 364
 365 static void tMPI_Global_destroy(struct tmpi_global *g)
 366 {
 367     tMPI_Thread_barrier_destroy(&(g->barrier));
 368     tMPI_Thread_mutex_destroy(&(g->timer_mutex));
 369     tMPI_Thread_mutex_destroy(&(g->comm_link_lock));
 370 }
 371
 372
 373
 374
 375 static void* tMPI_Thread_starter(void *arg)
 376 {
 377     int                 ret;
 378     struct tmpi_thread *th = (struct tmpi_thread*)arg;
 379
 380 #ifdef TMPI_TRACE
 381     tMPI_Trace_print("Created thread nr. %d", (int)(th-threads));
 382 #endif
 383
 384     ret = tMPI_Thread_init(th);
 385     if (ret != TMPI_SUCCESS)
 386     {
 387         return NULL;
 388     }
 389
 390     /* start_fn, start_arg, argc and argv were set by the calling function */
 391     if (!th->start_fn)
 392     {
 393         th->start_fn_main(th->argc, th->argv);
 394     }
 395     else
 396     {
 397         th->start_fn(th->start_arg);
 398         if (!tmpi_finalized)
 399         {
 400             tMPI_Finalize();
 401         }
 402     }
 403
 404     return NULL;
 405 }
 406
 407
 408 int tMPI_Start_threads(tmpi_bool main_returns, int N,
 409                        tMPI_Affinity_strategy aff_strategy,
 410                        int *argc, char ***argv,
 411                        void (*start_fn)(void*), void *start_arg,
 412                        int (*start_fn_main)(int, char**))
 413 {
 414     int ret;
 415 #ifdef TMPI_TRACE
 416     tMPI_Trace_print("tMPI_Start_threads(%d, %d, %d, %d, %d, %p, %p, %p, %p)",
 417                      main_returns, N, aff_strategy, argc, argv, start_fn,
 418                      start_arg);
 419 #endif
 420     if (N > 0)
 421     {
 422         int i;
 423         int set_affinity = FALSE;
 424
 425         tmpi_finalized = FALSE;
 426         Nthreads       = N;
 427
 428         /* allocate global data */
 429         tmpi_global = (struct tmpi_global*)
 430             tMPI_Malloc(sizeof(struct tmpi_global));
 431         if (tmpi_global == 0)
 432         {
 433             return TMPI_ERR_NO_MEM;
 434         }
 435         ret = tMPI_Global_init(tmpi_global, N);
 436         if (ret != TMPI_SUCCESS)
 437         {
 438             return ret;
 439         }
 440
 441         /* allocate world and thread data */
 442         threads = (struct tmpi_thread*)
 443             tMPI_Malloc(sizeof(struct tmpi_thread)*N);
 444         if (threads == NULL)
 445         {
 446             return TMPI_ERR_NO_MEM;
 447         }
 448         ret = tMPI_Comm_alloc(&TMPI_COMM_WORLD, NULL, N);
 449         if (ret != TMPI_SUCCESS)
 450         {
 451             return ret;
 452         }
 453         TMPI_GROUP_EMPTY = tMPI_Group_alloc();
 454
 455         if (tMPI_Thread_key_create(&id_key, NULL))
 456         {
 457             return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_INIT);
 458         }
 459         for (i = 0; i < N; i++)
 460         {
 461             TMPI_COMM_WORLD->grp.peers[i] = &(threads[i]);
 462
 463             /* copy argc, argv */
 464             if (argc && argv)
 465             {
 466                 int j;
 467                 threads[i].argc = *argc;
 468                 threads[i].argv = (char**)tMPI_Malloc(threads[i].argc*
 469                                                       sizeof(char*));
 470                 for (j = 0; j < threads[i].argc; j++)
 471                 {
 472 #if !(defined( _WIN32 ) || defined( _WIN64 ) )
 473                     threads[i].argv[j] = strdup( (*argv)[j] );
 474 #else
 475                     threads[i].argv[j] = _strdup( (*argv)[j] );
 476 #endif
 477                 }
 478             }
 479             else
 480             {
 481                 threads[i].argc = 0;
 482                 threads[i].argv = NULL;
 483             }
 484             threads[i].start_fn      = start_fn;
 485             threads[i].start_fn_main = start_fn_main;
 486             threads[i].start_arg     = start_arg;
 487         }
 488
 489         /* now check whether to set affinity */
 490         if (aff_strategy == TMPI_AFFINITY_ALL_CORES)
 491         {
 492             int nhw = tMPI_Thread_get_hw_number();
 493             if ((nhw > 1) && (nhw == N))
 494             {
 495                 set_affinity = TRUE;
 496             }
 497         }
 498
 499         /* set thread 0's properties */
 500         threads[0].thread_id = tMPI_Thread_self();
 501         if (set_affinity)
 502         {
 503             /* set the main thread's affinity */
 504             tMPI_Thread_setaffinity_single(threads[0].thread_id, 0);
 505         }
 506
 507         for (i = 1; i < N; i++) /* zero is the main thread */
 508         {
 509             ret = tMPI_Thread_create(&(threads[i].thread_id),
 510                                      tMPI_Thread_starter,
 511                                      (void*)&(threads[i]) );
 512
 513             if (set_affinity)
 514             {
 515                 tMPI_Thread_setaffinity_single(threads[i].thread_id, i);
 516             }
 517             if (ret != TMPI_SUCCESS)
 518             {
 519                 return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_INIT);
 520             }
 521         }
 522         /* the main thread also runs start_fn if we don't want
 523            it to return */
 524         if (!main_returns)
 525         {
 526             tMPI_Thread_starter((void*)&(threads[0]));
 527
 528         }
 529         else
 530         {
 531             ret = tMPI_Thread_init(&(threads[0]));
 532             if (ret != 0)
 533             {
 534                 return ret;
 535             }
 536         }
 537     }
 538     return TMPI_SUCCESS;
 539 }
 540
 541
 542 int tMPI_Init(int *argc, char ***argv,
 543               int (*start_function)(int, char**))
 544 {
 545     int ret;
 546 #ifdef TMPI_TRACE
 547     tMPI_Trace_print("tMPI_Init(%p, %p, %p)", argc, argv, start_function);
 548 #endif
 549
 550     if (TMPI_COMM_WORLD == 0) /* we're the main process */
 551     {
 552         int N = 0;
 553         tMPI_Get_N(argc, argv, "-nt", &N);
 554         ret = tMPI_Start_threads(TRUE, N, TMPI_AFFINITY_ALL_CORES, argc, argv,
 555                                  NULL, NULL, start_function) != 0;
 556         if (ret != 0)
 557         {
 558             return ret;
 559         }
 560     }
 561     else
 562     {
 563         /* if we're a sub-thread we need don't need to do anyhing, because
 564            everything has already been set up by either the main thread,
 565            or the thread runner function.*/
 566     }
 567     return TMPI_SUCCESS;
 568 }
 569
 570
 571
 572
 573 int tMPI_Init_fn(int main_thread_returns, int N,
 574                  tMPI_Affinity_strategy aff_strategy,
 575                  void (*start_function)(void*), void *arg)
 576 {
 577     int ret;
 578 #ifdef TMPI_TRACE
 579     tMPI_Trace_print("tMPI_Init_fn(%d, %p, %p)", N, start_function, arg);
 580 #endif
 581
 582     if (N < 1)
 583     {
 584         N = tMPI_Thread_get_hw_number();
 585         if (N < 1)
 586         {
 587             N = 1;    /*because that's what the fn returns if it doesn't know*/
 588         }
 589     }
 590
 591     if (TMPI_COMM_WORLD == 0 && N >= 1) /* we're the main process */
 592     {
 593         ret = tMPI_Start_threads(main_thread_returns, N, aff_strategy,
 594                                  0, 0, start_function, arg, NULL);
 595         if (ret != 0)
 596         {
 597             return ret;
 598         }
 599     }
 600     return TMPI_SUCCESS;
 601 }
 602
 603 int tMPI_Initialized(int *flag)
 604 {
 605 #ifdef TMPI_TRACE
 606     tMPI_Trace_print("tMPI_Initialized(%p)", flag);
 607 #endif
 608
 609     *flag = (TMPI_COMM_WORLD && !tmpi_finalized);
 610
 611     return TMPI_SUCCESS;
 612 }
 613
 614 int tMPI_Finalize(void)
 615 {
 616     int i;
 617     int ret;
 618 #ifdef TMPI_TRACE
 619     tMPI_Trace_print("tMPI_Finalize()");
 620 #endif
 621 #ifdef TMPI_DEBUG
 622     printf("%5d: tMPI_Finalize called\n", tMPI_This_threadnr());
 623     fflush(stdout);
 624 #endif
 625
 626 #ifdef TMPI_PROFILE
 627     {
 628         struct tmpi_thread *cur = tMPI_Get_current();
 629
 630         tMPI_Profile_stop( &(cur->profile) );
 631         ret = tMPI_Thread_barrier_wait( &(tmpi_global->barrier) );
 632         if (ret != 0)
 633         {
 634             return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO);
 635         }
 636
 637         if (tMPI_Is_master())
 638         {
 639             tMPI_Profiles_summarize(Nthreads, threads);
 640         }
 641     }
 642 #endif
 643     ret = tMPI_Thread_barrier_wait( &(tmpi_global->barrier) );
 644     if (ret != 0)
 645     {
 646         return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO);
 647     }
 648
 649
 650
 651     if (tMPI_Is_master())
 652     {
 653
 654         /* we just wait for all threads to finish; the order isn't very
 655            relevant, as all threads should arrive at their endpoints soon. */
 656         for (i = 1; i < Nthreads; i++)
 657         {
 658             if (tMPI_Thread_join(threads[i].thread_id, NULL))
 659             {
 660                 return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_FINALIZE);
 661             }
 662             tMPI_Thread_destroy(&(threads[i]));
 663         }
 664         /* at this point, we are the only thread left, so we can
 665            destroy the global structures with impunity. */
 666         tMPI_Thread_destroy(&(threads[0]));
 667         free(threads);
 668
 669         tMPI_Thread_key_delete(id_key);
 670         /* de-allocate all the comm stuctures. */
 671         {
 672             tMPI_Comm cur;
 673
 674             ret = tMPI_Thread_mutex_lock(&(tmpi_global->comm_link_lock));
 675             if (ret != 0)
 676             {
 677                 return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO);
 678             }
 679             cur = TMPI_COMM_WORLD->next;
 680             while (cur && (cur != TMPI_COMM_WORLD) )
 681             {
 682                 tMPI_Comm next = cur->next;
 683                 ret = tMPI_Comm_destroy(cur, FALSE);
 684                 if (ret != 0)
 685                 {
 686                     tMPI_Thread_mutex_unlock(&(tmpi_global->comm_link_lock));
 687                     return ret;
 688                 }
 689                 cur = next;
 690             }
 691             ret = tMPI_Comm_destroy(TMPI_COMM_WORLD, FALSE);
 692             if (ret != 0)
 693             {
 694                 tMPI_Thread_mutex_unlock(&(tmpi_global->comm_link_lock));
 695                 return ret;
 696             }
 697             ret = tMPI_Thread_mutex_unlock(&(tmpi_global->comm_link_lock));
 698             if (ret != 0)
 699             {
 700                 return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO);
 701             }
 702
 703         }
 704
 705         tMPI_Group_free(&TMPI_GROUP_EMPTY);
 706         threads          = 0;
 707         TMPI_COMM_WORLD  = NULL;
 708         TMPI_GROUP_EMPTY = NULL;
 709         Nthreads         = 0;
 710
 711         /* deallocate the 'global' structure */
 712         tMPI_Global_destroy(tmpi_global);
 713         free(tmpi_global);
 714
 715         tmpi_finalized = TRUE;
 716     }
 717     else
 718     {
 719         tMPI_Thread_exit(0);
 720     }
 721     return TMPI_SUCCESS;
 722 }
 723
 724
 725 int tMPI_Finalized(int *flag)
 726 {
 727 #ifdef TMPI_TRACE
 728     tMPI_Trace_print("tMPI_Finalized(%p)", flag);
 729 #endif
 730     *flag = tmpi_finalized;
 731
 732     return TMPI_SUCCESS;
 733 }
 734
 735
 736
 737 int tMPI_Abort(tMPI_Comm comm, int errorcode)
 738 {
 739 #ifdef TMPI_TRACE
 740     tMPI_Trace_print("tMPI_Abort(%p, %d)", comm, errorcode);
 741 #endif
 742 #if 0
 743     /* we abort(). This way we can run a debugger on it */
 744     fprintf(stderr, "tMPI_Abort called with error code %d", errorcode);
 745     if (comm == TMPI_COMM_WORLD)
 746     {
 747         fprintf(stderr, " on TMPI_COMM_WORLD");
 748     }
 749     fprintf(stderr, "\n");
 750     fflush(stdout);
 751
 752     abort();
 753 #else
 754     /* we just kill all threads, but not the main process */
 755
 756     if (tMPI_Is_master())
 757     {
 758         if (comm == TMPI_COMM_WORLD)
 759         {
 760             fprintf(stderr,
 761                     "tMPI_Abort called on TMPI_COMM_WORLD main with errorcode=%d\n",
 762                     errorcode);
 763         }
 764         else
 765         {
 766             fprintf(stderr,
 767                     "tMPI_Abort called on main thread with errorcode=%d\n",
 768                     errorcode);
 769         }
 770         fflush(stderr);
 771         exit(errorcode);
 772     }
 773     else
 774     {
 775         int *ret;
 776         /* kill myself */
 777         fprintf(stderr, "tMPI_Abort called with error code %d on thread %d\n",
 778                 errorcode, tMPI_This_threadnr());
 779         fflush(stderr);
 780         ret = (int*)malloc(sizeof(int));
 781         tMPI_Thread_exit(ret);
 782     }
 783 #endif
 784     return TMPI_SUCCESS;
 785 }
 786
 787
 788 int tMPI_Get_processor_name(char *name, int *resultlen)
 789 {
 790     int                nr     = tMPI_Threadnr(tMPI_Get_current());
 791     unsigned int       digits = 0;
 792     const unsigned int base   = 10;
 793
 794 #ifdef TMPI_TRACE
 795     tMPI_Trace_print("tMPI_Get_processor_name(%p, %p)", name, resultlen);
 796 #endif
 797     /* we don't want to call sprintf here (it turns out to be not entirely
 798        thread-safe on Mac OS X, for example), so we do it our own way: */
 799
 800     /* first determine number of digits */
 801     {
 802         int rest = nr;
 803         while (rest > 0)
 804         {
 805             rest /= base;
 806             digits++;
 807         }
 808         if (digits == 0)
 809         {
 810             digits = 1;
 811         }
 812     }
 813 #ifndef _MSC_VER
 814     strcpy(name, "thread #");
 815 #else
 816     strncpy_s(name, TMPI_MAX_PROCESSOR_NAME, "thread #", TMPI_MAX_PROCESSOR_NAME);
 817 #endif
 818     /* now construct the number */
 819     {
 820         size_t       len = strlen(name);
 821         unsigned int i;
 822         int          rest = nr;
 823
 824         for (i = 0; i < digits; i++)
 825         {
 826             size_t pos = len + (digits-i-1);
 827             if (pos < (TMPI_MAX_PROCESSOR_NAME -1) )
 828             {
 829                 name[ pos ] = (char)('0' + rest%base);
 830             }
 831             rest /= base;
 832         }
 833         if ( (digits+len) < TMPI_MAX_PROCESSOR_NAME)
 834         {
 835             name[digits + len] = '\0';
 836         }
 837         else
 838         {
 839             name[TMPI_MAX_PROCESSOR_NAME] = '\0';
 840         }
 841
 842     }
 843     if (resultlen)
 844     {
 845         *resultlen = (int)strlen(name); /* For some reason the MPI standard
 846                                            uses ints instead of size_ts for
 847                                            sizes. */
 848     }
 849     return TMPI_SUCCESS;
 850 }
 851
 852
 853
 854
 855
 856 /* TODO: there must be better ways to do this */
 857 double tMPI_Wtime(void)
 858 {
 859     double ret = 0;
 860
 861 #ifdef TMPI_TRACE
 862     tMPI_Trace_print("tMPI_Wtime()");
 863 #endif
 864
 865 #if !(defined( _WIN32 ) || defined( _WIN64 ) )
 866     {
 867         struct timeval tv;
 868         long int       secdiff;
 869         int            usecdiff;
 870
 871         gettimeofday(&tv, NULL);
 872         secdiff  = tv.tv_sec - tmpi_global->timer_init.tv_sec;
 873         usecdiff = tv.tv_usec - tmpi_global->timer_init.tv_usec;
 874
 875         ret = (double)secdiff + 1e-6*usecdiff;
 876     }
 877 #else
 878     {
 879         DWORD tv = GetTickCount();
 880
 881         /* the windows absolute time GetTickCount() wraps around in ~49 days,
 882            so it's safer to always use differences, and assume that our
 883            program doesn't run that long.. */
 884         ret = 1e-3*((unsigned int)(tv - tmpi_global->timer_init));
 885     }
 886 #endif
 887     return ret;
 888 }
 889
 890 double tMPI_Wtick(void)
 891 {
 892 #if !(defined( _WIN32 ) || defined( _WIN64 ) )
 893     /* In Unix, we don't really know. Any modern OS should be at least
 894        this precise, though */
 895     return 1./100.;
 896 #else
 897     /* According to the Windows documentation, this is about right: */
 898     return 1./100.;
 899 #endif
 900 }
 901
 902 int tMPI_Get_count(tMPI_Status *status, tMPI_Datatype datatype, int *count)
 903 {
 904 #ifdef TMPI_TRACE
 905     tMPI_Trace_print("tMPI_Get_count(%p, %p, %p)", status, datatype, count);
 906 #endif
 907     if (!status)
 908     {
 909         return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_STATUS);
 910     }
 911     *count = (int)(status->transferred/datatype->size);
 912     return TMPI_SUCCESS;
 913 }